This is an automated email from the git hooks/post-receive script.

sam_c-guest pushed a commit to branch master
in repository libstring-scanf-perl.

commit 12ad998d735403933c6a08a3ce374bc39fce921b
Author: sam james <s...@cmpct.info>
Date:   Tue Aug 23 16:35:23 2016 +0000

    Import original source of String-Scanf 2.1
---
 ChangeLog           |  18 ++++
 MANIFEST            |   7 ++
 META.yml            |   9 ++
 Makefile.PL         |   7 ++
 README              |   8 ++
 lib/String/Scanf.pm | 248 ++++++++++++++++++++++++++++++++++++++++++++++++++
 t/scanf.t           | 256 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 553 insertions(+)

diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..9fe190f
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,18 @@
+2004-05-07  Jarkko Hietaniemi  <j...@iki.fi>
+
+       * 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  <j...@iki.fi>
+
+       * 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.
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..b214d2c
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,7 @@
+ChangeLog
+lib/String/Scanf.pm
+Makefile.PL
+MANIFEST
+README
+t/scanf.t
+META.yml                                Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..50908cb
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,9 @@
+#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
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..f932e36
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,7 @@
+use 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',
+);
diff --git a/README b/README
new file mode 100644
index 0000000..e85dec5
--- /dev/null
+++ b/README
@@ -0,0 +1,8 @@
+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.
+
diff --git a/lib/String/Scanf.pm b/lib/String/Scanf.pm
new file mode 100644
index 0000000..a15e521
--- /dev/null
+++ b/lib/String/Scanf.pm
@@ -0,0 +1,248 @@
+package 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<e> may also be C<E>.
+
+The various borderline cases like C<Inf> and C<Nan> 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<sscanf()>, 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 <j...@iki.fi>
+
+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;
diff --git a/t/scanf.t b/t/scanf.t
new file mode 100644
index 0000000..cc1abf2
--- /dev/null
+++ b/t/scanf.t
@@ -0,0 +1,256 @@
+use 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 (<DATA>) {
+  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

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libstring-scanf-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to