String-Scanf-2.1/0040700000076500001430000000000010046730435012701 5ustar jhiunknownString-Scanf-2.1/ChangeLog0100644000076500001430000000114710046730347014467 0ustar jhiunknown2004-05-07 Jarkko Hietaniemi * Release 2.1: Fix a bug reported by Julio Garvía Honrad: if a scan pattern contained a literal 't', it was matched as a '\t'. Duh. 2002-09-01 Jarkko Hietaniemi * Release 2.0: The 2.0 release of String::Scanf introduces an object-oriented interface (works only for Perl release 5.005 and up) that should speed up repetitive sscanf() operations. Note that for the 2.0 release the old compatibility setting interface set_compat() has been removed since there is no need to be able to be backward compatible with the old release 1 bugs. String-Scanf-2.1/lib/0040700000076500001430000000000010046730435013447 5ustar jhiunknownString-Scanf-2.1/lib/String/0040700000076500001430000000000010046730435014715 5ustar jhiunknownString-Scanf-2.1/lib/String/Scanf.pm0100644000076500001430000001230710046727517016326 0ustar jhiunknownpackage String::Scanf; use strict; use vars qw($VERSION @ISA @EXPORT); $VERSION = '2.1'; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(sscanf); =pod =head1 NAME String::Scanf - emulate sscanf() of the C library =head1 SYNOPSIS use String::Scanf; # imports sscanf() ($a, $b, $c, $d) = sscanf("%d+%d %f-%s", $input); ($e, $f, $g, $h) = sscanf("%x %o %s:%3c"); # input defaults to $_ $r = String::Scanf::format_to_re($f); or # works only for Perl 5.005 or later use String::Scanf qw(); # import nothing my $s1 = String::Scanf->new("%d+%d %f-%s"); my $s2 = String::Scanf->new("%x %o %s:%3c"); ($a, $b, $c, $d) = $s1->sscanf($input); ($e, $f, $g, $h) = $s2->sscanf(); # input defaults to $_ =head1 DESCRIPTION String::Scanf supports scanning strings for data using formats similar to the libc/stdio sscanf(). The supported sscanf() formats are as follows: =over 4 =item %d Decimal integer, with optional plus or minus sign. =item %u Decimal unsigned integer, with optional plus sign. =item %x Hexadecimal unsigned integer, with optional "0x" or "0x" in front. =item %o Octal unsigned integer. =item %e %f %g (The [efg] work identically.) Decimal floating point number, with optional plus or minus sign, in any of these formats: 1 1. 1.23 .23 1e45 1.e45 1.23e45 .23e45 The exponent has an optional plus or minus sign, and the C may also be C. The various borderline cases like C and C are not recognized. =item %s A non-whitespace string. =item %c A string of characters. An array reference is returned containing the numerical values of the characters. =item %% A literal C<%>. =back The sscanf() formats [pnSC] are not supported. The C<%s> and C<%c> have an optional maximum width, e.g. C<%4s>, in which case at most so many characters are consumed (but fewer characters are also accecpted). The numeric formats may also have such a width but it is ignored. The numeric formats may have C<[hl]> before the main option, e.g. C<%hd>, but since such widths have no meaning in Perl, they are ignored. Non-format parts of the parameter string are matched literally (e.g. C<:> matches as C<:>), expect that any whitespace is matched as any whitespace (e.g. C< > matches as C<\s+>). =head1 WARNING The numeric formats match only something that looks like a number, they do not care whether it fits into the numbers of Perl. In other words, C<123e456789> is valid for C, but quite probably it won't fit into your Perl's numbers. Consider using the various Math::* modules instead. =head1 AUTHOR, COPYRIGHT AND LICENSE Jarkko Hietaniemi Copyright (c) 2002,2004 Jarkko Hietaniemi. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut use Carp; sub _format_to_re { my $format = shift; my $re = ''; my $ix = 0; my @fmt; my @reo; my $dx = '\d+(?:_\d+)*'; while ($format =~ /(%(?:(?:(\d+)\$)?(\d*)([hl]?[diuoxefg]|[pnsScC%]))|%(\d*)(\[.+?\])|(.+?))/g) { if (defined $2) { # Reordering. $reo[$ix] = $2 - 1; } else { $reo[$ix] = $ix; } if (defined $1) { if (defined $4) { my $e; my ($w, $f) = ($3, $4); $f =~ s/^[hl]//; if ($f =~ /^[pnSC]$/) { croak "'$f' not supported"; } elsif ($f =~ /^[di]$/) { $e = "[-+]?$dx"; } elsif ($f eq 'x') { $e = '(?:0[xX])?[0-9A-Fa-f]+(?:_[0-9A-Fa-f]+)*'; } elsif ($f eq 'o') { $e = '[0-7]+(?:_[0-7]+)*'; } elsif ($f =~ /^[efg]$/) { $e = "[-+]?(?:(?:$dx(?:\\.(?:$dx)?)?|\\.$dx)(?:[eE][-+]?$dx)?)"; } elsif ($f eq 'u') { $e = "\\+?$dx"; } elsif ($f eq 's') { $e = $w ? "\\S{0,$w}" : "\\S*"; } elsif ($f eq 'c') { $e = $w ? ".{0,$w}" : ".*"; } if ($f !~ /^[cC%]$/) { $re .= '\s*'; } $re .= "($e)"; $fmt[$ix++] = $f; } elsif (defined $6) { # [...] $re .= $5 ? "(${6}{0,$5})" : "($6+)"; $fmt[$ix++] = '['; } elsif (defined $7) { # Literal. my $lit = $7; if ($lit =~ /^\s+$/) { $re .= '\s+'; } else { $lit =~ s/(\W)/\\$1/g; $re .= $lit; } } } } $re =~ s/\\s\*\\s\+/\\s+/g; $re =~ s/\\s\+\\s\*/\\s+/g; return ($re, \@fmt, \@reo); } sub format_to_re { my ($re) = _format_to_re $_[0]; return $re; } sub _match { my ($format, $re, $fmt, $reo, $data) = @_; my @matches = ($data =~ /$re/); my $ix; for ($ix = 0; $ix < @matches; $ix++) { if ($fmt->[$ix] eq 'c') { $matches[$ix] = [ map { ord } split //, $matches[$ix] ]; } elsif ($fmt->[$ix] =~ /^[diuoxefg]$/) { $matches[$ix] =~ tr/_//d; } if ($fmt->[$ix] eq 'x') { $matches[$ix] =~ s/^0[xX]//; $matches[$ix] = hex $matches[$ix]; } elsif ($fmt->[$ix] eq 'o') { $matches[$ix] = oct $matches[$ix]; } } @matches = @matches[@$reo]; return @matches; } sub new { require 5.005; sub qr {} my ($class, $format) = @_; my ($re, $fmt, $reo) = _format_to_re $format; bless [ $format, qr/$re/, $fmt, $reo ], $class; } sub format { $_[0]->[0]; } sub sscanf { my $self = shift; my $data = @_ ? shift : $_; if (ref $self) { return _match(@{ $self }, $data); } _match($self, _format_to_re($self), $data); } 1; String-Scanf-2.1/Makefile.PL0100644000076500001430000000035007532555441014670 0ustar jhiunknownuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'String::Scanf', 'VERSION_FROM' => 'lib/String/Scanf.pm', ); String-Scanf-2.1/MANIFEST0100644000076500001430000000022210046730434014034 0ustar jhiunknownChangeLog lib/String/Scanf.pm Makefile.PL MANIFEST README t/scanf.t META.yml Module meta-data (added by MakeMaker) String-Scanf-2.1/META.yml0100644000076500001430000000037610046730435014167 0ustar jhiunknown#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: String-Scanf version: 2.1 version_from: lib/String/Scanf.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.12 String-Scanf-2.1/README0100644000076500001430000000055007534230064013571 0ustar jhiunknownThe 2.0 release of String::Scanf introduces an object-oriented interface (works only for Perl release 5.005 and up) that should speed up repetitive sscanf() operations. Note that for the 2.0 release the old compatibility setting interface set_compat() has been removed since there is no need to be able to be backward compatible with the old release 1 bugs. String-Scanf-2.1/t/0040700000076500001430000000000010046730435013144 5ustar jhiunknownString-Scanf-2.1/t/scanf.t0100644000076500001430000001256610046730050014435 0ustar jhiunknownuse String::Scanf; print "1..135\n"; ($i, $s, $x) = sscanf('%d %3s %g', ' -5_678 abc 3.14e-99 9'); print 'not ' unless ($i == -5678); print "ok 1\n"; print 'not ' unless ($s eq 'abc'); print "ok 2\n"; print 'not ' unless ($x == 3.14e-99); print "ok 3\n"; ($x, $y, $z) = sscanf('%i%3[a-e]%2c', ' 42acxde'); print 'not ' unless ($x == 42); print "ok 4\n"; print 'not ' unless ($y eq 'ac'); print "ok 5\n"; print 'not ' unless ($$z[0] == ord("x") and $$z[1] == ord("d")); print "ok 6\n"; ($a, $b) = sscanf('%2$d %1$d', '12 34'); print 'not ' unless ($a == 34); print "ok 7\n"; print 'not ' unless ($b == 12); print "ok 8\n"; ($h, $o, $hh, $oo) = sscanf('%x %o %x %o', '0xa_b_c_d 0234_5 3_45_6 45_67'); print 'not ' unless ($h == 0xabcd); print "ok 9\n"; print 'not ' unless ($o == 02345); print "ok 10\n"; print 'not ' unless ($hh == 0x3456); print "ok 11\n"; print 'not ' unless ($oo == 04567); print "ok 12\n"; ($a, $b, $c) = sscanf("%f %f %f", "123. 0123. 0123"); print 'not ' unless ($a == 123); print "ok 13\n"; print 'not ' unless ($b == 123); print "ok 14\n"; print 'not ' unless ($c == 123); print "ok 15\n"; ($a, $b, $c) = sscanf("%f %f %f", "+123. +0123. +0123"); print 'not ' unless ($a == 123); print "ok 16\n"; print 'not ' unless ($b == 123); print "ok 17\n"; print 'not ' unless ($c == 123); print "ok 18\n"; ($a, $b, $c) = sscanf("%f %f %f", "-123. -0123. -0123"); print 'not ' unless ($a == -123); print "ok 19\n"; print 'not ' unless ($b == -123); print "ok 20\n"; print 'not ' unless ($c == -123); print "ok 21\n"; $line = "2002-08-19 16:03:00 65.2 88.7 111131.65 +170911.2 64.017681122 102375.7472 65.2 88.7 111131.15 +170918.3 64.014927982 -102336.8523 12:03"; ($year, $month, $day, $hour, $min, $sec, $elR, $azR, $HMSR, $DMSR, $RTTR, $DopR, $elT, $azT, $HMST, $DMST, $RTTT, $DopT, $local) = sscanf("%f-%f-%f %f:%f:%f %f%f%f%f%f%f%f%lf%lf%lf%lf%lf %s", $line); sub arecibo { print 'not ' unless ($year == 2002 && $month == 8 && $day == 19 && $hour == 16 && $min == 3 && $sec == 0 && $elR == 65.2 && $azR == 88.7 && $HMSR == 111131.65 && $DMSR == 170911.2 && $RTTR == 64.017681122 && $DopR == 102375.7472 && $elT == 65.2 && $azT == 88.7 && $HMST == 111131.15 && $DMST == 170918.3 && $RTTT == 64.014927982 && $DopT == -102336.8523 && $local eq "12:03"); } arecibo; print "ok 22\n"; ($year, $month, $day, $hour, $min, $sec, $elR, $azR, $HMSR, $DMSR, $RTTR, $DopR, $elT, $azT, $HMST, $DMST, $RTTT, $DopT, $local) = sscanf("%d-%d-%d %d:%d:%d %f%f%f%f%f%f%f%lf%lf%lf%lf%lf %s", $line); arecibo; print "ok 23\n"; if ($] < 5.005) { print "ok 24 # skip in Perl $]\n"; print "ok 25 # skip in Perl $]\n"; } else { my $s = String::Scanf->new("%d"); my @s1 = $s->sscanf("123"); print "not " unless @s1 == 1 && $s1[0] == 123; print "ok 24\n"; $_ = "456"; my @s2 = $s->sscanf(); print "not " unless @s2 == 1 && $s2[0] == 456; print "ok 25\n"; } my $t = 26; sub eps () { 1e-50 } while () { chomp; ($f, $d, $e) = split(/\s*;\s*/); my @r = sscanf($f, $d); my @e = split(/\s*,\s*/,$e); my $i; for ($i = 0; $i < @e; $i++) { unless (($e[$i] =~ /^[\d-]/ && ($e[$i] - $r[$i]) < eps) || $e[$i] eq $r[$i]) { last; } } unless ($i == @e) { print "not ok $t # [@r] [@e]\n"; } else { print "ok $t\n"; } $t++; } __DATA__ %d ; 123 ; 123 %d ; +123 ; 123 %d ; -123 ; -123 %d ; 0123 ; 123 %d ; 1_2_3 ; 123 %d ; d123 ; %i ; 123 ; 123 %i ; +123 ; 123 %i ; -123 ; -123 %i ; 0123 ; 123 %i ; 1_2_3 ; 123 %d ; d123 ; %u ; 123 ; 123 %u ; +123 ; 123 %u ; -123 ; %u ; 0123 ; 123 %u ; 1_2_3 ; 123 %u ; u123 ; %e ; 1 ; 1 %e ; 1. ; 1 %e ; 1.23 ; 1.23 %e ; .23 ; 0.23 %e ; +1 ; 1 %e ; +1. ; 1 %e ; +1.23 ; 1.23 %e ; +.23 ; 0.23 %e ; -1 ; -1 %e ; -1. ; -1 %e ; -1.23 ; -1.23 %e ; -.23 ; -0.23 %e ; 1e45 ; 1e45 %e ; 1.e45 ; 1e45 %e ; 1.23e45 ; 1.23e45 %e ; .23e45 ; 0.23e45 %e ; +1e45 ; 1e45 %e ; +1.e45 ; 1e45 %e ; +1.23e45 ; 1.23e45 %e ; +.23e45 ; 0.23e45 %e ; -1e45 ; -1e45 %e ; -1.e45 ; -1e45 %e ; -1.23e45 ; -1.23e45 %e ; -.23e45 ; -0.23e45 %e ; 1e-45 ; 1e-45 %e ; 1.e-45 ; 1e-45 %e ; 1.23e-45 ; 1.23e-45 %e ; .23e-45 ; 0.23e-45 %e ; +1e-45 ; 1e-45 %e ; +1.e-45 ; 1e-45 %e ; +1.23e-45 ; 1.23e-45 %e ; +.23e-45 ; 0.23e-45 %e ; -1e-45 ; -1e-45 %e ; -1.e-45 ; -1e-45 %e ; -1.23e-45 ; -1.23e-45 %e ; -.23e-45 ; -0.23e-45 %e ; 1e045 ; 1e45 %e ; 1.e045 ; 1e45 %e ; 1.23e045 ; 1.23e45 %e ; .23e045 ; 0.23e45 %e ; +1e045 ; 1e45 %e ; +1.e045 ; 1e45 %e ; +1.23e045 ; 1.23e45 %e ; +.23e045 ; 0.23e45 %e ; -1e045 ; -1e45 %e ; -1.e045 ; -1e45 %e ; -1.23e045 ; -1.23e45 %e ; -.23e045 ; -0.23e45 %e ; 1_2_3e4_5 ; 1.23e47 %e ; 0123 ; 123 %e ; e123 ; %f ; 1 ; 1 %f ; 1. ; 1 %f ; 1.23 ; 1.23 %f ; .23 ; 0.23 %g ; 1 ; 1 %g ; 1. ; 1 %g ; 1.23 ; 1.23 %g ; .23 ; 0.23 %x ; a ; 10 %x ; A ; 10 %x ; 0xa ; 10 %x ; 0Xa ; 10 %x ; 11 ; 17 %x ; 011 ; 17 %x ; 1_1 ; 17 %x ; x11 ; %o ; 11 ; 9 %o ; 011 ; 9 %o ; 1_1 ; 9 %o ; o11 ; %hd ; 123 ; 123 %ld ; 123 ; 123 %hi ; 123 ; 123 %li ; 123 ; 123 %hu ; 123 ; 123 %lu ; 123 ; 123 %he ; 123 ; 123 %le ; 123 ; 123 %hx ; 123 ; 291 %lx ; 123 ; 291 %ho ; 123 ; 83 %lo ; 123 ; 83 %s ; foo bar ; foo %s %s ; foo bar ; foo,bar %s %s ; foo bar ; foo,bar %s %d ; foo 123 ; foo,123 %3s%3s ; foobar ; foo,bar %4s%2s ; foobar ; foob,ar %2s%4s ; foobar ; fo,obar State:%s; State: Active ; Active n=%g ; n=1.234 ; 1.234