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