r48696 - in /trunk/libgetopt-long-descriptive-perl: Changes MANIFEST META.yml README debian/changelog lib/Getopt/Long/Descriptive.pm lib/Getopt/Long/Descriptive/Opts.pm lib/Getopt/Long/Descriptive/Usage.pm t/descriptive.t
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Sun Dec 13 14:19:56 UTC 2009
Author: carnil-guest
Date: Sun Dec 13 14:19:50 2009
New Revision: 48696
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=48696
Log:
New upstream release
Added:
trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive/Opts.pm
- copied unchanged from r48694, branches/upstream/libgetopt-long-descriptive-perl/current/lib/Getopt/Long/Descriptive/Opts.pm
Modified:
trunk/libgetopt-long-descriptive-perl/Changes
trunk/libgetopt-long-descriptive-perl/MANIFEST
trunk/libgetopt-long-descriptive-perl/META.yml
trunk/libgetopt-long-descriptive-perl/README
trunk/libgetopt-long-descriptive-perl/debian/changelog
trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive.pm
trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive/Usage.pm
trunk/libgetopt-long-descriptive-perl/t/descriptive.t
Modified: trunk/libgetopt-long-descriptive-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/Changes?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/Changes (original)
+++ trunk/libgetopt-long-descriptive-perl/Changes Sun Dec 13 14:19:50 2009
@@ -1,4 +1,8 @@
Revision history for Getopt-Long-Descriptive
+
+0.083 2009-12-12
+ create an Opts module to store the opts object code
+ add _specified_opts method and _specified method for Opts
0.082 2009-12-03
require Getopt::Long 2.33 for proper --no-foo handling
Modified: trunk/libgetopt-long-descriptive-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/MANIFEST?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/MANIFEST (original)
+++ trunk/libgetopt-long-descriptive-perl/MANIFEST Sun Dec 13 14:19:50 2009
@@ -1,11 +1,12 @@
Changes
+lib/Getopt/Long/Descriptive.pm
+lib/Getopt/Long/Descriptive/Opts.pm
+lib/Getopt/Long/Descriptive/Usage.pm
+Makefile.PL
MANIFEST
-Makefile.PL
README
-lib/Getopt/Long/Descriptive.pm
-lib/Getopt/Long/Descriptive/Usage.pm
t/00-load.t
+t/descriptive.t
t/pod-coverage.t
t/pod.t
-t/descriptive.t
META.yml Module meta-data (added by MakeMaker)
Modified: trunk/libgetopt-long-descriptive-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/META.yml?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/META.yml (original)
+++ trunk/libgetopt-long-descriptive-perl/META.yml Sun Dec 13 14:19:50 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Getopt-Long-Descriptive
-version: 0.082
+version: 0.083
abstract: Getopt::Long with usage text
author:
- Hans Dieter Pearcey <hdp at cpan.org>
Modified: trunk/libgetopt-long-descriptive-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/README?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/README (original)
+++ trunk/libgetopt-long-descriptive-perl/README Sun Dec 13 14:19:50 2009
@@ -2,7 +2,7 @@
VERSION
-0.082
+0.083
INSTALLATION
Modified: trunk/libgetopt-long-descriptive-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/debian/changelog?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/debian/changelog (original)
+++ trunk/libgetopt-long-descriptive-perl/debian/changelog Sun Dec 13 14:19:50 2009
@@ -1,12 +1,12 @@
-libgetopt-long-descriptive-perl (0.082-1) UNRELEASED; urgency=low
+libgetopt-long-descriptive-perl (0.083-1) UNRELEASED; urgency=low
- Adds a dependency on Getopt::Long >= 2.33, which has been in
- Perl core since 5.6
- IGNORE-VERSION: 0.082-1
-
+ [ Jonathan Yu ]
* New upstream release
- -- Jonathan Yu <jawnsy at cpan.org> Thu, 03 Dec 2009 16:47:08 -0500
+ [ Salvatore Bonaccorso ]
+ * New upstream release
+
+ -- Salvatore Bonaccorso <salvatore.bonaccorso at gmail.com> Sun, 13 Dec 2009 15:17:54 +0100
libgetopt-long-descriptive-perl (0.081-1) unstable; urgency=low
Modified: trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive.pm?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive.pm (original)
+++ trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive.pm Sun Dec 13 14:19:50 2009
@@ -6,7 +6,9 @@
use Carp qw(carp croak);
use Params::Validate qw(:all);
use File::Basename ();
-
+use Scalar::Util ();
+
+use Getopt::Long::Descriptive::Opts;
use Getopt::Long::Descriptive::Usage;
=head1 NAME
@@ -15,11 +17,11 @@
=head1 VERSION
-Version 0.082
+Version 0.083
=cut
-our $VERSION = '0.082';
+our $VERSION = '0.083';
=head1 DESCRIPTION
@@ -356,6 +358,7 @@
my %return;
$usage->die unless GetOptions(\%return, grep { length } @specs);
+ my @given_keys = keys %return;
for my $opt (keys %return) {
my $newopt = _munge($opt);
@@ -377,8 +380,9 @@
$return{$name} = $new;
}
- my $opt_obj = $class->_new_opt_obj({
+ my $opt_obj = Getopt::Long::Descriptive::Opts->___new_opt_obj({
values => { %method_map, %return },
+ given => { map {; $_ => 1 } @given_keys },
});
return($opt_obj, $usage);
@@ -509,46 +513,6 @@
die "unimplemented";
}
-my $OPT_CLASS_COUNTER = 1;
-
-sub _class_for_opt {
- my ($gld_class, $arg) = @_;
-
- my $values = $arg->{values};
- my @bad = grep { $_ !~ /^[a-z_]\w*$/ } keys %$values;
- Carp::confess "perverse option names given: @bad" if @bad;
-
- my $class = "$gld_class\::__OPT__::" . $OPT_CLASS_COUNTER++;
-
- {
- no strict 'refs';
- ${"$class\::VERSION"} = $gld_class->VERSION;
- for my $opt (keys %$values) {
- *{"$class\::$opt"} = sub { $_[0]->{ $opt } };
- }
- }
-
- return $class;
-}
-
-sub _new_opt_obj {
- my ($gld_class, $arg) = @_;
-
- my $class = $gld_class->_class_for_opt($arg);
-
- # This is stupid, but the traditional behavior was that if --foo was not
- # given, there is no $opt->{foo}; it started to show up when we "needed" all
- # the keys to generate a class, but was undef; this wasn't a problem, but
- # broke tests of things that were relying on not-exists like tests of %$opt
- # contents or MooseX::Getopt which wanted to use things as args for new --
- # undef would not pass an Int TC. Easier to just do this. -- rjbs,
- # 2009-11-27
- my $obj = bless { %{ $arg->{values} } } => $class;
- delete $obj->{$_} for grep { ! defined $obj->{$_} } keys %$obj;
-
- return $obj;
-}
-
=head1 CUSTOMIZING
Getopt::Long::Descriptive uses L<Sub::Exporter|Sub::Exporter> to build and
Modified: trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive/Usage.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive/Usage.pm?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive/Usage.pm (original)
+++ trunk/libgetopt-long-descriptive-perl/lib/Getopt/Long/Descriptive/Usage.pm Sun Dec 13 14:19:50 2009
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = '0.082';
+our $VERSION = '0.083';
use List::Util qw(max);
Modified: trunk/libgetopt-long-descriptive-perl/t/descriptive.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgetopt-long-descriptive-perl/t/descriptive.t?rev=48696&op=diff
==============================================================================
--- trunk/libgetopt-long-descriptive-perl/t/descriptive.t (original)
+++ trunk/libgetopt-long-descriptive-perl/t/descriptive.t Sun Dec 13 14:19:50 2009
@@ -1,9 +1,8 @@
#!perl
-
use strict;
use warnings;
-use Test::More 'no_plan';
+use Test::More tests => 37;
use_ok("Getopt::Long::Descriptive");
@@ -202,6 +201,31 @@
}
{
+ local @ARGV = qw(--foo FOO --baz BAZ);
+ my ($c_opt, $usage) = describe_options(
+ "%c %o",
+ [ "foo=s", '' ],
+ [ "bar=s", '', { default => 'BAR' } ],
+ [ "baz=s", '', { default => 'BAZ' } ],
+ );
+
+ my $s_opt = $c_opt->_specified_opts;
+ my $C_opt = $s_opt->_complete_opts;
+
+ is($c_opt->foo, 'FOO', 'c_opt->foo is FOO');
+ is($C_opt->foo, 'FOO', 'C_opt->foo is FOO');
+ is($s_opt->foo, 'FOO', 's_opt->foo is FOO');
+
+ is($c_opt->bar, 'BAR', 'c_opt->foo is BAR');
+ is($C_opt->bar, 'BAR', 'C_opt->foo is BAR');
+ is($s_opt->bar, undef, 's_opt->foo is undef');
+
+ is($c_opt->baz, 'BAZ', 'c_opt->foo is BAZ');
+ is($C_opt->baz, 'BAZ', 'C_opt->foo is BAZ');
+ is($s_opt->baz, 'BAZ', 's_opt->foo is BAZ');
+}
+
+{
local @ARGV = qw(--foo);
my ($opt, $usage) = describe_options(
"%c %o",
More information about the Pkg-perl-cvs-commits
mailing list