r17622 - in /branches/upstream/libgetopt-euclid-perl/current: Changes MANIFEST META.yml README lib/Getopt/Euclid.pm t/empty_ARGV_array t/entity_angles.t t/minimal.t t/regex_type.t t/simple.t
roberto at users.alioth.debian.org
roberto at users.alioth.debian.org
Sun Mar 16 04:57:04 UTC 2008
Author: roberto
Date: Sun Mar 16 04:57:03 2008
New Revision: 17622
URL: http://svn.debian.org/wsvn/?sc=1&rev=17622
Log:
[svn-upgrade] Integrating new upstream version, libgetopt-euclid-perl (0.2.0)
Added:
branches/upstream/libgetopt-euclid-perl/current/t/empty_ARGV_array
branches/upstream/libgetopt-euclid-perl/current/t/entity_angles.t
Modified:
branches/upstream/libgetopt-euclid-perl/current/Changes
branches/upstream/libgetopt-euclid-perl/current/MANIFEST
branches/upstream/libgetopt-euclid-perl/current/META.yml
branches/upstream/libgetopt-euclid-perl/current/README
branches/upstream/libgetopt-euclid-perl/current/lib/Getopt/Euclid.pm
branches/upstream/libgetopt-euclid-perl/current/t/minimal.t
branches/upstream/libgetopt-euclid-perl/current/t/regex_type.t
branches/upstream/libgetopt-euclid-perl/current/t/simple.t
Modified: branches/upstream/libgetopt-euclid-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/Changes?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/Changes (original)
+++ branches/upstream/libgetopt-euclid-perl/current/Changes Sun Mar 16 04:57:03 2008
@@ -83,3 +83,18 @@
- Repatched :vars<opt_> mode to really export all args
(thanks again Tim!)
+
+
+0.2.0 Sat Aug 4 17:22:31 2007
+
+ - Added fallback to $main::VERSION if version not specified in Pod
+ (thanks Todd and Thomas)
+
+ - Added non-zero exit value on bad arg list (thanks Toby)
+
+ - Changed module behaviour: now removes identified arguments from @ARGV.
+ on successful match (thanks Aran and Tim)
+
+ - Allowed alternations everywhere (i.e. outside optionals too)
+
+ - Allowed E<lt> and E<gt> in option specifiers (thanks Wes)
Modified: branches/upstream/libgetopt-euclid-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/MANIFEST?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/MANIFEST (original)
+++ branches/upstream/libgetopt-euclid-perl/current/MANIFEST Sun Mar 16 04:57:03 2008
@@ -38,3 +38,5 @@
t/fail_misplaced_type.t
t/fail_type_msg.t
t/regex_type.t
+t/empty_ARGV_array
+t/entity_angles.t
Modified: branches/upstream/libgetopt-euclid-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/META.yml?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/META.yml (original)
+++ branches/upstream/libgetopt-euclid-perl/current/META.yml Sun Mar 16 04:57:03 2008
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Getopt-Euclid
-version: v0.1.0
+version: v0.2.0
version_from: lib/Getopt/Euclid.pm
installdirs: site
requires:
Modified: branches/upstream/libgetopt-euclid-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/README?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/README (original)
+++ branches/upstream/libgetopt-euclid-perl/current/README Sun Mar 16 04:57:03 2008
@@ -1,4 +1,4 @@
-Getopt::Euclid version 0.1.0
+Getopt::Euclid version 0.2.0
Getopt::Euclid uses your program's own documentation to create a com-
mand-line argument parser. This ensures that your program's documented
Modified: branches/upstream/libgetopt-euclid-perl/current/lib/Getopt/Euclid.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/lib/Getopt/Euclid.pm?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/lib/Getopt/Euclid.pm (original)
+++ branches/upstream/libgetopt-euclid-perl/current/lib/Getopt/Euclid.pm Sun Mar 16 04:57:03 2008
@@ -1,6 +1,6 @@
package Getopt::Euclid;
-use version; $VERSION = qv('0.1.0');
+use version; $VERSION = qv('0.2.0');
use warnings;
use strict;
@@ -79,6 +79,10 @@
open my $fh, '<', $0
or croak "Getopt::Euclid was unable to access POD\n($!)\nProblem was";
my $source = do{ local $/; <$fh>};
+
+ # Clean up significant entities...
+ $source =~ s{ E<lt> }{<}gxms;
+ $source =~ s{ E<gt> }{>}gxms;
# Set up parsing rules...
my $HWS = qr{ [^\S\n]* }xms;
@@ -115,7 +119,11 @@
my ($prog_name) = (splitpath($0))[-1];
my ($version)
- = $pod =~ m/^=head1 $VERS .*? (\d+(?:[._]\d+)+) .*? $EOHEAD /xms;
+ = $pod =~ m/^=head1 $VERS .*? (\d+(?:[._]\d+)+) .*? $EOHEAD /xms;
+ if ( !defined $version ) {
+ $version = $main::VERSION;
+ }
+
my ($opt_name, $options)
= $pod =~ m/^=head1 ($OPTIONS) (.*?) $EOHEAD /xms;
@@ -259,7 +267,7 @@
}
elsif ($field eq 'type') {
my ($matchtype, $comma, $constraint)
- = $val =~ m/([^,\s]+)\s*(?:(,))?\s*(.*)/xms;
+ = $val =~ m{(/(?:\.|.)+/ | [^,\s]+)\s*(?:(,))?\s*(.*)}xms;
$arg->{var}{$var}{type} = $matchtype;
if ($comma && length $constraint) {
@@ -364,7 +372,7 @@
$msg =~ tr/\0\1/ \t/;
$msg =~ s/\n?\z/\n/xms;
warn "$msg(Try: $prog_name --help)\n\n";
- exit;
+ exit 2; # Traditional "bad arg list" value
};
# Run matcher...
@@ -394,7 +402,9 @@
_verify_args($all_args_ref);
- # Clean up %ARGV...
+ # Clean up @ARGV and %ARGV...
+
+ @ARGV = (); # Everything must have been parsed, so nothign left
for my $arg_name (keys %ARGV) {
# Flatten non-repeatables...
@@ -671,7 +681,9 @@
my $regex = $arg_name;
# Quotemeta specials...
- $regex =~ s{([@#$^*()+{}?|])}{\\$1}gxms;
+ $regex =~ s{([@#$^*()+{}?])}{\\$1}gxms;
+
+ $regex = "(?:$regex)";
# Convert optionals...
1 while $regex =~ s/ \[ ([^]]*) \] /(?:$1)?/gxms;
@@ -743,8 +755,20 @@
exit;
}
+my $OPTIONAL;
+
+BEGIN {
+ $OPTIONAL = qr{ \[ [^[]* (?: (??{$OPTIONAL}) [^[]* )* \] }xms;
+}
+
sub _get_variants {
- my @arg_desc = @_;
+ my @arg_desc = shift =~ m{ [^[|]+ (?: $OPTIONAL [^[|]* )* }gmxs;
+
+ for (@arg_desc) {
+ s{^ \s+ | \s+ $}{}gxms;
+ }
+
+ $DB::single = 1;
# Only consider first "word"...
return $1 if $arg_desc[0] =~ m/\A (< [^>]+ >)/xms;
@@ -760,11 +784,11 @@
if ($arg_desc_without =~ s/ \[ [^][]* \] //xms) {
push @arg_desc, $arg_desc_without;
}
- if ($arg_desc_with =~ m/ \[ ([^][]*) \] /xms) {
+ if ($arg_desc_with =~ m/ [[(] ([^][()]*) [])] /xms) {
my $option = $1;
for my $alternative ( split /\|/, $option ) {
my $arg_desc = $arg_desc_with;
- $arg_desc =~ s{\[ ([^][]*) \]}{$alternative}xms;
+ $arg_desc =~ s{[[(] [^][()]* [])]}{$alternative}xms;
push @arg_desc, $arg_desc;
}
}
@@ -803,7 +827,7 @@
=head1 VERSION
-This document describes Getopt::Euclid version 0.1.0
+This document describes Getopt::Euclid version 0.2.0
=head1 SYNOPSIS
@@ -936,7 +960,7 @@
=item 4.
-parse the contents of C<@ARGV> using that parser, and
+remove the command-line arguments from C<@ARGV> and parse them, and
=item 5.
@@ -1109,14 +1133,13 @@
=item *
-A vertical bar within an optional component indicates an alternative.
-Note that such vertical bars may only appear within square brackets.
+A vertical bar indicates the start of an alternative variant of the argument.
=back
For example, the argument specification:
- =item -i[n] [=] <file>
+ =item -i[n] [=] <file> | --from <file>
indicates that any of the following may appear on the command-line:
@@ -1124,10 +1147,17 @@
-indata.txt -in data.txt -in=data.txt -in = data.txt
+ --from data.text
+
as well as any other combination of whitespacing.
-Any of the above variations would cause both C<$ARGV{'-i'}> and C<$ARGV{'-
-in'}> to be set to the string C<'data.txt'>.
+Any of the above variations would cause all three of:
+
+ $ARGV{'-i'}
+ $ARGV{'-in'}
+ $ARGV{'--from'}
+
+to be set to the string C<'data.txt'>.
You could allow the optional C<=> to also be an optional colon by specifying:
@@ -1757,7 +1787,7 @@
=item Missing required argument(s): %s
-One or more arguments specified in the C<REQUIRED ARGUMENTS> POD section
+At least one argument specified in the C<REQUIRED ARGUMENTS> POD section
wasn't present on the command-line.
@@ -1771,7 +1801,8 @@
=item Unknown argument: %s
Getopt::Euclid didn't recognize an argument you were trying to specify on the
-command-line. This is often caused by command-line typos.
+command-line. This is often caused by command-line typos or an incomplete
+interface specification.
=back
Added: branches/upstream/libgetopt-euclid-perl/current/t/empty_ARGV_array
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/t/empty_ARGV_array?rev=17622&op=file
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/t/empty_ARGV_array (added)
+++ branches/upstream/libgetopt-euclid-perl/current/t/empty_ARGV_array Sun Mar 16 04:57:03 2008
@@ -1,0 +1,148 @@
+BEGIN {
+ $INFILE = $0;
+ $OUTFILE = $0;
+ $LEN = 42;
+ $H = 2;
+ $W = -10;
+ $TIMEOUT = 7;
+
+ @ARGV = (
+ "-i $INFILE",
+ "-out=", $OUTFILE,
+ "-lgth $LEN",
+ "size ${H}x${W}",
+ '-v',
+ "--timeout $TIMEOUT",
+ '-w', 's p a c e s',
+ 7,
+ );
+}
+
+sub lucky {
+ my ($num) = @_;
+ return $num == 7;
+}
+
+use Getopt::Euclid;
+
+use Test::More 'no_plan';
+
+sub got_arg {
+ my ($key, $val) = @_;
+ is $ARGV{$key}, $val, "Got expected value for $key";
+}
+
+is_deeply \@ARGV, [] => '@ARGV emptied on success';
+
+__END__
+
+=head1 NAME
+
+orchestrate - Convert a file to Melkor's .orc format
+
+=head1 VERSION
+
+This documentation refers to orchestrate version 1.9.4
+
+=head1 USAGE
+
+ orchestrate -in source.txt --out dest.orc -verbose -len=24
+
+=head1 REQUIRED ARGUMENTS
+
+=over
+
+=item -i[nfile] [=]<file>
+
+Specify input file
+
+=for Euclid:
+ file.type: readable
+ file.default: '-'
+
+=item -o[ut][file]= <out_file>
+
+Specify output file
+
+=for Euclid:
+ out_file.type: writable
+ out_file.default: '-'
+
+=back
+
+=head1 OPTIONS
+
+=over
+
+=item size <h>x<w>
+
+Specify height and width
+
+=item -l[[en][gth]] <l>
+
+Display length [default: 24 ]
+
+=for Euclid:
+ l.type: int > 0
+ l.default: 24
+
+=item -girth <g>
+
+Display girth [default: 42 ]
+
+=for Euclid:
+ g.default: 42
+
+=item -v[erbose]
+
+Print all warnings
+
+=item --timeout [<min>] [<max>]
+
+=for Euclid:
+ min.type: int
+ max.type: int
+ max.default: -1
+
+=item -w <space>
+
+Test something spaced
+
+=item <step>
+
+Step size
+
+=for Euclid:
+ step.type: int, lucky(step)
+
+=item --version
+
+=item --usage
+
+=item --help
+
+=item --man
+
+Print the usual program information
+
+=back
+
+=begin remainder of documentation here...
+
+=end
+
+=head1 AUTHOR
+
+Damian Conway (damian at conway.org)
+
+=head1 BUGS
+
+There are undoubtedly serious bugs lurking somewhere in this code.
+Bug reports and other feedback are most welcome.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2002, Damian Conway. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the terms of the Perl Artistic License
+ (see http://www.perl.com/perl/misc/Artistic.html)
Added: branches/upstream/libgetopt-euclid-perl/current/t/entity_angles.t
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/t/entity_angles.t?rev=17622&op=file
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/t/entity_angles.t (added)
+++ branches/upstream/libgetopt-euclid-perl/current/t/entity_angles.t Sun Mar 16 04:57:03 2008
@@ -1,0 +1,179 @@
+BEGIN {
+ $INFILE = $0;
+ $OUTFILE = $0;
+ $LEN = 42;
+ $H = 2;
+ $W = -10;
+ $TIMEOUT = 7;
+
+ @ARGV = (
+ "-i $INFILE",
+ "-out=", $OUTFILE,
+ "-lgth $LEN",
+ "size ${H}x${W}",
+ '-v',
+ "--timeout $TIMEOUT",
+ '--with', 's p a c e s',
+ 7,
+ );
+}
+
+sub lucky {
+ my ($num) = @_;
+ return $num == 7;
+}
+
+use Getopt::Euclid;
+
+use Test::More 'no_plan';
+
+sub got_arg {
+ my ($key, $val) = @_;
+ is $ARGV{$key}, $val, "Got expected value for $key";
+}
+
+is keys %ARGV, 18 => 'Right number of args returned';
+
+got_arg -i => $INFILE;
+got_arg -infile => $INFILE;
+
+got_arg -l => $LEN;
+got_arg -len => $LEN;
+got_arg -length => $LEN;
+got_arg -lgth => $LEN;
+
+got_arg -girth => 42;
+
+got_arg -o => $OUTFILE;
+got_arg -ofile => $OUTFILE;
+got_arg -out => $OUTFILE;
+got_arg -outfile => $OUTFILE;
+
+got_arg -v => 1,
+got_arg -verbose => 1,
+
+is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout';
+is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout <min>';
+is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout <max>';
+
+is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size';
+is $ARGV{size}{h}, $H => 'Got expected value for size <h>';
+is $ARGV{size}{w}, $W => 'Got expected value for size <w>';
+
+is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly';
+is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly';
+
+is $ARGV{'<step>'}, 7 => 'Handled step size correctly';
+
+__END__
+
+=head1 NAME
+
+orchestrate - Convert a file to Melkor's .orc format
+
+=head1 VERSION
+
+This documentation refers to orchestrate version 1.9.4
+
+=head1 USAGE
+
+ orchestrate -in source.txt --out dest.orc -verbose -len=24
+
+=head1 REQUIRED ARGUMENTS
+
+=over
+
+=item -i[nfile] [=]E<lt>fileE<gt>
+
+Specify input file
+
+=for Euclid:
+ file.type: readable
+ file.default: '-'
+
+=item -o[ut][file]= E<lt>out_fileE<gt>
+
+Specify output file
+
+=for Euclid:
+ out_file.type: writable
+ out_file.default: '-'
+
+=back
+
+=head1 OPTIONS
+
+=over
+
+=item size E<lt>hE<gt>xE<lt>wE<gt>
+
+Specify height and width
+
+=item -l[[en][gth]] E<lt>lE<gt>
+
+Display length [default: 24 ]
+
+=for Euclid:
+ l.type: int > 0
+ l.default: 24
+
+=item -girth E<lt>gE<gt>
+
+Display girth [default: 42 ]
+
+=for Euclid:
+ g.default: 42
+
+=item -v[erbose]
+
+Print all warnings
+
+=item --timeout [E<lt>minE<gt>] [E<lt>maxE<gt>]
+
+=for Euclid:
+ min.type: int
+ max.type: int
+ max.default: -1
+
+=item -w E<lt>spaceE<gt> | --with E<lt>spaceE<gt>
+
+Test something spaced
+
+=item E<lt>stepE<gt>
+
+Step size
+
+=for Euclid:
+ step.type: int, lucky(step)
+
+=item --version
+
+=item --usage
+
+=item --help
+
+=item --man
+
+Print the usual program information
+
+=back
+
+=begin remainder of documentation here...
+
+=end
+
+=head1 AUTHOR
+
+Damian Conway (damian at conway.org)
+
+=head1 BUGS
+
+There are undoubtedly serious bugs lurking somewhere in this code.
+Bug reports and other feedback are most welcome.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2002, Damian Conway. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the terms of the Perl Artistic License
+ (see http://www.perl.com/perl/misc/Artistic.html)
Modified: branches/upstream/libgetopt-euclid-perl/current/t/minimal.t
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/t/minimal.t?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/t/minimal.t (original)
+++ branches/upstream/libgetopt-euclid-perl/current/t/minimal.t Sun Mar 16 04:57:03 2008
@@ -141,7 +141,7 @@
Automaticaly fudge the factors.
=for Euclid:
- false: --no[-fudge]
+ false: [-]-no[-fudge]
=item <step>
Modified: branches/upstream/libgetopt-euclid-perl/current/t/regex_type.t
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/t/regex_type.t?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/t/regex_type.t (original)
+++ branches/upstream/libgetopt-euclid-perl/current/t/regex_type.t Sun Mar 16 04:57:03 2008
@@ -1,6 +1,7 @@
BEGIN {
@ARGV = (
"-h=hostname1234",
+ "-dim=3,4",
);
}
@@ -15,6 +16,7 @@
is $ARGV{'-h'}{dev}, 'hostname' => 'Got expected value for -h <dev>';
is $ARGV{'-h'}{port}, 1234 => 'Got expected value for -h <port>';
+is $ARGV{'-dim'}, '3,4' => 'Got expected value for -dim';
__END__
@@ -39,8 +41,13 @@
Specify device/port
=for Euclid:
- dev.type: /[^:]+\D/
+ dev.type: /[^:\s\d]+\D/
port.type: /\d+/
+
+=item -dim=<dim>
+
+=for Euclid:
+ dim.type: /\d+,\d+/
=back
Modified: branches/upstream/libgetopt-euclid-perl/current/t/simple.t
URL: http://svn.debian.org/wsvn/branches/upstream/libgetopt-euclid-perl/current/t/simple.t?rev=17622&op=diff
==============================================================================
--- branches/upstream/libgetopt-euclid-perl/current/t/simple.t (original)
+++ branches/upstream/libgetopt-euclid-perl/current/t/simple.t Sun Mar 16 04:57:03 2008
@@ -13,7 +13,7 @@
"size ${H}x${W}",
'-v',
"--timeout $TIMEOUT",
- '-w', 's p a c e s',
+ '--with', 's p a c e s',
7,
);
}
@@ -32,7 +32,7 @@
is $ARGV{$key}, $val, "Got expected value for $key";
}
-is keys %ARGV, 17 => 'Right number of args returned';
+is keys %ARGV, 18 => 'Right number of args returned';
got_arg -i => $INFILE;
got_arg -infile => $INFILE;
@@ -60,7 +60,8 @@
is $ARGV{size}{h}, $H => 'Got expected value for size <h>';
is $ARGV{size}{w}, $W => 'Got expected value for size <w>';
-is $ARGV{-w}, 's p a c e s' => 'Handled spaces correctly';
+is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly';
+is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly';
is $ARGV{'<step>'}, 7 => 'Handled step size correctly';
@@ -134,7 +135,7 @@
max.type: int
max.default: -1
-=item -w <space>
+=item -w <space> | --with <space>
Test something spaced
More information about the Pkg-perl-cvs-commits
mailing list