r43579 - in /branches/upstream/libgetopt-declare-perl/current: Changes Makefile.PL README lib/Getopt/Declare.pm test.pl
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Sep 3 17:56:27 UTC 2009
Author: jawnsy-guest
Date: Thu Sep 3 17:56:18 2009
New Revision: 43579
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=43579
Log:
[svn-upgrade] Integrating new upstream version, libgetopt-declare-perl (1.12)
Modified:
branches/upstream/libgetopt-declare-perl/current/Changes
branches/upstream/libgetopt-declare-perl/current/Makefile.PL
branches/upstream/libgetopt-declare-perl/current/README
branches/upstream/libgetopt-declare-perl/current/lib/Getopt/Declare.pm
branches/upstream/libgetopt-declare-perl/current/test.pl
Modified: branches/upstream/libgetopt-declare-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/Changes?rev=43579&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/Changes (original)
+++ branches/upstream/libgetopt-declare-perl/current/Changes Thu Sep 3 17:56:18 2009
@@ -119,3 +119,18 @@
1.11 Tue Feb 3 20:44:26 2004
- Fixed bug in multi-argument parameters
+
+
+1.12 Tue Sep 2 14:15:01 2009
+
+ - Fixed bug #18084: Misparsing of numbers in exponential notation.
+
+ - Fixed bug in which only the first part of an number (:i or :n) needed
+ to be a number (e.g. '123asdf' was parsed as '123').
+
+ - Fixed bug #41043: Misparsing of lists of files (:if or :of).
+
+ - Fixed bug causing misparsing of lists of quoted strings (:qs).
+
+ - Added emphasis in the documentation on the need for tabs in the
+ specification
Modified: branches/upstream/libgetopt-declare-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/Makefile.PL?rev=43579&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/Makefile.PL (original)
+++ branches/upstream/libgetopt-declare-perl/current/Makefile.PL Thu Sep 3 17:56:18 2009
@@ -2,7 +2,7 @@
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => q[Getopt::Declare],
- VERSION => q[1.11],
+ VERSION => q[1.12],
PREREQ_PM => { 'Text::Balanced'=> 0 },
);
Modified: branches/upstream/libgetopt-declare-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/README?rev=43579&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/README (original)
+++ branches/upstream/libgetopt-declare-perl/current/README Thu Sep 3 17:56:18 2009
@@ -1,5 +1,5 @@
==============================================================================
- Release of version 1.11 of Getopt::Declare
+ Release of version 1.12 of Getopt::Declare
==============================================================================
@@ -86,10 +86,10 @@
==============================================================================
-CHANGES IN VERSION 1.11
+CHANGES IN VERSION 1.12
- - Fixed bug in multi-argument parameters
+ - Bug fixes for parsing decimal numbers and lists of files
==============================================================================
Modified: branches/upstream/libgetopt-declare-perl/current/lib/Getopt/Declare.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/lib/Getopt/Declare.pm?rev=43579&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/lib/Getopt/Declare.pm (original)
+++ branches/upstream/libgetopt-declare-perl/current/lib/Getopt/Declare.pm Thu Sep 3 17:56:18 2009
@@ -5,7 +5,7 @@
use UNIVERSAL qw(isa);
use Carp;
-$VERSION = '1.11';
+$VERSION = '1.12';
sub import {
my ($class, $defn) = @_;
@@ -48,34 +48,28 @@
{
%stdtype =
(
- ':i' => { pattern => '(?:(?:%T[+-]?)%D+)' },
- ':n' => { pattern => '(?:(?:%T[+-]?)(?:%D+(?:%T\.%D*)?(?:%T[eE]%D+)?'
- . '|%T\.%D+(?:%T[eE]%D+)?))' },
+ ':i' => { pattern => '(?:(?:%T[+-]?)%D+)(?=\s|\0|\z)' },
+ ':n' => { pattern => '(?:(?:%T[+-]?)(?:%D+(?:%T\.%D*)?(?:%T[eE][+-]?%D+)?|%T\.%D+(?:%T[eE][+-]?%D+)?))(?=\s|\0|\z)' },
':s' => { pattern => '(?:%T(?:\S|\0))+(?=\s|\0|\z)' },
- ':qs' => { pattern => q{"(?:\\"|[^"])*"|'(?:\\'|[^'])*'|(?:%T(?:\S|\0))+(?=\s|\0|\z)} },
+ ':qs' => { pattern => q{(?:"(?:\\"|[^"])*"|'(?:\\'|[^'])*'|(?:%T(?:\S|\0))+)(?=\s|\0|\z)} },
':id' => { pattern => '%T[a-zA-Z_](?:%T\w)*(?=\s|\0|\z)' },
- ':if' => { pattern => '%F(?:%T(?:\S|\0))+(?=\s|\0|\z)',
- action => '{reject(!defined $_VAL_ || $_VAL_ ne "-" && ! -r $_VAL_, "in parameter \'$_PARAM_\' (file \"$_VAL_\" is not readable)")}' },
- ':of' => { pattern => '%F(?:%T(?:\S|\0))+(?=\s|\0|\z)',
+ ':if' => { pattern => '(?:%T(?:\S|\0))+(?=\s|\0|\z)',
+ action => '{reject (!defined $_VAL_ || $_VAL_ ne "-" && ! -r $_VAL_, "in parameter \'$_PARAM_\' (file \"$_VAL_\" is not readable)")}' },
+ ':of' => { pattern => '(?:%T(?:\S|\0))+(?=\s|\0|\z)',
action => '{reject (!defined $_VAL_ || $_VAL_ ne "-" && -e $_VAL_ && ! -w $_VAL_ , "in parameter \'$_PARAM_\' (file \"$_VAL_\" is not writable)")}' },
'' => { pattern => ':s', ind => 1 },
-
':+i' => { pattern => ':i',
action => '{reject (!defined $_VAL_ || $_VAL_<=0, "in parameter \'$_PARAM_\' ($_VAR_ must be an integer greater than zero)")}',
ind => 1},
-
':+n' => { pattern => ':n',
action => '{reject (!defined $_VAL_ || $_VAL_<=0, "in parameter \'$_PARAM_\' ($_VAR_ must be a number greater than zero)")}',
ind => 1},
-
':0+i' => { pattern => ':i',
action => '{reject (!defined $_VAL_ || $_VAL_<0, "in parameter \'$_PARAM_\' ($_VAR_ must be an positive integer)")}',
ind => 1},
-
':0+n' => { pattern => ':n',
action => '{reject (!defined $_VAL_ || $_VAL_<0, "in parameter \'$_PARAM_\' ($_VAR_ must be a positive number)")}',
ind => 1},
-
);
}
@@ -131,10 +125,10 @@
sub matcher # ($self, $trailing)
{
my ($self, $trailing) = @_;
+
#WAS: $trailing = $trailing ? '(?!\Q'.$trailing.'\E)' : '';
$trailing = $trailing ? '(?!'.quotemeta($trailing).')' : '';
my $stdtype = stdtype($self->{type});
-
if (!$stdtype && $self->{type} =~ m#\A:/([^/]+)/\Z#) { $stdtype = $1; }
if (!$stdtype)
{
@@ -146,6 +140,8 @@
{
$stdtype = Getopt::Declare::Arg::negflagpat().$stdtype;
}
+ $stdtype = Getopt::Declare::Arg::negflagpat().$stdtype;
+
return "(?:$stdtype)";
}
@@ -178,7 +174,7 @@
sub trailer { '' }; # MEANS TRAILING PARAMETER VARIABLE
-sub ows
+sub ows
{
return '[\s\0]*('.$_[1].')' unless $_[0]->{nows};
return '('.$_[1].')';
@@ -195,7 +191,6 @@
my ($self, $trailing) = @_;
my $suffix = (defined $trailing && !$trailing) ? '([\s\0]+)' : '';
my $scalar = $self->SUPER::matcher($trailing);
-
return $scalar.'(?:[\s\0]+'.$scalar.')*'.$suffix;
}
@@ -204,9 +199,7 @@
my $code = '
$_VAR_ = q|<' . $_[0]->{name} . '>|;
$_VAL_ = undef;
- my @' . $_[0]->{name} . ' =
- map { tr/\0/ /; $_ } split " ", $'.($_[1]+1)."||'';\n";
-
+ my @' . $_[0]->{name} . ' = map { tr/\0/ /; $_ } split " ", $'.($_[1]+1)."||'';\n";
my @actions = Getopt::Declare::ScalarArg::stdactions($_[0]->{type});
if (@actions)
@@ -217,7 +210,7 @@
foreach ( @actions )
{
s/(\s*\{)/$1 package $_[2]; /;
- $code .= "\t\t\tdo $_;\n";
+ $code .= "\n\t\t\tdo $_;\n";
}
$code .= '
}';
@@ -265,7 +258,7 @@
sub trailer { $_[0]->{text} };
-sub ows
+sub ows
{
return '[\s\0]*('.$_[1].')' unless $_[0]->{nows};
return '('.$_[1].')';
@@ -463,15 +456,11 @@
if (@{$self->{args}})
{
- $code .= '
- $_args && $_args =~ m/\G';
-
+ $code .= "\t\t".'$_args && $_args =~ m/\G';
for ($i=0; $i < @{$self->{args}} ; $i++ )
{
- $code .=
- $self->{args}[$i]->ows($self->{args}[$i]->matcher($trailer[$i]))
+ $code .= $self->{args}[$i]->ows($self->{args}[$i]->matcher($trailer[$i]));
}
-
$code .= '/gx' . $nocase . ' or last;'
}
@@ -740,13 +729,12 @@
# VESTIGAL DEBUGGING CODE
- open (CODE, ">.CODE")
- and print CODE $self->code($self->{_internal}{'caller'})
- and close CODE
+ open (CODE, ">.CODE")
+ and print CODE $self->code($self->{_internal}{'caller'})
+ and close CODE
if $::Declare_debug;
# DO THE PARSE (IF APPROPRIATE)
-
if (@_==3) { return undef unless defined $self->parse($_[2]) }
else { return undef unless defined $self->parse(); }
@@ -786,7 +774,7 @@
my ( $self, $source ) = @_;
my $_args = ();
my $_get_nextline = sub { undef };
- if (@_>1)
+ if (@_>1) # if $source was provided
{
if (!defined $source)
{
@@ -863,9 +851,12 @@
return 0 unless defined $_args;
$source = " (in $source)";
}
- else
- {
- foreach (@ARGV) { $_ =~ tr/ \t\n/\0\0\0/; }
+ else # $source was NOT provided
+ {
+ foreach (@ARGV) {
+ # Clean entries: remove spaces, tabs and newlines
+ $_ =~ tr/ \t\n/\0\0\0/;
+ }
$_args = join(' ', @ARGV);
$source = '';
}
@@ -1166,6 +1157,7 @@
{
my $self = shift;
my $package = shift||'main';
+
my $code = q#
do
@@ -1228,7 +1220,7 @@
{
$code .= $arg->code($self,$package);
}
-
+
$code .= q#
if ($_lastprefix)
@@ -1324,6 +1316,7 @@
}
#;
+
}
1;
@@ -1335,8 +1328,8 @@
=head1 VERSION
-This document describes version 1.11 of Getopt::Declare,
-released Feb 4, 2003
+This document describes version 1.12 of Getopt::Declare,
+released Sept 2, 2009
=head1 SYNOPSIS
@@ -1398,11 +1391,14 @@
{ finish }
);
-in which the syntax of each parameter is declared, along with a
-description and (optionally) one or more actions to be performed when
-the parameter is encountered. The specification string may also
-include other usage formatting information (such as group headings or
-separators) as well as standard Perl comments (which are ignored).
+B<Note that in each of the cases above, there is a tab between each
+parameter definition and description (even if you can't see it)!>
+In the specification, the syntax of each parameter is declared,
+along with a description and (optionally) one or more actions to
+be performed when the parameter is encountered. The specification
+string may also include other usage formatting information (such
+as group headings or separators) as well as standard Perl comments
+(which are ignored).
Calling C<Getopt::Delare::new()> parses the contents of the array C<@ARGV>,
extracting any arguments which match the parameters defined in the
@@ -1579,8 +1575,8 @@
ignore bad lines
<outfile>
-Note that each of the above examples has at least one trailing tab
-(even if you can't see them). Note too that this hodge-podge of
+B<Note that each of the above examples has at least one trailing tab
+(even if you can't see them)!>. Note too that this hodge-podge of
parameter styles is certainly not recommended within a single program,
but is shown so as to illustrate some of the range of parameter syntax
conventions F<Getopt::Declare> supports.
@@ -2028,29 +2024,29 @@
which restricts a parameter variable to matching positive, non-zero
numbers (that is, floating point numbers strictly greater than zero).
-=item :0+i
+=item :0+i
which restricts a parameter variable to matching non-negative integers (that
is: 0, 1, 2, 3, etc.)
-=item :0+n
+=item :0+n
which restricts a parameter variable to matching non-negative numbers (that
is, floating point numbers greater than or equal to zero).
-=item :qs
+=item :qs
which allows a parameter variable to match any quote-delimited or
whitespace-terminated string. Note that this specifier simply makes
explicit the default behaviour.
-=item :id
+=item :id
which allows a parameter variable to match any identifier
sequence. That is: a alphabetic or underscore, followed by
zero-or-more alphanumerics or underscores.
-=item :if
+=item :if
which is used to match input file names. Like type ':s', type ':if'
matches any quote-delimited or whitespace-terminated string. However
@@ -2058,13 +2054,13 @@
requires that the matched string is either "-" (indicating standard
input) or the name of a readable file.
-=item :of
+=item :of
which is used to match output file names. It is exactly like type ':if' except
that it requires that the string is either "-" (indicating standard output)
or the name of a file that is either writable or non-existent.
-=item :s
+=item :s
which allows a parameter variable to match any quote-delimited or
whitespace-terminated string. Note that this specifier simply makes
@@ -2120,9 +2116,8 @@
so that it fails if the argument being matched represents some defined
parameter flag. If however the sequence C<%F> appears anywhere in a
pattern, it causes the pattern I<not> to reject strings which would
-otherwise match another flag. For example, the inbuilt types ':if' and
-':of' use C<%F> to enable them to match filenames which happen to be
-identical to parameter flags.
+otherwise match another flag. By default, no inbuilt type allows
+arguments to match a flag.
=back
Modified: branches/upstream/libgetopt-declare-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/test.pl?rev=43579&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/test.pl (original)
+++ branches/upstream/libgetopt-declare-perl/current/test.pl Thu Sep 3 17:56:18 2009
@@ -6,8 +6,9 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-BEGIN { $| = 1; print "1..11\n"; }
+BEGIN { $| = 1; print "1..12\n"; }
END {print "not ok 1\n" unless $loaded;}
+
use Getopt::Declare;
$::loaded = 1;
print "ok 1\n";
@@ -22,16 +23,22 @@
$count++;
}
-sub debug { print @_ if 0 }
+sub debug
+{
+ print @_ if 0;
+}
######################### End of black magic.
- at ARGV = ("bee",'BB BB',
- "-aA", "s e e",
- "remainder",
- '+d', '1', '2', '3', '-1',
- '-yz',
- '+d', '1', '2', '3', '-1', 'a',
+ at ARGV = (
+ 'bee', 'BB BB',
+ '--out', 'dummy.txt',
+ '-aA',
+ 's e e',
+ 'remainder',
+ '+d', '9', '1.2345', '1e3', '2.1E-01', '.3', '-1',
+ '-yz',
+ '+d', '9', '1.2345', '1e3', '2.1E-01', '.3', '-1', 'a',
);
my $args = new Getopt::Declare (q
@@ -56,30 +63,34 @@
{ $_VAL_ = '<undef>' unless defined $_VAL_;
::debug "matched $_PARAM_\t($_VAL_)\n" }
- <d> option 6
+ --out <out:of>... option 6
+ { $_VAL_ = '<undef>' unless defined $_VAL_;
+ ::debug "matched $_PARAM_\t($_VAL_)\n" }
+
+ <d> option 7
{ $_VAL_ = '<undef>' unless defined $_VAL_;
::debug "rejected $_PARAM_\t($_VAL_)\n" }
{ reject }
{ $_VAL_ = '<undef>' unless defined $_VAL_;
::debug "matched $_PARAM_\t($_VAL_)\n" }
- -y option 7
+ -y option 8
{ $_VAL_ = '<undef>' unless defined $_VAL_;
::debug "matched $_PARAM_\t($_VAL_)\n" }
- -z option 8
+ -z option 9
{ $_VAL_ = '<undef>' unless defined $_VAL_;
::debug "matched $_PARAM_\t($_VAL_)\n" }
-
});
ok $args;
-ok $args->{-a} eq "A";
-ok $args->{bee} eq "BB BB";
-ok $args->{"<c>"} eq "s e e";
-ok join(',',@{$args->{'+d'}}) eq '1,2,3,1,2,3';
+ok $args->{'-a'} eq 'A';
+ok $args->{'bee'} eq 'BB BB';
+ok $args->{'<c>'} eq 's e e';
+ok join(',',@{$args->{'+d'}}) eq '9,1.2345,1e3,2.1E-01,.3,9,1.2345,1e3,2.1E-01,.3';
ok !($args->{'<d>'});
ok $args->{'-1'};
+ok ${$args->{'--out'}}[0] eq 'dummy.txt';
ok @ARGV==2;
ok $ARGV[0] eq 'remainder';
ok $ARGV[1] eq 'a';
More information about the Pkg-perl-cvs-commits
mailing list