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