[libgetopt-euclid-perl] 01/06: Imported Upstream version 0.4.5
gregor herrmann
gregoa at debian.org
Tue May 6 17:25:55 UTC 2014
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 <gregoa at debian.org>
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 <DCONWAY at cpan.org>"
- ],
- "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 <DCONWAY at cpan.org>'
+ - 'Damian Conway (DCONWAY at CPAN.org)'
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('|', at 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
More information about the Pkg-perl-cvs-commits
mailing list