r54208 - in /trunk/libapp-cmd-perl: ./ debian/ inc/Module/ inc/Module/Install/ lib/App/ lib/App/Cmd/ lib/App/Cmd/Command/ lib/App/Cmd/Subdispatch/ t/ t/lib/Test/ t/lib/Test/MyCmd/Command/
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Sat Mar 13 08:29:17 UTC 2010
Author: carnil-guest
Date: Sat Mar 13 08:29:09 2010
New Revision: 54208
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54208
Log:
* New upstream release
* Refresh debian/copyright: Update URL to format specification and update
copyright years.
Added:
trunk/libapp-cmd-perl/t/lib/Test/MyCmd/Command/exit.pm
- copied unchanged from r54207, branches/upstream/libapp-cmd-perl/current/t/lib/Test/MyCmd/Command/exit.pm
Modified:
trunk/libapp-cmd-perl/Changes
trunk/libapp-cmd-perl/MANIFEST
trunk/libapp-cmd-perl/META.yml
trunk/libapp-cmd-perl/Makefile.PL
trunk/libapp-cmd-perl/debian/changelog
trunk/libapp-cmd-perl/debian/copyright
trunk/libapp-cmd-perl/inc/Module/Install.pm
trunk/libapp-cmd-perl/inc/Module/Install/Base.pm
trunk/libapp-cmd-perl/inc/Module/Install/Can.pm
trunk/libapp-cmd-perl/inc/Module/Install/Fetch.pm
trunk/libapp-cmd-perl/inc/Module/Install/Makefile.pm
trunk/libapp-cmd-perl/inc/Module/Install/Metadata.pm
trunk/libapp-cmd-perl/inc/Module/Install/Win32.pm
trunk/libapp-cmd-perl/inc/Module/Install/WriteAll.pm
trunk/libapp-cmd-perl/lib/App/Cmd.pm
trunk/libapp-cmd-perl/lib/App/Cmd/ArgProcessor.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Command.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Command/commands.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Command/help.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Setup.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Simple.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch/DashedStyle.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Tester.pm
trunk/libapp-cmd-perl/lib/App/Cmd/Tutorial.pod
trunk/libapp-cmd-perl/t/basic.t
trunk/libapp-cmd-perl/t/lib/Test/WSNCC.pm
trunk/libapp-cmd-perl/t/lib/Test/WSOF.pm
trunk/libapp-cmd-perl/t/lib/Test/WithSetup.pm
Modified: trunk/libapp-cmd-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/Changes?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/Changes (original)
+++ trunk/libapp-cmd-perl/Changes Sat Mar 13 08:29:09 2010
@@ -1,4 +1,17 @@
Revision history for App-Cmd
+
+0.307 2010-03-09
+ bump up required version of Getopt::Long::Descriptive
+
+0.306 2010-03-08
+ return the App::Cmd object (when non-Simple) in the Tester result
+ allow App::Cmd::Tester subclasses to chose another Result class
+
+0.305 2010-03-07
+ App::Cmd::Tester now reports (probable?) exit code of tested apps
+ some improvements to the tutorial and other docs
+ added some documentation for App::Cmd::Setup
+ now searches for plugins under App::Cmd::Plugin::; use = to prevent
0.304 2009-12-07
remove use of deprecated "-run" from synopsis (thanks, George
Modified: trunk/libapp-cmd-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/MANIFEST?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/MANIFEST (original)
+++ trunk/libapp-cmd-perl/MANIFEST Sat Mar 13 08:29:09 2010
@@ -30,6 +30,7 @@
t/abbrev.t
t/basic.t
t/lib/Test/MyCmd.pm
+t/lib/Test/MyCmd/Command/exit.pm
t/lib/Test/MyCmd/Command/frobulate.pm
t/lib/Test/MyCmd/Command/justusage.pm
t/lib/Test/MyCmd/Command/stock.pm
Modified: trunk/libapp-cmd-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/META.yml?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/META.yml (original)
+++ trunk/libapp-cmd-perl/META.yml Sat Mar 13 08:29:09 2010
@@ -8,7 +8,7 @@
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.91'
+generated_by: 'Module::Install version 0.94'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -21,12 +21,13 @@
- t
- xt
requires:
- Getopt::Long::Descriptive: 0.081
+ Getopt::Long::Descriptive: 0.084
Module::Pluggable::Object: 0
+ String::RewritePrefix: 0
Sub::Exporter: 0.975
Sub::Install: 0
perl: 5.6.0
resources:
license: http://dev.perl.org/licenses/
repository: http://github.com/rjbs/app-cmd
-version: 0.304
+version: 0.307
Modified: trunk/libapp-cmd-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/Makefile.PL?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/Makefile.PL (original)
+++ trunk/libapp-cmd-perl/Makefile.PL Sat Mar 13 08:29:09 2010
@@ -2,10 +2,11 @@
all_from('lib/App/Cmd.pm');
-requires('Getopt::Long::Descriptive' => 0.081); # leader_text, option_text
+requires('Getopt::Long::Descriptive' => 0.084); # Opts improvements, bugfixes
requires('Module::Pluggable::Object' => 0.00);
requires('Sub::Exporter' => 0.975); # curry_method
requires('Sub::Install' => 0.00); # minimum unknown
+requires('String::RewritePrefix' => 0.00); # minimum unknown
test_requires('IO::TieCombine' => 1.000); # first release
Modified: trunk/libapp-cmd-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/debian/changelog?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/debian/changelog (original)
+++ trunk/libapp-cmd-perl/debian/changelog Sat Mar 13 08:29:09 2010
@@ -1,3 +1,11 @@
+libapp-cmd-perl (0.307-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Refresh debian/copyright: Update URL to format specification and update
+ copyright years.
+
+ -- Salvatore Bonaccorso <salvatore.bonaccorso at gmail.com> Sat, 13 Mar 2010 09:27:29 +0100
+
libapp-cmd-perl (0.304-1) unstable; urgency=low
* New upstream release
Modified: trunk/libapp-cmd-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/debian/copyright?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/debian/copyright (original)
+++ trunk/libapp-cmd-perl/debian/copyright Sat Mar 13 08:29:09 2010
@@ -1,4 +1,4 @@
-Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=59
+Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
Maintainer: Ricardo SIGNES
Source: http://search.cpan.org/dist/App-Cmd/
Name: App-Cmd
@@ -7,15 +7,15 @@
Copyright: 2005-2006, (code (simply))
License: Artistic or GPL-1+
-Files: inc/Module/*
-Copyright: 2002-2009, Adam Kennedy <adamk at cpan.org>
- 2002-2009, Audrey Tang <autrijus at autrijus.org>
- 2002-2009, Brian Ingerson <ingy at cpan.org>
+Files: inc/Module/*
+Copyright: 2002-2010, Adam Kennedy <adamk at cpan.org>
+ 2002-2010, Audrey Tang <autrijus at autrijus.org>
+ 2002-2010, Brian Ingerson <ingy at cpan.org>
License: Artistic or GPL-1+
Files: debian/*
Copyright: 2009, Ryan Niebur <ryanryan52 at gmail.com>
- 2009, Salvatore Bonaccorso <salvatore.bonaccorso at gmail.com>
+ 2009-2010, Salvatore Bonaccorso <salvatore.bonaccorso at gmail.com>
License: Artistic or GPL-1+
License: Artistic
Modified: trunk/libapp-cmd-perl/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install.pm Sat Mar 13 08:29:09 2010
@@ -28,7 +28,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.91';
+ $VERSION = '0.94';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -348,17 +348,24 @@
return $call;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
sub _readperl {
my $string = Module::Install::_read($_[0]);
@@ -379,18 +386,26 @@
return $string;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
@@ -427,4 +442,4 @@
1;
-# Copyright 2008 - 2009 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
Modified: trunk/libapp-cmd-perl/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install/Base.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install/Base.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install/Base.pm Sat Mar 13 08:29:09 2010
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.94';
}
# Suspend handler for "redefined" warnings
Modified: trunk/libapp-cmd-perl/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install/Can.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install/Can.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install/Can.pm Sat Mar 13 08:29:09 2010
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.94';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: trunk/libapp-cmd-perl/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install/Fetch.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install/Fetch.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install/Fetch.pm Sat Mar 13 08:29:09 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.94';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: trunk/libapp-cmd-perl/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install/Makefile.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install/Makefile.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install/Makefile.pm Sat Mar 13 08:29:09 2010
@@ -7,7 +7,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.94';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -34,6 +34,17 @@
}
}
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
sub makemaker_args {
my $self = shift;
my $args = ( $self->{makemaker_args} ||= {} );
@@ -44,7 +55,7 @@
# For mm args that take multiple space-seperated args,
# append an argument to the current list.
sub makemaker_append {
- my $self = sShift;
+ my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{name} = defined $args->{$name}
@@ -107,6 +118,9 @@
%test_dir = ();
require File::Find;
File::Find::find( \&_wanted_t, $dir );
+ if ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ File::Find::find( \&_wanted_t, 'xt' );
+ }
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
@@ -130,12 +144,13 @@
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
- $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
+ $self->build_requires( 'ExtUtils::MakeMaker' => $v );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
}
@@ -145,57 +160,87 @@
$args->{NAME} = $self->module_name || $self->name;
$args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
+ $DB::single = 1;
if ( $self->tests ) {
- $args->{test} = { TESTS => $self->tests };
+ $args->{test} = {
+ TESTS => $self->tests,
+ };
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
- $args->{NO_META} = 1;
- }
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
+ }
+ if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
- # Merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
- map { @$_ }
+ map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
- ($self->configure_requires, $self->build_requires, $self->requires)
+ ($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
- # merge both kinds of requires into prereq_pm
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
foreach my $bundle (@{ $self->bundles }) {
my ($file, $dir) = @$bundle;
push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
+ delete $build_prereq->{$file}; #Delete from build prereqs only
}
+ }
+
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
}
$args->{INSTALLDIRS} = $self->installdirs;
- my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
- if (my $preop = $self->admin->preop($user_preop)) {
+ if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
@@ -265,4 +310,4 @@
__END__
-#line 394
+#line 439
Modified: trunk/libapp-cmd-perl/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install/Metadata.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install/Metadata.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install/Metadata.pm Sat Mar 13 08:29:09 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.94';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -230,6 +230,8 @@
die("The path '$file' does not exist, or is not a file");
}
+ $self->{values}{all_from} = $file;
+
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
@@ -385,11 +387,10 @@
}
}
-sub perl_version_from {
- my $self = shift;
+sub _extract_perl_version {
if (
- Module::Install::_read($_[0]) =~ m/
- ^
+ $_[0] =~ m/
+ ^\s*
(?:use|require) \s*
v?
([\d_\.]+)
@@ -398,6 +399,16 @@
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
@@ -425,13 +436,12 @@
}
}
-sub license_from {
- my $self = shift;
+sub _extract_license {
if (
- Module::Install::_read($_[0]) =~ m/
+ $_[0] =~ m/
(
=head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
+ (?:licen[cs]e|licensing|copyrights?|legal)\b
.*?
)
(=head\\d.*|=cut.*|)
@@ -439,7 +449,9 @@
/ixms ) {
my $license_text = $1;
my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
+ 'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
@@ -456,20 +468,32 @@
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
+ $pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
- $self->license($license);
- return 1;
+ return $license;
}
}
- }
-
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
+ } else {
+ return;
+ }
+}
+
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
}
sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ my @links = $_[0] =~ m#L<(
+ \Qhttp://rt.cpan.org/\E[^>]+|
+ \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
+ \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
my %links;
@links{@links}=();
@links=keys %links;
@@ -485,7 +509,7 @@
return 0;
}
if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
+ warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
Modified: trunk/libapp-cmd-perl/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install/Win32.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install/Win32.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install/Win32.pm Sat Mar 13 08:29:09 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.94';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: trunk/libapp-cmd-perl/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/inc/Module/Install/WriteAll.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/inc/Module/Install/WriteAll.pm (original)
+++ trunk/libapp-cmd-perl/inc/Module/Install/WriteAll.pm Sat Mar 13 08:29:09 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';;
+ $VERSION = '0.94';;
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
Modified: trunk/libapp-cmd-perl/lib/App/Cmd.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd.pm Sat Mar 13 08:29:09 2010
@@ -51,11 +51,11 @@
=head1 VERSION
-version 0.304
-
-=cut
-
-our $VERSION = '0.304';
+version 0.307
+
+=cut
+
+our $VERSION = '0.307';
=head1 SYNOPSIS
@@ -580,7 +580,7 @@
=head2 usage_error
- $self->usage_error("Your mother!");
+ $self->usage_error("Something's wrong!");
Used to die with nice usage output, during C<validate_args>.
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/ArgProcessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/ArgProcessor.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/ArgProcessor.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/ArgProcessor.pm Sat Mar 13 08:29:09 2010
@@ -9,17 +9,18 @@
=head1 VERSION
-version 0.304
+version 0.307
=cut
-our $VERSION = '0.304';
+our $VERSION = '0.307';
sub _process_args {
my ($class, $args, @params) = @_;
local @ARGV = @$args;
require Getopt::Long::Descriptive;
+ Getopt::Long::Descriptive->VERSION(0.084);
my ($opt, $usage) = Getopt::Long::Descriptive::describe_options(@params);
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Command.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Command.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Command.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Command.pm Sat Mar 13 08:29:09 2010
@@ -11,11 +11,11 @@
=head1 VERSION
-version 0.304
-
-=cut
-
-our $VERSION = '0.304';
+version 0.307
+
+=cut
+
+our $VERSION = '0.307';
use Carp ();
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Command/commands.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Command/commands.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Command/commands.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Command/commands.pm Sat Mar 13 08:29:09 2010
@@ -11,11 +11,11 @@
=head1 VERSION
-version 0.304
+version 0.307
=cut
-our $VERSION = 0.304;
+our $VERSION = 0.307;
=head1 DESCRIPTION
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Command/help.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Command/help.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Command/help.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Command/help.pm Sat Mar 13 08:29:09 2010
@@ -11,11 +11,11 @@
=head1 VERSION
-version 0.304
+version 0.307
=cut
-our $VERSION = '0.304';
+our $VERSION = '0.307';
=head1 DESCRIPTION
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Setup.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Setup.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Setup.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Setup.pm Sat Mar 13 08:29:09 2010
@@ -1,12 +1,84 @@
use strict;
use warnings;
package App::Cmd::Setup;
+
+our $VERSION = 0.307;
+
+=head1 NAME
+
+App::Cmd::Setup - helper for setting up App::Cmd classes
+
+=head1 OVERVIEW
+
+App::Cmd::Setup is a helper library, used to set up base classes that will be
+used as part of an App::Cmd program. For the most part you should refer to
+L<the manual|App::Cmd::Manual> for how you should use this library.
+
+This class is useful in three scenarios:
+
+=over 4
+
+=item when writing your App::Cmd subclass
+
+Instead of writing:
+
+ package MyApp;
+ use base 'App::Cmd';
+
+...you can write:
+
+ package MyApp;
+ use App::Cmd::Setup -app;
+
+The benefits of doing this are mostly minor, and relate to sanity-checking your
+class. The significant benefit is that this form allows you to specify
+plugins, as in:
+
+ package MyApp;
+ use App::Cmd::Setup -app => { plugins => [ 'Prompt' ] };
+
+Plugins are described in L<App::Cmd::Manual> and L<App::Cmd::Plugin>.
+
+=item when writing abstract base classes for commands
+
+That is: when you write a subclass of L<App::Cmd::Command> that is intended for
+other commands to use as their base class, you should use App::Cmd::Setup. For
+example, if you want all the commands in MyApp to inherit from MyApp::Command,
+you may want to write that package like this:
+
+ package MyApp::Command;
+ use App::Cmd::Setup -command;
+
+Do not confuse this with the way you will write specific commands:
+
+ package MyApp::Command::mycmd;
+ use MyApp -command;
+
+Again, this form mostly performs some validation and setup behind the scenes
+for you. You can use C<L<base>> if you prefer.
+
+=item when writing App::Cmd plugins
+
+L<App::Cmd::Plugin> is a mechanism that allows an App::Cmd class to inject code
+into all its command classes, providing them with utility routines.
+
+To write a plugin, you must use App::Cmd::Setup. As seen above, you must also
+use App::Cmd::Setup to set up your App::Cmd subclass if you wish to consume
+plugins.
+
+For more information on writing plugins, see L<App::Cmd::Manual> and
+L<App::Cmd::Plugin>.
+
+=back
+
+=cut
use App::Cmd ();
use App::Cmd::Command ();
use App::Cmd::Plugin ();
use Carp ();
use Data::OptList ();
+use String::RewritePrefix ();
use Sub::Exporter -setup => {
-as => '_import',
@@ -53,6 +125,14 @@
my @plugins;
for my $plugin (@{ $val->{plugins} || [] }) {
+ $plugin = String::RewritePrefix->rewrite(
+ {
+ '' => 'App::Cmd::Plugin::',
+ '=' => ''
+ },
+ $plugin,
+ );
+
unless (eval { $plugin->isa($self->_plugin_base_class) }) {
eval "require $plugin; 1" or die "couldn't load plugin $plugin: $@";
}
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Simple.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Simple.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Simple.pm Sat Mar 13 08:29:09 2010
@@ -5,7 +5,7 @@
use App::Cmd::Command;
BEGIN { our @ISA = 'App::Cmd::Command' }
-our $VERSION = '0.304';
+our $VERSION = '0.307';
use App::Cmd;
use Sub::Install;
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch.pm Sat Mar 13 08:29:09 2010
@@ -13,11 +13,11 @@
=head1 VERSION
-version 0.304
+version 0.307
=cut
-our $VERSION = '0.304';
+our $VERSION = '0.307';
=head1 METHODS
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch/DashedStyle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch/DashedStyle.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch/DashedStyle.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Subdispatch/DashedStyle.pm Sat Mar 13 08:29:09 2010
@@ -11,11 +11,11 @@
=head1 VERSION
-version 0.304
+version 0.307
=cut
-our $VERSION = '0.304';
+our $VERSION = '0.307';
=head1 METHODS
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Tester.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Tester.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Tester.pm (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Tester.pm Sat Mar 13 08:29:09 2010
@@ -1,6 +1,8 @@
use strict;
use warnings;
package App::Cmd::Tester;
+
+our $VERSION = 0.307;
=head1 NAME
@@ -56,6 +58,7 @@
output - the combined output of stdout and stderr
error - the exception thrown by running the application, or undef
run_rv - the return value of the run method (generally irrelevant)
+ exit_code - the numeric exit code that would've been issued (0 is 'okay')
=cut
@@ -64,6 +67,16 @@
exports => { test_app => curry_method },
groups => { default => [ qw(test_app) ] },
};
+
+our $TEST_IN_PROGRESS;
+BEGIN {
+ *CORE::GLOBAL::exit = sub {
+ return CORE::exit(@_) unless $TEST_IN_PROGRESS;
+ App::Cmd::Tester::Exited->throw($_[0]);
+ };
+}
+
+sub result_class { 'App::Cmd::Tester::Result' }
sub test_app {
my ($class, $app, $argv) = @_;
@@ -75,7 +88,11 @@
my $stderr = tie local *STDERR, $hub, 'stderr';
my $run_rv;
+
+ $app = $app->new unless ref($app) or $app->isa('App::Cmd::Simple');
+
my $ok = eval {
+ local $TEST_IN_PROGRESS = 1;
local @ARGV = @$argv;
$run_rv = $app->run;
1;
@@ -83,22 +100,45 @@
my $error = $ok ? undef : $@;
- bless {
+ my $exit_code = defined $error ? ((0+$!)||-1) : 0;
+
+ if ($error and eval { $error->isa('App::Cmd::Tester::Exited') }) {
+ $exit_code = $$error;
+ }
+
+ $class->result_class->new({
+ app => $app,
stdout => $hub->slot_contents('stdout'),
stderr => $hub->slot_contents('stderr'),
output => $hub->combined_contents,
error => $error,
run_rv => $run_rv,
- } => 'App::Cmd::Tester::Result';
+ exit_code => $exit_code
+ });
}
{
package App::Cmd::Tester::Result;
- for my $attr (qw(stdout stderr output error run_rv)) {
+
+ sub new {
+ my ($class, $arg) = @_;
+ bless $arg => $class;
+ }
+
+ for my $attr (qw(app stdout stderr output error run_rv exit_code)) {
Sub::Install::install_sub({
code => sub { $_[0]->{$attr} },
as => $attr,
});
+ }
+}
+
+{
+ package App::Cmd::Tester::Exited;
+ sub throw {
+ my ($class, $code) = @_;
+ my $self = (bless \$code => $class);
+ die $self;
}
}
Modified: trunk/libapp-cmd-perl/lib/App/Cmd/Tutorial.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/lib/App/Cmd/Tutorial.pod?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/lib/App/Cmd/Tutorial.pod (original)
+++ trunk/libapp-cmd-perl/lib/App/Cmd/Tutorial.pod Sat Mar 13 08:29:09 2010
@@ -28,18 +28,10 @@
use App::Cmd::Setup -app;
1;
-In fact, you can roll these two together, keeping it all in the script, if you
-want:
-
- #!/usr/bin/perl
- package YourApp;
- use App::Cmd::Setup -app;
- YourApp->run;
-
When a new application instance is created, it loads all of the command classes
it can find, looking for modules under the Command namespace under its own
name. In the above snippet, for example, YourApp will look for any module with
-a name starting with YourApp::Command.
+a name starting with C<YourApp::Command::>.
We can set up a simple command class like this:
@@ -66,9 +58,9 @@
$ yourcmd initialize
Everything has been initialized. (Not really.)
-The arguments to the run method are the options passed from the command line
-and the leftover arguments. With a properly configured command class, the
-following invocation:
+The arguments to the run method are the parsed options from the command line
+(that is, the switches) and the remaining arguments. With a properly
+configured command class, the following invocation:
$ yourcmd reset -zB --new-seed xyzxy foo.db bar.db
@@ -82,9 +74,11 @@
$args = [ qw(foo.db bar.db) ];
-Arguments are processed by Getopt::Long::Descriptive. To customize its
-argument procession, a command class can implement a few methods: C<usage_desc>
-provides the usage format string; C<opt_spec> provides the option specification list; C<validate_args> is run after Getopt::Long::Descriptive.
+Arguments are processed by L<Getopt::Long::Descriptive> (GLD). To customize
+its argument processing, a command class can implement a few methods:
+C<usage_desc> provides the usage format string; C<opt_spec> provides the option
+specification list; C<validate_args> is run after Getopt::Long::Descriptive,
+and is meant to validate the C<$args>, which GLD ignores.
The first two methods provide configuration passed to GLD's C<describe_options> routine. To improve our command class, we might add the following code:
@@ -100,8 +94,9 @@
sub validate_args {
my ($self, $opt, $args) = @_;
- # we need at least one argument beyond the options
- die $self->usage->text unless @$args;
+ # we need at least one argument beyond the options; die with that message
+ # and the complete "usage" text describing switches, etc
+ $self->usage_error("too few arguments") unless @$args;
}
=head1 TIPS
Modified: trunk/libapp-cmd-perl/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/t/basic.t?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/t/basic.t (original)
+++ trunk/libapp-cmd-perl/t/basic.t Sat Mar 13 08:29:09 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 10;
+use Test::More tests => 11;
use App::Cmd::Tester;
use lib 't/lib';
@@ -16,7 +16,7 @@
is_deeply(
[ sort $app->command_names ],
- [ sort qw(help --help -h -? commands frob frobulate justusage stock) ],
+ [ sort qw(help --help -h -? commands exit frob frobulate justusage stock) ],
"got correct list of registered command names",
);
@@ -25,6 +25,7 @@
[ qw(
App::Cmd::Command::commands
App::Cmd::Command::help
+ Test::MyCmd::Command::exit
Test::MyCmd::Command::frobulate
Test::MyCmd::Command::justusage
Test::MyCmd::Command::stock
@@ -68,3 +69,8 @@
for my $name (qw(commands frobulate justusage stock)) {
like($return->stdout, qr/^\s+\Q$name\E/sm, "$name plugin in listing");
}
+
+{
+ my $return = test_app('Test::MyCmd', [ qw(exit 1) ]);
+ is($return->exit_code, 1, "exit code is 1");
+}
Modified: trunk/libapp-cmd-perl/t/lib/Test/WSNCC.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/t/lib/Test/WSNCC.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/t/lib/Test/WSNCC.pm (original)
+++ trunk/libapp-cmd-perl/t/lib/Test/WSNCC.pm Sat Mar 13 08:29:09 2010
@@ -3,7 +3,7 @@
package Test::WSNCC;
use App::Cmd::Setup -app => {
- plugins => [ qw(Test::XyzzyPlugin) ],
+ plugins => [ qw(=Test::XyzzyPlugin) ],
};
1;
Modified: trunk/libapp-cmd-perl/t/lib/Test/WSOF.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/t/lib/Test/WSOF.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/t/lib/Test/WSOF.pm (original)
+++ trunk/libapp-cmd-perl/t/lib/Test/WSOF.pm Sat Mar 13 08:29:09 2010
@@ -4,7 +4,7 @@
# WSOF: with Setup, one file
package Test::WSOF;
use App::Cmd::Setup -app => {
- plugins => [ qw(Test::XyzzyPlugin) ],
+ plugins => [ qw(=Test::XyzzyPlugin) ],
};
package Test::WSOF::Command::poot;
Modified: trunk/libapp-cmd-perl/t/lib/Test/WithSetup.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libapp-cmd-perl/t/lib/Test/WithSetup.pm?rev=54208&op=diff
==============================================================================
--- trunk/libapp-cmd-perl/t/lib/Test/WithSetup.pm (original)
+++ trunk/libapp-cmd-perl/t/lib/Test/WithSetup.pm Sat Mar 13 08:29:09 2010
@@ -3,7 +3,7 @@
package Test::WithSetup;
use App::Cmd::Setup -app => {
- plugins => [ qw(Test::XyzzyPlugin) ],
+ plugins => [ qw(=Test::XyzzyPlugin) ],
};
1;
More information about the Pkg-perl-cvs-commits
mailing list