This is an automated email from the git hooks/post-receive script. gregoa pushed a commit to branch master in repository libgetopt-euclid-perl.
commit 1c397af505a62f4f107fc08dd858fd311c3493cd Author: gregor herrmann <[email protected]> Date: Tue May 6 19:18:24 2014 +0200 Imported Upstream version 0.4.5 --- Changes | 4 +++ MANIFEST | 2 +- META.json | 56 --------------------------------------- META.yml | 22 ++++++++++------ README | 2 +- lib/Getopt/Euclid.pm | 71 +++++++++++++++++++++----------------------------- t/fail_missing_var_2.t | 36 +++++++++++++++++++++++++ 7 files changed, 85 insertions(+), 108 deletions(-) diff --git a/Changes b/Changes index 0ec0480..d73fa14 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for Getopt-Euclid +0.4.5 2014-03-21 + - Fixed bug when parsing arguments with missing variable (reported by Torbjørn + Lindahl) + 0.4.4 2013-08-21 - Fixed bug with Bleadperl v5.19.2-257-gc30fc27 (bug #87804, reported by Andreas Koenig, patch by Dave Mitchell) diff --git a/MANIFEST b/MANIFEST index ce86882..9aa4568 100644 --- a/MANIFEST +++ b/MANIFEST @@ -11,7 +11,6 @@ inc/Module/Install/WriteAll.pm lib/Getopt/Euclid.pm Makefile.PL MANIFEST This list of files -META.json META.yml README t/00.load.t @@ -38,6 +37,7 @@ t/fail_minimal_clash.t t/fail_misplaced_type.t t/fail_missing_required.t t/fail_missing_var.t +t/fail_missing_var_2.t t/fail_no_spec.t t/fail_quoted_args.t t/fail_type.t diff --git a/META.json b/META.json deleted file mode 100644 index 01397a1..0000000 --- a/META.json +++ /dev/null @@ -1,56 +0,0 @@ -{ - "abstract" : "Executable Uniform Command-Line Interface Descriptions", - "author" : [ - "Damian Conway <[email protected]>" - ], - "dynamic_config" : 1, - "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", - "license" : [ - "perl_5" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";, - "version" : "2" - }, - "name" : "Getopt-Euclid", - "prereqs" : { - "build" : { - "requires" : { - "Pod::Checker" : "0", - "Test::More" : "0" - } - }, - "configure" : { - "requires" : { - "Module::Build" : "0.40" - } - }, - "runtime" : { - "recommends" : { - "IO::Pager::Page" : "0" - }, - "requires" : { - "File::Basename" : "0", - "File::Spec::Functions" : "0", - "List::Util" : "0", - "Pod::PlainText" : "0", - "Pod::Select" : "0", - "Text::Balanced" : "0", - "version" : "0" - } - } - }, - "provides" : { - "Getopt::Euclid" : { - "file" : "lib/Getopt/Euclid.pm", - "version" : "v0.4.3" - } - }, - "release_status" : "stable", - "resources" : { - "license" : [ - "http://dev.perl.org/licenses/"; - ] - }, - "version" : "v0.4.3" -} diff --git a/META.yml b/META.yml index 3e0eee4..ae83361 100644 --- a/META.yml +++ b/META.yml @@ -1,23 +1,25 @@ --- abstract: 'Executable Uniform Command-Line Interface Descriptions' author: - - 'Damian Conway <[email protected]>' + - 'Damian Conway ([email protected])' build_requires: + ExtUtils::MakeMaker: 6.36 Pod::Checker: 0 Test::More: 0 configure_requires: - Module::Build: 0.40 + ExtUtils::MakeMaker: 6.36 +distribution_type: module dynamic_config: 1 -generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' +generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Getopt-Euclid -provides: - Getopt::Euclid: - file: lib/Getopt/Euclid.pm - version: v0.4.3 +no_index: + directory: + - inc + - t recommends: IO::Pager::Page: 0 requires: @@ -27,7 +29,11 @@ requires: Pod::PlainText: 0 Pod::Select: 0 Text::Balanced: 0 + perl: 5.005 version: 0 resources: + bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Getopt-Euclid + homepage: http://search.cpan.org/search?query=Getopt%3A%3AEuclid&mode=dist license: http://dev.perl.org/licenses/ -version: v0.4.3 + repository: git://getopt-euclid.git.sourceforge.net/gitroot/getopt-euclid/getopt-euclid +version: 0.004005 diff --git a/README b/README index 9181358..f5ec534 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ NAME Getopt::Euclid - Executable Uniform Command-Line Interface Descriptions VERSION - This document describes Getopt::Euclid version 0.4.4 + This document describes Getopt::Euclid version 0.4.5 SYNOPSIS use Getopt::Euclid; diff --git a/lib/Getopt/Euclid.pm b/lib/Getopt/Euclid.pm index 384cba8..d72ec08 100644 --- a/lib/Getopt/Euclid.pm +++ b/lib/Getopt/Euclid.pm @@ -1,6 +1,6 @@ package Getopt::Euclid; -use version; our $VERSION = version->declare('0.4.4'); +use version; our $VERSION = version->declare('0.4.5'); use warnings; use strict; @@ -121,6 +121,11 @@ sub import { $has_run = 1; # Parse POD + parse and export arguments + + ###### + #use Data::Dumper; print "ARGV: ".Dumper(\@ARGV); + ###### + __PACKAGE__->process_args( \@ARGV ) unless $defer; return 1; @@ -204,20 +209,16 @@ sub process_args { if ( first { $_ eq '--man' } @$args ) { _print_pod( __PACKAGE__->man(), 'paged' ); exit; - } - elsif ( first { $_ eq '--usage' } @$args ) { + } elsif ( first { $_ eq '--usage' } @$args ) { print __PACKAGE__->usage(); exit; - } - elsif ( first { $_ eq '--help' } @$args ) { + } elsif ( first { $_ eq '--help' } @$args ) { _print_pod( __PACKAGE__->help(), 'paged' ); exit; - } - elsif ( first { $_ eq '--version' } @$args ) { + } elsif ( first { $_ eq '--version' } @$args ) { print __PACKAGE__->version(); exit; - } - elsif ( first { $_ eq '--podfile' } @$args ) { + } elsif ( first { $_ eq '--podfile' } @$args ) { # Option meant for authors my $podfile = podfile( ); print "Wrote POD manual in file $podfile\n"; @@ -291,8 +292,7 @@ sub process_args { if ($repeatable) { push @{ $ARGV{$arg_flag} }, $variant_val; - } - else { + } else { $ARGV{$arg_flag} = $variant_val; } $vars_opt_vals{$arg_flag} = $ARGV{$arg_flag} if $vars_prefix; @@ -525,9 +525,7 @@ sub _parse_pod { $matcher = join '|', map { $_->{matcher} } sort( { $b->{name} cmp $a->{name} } grep { $_->{name} =~ /^[^<]/ } @arg_list ), sort( { $a->{seq} <=> $b->{seq} } grep { $_->{name} =~ /^[<]/ } @arg_list ); - $matcher .= '|(?> (.+)) (?{ push @errors, $^N }) (?!)'; - $matcher = '(?:' . $matcher . ')'; return 1; @@ -601,8 +599,7 @@ sub _process_euclid_specs { # Decode... if ( $field eq 'type.error' ) { $arg->{var}{$var}{type_error} = $val; - } - elsif ( $field eq 'type' ) { + } elsif ( $field eq 'type' ) { $val = _qualify_variables_fully( $val ); my ( $matchtype, $comma, $constraint ) = $val =~ m{(/(?:\.|.)+/ | [^,\s]+)\s*(?:(,))?\s*(.*)}xms; @@ -613,14 +610,12 @@ sub _process_euclid_specs { $constraint =~ s/\b\Q$var\E\b/\$_[0]/g; $arg->{var}{$var}{constraint} = eval "sub{ $constraint }" or _fail("Invalid .type constraint: $spec\n($@)"); - } - elsif ( length $constraint ) { + } elsif ( length $constraint ) { $arg->{var}{$var}{constraint_desc} = $constraint; $arg->{var}{$var}{constraint} = eval "sub{ \$_[0] $constraint }" or _fail("Invalid .type constraint: $spec\n($@)"); - } - else { + } else { $arg->{var}{$var}{constraint_desc} = $matchtype; $arg->{var}{$var}{constraint} = $matchtype =~ m{\A\s*/.*/\s*\z}xms @@ -629,8 +624,7 @@ sub _process_euclid_specs { or _fail("Unknown .type constraint: $spec"); } - } - elsif ( ($field eq 'default') || ($field eq 'opt_default') ) { + } elsif ( ($field eq 'default') || ($field eq 'opt_default') ) { $val = _qualify_variables_fully( $val ); eval "\$val = $val; 1" or _fail("Invalid .$field value: $spec\n($@)"); @@ -654,11 +648,9 @@ sub _process_euclid_specs { } } - } - elsif ( $field eq 'excludes.error' ) { + } elsif ( $field eq 'excludes.error' ) { $arg->{var}{$var}{excludes_error} = $val; - } - elsif ( $field eq 'excludes' ) { + } elsif ( $field eq 'excludes' ) { $arg->{var}{$var}{excludes} = [ split '\s*,\s*', $val ]; for my $excl_var (@{$arg->{var}{$var}{excludes}}) { if ($var eq $excl_var) { @@ -666,8 +658,7 @@ sub _process_euclid_specs { "<$excl_var> cannot exclude itself." ); } } - } - else { + } else { _fail("Unknown specification: $spec"); } } @@ -848,17 +839,14 @@ sub _rectify_all_args { for my $var ( values %{$arg} ) { if ( ref $var eq 'ARRAY' ) { $var = [ map { _rectify_arg($_) } @{$var} ]; - } - else { + } else { $var = _rectify_arg($var); } } - } - else { + } else { if ( ref $arg eq 'ARRAY' ) { $arg = [ map { _rectify_arg($_) } @{$arg} ]; - } - else { + } else { $arg = _rectify_arg($arg); } } @@ -928,8 +916,8 @@ sub _verify_args { # Check constraints on vars... if ( exists $ARGV{$arg_name} ) { - # Named vars... if ( ref $entry eq 'HASH' && defined $entry->{$var} ) { + # Named vars... for my $val ( ref $entry->{$var} eq 'ARRAY' ? @{ $entry->{$var} } @@ -944,10 +932,8 @@ sub _verify_args { } } next VAR; - } - - # Unnamed vars... - elsif ( ref $entry ne 'HASH' && defined $entry ) { + } elsif ( ref $entry ne 'HASH' && defined $entry ) { + # Unnamed vars... for my $val ( ref $entry eq 'ARRAY' ? @{$entry} @@ -1026,6 +1012,7 @@ sub _convert_to_regex { while ( my ($arg_name, $arg_specs) = each %{$args_ref} ) { push @arg_variants, @{$arg_specs->{variants}}; } + my $no_match = join('|',@arg_variants); $no_match = _escape_specials($no_match); $no_match = '(?!(?:'.$no_match.')'.$no_esc_ws.')'; @@ -1056,7 +1043,8 @@ sub _convert_to_regex { or _fail("Unknown type ($type) in specification: $arg_name"); $var_rep ? "(?:[\\s\\0\\1]*$no_match($matcher)(?{push \@{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}}}, \$^N}))+" - : "(?:($matcher)(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}} = \$^N}))"; + : + "(?:$no_match($matcher)(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}} = \$^N}))"; }gexms or do { $regex .= "(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{}} = 1})"; @@ -1064,8 +1052,7 @@ sub _convert_to_regex { if ( $arg->{is_repeatable} ) { $arg->{matcher} = "$regex (?:(?<!\\w)|(?!\\w)) (?{push \@{\$ARGV{q{$arg_name}}}, {} })"; - } - else { + } else { $arg->{matcher} = "(??{exists\$ARGV{q{$arg_name}}?'(?!)':''}) " . ( $arg->{false_vals} @@ -1300,7 +1287,7 @@ Getopt::Euclid - Executable Uniform Command-Line Interface Descriptions =head1 VERSION -This document describes Getopt::Euclid version 0.4.4 +This document describes Getopt::Euclid version 0.4.5 =head1 SYNOPSIS diff --git a/t/fail_missing_var_2.t b/t/fail_missing_var_2.t new file mode 100644 index 0000000..70e9e1a --- /dev/null +++ b/t/fail_missing_var_2.t @@ -0,0 +1,36 @@ +use Test::More 'no_plan'; + +BEGIN { + require 5.006_001 or plan 'skip_all'; + close *STDERR; + open *STDERR, '>', \my $stderr; + *CORE::GLOBAL::exit = sub { die $stderr }; +} + +BEGIN { + @ARGV = ( + "--foo", + "--bar", + ); +} + +if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { + ok 0 => 'Unexpectedly succeeded'; +} +else { + like $@, qr/Unknown argument: --foo --bar/ => 'Failed as expected'; +} + +__END__ + +=head1 OPTIONS + +=over + +=item --foo <foo> + +=item --bar <bar> + +=back + +=cut -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libgetopt-euclid-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
