[Bps-public-commit] App-CLI branch, master, updated. 0.09-42-g3159542
Alex Vandiver
alexmv at bestpractical.com
Fri Dec 3 00:53:11 EST 2010
The branch, master has been updated
via 31595427cd11d9476e700f3debbf0669820956e8 (commit)
via 57bb730c056068c2d9d8497313e0a394703ba5a8 (commit)
via cd0b90f1a6a4c013d12678b691392bcf3e9e40d6 (commit)
via 19636ddb8c65356ce6d64640e0e8916d5e5b7299 (commit)
via e2044240bf81563b02139cc924698208f0f84a72 (commit)
via 2a643920e539c4c6c5ab3a26823b19078d8942c4 (commit)
via d42715c2fb3fbdee396fc8e44f11a85ffe567961 (commit)
via 498791c0609e1fa0ad9d2fa418777f6498533d44 (commit)
via 368f50c72606c4d7699796693b43db9c17efd80e (commit)
via 41b2da1dcfd51ee3dc240cc78bf284dc097622d7 (commit)
via 1c90f01a3c9d3eeccd1d3fd8feafe36843e7f04a (commit)
via 44a5ff97bac98b9f7e6941b62daddff1e4e35e18 (commit)
via 78623a37b9764b7848294e9077cfc3d61eb387f5 (commit)
via b4230c733fd4b9d9b66dc8e1741f7793de18c53e (commit)
via 9b6c4a56b1ab7cdce70f555a9dfea8ed0c6c3246 (commit)
via 3af73f1983a63ebf99fdf00032e561fd97d29491 (commit)
via 2eeb23e633f8583e0e4d5234c7f8d368283bf0b7 (commit)
via 6d00f9eaba589bad7af4d326a21e025a5055e210 (commit)
via 20eccbb8740061556c86d0db1d7cbf7c3ef47ea3 (commit)
via 9f4d6249c8f4989073fd117fd9ac5bb8efd94abd (commit)
via fa637328ede34c3f6ee50e8702a33674239e2dde (commit)
via 27b48827f195c2cd56b4728293859c372897be7d (commit)
via c860af7efe41698729e3d1c9abe78bb2f6354740 (commit)
via 3cdc90f3b70c5b405447ffc8e0c2eb031e6970c3 (commit)
via b636cd04542c0ed8fe3b65d9c4eef951919e6351 (commit)
via feef569468bca84c069f03d60a8b4d0dbcabc0fd (commit)
via e56b7d34a3738927f1d282daf5828612e834fcd8 (commit)
via fffe1b6cd27f483b83a68b04b09fce438c166fe4 (commit)
via ee779a63f720250d67dcd989331fd7b294907e76 (commit)
via f2f798e2fa72836f72429342fbf039b32b2352f5 (commit)
via ee40ef52f73bdf2a5c1fdfa9900999bc28f557d4 (commit)
via 5797722975f2156f075f144bbe93ca09f68b000b (commit)
via 01f3fa66780277c473f2e56b28a102f2328563ab (commit)
via 5dd88ad0aa1e21ca5d8d3be76f5cacfdaf4052a0 (commit)
via aea183d0682fef3f93f73b6b0f35b79e62e08155 (commit)
via daa9272b654c137a1d0f27cf24c9a1dd602584b1 (commit)
via 41b11bb12d5d213abafcb9cf3d18fbaf36b791a2 (commit)
via 29161ddfd0ae422eea80fb4f4acd6242df8d0008 (commit)
via 9cecc6bd38739281f311ff789d46d329dfff56fb (commit)
via 572e0fe3c8cdca0a0d4a63a186865c6f89d102af (commit)
via ba9ae554e30ebf713a22939f3e9276d26ccf12b6 (commit)
via 8fbeecdbc12502742121cdb7810a809f240c6107 (commit)
from ac38f1284aaae8e5c90c892953f7066c9d7f9079 (commit)
Summary of changes:
.gitignore | 2 +
Changes | 27 +
MANIFEST | 2 +-
MANIFEST.SKIP | 10 +
Makefile.PL | 4 +-
SIGNATURE | 46 --
inc/Module/AutoInstall.pm | 768 --------------------
inc/Module/Install.pm | 369 ----------
inc/Module/Install/AutoInstall.pm | 61 --
inc/Module/Install/Base.pm | 72 --
inc/Module/Install/Can.pm | 83 ---
inc/Module/Install/Fetch.pm | 93 ---
inc/Module/Install/Include.pm | 34 -
inc/Module/Install/Makefile.pm | 253 -------
inc/Module/Install/Metadata.pm | 510 -------------
inc/Module/Install/Win32.pm | 64 --
inc/Module/Install/WriteAll.pm | 40 -
lib/App/CLI.pm | 223 ++++--
lib/App/CLI/Command.pm | 104 ++-
lib/App/CLI/Command/Help.pm | 40 +
lib/App/CLI/Helper.pm | 43 ++
t/1basic.t | 25 +-
t/lib/MyApp/Test.pm | 10 +-
t/lib/MyApp/Test/Cascading.pm | 11 +
t/lib/MyApp/Test/Cascading/Infinite.pm | 11 +
t/lib/MyApp/Test/Cascading/Infinite/Subcommands.pm | 16 +
26 files changed, 431 insertions(+), 2490 deletions(-)
create mode 100644 MANIFEST.SKIP
delete mode 100644 SIGNATURE
delete mode 100644 inc/Module/AutoInstall.pm
delete mode 100644 inc/Module/Install.pm
delete mode 100644 inc/Module/Install/AutoInstall.pm
delete mode 100644 inc/Module/Install/Base.pm
delete mode 100644 inc/Module/Install/Can.pm
delete mode 100644 inc/Module/Install/Fetch.pm
delete mode 100644 inc/Module/Install/Include.pm
delete mode 100644 inc/Module/Install/Makefile.pm
delete mode 100644 inc/Module/Install/Metadata.pm
delete mode 100644 inc/Module/Install/Win32.pm
delete mode 100644 inc/Module/Install/WriteAll.pm
create mode 100644 lib/App/CLI/Helper.pm
create mode 100644 t/lib/MyApp/Test/Cascading.pm
create mode 100644 t/lib/MyApp/Test/Cascading/Infinite.pm
create mode 100644 t/lib/MyApp/Test/Cascading/Infinite/Subcommands.pm
- Log -----------------------------------------------------------------
commit 8fbeecdbc12502742121cdb7810a809f240c6107
Author: c9s <cornelius.howl at gmail.com>
Date: Sun Oct 17 18:55:22 2010 +0900
Fix filename pattern.
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 57732c9..bc6a0a1 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -99,16 +99,19 @@ sub get_cmd {
die $class->error_cmd
unless $cmd && $cmd =~ m/^[?a-z]+$/;
my $pkg = join('::', $class->command_class, $class->_cmd_map ($cmd));
+
my $file = "$pkg.pm";
$file =~ s!::!/!g;
eval {require $file; };
unless ($pkg->can('run')) {
- warn $@ if $@ and exists $INC{$file};
- die $class->error_cmd;
+ warn $@ if $@ and exists $INC{$file};
+ die $class->error_cmd;
}
+
$cmd = $pkg->new (@arg);
$cmd->app ($class);
+
return $cmd;
}
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index ecf10e3..9b3af3f 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -106,7 +106,7 @@ section is displayed as well.
sub usage {
my ($self, $want_detail) = @_;
my $fname = $self->filename;
- my($cmd) = $fname =~ m{\W(\w+)\.pm$};
+ my ($cmd) = $fname =~ m{\W(\w+)\.pm$};
require Pod::Simple::Text;
my $parser = Pod::Simple::Text->new;
my $buf;
@@ -162,9 +162,9 @@ Return the filename for the command module.
sub filename {
my $self = shift;
my $fname = ref($self);
- $fname =~ s{::[a-z]+}{}; # subcommand
+ $fname =~ s{::[a-z]+$}{}; # subcommand
$fname =~ s{::}{/}g;
- $INC{"$fname.pm"}
+ return $INC{"$fname.pm"};
}
=head1 TODO
commit ba9ae554e30ebf713a22939f3e9276d26ccf12b6
Author: c9s <cornelius.howl at gmail.com>
Date: Mon Oct 18 15:42:59 2010 +0900
Document Help command class.
diff --git a/lib/App/CLI/Command/Help.pm b/lib/App/CLI/Command/Help.pm
index 117d0f9..904fd42 100644
--- a/lib/App/CLI/Command/Help.pm
+++ b/lib/App/CLI/Command/Help.pm
@@ -6,6 +6,35 @@ use File::Find qw(find);
use Locale::Maketext::Simple;
use Pod::Simple::Text;
+=head1 NAME
+
+App::CLI::Command::Help
+
+=head1 DESCRIPTION
+
+Your command class should be capitalized.
+
+To add help message , you just add pod in command class:
+
+ package YourApp::Command::Foo;
+
+
+ =head1 NAME
+
+ YourApp::Command::Foo - execute foo
+
+ =head1 DESCRIPTION
+
+ blah blah
+
+ =head1 USAGE
+
+ ....
+
+ =cut
+
+=cut
+
sub run {
my $self = shift;
my @topics = @_;
commit 572e0fe3c8cdca0a0d4a63a186865c6f89d102af
Author: c9s <cornelius.howl at gmail.com>
Date: Mon Oct 18 15:46:18 2010 +0900
Update synopsis
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index bc6a0a1..87729b1 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -9,23 +9,38 @@ App::CLI - Dispatcher module for command line interface programs
=head1 SYNOPSIS
- package MyApp;
- use base 'App::CLI';
+ package MyApp;
+ use base 'App::CLI';
- package main;
+ package main;
- MyApp->dispatch;
+ MyApp->dispatch;
- package MyApp::Help;
- use base 'App::CLI::Command';
+ package MyApp::List;
+ use base qw(App::CLI::Command);
- sub options {
- ('verbose' => 'verbose');
- }
+ sub run {
+ my ($self, @args ) = @_;
- sub run {
- my ($self, $arg) = @_;
- }
+
+ }
+
+ package MyApp::Help;
+ use base 'App::CLI::Command';
+
+ sub options { (
+ 'verbose' => 'verbose',
+ 'n|name=s' => 'name'
+ }
+
+ sub run {
+ my ( $self, $arg ) = @_;
+
+ print "verbose" if $self->{verbose};
+
+ my $name = $self->{name};
+
+ }
=head1 DESCRIPTION
@@ -147,6 +162,7 @@ L<App::CLI::Command>
=head1 AUTHORS
Chia-liang Kao E<lt>clkao at clkao.orgE<gt>
+Cornelius Lin E<lt>cornelius.howl at gmail.comE<gt>
=head1 COPYRIGHT
commit 9cecc6bd38739281f311ff789d46d329dfff56fb
Merge: 572e0fe ac38f12
Author: c9s <cornelius.howl at gmail.com>
Date: Mon Oct 18 15:48:24 2010 +0900
Merge branch 'master' of git://github.com/bestpractical/app-cli into bestpractical-master
commit 29161ddfd0ae422eea80fb4f4acd6242df8d0008
Author: c9s <cornelius.howl at gmail.com>
Date: Tue Oct 19 02:45:56 2010 +0900
Checking in changes prior to tagging of version 0.10.
Changelog diff is:
diff --git a/Changes b/Changes
index 5ecd98e..7d46d98 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+
+0.10 - 19 Oct 2010
+
+ * Update document
+
0.09 - 17 Oct 2010
* Fix the command pattern used in help.
diff --git a/Changes b/Changes
index 5ecd98e..7d46d98 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+
+0.10 - 19 Oct 2010
+
+ * Update document
+
0.09 - 17 Oct 2010
* Fix the command pattern used in help.
diff --git a/MANIFEST b/MANIFEST
index 2c9e59e..8ab40f4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -22,3 +22,4 @@ t/lib/CLITest.pm
t/lib/MyApp.pm
t/lib/MyApp/Help.pm
t/lib/MyApp/Test.pm
+MANIFEST.SKIP
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..39a199f
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,10 @@
+^blib
+^pm_to_blib
+.*\.old$
+^Makefile$
+^\.git
+MYMETA.yml
+.tar.gz$
+test*
+shipit
+META.yml
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 404e948..d9d20b1 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -1,5 +1,5 @@
package App::CLI;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
use strict;
use warnings;
commit 41b11bb12d5d213abafcb9cf3d18fbaf36b791a2
Author: c9s <cornelius.howl at gmail.com>
Date: Tue Oct 19 13:04:29 2010 +0900
update inc
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index 7efc552..60b90ea 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -18,7 +18,9 @@ my %FeatureMap = (
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
-my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly );
+my (
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+);
my ( $PostambleActions, $PostambleUsed );
# See if it's a testing or non-interactive session
@@ -73,6 +75,9 @@ sub _init {
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
}
}
@@ -115,6 +120,13 @@ sub import {
)[0]
);
+ # We want to know if we're under CPAN early to avoid prompting, but
+ # if we aren't going to try and install anything anyway then skip the
+ # check entirely since we don't want to have to load (and configure)
+ # an old CPAN just for a cosmetic message
+
+ $UnderCPAN = _check_lock(1) unless $SkipInstall;
+
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
my $default = 1;
@@ -163,15 +175,24 @@ sub import {
}
# XXX: check for conflicts and uninstalls(!) them.
- if (
- defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) )
+ my $cur = _load($mod);
+ if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
- print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ if (not defined $cur) # indeed missing
+ {
+ print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ }
+ else
+ {
+ # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+ print "too old. ($cur < $arg)\n";
+ }
+
push @required, $mod => $arg;
}
}
@@ -184,6 +205,8 @@ sub import {
!$SkipInstall
and (
$CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
@@ -214,8 +237,6 @@ sub import {
}
}
- $UnderCPAN = _check_lock(); # check for $UnderCPAN
-
if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
require Config;
print
@@ -232,23 +253,42 @@ sub import {
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+ return (@Existing, @Missing);
+}
+
+sub _running_under {
+ my $thing = shift;
+ print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
- return unless @Missing;
+ return unless @Missing or @_;
+
+ my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
- print <<'END_MESSAGE';
+ return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+ }
-*** Since we're running under CPANPLUS, I'll just let it take care
- of the dependency's installation later.
-END_MESSAGE
- return 1;
+ require CPAN;
+
+ if ($CPAN::VERSION > '1.89') {
+ if ($cpan_env) {
+ return _running_under('CPAN');
+ }
+ return; # CPAN.pm new enough, don't need to check further
}
- _load_cpan();
+ # last ditch attempt, this -will- configure CPAN, very sorry
+
+ _load_cpan(1); # force initialize even though it's already loaded
# Find the CPAN lock-file
my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
@@ -284,7 +324,7 @@ sub install {
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
- if ( defined( _version_check( _load($pkg), $ver ) ) ) {
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
else {
@@ -313,7 +353,7 @@ sub install {
@modules = @newmod;
}
- if ( _has_cpanplus() ) {
+ if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
_install_cpanplus( \@modules, \@config );
} else {
_install_cpan( \@modules, \@config );
@@ -323,7 +363,7 @@ sub install {
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- if ( defined( _version_check( _load($pkg), $ver ) ) ) {
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
@@ -378,7 +418,7 @@ sub _install_cpanplus {
my $success;
my $obj = $modtree->{$pkg};
- if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) {
+ if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
@@ -471,7 +511,7 @@ sub _install_cpan {
my $obj = CPAN::Shell->expand( Module => $pkg );
my $success = 0;
- if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) {
+ if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
@@ -535,7 +575,7 @@ sub _update_to {
my $ver = shift;
return
- if defined( _version_check( _load($class), $ver ) ); # no need to upgrade
+ if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
@@ -632,9 +672,22 @@ sub _load {
# Load CPAN.pm and it's configuration
sub _load_cpan {
- return if $CPAN::VERSION;
+ return if $CPAN::VERSION and $CPAN::Config and not @_;
require CPAN;
- if ( $CPAN::HandleConfig::VERSION ) {
+
+ # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
+ # CPAN::HandleConfig->load. CPAN reports that the redirection
+ # is deprecated in a warning printed at the user.
+
+ # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
+ # $CPAN::HandleConfig::VERSION but cannot handle
+ # CPAN::Config->load
+
+ # Which "versions expect CPAN::Config->load?
+
+ if ( $CPAN::HandleConfig::VERSION
+ || CPAN::HandleConfig->can('load')
+ ) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
@@ -644,9 +697,11 @@ sub _load_cpan {
}
# compare two versions, either use Sort::Versions or plain comparison
-sub _version_check {
+# return values same as <=>
+sub _version_cmp {
my ( $cur, $min ) = @_;
- return unless defined $cur;
+ return -1 unless defined $cur; # if 0 keep comparing
+ return 1 unless $min;
$cur =~ s/\s+$//;
@@ -657,16 +712,13 @@ sub _version_check {
) {
# use version.pm if it is installed.
- return (
- ( version->new($cur) >= version->new($min) ) ? $cur : undef );
+ return version->new($cur) <=> version->new($min);
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
- return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
- ? $cur
- : undef );
+ return Sort::Versions::versioncmp( $cur, $min );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
@@ -675,7 +727,7 @@ sub _version_check {
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
- return ( $cur >= $min ? $cur : undef );
+ return $cur <=> $min;
}
# nothing; this usage is deprecated.
@@ -706,7 +758,7 @@ sub _make_args {
if $Config;
$PostambleActions = (
- $missing
+ ($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
@@ -746,7 +798,7 @@ sub Write {
sub postamble {
$PostambleUsed = 1;
- return << ".";
+ return <<"END_MAKE";
config :: installdeps
\t\$(NOECHO) \$(NOOP)
@@ -757,7 +809,7 @@ checkdeps ::
installdeps ::
\t$PostambleActions
-.
+END_MAKE
}
@@ -765,4 +817,4 @@ installdeps ::
__END__
-#line 1003
+#line 1071
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index b46be99..8ee839d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,12 +17,13 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-BEGIN {
- require 5.004;
-}
+use 5.005;
use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
-use vars qw{$VERSION};
+use vars qw{$VERSION $MAIN};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
@@ -30,25 +31,35 @@ BEGIN {
# 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.79';
+ $VERSION = '1.00';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
-
-
-
-# Whether or not inc::Module::Install is actually loaded, the
-# $INC{inc/Module/Install.pm} is what will still get set as long as
-# the caller loaded module this in the documented manner.
-# If not set, the caller may NOT have loaded the bundled version, and thus
-# they may not have a MI version that works with the Makefile.PL. This would
-# result in false errors or unexpected behaviour. And we don't want that.
-my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) { die <<"END_DIE" }
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
@@ -60,32 +71,42 @@ not:
END_DIE
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
-# If the script that is loading Module::Install is from the future,
-# then make will detect this and cause it to re-run over and over
-# again. This is bad. Rather than taking action to touch it (which
-# is unreliable on some platforms and requires write permissions)
-# for now we should catch this and refuse to run.
-if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
-
-Your installer $0 has a modification time in the future.
+Your installer $0 has a modification time in the future ($s > $t).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
+ }
-
-
-
-# Build.PL was formerly supported, but no longer is due to excessive
-# difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
@@ -95,23 +116,42 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
+ #-------------------------------------------------------------
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+ #-------------------------------------------------------------
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
-# To save some more typing in Module::Install installers, every...
-# use inc::Module::Install
-# ...also acts as an implicit use strict.
-$^H |= strict::bits(qw(refs subs vars));
-
+ local $^W;
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+ # Save to the singleton
+ $MAIN = $self;
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
+ return 1;
+}
sub autoload {
my $self = shift;
@@ -121,39 +161,37 @@ sub autoload {
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
- # delegate back to parent dirs
+ # Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
- unless ( uc($1) eq $1 ) {
- unshift @_, ( $self, $1 );
- goto &{$self->can('call')};
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
}
- };
-}
-
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
- return 1;
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
}
sub preload {
@@ -166,8 +204,7 @@ sub preload {
my @exts = @{$self->{extensions}};
unless ( @exts ) {
- my $admin = $self->{admin};
- @exts = $admin->load_all_extensions;
+ @exts = $self->{admin}->load_all_extensions;
}
my %seen;
@@ -182,6 +219,7 @@ sub preload {
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
+ local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
@@ -192,12 +230,18 @@ sub preload {
sub new {
my ($class, %args) = @_;
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
delete $args{prefix};
}
-
return $args{_self} if $args{_self};
$args{dispatch} ||= 'Admin';
@@ -250,8 +294,10 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;
- unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
+ my $should_reload = 0;
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
+ $should_reload = 1;
}
foreach my $rv ( $self->find_extensions($path) ) {
@@ -259,12 +305,13 @@ sub load_extensions {
next if $self->{pathnames}{$pkg};
local $@;
- my $new = eval { require $file; $pkg->can('new') };
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
- $self->{pathnames}{$pkg} = delete $INC{$file};
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
@@ -314,7 +361,7 @@ sub find_extensions {
#####################################################################
-# Utility Functions
+# Common Utility Functions
sub _caller {
my $depth = 0;
@@ -326,33 +373,87 @@ sub _caller {
return $call;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+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_NEW
sub _read {
local *FH;
- open FH, "< $_[0]" or die "open($_[0]): $!";
- my $str = do { local $/; <FH> };
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
- return $str;
+ return $string;
+}
+END_OLD
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
- open FH, "> $_[0]" or die "open($_[0]): $!";
- foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[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).
-
sub _version ($) {
my $s = shift || 0;
- $s =~ s/^(\d+)\.?//;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
- my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
- $l = $l . '.' . join '', @v if @v;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
return $l + 0;
}
+sub _cmp ($$) {
+ _version($_[0]) <=> _version($_[1]);
+}
+
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
@@ -360,10 +461,10 @@ sub _CLASS ($) {
and
! ref $_[0]
and
- $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
-# Copyright 2008 - 2009 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index 343738e..f1f5356 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -2,13 +2,13 @@
package Module::Install::AutoInstall;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub AutoInstall { $_[0] }
@@ -37,12 +37,33 @@ sub auto_install {
$self->include('Module::AutoInstall');
require Module::AutoInstall;
- Module::AutoInstall->import(
+ my @features_require = Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
(@core ? (-core => \@core) : ()),
$self->features,
);
+ my %seen;
+ my @requires = map @$_, map @$_, grep ref, $self->requires;
+ while (my ($mod, $ver) = splice(@requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
+ while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
+ while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+
+ my @deduped;
+ while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
+ push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
+ }
+
+ $self->requires(@deduped);
+
$self->makemaker_args( Module::AutoInstall::_make_args() );
my $class = ref($self);
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 1145fe4..b55bda3 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -1,7 +1,11 @@
#line 1
package Module::Install::Base;
-$VERSION = '0.79';
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.00';
+}
# Suspend handler for "redefined" warnings
BEGIN {
@@ -9,54 +13,61 @@ BEGIN {
$SIG{__WARN__} = sub { $w };
}
-### This is the ONLY module that shouldn't have strict on
-# use strict;
-
-#line 41
+#line 42
sub new {
- my ($class, %args) = @_;
-
- foreach my $method ( qw(call load) ) {
- *{"$class\::$method"} = sub {
- shift()->_top->$method(@_);
- } unless defined &{"$class\::$method"};
- }
-
- bless( \%args, $class );
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
}
#line 61
sub AUTOLOAD {
- my $self = shift;
- local $@;
- my $autoload = eval { $self->_top->autoload } or return;
- goto &$autoload;
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
}
-#line 76
+#line 75
-sub _top { $_[0]->{_top} }
+sub _top {
+ $_[0]->{_top};
+}
-#line 89
+#line 90
sub admin {
- $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
}
-#line 101
+#line 106
sub is_admin {
- $_[0]->admin->VERSION;
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
-my $Fake;
-sub new { $Fake ||= bless(\@_, $_[0]) }
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
sub AUTOLOAD {}
@@ -69,4 +80,4 @@ BEGIN {
1;
-#line 146
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index ac81dec..71ccc27 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -2,18 +2,16 @@
package Module::Install::Can;
use strict;
-use Module::Install::Base;
-use Config ();
-### This adds a 5.005 Perl version dependency.
-### This is a bug and will be fixed.
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION $ISCORE @ISA};
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
# check if we can load some module
@@ -80,4 +78,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 158
+#line 156
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 41d9569..ec1f106 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -2,13 +2,13 @@
package Module::Install::Fetch;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub get_file {
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index 742121a..a28cd4c 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -2,13 +2,13 @@
package Module::Install::Include;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub include {
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 689a4b7..5dfd0e9 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -2,14 +2,15 @@
package Module::Install::Makefile;
use strict 'vars';
-use Module::Install::Base;
-use ExtUtils::MakeMaker ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub Makefile { $_[0] }
@@ -25,8 +26,8 @@ sub prompt {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
- # In automated testing, always use defaults
- if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
@@ -34,21 +35,112 @@ sub prompt {
}
}
+# 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
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
sub makemaker_args {
- my $self = shift;
+ my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$args, @_ );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
return $args;
}
# 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}
- ? join( ' ', $args->{name}, @_ )
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
@@ -89,98 +181,167 @@ sub inc {
$self->makemaker_args( INC => shift );
}
-my %test_dir = ();
-
sub _wanted_t {
- /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
}
sub tests_recursive {
my $self = shift;
- if ( $self->tests ) {
- die "tests_recursive will not work if tests are already defined";
- }
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
- %test_dir = ();
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
- File::Find::find( \&_wanted_t, $dir );
- $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
- # Make sure we have a new enough
- require ExtUtils::MakeMaker;
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # MakeMaker can complain about module versions that include
+ # an underscore, even though its own version may contain one!
+ # Hence the funny regexp to get rid of it. See RT #35800
+ # for details.
+ 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->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ }
- # Generate the
+ # Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ $DB::single = 1;
if ( $self->tests ) {
- $args->{test} = { TESTS => $self->tests };
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } 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) {
+ if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
}
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
- $args->{NO_META} = 1;
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
- # 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
- my $subdirs = ($args->{DIR} ||= []);
+ # 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, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
+ my %processed;
foreach my $bundle (@{ $self->bundles }) {
- my ($file, $dir) = @$bundle;
- push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
}
}
+ 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;
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $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};
}
@@ -204,9 +365,9 @@ sub fix_up_makefile {
. ($self->postamble || '');
local *MAKEFILE;
- open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; <MAKEFILE> };
- close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -226,7 +387,8 @@ sub fix_up_makefile {
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
- open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
@@ -250,4 +412,4 @@ sub postamble {
__END__
-#line 379
+#line 541
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 37d5eff..cfe45b3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -2,20 +2,23 @@
package Module::Install::Metadata;
use strict 'vars';
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
+my @boolean_keys = qw{
+ sign
+};
+
my @scalar_keys = qw{
name
module_name
abstract
- author
version
distribution_type
tests
@@ -37,16 +40,46 @@ my @resource_keys = qw{
repository
};
+my @array_keys = qw{
+ keywords
+ author
+};
+
+*authors = \&author;
+
sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
+ *$key = sub {
+ my $self = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+ return $self;
+ };
+}
foreach my $key ( @scalar_keys ) {
*$key = sub {
my $self = shift;
- return $self->{values}{$key} if defined wantarray and !@_;
- $self->{values}{$key} = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
return $self;
};
}
@@ -55,12 +88,12 @@ foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
- return () unless $self->{values}{resources};
+ return () unless $self->{values}->{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
- @{ $self->{values}{resources} };
+ @{ $self->{values}->{resources} };
}
- return $self->{values}{resources}{$key} unless @_;
+ return $self->{values}->{resources}->{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
@@ -69,17 +102,17 @@ foreach my $key ( @resource_keys ) {
};
}
-foreach my $key ( grep {$_ ne "resources"} @tuple_keys) {
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
*$key = sub {
my $self = shift;
- return $self->{values}{$key} unless @_;
+ return $self->{values}->{$key} unless @_;
my @added;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @added, [ $module, $version ];
}
- push @{ $self->{values}{$key} }, @added;
+ push @{ $self->{values}->{$key} }, @added;
return map {@$_} @added;
};
}
@@ -100,29 +133,22 @@ sub resources {
if ( $name eq lc $name and ! $lc_resource{$name} ) {
die("Unsupported reserved lowercase resource '$name'");
}
- $self->{values}{resources} ||= [];
- push @{ $self->{values}{resources} }, [ $name, $value ];
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
}
- $self->{values}{resources};
+ $self->{values}->{resources};
}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
-sub test_requires { shift->build_requires(@_) }
-sub install_requires { shift->build_requires(@_) }
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
-sub install_as_core { $_[0]->installdirs('perl') }
-sub install_as_cpan { $_[0]->installdirs('site') }
-sub install_as_site { $_[0]->installdirs('site') }
-sub install_as_vendor { $_[0]->installdirs('vendor') }
-
-sub sign {
- my $self = shift;
- return $self->{values}{sign} if defined wantarray and ! @_;
- $self->{values}{sign} = ( @_ ? $_[0] : 1 );
- return $self;
-}
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
my $self = shift;
@@ -130,13 +156,13 @@ sub dynamic_config {
warn "You MUST provide an explicit true/false value to dynamic_config\n";
return $self;
}
- $self->{values}{dynamic_config} = $_[0] ? 1 : 0;
+ $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
return 1;
}
sub perl_version {
my $self = shift;
- return $self->{values}{perl_version} unless @_;
+ return $self->{values}->{perl_version} unless @_;
my $version = shift or die(
"Did not provide a value to perl_version()"
);
@@ -149,23 +175,7 @@ sub perl_version {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
- $self->{values}{perl_version} = $version;
-}
-
-sub license {
- my $self = shift;
- return $self->{values}{license} unless @_;
- my $license = shift or die(
- 'Did not provide a value to license()'
- );
- $self->{values}{license} = $license;
-
- # Automatically fill in license URLs
- if ( $license eq 'perl' ) {
- $self->resources( license => 'http://dev.perl.org/licenses/' );
- }
-
- return 1;
+ $self->{values}->{perl_version} = $version;
}
sub all_from {
@@ -185,6 +195,8 @@ sub all_from {
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;
@@ -195,7 +207,7 @@ sub all_from {
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless $self->author;
+ $self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
@@ -204,7 +216,7 @@ sub all_from {
sub provides {
my $self = shift;
- my $provides = ( $self->{values}{provides} ||= {} );
+ my $provides = ( $self->{values}->{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
@@ -233,7 +245,7 @@ sub auto_provides {
sub feature {
my $self = shift;
my $name = shift;
- my $features = ( $self->{values}{features} ||= [] );
+ my $features = ( $self->{values}->{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
@@ -261,16 +273,16 @@ sub features {
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
- return $self->{values}{features}
- ? @{ $self->{values}{features} }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
- push @{ $self->{values}{no_index}{$type} }, @_ if $type;
- return $self->{values}{no_index};
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
}
sub read {
@@ -305,6 +317,9 @@ sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
@@ -315,7 +330,7 @@ sub abstract_from {
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
- );
+ );
}
# Add both distribution and module name
@@ -340,11 +355,10 @@ sub name_from {
}
}
-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_\.]+)
@@ -353,6 +367,16 @@ sub perl_version_from {
) {
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";
@@ -372,67 +396,180 @@ sub author_from {
([^\n]*)
/ixms) {
my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
-sub license_from {
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
my $self = shift;
- if (
- Module::Install::_read($_[0]) =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms ) {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as perl itself' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
- if ( $license_text =~ /\b$pattern\b/i ) {
- $self->license($license);
- return 1;
- }
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?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,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
}
}
+ return '';
+}
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
+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[^>]+|
+ \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
+ \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
}
sub bugtracker_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
- my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g;
+ my @links = _extract_bugtracker($content);
unless ( @links ) {
warn "Cannot determine bugtracker info from $_[0]\n";
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;
}
@@ -441,37 +578,107 @@ sub bugtracker_from {
return 1;
}
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
- $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
- $v = $v + 0; # Numify
+ # Numify
+ $v = $v + 0;
}
return $v;
}
-
-
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
######################################################################
-# MYMETA.yml Support
+# MYMETA Support
sub WriteMyMeta {
- $_[0]->write_mymeta;
+ die "WriteMyMeta has been deprecated";
}
-sub write_mymeta {
+sub write_mymeta_yaml {
my $self = shift;
-
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
# If there's no existing META.yml there is nothing we can do
- return unless -f 'META.yml';
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
@@ -488,8 +695,7 @@ sub write_mymeta {
}
# Load the advisory META.yml file
- require YAML::Tiny;
- my @yaml = YAML::Tiny::LoadFile('META.yml');
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
@@ -503,8 +709,7 @@ sub write_mymeta {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
- # Save as the MYMETA.yml file
- YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+ return $meta;
}
1;
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 2bd721a..edc18b4 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -2,12 +2,12 @@
package Module::Install::Win32;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
- @ISA = qw{Module::Install::Base};
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 3819d78..d0f6599 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -2,11 +2,11 @@
package Module::Install::WriteAll;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.79';
+ $VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -22,19 +22,42 @@ sub WriteAll {
);
$self->sign(1) if $args{sign};
- $self->Meta->write if $args{meta};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
- $self->makemaker_args( PL_FILES => {} );
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
}
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # we clean it up properly ourself.
+ $self->realclean_files('MYMETA.yml');
+
if ( $args{inline} ) {
$self->Inline->write;
} else {
$self->Makefile->write;
}
+
+ # The Makefile write process adds a couple of dependencies,
+ # so write the META.yml files after the Makefile.
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
+
+ return 1;
}
1;
commit daa9272b654c137a1d0f27cf24c9a1dd602584b1
Author: c9s <cornelius.howl at gmail.com>
Date: Wed Oct 20 02:02:28 2010 +0900
No sign
diff --git a/Makefile.PL b/Makefile.PL
index 8ae7888..69d8310 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -4,6 +4,7 @@ use inc::Module::Install;
name ('App-CLI');
author ('Chia-liang Kao <clkao at clkao.org>');
+# author ('Cornelius <cornelius.howl at gmail.com>');
abstract_from ('lib/App/CLI.pm');
license ('perl');
version_from ('lib/App/CLI.pm');
@@ -16,4 +17,5 @@ requires(
auto_install();
-WriteAll( sign => 1 );
+# WriteAll( sign => 1 );
+WriteAll( );
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index d9d20b1..37ffde9 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -1,5 +1,5 @@
package App::CLI;
-our $VERSION = '0.10';
+our $VERSION = '0.101';
use strict;
use warnings;
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 9b3af3f..d140545 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -10,23 +10,30 @@ App::CLI::Command - Base class for App::CLI commands
=head1 SYNOPSIS
- package MyApp;
- use base 'App::CLI';
+ package MyApp;
+ use base 'App::CLI';
- package main;
+ package main;
- MyApp->dispatch;
+ MyApp->dispatch;
- package MyApp::Help;
- use base 'App::CLI::Command';
- sub options {
- ('verbose' => 'verbose');
- }
+ package MyApp::Help;
+ use base 'App::CLI::Command';
- sub run {
- my ($self, $arg) = @_;
- }
+ sub options { (
+ 'verbose' => 'verbose',
+ 'n|name=s' => 'name'
+ }
+
+ sub run {
+ my ( $self, $arg ) = @_;
+
+ print "verbose" if $self->{verbose};
+
+ my $name = $self->{name};
+
+ }
=head1 DESCRIPTION
@@ -48,6 +55,12 @@ sub command_options {
$_[0]->options );
}
+# XXX:
+sub _mk_completion_sh { }
+sub _mk_completion_zsh { }
+
+
+
sub run_command {
my $self = shift;
$self->run(@_);
commit aea183d0682fef3f93f73b6b0f35b79e62e08155
Author: c9s <cornelius.howl at gmail.com>
Date: Wed Oct 20 02:02:41 2010 +0900
bump version
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 37ffde9..14f4cec 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -1,5 +1,5 @@
package App::CLI;
-our $VERSION = '0.101';
+our $VERSION = '0.102';
use strict;
use warnings;
commit 5dd88ad0aa1e21ca5d8d3be76f5cacfdaf4052a0
Author: c9s <cornelius.howl at gmail.com>
Date: Wed Oct 20 02:03:41 2010 +0900
Checking in changes prior to tagging of version 0.102.
Changelog diff is:
diff --git a/Changes b/Changes
index 7d46d98..a0ba131 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
+0.102 - Wed 20 Oct 2010 02:02:56 AM JST
+
+ * Re-upload
+
0.10 - 19 Oct 2010
* Update document
diff --git a/Changes b/Changes
index 7d46d98..a0ba131 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
+0.102 - Wed 20 Oct 2010 02:02:56 AM JST
+
+ * Re-upload
+
0.10 - 19 Oct 2010
* Update document
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
deleted file mode 100644
index 60b90ea..0000000
--- a/inc/Module/AutoInstall.pm
+++ /dev/null
@@ -1,820 +0,0 @@
-#line 1
-package Module::AutoInstall;
-
-use strict;
-use Cwd ();
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '1.03';
-}
-
-# special map on pre-defined feature sets
-my %FeatureMap = (
- '' => 'Core Features', # XXX: deprecated
- '-core' => 'Core Features',
-);
-
-# various lexical flags
-my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
-my (
- $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
-);
-my ( $PostambleActions, $PostambleUsed );
-
-# See if it's a testing or non-interactive session
-_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
-_init();
-
-sub _accept_default {
- $AcceptDefault = shift;
-}
-
-sub missing_modules {
- return @Missing;
-}
-
-sub do_install {
- __PACKAGE__->install(
- [
- $Config
- ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- : ()
- ],
- @Missing,
- );
-}
-
-# initialize various flags, and/or perform install
-sub _init {
- foreach my $arg (
- @ARGV,
- split(
- /[\s\t]+/,
- $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
- )
- )
- {
- if ( $arg =~ /^--config=(.*)$/ ) {
- $Config = [ split( ',', $1 ) ];
- }
- elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
- __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
- exit 0;
- }
- elsif ( $arg =~ /^--default(?:deps)?$/ ) {
- $AcceptDefault = 1;
- }
- elsif ( $arg =~ /^--check(?:deps)?$/ ) {
- $CheckOnly = 1;
- }
- elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
- $SkipInstall = 1;
- }
- elsif ( $arg =~ /^--test(?:only)?$/ ) {
- $TestOnly = 1;
- }
- elsif ( $arg =~ /^--all(?:deps)?$/ ) {
- $AllDeps = 1;
- }
- }
-}
-
-# overrides MakeMaker's prompt() to automatically accept the default choice
-sub _prompt {
- goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
-
- my ( $prompt, $default ) = @_;
- my $y = ( $default =~ /^[Yy]/ );
-
- print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
- print "$default\n";
- return $default;
-}
-
-# the workhorse
-sub import {
- my $class = shift;
- my @args = @_ or return;
- my $core_all;
-
- print "*** $class version " . $class->VERSION . "\n";
- print "*** Checking for Perl dependencies...\n";
-
- my $cwd = Cwd::cwd();
-
- $Config = [];
-
- my $maxlen = length(
- (
- sort { length($b) <=> length($a) }
- grep { /^[^\-]/ }
- map {
- ref($_)
- ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
- : ''
- }
- map { +{@args}->{$_} }
- grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
- )[0]
- );
-
- # We want to know if we're under CPAN early to avoid prompting, but
- # if we aren't going to try and install anything anyway then skip the
- # check entirely since we don't want to have to load (and configure)
- # an old CPAN just for a cosmetic message
-
- $UnderCPAN = _check_lock(1) unless $SkipInstall;
-
- while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
- my ( @required, @tests, @skiptests );
- my $default = 1;
- my $conflict = 0;
-
- if ( $feature =~ m/^-(\w+)$/ ) {
- my $option = lc($1);
-
- # check for a newer version of myself
- _update_to( $modules, @_ ) and return if $option eq 'version';
-
- # sets CPAN configuration options
- $Config = $modules if $option eq 'config';
-
- # promote every features to core status
- $core_all = ( $modules =~ /^all$/i ) and next
- if $option eq 'core';
-
- next unless $option eq 'core';
- }
-
- print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
-
- $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
-
- unshift @$modules, -default => &{ shift(@$modules) }
- if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
-
- while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
- if ( $mod =~ m/^-(\w+)$/ ) {
- my $option = lc($1);
-
- $default = $arg if ( $option eq 'default' );
- $conflict = $arg if ( $option eq 'conflict' );
- @tests = @{$arg} if ( $option eq 'tests' );
- @skiptests = @{$arg} if ( $option eq 'skiptests' );
-
- next;
- }
-
- printf( "- %-${maxlen}s ...", $mod );
-
- if ( $arg and $arg =~ /^\D/ ) {
- unshift @$modules, $arg;
- $arg = 0;
- }
-
- # XXX: check for conflicts and uninstalls(!) them.
- my $cur = _load($mod);
- if (_version_cmp ($cur, $arg) >= 0)
- {
- print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
- push @Existing, $mod => $arg;
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
- else {
- if (not defined $cur) # indeed missing
- {
- print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
- }
- else
- {
- # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
- print "too old. ($cur < $arg)\n";
- }
-
- push @required, $mod => $arg;
- }
- }
-
- next unless @required;
-
- my $mandatory = ( $feature eq '-core' or $core_all );
-
- if (
- !$SkipInstall
- and (
- $CheckOnly
- or ($mandatory and $UnderCPAN)
- or $AllDeps
- or _prompt(
- qq{==> Auto-install the }
- . ( @required / 2 )
- . ( $mandatory ? ' mandatory' : ' optional' )
- . qq{ module(s) from CPAN?},
- $default ? 'y' : 'n',
- ) =~ /^[Yy]/
- )
- )
- {
- push( @Missing, @required );
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
-
- elsif ( !$SkipInstall
- and $default
- and $mandatory
- and
- _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
- =~ /^[Nn]/ )
- {
- push( @Missing, @required );
- $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
- }
-
- else {
- $DisabledTests{$_} = 1 for map { glob($_) } @tests;
- }
- }
-
- if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
- require Config;
- print
-"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
-
- # make an educated guess of whether we'll need root permission.
- print " (You may need to do that as the 'root' user.)\n"
- if eval '$>';
- }
- print "*** $class configuration finished.\n";
-
- chdir $cwd;
-
- # import to main::
- no strict 'refs';
- *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
-
- return (@Existing, @Missing);
-}
-
-sub _running_under {
- my $thing = shift;
- print <<"END_MESSAGE";
-*** Since we're running under ${thing}, I'll just let it take care
- of the dependency's installation later.
-END_MESSAGE
- return 1;
-}
-
-# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
-# if we are, then we simply let it taking care of our dependencies
-sub _check_lock {
- return unless @Missing or @_;
-
- my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
-
- if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
- return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
- }
-
- require CPAN;
-
- if ($CPAN::VERSION > '1.89') {
- if ($cpan_env) {
- return _running_under('CPAN');
- }
- return; # CPAN.pm new enough, don't need to check further
- }
-
- # last ditch attempt, this -will- configure CPAN, very sorry
-
- _load_cpan(1); # force initialize even though it's already loaded
-
- # Find the CPAN lock-file
- my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
- return unless -f $lock;
-
- # Check the lock
- local *LOCK;
- return unless open(LOCK, $lock);
-
- if (
- ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
- and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
- ) {
- print <<'END_MESSAGE';
-
-*** Since we're running under CPAN, I'll just let it take care
- of the dependency's installation later.
-END_MESSAGE
- return 1;
- }
-
- close LOCK;
- return;
-}
-
-sub install {
- my $class = shift;
-
- my $i; # used below to strip leading '-' from config keys
- my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
-
- my ( @modules, @installed );
- while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
-
- # grep out those already installed
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- else {
- push @modules, $pkg, $ver;
- }
- }
-
- return @installed unless @modules; # nothing to do
- return @installed if _check_lock(); # defer to the CPAN shell
-
- print "*** Installing dependencies...\n";
-
- return unless _connected_to('cpan.org');
-
- my %args = @config;
- my %failed;
- local *FAILED;
- if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
- while (<FAILED>) { chomp; $failed{$_}++ }
- close FAILED;
-
- my @newmod;
- while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
- push @newmod, ( $k => $v ) unless $failed{$k};
- }
- @modules = @newmod;
- }
-
- if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
- _install_cpanplus( \@modules, \@config );
- } else {
- _install_cpan( \@modules, \@config );
- }
-
- print "*** $class installation finished.\n";
-
- # see if we have successfully installed them
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
- print FAILED "$pkg\n";
- }
- }
-
- close FAILED if $args{do_once};
-
- return @installed;
-}
-
-sub _install_cpanplus {
- my @modules = @{ +shift };
- my @config = _cpanplus_config( @{ +shift } );
- my $installed = 0;
-
- require CPANPLUS::Backend;
- my $cp = CPANPLUS::Backend->new;
- my $conf = $cp->configure_object;
-
- return unless $conf->can('conf') # 0.05x+ with "sudo" support
- or _can_write($conf->_get_build('base')); # 0.04x
-
- # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
- my $makeflags = $conf->get_conf('makeflags') || '';
- if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
- # 0.03+ uses a hashref here
- $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
-
- } else {
- # 0.02 and below uses a scalar
- $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
- if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
-
- }
- $conf->set_conf( makeflags => $makeflags );
- $conf->set_conf( prereqs => 1 );
-
-
-
- while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
- $conf->set_conf( $key, $val );
- }
-
- my $modtree = $cp->module_tree;
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- print "*** Installing $pkg...\n";
-
- MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
-
- my $success;
- my $obj = $modtree->{$pkg};
-
- if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
- my $pathname = $pkg;
- $pathname =~ s/::/\\W/;
-
- foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
- delete $INC{$inc};
- }
-
- my $rv = $cp->install( modules => [ $obj->{module} ] );
-
- if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
- print "*** $pkg successfully installed.\n";
- $success = 1;
- } else {
- print "*** $pkg installation cancelled.\n";
- $success = 0;
- }
-
- $installed += $success;
- } else {
- print << ".";
-*** Could not find a version $ver or above for $pkg; skipping.
-.
- }
-
- MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
- }
-
- return $installed;
-}
-
-sub _cpanplus_config {
- my @config = ();
- while ( @_ ) {
- my ($key, $value) = (shift(), shift());
- if ( $key eq 'prerequisites_policy' ) {
- if ( $value eq 'follow' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
- } elsif ( $value eq 'ask' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
- } elsif ( $value eq 'ignore' ) {
- $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
- } else {
- die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
- }
- } else {
- die "*** Cannot convert option $key to CPANPLUS version.\n";
- }
- }
- return @config;
-}
-
-sub _install_cpan {
- my @modules = @{ +shift };
- my @config = @{ +shift };
- my $installed = 0;
- my %args;
-
- _load_cpan();
- require Config;
-
- if (CPAN->VERSION < 1.80) {
- # no "sudo" support, probe for writableness
- return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
- and _can_write( $Config::Config{sitelib} );
- }
-
- # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
- my $makeflags = $CPAN::Config->{make_install_arg} || '';
- $CPAN::Config->{make_install_arg} =
- join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
- if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
-
- # don't show start-up info
- $CPAN::Config->{inhibit_startup_message} = 1;
-
- # set additional options
- while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
- ( $args{$opt} = $arg, next )
- if $opt =~ /^force$/; # pseudo-option
- $CPAN::Config->{$opt} = $arg;
- }
-
- local $CPAN::Config->{prerequisites_policy} = 'follow';
-
- while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
-
- print "*** Installing $pkg...\n";
-
- my $obj = CPAN::Shell->expand( Module => $pkg );
- my $success = 0;
-
- if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
- my $pathname = $pkg;
- $pathname =~ s/::/\\W/;
-
- foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
- delete $INC{$inc};
- }
-
- my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
- : CPAN::Shell->install($pkg);
- $rv ||= eval {
- $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
- ->{install}
- if $CPAN::META;
- };
-
- if ( $rv eq 'YES' ) {
- print "*** $pkg successfully installed.\n";
- $success = 1;
- }
- else {
- print "*** $pkg installation failed.\n";
- $success = 0;
- }
-
- $installed += $success;
- }
- else {
- print << ".";
-*** Could not find a version $ver or above for $pkg; skipping.
-.
- }
-
- MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
- }
-
- return $installed;
-}
-
-sub _has_cpanplus {
- return (
- $HasCPANPLUS = (
- $INC{'CPANPLUS/Config.pm'}
- or _load('CPANPLUS::Shell::Default')
- )
- );
-}
-
-# make guesses on whether we're under the CPAN installation directory
-sub _under_cpan {
- require Cwd;
- require File::Spec;
-
- my $cwd = File::Spec->canonpath( Cwd::cwd() );
- my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
-
- return ( index( $cwd, $cpan ) > -1 );
-}
-
-sub _update_to {
- my $class = __PACKAGE__;
- my $ver = shift;
-
- return
- if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
-
- if (
- _prompt( "==> A newer version of $class ($ver) is required. Install?",
- 'y' ) =~ /^[Nn]/
- )
- {
- die "*** Please install $class $ver manually.\n";
- }
-
- print << ".";
-*** Trying to fetch it from CPAN...
-.
-
- # install ourselves
- _load($class) and return $class->import(@_)
- if $class->install( [], $class, $ver );
-
- print << '.'; exit 1;
-
-*** Cannot bootstrap myself. :-( Installation terminated.
-.
-}
-
-# check if we're connected to some host, using inet_aton
-sub _connected_to {
- my $site = shift;
-
- return (
- ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
- qq(
-*** Your host cannot resolve the domain name '$site', which
- probably means the Internet connections are unavailable.
-==> Should we try to install the required module(s) anyway?), 'n'
- ) =~ /^[Yy]/
- );
-}
-
-# check if a directory is writable; may create it on demand
-sub _can_write {
- my $path = shift;
- mkdir( $path, 0755 ) unless -e $path;
-
- return 1 if -w $path;
-
- print << ".";
-*** You are not allowed to write to the directory '$path';
- the installation may fail due to insufficient permissions.
-.
-
- if (
- eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
- qq(
-==> Should we try to re-execute the autoinstall process with 'sudo'?),
- ((-t STDIN) ? 'y' : 'n')
- ) =~ /^[Yy]/
- )
- {
-
- # try to bootstrap ourselves from sudo
- print << ".";
-*** Trying to re-execute the autoinstall process with 'sudo'...
-.
- my $missing = join( ',', @Missing );
- my $config = join( ',',
- UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- if $Config;
-
- return
- unless system( 'sudo', $^X, $0, "--config=$config",
- "--installdeps=$missing" );
-
- print << ".";
-*** The 'sudo' command exited with error! Resuming...
-.
- }
-
- return _prompt(
- qq(
-==> Should we try to install the required module(s) anyway?), 'n'
- ) =~ /^[Yy]/;
-}
-
-# load a module and return the version it reports
-sub _load {
- my $mod = pop; # class/instance doesn't matter
- my $file = $mod;
-
- $file =~ s|::|/|g;
- $file .= '.pm';
-
- local $@;
- return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
-}
-
-# Load CPAN.pm and it's configuration
-sub _load_cpan {
- return if $CPAN::VERSION and $CPAN::Config and not @_;
- require CPAN;
-
- # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
- # CPAN::HandleConfig->load. CPAN reports that the redirection
- # is deprecated in a warning printed at the user.
-
- # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
- # $CPAN::HandleConfig::VERSION but cannot handle
- # CPAN::Config->load
-
- # Which "versions expect CPAN::Config->load?
-
- if ( $CPAN::HandleConfig::VERSION
- || CPAN::HandleConfig->can('load')
- ) {
- # Newer versions of CPAN have a HandleConfig module
- CPAN::HandleConfig->load;
- } else {
- # Older versions had the load method in Config directly
- CPAN::Config->load;
- }
-}
-
-# compare two versions, either use Sort::Versions or plain comparison
-# return values same as <=>
-sub _version_cmp {
- my ( $cur, $min ) = @_;
- return -1 unless defined $cur; # if 0 keep comparing
- return 1 unless $min;
-
- $cur =~ s/\s+$//;
-
- # check for version numbers that are not in decimal format
- if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
- if ( ( $version::VERSION or defined( _load('version') )) and
- version->can('new')
- ) {
-
- # use version.pm if it is installed.
- return version->new($cur) <=> version->new($min);
- }
- elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
- {
-
- # use Sort::Versions as the sorting algorithm for a.b.c versions
- return Sort::Versions::versioncmp( $cur, $min );
- }
-
- warn "Cannot reliably compare non-decimal formatted versions.\n"
- . "Please install version.pm or Sort::Versions.\n";
- }
-
- # plain comparison
- local $^W = 0; # shuts off 'not numeric' bugs
- return $cur <=> $min;
-}
-
-# nothing; this usage is deprecated.
-sub main::PREREQ_PM { return {}; }
-
-sub _make_args {
- my %args = @_;
-
- $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
- if $UnderCPAN or $TestOnly;
-
- if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
- require ExtUtils::Manifest;
- my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
-
- $args{EXE_FILES} =
- [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
- }
-
- $args{test}{TESTS} ||= 't/*.t';
- $args{test}{TESTS} = join( ' ',
- grep { !exists( $DisabledTests{$_} ) }
- map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
-
- my $missing = join( ',', @Missing );
- my $config =
- join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
- if $Config;
-
- $PostambleActions = (
- ($missing and not $UnderCPAN)
- ? "\$(PERL) $0 --config=$config --installdeps=$missing"
- : "\$(NOECHO) \$(NOOP)"
- );
-
- return %args;
-}
-
-# a wrapper to ExtUtils::MakeMaker::WriteMakefile
-sub Write {
- require Carp;
- Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
-
- if ($CheckOnly) {
- print << ".";
-*** Makefile not written in check-only mode.
-.
- return;
- }
-
- my %args = _make_args(@_);
-
- no strict 'refs';
-
- $PostambleUsed = 0;
- local *MY::postamble = \&postamble unless defined &MY::postamble;
- ExtUtils::MakeMaker::WriteMakefile(%args);
-
- print << "." unless $PostambleUsed;
-*** WARNING: Makefile written with customized MY::postamble() without
- including contents from Module::AutoInstall::postamble() --
- auto installation features disabled. Please contact the author.
-.
-
- return 1;
-}
-
-sub postamble {
- $PostambleUsed = 1;
-
- return <<"END_MAKE";
-
-config :: installdeps
-\t\$(NOECHO) \$(NOOP)
-
-checkdeps ::
-\t\$(PERL) $0 --checkdeps
-
-installdeps ::
-\t$PostambleActions
-
-END_MAKE
-
-}
-
-1;
-
-__END__
-
-#line 1071
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
deleted file mode 100644
index 8ee839d..0000000
--- a/inc/Module/Install.pm
+++ /dev/null
@@ -1,470 +0,0 @@
-#line 1
-package Module::Install;
-
-# For any maintainers:
-# The load order for Module::Install is a bit magic.
-# It goes something like this...
-#
-# IF ( host has Module::Install installed, creating author mode ) {
-# 1. Makefile.PL calls "use inc::Module::Install"
-# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
-# 3. The installed version of inc::Module::Install loads
-# 4. inc::Module::Install calls "require Module::Install"
-# 5. The ./inc/ version of Module::Install loads
-# } ELSE {
-# 1. Makefile.PL calls "use inc::Module::Install"
-# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
-# 3. The ./inc/ version of Module::Install loads
-# }
-
-use 5.005;
-use strict 'vars';
-use Cwd ();
-use File::Find ();
-use File::Path ();
-
-use vars qw{$VERSION $MAIN};
-BEGIN {
- # All Module::Install core packages now require synchronised versions.
- # This will be used to ensure we don't accidentally load old or
- # different versions of modules.
- # 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 = '1.00';
-
- # Storage for the pseudo-singleton
- $MAIN = undef;
-
- *inc::Module::Install::VERSION = *VERSION;
- @inc::Module::Install::ISA = __PACKAGE__;
-
-}
-
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- #-------------------------------------------------------------
- # all of the following checks should be included in import(),
- # to allow "eval 'require Module::Install; 1' to test
- # installation of Module::Install. (RT #51267)
- #-------------------------------------------------------------
-
- # Whether or not inc::Module::Install is actually loaded, the
- # $INC{inc/Module/Install.pm} is what will still get set as long as
- # the caller loaded module this in the documented manner.
- # If not set, the caller may NOT have loaded the bundled version, and thus
- # they may not have a MI version that works with the Makefile.PL. This would
- # result in false errors or unexpected behaviour. And we don't want that.
- my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
- unless ( $INC{$file} ) { die <<"END_DIE" }
-
-Please invoke ${\__PACKAGE__} with:
-
- use inc::${\__PACKAGE__};
-
-not:
-
- use ${\__PACKAGE__};
-
-END_DIE
-
- # This reportedly fixes a rare Win32 UTC file time issue, but
- # as this is a non-cross-platform XS module not in the core,
- # we shouldn't really depend on it. See RT #24194 for detail.
- # (Also, this module only supports Perl 5.6 and above).
- eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
-
- # If the script that is loading Module::Install is from the future,
- # then make will detect this and cause it to re-run over and over
- # again. This is bad. Rather than taking action to touch it (which
- # is unreliable on some platforms and requires write permissions)
- # for now we should catch this and refuse to run.
- if ( -f $0 ) {
- my $s = (stat($0))[9];
-
- # If the modification time is only slightly in the future,
- # sleep briefly to remove the problem.
- my $a = $s - time;
- if ( $a > 0 and $a < 5 ) { sleep 5 }
-
- # Too far in the future, throw an error.
- my $t = time;
- if ( $s > $t ) { die <<"END_DIE" }
-
-Your installer $0 has a modification time in the future ($s > $t).
-
-This is known to create infinite loops in make.
-
-Please correct this, then run $0 again.
-
-END_DIE
- }
-
-
- # Build.PL was formerly supported, but no longer is due to excessive
- # difficulty in implementing every single feature twice.
- if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
-
-Module::Install no longer supports Build.PL.
-
-It was impossible to maintain duel backends, and has been deprecated.
-
-Please remove all Build.PL files and only use the Makefile.PL installer.
-
-END_DIE
-
- #-------------------------------------------------------------
-
- # To save some more typing in Module::Install installers, every...
- # use inc::Module::Install
- # ...also acts as an implicit use strict.
- $^H |= strict::bits(qw(refs subs vars));
-
- #-------------------------------------------------------------
-
- unless ( -f $self->{file} ) {
- foreach my $key (keys %INC) {
- delete $INC{$key} if $key =~ /Module\/Install/;
- }
-
- local $^W;
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- local $^W;
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{'inc/Module/Install.pm'};
- delete $INC{'Module/Install.pm'};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
-sub autoload {
- my $self = shift;
- my $who = $self->_caller;
- my $cwd = Cwd::cwd();
- my $sym = "${who}::AUTOLOAD";
- $sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
- if ( my $code = $sym->{$pwd} ) {
- # Delegate back to parent dirs
- goto &$code unless $cwd eq $pwd;
- }
- unless ($$sym =~ s/([^:]+)$//) {
- # XXX: it looks like we can't retrieve the missing function
- # via $$sym (usually $main::AUTOLOAD) in this case.
- # I'm still wondering if we should slurp Makefile.PL to
- # get some context or not ...
- my ($package, $file, $line) = caller;
- die <<"EOT";
-Unknown function is found at $file line $line.
-Execution of $file aborted due to runtime errors.
-
-If you're a contributor to a project, you may need to install
-some Module::Install extensions from CPAN (or other repository).
-If you're a user of a module, please contact the author.
-EOT
- }
- my $method = $1;
- if ( uc($method) eq $method ) {
- # Do nothing
- return;
- } elsif ( $method =~ /^_/ and $self->can($method) ) {
- # Dispatch to the root M:I class
- return $self->$method(@_);
- }
-
- # Dispatch to the appropriate plugin
- unshift @_, ( $self, $1 );
- goto &{$self->can('call')};
- };
-}
-
-sub preload {
- my $self = shift;
- unless ( $self->{extensions} ) {
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- );
- }
-
- my @exts = @{$self->{extensions}};
- unless ( @exts ) {
- @exts = $self->{admin}->load_all_extensions;
- }
-
- my %seen;
- foreach my $obj ( @exts ) {
- while (my ($method, $glob) = each %{ref($obj) . '::'}) {
- next unless $obj->can($method);
- next if $method =~ /^_/;
- next if $method eq uc($method);
- $seen{$method}++;
- }
- }
-
- my $who = $self->_caller;
- foreach my $name ( sort keys %seen ) {
- local $^W;
- *{"${who}::$name"} = sub {
- ${"${who}::AUTOLOAD"} = "${who}::$name";
- goto &{"${who}::AUTOLOAD"};
- };
- }
-}
-
-sub new {
- my ($class, %args) = @_;
-
- delete $INC{'FindBin.pm'};
- {
- # to suppress the redefine warning
- local $SIG{__WARN__} = sub {};
- require FindBin;
- }
-
- # ignore the prefix on extension modules built from top level.
- my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
- delete $args{prefix};
- }
- return $args{_self} if $args{_self};
-
- $args{dispatch} ||= 'Admin';
- $args{prefix} ||= 'inc';
- $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
- $args{bundle} ||= 'inc/BUNDLES';
- $args{base} ||= $base_path;
- $class =~ s/^\Q$args{prefix}\E:://;
- $args{name} ||= $class;
- $args{version} ||= $class->VERSION;
- unless ( $args{path} ) {
- $args{path} = $args{name};
- $args{path} =~ s!::!/!g;
- }
- $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
- $args{wrote} = 0;
-
- bless( \%args, $class );
-}
-
-sub call {
- my ($self, $method) = @_;
- my $obj = $self->load($method) or return;
- splice(@_, 0, 2, $obj);
- goto &{$obj->can($method)};
-}
-
-sub load {
- my ($self, $method) = @_;
-
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- ) unless $self->{extensions};
-
- foreach my $obj (@{$self->{extensions}}) {
- return $obj if $obj->can($method);
- }
-
- my $admin = $self->{admin} or die <<"END_DIE";
-The '$method' method does not exist in the '$self->{prefix}' path!
-Please remove the '$self->{prefix}' directory and run $0 again to load it.
-END_DIE
-
- my $obj = $admin->load($method, 1);
- push @{$self->{extensions}}, $obj;
-
- $obj;
-}
-
-sub load_extensions {
- my ($self, $path, $top) = @_;
-
- my $should_reload = 0;
- unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
- unshift @INC, $self->{prefix};
- $should_reload = 1;
- }
-
- foreach my $rv ( $self->find_extensions($path) ) {
- my ($file, $pkg) = @{$rv};
- next if $self->{pathnames}{$pkg};
-
- local $@;
- my $new = eval { local $^W; require $file; $pkg->can('new') };
- unless ( $new ) {
- warn $@ if $@;
- next;
- }
- $self->{pathnames}{$pkg} =
- $should_reload ? delete $INC{$file} : $INC{$file};
- push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
- }
-
- $self->{extensions} ||= [];
-}
-
-sub find_extensions {
- my ($self, $path) = @_;
-
- my @found;
- File::Find::find( sub {
- my $file = $File::Find::name;
- return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
- my $subpath = $1;
- return if lc($subpath) eq lc($self->{dispatch});
-
- $file = "$self->{path}/$subpath.pm";
- my $pkg = "$self->{name}::$subpath";
- $pkg =~ s!/!::!g;
-
- # If we have a mixed-case package name, assume case has been preserved
- # correctly. Otherwise, root through the file to locate the case-preserved
- # version of the package name.
- if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
- my $content = Module::Install::_read($subpath . '.pm');
- my $in_pod = 0;
- foreach ( split //, $content ) {
- $in_pod = 1 if /^=\w/;
- $in_pod = 0 if /^=cut/;
- next if ($in_pod || /^=cut/); # skip pod text
- next if /^\s*#/; # and comments
- if ( m/^\s*package\s+($pkg)\s*;/i ) {
- $pkg = $1;
- last;
- }
- }
- }
-
- push @found, [ $file, $pkg ];
- }, $path ) if -d $path;
-
- @found;
-}
-
-
-
-
-
-#####################################################################
-# Common Utility Functions
-
-sub _caller {
- my $depth = 0;
- my $call = caller($depth);
- while ( $call eq __PACKAGE__ ) {
- $depth++;
- $call = caller($depth);
- }
- return $call;
-}
-
-# Done in evals to avoid confusing Perl::MinimumVersion
-eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
-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_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]);
- $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
- $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
- $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
- return $string;
-}
-
-sub _readpod {
- my $string = Module::Install::_read($_[0]);
- $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
- return $string if $_[0] =~ /\.pod\z/;
- $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
- $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
- $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
- $string =~ s/^\n+//s;
- return $string;
-}
-
-# Done in evals to avoid confusing Perl::MinimumVersion
-eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
-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_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).
-sub _version ($) {
- my $s = shift || 0;
- my $d =()= $s =~ /(\.)/g;
- if ( $d >= 2 ) {
- # Normalise multipart versions
- $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
- }
- $s =~ s/^(\d+)\.?//;
- my $l = $1 || 0;
- my @v = map {
- $_ . '0' x (3 - length $_)
- } $s =~ /(\d{1,3})\D?/g;
- $l = $l . '.' . join '', @v if @v;
- return $l + 0;
-}
-
-sub _cmp ($$) {
- _version($_[0]) <=> _version($_[1]);
-}
-
-# Cloned from Params::Util::_CLASS
-sub _CLASS ($) {
- (
- defined $_[0]
- and
- ! ref $_[0]
- and
- $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
- ) ? $_[0] : undef;
-}
-
-1;
-
-# Copyright 2008 - 2010 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
deleted file mode 100644
index f1f5356..0000000
--- a/inc/Module/Install/AutoInstall.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-#line 1
-package Module::Install::AutoInstall;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub AutoInstall { $_[0] }
-
-sub run {
- my $self = shift;
- $self->auto_install_now(@_);
-}
-
-sub write {
- my $self = shift;
- $self->auto_install(@_);
-}
-
-sub auto_install {
- my $self = shift;
- return if $self->{done}++;
-
- # Flatten array of arrays into a single array
- my @core = map @$_, map @$_, grep ref,
- $self->build_requires, $self->requires;
-
- my @config = @_;
-
- # We'll need Module::AutoInstall
- $self->include('Module::AutoInstall');
- require Module::AutoInstall;
-
- my @features_require = Module::AutoInstall->import(
- (@config ? (-config => \@config) : ()),
- (@core ? (-core => \@core) : ()),
- $self->features,
- );
-
- my %seen;
- my @requires = map @$_, map @$_, grep ref, $self->requires;
- while (my ($mod, $ver) = splice(@requires, 0, 2)) {
- $seen{$mod}{$ver}++;
- }
- my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
- while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
- $seen{$mod}{$ver}++;
- }
- my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
- while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
- $seen{$mod}{$ver}++;
- }
-
- my @deduped;
- while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
- push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
- }
-
- $self->requires(@deduped);
-
- $self->makemaker_args( Module::AutoInstall::_make_args() );
-
- my $class = ref($self);
- $self->postamble(
- "# --- $class section:\n" .
- Module::AutoInstall::postamble()
- );
-}
-
-sub auto_install_now {
- my $self = shift;
- $self->auto_install(@_);
- Module::AutoInstall::do_install();
-}
-
-1;
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
deleted file mode 100644
index b55bda3..0000000
--- a/inc/Module/Install/Base.pm
+++ /dev/null
@@ -1,83 +0,0 @@
-#line 1
-package Module::Install::Base;
-
-use strict 'vars';
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '1.00';
-}
-
-# Suspend handler for "redefined" warnings
-BEGIN {
- my $w = $SIG{__WARN__};
- $SIG{__WARN__} = sub { $w };
-}
-
-#line 42
-
-sub new {
- my $class = shift;
- unless ( defined &{"${class}::call"} ) {
- *{"${class}::call"} = sub { shift->_top->call(@_) };
- }
- unless ( defined &{"${class}::load"} ) {
- *{"${class}::load"} = sub { shift->_top->load(@_) };
- }
- bless { @_ }, $class;
-}
-
-#line 61
-
-sub AUTOLOAD {
- local $@;
- my $func = eval { shift->_top->autoload } or return;
- goto &$func;
-}
-
-#line 75
-
-sub _top {
- $_[0]->{_top};
-}
-
-#line 90
-
-sub admin {
- $_[0]->_top->{admin}
- or
- Module::Install::Base::FakeAdmin->new;
-}
-
-#line 106
-
-sub is_admin {
- ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
-}
-
-sub DESTROY {}
-
-package Module::Install::Base::FakeAdmin;
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = $Module::Install::Base::VERSION;
-}
-
-my $fake;
-
-sub new {
- $fake ||= bless(\@_, $_[0]);
-}
-
-sub AUTOLOAD {}
-
-sub DESTROY {}
-
-# Restore warning handler
-BEGIN {
- $SIG{__WARN__} = $SIG{__WARN__}->();
-}
-
-1;
-
-#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
deleted file mode 100644
index 71ccc27..0000000
--- a/inc/Module/Install/Can.pm
+++ /dev/null
@@ -1,81 +0,0 @@
-#line 1
-package Module::Install::Can;
-
-use strict;
-use Config ();
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-# check if we can load some module
-### Upgrade this to not have to load the module if possible
-sub can_use {
- my ($self, $mod, $ver) = @_;
- $mod =~ s{::|\\}{/}g;
- $mod .= '.pm' unless $mod =~ /\.pm$/i;
-
- my $pkg = $mod;
- $pkg =~ s{/}{::}g;
- $pkg =~ s{\.pm$}{}i;
-
- local $@;
- eval { require $mod; $pkg->VERSION($ver || 0); 1 };
-}
-
-# check if we can run some command
-sub can_run {
- my ($self, $cmd) = @_;
-
- my $_cmd = $cmd;
- return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
-
- for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
- next if $dir eq '';
- my $abs = File::Spec->catfile($dir, $_[1]);
- return $abs if (-x $abs or $abs = MM->maybe_command($abs));
- }
-
- return;
-}
-
-# can we locate a (the) C compiler
-sub can_cc {
- my $self = shift;
- my @chunks = split(/ /, $Config::Config{cc}) or return;
-
- # $Config{cc} may contain args; try to find out the program part
- while (@chunks) {
- return $self->can_run("@chunks") || (pop(@chunks), next);
- }
-
- return;
-}
-
-# Fix Cygwin bug on maybe_command();
-if ( $^O eq 'cygwin' ) {
- require ExtUtils::MM_Cygwin;
- require ExtUtils::MM_Win32;
- if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
- *ExtUtils::MM_Cygwin::maybe_command = sub {
- my ($self, $file) = @_;
- if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
- ExtUtils::MM_Win32->maybe_command($file);
- } else {
- ExtUtils::MM_Unix->maybe_command($file);
- }
- }
- }
-}
-
-1;
-
-__END__
-
-#line 156
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
deleted file mode 100644
index ec1f106..0000000
--- a/inc/Module/Install/Fetch.pm
+++ /dev/null
@@ -1,93 +0,0 @@
-#line 1
-package Module::Install::Fetch;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub get_file {
- my ($self, %args) = @_;
- my ($scheme, $host, $path, $file) =
- $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
-
- if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
- $args{url} = $args{ftp_url}
- or (warn("LWP support unavailable!\n"), return);
- ($scheme, $host, $path, $file) =
- $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
- }
-
- $|++;
- print "Fetching '$file' from $host... ";
-
- unless (eval { require Socket; Socket::inet_aton($host) }) {
- warn "'$host' resolve failed!\n";
- return;
- }
-
- return unless $scheme eq 'ftp' or $scheme eq 'http';
-
- require Cwd;
- my $dir = Cwd::getcwd();
- chdir $args{local_dir} or return if exists $args{local_dir};
-
- if (eval { require LWP::Simple; 1 }) {
- LWP::Simple::mirror($args{url}, $file);
- }
- elsif (eval { require Net::FTP; 1 }) { eval {
- # use Net::FTP to get past firewall
- my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
- $ftp->login("anonymous", 'anonymous at example.com');
- $ftp->cwd($path);
- $ftp->binary;
- $ftp->get($file) or (warn("$!\n"), return);
- $ftp->quit;
- } }
- elsif (my $ftp = $self->can_run('ftp')) { eval {
- # no Net::FTP, fallback to ftp.exe
- require FileHandle;
- my $fh = FileHandle->new;
-
- local $SIG{CHLD} = 'IGNORE';
- unless ($fh->open("|$ftp -n")) {
- warn "Couldn't open ftp: $!\n";
- chdir $dir; return;
- }
-
- my @dialog = split(/\n/, <<"END_FTP");
-open $host
-user anonymous anonymous\@example.com
-cd $path
-binary
-get $file $file
-quit
-END_FTP
- foreach (@dialog) { $fh->print("$_\n") }
- $fh->close;
- } }
- else {
- warn "No working 'ftp' program available!\n";
- chdir $dir; return;
- }
-
- unless (-f $file) {
- warn "Fetching failed: $@\n";
- chdir $dir; return;
- }
-
- return if exists $args{size} and -s $file != $args{size};
- system($args{run}) if exists $args{run};
- unlink($file) if $args{remove};
-
- print(((!exists $args{check_for} or -e $args{check_for})
- ? "done!" : "failed! ($!)"), "\n");
- chdir $dir; return !$?;
-}
-
-1;
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
deleted file mode 100644
index a28cd4c..0000000
--- a/inc/Module/Install/Include.pm
+++ /dev/null
@@ -1,34 +0,0 @@
-#line 1
-package Module::Install::Include;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub include {
- shift()->admin->include(@_);
-}
-
-sub include_deps {
- shift()->admin->include_deps(@_);
-}
-
-sub auto_include {
- shift()->admin->auto_include(@_);
-}
-
-sub auto_include_deps {
- shift()->admin->auto_include_deps(@_);
-}
-
-sub auto_include_dependent_dists {
- shift()->admin->auto_include_dependent_dists(@_);
-}
-
-1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
deleted file mode 100644
index 5dfd0e9..0000000
--- a/inc/Module/Install/Makefile.pm
+++ /dev/null
@@ -1,415 +0,0 @@
-#line 1
-package Module::Install::Makefile;
-
-use strict 'vars';
-use ExtUtils::MakeMaker ();
-use Module::Install::Base ();
-use Fcntl qw/:flock :seek/;
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-sub Makefile { $_[0] }
-
-my %seen = ();
-
-sub prompt {
- shift;
-
- # Infinite loop protection
- my @c = caller();
- if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
- die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
- }
-
- # In automated testing or non-interactive session, always use defaults
- if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
- local $ENV{PERL_MM_USE_DEFAULT} = 1;
- goto &ExtUtils::MakeMaker::prompt;
- } else {
- goto &ExtUtils::MakeMaker::prompt;
- }
-}
-
-# 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
-}
-
-# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
-# as we only need to know here whether the attribute is an array
-# or a hash or something else (which may or may not be appendable).
-my %makemaker_argtype = (
- C => 'ARRAY',
- CONFIG => 'ARRAY',
-# CONFIGURE => 'CODE', # ignore
- DIR => 'ARRAY',
- DL_FUNCS => 'HASH',
- DL_VARS => 'ARRAY',
- EXCLUDE_EXT => 'ARRAY',
- EXE_FILES => 'ARRAY',
- FUNCLIST => 'ARRAY',
- H => 'ARRAY',
- IMPORTS => 'HASH',
- INCLUDE_EXT => 'ARRAY',
- LIBS => 'ARRAY', # ignore ''
- MAN1PODS => 'HASH',
- MAN3PODS => 'HASH',
- META_ADD => 'HASH',
- META_MERGE => 'HASH',
- PL_FILES => 'HASH',
- PM => 'HASH',
- PMLIBDIRS => 'ARRAY',
- PMLIBPARENTDIRS => 'ARRAY',
- PREREQ_PM => 'HASH',
- CONFIGURE_REQUIRES => 'HASH',
- SKIP => 'ARRAY',
- TYPEMAPS => 'ARRAY',
- XS => 'HASH',
-# VERSION => ['version',''], # ignore
-# _KEEP_AFTER_FLUSH => '',
-
- clean => 'HASH',
- depend => 'HASH',
- dist => 'HASH',
- dynamic_lib=> 'HASH',
- linkext => 'HASH',
- macro => 'HASH',
- postamble => 'HASH',
- realclean => 'HASH',
- test => 'HASH',
- tool_autosplit => 'HASH',
-
- # special cases where you can use makemaker_append
- CCFLAGS => 'APPENDABLE',
- DEFINE => 'APPENDABLE',
- INC => 'APPENDABLE',
- LDDLFLAGS => 'APPENDABLE',
- LDFROM => 'APPENDABLE',
-);
-
-sub makemaker_args {
- my ($self, %new_args) = @_;
- my $args = ( $self->{makemaker_args} ||= {} );
- foreach my $key (keys %new_args) {
- if ($makemaker_argtype{$key}) {
- if ($makemaker_argtype{$key} eq 'ARRAY') {
- $args->{$key} = [] unless defined $args->{$key};
- unless (ref $args->{$key} eq 'ARRAY') {
- $args->{$key} = [$args->{$key}]
- }
- push @{$args->{$key}},
- ref $new_args{$key} eq 'ARRAY'
- ? @{$new_args{$key}}
- : $new_args{$key};
- }
- elsif ($makemaker_argtype{$key} eq 'HASH') {
- $args->{$key} = {} unless defined $args->{$key};
- foreach my $skey (keys %{ $new_args{$key} }) {
- $args->{$key}{$skey} = $new_args{$key}{$skey};
- }
- }
- elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
- $self->makemaker_append($key => $new_args{$key});
- }
- }
- else {
- if (defined $args->{$key}) {
- warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
- }
- $args->{$key} = $new_args{$key};
- }
- }
- return $args;
-}
-
-# For mm args that take multiple space-seperated args,
-# append an argument to the current list.
-sub makemaker_append {
- my $self = shift;
- my $name = shift;
- my $args = $self->makemaker_args;
- $args->{$name} = defined $args->{$name}
- ? join( ' ', $args->{$name}, @_ )
- : join( ' ', @_ );
-}
-
-sub build_subdirs {
- my $self = shift;
- my $subdirs = $self->makemaker_args->{DIR} ||= [];
- for my $subdir (@_) {
- push @$subdirs, $subdir;
- }
-}
-
-sub clean_files {
- my $self = shift;
- my $clean = $self->makemaker_args->{clean} ||= {};
- %$clean = (
- %$clean,
- FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
- );
-}
-
-sub realclean_files {
- my $self = shift;
- my $realclean = $self->makemaker_args->{realclean} ||= {};
- %$realclean = (
- %$realclean,
- FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
- );
-}
-
-sub libs {
- my $self = shift;
- my $libs = ref $_[0] ? shift : [ shift ];
- $self->makemaker_args( LIBS => $libs );
-}
-
-sub inc {
- my $self = shift;
- $self->makemaker_args( INC => shift );
-}
-
-sub _wanted_t {
-}
-
-sub tests_recursive {
- my $self = shift;
- my $dir = shift || 't';
- unless ( -d $dir ) {
- die "tests_recursive dir '$dir' does not exist";
- }
- my %tests = map { $_ => 1 } split / /, ($self->tests || '');
- require File::Find;
- File::Find::find(
- sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
- $dir
- );
- $self->tests( join ' ', sort keys %tests );
-}
-
-sub write {
- my $self = shift;
- die "&Makefile->write() takes no arguments\n" if @_;
-
- # Check the current Perl version
- my $perl_version = $self->perl_version;
- if ( $perl_version ) {
- eval "use $perl_version; 1"
- or die "ERROR: perl: Version $] is installed, "
- . "but we need version >= $perl_version";
- }
-
- # Make sure we have a new enough MakeMaker
- require ExtUtils::MakeMaker;
-
- if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
- 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->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
- }
-
- # Generate the MakeMaker params
- my $args = $self->makemaker_args;
- $args->{DISTNAME} = $self->name;
- $args->{NAME} = $self->module_name || $self->name;
- $args->{NAME} =~ s/-/::/g;
- $args->{VERSION} = $self->version or die <<'EOT';
-ERROR: Can't determine distribution version. Please specify it
-explicitly via 'version' in Makefile.PL, or set a valid $VERSION
-in a module, and provide its file path via 'version_from' (or
-'all_from' if you prefer) in Makefile.PL.
-EOT
-
- $DB::single = 1;
- if ( $self->tests ) {
- my @tests = split ' ', $self->tests;
- my %seen;
- $args->{test} = {
- TESTS => (join ' ', grep {!$seen{$_}++} @tests),
- };
- } elsif ( $Module::Install::ExtraTests::use_extratests ) {
- # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
- # So, just ignore our xt tests here.
- } 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} = join ', ', @{$self->author || []};
- }
- 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};
- }
- if ( $self->makemaker(6.31) and $self->license ) {
- $args->{LICENSE} = $self->license;
- }
-
- my $prereq = ($args->{PREREQ_PM} ||= {});
- %$prereq = ( %$prereq,
- map { @$_ } # flatten [module => version]
- map { @$_ }
- grep $_,
- ($self->requires)
- );
-
- # Remove any reference to perl, PREREQ_PM doesn't support it
- delete $args->{PREREQ_PM}->{perl};
-
- # 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, add it to Makefile DIR
- my $subdirs = ($args->{DIR} || []);
- if ($self->bundles) {
- my %processed;
- foreach my $bundle (@{ $self->bundles }) {
- my ($mod_name, $dist_dir) = @$bundle;
- delete $prereq->{$mod_name};
- $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
- if (not exists $processed{$dist_dir}) {
- if (-d $dist_dir) {
- # List as sub-directory to be processed by make
- push @$subdirs, $dist_dir;
- }
- # Else do nothing: the module is already present on the system
- $processed{$dist_dir} = undef;
- }
- }
- }
-
- 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;
- }
- }
-
- if ($self->installdirs) {
- warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
- $args->{INSTALLDIRS} = $self->installdirs;
- }
-
- my %args = map {
- ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
- } keys %$args;
-
- my $user_preop = delete $args{dist}->{PREOP};
- if ( my $preop = $self->admin->preop($user_preop) ) {
- foreach my $key ( keys %$preop ) {
- $args{dist}->{$key} = $preop->{$key};
- }
- }
-
- my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
- $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
-}
-
-sub fix_up_makefile {
- my $self = shift;
- my $makefile_name = shift;
- my $top_class = ref($self->_top) || '';
- my $top_version = $self->_top->VERSION || '';
-
- my $preamble = $self->preamble
- ? "# Preamble by $top_class $top_version\n"
- . $self->preamble
- : '';
- my $postamble = "# Postamble by $top_class $top_version\n"
- . ($self->postamble || '');
-
- local *MAKEFILE;
- open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
- eval { flock MAKEFILE, LOCK_EX };
- my $makefile = do { local $/; <MAKEFILE> };
-
- $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
- $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
- $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
- $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
- $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
-
- # Module::Install will never be used to build the Core Perl
- # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
- # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
- $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
- #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
-
- # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
- $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
-
- # XXX - This is currently unused; not sure if it breaks other MM-users
- # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
-
- seek MAKEFILE, 0, SEEK_SET;
- truncate MAKEFILE, 0;
- print MAKEFILE "$preamble$makefile$postamble" or die $!;
- close MAKEFILE or die $!;
-
- 1;
-}
-
-sub preamble {
- my ($self, $text) = @_;
- $self->{preamble} = $text . $self->{preamble} if defined $text;
- $self->{preamble};
-}
-
-sub postamble {
- my ($self, $text) = @_;
- $self->{postamble} ||= $self->admin->postamble;
- $self->{postamble} .= $text if defined $text;
- $self->{postamble}
-}
-
-1;
-
-__END__
-
-#line 541
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
deleted file mode 100644
index cfe45b3..0000000
--- a/inc/Module/Install/Metadata.pm
+++ /dev/null
@@ -1,715 +0,0 @@
-#line 1
-package Module::Install::Metadata;
-
-use strict 'vars';
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-my @boolean_keys = qw{
- sign
-};
-
-my @scalar_keys = qw{
- name
- module_name
- abstract
- version
- distribution_type
- tests
- installdirs
-};
-
-my @tuple_keys = qw{
- configure_requires
- build_requires
- requires
- recommends
- bundles
- resources
-};
-
-my @resource_keys = qw{
- homepage
- bugtracker
- repository
-};
-
-my @array_keys = qw{
- keywords
- author
-};
-
-*authors = \&author;
-
-sub Meta { shift }
-sub Meta_BooleanKeys { @boolean_keys }
-sub Meta_ScalarKeys { @scalar_keys }
-sub Meta_TupleKeys { @tuple_keys }
-sub Meta_ResourceKeys { @resource_keys }
-sub Meta_ArrayKeys { @array_keys }
-
-foreach my $key ( @boolean_keys ) {
- *$key = sub {
- my $self = shift;
- if ( defined wantarray and not @_ ) {
- return $self->{values}->{$key};
- }
- $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
- return $self;
- };
-}
-
-foreach my $key ( @scalar_keys ) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} if defined wantarray and !@_;
- $self->{values}->{$key} = shift;
- return $self;
- };
-}
-
-foreach my $key ( @array_keys ) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} if defined wantarray and !@_;
- $self->{values}->{$key} ||= [];
- push @{$self->{values}->{$key}}, @_;
- return $self;
- };
-}
-
-foreach my $key ( @resource_keys ) {
- *$key = sub {
- my $self = shift;
- unless ( @_ ) {
- return () unless $self->{values}->{resources};
- return map { $_->[1] }
- grep { $_->[0] eq $key }
- @{ $self->{values}->{resources} };
- }
- return $self->{values}->{resources}->{$key} unless @_;
- my $uri = shift or die(
- "Did not provide a value to $key()"
- );
- $self->resources( $key => $uri );
- return 1;
- };
-}
-
-foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
- *$key = sub {
- my $self = shift;
- return $self->{values}->{$key} unless @_;
- my @added;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @added, [ $module, $version ];
- }
- push @{ $self->{values}->{$key} }, @added;
- return map {@$_} @added;
- };
-}
-
-# Resource handling
-my %lc_resource = map { $_ => 1 } qw{
- homepage
- license
- bugtracker
- repository
-};
-
-sub resources {
- my $self = shift;
- while ( @_ ) {
- my $name = shift or last;
- my $value = shift or next;
- if ( $name eq lc $name and ! $lc_resource{$name} ) {
- die("Unsupported reserved lowercase resource '$name'");
- }
- $self->{values}->{resources} ||= [];
- push @{ $self->{values}->{resources} }, [ $name, $value ];
- }
- $self->{values}->{resources};
-}
-
-# Aliases for build_requires that will have alternative
-# meanings in some future version of META.yml.
-sub test_requires { shift->build_requires(@_) }
-sub install_requires { shift->build_requires(@_) }
-
-# Aliases for installdirs options
-sub install_as_core { $_[0]->installdirs('perl') }
-sub install_as_cpan { $_[0]->installdirs('site') }
-sub install_as_site { $_[0]->installdirs('site') }
-sub install_as_vendor { $_[0]->installdirs('vendor') }
-
-sub dynamic_config {
- my $self = shift;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
- }
- $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
- return 1;
-}
-
-sub perl_version {
- my $self = shift;
- return $self->{values}->{perl_version} unless @_;
- my $version = shift or die(
- "Did not provide a value to perl_version()"
- );
-
- # Normalize the version
- $version = $self->_perl_version($version);
-
- # We don't support the reall old versions
- unless ( $version >= 5.005 ) {
- die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
- }
-
- $self->{values}->{perl_version} = $version;
-}
-
-sub all_from {
- my ( $self, $file ) = @_;
-
- unless ( defined($file) ) {
- my $name = $self->name or die(
- "all_from called with no args without setting name() first"
- );
- $file = join('/', 'lib', split(/-/, $name)) . '.pm';
- $file =~ s{.*/}{} unless -e $file;
- unless ( -e $file ) {
- die("all_from cannot find $file from $name");
- }
- }
- unless ( -f $file ) {
- 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;
- $pod =~ s/\.pm$/.pod/i;
- $pod = $file unless -e $pod;
-
- # Pull the different values
- $self->name_from($file) unless $self->name;
- $self->version_from($file) unless $self->version;
- $self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless @{$self->author || []};
- $self->license_from($pod) unless $self->license;
- $self->abstract_from($pod) unless $self->abstract;
-
- return 1;
-}
-
-sub provides {
- my $self = shift;
- my $provides = ( $self->{values}->{provides} ||= {} );
- %$provides = (%$provides, @_) if @_;
- return $provides;
-}
-
-sub auto_provides {
- my $self = shift;
- return $self unless $self->is_admin;
- unless (-e 'MANIFEST') {
- warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
- return $self;
- }
- # Avoid spurious warnings as we are not checking manifest here.
- local $SIG{__WARN__} = sub {1};
- require ExtUtils::Manifest;
- local *ExtUtils::Manifest::manicheck = sub { return };
-
- require Module::Build;
- my $build = Module::Build->new(
- dist_name => $self->name,
- dist_version => $self->version,
- license => $self->license,
- );
- $self->provides( %{ $build->find_dist_packages || {} } );
-}
-
-sub feature {
- my $self = shift;
- my $name = shift;
- my $features = ( $self->{values}->{features} ||= [] );
- my $mods;
-
- if ( @_ == 1 and ref( $_[0] ) ) {
- # The user used ->feature like ->features by passing in the second
- # argument as a reference. Accomodate for that.
- $mods = $_[0];
- } else {
- $mods = \@_;
- }
-
- my $count = 0;
- push @$features, (
- $name => [
- map {
- ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
- } @$mods
- ]
- );
-
- return @$features;
-}
-
-sub features {
- my $self = shift;
- while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
- $self->feature( $name, @$mods );
- }
- return $self->{values}->{features}
- ? @{ $self->{values}->{features} }
- : ();
-}
-
-sub no_index {
- my $self = shift;
- my $type = shift;
- push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
- return $self->{values}->{no_index};
-}
-
-sub read {
- my $self = shift;
- $self->include_deps( 'YAML::Tiny', 0 );
-
- require YAML::Tiny;
- my $data = YAML::Tiny::LoadFile('META.yml');
-
- # Call methods explicitly in case user has already set some values.
- while ( my ( $key, $value ) = each %$data ) {
- next unless $self->can($key);
- if ( ref $value eq 'HASH' ) {
- while ( my ( $module, $version ) = each %$value ) {
- $self->can($key)->($self, $module => $version );
- }
- } else {
- $self->can($key)->($self, $value);
- }
- }
- return $self;
-}
-
-sub write {
- my $self = shift;
- return $self unless $self->is_admin;
- $self->admin->write_meta;
- return $self;
-}
-
-sub version_from {
- require ExtUtils::MM_Unix;
- my ( $self, $file ) = @_;
- $self->version( ExtUtils::MM_Unix->parse_version($file) );
-
- # for version integrity check
- $self->makemaker_args( VERSION_FROM => $file );
-}
-
-sub abstract_from {
- require ExtUtils::MM_Unix;
- my ( $self, $file ) = @_;
- $self->abstract(
- bless(
- { DISTNAME => $self->name },
- 'ExtUtils::MM_Unix'
- )->parse_abstract($file)
- );
-}
-
-# Add both distribution and module name
-sub name_from {
- my ($self, $file) = @_;
- if (
- Module::Install::_read($file) =~ m/
- ^ \s*
- package \s*
- ([\w:]+)
- \s* ;
- /ixms
- ) {
- my ($name, $module_name) = ($1, $1);
- $name =~ s{::}{-}g;
- $self->name($name);
- unless ( $self->module_name ) {
- $self->module_name($module_name);
- }
- } else {
- die("Cannot determine name from $file\n");
- }
-}
-
-sub _extract_perl_version {
- if (
- $_[0] =~ m/
- ^\s*
- (?:use|require) \s*
- v?
- ([\d_\.]+)
- \s* ;
- /ixms
- ) {
- 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";
- return;
- }
-}
-
-sub author_from {
- my $self = shift;
- my $content = Module::Install::_read($_[0]);
- if ($content =~ m/
- =head \d \s+ (?:authors?)\b \s*
- ([^\n]*)
- |
- =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
- .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
- ([^\n]*)
- /ixms) {
- my $author = $1 || $2;
-
- # XXX: ugly but should work anyway...
- if (eval "require Pod::Escapes; 1") {
- # Pod::Escapes has a mapping table.
- # It's in core of perl >= 5.9.3, and should be installed
- # as one of the Pod::Simple's prereqs, which is a prereq
- # of Pod::Text 3.x (see also below).
- $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
- {
- defined $2
- ? chr($2)
- : defined $Pod::Escapes::Name2character_number{$1}
- ? chr($Pod::Escapes::Name2character_number{$1})
- : do {
- warn "Unknown escape: E<$1>";
- "E<$1>";
- };
- }gex;
- }
- elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
- # Pod::Text < 3.0 has yet another mapping table,
- # though the table name of 2.x and 1.x are different.
- # (1.x is in core of Perl < 5.6, 2.x is in core of
- # Perl < 5.9.3)
- my $mapping = ($Pod::Text::VERSION < 2)
- ? \%Pod::Text::HTML_Escapes
- : \%Pod::Text::ESCAPES;
- $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
- {
- defined $2
- ? chr($2)
- : defined $mapping->{$1}
- ? $mapping->{$1}
- : do {
- warn "Unknown escape: E<$1>";
- "E<$1>";
- };
- }gex;
- }
- else {
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
- }
- $self->author($author);
- } else {
- warn "Cannot determine author info from $_[0]\n";
- }
-}
-
-#Stolen from M::B
-my %license_urls = (
- perl => 'http://dev.perl.org/licenses/',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
- artistic => 'http://opensource.org/licenses/artistic-license.php',
- artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
- lgpl => 'http://opensource.org/licenses/lgpl-license.php',
- lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
- lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
- bsd => 'http://opensource.org/licenses/bsd-license.php',
- gpl => 'http://opensource.org/licenses/gpl-license.php',
- gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
- gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
- mit => 'http://opensource.org/licenses/mit-license.php',
- mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
- open_source => undef,
- unrestricted => undef,
- restrictive => undef,
- unknown => undef,
-);
-
-sub license {
- my $self = shift;
- return $self->{values}->{license} unless @_;
- my $license = shift or die(
- 'Did not provide a value to license()'
- );
- $license = __extract_license($license) || lc $license;
- $self->{values}->{license} = $license;
-
- # Automatically fill in license URLs
- if ( $license_urls{$license} ) {
- $self->resources( license => $license_urls{$license} );
- }
-
- return 1;
-}
-
-sub _extract_license {
- my $pod = shift;
- my $matched;
- return __extract_license(
- ($matched) = $pod =~ m/
- (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
- (=head \d.*|=cut.*|)\z
- /xms
- ) || __extract_license(
- ($matched) = $pod =~ m/
- (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
- (=head \d.*|=cut.*|)\z
- /xms
- );
-}
-
-sub __extract_license {
- my $license_text = shift or return;
- my @phrases = (
- '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?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,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'GNU Free Documentation license' => 'unrestricted', 1,
- 'GNU Affero General Public License' => 'open_source', 1,
- '(?:Free)?BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'Apache (?:Software )?license' => 'apache', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'Mozilla Public License' => 'mozilla', 1,
- 'Q Public License' => 'open_source', 1,
- 'OpenSSL License' => 'unrestricted', 1,
- 'SSLeay License' => 'unrestricted', 1,
- 'zlib License' => 'open_source', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s#\s+#\\s+#gs;
- if ( $license_text =~ /\b$pattern\b/i ) {
- return $license;
- }
- }
- 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[^>]+|
- \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
- \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
- )>#gx;
- my %links;
- @links{@links}=();
- @links=keys %links;
- return @links;
-}
-
-sub bugtracker_from {
- my $self = shift;
- my $content = Module::Install::_read($_[0]);
- my @links = _extract_bugtracker($content);
- unless ( @links ) {
- warn "Cannot determine bugtracker info from $_[0]\n";
- return 0;
- }
- if ( @links > 1 ) {
- warn "Found more than one bugtracker link in $_[0]\n";
- return 0;
- }
-
- # Set the bugtracker
- bugtracker( $links[0] );
- return 1;
-}
-
-sub requires_from {
- my $self = shift;
- my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
- while ( @requires ) {
- my $module = shift @requires;
- my $version = shift @requires;
- $self->requires( $module => $version );
- }
-}
-
-sub test_requires_from {
- my $self = shift;
- my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
- while ( @requires ) {
- my $module = shift @requires;
- my $version = shift @requires;
- $self->test_requires( $module => $version );
- }
-}
-
-# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
-# numbers (eg, 5.006001 or 5.008009).
-# Also, convert double-part versions (eg, 5.8)
-sub _perl_version {
- my $v = $_[-1];
- $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
- $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
- $v =~ s/(\.\d\d\d)000$/$1/;
- $v =~ s/_.+$//;
- if ( ref($v) ) {
- # Numify
- $v = $v + 0;
- }
- return $v;
-}
-
-sub add_metadata {
- my $self = shift;
- my %hash = @_;
- for my $key (keys %hash) {
- warn "add_metadata: $key is not prefixed with 'x_'.\n" .
- "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
- $self->{values}->{$key} = $hash{$key};
- }
-}
-
-
-######################################################################
-# MYMETA Support
-
-sub WriteMyMeta {
- die "WriteMyMeta has been deprecated";
-}
-
-sub write_mymeta_yaml {
- my $self = shift;
-
- # We need YAML::Tiny to write the MYMETA.yml file
- unless ( eval { require YAML::Tiny; 1; } ) {
- return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.yml\n";
- YAML::Tiny::DumpFile('MYMETA.yml', $meta);
-}
-
-sub write_mymeta_json {
- my $self = shift;
-
- # We need JSON to write the MYMETA.json file
- unless ( eval { require JSON; 1; } ) {
- return 1;
- }
-
- # Generate the data
- my $meta = $self->_write_mymeta_data or return 1;
-
- # Save as the MYMETA.yml file
- print "Writing MYMETA.json\n";
- Module::Install::_write(
- 'MYMETA.json',
- JSON->new->pretty(1)->canonical->encode($meta),
- );
-}
-
-sub _write_mymeta_data {
- my $self = shift;
-
- # If there's no existing META.yml there is nothing we can do
- return undef unless -f 'META.yml';
-
- # We need Parse::CPAN::Meta to load the file
- unless ( eval { require Parse::CPAN::Meta; 1; } ) {
- return undef;
- }
-
- # Merge the perl version into the dependencies
- my $val = $self->Meta->{values};
- my $perl = delete $val->{perl_version};
- if ( $perl ) {
- $val->{requires} ||= [];
- my $requires = $val->{requires};
-
- # Canonize to three-dot version after Perl 5.6
- if ( $perl >= 5.006 ) {
- $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
- }
- unshift @$requires, [ perl => $perl ];
- }
-
- # Load the advisory META.yml file
- my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
- my $meta = $yaml[0];
-
- # Overwrite the non-configure dependency hashs
- delete $meta->{requires};
- delete $meta->{build_requires};
- delete $meta->{recommends};
- if ( exists $val->{requires} ) {
- $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
- }
- if ( exists $val->{build_requires} ) {
- $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
- }
-
- return $meta;
-}
-
-1;
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
deleted file mode 100644
index edc18b4..0000000
--- a/inc/Module/Install/Win32.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-#line 1
-package Module::Install::Win32;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = 'Module::Install::Base';
- $ISCORE = 1;
-}
-
-# determine if the user needs nmake, and download it if needed
-sub check_nmake {
- my $self = shift;
- $self->load('can_run');
- $self->load('get_file');
-
- require Config;
- return unless (
- $^O eq 'MSWin32' and
- $Config::Config{make} and
- $Config::Config{make} =~ /^nmake\b/i and
- ! $self->can_run('nmake')
- );
-
- print "The required 'nmake' executable not found, fetching it...\n";
-
- require File::Basename;
- my $rv = $self->get_file(
- url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
- ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
- local_dir => File::Basename::dirname($^X),
- size => 51928,
- run => 'Nmake15.exe /o > nul',
- check_for => 'Nmake.exe',
- remove => 1,
- );
-
- die <<'END_MESSAGE' unless $rv;
-
--------------------------------------------------------------------------------
-
-Since you are using Microsoft Windows, you will need the 'nmake' utility
-before installation. It's available at:
-
- http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
- or
- ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
-
-Please download the file manually, save it to a directory in %PATH% (e.g.
-C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
-that directory, and run "Nmake15.exe" from there; that will create the
-'nmake.exe' file needed by this module.
-
-You may then resume the installation process described in README.
-
--------------------------------------------------------------------------------
-END_MESSAGE
-
-}
-
-1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
deleted file mode 100644
index d0f6599..0000000
--- a/inc/Module/Install/WriteAll.pm
+++ /dev/null
@@ -1,63 +0,0 @@
-#line 1
-package Module::Install::WriteAll;
-
-use strict;
-use Module::Install::Base ();
-
-use vars qw{$VERSION @ISA $ISCORE};
-BEGIN {
- $VERSION = '1.00';
- @ISA = qw{Module::Install::Base};
- $ISCORE = 1;
-}
-
-sub WriteAll {
- my $self = shift;
- my %args = (
- meta => 1,
- sign => 0,
- inline => 0,
- check_nmake => 1,
- @_,
- );
-
- $self->sign(1) if $args{sign};
- $self->admin->WriteAll(%args) if $self->is_admin;
-
- $self->check_nmake if $args{check_nmake};
- unless ( $self->makemaker_args->{PL_FILES} ) {
- # XXX: This still may be a bit over-defensive...
- unless ($self->makemaker(6.25)) {
- $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
- }
- }
-
- # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
- # we clean it up properly ourself.
- $self->realclean_files('MYMETA.yml');
-
- if ( $args{inline} ) {
- $self->Inline->write;
- } else {
- $self->Makefile->write;
- }
-
- # The Makefile write process adds a couple of dependencies,
- # so write the META.yml files after the Makefile.
- if ( $args{meta} ) {
- $self->Meta->write;
- }
-
- # Experimental support for MYMETA
- if ( $ENV{X_MYMETA} ) {
- if ( $ENV{X_MYMETA} eq 'JSON' ) {
- $self->Meta->write_mymeta_json;
- } else {
- $self->Meta->write_mymeta_yaml;
- }
- }
-
- return 1;
-}
-
-1;
commit 01f3fa66780277c473f2e56b28a102f2328563ab
Author: c9s <cornelius.howl at gmail.com>
Date: Mon Oct 25 00:09:10 2010 +0800
Checking in changes prior to tagging of version 0.103.
Changelog diff is:
diff --git a/Changes b/Changes
index a0ba131..1178138 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
+0.103 - Mon 25 Oct 2010 12:08:58 AM CST
+
+ * Release
+
0.102 - Wed 20 Oct 2010 02:02:56 AM JST
* Re-upload
diff --git a/Changes b/Changes
index a0ba131..1178138 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
+0.103 - Mon 25 Oct 2010 12:08:58 AM CST
+
+ * Release
+
0.102 - Wed 20 Oct 2010 02:02:56 AM JST
* Re-upload
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 14f4cec..eabdd6c 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -1,5 +1,5 @@
package App::CLI;
-our $VERSION = '0.102';
+our $VERSION = '0.103';
use strict;
use warnings;
commit 5797722975f2156f075f144bbe93ca09f68b000b
Author: shelling <navyblueshellingford at gmail.com>
Date: Mon Nov 22 19:10:30 2010 +0800
add ability to call cascading subcommand
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index d140545..6d96755 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -74,11 +74,23 @@ sub subcommand {
no strict 'refs';
if (exists ${ref($self).'::'}{$_.'::'}) {
bless ($self, (ref($self)."::$_"));
- last;
+ last;
}
}
}
+sub cascading {
+ my $self = shift;
+ for ($self->subcommands) {
+ no strict "refs";
+ if (ucfirst($ARGV[0]) eq $_ && exists ${ref($self)."::"}{$_."::"}) {
+ my %data = %{$self};
+ return bless {%data}, ref($self)."::".ucfirst($_);
+ }
+ }
+ return undef;
+}
+
sub app {
my $self = shift;
die Carp::longmess "not a ref" unless ref $self;
diff --git a/t/1basic.t b/t/1basic.t
index 8b99cbe..702dae9 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 8;
+use Test::More tests => 9;
use lib qw(t/lib);
use CLITest;
@@ -45,3 +45,13 @@ is_deeply ([MyApp->commands],
is_deeply (clicheck, [qw(MyApp::Test::hate MyApp::Test::hate::run), 'v', 'hate', 'arg'],
'subcommand with option and arg');
}
+
+{
+ local *ARGV = ["test", "cascading"];
+ MyApp->dispatch;
+ use Data::Dumper;
+ my $res = clicheck;
+ print STDERR Dumper $res;
+ is_deeply ($res, [qw(MyApp::Test::Cascading MyApp::Test::Cascading::run)],
+ 'cascading subcommand');
+}
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index 94ea98e..ef183fa 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -2,14 +2,18 @@ package MyApp::Test;
use strict;
use base 'MyApp';
-use constant subcommands => ('hate');
+use constant subcommands => qw(hate Cascading);
use constant options => ( 'v|verbose' => 'verbose',
);
use CLITest;
sub run {
my $self = shift;
- cliack($self->{verbose} ? 'v' : '', @_);
+ if ($self->cascading) {
+ $self->cascading->run_command;
+ } else {
+ cliack($self->{verbose} ? 'v' : '', @_);
+ }
}
package MyApp::Test::hate;
@@ -21,4 +25,15 @@ sub run {
cliack($self->{verbose} ? 'v' : '', 'hate', @_);
}
+package MyApp::Test::Cascading;
+use base qw(App::CLI::Command);
+use CLITest;
+use Data::Dumper;
+
+sub run {
+ my $self = shift;
+ cliack();
+}
+
+
1;
commit ee40ef52f73bdf2a5c1fdfa9900999bc28f557d4
Author: shelling <navyblueshellingford at gmail.com>
Date: Mon Nov 22 19:19:05 2010 +0800
purge trivial lines
diff --git a/t/1basic.t b/t/1basic.t
index 702dae9..995880e 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -49,9 +49,6 @@ is_deeply ([MyApp->commands],
{
local *ARGV = ["test", "cascading"];
MyApp->dispatch;
- use Data::Dumper;
- my $res = clicheck;
- print STDERR Dumper $res;
- is_deeply ($res, [qw(MyApp::Test::Cascading MyApp::Test::Cascading::run)],
+ is_deeply (clicheck, [qw(MyApp::Test::Cascading MyApp::Test::Cascading::run)],
'cascading subcommand');
}
commit f2f798e2fa72836f72429342fbf039b32b2352f5
Author: shelling <navyblueshellingford at gmail.com>
Date: Mon Nov 22 21:33:13 2010 +0800
shift @ARGV to avoid catching by next level
diff --git a/.gitignore b/.gitignore
index aa7964e..26f414b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,4 @@ Makefile
inc/
pm_to_blib
*~
+blib
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 6d96755..4f9f5c0 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -84,6 +84,7 @@ sub cascading {
for ($self->subcommands) {
no strict "refs";
if (ucfirst($ARGV[0]) eq $_ && exists ${ref($self)."::"}{$_."::"}) {
+ shift @ARGV;
my %data = %{$self};
return bless {%data}, ref($self)."::".ucfirst($_);
}
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index ef183fa..db54f14 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -9,8 +9,9 @@ use CLITest;
sub run {
my $self = shift;
- if ($self->cascading) {
- $self->cascading->run_command;
+ my $cas = $self->cascading;
+ if ($cas) {
+ $cas->run_command;
} else {
cliack($self->{verbose} ? 'v' : '', @_);
}
commit ee779a63f720250d67dcd989331fd7b294907e76
Author: shelling <navyblueshellingford at gmail.com>
Date: Mon Nov 22 21:37:38 2010 +0800
add test 10
diff --git a/t/1basic.t b/t/1basic.t
index 995880e..c0cd8a3 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 9;
+use Test::More tests => 10;
use lib qw(t/lib);
use CLITest;
@@ -52,3 +52,10 @@ is_deeply ([MyApp->commands],
is_deeply (clicheck, [qw(MyApp::Test::Cascading MyApp::Test::Cascading::run)],
'cascading subcommand');
}
+
+{
+ local *ARGV = [qw(test cascading infinite)];
+ MyApp->dispatch;
+ is_deeply (clicheck, [qw(MyApp::Test::Cascading::Infinite MyApp::Test::Cascading::Infinite::run)],
+ 'cascading more subcommands');
+}
commit fffe1b6cd27f483b83a68b04b09fce438c166fe4
Author: shelling <navyblueshellingford at gmail.com>
Date: Mon Nov 22 22:06:32 2010 +0800
completely implement cascading()
diff --git a/t/1basic.t b/t/1basic.t
index c0cd8a3..60a4c38 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -59,3 +59,4 @@ is_deeply ([MyApp->commands],
is_deeply (clicheck, [qw(MyApp::Test::Cascading::Infinite MyApp::Test::Cascading::Infinite::run)],
'cascading more subcommands');
}
+
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index db54f14..a6351ad 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -26,14 +26,30 @@ sub run {
cliack($self->{verbose} ? 'v' : '', 'hate', @_);
}
+package MyApp::Test::Cascading::Infinite;
+use base qw(App::CLI::Command);
+use CLITest;
+
+sub run {
+ my $self = shift;
+ cliack();
+}
+
package MyApp::Test::Cascading;
use base qw(App::CLI::Command);
use CLITest;
use Data::Dumper;
+use constant subcommands => qw(Infinite);
+
sub run {
my $self = shift;
- cliack();
+ my $cas = $self->cascading;
+ if ($cas) {
+ $cas->run_command;
+ } else {
+ cliack;
+ }
}
commit e56b7d34a3738927f1d282daf5828612e834fcd8
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 13:46:46 2010 +0800
shorter new()
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index eabdd6c..d7beca1 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -58,9 +58,7 @@ use constant options => ();
sub new {
my $class = shift;
- my $self = bless {}, $class;
- %$self = @_;
- return $self;
+ bless {@_}, $class;
}
sub prepare {
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 4f9f5c0..02560eb 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -45,9 +45,7 @@ use constant options => ();
sub new {
my $class = shift;
- my $self = bless {}, $class;
- %$self = @_;
- return $self;
+ bless {@_}, $class;
}
sub command_options {
commit feef569468bca84c069f03d60a8b4d0dbcabc0fd
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 14:28:09 2010 +0800
more docs
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index d7beca1..2cd26e1 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -10,36 +10,73 @@ App::CLI - Dispatcher module for command line interface programs
=head1 SYNOPSIS
package MyApp;
- use base 'App::CLI';
+ use base 'App::CLI'; # the DISPATCHER of your App
+ # it's not necessary putting the dispather on the top level of your App
package main;
- MyApp->dispatch;
+ MyApp->dispatch; # call dispather in where you want
package MyApp::List;
- use base qw(App::CLI::Command);
+ use base qw(App::CLI::Command); # any (SUB)COMMAND of your App
- sub run {
- my ($self, @args ) = @_;
+ use constant options => qw(
+ "h|help" => "help",
+ "verbose" => "verbose",
+ 'n|name=s' => 'name',
+ );
+ use constant subcommands => qw(User Nickname); # if you want subcommands
+ sub run {
+ my ($self, @args) = @_;
+
+ print "verbose" if $self->{verbose};
+ my $name = $self->{name}; # get arg following long option --name
+
+ if ($self->{help}) {
+ # if $ myapp list --help or $ $ myapp list -h
+ # just only output PODs
+ } else {
+ $subcmd = $self->cascading;
+ if ($subcmd) {
+ $subcmd->run_command; # if you want to invoke MyApp::List::User or MyApp::List::Nickname
+ } else {
+ # do something that without subcommand
+ # or die as below
+ $self->error_cmd;
+ }
+ }
}
- package MyApp::Help;
- use base 'App::CLI::Command';
+ package MyApp::List::User;
+ use base qw(App::CLI::Command);
- sub options { (
- 'verbose' => 'verbose',
- 'n|name=s' => 'name'
+ sub run {
+ my ($self, at args) = @_;
+ # code for listing user
}
+ pakcage MyApp::List::Nickname;
+ use base qw(App::CLI::Command);
+
sub run {
- my ( $self, $arg ) = @_;
+ my ($self, at args) = @_;
+ # code for listing nickname
+ }
- print "verbose" if $self->{verbose};
- my $name = $self->{name};
+ package MyApp::Help;
+ use base 'App::CLI::Command::Help';
+
+ use constant options => (
+ 'verbose' => 'verbose',
+ );
+ sub run {
+ my ($self, @arg) = @_;
+ # do something
+ $self->SUPER(@_); # App::CLI::Command::Help would output PDOs of each command
}
=head1 DESCRIPTION
@@ -156,6 +193,7 @@ More documentation
=head1 SEE ALSO
L<App::CLI::Command>
+L<Getopt::Long>
=head1 AUTHORS
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 02560eb..7e7509e 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -10,31 +10,26 @@ App::CLI::Command - Base class for App::CLI commands
=head1 SYNOPSIS
- package MyApp;
- use base 'App::CLI';
+ package MyApp::List;
+ use base qw(App::CLI::Command);
- package main;
-
- MyApp->dispatch;
-
-
- package MyApp::Help;
- use base 'App::CLI::Command';
-
- sub options { (
- 'verbose' => 'verbose',
- 'n|name=s' => 'name'
- }
+ use constant options => (
+ 'verbose' => 'verbose',
+ 'n|name=s' => 'name',
+ );
sub run {
my ( $self, $arg ) = @_;
print "verbose" if $self->{verbose};
- my $name = $self->{name};
+ my $name = $self->{name}; # get arg following long option --name
+ # any thing your want this command do
}
+ # See App::CLI for information of how to invoke (sub)command.
+
=head1 DESCRIPTION
@@ -69,13 +64,13 @@ sub subcommand {
my @cmd = $self->subcommands;
@cmd = values %{{$self->options}} if @cmd && $cmd[0] eq '*';
for (grep {$self->{$_}} @cmd) {
- no strict 'refs';
- if (exists ${ref($self).'::'}{$_.'::'}) {
+ no strict 'refs';
+ if (exists ${ref($self).'::'}{$_.'::'}) {
bless ($self, (ref($self)."::$_"));
- last;
- }
+ last;
+ }
}
-}
+)
sub cascading {
my $self = shift;
@@ -198,6 +193,7 @@ More documentation
=head1 SEE ALSO
L<App::CLI>
+L<Getopt::Long>
=head1 AUTHORS
diff --git a/lib/App/CLI/Command/Help.pm b/lib/App/CLI/Command/Help.pm
index 904fd42..e381ad5 100644
--- a/lib/App/CLI/Command/Help.pm
+++ b/lib/App/CLI/Command/Help.pm
@@ -10,6 +10,17 @@ use Pod::Simple::Text;
App::CLI::Command::Help
+=head1 SYNOPSIS
+
+ package MyApp::Help;
+ use base qw(App::CLI::Command::Help);
+
+ sub run {
+ my ($self, @args) = @_;
+ # preprocess
+ $self->SUPER(@_); # App::CLI::Command::Help would output PODs of each command
+ }
+
=head1 DESCRIPTION
Your command class should be capitalized.
commit b636cd04542c0ed8fe3b65d9c4eef951919e6351
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 14:34:15 2010 +0800
fix typo
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 7e7509e..8a6a9b7 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -70,7 +70,7 @@ sub subcommand {
last;
}
}
-)
+}
sub cascading {
my $self = shift;
commit 3cdc90f3b70c5b405447ffc8e0c2eb031e6970c3
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 14:37:48 2010 +0800
add shelling to list of authors
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 2cd26e1..d5b1aa2 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -199,6 +199,7 @@ L<Getopt::Long>
Chia-liang Kao E<lt>clkao at clkao.orgE<gt>
Cornelius Lin E<lt>cornelius.howl at gmail.comE<gt>
+shelling E<lt>navyblueshellingford at gmail.comE<gt>
=head1 COPYRIGHT
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 8a6a9b7..7697707 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -198,6 +198,8 @@ L<Getopt::Long>
=head1 AUTHORS
Chia-liang Kao E<lt>clkao at clkao.orgE<gt>
+Cornelius Lin E<lt>cornelius.howl at gmail.comE<gt>
+shelling E<lt>navyblueshellingford at gmail.comE<gt>
=head1 COPYRIGHT
commit c860af7efe41698729e3d1c9abe78bb2f6354740
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 14:49:09 2010 +0800
add test 11
diff --git a/t/1basic.t b/t/1basic.t
index 60a4c38..9136642 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 10;
+use Test::More tests => 11;
use lib qw(t/lib);
use CLITest;
@@ -60,3 +60,9 @@ is_deeply ([MyApp->commands],
'cascading more subcommands');
}
+{
+ local *ARGV = [qw(test cascading infinite subcommands)];
+ MyApp->dispatch;
+ is_deeply(clicheck, [qw(MyApp::Test::Cascading::Infinite::Subcommands MyApp::Test::Cascading::Infinite::Subcommands::run)],
+ 'cascading with options');
+}
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index a6351ad..386edd9 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -26,19 +26,39 @@ sub run {
cliack($self->{verbose} ? 'v' : '', 'hate', @_);
}
+package MyApp::Test::Cascading::Infinite::Subcommands;
+use base qw(App::CLI::Command);
+use CLITest;
+
+use constant options => qw(
+ "h|help" => "help",
+ "name" => "name",
+);
+
+sub run {
+ my $self = shift;
+ cliack;
+}
+
package MyApp::Test::Cascading::Infinite;
use base qw(App::CLI::Command);
use CLITest;
+use constant subcommands => qw(Subcommands);
+
sub run {
my $self = shift;
- cliack();
+ my $cas = $self->cascading;
+ if ($cas) {
+ $cas->run_command;
+ } else {
+ cliack;
+ }
}
package MyApp::Test::Cascading;
use base qw(App::CLI::Command);
use CLITest;
-use Data::Dumper;
use constant subcommands => qw(Infinite);
commit 27b48827f195c2cd56b4728293859c372897be7d
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 15:24:19 2010 +0800
using options of parents to work
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index d5b1aa2..dfd518b 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -101,13 +101,20 @@ sub new {
sub prepare {
my $class = shift;
my $data = {};
- $class->_getopt( [qw(no_ignore_case bundling pass_through)],
- _opt_map($data, $class->global_options));
+
+ $class->_getopt(
+ [qw(no_ignore_case bundling pass_through)],
+ _opt_map($data, $class->global_options)
+ );
+
my $cmd = shift @ARGV;
$cmd = $class->get_cmd($cmd, @_, %$data);
- $class->_getopt( [qw(no_ignore_case bundling)],
- _opt_map($cmd, $cmd->command_options) );
+ $class->_getopt(
+ [qw(no_ignore_case bundling)],
+ _opt_map($cmd, $cmd->command_options)
+ );
+
return $cmd;
}
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 7697707..53360e0 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -44,8 +44,7 @@ sub new {
}
sub command_options {
- ( (map { $_ => $_ } $_[0]->subcommands),
- $_[0]->options );
+ ( (map { $_ => $_ } $_[0]->subcommands), $_[0]->options );
}
# XXX:
diff --git a/t/1basic.t b/t/1basic.t
index 9136642..08261df 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -61,8 +61,8 @@ is_deeply ([MyApp->commands],
}
{
- local *ARGV = [qw(test cascading infinite subcommands)];
+ local *ARGV = [qw(test cascading infinite subcommands --name shelling)];
MyApp->dispatch;
- is_deeply(clicheck, [qw(MyApp::Test::Cascading::Infinite::Subcommands MyApp::Test::Cascading::Infinite::Subcommands::run)],
+ is_deeply(clicheck, [qw(MyApp::Test::Cascading::Infinite::Subcommands MyApp::Test::Cascading::Infinite::Subcommands::run), "shelling"],
'cascading with options');
}
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index 386edd9..931adeb 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -3,8 +3,10 @@ use strict;
use base 'MyApp';
use constant subcommands => qw(hate Cascading);
-use constant options => ( 'v|verbose' => 'verbose',
- );
+use constant options => (
+ 'v|verbose' => 'verbose',
+ "name=s" => "name",
+);
use CLITest;
sub run {
@@ -27,17 +29,16 @@ sub run {
}
package MyApp::Test::Cascading::Infinite::Subcommands;
-use base qw(App::CLI::Command);
+use base qw(App::CLI App::CLI::Command);
use CLITest;
-use constant options => qw(
+use constant options => (
"h|help" => "help",
- "name" => "name",
);
sub run {
my $self = shift;
- cliack;
+ cliack($self->{name});
}
package MyApp::Test::Cascading::Infinite;
commit fa637328ede34c3f6ee50e8702a33674239e2dde
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 18:19:03 2010 +0800
refactor cascading()
diff --git a/.gitignore b/.gitignore
index 26f414b..9a431a2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,4 @@ inc/
pm_to_blib
*~
blib
+*.swp
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index dfd518b..596e888 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -112,7 +112,7 @@ sub prepare {
$class->_getopt(
[qw(no_ignore_case bundling)],
- _opt_map($cmd, $cmd->command_options)
+ _opt_map($cmd, $cmd->command_options)
);
return $cmd;
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 53360e0..f3bb200 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -73,15 +73,23 @@ sub subcommand {
sub cascading {
my $self = shift;
+ if ($self->cascadable) {
+ my $subcmd = shift @ARGV;
+ my %data = %{$self};
+ return bless {%data}, ref($self)."::".ucfirst($subcmd);
+ }
+ return undef;
+}
+
+sub cascadable {
+ my $self = shift;
for ($self->subcommands) {
- no strict "refs";
+ no strict 'refs';
if (ucfirst($ARGV[0]) eq $_ && exists ${ref($self)."::"}{$_."::"}) {
- shift @ARGV;
- my %data = %{$self};
- return bless {%data}, ref($self)."::".ucfirst($_);
+ return 1;
}
}
- return undef;
+ return undef
}
sub app {
commit 9f4d6249c8f4989073fd117fd9ac5bb8efd94abd
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 18:37:18 2010 +0800
using cascadable in TEST
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index 931adeb..2f4974d 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -11,9 +11,8 @@ use CLITest;
sub run {
my $self = shift;
- my $cas = $self->cascading;
- if ($cas) {
- $cas->run_command;
+ if ($self->cascadable) {
+ $self->cascading->run_command;
} else {
cliack($self->{verbose} ? 'v' : '', @_);
}
@@ -49,9 +48,8 @@ use constant subcommands => qw(Subcommands);
sub run {
my $self = shift;
- my $cas = $self->cascading;
- if ($cas) {
- $cas->run_command;
+ if ($self->cascadable) {
+ $self->cascading->run_command;
} else {
cliack;
}
@@ -65,9 +63,8 @@ use constant subcommands => qw(Infinite);
sub run {
my $self = shift;
- my $cas = $self->cascading;
- if ($cas) {
- $cas->run_command;
+ if ($self->cascadable) {
+ $self->cascading->run_command;
} else {
cliack;
}
commit 20eccbb8740061556c86d0db1d7cbf7c3ef47ea3
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 22:05:39 2010 +0800
cascading subcommands receive options without problem
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 596e888..4c82802 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -110,6 +110,10 @@ sub prepare {
my $cmd = shift @ARGV;
$cmd = $class->get_cmd($cmd, @_, %$data);
+ while ($cmd->cascadable) {
+ $cmd = $cmd->cascading;
+ }
+
$class->_getopt(
[qw(no_ignore_case bundling)],
_opt_map($cmd, $cmd->command_options)
diff --git a/t/1basic.t b/t/1basic.t
index 08261df..611cd88 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -61,8 +61,8 @@ is_deeply ([MyApp->commands],
}
{
- local *ARGV = [qw(test cascading infinite subcommands --name shelling)];
+ local *ARGV = [qw(test cascading infinite subcommands --name shelling --help)];
MyApp->dispatch;
- is_deeply(clicheck, [qw(MyApp::Test::Cascading::Infinite::Subcommands MyApp::Test::Cascading::Infinite::Subcommands::run), "shelling"],
+ is_deeply(clicheck, [qw(MyApp::Test::Cascading::Infinite::Subcommands MyApp::Test::Cascading::Infinite::Subcommands::run), "shelling", "help"],
'cascading with options');
}
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index 2f4974d..2db872d 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -5,7 +5,6 @@ use base 'MyApp';
use constant subcommands => qw(hate Cascading);
use constant options => (
'v|verbose' => 'verbose',
- "name=s" => "name",
);
use CLITest;
@@ -33,11 +32,12 @@ use CLITest;
use constant options => (
"h|help" => "help",
+ "name=s" => "name",
);
sub run {
my $self = shift;
- cliack($self->{name});
+ cliack($self->{name}, $self->{help} ? "help" : "");
}
package MyApp::Test::Cascading::Infinite;
commit 6d00f9eaba589bad7af4d326a21e025a5055e210
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 22:14:38 2010 +0800
more docs
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 4c82802..d19235c 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -38,9 +38,8 @@ App::CLI - Dispatcher module for command line interface programs
# if $ myapp list --help or $ $ myapp list -h
# just only output PODs
} else {
- $subcmd = $self->cascading;
- if ($subcmd) {
- $subcmd->run_command; # if you want to invoke MyApp::List::User or MyApp::List::Nickname
+ if ($self->cascadable) {
+ $self->cascading->run_command; # if you want to invoke MyApp::List::User or MyApp::List::Nickname
} else {
# do something that without subcommand
# or die as below
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index f3bb200..6063543 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -71,6 +71,12 @@ sub subcommand {
}
}
+=head3 cascading()
+
+return instance of subcommand invoked if it was listed in your constant subcommands.
+
+=cut
+
sub cascading {
my $self = shift;
if ($self->cascadable) {
@@ -81,6 +87,14 @@ sub cascading {
return undef;
}
+=head3 cascadable()
+
+return 1 if the subcommand invoked is in you constant subcommands
+
+otherwise, return undef
+
+=cut
+
sub cascadable {
my $self = shift;
for ($self->subcommands) {
commit 2eeb23e633f8583e0e4d5234c7f8d368283bf0b7
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 22:22:18 2010 +0800
announce deprecated functionality in test
diff --git a/t/1basic.t b/t/1basic.t
index 611cd88..5560ff7 100644
--- a/t/1basic.t
+++ b/t/1basic.t
@@ -40,6 +40,8 @@ is_deeply ([MyApp->commands],
}
{
+ # this kind of subcommand should be deprecated
+ # because it makes people confused which is option and which is subcommand
local *ARGV = ['test', '--hate', 'arg', '--verbose'];
MyApp->dispatch;
is_deeply (clicheck, [qw(MyApp::Test::hate MyApp::Test::hate::run), 'v', 'hate', 'arg'],
commit 3af73f1983a63ebf99fdf00032e561fd97d29491
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 23 22:53:22 2010 +0800
Checking in changes prior to tagging of version 0.2.
Changelog diff is:
diff --git a/Changes b/Changes
index 1178138..7ee27aa 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+0.2 Tue 23 Nov 2010 10:51:32 PM CST
+
+ * New Feature: Cascading Subcommand
+ * Deprecated Feature: Long Option Subcommand (still work)
+ * Abundant DOCs
0.103 - Mon 25 Oct 2010 12:08:58 AM CST
diff --git a/Changes b/Changes
index 1178138..7ee27aa 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+0.2 Tue 23 Nov 2010 10:51:32 PM CST
+
+ * New Feature: Cascading Subcommand
+ * Deprecated Feature: Long Option Subcommand (still work)
+ * Abundant DOCs
0.103 - Mon 25 Oct 2010 12:08:58 AM CST
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index d19235c..3880a33 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -1,5 +1,5 @@
package App::CLI;
-our $VERSION = '0.103';
+our $VERSION = '0.2';
use strict;
use warnings;
commit 9b6c4a56b1ab7cdce70f555a9dfea8ed0c6c3246
Author: c9s <cornelius.howl at gmail.com>
Date: Wed Nov 24 01:32:35 2010 +0800
Checking in changes prior to tagging of version 0.3.
Changelog diff is:
diff --git a/Changes b/Changes
index 7ee27aa..17e16e6 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+
+0.3 Wed 24 Nov 2010 01:32:10 AM CST
+
+ * new cascading attribute for subcommands. thanks to @shelling++.
+
0.2 Tue 23 Nov 2010 10:51:32 PM CST
* New Feature: Cascading Subcommand
diff --git a/Changes b/Changes
index 7ee27aa..17e16e6 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+
+0.3 Wed 24 Nov 2010 01:32:10 AM CST
+
+ * new cascading attribute for subcommands. thanks to @shelling++.
+
0.2 Tue 23 Nov 2010 10:51:32 PM CST
* New Feature: Cascading Subcommand
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 3880a33..c04aa62 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -1,5 +1,5 @@
package App::CLI;
-our $VERSION = '0.2';
+our $VERSION = '0.3';
use strict;
use warnings;
commit b4230c733fd4b9d9b66dc8e1741f7793de18c53e
Author: shelling <navyblueshellingford at gmail.com>
Date: Thu Nov 25 15:29:41 2010 +0800
not need to declare cascading in run() now
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index 2db872d..b4a7f14 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -1,20 +1,15 @@
package MyApp::Test;
use strict;
use base 'MyApp';
-
+use CLITest;
use constant subcommands => qw(hate Cascading);
use constant options => (
'v|verbose' => 'verbose',
);
-use CLITest;
sub run {
my $self = shift;
- if ($self->cascadable) {
- $self->cascading->run_command;
- } else {
- cliack($self->{verbose} ? 'v' : '', @_);
- }
+ cliack($self->{verbose} ? 'v' : '', @_);
}
package MyApp::Test::hate;
@@ -26,10 +21,12 @@ sub run {
cliack($self->{verbose} ? 'v' : '', 'hate', @_);
}
+
+
+
package MyApp::Test::Cascading::Infinite::Subcommands;
use base qw(App::CLI App::CLI::Command);
use CLITest;
-
use constant options => (
"h|help" => "help",
"name=s" => "name",
@@ -40,34 +37,28 @@ sub run {
cliack($self->{name}, $self->{help} ? "help" : "");
}
+
+
package MyApp::Test::Cascading::Infinite;
use base qw(App::CLI::Command);
use CLITest;
-
use constant subcommands => qw(Subcommands);
sub run {
my $self = shift;
- if ($self->cascadable) {
- $self->cascading->run_command;
- } else {
- cliack;
- }
+ cliack;
}
+
+
package MyApp::Test::Cascading;
use base qw(App::CLI::Command);
use CLITest;
-
use constant subcommands => qw(Infinite);
sub run {
my $self = shift;
- if ($self->cascadable) {
- $self->cascading->run_command;
- } else {
- cliack;
- }
+ cliack;
}
commit 78623a37b9764b7848294e9077cfc3d61eb387f5
Author: shelling <navyblueshellingford at gmail.com>
Date: Thu Nov 25 15:40:57 2010 +0800
new docs
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index c04aa62..e9a7280 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -11,12 +11,14 @@ App::CLI - Dispatcher module for command line interface programs
package MyApp;
use base 'App::CLI'; # the DISPATCHER of your App
- # it's not necessary putting the dispather on the top level of your App
+ # it's not necessary putting the dispather
+ # on the top level of your App
package main;
MyApp->dispatch; # call dispather in where you want
+
package MyApp::List;
use base qw(App::CLI::Command); # any (SUB)COMMAND of your App
@@ -26,7 +28,9 @@ App::CLI - Dispatcher module for command line interface programs
'n|name=s' => 'name',
);
- use constant subcommands => qw(User Nickname); # if you want subcommands
+ use constant subcommands => qw(User Nickname type); # if you want subcommands
+ # automatically dispatch to subcommands
+ # when invoke $ myapp list [user|nickname]
sub run {
my ($self, @args) = @_;
@@ -38,32 +42,43 @@ App::CLI - Dispatcher module for command line interface programs
# if $ myapp list --help or $ $ myapp list -h
# just only output PODs
} else {
- if ($self->cascadable) {
- $self->cascading->run_command; # if you want to invoke MyApp::List::User or MyApp::List::Nickname
- } else {
- # do something that without subcommand
- # or die as below
- $self->error_cmd;
- }
+ # do something when imvoking $ my app list
+ # without subcommand and --help
}
}
+
package MyApp::List::User;
use base qw(App::CLI::Command);
+ use constant options => (
+ "h|help" => "help",
+ );
sub run {
my ($self, at args) = @_;
# code for listing user
}
+
pakcage MyApp::List::Nickname;
use base qw(App::CLI::Command);
+ use constant options => (
+ "sort=s" => "sort",
+ );
sub run {
my ($self, at args) = @_;
# code for listing nickname
}
+ package MyApp::List::type; # old genre of subcommand could not be cascading infinitely
+ use base qw(MyApp::List); # should inherit its parents command
+
+ sub run {
+ my ($self, @args);
+ # run to here when invoking $ myapp list --type
+ }
+
package MyApp::Help;
use base 'App::CLI::Command::Help';
commit 44a5ff97bac98b9f7e6941b62daddff1e4e35e18
Author: c9s <cornelius.howl at gmail.com>
Date: Thu Nov 25 15:58:59 2010 +0800
Checking in changes prior to tagging of version 0.31.
Changelog diff is:
diff --git a/Changes b/Changes
index 17e16e6..cf00570 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
+0.31 Thu 25 Nov 2010 03:58:47 PM CST
+
+ * doc update
+
0.3 Wed 24 Nov 2010 01:32:10 AM CST
* new cascading attribute for subcommands. thanks to @shelling++.
diff --git a/Changes b/Changes
index 17e16e6..cf00570 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
+0.31 Thu 25 Nov 2010 03:58:47 PM CST
+
+ * doc update
+
0.3 Wed 24 Nov 2010 01:32:10 AM CST
* new cascading attribute for subcommands. thanks to @shelling++.
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index e9a7280..4d16091 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -1,5 +1,5 @@
package App::CLI;
-our $VERSION = '0.3';
+our $VERSION = '0.31';
use strict;
use warnings;
commit 1c90f01a3c9d3eeccd1d3fd8feafe36843e7f04a
Author: shelling <navyblueshellingford at gmail.com>
Date: Fri Nov 26 17:33:53 2010 +0800
short some trivial code
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 4d16091..ad777ca 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -121,8 +121,7 @@ sub prepare {
_opt_map($data, $class->global_options)
);
- my $cmd = shift @ARGV;
- $cmd = $class->get_cmd($cmd, @_, %$data);
+ my $cmd = $class->get_cmd(shift @ARGV, @_, %$data);
while ($cmd->cascadable) {
$cmd = $cmd->cascading;
@@ -130,9 +129,11 @@ sub prepare {
$class->_getopt(
[qw(no_ignore_case bundling)],
- _opt_map($cmd, $cmd->command_options)
+ _opt_map($cmd, $cmd->command_options)
);
+ $cmd->subcommand;
+
return $cmd;
}
@@ -147,10 +148,16 @@ sub _getopt {
unless $p->getoptions(@_);
}
+
+sub _opt_map {
+ my ($self, %opt) = @_;
+ return map { $_ => ref($opt{$_}) ? $opt{$_} : \$self->{$opt{$_}}} keys %opt;
+}
+
+
sub dispatch {
my $class = shift;
my $cmd = $class->prepare(@_);
- $cmd->subcommand;
$cmd->run_command(@ARGV);
}
@@ -190,10 +197,6 @@ sub get_cmd {
return $cmd;
}
-sub _opt_map {
- my ($self, %opt) = @_;
- return map { $_ => ref($opt{$_}) ? $opt{$_} : \$self->{$opt{$_}}} keys %opt;
-}
sub commands {
my $class = shift;
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 6063543..2915870 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -58,6 +58,12 @@ sub run_command {
$self->run(@_);
}
+=head3 subcommand()
+
+ make $self become subcommand of old genre of $self;o
+
+=cut
+
sub subcommand {
my $self = shift;
my @cmd = $self->subcommands;
commit 41b2da1dcfd51ee3dc240cc78bf284dc097622d7
Author: shelling <navyblueshellingford at gmail.com>
Date: Fri Nov 26 22:41:49 2010 +0800
more docs, remove trivial code
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index ad777ca..850a565 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -29,8 +29,10 @@ App::CLI - Dispatcher module for command line interface programs
);
use constant subcommands => qw(User Nickname type); # if you want subcommands
- # automatically dispatch to subcommands
- # when invoke $ myapp list [user|nickname]
+ # automatically dispatch to subcommands
+ # when invoke $ myapp list [user|nickname|--type]
+ # note 'type' lower case in first char
+ # is subcommand of old genre which is deprecated
sub run {
my ($self, @args) = @_;
@@ -116,9 +118,9 @@ sub prepare {
my $class = shift;
my $data = {};
- $class->_getopt(
+ $class->get_opt(
[qw(no_ignore_case bundling pass_through)],
- _opt_map($data, $class->global_options)
+ opt_map($data, $class->global_options)
);
my $cmd = $class->get_cmd(shift @ARGV, @_, %$data);
@@ -127,9 +129,9 @@ sub prepare {
$cmd = $cmd->cascading;
}
- $class->_getopt(
+ $class->get_opt(
[qw(no_ignore_case bundling)],
- _opt_map($cmd, $cmd->command_options)
+ opt_map($cmd, $cmd->command_options)
);
$cmd->subcommand;
@@ -137,31 +139,48 @@ sub prepare {
return $cmd;
}
-sub _getopt {
+sub get_opt {
my $class = shift;
my $config = shift;
my $p = Getopt::Long::Parser->new;
$p->configure(@$config);
my $err = '';
- local $SIG{__WARN__} = sub { my $msg = shift; $err .= "$msg" };
- die $class->error_opt ($err)
- unless $p->getoptions(@_);
+ local $SIG{__WARN__} = sub {
+ my $msg = shift;
+ $err .= "$msg"
+ };
+ die $class->error_opt ($err) unless $p->getoptions(@_);
}
-sub _opt_map {
+sub opt_map {
my ($self, %opt) = @_;
return map { $_ => ref($opt{$_}) ? $opt{$_} : \$self->{$opt{$_}}} keys %opt;
}
+=head3
+
+interface of dispatcher
+
+=cut
sub dispatch {
my $class = shift;
- my $cmd = $class->prepare(@_);
- $cmd->run_command(@ARGV);
+ $class->prepare(@_)->run_command(@ARGV);
}
-sub _cmd_map {
+
+=head3 cmd_map($cmd)
+
+find package name of subcommand in constant %alias
+
+if it's finded, return ucfirst of the package name,
+
+otherwise, return ucfirst of $cmd itself.
+
+=cut
+
+sub cmd_map {
my ($pkg, $cmd) = @_;
my %alias = $pkg->alias;
$cmd = $alias{$cmd} if exists $alias{$cmd};
@@ -174,28 +193,36 @@ sub error_cmd {
sub error_opt { $_[1] }
-sub command_class { $_[0] }
+=head3 get_cmd($cmd, @arg)
+
+return subcommand of first level via $ARGV[0]
+
+=cut
sub get_cmd {
my ($class, $cmd, @arg) = @_;
- die $class->error_cmd
- unless $cmd && $cmd =~ m/^[?a-z]+$/;
- my $pkg = join('::', $class->command_class, $class->_cmd_map ($cmd));
+ die $class->error_cmd unless $cmd && $cmd =~ m/^[?a-z]+$/;
+ my $pkg = join('::', $class, $class->cmd_map($cmd));
my $file = "$pkg.pm";
$file =~ s!::!/!g;
- eval {require $file; };
+ eval { require $file; };
unless ($pkg->can('run')) {
- warn $@ if $@ and exists $INC{$file};
- die $class->error_cmd;
+ warn $@ if $@ and exists $INC{$file};
+ die $class->error_cmd;
+ } else {
+ $cmd = $pkg->new(@arg);
+ $cmd->app($class);
+ return $cmd;
}
+}
+
+=head3 commands()
- $cmd = $pkg->new (@arg);
- $cmd->app ($class);
- return $cmd;
-}
+
+=cut
sub commands {
@@ -206,6 +233,12 @@ sub commands {
return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
}
+=head3 files()
+
+return module files of subcommans of first level
+
+=cut
+
sub files {
my $class = shift;
$class =~ s{::}{/}g;
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 2915870..183bac0 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -43,8 +43,10 @@ sub new {
bless {@_}, $class;
}
+
+
sub command_options {
- ( (map { $_ => $_ } $_[0]->subcommands), $_[0]->options );
+ ((map { $_ => $_ } $_[0]->subcommands), $_[0]->options);
}
# XXX:
@@ -60,7 +62,7 @@ sub run_command {
=head3 subcommand()
- make $self become subcommand of old genre of $self;o
+ mutate $self become subcommand of old genre of $self;
=cut
@@ -79,7 +81,7 @@ sub subcommand {
=head3 cascading()
-return instance of subcommand invoked if it was listed in your constant subcommands.
+return instance of cascading subcommand invoked if it was listed in your constant subcommands.
=cut
commit 368f50c72606c4d7699796693b43db9c17efd80e
Author: shelling <navyblueshellingford at gmail.com>
Date: Sat Nov 27 16:49:32 2010 +0800
more docs
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 850a565..1606277 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -139,6 +139,12 @@ sub prepare {
return $cmd;
}
+=head3 get_opt([@config], %opt_map)
+
+ give options map, process by Getopt::Long::Parser
+
+=cut
+
sub get_opt {
my $class = shift;
my $config = shift;
@@ -158,6 +164,7 @@ sub opt_map {
return map { $_ => ref($opt{$_}) ? $opt{$_} : \$self->{$opt{$_}}} keys %opt;
}
+
=head3
interface of dispatcher
commit 498791c0609e1fa0ad9d2fa418777f6498533d44
Author: shelling <navyblueshellingford at gmail.com>
Date: Sat Nov 27 18:54:23 2010 +0800
fix bug that subcommand didn't require subsubcommands
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 1606277..bfd0a82 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -129,6 +129,7 @@ sub prepare {
$cmd = $cmd->cascading;
}
+
$class->get_opt(
[qw(no_ignore_case bundling)],
opt_map($cmd, $cmd->command_options)
@@ -234,8 +235,9 @@ sub get_cmd {
sub commands {
my $class = shift;
- $class =~ s{::}{/}g;
- my $dir = $INC{$class.'.pm'};
+ my $dir = ref($class) ? ref($class) : $class;
+ $dir =~ s{::}{/}g;
+ $dir = $INC{$dir.'.pm'};
$dir =~ s/\.pm$//;
return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
}
@@ -248,6 +250,7 @@ return module files of subcommans of first level
sub files {
my $class = shift;
+ $class = ref($class) if ref($class);
$class =~ s{::}{/}g;
my $dir = $INC{$class.'.pm'};
$dir =~ s/\.pm$//;
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 183bac0..48f5e05 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -97,7 +97,7 @@ sub cascading {
=head3 cascadable()
-return 1 if the subcommand invoked is in you constant subcommands
+return package name of subcommand if the subcommand invoked is in you constant subcommands
otherwise, return undef
@@ -107,13 +107,34 @@ sub cascadable {
my $self = shift;
for ($self->subcommands) {
no strict 'refs';
+ my $sub = ref($self)."::$_";
+ eval "require $sub";
if (ucfirst($ARGV[0]) eq $_ && exists ${ref($self)."::"}{$_."::"}) {
- return 1;
+ return ref($self)."::".$_;
}
}
return undef
}
+sub commands {
+ my $class = shift;
+ my $dir = ref($class) ? ref($class) : $class;
+ $dir =~ s{::}{/}g;
+ $dir = $INC{$dir.'.pm'};
+ $dir =~ s/\.pm$//;
+ return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
+}
+
+sub files {
+ my $class = shift;
+ $class = ref($class) if ref($class);
+ $class =~ s{::}{/}g;
+ my $dir = $INC{$class.'.pm'};
+ $dir =~ s/\.pm$//;
+ return sort glob("$dir/*.pm");
+}
+
+
sub app {
my $self = shift;
die Carp::longmess "not a ref" unless ref $self;
diff --git a/t/lib/MyApp/Test.pm b/t/lib/MyApp/Test.pm
index b4a7f14..202c1dd 100644
--- a/t/lib/MyApp/Test.pm
+++ b/t/lib/MyApp/Test.pm
@@ -1,6 +1,6 @@
package MyApp::Test;
use strict;
-use base 'MyApp';
+use base qw(MyApp);
use CLITest;
use constant subcommands => qw(hate Cascading);
use constant options => (
@@ -21,45 +21,4 @@ sub run {
cliack($self->{verbose} ? 'v' : '', 'hate', @_);
}
-
-
-
-package MyApp::Test::Cascading::Infinite::Subcommands;
-use base qw(App::CLI App::CLI::Command);
-use CLITest;
-use constant options => (
- "h|help" => "help",
- "name=s" => "name",
-);
-
-sub run {
- my $self = shift;
- cliack($self->{name}, $self->{help} ? "help" : "");
-}
-
-
-
-package MyApp::Test::Cascading::Infinite;
-use base qw(App::CLI::Command);
-use CLITest;
-use constant subcommands => qw(Subcommands);
-
-sub run {
- my $self = shift;
- cliack;
-}
-
-
-
-package MyApp::Test::Cascading;
-use base qw(App::CLI::Command);
-use CLITest;
-use constant subcommands => qw(Infinite);
-
-sub run {
- my $self = shift;
- cliack;
-}
-
-
1;
diff --git a/t/lib/MyApp/Test/Cascading.pm b/t/lib/MyApp/Test/Cascading.pm
new file mode 100644
index 0000000..ff4d7d9
--- /dev/null
+++ b/t/lib/MyApp/Test/Cascading.pm
@@ -0,0 +1,11 @@
+package MyApp::Test::Cascading;
+use base qw(App::CLI::Command);
+use CLITest;
+use constant subcommands => qw(Infinite);
+
+sub run {
+ my $self = shift;
+ cliack;
+}
+
+1;
diff --git a/t/lib/MyApp/Test/Cascading/Infinite.pm b/t/lib/MyApp/Test/Cascading/Infinite.pm
new file mode 100644
index 0000000..154c3bc
--- /dev/null
+++ b/t/lib/MyApp/Test/Cascading/Infinite.pm
@@ -0,0 +1,11 @@
+package MyApp::Test::Cascading::Infinite;
+use base qw(App::CLI::Command);
+use CLITest;
+use constant subcommands => qw(Subcommands);
+
+sub run {
+ my $self = shift;
+ cliack;
+}
+
+1;
diff --git a/t/lib/MyApp/Test/Cascading/Infinite/Subcommands.pm b/t/lib/MyApp/Test/Cascading/Infinite/Subcommands.pm
new file mode 100644
index 0000000..33006e0
--- /dev/null
+++ b/t/lib/MyApp/Test/Cascading/Infinite/Subcommands.pm
@@ -0,0 +1,16 @@
+package MyApp::Test::Cascading::Infinite::Subcommands;
+use base qw(App::CLI::Command);
+use CLITest;
+
+use constant options => (
+ "h|help" => "help",
+ "name=s" => "name",
+);
+
+sub run {
+ my $self = shift;
+ cliack($self->{name}, $self->{help} ? "help" : "");
+}
+
+
+1;
commit d42715c2fb3fbdee396fc8e44f11a85ffe567961
Author: shelling <navyblueshellingford at gmail.com>
Date: Sat Nov 27 19:42:42 2010 +0800
move common subs in App::CLI and App::CLI::Command to App::CLI::Helper
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index bfd0a82..3895fa9 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -103,6 +103,8 @@ options.
=cut
+
+use App::CLI::Helper;
use Getopt::Long ();
use constant alias => ();
@@ -226,37 +228,6 @@ sub get_cmd {
}
}
-=head3 commands()
-
-
-
-=cut
-
-
-sub commands {
- my $class = shift;
- my $dir = ref($class) ? ref($class) : $class;
- $dir =~ s{::}{/}g;
- $dir = $INC{$dir.'.pm'};
- $dir =~ s/\.pm$//;
- return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
-}
-
-=head3 files()
-
-return module files of subcommans of first level
-
-=cut
-
-sub files {
- my $class = shift;
- $class = ref($class) if ref($class);
- $class =~ s{::}{/}g;
- my $dir = $INC{$class.'.pm'};
- $dir =~ s/\.pm$//;
- return sort glob("$dir/*.pm");
-}
-
=head1 TODO
More documentation
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 48f5e05..0df8325 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -3,6 +3,7 @@ use strict;
use warnings;
use Locale::Maketext::Simple;
use Carp ();
+use App::CLI::Helper;
=head1 NAME
@@ -116,25 +117,6 @@ sub cascadable {
return undef
}
-sub commands {
- my $class = shift;
- my $dir = ref($class) ? ref($class) : $class;
- $dir =~ s{::}{/}g;
- $dir = $INC{$dir.'.pm'};
- $dir =~ s/\.pm$//;
- return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
-}
-
-sub files {
- my $class = shift;
- $class = ref($class) if ref($class);
- $class =~ s{::}{/}g;
- my $dir = $INC{$class.'.pm'};
- $dir =~ s/\.pm$//;
- return sort glob("$dir/*.pm");
-}
-
-
sub app {
my $self = shift;
die Carp::longmess "not a ref" unless ref $self;
diff --git a/lib/App/CLI/Helper.pm b/lib/App/CLI/Helper.pm
new file mode 100644
index 0000000..75292b7
--- /dev/null
+++ b/lib/App/CLI/Helper.pm
@@ -0,0 +1,43 @@
+package App::CLI::Helper;
+
+sub import {
+ my $caller = caller;
+ for (qw(commands files)) {
+ *{$caller."::$_"} = *$_;
+ }
+}
+
+
+=head3 commands()
+
+
+
+=cut
+
+
+sub commands {
+ my $class = shift;
+ my $dir = ref($class) ? ref($class) : $class;
+ $dir =~ s{::}{/}g;
+ $dir = $INC{$dir.'.pm'};
+ $dir =~ s/\.pm$//;
+ return sort map { ($_) = m{^\Q$dir\E/(.*)\.pm}; lc($_) } $class->files;
+}
+
+=head3 files()
+
+return module files of subcommans of first level
+
+=cut
+
+sub files {
+ my $class = shift;
+ $class = ref($class) if ref($class);
+ $class =~ s{::}{/}g;
+ my $dir = $INC{$class.'.pm'};
+ $dir =~ s/\.pm$//;
+ return sort glob("$dir/*.pm");
+}
+
+
+1;
commit 2a643920e539c4c6c5ab3a26823b19078d8942c4
Author: shelling <navyblueshellingford at gmail.com>
Date: Sat Nov 27 22:45:40 2010 +0800
compact code
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index 3895fa9..c7c8bae 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -228,9 +228,6 @@ sub get_cmd {
}
}
-=head1 TODO
-
-More documentation
=head1 SEE ALSO
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index 0df8325..e82f5c8 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -88,12 +88,13 @@ return instance of cascading subcommand invoked if it was listed in your constan
sub cascading {
my $self = shift;
- if ($self->cascadable) {
- my $subcmd = shift @ARGV;
+ if (my $subcmd = $self->cascadable) {
+ shift @ARGV;
my %data = %{$self};
- return bless {%data}, ref($self)."::".ucfirst($subcmd);
+ return bless {%data}, $subcmd;
+ } else {
+ die $self->error_cmd;
}
- return undef;
}
=head3 cascadable()
@@ -108,8 +109,7 @@ sub cascadable {
my $self = shift;
for ($self->subcommands) {
no strict 'refs';
- my $sub = ref($self)."::$_";
- eval "require $sub";
+ eval "require ".ref($self)."::$_";
if (ucfirst($ARGV[0]) eq $_ && exists ${ref($self)."::"}{$_."::"}) {
return ref($self)."::".$_;
}
@@ -218,9 +218,6 @@ sub filename {
return $INC{"$fname.pm"};
}
-=head1 TODO
-
-More documentation
=head1 SEE ALSO
commit e2044240bf81563b02139cc924698208f0f84a72
Author: shelling <navyblueshellingford at gmail.com>
Date: Tue Nov 30 22:13:21 2010 +0800
more semantic
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index c7c8bae..c7843aa 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -137,7 +137,7 @@ sub prepare {
opt_map($cmd, $cmd->command_options)
);
- $cmd->subcommand;
+ $cmd = $cmd->subcommand;
return $cmd;
}
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index e82f5c8..b754b7f 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -71,13 +71,16 @@ sub subcommand {
my $self = shift;
my @cmd = $self->subcommands;
@cmd = values %{{$self->options}} if @cmd && $cmd[0] eq '*';
+ my $subcmd = undef;
for (grep {$self->{$_}} @cmd) {
no strict 'refs';
if (exists ${ref($self).'::'}{$_.'::'}) {
- bless ($self, (ref($self)."::$_"));
+ my %data = %{$self};
+ $subcmd = bless ({%data}, (ref($self)."::$_"));
last;
}
}
+ $subcmd ? $subcmd : $self;
}
=head3 cascading()
commit 19636ddb8c65356ce6d64640e0e8916d5e5b7299
Author: shelling <navyblueshellingford at gmail.com>
Date: Wed Dec 1 22:23:20 2010 +0800
should run_command(@_), @ARGV is avaiable everywhere
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index c7843aa..f12a671 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -176,7 +176,7 @@ interface of dispatcher
sub dispatch {
my $class = shift;
- $class->prepare(@_)->run_command(@ARGV);
+ $class->prepare(@_)->run_command(@_);
}
commit cd0b90f1a6a4c013d12678b691392bcf3e9e40d6
Author: shelling <navyblueshellingford at gmail.com>
Date: Wed Dec 1 22:25:28 2010 +0800
update PODs
diff --git a/lib/App/CLI/Command.pm b/lib/App/CLI/Command.pm
index b754b7f..07232b8 100644
--- a/lib/App/CLI/Command.pm
+++ b/lib/App/CLI/Command.pm
@@ -63,7 +63,7 @@ sub run_command {
=head3 subcommand()
- mutate $self become subcommand of old genre of $self;
+ return old genre subcommand of $self;
=cut
commit 57bb730c056068c2d9d8497313e0a394703ba5a8
Author: shelling <navyblueshellingford at gmail.com>
Date: Wed Dec 1 22:49:31 2010 +0800
go back due to conflict
diff --git a/lib/App/CLI.pm b/lib/App/CLI.pm
index f12a671..c7843aa 100644
--- a/lib/App/CLI.pm
+++ b/lib/App/CLI.pm
@@ -176,7 +176,7 @@ interface of dispatcher
sub dispatch {
my $class = shift;
- $class->prepare(@_)->run_command(@_);
+ $class->prepare(@_)->run_command(@ARGV);
}
commit 31595427cd11d9476e700f3debbf0669820956e8
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 3 00:48:16 2010 -0500
Remove old SIGNATURE file
diff --git a/MANIFEST b/MANIFEST
index 8ab40f4..536dafc 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2,7 +2,6 @@ Changes
MANIFEST This list of files
META.yml
Makefile.PL
-SIGNATURE
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
diff --git a/SIGNATURE b/SIGNATURE
deleted file mode 100644
index 8774ccc..0000000
--- a/SIGNATURE
+++ /dev/null
@@ -1,46 +0,0 @@
-This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.55.
-
-To verify the content in this distribution, first make sure you have
-Module::Signature installed, then type:
-
- % cpansign -v
-
-It will check each file's integrity, as well as the signature's
-validity. If "==> Signature verified OK! <==" is not displayed,
-the distribution may already have been compromised, and you should
-not run its Makefile.PL or Build.PL.
-
------BEGIN PGP SIGNED MESSAGE-----
-Hash: SHA1
-
-SHA1 7fd9bee22194a446efee9479819cb1e2756f4525 Changes
-SHA1 63b10e1b9dc12d9570df6daa4233ee44ce60c043 MANIFEST
-SHA1 8e6b388a9c7135b46f8d5cec0f7de3c90b5cdaa4 META.yml
-SHA1 2a8226162700b54e808b0d95edeb545d27073d07 Makefile.PL
-SHA1 603bb9de29fb8cba7f13409c546750972eff645d inc/Module/AutoInstall.pm
-SHA1 ae018c4565c1277089ca8f1b28f888d95430cb7f inc/Module/Install.pm
-SHA1 0a6f29536bedea3bb94744a7d43ffe39da7e4819 inc/Module/Install/AutoInstall.pm
-SHA1 4552acdfca8b78f8015d8449e1325616259095f5 inc/Module/Install/Base.pm
-SHA1 7fb663fff161fb45882b52edd62857bf15359658 inc/Module/Install/Can.pm
-SHA1 8b1d3db746faa6faf2d967a48d3812ec1f44b4c6 inc/Module/Install/Fetch.pm
-SHA1 d7ce736cdd05d5156d379ef39cca93beeeeba828 inc/Module/Install/Include.pm
-SHA1 9f6beaa2f4749ceb5dd0c9b0c647d0f3289c7b46 inc/Module/Install/Makefile.pm
-SHA1 7ad1da4fff7a1e7a634c9d734111c8292be08884 inc/Module/Install/Metadata.pm
-SHA1 e9aa83f3e8b16ccfce544a90a57b63b70a497759 inc/Module/Install/Win32.pm
-SHA1 ade2ac0b0246d4d8e28fa46942e53f6925abda46 inc/Module/Install/WriteAll.pm
-SHA1 ba3a180b4915e0060ced5135e2d6441e766823e0 lib/App/CLI.pm
-SHA1 afa50c5c799445a48385ce9d6f2589bb8d90d00d lib/App/CLI/Command.pm
-SHA1 bbda8c25ee4e1a704cb574e52b1db4e85e008c16 lib/App/CLI/Command/Help.pm
-SHA1 2e2fae52c7271120faa67828599c8e15c6ee52f6 t/1basic.t
-SHA1 bdf8cf34a6036e32739dc19cb775db69952184cb t/lib/CLITest.pm
-SHA1 d8d9e73b090de778d7a046c6cc4ad01b3dc52612 t/lib/MyApp.pm
-SHA1 d54e822cc998c53e44b74995affadd86c14a38a3 t/lib/MyApp/Help.pm
-SHA1 a4d7d62cb74ddda64f20836e7ec3ff67215d9f04 t/lib/MyApp/Test.pm
------BEGIN PGP SIGNATURE-----
-Version: GnuPG v2.0.9 (GNU/Linux)
-
-iEYEARECAAYFAkmmC2wACgkQMflWJZZAbqDtpgCgrVJYpHaTY7NMaq88VPcOtJDV
-+lcAn3w7ctgg9ed/6j1zeS1Sl7imX5+D
-=+oKY
------END PGP SIGNATURE-----
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list