r54996 - in /branches/upstream/libgetopt-declare-perl/current: ./ demos/ lib/Getopt/ t/

nhandler-guest at users.alioth.debian.org nhandler-guest at users.alioth.debian.org
Mon Mar 29 02:28:00 UTC 2010


Author: nhandler-guest
Date: Mon Mar 29 02:27:55 2010
New Revision: 54996

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54996
Log:
[svn-upgrade] Integrating new upstream version, libgetopt-declare-perl (1.13)

Added:
    branches/upstream/libgetopt-declare-perl/current/META.yml
    branches/upstream/libgetopt-declare-perl/current/demos/
    branches/upstream/libgetopt-declare-perl/current/demos/demo_cmdline   (with props)
    branches/upstream/libgetopt-declare-perl/current/demos/demo_csv   (with props)
    branches/upstream/libgetopt-declare-perl/current/demos/demo_interp   (with props)
    branches/upstream/libgetopt-declare-perl/current/demos/demo_shell   (with props)
    branches/upstream/libgetopt-declare-perl/current/t/
    branches/upstream/libgetopt-declare-perl/current/t/test.t   (with props)
Removed:
    branches/upstream/libgetopt-declare-perl/current/demo_cmdline
    branches/upstream/libgetopt-declare-perl/current/demo_csv
    branches/upstream/libgetopt-declare-perl/current/demo_interp
    branches/upstream/libgetopt-declare-perl/current/demo_shell
    branches/upstream/libgetopt-declare-perl/current/test.pl
Modified:
    branches/upstream/libgetopt-declare-perl/current/Changes
    branches/upstream/libgetopt-declare-perl/current/MANIFEST
    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

Modified: branches/upstream/libgetopt-declare-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/Changes?rev=54996&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/Changes (original)
+++ branches/upstream/libgetopt-declare-perl/current/Changes Mon Mar 29 02:27:55 2010
@@ -115,7 +115,6 @@
 	- Added AUTOLOAD to delegate embedded sub calls back to main 
 
 
-
 1.11	Tue Feb  3 20:44:26 2004
 
 	- Fixed bug in multi-argument parameters
@@ -134,3 +133,11 @@
 
 	- Added emphasis in the documentation on the need for tabs in the
 	  specification
+
+
+1.13	Sun Mar 28 16:35:18 2010
+
+	- Fixed the support for IO::Pager
+
+  - Improved unit testing with Test::More
+

Modified: branches/upstream/libgetopt-declare-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/MANIFEST?rev=54996&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/MANIFEST (original)
+++ branches/upstream/libgetopt-declare-perl/current/MANIFEST Mon Mar 29 02:27:55 2010
@@ -1,9 +1,11 @@
 Changes
+demos/demo_cmdline
+demos/demo_csv
+demos/demo_interp
+demos/demo_shell
+lib/Getopt/Declare.pm
+Makefile.PL
 MANIFEST
-Makefile.PL
-demo_csv
-demo_interp
-demo_shell
-demo_cmdline
-lib/Getopt/Declare.pm
-test.pl
+README
+t/test.t
+META.yml                                 Module meta-data (added by MakeMaker)

Added: branches/upstream/libgetopt-declare-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/META.yml?rev=54996&op=file
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/META.yml (added)
+++ branches/upstream/libgetopt-declare-perl/current/META.yml Mon Mar 29 02:27:55 2010
@@ -1,0 +1,21 @@
+--- #YAML:1.0
+name:               Getopt-Declare
+version:            1.13
+abstract:           ~
+author:  []
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
+requires:
+    Text::Balanced:  0
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

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=54996&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/Makefile.PL (original)
+++ branches/upstream/libgetopt-declare-perl/current/Makefile.PL Mon Mar 29 02:27:55 2010
@@ -2,7 +2,6 @@
 use ExtUtils::MakeMaker;
 WriteMakefile(
 		NAME	=> q[Getopt::Declare],
-		VERSION => q[1.12],
-                PREREQ_PM => { 'Text::Balanced'=> 0 },
-
-	     );
+		VERSION => q[1.13],
+    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=54996&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/README (original)
+++ branches/upstream/libgetopt-declare-perl/current/README Mon Mar 29 02:27:55 2010
@@ -1,5 +1,5 @@
 ==============================================================================
-                  Release of version 1.12 of Getopt::Declare
+                  Release of version 1.13 of Getopt::Declare
 ==============================================================================
 
 
@@ -86,11 +86,11 @@
 
 ==============================================================================
 
-CHANGES IN VERSION 1.12
+CHANGES IN VERSION 1.13
 
 
-	- Bug fixes for parsing decimal numbers and lists of files
-
+	- Bug fix for the use of IO::Pager
+  - Unit testing uses Test::More now
 
 ==============================================================================
 

Added: branches/upstream/libgetopt-declare-perl/current/demos/demo_cmdline
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/demos/demo_cmdline?rev=54996&op=file
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/demos/demo_cmdline (added)
+++ branches/upstream/libgetopt-declare-perl/current/demos/demo_cmdline Mon Mar 29 02:27:55 2010
@@ -1,0 +1,81 @@
+#! /usr/local/bin/perl -w
+
+use Getopt::Declare;
+
+$VERSION = "1.00b";
+
+my $config;
+
+$config = new Getopt::Declare( <<'EOCONFIG', [-CONFIG]);
+	[strict]
+	min = <n>	Minimum value [required]
+	max = <n>	Maximum value
+
+EOCONFIG
+
+print "min: ", $config->{min}{'<n>'}, "\n" if $config->{min};
+print "max: ", $config->{max}{'<n>'}, "\n" if $config->{max};
+
+$args = new Getopt::Declare <<'EOARGS';
+($0 version $VERSION)
+General options:
+
+        -e <f:i>..<t:i> Set expansion factor to specified range
+                        [requires: <file>]
+                                { print "k = [$f..$t]\n"; }
+
+        -e [<k:n>...]   Set expansion factor to <k> (or 2 by default)
+                        [required]
+                                { @k = (2) unless @k;
+                                  print "k = [", join(',', @k), "]\n"; }
+
+
+        -b <blen:i>     Use byte length of <blen> 
+                        [excludes: -a +c]
+                                { print "byte len: $blen\n"; }
+
+        <file>...       Process files [required] [implies: -a]
+                                { print "files: \@file\n"; }
+
+        -a [<N:n>]      Process all data [except item <N>]
+                                { print "proc all\n"; print "except $N\n" if $N; }
+
+        -fab            The fabulous option (is always required :-)
+                        [required]
+                                { defer { print "fabulous!\n" } }
+
+File creation options:
+
+        +c <file>       Create file [mutex: +c -a]
+                                { print "create: $file\n"; }
+
+        +d <file>       Duplicate file [implies: -a and -b 8]
+                        This is a second line
+                                { print "dup (+d) $file\n"; }
+        --dup <file>    [ditto] (long form)
+#                               { print "dup (--dup) $file\n"; }
+
+        -how <N:i>      Set height to <N>       [repeatable]
+
+Garbling options:
+
+        -g [<seed:i>]   Garble output with optional seed [requires: +c]
+                                { print "garbling with $seed\n"; }
+
+        -i              Case insensitive garbling [required]
+                                { print "insensitive\n"; }
+        -s              Case sensitive garbling 
+        -w              WaReZ m0De 6aRBL1N6 
+
+        [mutex: -i -s -w]
+EOARGS
+
+print "Unused:\n" if @ARGV;
+foreach ( @ARGV )
+{
+        print "\t[$_]\n";
+}
+
+#$args->debug();
+#$args->usage();
+__END__

Propchange: branches/upstream/libgetopt-declare-perl/current/demos/demo_cmdline
------------------------------------------------------------------------------
    svn:executable = *

Added: branches/upstream/libgetopt-declare-perl/current/demos/demo_csv
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/demos/demo_csv?rev=54996&op=file
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/demos/demo_csv (added)
+++ branches/upstream/libgetopt-declare-perl/current/demos/demo_csv Mon Mar 29 02:27:55 2010
@@ -1,0 +1,54 @@
+#!/usr/local/bin/perl -w
+
+
+use Getopt::Declare;
+
+my $args = new Getopt::Declare <<EOARGS;
+	-f <filename:if>	Parse file <filename>
+EOARGS
+
+ at students = ();
+ at absent = ();
+
+$data = q{
+	absmith,1234567,20
+	"aesmith, the other one",7635656,DNS
+	cat,dog,22.2
+	7637843,dejones,66.7
+	rmwilliams,288721,88
+	help me,I'm trapped,in the marks system
+	vtthan,872829,94
+};
+
+my $csv = <<'EOCSV';
+	<name:qs> , <id:+i> , <score:0+n>	STD FORMAT [repeatable]
+		{ push @::students, {name=>$name, id=>$id, score=>$score} }
+
+	<id:+i> , <name:qs> , <score:0+n>	VARIANT FORMAT [repeatable]
+		{ push @::students, {name=>$name, id=>$id, score=>$score} }
+
+	<name:qs> , <id:+i> , DNS		DID NOT SIT [repeatable]
+		{ push @::absent, {name=>$name, id=>$id, score=>0} }
+
+	<other:/.+/>				SOMETHING ELSE [repeatable]
+		{ print "Unknown entry format: [$other]\n"; }
+EOCSV
+
+if ($args->{"-f"})
+{
+	my $args = new Getopt::Declare ($csv,[$args->{"-f"}]);
+}
+else
+{
+	my $args = new Getopt::Declare ($csv,$data);
+}
+
+foreach ( @students )
+{
+	print "$_->{id} ($_->{name}):	$_->{score}\n";
+}
+
+foreach ( @absent )
+{
+	print "$_->{id} ($_->{name}):	ABSENT\n";
+}

Propchange: branches/upstream/libgetopt-declare-perl/current/demos/demo_csv
------------------------------------------------------------------------------
    svn:executable = *

Added: branches/upstream/libgetopt-declare-perl/current/demos/demo_interp
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/demos/demo_interp?rev=54996&op=file
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/demos/demo_interp (added)
+++ branches/upstream/libgetopt-declare-perl/current/demos/demo_interp Mon Mar 29 02:27:55 2010
@@ -1,0 +1,41 @@
+#!/usr/local/bin/perl -w
+
+use Getopt::Declare;
+use vars qw{ $name $result $n };
+
+my $interpolator = new Getopt::Declare (<<'EOCMDS',[-BUILD]);
+	[cluster:none]
+	[repeatable]
+	[pvtype: NOTDELIM /(?:%T.)+/ ]
+	[pvtype: WS   /\s+/ ]
+
+	\{{ <cmd:NOTDELIM> }}[<ws:WS>]	
+			{ $self->{result} .= eval "no strict; $cmd"||'';
+			  $self->{result} .= $ws if $ws; }
+
+	<str>[<ws:WS>]	
+			{ $self->{result} .= $str;
+			  $self->{result} .= $ws if $ws; }
+EOCMDS
+
+sub interpolate($)
+{
+	$interpolator->{result} = '';
+	$interpolator->parse($_[0]);
+	return $interpolator->{result};
+}
+
+
+$result = 22;
+$name = "Sam";
+$n = 50;
+sub average
+{
+	my ($sum, $count) = (0,0);
+	foreach ( @_ ) { $sum += $_; $count++; }
+	return $count ? $sum/$count : 0;
+}
+
+print interpolate('The person {{$name}} scored {{$result}}'), "\n";
+print interpolate('The pass mark was {{$result * 2}}'), "\n";
+print interpolate('The average of the first {{2*$n}} numbers is {{average 1..2*$n}}'), "\n";

Propchange: branches/upstream/libgetopt-declare-perl/current/demos/demo_interp
------------------------------------------------------------------------------
    svn:executable = *

Added: branches/upstream/libgetopt-declare-perl/current/demos/demo_shell
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/demos/demo_shell?rev=54996&op=file
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/demos/demo_shell (added)
+++ branches/upstream/libgetopt-declare-perl/current/demos/demo_shell Mon Mar 29 02:27:55 2010
@@ -1,0 +1,36 @@
+#!/usr/local/bin/perl -w
+
+
+use Getopt::Declare;
+
+my $shell_cmds = <<'EOCMDS';
+Commands: [repeatable]
+
+	echo [-n] <words:/.*/>	ECHO WITHOUT NEWLINE 
+			{ print $words; print "\n" unless $_PUNCT_{'-n'}; }
+
+	[pvtype: chwho /u?g?a?/]
+	[pvtype: chwhat /r?w?x?/]
+
+	chmod [-R] <who:chwho>=<what:chwhat> <files>...	
+				CHANGE FILE PERMISSIONS 
+			{ foreach (@files) { print "chmod $who=$what $_\n"; }
+			}
+
+	help			SHOW THIS SUMMARY 
+			{ $self->usage() }
+
+	exit			EXIT SHELL 
+			{ exit }
+
+	<error:/.*/>	 
+			{ print "Unknown command: $error\n";
+			  print "(Try the 'help' command?)\n"; }
+EOCMDS
+
+my $shell = new Getopt::Declare ($shell_cmds,[-BUILD]);
+
+my $count = 1;
+sub prompt { print "$count> "; $count++; return <STDIN> }
+
+$shell->parse(\&prompt);

Propchange: branches/upstream/libgetopt-declare-perl/current/demos/demo_shell
------------------------------------------------------------------------------
    svn:executable = *

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=54996&op=diff
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/lib/Getopt/Declare.pm (original)
+++ branches/upstream/libgetopt-declare-perl/current/lib/Getopt/Declare.pm Mon Mar 29 02:27:55 2010
@@ -5,7 +5,7 @@
 use UNIVERSAL qw(isa);
 use Carp;
 
-$VERSION = '1.12';
+$VERSION = '1.13';
 
 sub import {
 	my ($class, $defn) = @_;
@@ -1005,16 +1005,37 @@
 
 sub version
 {
+	my ($self, $exit_status) = @_;
 	# my $filedate = localtime(time - 86400 * -M $0);
 	my $filedate = localtime((stat $0)[9]);
 	if ($::VERSION) { print "\n\t$0: version $::VERSION  ($filedate)\n\n" }
-	else		{ print "\n\t$0: version dated $filedate\n\n" }
-	exit $_[1] if defined $_[1];
+	else { print "\n\t$0: version dated $filedate\n\n" }
+	exit $exit_status if defined $exit_status;
+  return 1;
 }
 
 sub usage
 {
-	my $self = $_[0];
+	my ($self, $exit_status) = @_;
+	if (eval { require IO::Pager })
+	{
+		new IO::Pager; # use a pager for all print() statements
+	}
+	print $self->usage_string;
+	if (eval { require IO::Pager })
+	{
+		close; # done using the pager
+	}
+	if (defined $exit_status)
+	{
+		exit $exit_status;
+	}
+	return 1;
+}
+
+sub usage_string
+{
+	my $self = shift;
 	local $_ = $self->{_internal}{usage};
 	
 	my $lastflag = undef;
@@ -1074,7 +1095,6 @@
 
 			next;
 		};
-
 
 	# OTHERWISE, DECORATION
 		if (s/((?:(?!\[\s*pvtype:).)*)(\n|(?=\[\s*pvtype:))//)
@@ -1105,24 +1125,17 @@
 	my $helpcmd = Getopt::Declare::Arg::besthelp;
 	my $versioncmd = Getopt::Declare::Arg::bestversion;
 
-	my $PAGER = \*STDOUT;
-
-	if (eval { require IO::Pager })
-	{
-		$PAGER = new IO::Pager ( resume => 1 );
-	}
-
-	unless ($self->{_internal}{source})
-	{
-		print $PAGER  "\nUsage: $0 [options] $required\n";
-		print $PAGER  "       $0 $helpcmd\n" if $helpcmd;
-		print $PAGER  "       $0 $versioncmd\n" if $versioncmd;
-		print $PAGER  "\n" unless $decfirst && $usage =~ /\A[ \t]*\n/;
-	}
-	print $PAGER  "Options:\n" unless $decfirst;
-	print $PAGER  $usage;
-
-	exit $_[1] if defined $_[1];
+  my $msg = '';
+  unless ($self->{_internal}{source})
+	{
+		$msg .= "\nUsage: $0 [options] $required\n";
+		$msg .= "       $0 $helpcmd\n" if $helpcmd;
+		$msg .= "       $0 $versioncmd\n" if $versioncmd;
+		$msg .= "\n" unless $decfirst && $usage =~ /\A[ \t]*\n/;
+	}
+	$msg .= "Options:\n" unless $decfirst;
+  $msg .= $usage;
+  return $msg;
 }
 
 sub unused {
@@ -1328,8 +1341,7 @@
 
 =head1 VERSION
 
-This document describes version 1.12 of Getopt::Declare,
-released Sept 2, 2009
+This document describes version 1.13 of Getopt::Declare, released Mar 28, 2010
 
 =head1 SYNOPSIS
 
@@ -2708,6 +2720,7 @@
 Note that the operators C<&&>, C<||>, and C<!> retain their normal
 Perl precedences.
 
+=back
 
 =head2 Parsing from other sources
 

Added: branches/upstream/libgetopt-declare-perl/current/t/test.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgetopt-declare-perl/current/t/test.t?rev=54996&op=file
==============================================================================
--- branches/upstream/libgetopt-declare-perl/current/t/test.t (added)
+++ branches/upstream/libgetopt-declare-perl/current/t/test.t Mon Mar 29 02:27:55 2010
@@ -1,0 +1,75 @@
+#!perl
+
+use lib 'lib';
+use strict;
+use warnings;
+use Test::More tests => 15;
+
+BEGIN { use_ok( 'Getopt::Declare' ); }
+
+my $spec = q{
+	-a <aval>		option 1
+				{ $_VAL_ = '<undef>' unless defined $_VAL_;
+				  ::debug "matched $_PARAM_\t($_VAL_)\n" }
+	bee <bval:qs>		option 2
+				{ $_VAL_ = '<undef>' unless defined $_VAL_;
+				  ::debug "matched $_PARAM_\t($_VAL_)\n" }
+	<c>			option 3
+				{ $_VAL_ = '<undef>' unless defined $_VAL_;
+				  ::debug "matched $_PARAM_\t($_VAL_)\n" }
+	+d <dval:n>...		option 4 [repeatable]
+				{ $_VAL_ = '<undef>' unless defined $_VAL_;
+				  ::debug "matched $_PARAM_\t($_VAL_)\n" }
+	-1			option 5
+				{ $_VAL_ = '<undef>' unless defined $_VAL_;
+				  ::debug "matched $_PARAM_\t($_VAL_)\n" }
+	--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 8
+				{ $_VAL_ = '<undef>' unless defined $_VAL_;
+				  ::debug "matched $_PARAM_\t($_VAL_)\n" }
+	-z			option 9
+				{ $_VAL_ = '<undef>' unless defined $_VAL_;
+				  ::debug "matched $_PARAM_\t($_VAL_)\n" }
+};
+
+ 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',
+	);
+
+ok my $args = Getopt::Declare->new($spec), 'new';
+isa_ok $args, 'Getopt::Declare';
+ok $args->version, 'version';
+ok $args->usage, 'usage';
+is $args->{'-a'}, 'A', 'Argument parsing';
+is $args->{'bee'}, 'BB BB';
+is $args->{'<c>'}, 's e e';
+is join(',',@{$args->{'+d'}}), '9,1.2345,1e3,2.1E-01,.3,9,1.2345,1e3,2.1E-01,.3';
+is $args->{'<d>'}, undef;
+is $args->{'-1'}, -1;
+is ${$args->{'--out'}}[0], 'dummy.txt';
+is scalar @ARGV, 2;
+is $ARGV[0], 'remainder';
+is $ARGV[1], 'a';
+
+#done_testing();
+
+sub debug
+{
+        print @_ if 0;
+}
+

Propchange: branches/upstream/libgetopt-declare-perl/current/t/test.t
------------------------------------------------------------------------------
    svn:executable = *




More information about the Pkg-perl-cvs-commits mailing list