[libstring-scanf-perl] 01/03: Import original source of String-Scanf 2.1
Sam James
sam_c-guest at moszumanska.debian.org
Mon Aug 22 15:56:59 UTC 2016
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 98e273a2428a07085325d6d43b7d96aac542c2a6
Author: sam james <sam at cmpct.info>
Date: Mon Aug 22 15:48:52 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 <jhi at 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 <jhi at 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;
+ at ISA = qw(Exporter);
+ at 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 <jhi at 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
More information about the Pkg-perl-cvs-commits
mailing list