aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthew Somerville <matthew@mysociety.org>2012-08-07 12:10:19 +0100
committerMatthew Somerville <matthew@mysociety.org>2012-08-07 12:10:19 +0100
commit63c23c31d125ee430e2cf59301ca0e65cd75e3d5 (patch)
tree92a5a8fb1ddedfd807c005de376a835755046043
parent2c1ed85e481f6c71fe32f9952e3eafbd42de1b9d (diff)
Remove no longer used perl-external files.
Diffstat
-rw-r--r--perl-external/.gitignore1
-rwxr-xr-xperl-external/bin/cpanm5748
-rwxr-xr-xperl-external/bin/module-manage.pl265
-rw-r--r--perl-external/files.txt261
-rw-r--r--perl-external/lib/perl5/local/lib.pm1030
-rw-r--r--perl-external/minicpan/.gitignore3
-rw-r--r--perl-external/minicpan/modules/02packages.details.txt.gzbin20439 -> 0 bytes
-rw-r--r--perl-external/minicpan/modules/03modlist.data.gzbin222 -> 0 bytes
-rw-r--r--perl-external/modules.txt62
9 files changed, 0 insertions, 7370 deletions
diff --git a/perl-external/.gitignore b/perl-external/.gitignore
deleted file mode 100644
index 8db64e38e..000000000
--- a/perl-external/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-local-lib
diff --git a/perl-external/bin/cpanm b/perl-external/bin/cpanm
deleted file mode 100755
index 9aeb9c906..000000000
--- a/perl-external/bin/cpanm
+++ /dev/null
@@ -1,5748 +0,0 @@
-#!/usr/bin/env perl
-
-eval 'exec /usr/bin/env perl -S $0 ${1+"$@"}'
- if 0; # not running under some shell
-#
-# You want to install cpanminus? Run the following command and it will
-# install itself for you. You might want to run it as a root with sudo
-# if you want to install to places like /usr/local/bin.
-#
-# % curl -L http://cpanmin.us | perl - --self-upgrade
-#
-# If you don't have curl but wget, replace `curl -L` with `wget -O -`.
-#
-# For more details about this program, visit http://search.cpan.org/dist/App-cpanminus
-#
-# DO NOT EDIT -- this is an auto generated file
-# This chunk of stuff was generated by App::FatPacker. To find the original
-# file's code, look for the end of this BEGIN block or the string 'FATPACK'
-BEGIN {
-my %fatpacked;
-
-$fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
- package App::cpanminus;
- our $VERSION = "1.4007";
-
- =head1 NAME
-
- App::cpanminus - get, unpack, build and install modules from CPAN
-
- =head1 SYNOPSIS
-
- cpanm Module
-
- Run C<cpanm -h> for more options.
-
- =head1 DESCRIPTION
-
- cpanminus is a script to get, unpack, build and install modules from
- CPAN and does nothing else.
-
- It's dependency free (can bootstrap itself), requires zero
- configuration, and stands alone. When running, it requires only 10MB
- of RAM.
-
- =head1 INSTALLATION
-
- There are several ways to install cpanminus to your system.
-
- =head2 Package management system
-
- There are Debian packages, RPMs, FreeBSD ports, and packages for other
- operation systems available. If you want to use the package management system,
- search for cpanminus and use the appropriate command to install. This makes it
- easy to install C<cpanm> to your system without thinking about where to
- install, and later upgrade.
-
- =head2 Installing to system perl
-
- You can also use the latest cpanminus to install cpanminus itself:
-
- curl -L http://cpanmin.us | perl - --sudo App::cpanminus
-
- This will install C<cpanm> to your bin directory like
- C</usr/local/bin> (unless you configured C<INSTALL_BASE> with
- L<local::lib>), so you probably need the C<--sudo> option.
-
- =head2 Installing to local perl (perlbrew)
-
- If you have perl in your home directory, which is the case if you use
- tools like L<perlbrew>, you don't need the C<--sudo> option, since
- you're most likely to have a write permission to the perl's library
- path. You can just do:
-
- curl -L http://cpanmin.us | perl - App::cpanminus
-
- to install the C<cpanm> executable to the perl's bin path, like
- C<~/perl5/perlbrew/bin/cpanm>.
-
- =head2 Downloading the standalone executable
-
- You can also copy the standalone executable to whatever location you'd like.
-
- cd ~/bin
- curl -LO http://xrl.us/cpanm
- chmod +x cpanm
- # edit shebang if you don't have /usr/bin/env
-
- This just works, but be sure to grab the new version manually when you
- upgrade because C<--self-upgrade> might not work for this.
-
- =head1 DEPENDENCIES
-
- perl 5.8 or later.
-
- =over 4
-
- =item *
-
- 'tar' executable (bsdtar or GNU tar version 1.22 are rcommended) or Archive::Tar to unpack files.
-
- =item *
-
- C compiler, if you want to build XS modules.
-
- =item *
-
- make
-
- =item *
-
- Module::Build (core in 5.10)
-
- =back
-
- =head1 QUESTIONS
-
- =head2 Another CPAN installer?
-
- OK, the first motivation was this: the CPAN shell runs out of memory (or swaps
- heavily and gets really slow) on Slicehost/linode's most affordable plan with
- only 256MB RAM. Should I pay more to install perl modules from CPAN? I don't
- think so.
-
- =head2 But why a new client?
-
- First of all, let me be clear that CPAN and CPANPLUS are great tools
- I've used for I<literally> years (you know how many modules I have on
- CPAN, right?). I really respect their efforts of maintaining the most
- important tools in the CPAN toolchain ecosystem.
-
- However, for less experienced users (mostly from outside the Perl community),
- or even really experienced Perl developers who know how to shoot themselves in
- their feet, setting up the CPAN toolchain often feels like yak shaving,
- especially when all they want to do is just install some modules and start
- writing code.
-
- =head2 Zero-conf? How does this module get/parse/update the CPAN index?
-
- It queries the CPAN Meta DB site running on Google AppEngine at
- L<http://cpanmetadb.appspot.com/>. The site is updated every hour to reflect
- the latest changes from fast syncing mirrors. The script then also falls back
- to scrape the site L<http://search.cpan.org/>.
-
- Fetched files are unpacked in C<~/.cpanm> and automatically cleaned up
- periodically. You can configure the location of this with the
- C<PERL_CPANM_HOME> environment variable.
-
- =head2 Where does this install modules to? Do I need root access?
-
- It installs to wherever ExtUtils::MakeMaker and Module::Build are
- configured to (via C<PERL_MM_OPT> and C<PERL_MB_OPT>). So if you're
- using local::lib, then it installs to your local perl5
- directory. Otherwise it installs to the site_perl directory that
- belongs to your perl.
-
- cpanminus at a boot time checks whether you have configured
- local::lib, or have the permission to install modules to the site_perl
- directory. If neither, it automatically sets up local::lib compatible
- installation path in a C<perl5> directory under your home
- directory. To avoid this, run the script as the root user, with
- C<--sudo> option or with C<--local-lib> option.
-
- =head2 cpanminus can't install the module XYZ. Is it a bug?
-
- It is more likely a problem with the distribution itself. cpanminus
- doesn't support or is known to have issues with distributions like as
- follows:
-
- =over 4
-
- =item *
-
- Tests that require input from STDIN.
-
- =item *
-
- Tests that might fail when C<AUTOMATED_TESTING> is enabled.
-
- =item *
-
- Modules that have invalid numeric values as VERSION (such as C<1.1a>)
-
- =back
-
- These failures can be reported back to the author of the module so
- that they can fix it accordingly, rather than me.
-
- =head2 Does cpanm support the feature XYZ of L<CPAN> and L<CPANPLUS>?
-
- Most likely not. Here are the things that cpanm doesn't do by
- itself. And it's a feature - you got that from the name I<minus>,
- right?
-
- If you need these features, use L<CPAN>, L<CPANPLUS> or the standalone
- tools that are mentioned.
-
- =over 4
-
- =item *
-
- Bundle:: module dependencies
-
- =item *
-
- CPAN testers reporting
-
- =item *
-
- Building RPM packages from CPAN modules
-
- =item *
-
- Listing the outdated modules that needs upgrading. See L<cpan-outdated>
-
- =item *
-
- Uninstalling modules. See L<pm-uninstall>.
-
- =item *
-
- Showing the changes of the modules you're about to upgrade. See L<cpan-listchanges>
-
- =item *
-
- Patching CPAN modules with distroprefs.
-
- =back
-
- See L<cpanm> or C<cpanm -h> to see what cpanminus I<can> do :)
-
- =head1 COPYRIGHT
-
- Copyright 2010- Tatsuhiko Miyagawa
-
- The standalone executable contains the following modules embedded.
-
- =over 4
-
- =item L<CPAN::DistnameInfo> Copyright 2003 Graham Barr
-
- =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
-
- =item L<local::lib> Copyright 2007-2009 Matt S Trout
-
- =item L<HTTP::Tiny> Copyright 2011 Christian Hansen
-
- =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
-
- =item L<version> Copyright 2004-2010 John Peacock
-
- =back
-
- =head1 LICENSE
-
- Same as Perl.
-
- =head1 CREDITS
-
- =head2 CONTRIBUTORS
-
- Patches and code improvements were contributed by:
-
- Goro Fuji, Kazuhiro Osawa, Tokuhiro Matsuno, Kenichi Ishigaki, Ian
- Wells, Pedro Melo, Masayoshi Sekimura, Matt S Trout, squeeky, horus
- and Ingy dot Net.
-
- =head2 ACKNOWLEDGEMENTS
-
- Bug reports, suggestions and feedbacks were sent by, or general
- acknowledgement goes to:
-
- Jesse Vincent, David Golden, Andreas Koenig, Jos Boumans, Chris
- Williams, Adam Kennedy, Audrey Tang, J. Shirley, Chris Prather, Jesse
- Luehrs, Marcus Ramberg, Shawn M Moore, chocolateboy, Chirs Nehren,
- Jonathan Rockway, Leon Brocard, Simon Elliott, Ricardo Signes, AEvar
- Arnfjord Bjarmason, Eric Wilhelm, Florian Ragwitz and xaicron.
-
- =head1 COMMUNITY
-
- =over 4
-
- =item L<http://github.com/miyagawa/cpanminus> - source code repository, issue tracker
-
- =item L<irc://irc.perl.org/#toolchain> - discussions about Perl toolchain. I'm there.
-
- =back
-
- =head1 NO WARRANTY
-
- This software is provided "as-is," without any express or implied
- warranty. In no event shall the author be held liable for any damages
- arising from the use of the software.
-
- =head1 SEE ALSO
-
- L<CPAN> L<CPANPLUS> L<pip>
-
- =cut
-
- 1;
-APP_CPANMINUS
-
-$fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
- package App::cpanminus::script;
- use strict;
- use Config;
- use Cwd ();
- use File::Basename ();
- use File::Find ();
- use File::Path ();
- use File::Spec ();
- use File::Copy ();
- use Getopt::Long ();
- use Parse::CPAN::Meta;
- use Symbol ();
-
- use constant WIN32 => $^O eq 'MSWin32';
- use constant SUNOS => $^O eq 'solaris';
-
- our $VERSION = "1.4007";
-
- my $quote = WIN32 ? q/"/ : q/'/;
-
- sub new {
- my $class = shift;
-
- bless {
- home => "$ENV{HOME}/.cpanm",
- cmd => 'install',
- seen => {},
- notest => undef,
- installdeps => undef,
- force => undef,
- sudo => undef,
- make => undef,
- verbose => undef,
- quiet => undef,
- interactive => undef,
- log => undef,
- mirrors => [],
- mirror_only => undef,
- perl => $^X,
- argv => [],
- local_lib => undef,
- self_contained => undef,
- prompt_timeout => 0,
- prompt => undef,
- configure_timeout => 60,
- try_lwp => 1,
- try_wget => 1,
- try_curl => 1,
- uninstall_shadows => ($] < 5.012),
- skip_installed => 1,
- auto_cleanup => 7, # days
- pod2man => 1,
- installed_dists => 0,
- scandeps => 0,
- scandeps_tree => [],
- format => 'tree',
- save_dists => undef,
- @_,
- }, $class;
- }
-
- sub env {
- my($self, $key) = @_;
- $ENV{"PERL_CPANM_" . $key};
- }
-
- sub parse_options {
- my $self = shift;
-
- local @ARGV = @{$self->{argv}};
- push @ARGV, split /\s+/, $self->env('OPT');
- push @ARGV, @_;
-
- Getopt::Long::Configure("bundling");
- Getopt::Long::GetOptions(
- 'f|force' => sub { $self->{skip_installed} = 0; $self->{force} = 1 },
- 'n|notest!' => \$self->{notest},
- 'S|sudo!' => \$self->{sudo},
- 'v|verbose' => sub { $self->{verbose} = $self->{interactive} = 1 },
- 'q|quiet' => \$self->{quiet},
- 'h|help' => sub { $self->{action} = 'show_help' },
- 'V|version' => sub { $self->{action} = 'show_version' },
- 'perl=s' => \$self->{perl},
- 'l|local-lib=s' => sub { $self->{local_lib} = $self->maybe_abs($_[1]) },
- 'L|local-lib-contained=s' => sub {
- $self->{local_lib} = $self->maybe_abs($_[1]);
- $self->{self_contained} = 1;
- $self->{pod2man} = undef;
- },
- 'mirror=s@' => $self->{mirrors},
- 'mirror-only!' => \$self->{mirror_only},
- 'prompt!' => \$self->{prompt},
- 'installdeps' => \$self->{installdeps},
- 'skip-installed!' => \$self->{skip_installed},
- 'reinstall' => sub { $self->{skip_installed} = 0 },
- 'interactive!' => \$self->{interactive},
- 'i|install' => sub { $self->{cmd} = 'install' },
- 'info' => sub { $self->{cmd} = 'info' },
- 'look' => sub { $self->{cmd} = 'look'; $self->{skip_installed} = 0 },
- 'self-upgrade' => sub { $self->{cmd} = 'install'; $self->{skip_installed} = 1; push @ARGV, 'App::cpanminus' },
- 'uninst-shadows!' => \$self->{uninstall_shadows},
- 'lwp!' => \$self->{try_lwp},
- 'wget!' => \$self->{try_wget},
- 'curl!' => \$self->{try_curl},
- 'auto-cleanup=s' => \$self->{auto_cleanup},
- 'man-pages!' => \$self->{pod2man},
- 'scandeps' => \$self->{scandeps},
- 'format=s' => \$self->{format},
- 'save-dists=s' => sub {
- $self->{save_dists} = $self->maybe_abs($_[1]);
- },
- );
-
- if (!@ARGV && $0 ne '-' && !-t STDIN){ # e.g. # cpanm < author/requires.cpanm
- push @ARGV, $self->load_argv_from_fh(\*STDIN);
- $self->{load_from_stdin} = 1;
- }
-
- $self->{argv} = \@ARGV;
- }
-
- sub check_libs {
- my $self = shift;
- return if $self->{_checked}++;
-
- $self->bootstrap_local_lib;
- if (@{$self->{bootstrap_deps} || []}) {
- local $self->{notest} = 1; # test failure in bootstrap should be tolerated
- local $self->{scandeps} = 0;
- $self->install_deps(Cwd::cwd, 0, @{$self->{bootstrap_deps}});
- }
- }
-
- sub doit {
- my $self = shift;
-
- $self->setup_home;
- $self->init_tools;
-
- if (my $action = $self->{action}) {
- $self->$action() and return 1;
- }
-
- $self->show_help(1)
- unless @{$self->{argv}} or $self->{load_from_stdin};
-
- $self->configure_mirrors;
-
- my @fail;
- for my $module (@{$self->{argv}}) {
- if ($module =~ s/\.pm$//i) {
- my ($volume, $dirs, $file) = File::Spec->splitpath($module);
- $module = join '::', grep { $_ } File::Spec->splitdir($dirs), $file;
- }
- $self->install_module($module, 0)
- or push @fail, $module;
- }
-
- if ($self->{base} && $self->{auto_cleanup}) {
- $self->cleanup_workdirs;
- }
-
- if ($self->{installed_dists}) {
- my $dists = $self->{installed_dists} > 1 ? "distributions" : "distribution";
- $self->diag("$self->{installed_dists} $dists installed\n", 1);
- }
-
- if ($self->{scandeps}) {
- $self->dump_scandeps();
- }
-
- return !@fail;
- }
-
- sub setup_home {
- my $self = shift;
-
- $self->{home} = $self->env('HOME') if $self->env('HOME');
-
- unless (_writable($self->{home})) {
- die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n";
- }
-
- $self->{base} = "$self->{home}/work/" . time . ".$$";
- File::Path::mkpath([ $self->{base} ], 0, 0777);
-
- my $link = "$self->{home}/latest-build";
- eval { unlink $link; symlink $self->{base}, $link };
-
- $self->{log} = File::Spec->catfile($self->{home}, "build.log"); # because we use shell redirect
-
- {
- my $log = $self->{log}; my $base = $self->{base};
- $self->{at_exit} = sub {
- my $self = shift;
- File::Copy::copy($self->{log}, "$self->{base}/build.log");
- };
- }
-
- { open my $out, ">$self->{log}" or die "$self->{log}: $!" }
-
- $self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" .
- "Work directory is $self->{base}\n");
- }
-
- sub fetch_meta_sco {
- my($self, $dist) = @_;
- return if $self->{mirror_only};
-
- my $meta_yml = $self->get("http://search.cpan.org/meta/$dist->{distvname}/META.yml");
- return $self->parse_meta_string($meta_yml);
- }
-
- sub package_index_for {
- my ($self, $mirror) = @_;
- return $self->source_for($mirror) . "/02packages.details.txt";
- }
-
- sub generate_mirror_index {
- my ($self, $mirror) = @_;
- my $file = $self->package_index_for($mirror);
- my $gz_file = $file . '.gz';
- my $index_mtime = (stat $gz_file)[9];
-
- unless (-e $file && (stat $file)[9] >= $index_mtime) {
- $self->chat("Uncompressing index file...\n");
- if (eval {require Compress::Zlib}) {
- my $gz = Compress::Zlib::gzopen($gz_file, "rb")
- or do { $self->diag_fail("$Compress::Zlib::gzerrno opening compressed index"); return};
- open my $fh, '>', $file
- or do { $self->diag_fail("$! opening uncompressed index for write"); return };
- my $buffer;
- while (my $status = $gz->gzread($buffer)) {
- if ($status < 0) {
- $self->diag_fail($gz->gzerror . " reading compressed index");
- return;
- }
- print $fh $buffer;
- }
- } else {
- if (system("gunzip -c $gz_file > $file")) {
- $self->diag_fail("Cannot uncompress -- please install gunzip or Compress::Zlib");
- return;
- }
- }
- utime $index_mtime, $index_mtime, $file;
- }
- return 1;
- }
-
- sub search_mirror_index {
- my ($self, $mirror, $module) = @_;
-
- open my $fh, '<', $self->package_index_for($mirror) or return;
- while (<$fh>) {
- if (m!^\Q$module\E\s+([\w\.]+)\s+(.*)!m) {
- return $self->cpan_module($module, $2, $1);
- }
- }
-
- return;
- }
-
- sub search_module {
- my($self, $module) = @_;
-
- unless ($self->{mirror_only}) {
- $self->chat("Searching $module on cpanmetadb ...\n");
- my $uri = "http://cpanmetadb.appspot.com/v1.0/package/$module";
- my $yaml = $self->get($uri);
- my $meta = $self->parse_meta_string($yaml);
- if ($meta && $meta->{distfile}) {
- return $self->cpan_module($module, $meta->{distfile}, $meta->{version});
- }
-
- $self->diag_fail("Finding $module on cpanmetadb failed.");
-
- $self->chat("Searching $module on search.cpan.org ...\n");
- my $uri = "http://search.cpan.org/perldoc?$module";
- my $html = $self->get($uri);
- $html =~ m!<a href="/CPAN/authors/id/(.*?\.(?:tar\.gz|tgz|tar\.bz2|zip))">!
- and return $self->cpan_module($module, $1);
-
- $self->diag_fail("Finding $module on search.cpan.org failed.");
- }
-
- MIRROR: for my $mirror (@{ $self->{mirrors} }) {
- $self->chat("Searching $module on mirror $mirror ...\n");
- my $name = '02packages.details.txt.gz';
- my $uri = "$mirror/modules/$name";
- my $gz_file = $self->package_index_for($mirror) . '.gz';
-
- unless ($self->{pkgs}{$uri}) {
- $self->chat("Downloading index file $uri ...\n");
- $self->mirror($uri, $gz_file);
- $self->generate_mirror_index($mirror) or next MIRROR;
- $self->{pkgs}{$uri} = "!!retrieved!!";
- }
-
- my $pkg = $self->search_mirror_index($mirror, $module);
- return $pkg if $pkg;
-
- $self->diag_fail("Finding $module on mirror $mirror failed.");
- }
-
- return;
- }
-
- sub source_for {
- my($self, $mirror) = @_;
- $mirror =~ s/[^\w\.\-]+/%/g;
-
- my $dir = "$self->{home}/sources/$mirror";
- File::Path::mkpath([ $dir ], 0, 0777);
-
- return $dir;
- }
-
- sub load_argv_from_fh {
- my($self, $fh) = @_;
-
- my @argv;
- while(defined(my $line = <$fh>)){
- chomp $line;
- $line =~ s/#.+$//; # comment
- $line =~ s/^\s+//; # trim spaces
- $line =~ s/\s+$//; # trim spaces
-
- push @argv, split ' ', $line if $line;
- }
- return @argv;
- }
-
- sub show_version {
- print "cpanm (App::cpanminus) version $VERSION\n";
- return 1;
- }
-
- sub show_help {
- my $self = shift;
-
- if ($_[0]) {
- die <<USAGE;
- Usage: cpanm [options] Module [...]
-
- Try `cpanm --help` or `man cpanm` for more options.
- USAGE
- }
-
- print <<HELP;
- Usage: cpanm [options] Module [...]
-
- Options:
- -v,--verbose Turns on chatty output
- -q,--quiet Turns off the most output
- --interactive Turns on interactive configure (required for Task:: modules)
- -f,--force force install
- -n,--notest Do not run unit tests
- -S,--sudo sudo to run install commands
- --installdeps Only install dependencies
- --reinstall Reinstall the distribution even if you already have the latest version installed
- --mirror Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
- --mirror-only Use the mirror's index file instead of the CPAN Meta DB
- --prompt Prompt when configure/build/test fails
- -l,--local-lib Specify the install base to install modules
- -L,--local-lib-contained Specify the install base to install all non-core modules
- --auto-cleanup Number of days that cpanm's work directories expire in. Defaults to 7
-
- Commands:
- --self-upgrade upgrades itself
- --info Displays distribution info on CPAN
- --look Opens the distribution with your SHELL
- -V,--version Displays software version
-
- Examples:
-
- cpanm Test::More # install Test::More
- cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path
- cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL
- cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file
- cpanm --interactive Task::Kensho # Configure interactively
- cpanm . # install from local directory
- cpanm --installdeps . # install all the deps for the current directory
- cpanm -L extlib Plack # install Plack and all non-core deps into extlib
- cpanm --mirror http://cpan.cpantesters.org/ DBI # use the fast-syncing mirror
-
- You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
-
- export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
-
- Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
-
- HELP
-
- return 1;
- }
-
- sub _writable {
- my $dir = shift;
- my @dir = File::Spec->splitdir($dir);
- while (@dir) {
- $dir = File::Spec->catdir(@dir);
- if (-e $dir) {
- return -w _;
- }
- pop @dir;
- }
-
- return;
- }
-
- sub maybe_abs {
- my($self, $lib) = @_;
- $lib =~ /^[~\/]/ ? $lib : Cwd::abs_path($lib);
- }
-
- sub bootstrap_local_lib {
- my $self = shift;
-
- # If -l is specified, use that.
- if ($self->{local_lib}) {
- return $self->setup_local_lib($self->{local_lib});
- }
-
- # root, locally-installed perl or --sudo: don't care about install_base
- return if $self->{sudo} or (_writable($Config{installsitelib}) and _writable($Config{installsitebin}));
-
- # local::lib is configured in the shell -- yay
- if ($ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT})) {
- $self->bootstrap_local_lib_deps;
- return;
- }
-
- $self->setup_local_lib;
-
- $self->diag(<<DIAG);
- !
- ! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
- ! To turn off this warning, you have to do one of the following:
- ! - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
- | - run me with --local-lib option e.g. cpanm --local-lib=~/perl5
- ! - Set PERL_CPANM_OPT="--local-lib=~/perl5" environment variable (in your shell rc file)
- ! - Configure local::lib in your shell to set PERL_MM_OPT etc.
- !
- DIAG
- sleep 2;
- }
-
- sub _core_only_inc {
- my($self, $base) = @_;
- require local::lib;
- (
- local::lib->install_base_perl_path($base),
- local::lib->install_base_arch_path($base),
- @Config{qw(privlibexp archlibexp)},
- );
- }
-
- sub _dump_inc {
- my($self, $inc, $std_inc) = @_;
-
- # $self->{base} for ModuleBuildPatch.pm, . for inc/Module/Install.pm
- my @new_inc = map { qq('$_') } (@$inc, $self->{base}, '.');
- my @exclude_inc = map { qq('$_') } grep { $_ ne '.' && !ref } $self->_diff($inc, $std_inc);
-
- open my $out, ">$self->{base}/DumpedINC.pm" or die $!;
- local $" = ",";
- print $out <<EOF;
- package DumpedINC;
- my \%exclude = map { \$_ => 1 } (@exclude_inc);
- sub import {
- if (\$_[1] eq "tests") {
- \@INC = grep !\$exclude{\$_}, \@INC;
- } else {
- \@INC = (@new_inc);
- }
- }
- 1;
- EOF
- }
-
- sub _diff {
- my($self, $old, $new) = @_;
-
- my @diff;
- my %old = map { $_ => 1 } @$old;
- for my $n (@$new) {
- push @diff, $n unless exists $old{$n};
- }
-
- @diff;
- }
-
- sub _setup_local_lib_env {
- my($self, $base) = @_;
- local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
- local::lib->setup_env_hash_for($base);
- }
-
- sub setup_local_lib {
- my($self, $base) = @_;
-
- require local::lib;
- {
- local $0 = 'cpanm'; # so curl/wget | perl works
- $base ||= "~/perl5";
- if ($self->{self_contained}) {
- my @inc = $self->_core_only_inc($base);
- $self->_dump_inc(\@inc, \@INC);
- $self->{search_inc} = [ @inc ];
- } else {
- $self->{search_inc} = [
- local::lib->install_base_arch_path($base),
- local::lib->install_base_perl_path($base),
- @INC,
- ];
- }
- $self->_setup_local_lib_env($base);
- }
-
- $self->bootstrap_local_lib_deps;
- }
-
- sub bootstrap_local_lib_deps {
- my $self = shift;
- push @{$self->{bootstrap_deps}},
- 'ExtUtils::MakeMaker' => 6.31,
- 'ExtUtils::Install' => 1.46,
- 'Module::Build' => 0.36;
- }
-
- sub prompt_bool {
- my($self, $mess, $def) = @_;
-
- my $val = $self->prompt($mess, $def);
- return lc $val eq 'y';
- }
-
- sub prompt {
- my($self, $mess, $def) = @_;
-
- my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
- my $dispdef = defined $def ? "[$def] " : " ";
- $def = defined $def ? $def : "";
-
- if (!$self->{prompt} || (!$isa_tty && eof STDIN)) {
- return $def;
- }
-
- local $|=1;
- local $\;
- my $ans;
- eval {
- local $SIG{ALRM} = sub { undef $ans; die "alarm\n" };
- print STDOUT "$mess $dispdef";
- alarm $self->{prompt_timeout} if $self->{prompt_timeout};
- $ans = <STDIN>;
- alarm 0;
- };
- if ( defined $ans ) {
- chomp $ans;
- } else { # user hit ctrl-D or alarm timeout
- print STDOUT "\n";
- }
-
- return (!defined $ans || $ans eq '') ? $def : $ans;
- }
-
- sub diag_ok {
- my($self, $msg) = @_;
- chomp $msg;
- $msg ||= "OK";
- if ($self->{in_progress}) {
- $self->_diag("$msg\n");
- $self->{in_progress} = 0;
- }
- $self->log("-> $msg\n");
- }
-
- sub diag_fail {
- my($self, $msg, $always) = @_;
- chomp $msg;
- if ($self->{in_progress}) {
- $self->_diag("FAIL\n");
- $self->{in_progress} = 0;
- }
-
- if ($msg) {
- $self->_diag("! $msg\n", $always);
- $self->log("-> FAIL $msg\n");
- }
- }
-
- sub diag_progress {
- my($self, $msg) = @_;
- chomp $msg;
- $self->{in_progress} = 1;
- $self->_diag("$msg ... ");
- $self->log("$msg\n");
- }
-
- sub _diag {
- my($self, $msg, $always) = @_;
- print STDERR $msg if $always or $self->{verbose} or !$self->{quiet};
- }
-
- sub diag {
- my($self, $msg, $always) = @_;
- $self->_diag($msg, $always);
- $self->log($msg);
- }
-
- sub chat {
- my $self = shift;
- print STDERR @_ if $self->{verbose};
- $self->log(@_);
- }
-
- sub log {
- my $self = shift;
- open my $out, ">>$self->{log}";
- print $out @_;
- }
-
- sub run {
- my($self, $cmd) = @_;
-
- if (WIN32 && ref $cmd eq 'ARRAY') {
- $cmd = join q{ }, map { $self->shell_quote($_) } @$cmd;
- }
-
- if (ref $cmd eq 'ARRAY') {
- my $pid = fork;
- if ($pid) {
- waitpid $pid, 0;
- return !$?;
- } else {
- $self->run_exec($cmd);
- }
- } else {
- unless ($self->{verbose}) {
- $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
- }
- !system $cmd;
- }
- }
-
- sub run_exec {
- my($self, $cmd) = @_;
-
- if (ref $cmd eq 'ARRAY') {
- unless ($self->{verbose}) {
- open my $logfh, ">>", $self->{log};
- open STDERR, '>&', $logfh;
- open STDOUT, '>&', $logfh;
- close $logfh;
- }
- exec @$cmd;
- } else {
- unless ($self->{verbose}) {
- $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
- }
- exec $cmd;
- }
- }
-
- sub run_timeout {
- my($self, $cmd, $timeout) = @_;
- return $self->run($cmd) if WIN32 || $self->{verbose} || !$timeout;
-
- my $pid = fork;
- if ($pid) {
- eval {
- local $SIG{ALRM} = sub { die "alarm\n" };
- alarm $timeout;
- waitpid $pid, 0;
- alarm 0;
- };
- if ($@ && $@ eq "alarm\n") {
- $self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");
- local $SIG{TERM} = 'IGNORE';
- kill TERM => 0;
- waitpid $pid, 0;
- return;
- }
- return !$?;
- } elsif ($pid == 0) {
- $self->run_exec($cmd);
- } else {
- $self->chat("! fork failed: falling back to system()\n");
- $self->run($cmd);
- }
- }
-
- sub configure {
- my($self, $cmd) = @_;
-
- # trick AutoInstall
- local $ENV{PERL5_CPAN_IS_RUNNING} = local $ENV{PERL5_CPANPLUS_IS_RUNNING} = $$;
-
- # e.g. skip CPAN configuration on local::lib
- local $ENV{PERL5_CPANM_IS_RUNNING} = $$;
-
- my $use_default = !$self->{interactive};
- local $ENV{PERL_MM_USE_DEFAULT} = $use_default;
-
- # skip man page generation
- local $ENV{PERL_MM_OPT} = $ENV{PERL_MM_OPT};
- unless ($self->{pod2man}) {
- $ENV{PERL_MM_OPT} .= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";
- }
-
- local $self->{verbose} = $self->{verbose} || $self->{interactive};
- $self->run_timeout($cmd, $self->{configure_timeout});
- }
-
- sub build {
- my($self, $cmd, $distname) = @_;
-
- return 1 if $self->run_timeout($cmd, $self->{build_timeout});
- while (1) {
- my $ans = lc $self->prompt("Building $distname failed.\nYou can s)kip, r)etry or l)ook ?", "s");
- return if $ans eq 's';
- return $self->build($cmd, $distname) if $ans eq 'r';
- $self->look if $ans eq 'l';
- }
- }
-
- sub test {
- my($self, $cmd, $distname) = @_;
- return 1 if $self->{notest};
-
- # http://www.nntp.perl.org/group/perl.perl5.porters/2009/10/msg152656.html
- local $ENV{AUTOMATED_TESTING} = 1
- unless $self->env('NO_AUTOMATED_TESTING');
-
- local $ENV{PERL5OPT} = "-I$self->{base} -MDumpedINC=tests"
- if $self->{self_contained};
-
- return 1 if $self->run_timeout($cmd, $self->{test_timeout});
- if ($self->{force}) {
- $self->diag_fail("Testing $distname failed but installing it anyway.");
- return 1;
- } else {
- $self->diag_fail;
- while (1) {
- my $ans = lc $self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install or l)ook ?", "s");
- return if $ans eq 's';
- return $self->test($cmd, $distname) if $ans eq 'r';
- return 1 if $ans eq 'f';
- $self->look if $ans eq 'l';
- }
- }
- }
-
- sub install {
- my($self, $cmd, $uninst_opts) = @_;
-
- if ($self->{sudo}) {
- unshift @$cmd, "sudo";
- }
-
- if ($self->{uninstall_shadows} && !$ENV{PERL_MM_OPT}) {
- push @$cmd, @$uninst_opts;
- }
-
- $self->run($cmd);
- }
-
- sub look {
- my $self = shift;
-
- my $shell = $ENV{SHELL};
- $shell ||= $ENV{COMSPEC} if WIN32;
- if ($shell) {
- my $cwd = Cwd::cwd;
- $self->diag("Entering $cwd with $shell\n");
- system $shell;
- } else {
- $self->diag_fail("You don't seem to have a SHELL :/");
- }
- }
-
- sub chdir {
- my $self = shift;
- chdir(File::Spec->canonpath($_[0])) or die "$_[0]: $!";
- }
-
- sub configure_mirrors {
- my $self = shift;
- unless (@{$self->{mirrors}}) {
- $self->{mirrors} = [ 'http://search.cpan.org/CPAN' ];
- }
- for (@{$self->{mirrors}}) {
- s!^/!file:///!;
- s!/$!!;
- }
- }
-
- sub self_upgrade {
- my $self = shift;
- $self->{argv} = [ 'App::cpanminus' ];
- return; # continue
- }
-
- sub install_module {
- my($self, $module, $depth) = @_;
-
- if ($self->{seen}{$module}++) {
- $self->chat("Already tried $module. Skipping.\n");
- return 1;
- }
-
- my $dist = $self->resolve_name($module);
- unless ($dist) {
- $self->diag_fail("Couldn't find module or a distribution $module", 1);
- return;
- }
-
- if ($dist->{distvname} && $self->{seen}{$dist->{distvname}}++) {
- $self->chat("Already tried $dist->{distvname}. Skipping.\n");
- return 1;
- }
-
- if ($self->{cmd} eq 'info') {
- print $self->format_dist($dist), "\n";
- return 1;
- }
-
- $self->check_libs;
- $self->setup_module_build_patch unless $self->{pod2man};
-
- if ($dist->{module}) {
- my($ok, $local) = $self->check_module($dist->{module}, $dist->{module_version} || 0);
- if ($self->{skip_installed} && $ok) {
- $self->diag("$dist->{module} is up to date. ($local)\n", 1);
- return 1;
- }
- }
-
- if ($dist->{dist} eq 'perl'){
- $self->diag("skipping $dist->{pathname}\n");
- return 1;
- }
-
- $self->diag("--> Working on $module\n");
-
- $dist->{dir} ||= $self->fetch_module($dist);
-
- unless ($dist->{dir}) {
- $self->diag_fail("Failed to fetch distribution $dist->{distvname}", 1);
- return;
- }
-
- $self->chat("Entering $dist->{dir}\n");
- $self->chdir($self->{base});
- $self->chdir($dist->{dir});
-
- if ($self->{cmd} eq 'look') {
- $self->look;
- return 1;
- }
-
- return $self->build_stuff($module, $dist, $depth);
- }
-
- sub format_dist {
- my($self, $dist) = @_;
-
- # TODO support --dist-format?
- return "$dist->{cpanid}/$dist->{filename}";
- }
-
- sub fetch_module {
- my($self, $dist) = @_;
-
- $self->chdir($self->{base});
-
- for my $uri (@{$dist->{uris}}) {
- $self->diag_progress("Fetching $uri");
-
- # Ugh, $dist->{filename} can contain sub directory
- my $filename = $dist->{filename} || $uri;
- my $name = File::Basename::basename($filename);
-
- my $cancelled;
- my $fetch = sub {
- my $file;
- eval {
- local $SIG{INT} = sub { $cancelled = 1; die "SIGINT\n" };
- $self->mirror($uri, $name);
- $file = $name if -e $name;
- };
- $self->chat("$@") if $@ && $@ ne "SIGINT\n";
- return $file;
- };
-
- my($try, $file);
- while ($try++ < 3) {
- $file = $fetch->();
- last if $cancelled or $file;
- $self->diag_fail("Download $uri failed. Retrying ... ");
- }
-
- if ($cancelled) {
- $self->diag_fail("Download cancelled.");
- return;
- }
-
- unless ($file) {
- $self->diag_fail("Failed to download $uri");
- next;
- }
-
- $self->diag_ok;
- $dist->{local_path} = File::Spec->rel2abs($name);
-
- my $dir = $self->unpack($file);
- next unless $dir; # unpack failed
-
- if (my $save = $self->{save_dists}) {
- my $path = "$save/authors/id/$dist->{pathname}";
- $self->chat("Copying $name to $path\n");
- File::Path::mkpath([ File::Basename::dirname($path) ], 0, 0777);
- File::Copy::copy($file, $path) or warn $!;
- }
-
- return $dist, $dir;
- }
- }
-
- sub unpack {
- my($self, $file) = @_;
- $self->chat("Unpacking $file\n");
- my $dir = $file =~ /\.zip/i ? $self->unzip($file) : $self->untar($file);
- unless ($dir) {
- $self->diag_fail("Failed to unpack $file: no directory");
- }
- return $dir;
- }
-
- sub resolve_name {
- my($self, $module) = @_;
-
- # URL
- if ($module =~ /^(ftp|https?|file):/) {
- if ($module =~ m!authors/id/!) {
- return $self->cpan_dist($module, $module);
- } else {
- return { uris => [ $module ] };
- }
- }
-
- # Directory
- if ($module =~ m!^[\./]! && -d $module) {
- return {
- source => 'local',
- dir => Cwd::abs_path($module),
- };
- }
-
- # File
- if (-f $module) {
- return {
- source => 'local',
- uris => [ "file://" . Cwd::abs_path($module) ],
- };
- }
-
- # cpan URI
- if ($module =~ s!^cpan:///distfile/!!) {
- return $self->cpan_dist($module);
- }
-
- # PAUSEID/foo
- if ($module =~ m!([A-Z]{3,})/!) {
- return $self->cpan_dist($module);
- }
-
- # Module name
- return $self->search_module($module);
- }
-
- sub cpan_module {
- my($self, $module, $dist, $version) = @_;
-
- my $dist = $self->cpan_dist($dist);
- $dist->{module} = $module;
- $dist->{module_version} = $version if $version && $version ne 'undef';
-
- return $dist;
- }
-
- sub cpan_dist {
- my($self, $dist, $url) = @_;
-
- $dist =~ s!^([A-Z]{3})!substr($1,0,1)."/".substr($1,0,2)."/".$1!e;
-
- require CPAN::DistnameInfo;
- my $d = CPAN::DistnameInfo->new($dist);
-
- if ($url) {
- $url = [ $url ] unless ref $url eq 'ARRAY';
- } else {
- my $id = $d->cpanid;
- my $fn = substr($id, 0, 1) . "/" . substr($id, 0, 2) . "/" . $id . "/" . $d->filename;
-
- my @mirrors = @{$self->{mirrors}};
- my @urls = map "$_/authors/id/$fn", @mirrors;
-
- $url = \@urls,
- }
-
- return {
- $d->properties,
- source => 'cpan',
- uris => $url,
- };
- }
-
- sub setup_module_build_patch {
- my $self = shift;
-
- open my $out, ">$self->{base}/ModuleBuildSkipMan.pm" or die $!;
- print $out <<EOF;
- package ModuleBuildSkipMan;
- CHECK {
- if (%Module::Build::) {
- no warnings 'redefine';
- *Module::Build::Base::ACTION_manpages = sub {};
- *Module::Build::Base::ACTION_docs = sub {};
- }
- }
- 1;
- EOF
- }
-
- sub check_module {
- my($self, $mod, $want_ver) = @_;
-
- require Module::Metadata;
- my $meta = Module::Metadata->new_from_module($mod, inc => $self->{search_inc})
- or return 0, undef;
-
- my $version = $meta->version;
-
- # When -L is in use, the version loaded from 'perl' library path
- # might be newer than the version that is shipped with the current perl
- if ($self->{self_contained} && $self->loaded_from_perl_lib($meta)) {
- my $core_version = eval {
- require Module::CoreList;
- $Module::CoreList::version{$]+0}{$mod};
- };
-
- # HACK: Module::Build 0.3622 or later has non-core module
- # dependencies such as Perl::OSType and CPAN::Meta, and causes
- # issues when a newer version is loaded from 'perl' while deps
- # are loaded from the 'site' library path. Just assume it's
- # not in the core, and install to the new local library path.
- if ($mod eq 'Module::Build' && $core_version != $version) {
- return 0, undef;
- }
-
- $version = $core_version if $core_version;
- }
-
- $self->{local_versions}{$mod} = $version;
-
- if ($self->is_deprecated($meta)){
- return 0, $version;
- } elsif (!$want_ver or $version >= version->new($want_ver)) {
- return 1, ($version || 'undef');
- } else {
- return 0, $version;
- }
- }
-
- sub is_deprecated {
- my($self, $meta) = @_;
-
- my $deprecated = eval {
- require Module::CoreList;
- Module::CoreList::is_deprecated($meta->{module});
- };
-
- return unless $deprecated;
- return $self->loaded_from_perl_lib($meta);
- }
-
- sub loaded_from_perl_lib {
- my($self, $meta) = @_;
-
- require Config;
- for my $dir (qw(archlibexp privlibexp)) {
- my $confdir = $Config{$dir};
- if ($confdir eq substr($meta->filename, 0, length($confdir))) {
- return 1;
- }
- }
-
- return;
- }
-
- sub should_install {
- my($self, $mod, $ver) = @_;
-
- $self->chat("Checking if you have $mod $ver ... ");
- my($ok, $local) = $self->check_module($mod, $ver);
-
- if ($ok) { $self->chat("Yes ($local)\n") }
- elsif ($local) { $self->chat("No ($local < $ver)\n") }
- else { $self->chat("No\n") }
-
- return $mod unless $ok;
- return;
- }
-
- sub install_deps {
- my($self, $dir, $depth, @deps) = @_;
-
- my(@install, %seen);
- while (my($mod, $ver) = splice @deps, 0, 2) {
- next if $seen{$mod} or $mod eq 'perl' or $mod eq 'Config';
- if ($self->should_install($mod, $ver)) {
- push @install, $mod;
- $seen{$mod} = 1;
- }
- }
-
- if (@install) {
- $self->diag("==> Found dependencies: " . join(", ", @install) . "\n");
- }
-
- my @fail;
- for my $mod (@install) {
- $self->install_module($mod, $depth + 1)
- or push @fail, $mod;
- }
-
- $self->chdir($self->{base});
- $self->chdir($dir) if $dir;
-
- return @fail;
- }
-
- sub install_deps_bailout {
- my($self, $target, $dir, $depth, @deps) = @_;
-
- my @fail = $self->install_deps($dir, $depth, @deps);
- if (@fail) {
- unless ($self->prompt_bool("Installing the following dependencies failed:\n==> " .
- join(", ", @fail) . "\nDo you want to continue building $target anyway?", "n")) {
- $self->diag_fail("Bailing out the installation for $target. Retry with --prompt or --force.", 1);
- return;
- }
- }
-
- return 1;
- }
-
- sub build_stuff {
- my($self, $stuff, $dist, $depth) = @_;
-
- my @config_deps;
- if (!%{$dist->{meta} || {}} && -e 'META.yml') {
- $self->chat("Checking configure dependencies from META.yml\n");
- $dist->{meta} = $self->parse_meta('META.yml');
- }
-
- if (!$dist->{meta} && $dist->{source} eq 'cpan') {
- $self->chat("META.yml not found or unparsable. Fetching META.yml from search.cpan.org\n");
- $dist->{meta} = $self->fetch_meta_sco($dist);
- }
-
- $dist->{meta} ||= {};
-
- push @config_deps, %{$dist->{meta}{configure_requires} || {}};
-
- my $target = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};
-
- $self->install_deps_bailout($target, $dist->{dir}, $depth, @config_deps)
- or return;
-
- $self->diag_progress("Configuring $target");
-
- my $configure_state = $self->configure_this($dist);
-
- $self->diag_ok($configure_state->{configured_ok} ? "OK" : "N/A");
-
- my @deps = $self->find_prereqs($dist);
-
- my $distname = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;
-
- my $walkup;
- if ($self->{scandeps}) {
- $walkup = $self->scandeps_append_child($dist);
- }
-
- $self->install_deps_bailout($distname, $dist->{dir}, $depth, @deps)
- or return;
-
- if ($self->{scandeps}) {
- unless ($configure_state->{configured_ok}) {
- my $diag = <<DIAG;
- ! Configuring $distname failed. See $self->{log} for details.
- ! You might have to install the following modules first to get --scandeps working correctly.
- DIAG
- if (@config_deps) {
- my @tree = @{$self->{scandeps_tree}};
- $diag .= "!\n" . join("", map "! * $_->[0]{module}\n", @tree[0..$#tree-1]) if @tree;
- }
- $self->diag("!\n$diag!\n", 1);
- }
- $walkup->();
- return 1;
- }
-
- if ($self->{installdeps} && $depth == 0) {
- $self->diag("<== Installed dependencies for $stuff. Finishing.\n");
- return 1;
- }
-
- my $installed;
- if ($configure_state->{use_module_build} && -e 'Build' && -f _) {
- my @switches = $self->{pod2man} ? () : ("-I$self->{base}", "-MModuleBuildSkipMan");
- $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
- $self->build([ $self->{perl}, @switches, "./Build" ], $distname) &&
- $self->test([ $self->{perl}, "./Build", "test" ], $distname) &&
- $self->install([ $self->{perl}, @switches, "./Build", "install" ], [ "--uninst", 1 ]) &&
- $installed++;
- } elsif ($self->{make} && -e 'Makefile') {
- $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
- $self->build([ $self->{make} ], $distname) &&
- $self->test([ $self->{make}, "test" ], $distname) &&
- $self->install([ $self->{make}, "install" ], [ "UNINST=1" ]) &&
- $installed++;
- } else {
- my $why;
- my $configure_failed = $configure_state->{configured} && !$configure_state->{configured_ok};
- if ($configure_failed) { $why = "Configure failed for $distname." }
- elsif ($self->{make}) { $why = "The distribution doesn't have a proper Makefile.PL/Build.PL" }
- else { $why = "Can't configure the distribution. You probably need to have 'make'." }
-
- $self->diag_fail("$why See $self->{log} for details.", 1);
- return;
- }
-
- if ($installed) {
- my $local = $self->{local_versions}{$dist->{module} || ''};
- my $version = $dist->{module_version} || $dist->{meta}{version} || $dist->{version};
- my $reinstall = $local && ($local eq $version);
-
- my $how = $reinstall ? "reinstalled $distname"
- : $local ? "installed $distname (upgraded from $local)"
- : "installed $distname" ;
- my $msg = "Successfully $how";
- $self->diag_ok;
- $self->diag("$msg\n", 1);
- $self->{installed_dists}++;
- return 1;
- } else {
- my $msg = "Building $distname failed";
- $self->diag_fail("Installing $stuff failed. See $self->{log} for details.", 1);
- return;
- }
- }
-
- sub configure_this {
- my($self, $dist) = @_;
-
- my @switches;
- @switches = ("-I$self->{base}", "-MDumpedINC") if $self->{self_contained};
- local $ENV{PERL5LIB} = '' if $self->{self_contained};
-
- my @mb_switches = @switches;
- unless ($self->{pod2man}) {
- # it has to be push, so Module::Build is loaded from the adjusted path when -L is in use
- push @mb_switches, ("-I$self->{base}", "-MModuleBuildSkipMan");
- }
-
- my $state = {};
-
- my $try_eumm = sub {
- if (-e 'Makefile.PL') {
- $self->chat("Running Makefile.PL\n");
- local $ENV{X_MYMETA} = 'YAML';
-
- # NOTE: according to Devel::CheckLib, most XS modules exit
- # with 0 even if header files are missing, to avoid receiving
- # tons of FAIL reports in such cases. So exit code can't be
- # trusted if it went well.
- if ($self->configure([ $self->{perl}, @switches, "Makefile.PL" ])) {
- $state->{configured_ok} = -e 'Makefile';
- }
- $state->{configured}++;
- }
- };
-
- my $try_mb = sub {
- if (-e 'Build.PL') {
- $self->chat("Running Build.PL\n");
- if ($self->configure([ $self->{perl}, @mb_switches, "Build.PL" ])) {
- $state->{configured_ok} = -e 'Build' && -f _;
- }
- $state->{use_module_build}++;
- $state->{configured}++;
- }
- };
-
- # Module::Build deps should use MakeMaker because that causes circular deps and fail
- # Otherwise we should prefer Build.PL
- my %should_use_mm = map { $_ => 1 } qw( version ExtUtils-ParseXS ExtUtils-Install ExtUtils-Manifest );
-
- my @try;
- if ($dist->{dist} && $should_use_mm{$dist->{dist}}) {
- @try = ($try_eumm, $try_mb);
- } else {
- @try = ($try_mb, $try_eumm);
- }
-
- for my $try (@try) {
- $try->();
- last if $state->{configured_ok};
- }
-
- unless ($state->{configured_ok}) {
- while (1) {
- my $ans = lc $self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry or l)ook ?", "s");
- last if $ans eq 's';
- return $self->configure_this($dist) if $ans eq 'r';
- $self->look if $ans eq 'l';
- }
- }
-
- return $state;
- }
-
- sub safe_eval {
- my($self, $code) = @_;
- eval $code;
- }
-
- sub find_prereqs {
- my($self, $dist) = @_;
-
- my @deps;
-
- my $meta = $dist->{meta};
- if (-e 'MYMETA.yml') {
- $self->chat("Checking dependencies from MYMETA.yml ...\n");
- my $mymeta = $self->parse_meta('MYMETA.yml');
- if ($mymeta) {
- @deps = $self->extract_requires($mymeta);
- $meta->{$_} = $mymeta->{$_} for keys %$mymeta; # merge
- }
- } elsif (-e '_build/prereqs') {
- $self->chat("Checking dependencies from _build/prereqs ...\n");
- my $mymeta = do { open my $in, "_build/prereqs"; $self->safe_eval(join "", <$in>) };
- @deps = $self->extract_requires($mymeta);
- }
-
- if (-e 'Makefile') {
- $self->chat("Finding PREREQ from Makefile ...\n");
- open my $mf, "Makefile";
- while (<$mf>) {
- if (/^\#\s+PREREQ_PM => {\s*(.*?)\s*}/) {
- my @all;
- my @pairs = split ', ', $1;
- for (@pairs) {
- my ($pkg, $v) = split '=>', $_;
- push @all, [ $pkg, $v ];
- }
- my $list = join ", ", map { "'$_->[0]' => $_->[1]" } @all;
- my $prereq = $self->safe_eval("no strict; +{ $list }");
- push @deps, %$prereq if $prereq;
- last;
- }
- }
- }
-
- if ($dist->{module} =~ /^Bundle::/i) {
- push @deps, $self->bundle_deps($dist);
- }
-
- # No need to remove, but this gets in the way of signature testing :/
- unlink $_ for qw(MYMETA.json MYMETA.yml);
-
- return @deps;
- }
-
- sub bundle_deps {
- my($self, $dist) = @_;
-
- my @files;
- File::Find::find({
- wanted => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i },
- no_chdir => 1,
- }, '.');
-
- my @deps;
-
- for my $file (@files) {
- open my $pod, "<", $file or next;
- my $in_contents;
- while (<$pod>) {
- if (/^=head\d\s+CONTENTS/) {
- $in_contents = 1;
- } elsif (/^=/) {
- $in_contents = 0;
- } elsif ($in_contents) {
- /^(\S+)\s*(\S+)?/
- and push @deps, $1, $self->maybe_version($2);
- }
- }
- }
-
- return @deps;
- }
-
- sub maybe_version {
- my($self, $string) = @_;
- return $string && $string =~ /^\.?\d/ ? $string : undef;
- }
-
- sub extract_requires {
- my($self, $meta) = @_;
-
- my @deps;
- push @deps, %{$meta->{requires}} if $meta->{requires};
- push @deps, %{$meta->{build_requires}} if $meta->{build_requires};
-
- return @deps;
- }
-
- sub cleanup_workdirs {
- my $self = shift;
-
- my $expire = time - 24 * 60 * 60 * $self->{auto_cleanup};
- my @targets;
-
- opendir my $dh, "$self->{home}/work";
- while (my $e = readdir $dh) {
- next if $e !~ /^(\d+)\.\d+$/; # {UNIX time}.{PID}
- my $time = $1;
- if ($time < $expire) {
- push @targets, "$self->{home}/work/$e";
- }
- }
-
- if (@targets) {
- $self->chat("Expiring ", scalar(@targets), " work directories.\n");
- File::Path::rmtree(\@targets, 0, 0); # safe = 0, since blib usually doesn't have write bits
- }
- }
-
- sub scandeps_append_child {
- my($self, $dist) = @_;
-
- my $new_node = [ $dist, [] ];
-
- my $curr_node = $self->{scandeps_current} || [ undef, $self->{scandeps_tree} ];
- push @{$curr_node->[1]}, $new_node;
-
- $self->{scandeps_current} = $new_node;
-
- return sub { $self->{scandeps_current} = $curr_node };
- }
-
- sub dump_scandeps {
- my $self = shift;
-
- if ($self->{format} eq 'tree') {
- $self->walk_down(sub {
- my($dist, $depth) = @_;
- if ($depth == 0) {
- print "$dist->{distvname}\n";
- } else {
- print " " x ($depth - 1);
- print "\\_ $dist->{distvname}\n";
- }
- }, 1);
- } elsif ($self->{format} =~ /^dists?$/) {
- $self->walk_down(sub {
- my($dist, $depth) = @_;
- print $self->format_dist($dist), "\n";
- }, 0);
- } elsif ($self->{format} eq 'json') {
- require JSON;
- print JSON::encode_json($self->{scandeps_tree});
- } elsif ($self->{format} eq 'yaml') {
- require YAML;
- print YAML::Dump($self->{scandeps_tree});
- } else {
- $self->diag("Unknown format: $self->{format}\n");
- }
- }
-
- sub walk_down {
- my($self, $cb, $pre) = @_;
- $self->_do_walk_down($self->{scandeps_tree}, $cb, 0, $pre);
- }
-
- sub _do_walk_down {
- my($self, $children, $cb, $depth, $pre) = @_;
-
- # DFS - $pre determines when we call the callback
- for my $node (@$children) {
- $cb->($node->[0], $depth) if $pre;
- $self->_do_walk_down($node->[1], $cb, $depth + 1, $pre);
- $cb->($node->[0], $depth) unless $pre;
- }
- }
-
- sub DESTROY {
- my $self = shift;
- $self->{at_exit}->($self) if $self->{at_exit};
- }
-
- # Utils
-
- sub shell_quote {
- my($self, $stuff) = @_;
- $stuff =~ /^${quote}.+${quote}$/ ? $stuff : ($quote . $stuff . $quote);
- }
-
- sub which {
- my($self, $name) = @_;
- my $exe_ext = $Config{_exe};
- for my $dir (File::Spec->path) {
- my $fullpath = File::Spec->catfile($dir, $name);
- if (-x $fullpath || -x ($fullpath .= $exe_ext)) {
- if ($fullpath =~ /\s/ && $fullpath !~ /^$quote/) {
- $fullpath = $self->shell_quote($fullpath);
- }
- return $fullpath;
- }
- }
- return;
- }
-
- sub get { $_[0]->{_backends}{get}->(@_) };
- sub mirror { $_[0]->{_backends}{mirror}->(@_) };
- sub untar { $_[0]->{_backends}{untar}->(@_) };
- sub unzip { $_[0]->{_backends}{unzip}->(@_) };
-
- sub file_get {
- my($self, $uri) = @_;
- open my $fh, "<$uri" or return;
- join '', <$fh>;
- }
-
- sub file_mirror {
- my($self, $uri, $path) = @_;
- File::Copy::copy($uri, $path);
- }
-
- sub init_tools {
- my $self = shift;
-
- return if $self->{initialized}++;
-
- if ($self->{make} = $self->which($Config{make})) {
- $self->chat("You have make $self->{make}\n");
- }
-
- # use --no-lwp if they have a broken LWP, to upgrade LWP
- if ($self->{try_lwp} && eval { require LWP::UserAgent; LWP::UserAgent->VERSION(5.802) }) {
- $self->chat("You have LWP $LWP::VERSION\n");
- my $ua = sub {
- LWP::UserAgent->new(
- parse_head => 0,
- env_proxy => 1,
- agent => "cpanminus/$VERSION",
- timeout => 30,
- @_,
- );
- };
- $self->{_backends}{get} = sub {
- my $self = shift;
- my $res = $ua->()->request(HTTP::Request->new(GET => $_[0]));
- return unless $res->is_success;
- return $res->decoded_content;
- };
- $self->{_backends}{mirror} = sub {
- my $self = shift;
- my $res = $ua->()->mirror(@_);
- $res->code;
- };
- } elsif ($self->{try_wget} and my $wget = $self->which('wget')) {
- $self->chat("You have $wget\n");
- $self->{_backends}{get} = sub {
- my($self, $uri) = @_;
- return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
- $self->safeexec( my $fh, $wget, $uri, ( $self->{verbose} ? () : '-q' ), '-O', '-' ) or die "wget $uri: $!";
- local $/;
- <$fh>;
- };
- $self->{_backends}{mirror} = sub {
- my($self, $uri, $path) = @_;
- return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;
- $self->safeexec( my $fh, $wget, '--retry-connrefused', $uri, ( $self->{verbose} ? () : '-q' ), '-O', $path ) or die "wget $uri: $!";
- local $/;
- <$fh>;
- };
- } elsif ($self->{try_curl} and my $curl = $self->which('curl')) {
- $self->chat("You have $curl\n");
- $self->{_backends}{get} = sub {
- my($self, $uri) = @_;
- return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
- $self->safeexec( my $fh, $curl, '-L', ( $self->{verbose} ? () : '-s' ), $uri ) or die "curl $uri: $!";
- local $/;
- <$fh>;
- };
- $self->{_backends}{mirror} = sub {
- my($self, $uri, $path) = @_;
- return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;
- $self->safeexec( my $fh, $curl, '-L', $uri, ( $self->{verbose} ? () : '-s' ), '-#', '-o', $path ) or die "curl $uri: $!";
- local $/;
- <$fh>;
- };
- } else {
- require HTTP::Tiny;
- $self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");
-
- $self->{_backends}{get} = sub {
- my $self = shift;
- my $res = HTTP::Tiny->new->get($_[0]);
- return unless $res->{success};
- return $res->{content};
- };
- $self->{_backends}{mirror} = sub {
- my $self = shift;
- my $res = HTTP::Tiny->new->mirror(@_);
- return $res->{status};
- };
- }
-
- my $tar = $self->which('tar');
- my $tar_ver;
- my $maybe_bad_tar = sub { WIN32 || SUNOS || (($tar_ver = `$tar --version 2>/dev/null`) =~ /GNU.*1\.13/i) };
-
- if ($tar && !$maybe_bad_tar->()) {
- chomp $tar_ver;
- $self->chat("You have $tar: $tar_ver\n");
- $self->{_backends}{untar} = sub {
- my($self, $tarfile) = @_;
-
- my $xf = "xf" . ($self->{verbose} ? 'v' : '');
- my $ar = $tarfile =~ /bz2$/ ? 'j' : 'z';
-
- my($root, @others) = `$tar tf$ar $tarfile`
- or return undef;
-
- chomp $root;
- $root =~ s!^\./!!;
- $root =~ s{^(.+?)/.*$}{$1};
-
- system "$tar $xf$ar $tarfile";
- return $root if -d $root;
-
- $self->diag_fail("Bad archive: $tarfile");
- return undef;
- }
- } elsif ( $tar
- and my $gzip = $self->which('gzip')
- and my $bzip2 = $self->which('bzip2')) {
- $self->chat("You have $tar, $gzip and $bzip2\n");
- $self->{_backends}{untar} = sub {
- my($self, $tarfile) = @_;
-
- my $x = "x" . ($self->{verbose} ? 'v' : '') . "f -";
- my $ar = $tarfile =~ /bz2$/ ? $bzip2 : $gzip;
-
- my($root, @others) = `$ar -dc $tarfile | $tar tf -`
- or return undef;
-
- chomp $root;
- $root =~ s{^(.+?)/.*$}{$1};
-
- system "$ar -dc $tarfile | $tar $x";
- return $root if -d $root;
-
- $self->diag_fail("Bad archive: $tarfile");
- return undef;
- }
- } elsif (eval { require Archive::Tar }) { # uses too much memory!
- $self->chat("Falling back to Archive::Tar $Archive::Tar::VERSION\n");
- $self->{_backends}{untar} = sub {
- my $self = shift;
- my $t = Archive::Tar->new($_[0]);
- my $root = ($t->list_files)[0];
- $root =~ s{^(.+?)/.*$}{$1};
- $t->extract;
- return -d $root ? $root : undef;
- };
- } else {
- $self->{_backends}{untar} = sub {
- die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n";
- };
- }
-
- if (my $unzip = $self->which('unzip')) {
- $self->chat("You have $unzip\n");
- $self->{_backends}{unzip} = sub {
- my($self, $zipfile) = @_;
-
- my $opt = $self->{verbose} ? '' : '-q';
- my(undef, $root, @others) = `$unzip -t $zipfile`
- or return undef;
-
- chomp $root;
- $root =~ s{^\s+testing:\s+(.+?)/\s+OK$}{$1};
-
- system "$unzip $opt $zipfile";
- return $root if -d $root;
-
- $self->diag_fail("Bad archive: [$root] $zipfile");
- return undef;
- }
- } else {
- $self->{_backends}{unzip} = sub {
- eval { require Archive::Zip }
- or die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";
- my($self, $file) = @_;
- my $zip = Archive::Zip->new();
- my $status;
- $status = $zip->read($file);
- $self->diag_fail("Read of file[$file] failed")
- if $status != Archive::Zip::AZ_OK();
- my @members = $zip->members();
- my $root;
- for my $member ( @members ) {
- my $af = $member->fileName();
- next if ($af =~ m!^(/|\.\./)!);
- $root = $af unless $root;
- $status = $member->extractToFileNamed( $af );
- $self->diag_fail("Extracting of file[$af] from zipfile[$file failed")
- if $status != Archive::Zip::AZ_OK();
- }
- return -d $root ? $root : undef;
- };
- }
- }
-
- sub safeexec {
- my $self = shift;
- my $rdr = $_[0] ||= Symbol::gensym();
-
- if (WIN32) {
- my $cmd = join q{ }, map { $self->shell_quote($_) } @_[ 1 .. $#_ ];
- return open( $rdr, "$cmd |" );
- }
-
- if ( my $pid = open( $rdr, '-|' ) ) {
- return $pid;
- }
- elsif ( defined $pid ) {
- exec( @_[ 1 .. $#_ ] );
- exit 1;
- }
- else {
- return;
- }
- }
-
- sub parse_meta {
- my($self, $file) = @_;
- return eval { (Parse::CPAN::Meta::LoadFile($file))[0] } || undef;
- }
-
- sub parse_meta_string {
- my($self, $yaml) = @_;
- return eval { (Parse::CPAN::Meta::Load($yaml))[0] } || undef;
- }
-
- 1;
-APP_CPANMINUS_SCRIPT
-
-$fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
-
- package CPAN::DistnameInfo;
-
- $VERSION = "0.11";
- use strict;
-
- sub distname_info {
- my $file = shift or return;
-
- my ($dist, $version) = $file =~ /^
- ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
- (?:
- [A-Za-z](?=[^A-Za-z]|$)
- |
- \d(?=-)
- )(?<![._-][vV])
- )+)(.*)
- $/xs or return ($file,undef,undef);
-
- if ($dist =~ /-undef\z/ and ! length $version) {
- $dist =~ s/-undef\z//;
- }
-
- # Remove potential -withoutworldwriteables suffix
- $version =~ s/-withoutworldwriteables$//;
-
- if ($version =~ /^(-[Vv].*)-(\d.*)/) {
-
- # Catch names like Unicode-Collate-Standard-V3_1_1-0.1
- # where the V3_1_1 is part of the distname
- $dist .= $1;
- $version = $2;
- }
-
- # Normalize the Dist.pm-1.23 convention which CGI.pm and
- # a few others use.
- $dist =~ s{\.pm$}{};
-
- $version = $1
- if !length $version and $dist =~ s/-(\d+\w)$//;
-
- $version = $1 . $version
- if $version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;
-
- if ($version =~ /\d\.\d/) {
- $version =~ s/^[-_.]+//;
- }
- else {
- $version =~ s/^[-_]+//;
- }
-
- my $dev;
- if (length $version) {
- if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/) {
- $dev = 1 if (($1 > 6 and $1 & 1) or ($2 and $2 >= 50)) or $3;
- }
- elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/) {
- $dev = 1;
- }
- }
- else {
- $version = undef;
- }
-
- ($dist, $version, $dev);
- }
-
- sub new {
- my $class = shift;
- my $distfile = shift;
-
- $distfile =~ s,//+,/,g;
-
- my %info = ( pathname => $distfile );
-
- ($info{filename} = $distfile) =~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,,
- and $info{cpanid} = $6;
-
- if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i) { # support more ?
- $info{distvname} = $1;
- $info{extension} = $2;
- }
-
- @info{qw(dist version beta)} = distname_info($info{distvname});
- $info{maturity} = delete $info{beta} ? 'developer' : 'released';
-
- return bless \%info, $class;
- }
-
- sub dist { shift->{dist} }
- sub version { shift->{version} }
- sub maturity { shift->{maturity} }
- sub filename { shift->{filename} }
- sub cpanid { shift->{cpanid} }
- sub distvname { shift->{distvname} }
- sub extension { shift->{extension} }
- sub pathname { shift->{pathname} }
-
- sub properties { %{ $_[0] } }
-
- 1;
-
- __END__
-
-CPAN_DISTNAMEINFO
-
-$fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
- # vim: ts=4 sts=4 sw=4 et:
- #
- # This file is part of HTTP-Tiny
- #
- # This software is copyright (c) 2011 by Christian Hansen.
- #
- # This is free software; you can redistribute it and/or modify it under
- # the same terms as the Perl 5 programming language system itself.
- #
- package HTTP::Tiny;
- BEGIN {
- $HTTP::Tiny::VERSION = '0.009';
- }
- use strict;
- use warnings;
- # ABSTRACT: A small, simple, correct HTTP/1.1 client
-
- use Carp ();
-
-
- my @attributes;
- BEGIN {
- @attributes = qw(agent default_headers max_redirect max_size proxy timeout);
- no strict 'refs';
- for my $accessor ( @attributes ) {
- *{$accessor} = sub {
- @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
- };
- }
- }
-
- sub new {
- my($class, %args) = @_;
- (my $agent = $class) =~ s{::}{-}g;
- my $self = {
- agent => $agent . "/" . ($class->VERSION || 0),
- max_redirect => 5,
- timeout => 60,
- };
- for my $key ( @attributes ) {
- $self->{$key} = $args{$key} if exists $args{$key}
- }
- return bless $self, $class;
- }
-
-
- sub get {
- my ($self, $url, $args) = @_;
- @_ == 2 || (@_ == 3 && ref $args eq 'HASH')
- or Carp::croak(q/Usage: $http->get(URL, [HASHREF])/);
- return $self->request('GET', $url, $args || {});
- }
-
-
- sub mirror {
- my ($self, $url, $file, $args) = @_;
- @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
- or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/);
- if ( -e $file and my $mtime = (stat($file))[9] ) {
- $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
- }
- my $tempfile = $file . int(rand(2**31));
- open my $fh, ">", $tempfile
- or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!/);
- $args->{data_callback} = sub { print {$fh} $_[0] };
- my $response = $self->request('GET', $url, $args);
- close $fh
- or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!/);
- if ( $response->{success} ) {
- rename $tempfile, $file
- or Carp::croak "Error replacing $file with $tempfile: $!\n";
- my $lm = $response->{headers}{'last-modified'};
- if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
- utime $mtime, $mtime, $file;
- }
- }
- $response->{success} ||= $response->{status} eq '304';
- unlink $tempfile;
- return $response;
- }
-
-
- my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
-
- sub request {
- my ($self, $method, $url, $args) = @_;
- @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
- or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/);
- $args ||= {}; # we keep some state in this during _request
-
- # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
- my $response;
- for ( 0 .. 1 ) {
- $response = eval { $self->_request($method, $url, $args) };
- last unless $@ && $idempotent{$method}
- && $@ =~ m{^(?:Socket closed|Unexpected end)};
- }
-
- if (my $e = "$@") {
- $response = {
- success => q{},
- status => 599,
- reason => 'Internal Exception',
- content => $e,
- headers => {
- 'content-type' => 'text/plain',
- 'content-length' => length $e,
- }
- };
- }
- return $response;
- }
-
- my %DefaultPort = (
- http => 80,
- https => 443,
- );
-
- sub _request {
- my ($self, $method, $url, $args) = @_;
-
- my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
-
- my $request = {
- method => $method,
- scheme => $scheme,
- host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
- uri => $path_query,
- headers => {},
- };
-
- my $handle = HTTP::Tiny::Handle->new(timeout => $self->{timeout});
-
- if ($self->{proxy}) {
- $request->{uri} = "$scheme://$request->{host_port}$path_query";
- croak(qq/HTTPS via proxy is not supported/)
- if $request->{scheme} eq 'https';
- $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
- }
- else {
- $handle->connect($scheme, $host, $port);
- }
-
- $self->_prepare_headers_and_cb($request, $args);
- $handle->write_request($request);
-
- my $response;
- do { $response = $handle->read_response_header }
- until (substr($response->{status},0,1) ne '1');
-
- if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
- $handle->close;
- return $self->_request(@redir_args, $args);
- }
-
- if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
- # response has no message body
- }
- else {
- my $data_cb = $self->_prepare_data_cb($response, $args);
- $handle->read_body($data_cb, $response);
- }
-
- $handle->close;
- $response->{success} = substr($response->{status},0,1) eq '2';
- return $response;
- }
-
- sub _prepare_headers_and_cb {
- my ($self, $request, $args) = @_;
-
- for ($self->{default_headers}, $args->{headers}) {
- next unless defined;
- while (my ($k, $v) = each %$_) {
- $request->{headers}{lc $k} = $v;
- }
- }
- $request->{headers}{'host'} = $request->{host_port};
- $request->{headers}{'connection'} = "close";
- $request->{headers}{'user-agent'} ||= $self->{agent};
-
- if (defined $args->{content}) {
- $request->{headers}{'content-type'} ||= "application/octet-stream";
- if (ref $args->{content} eq 'CODE') {
- $request->{headers}{'transfer-encoding'} = 'chunked'
- unless $request->{headers}{'content-length'}
- || $request->{headers}{'transfer-encoding'};
- $request->{cb} = $args->{content};
- }
- else {
- my $content = $args->{content};
- if ( $] ge '5.008' ) {
- utf8::downgrade($content, 1)
- or Carp::croak(q/Wide character in request message body/);
- }
- $request->{headers}{'content-length'} = length $content
- unless $request->{headers}{'content-length'}
- || $request->{headers}{'transfer-encoding'};
- $request->{cb} = sub { substr $content, 0, length $content, '' };
- }
- $request->{trailer_cb} = $args->{trailer_callback}
- if ref $args->{trailer_callback} eq 'CODE';
- }
- return;
- }
-
- sub _prepare_data_cb {
- my ($self, $response, $args) = @_;
- my $data_cb = $args->{data_callback};
- $response->{content} = '';
-
- if (!$data_cb || $response->{status} !~ /^2/) {
- if (defined $self->{max_size}) {
- $data_cb = sub {
- $_[1]->{content} .= $_[0];
- die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
- if length $_[1]->{content} > $self->{max_size};
- };
- }
- else {
- $data_cb = sub { $_[1]->{content} .= $_[0] };
- }
- }
- return $data_cb;
- }
-
- sub _maybe_redirect {
- my ($self, $request, $response, $args) = @_;
- my $headers = $response->{headers};
- my ($status, $method) = ($response->{status}, $request->{method});
- if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
- and $headers->{location}
- and ++$args->{redirects} <= $self->{max_redirect}
- ) {
- my $location = ($headers->{location} =~ /^\//)
- ? "$request->{scheme}://$request->{host_port}$headers->{location}"
- : $headers->{location} ;
- return (($status eq '303' ? 'GET' : $method), $location);
- }
- return;
- }
-
- sub _split_url {
- my $url = pop;
-
- # URI regex adapted from the URI module
- my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
- or Carp::croak(qq/Cannot parse URL: '$url'/);
-
- $scheme = lc $scheme;
- $path_query = "/$path_query" unless $path_query =~ m<\A/>;
-
- my $host = (length($authority)) ? lc $authority : 'localhost';
- $host =~ s/\A[^@]*@//; # userinfo
- my $port = do {
- $host =~ s/:([0-9]*)\z// && length $1
- ? $1
- : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef);
- };
-
- return ($scheme, $host, $port, $path_query);
- }
-
- # Date conversions adapted from HTTP::Date
- my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
- my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
- sub _http_date {
- my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
- return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
- substr($DoW,$wday*4,3),
- $mday, substr($MoY,$mon*4,3), $year+1900,
- $hour, $min, $sec
- );
- }
-
- sub _parse_http_date {
- my ($self, $str) = @_;
- require Time::Local;
- my @tl_parts;
- if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
- @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
- }
- elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
- @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
- }
- elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
- @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
- }
- return eval {
- my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
- $t < 0 ? undef : $t;
- };
- }
-
- package
- HTTP::Tiny::Handle; # hide from PAUSE/indexers
- use strict;
- use warnings;
-
- use Carp qw[croak];
- use Errno qw[EINTR EPIPE];
- use IO::Socket qw[SOCK_STREAM];
-
- sub BUFSIZE () { 32768 }
-
- my $Printable = sub {
- local $_ = shift;
- s/\r/\\r/g;
- s/\n/\\n/g;
- s/\t/\\t/g;
- s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
- $_;
- };
-
- my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
-
- sub new {
- my ($class, %args) = @_;
- return bless {
- rbuf => '',
- timeout => 60,
- max_line_size => 16384,
- max_header_lines => 64,
- %args
- }, $class;
- }
-
- my $ssl_verify_args = {
- check_cn => "when_only",
- wildcards_in_alt => "anywhere",
- wildcards_in_cn => "anywhere"
- };
-
- sub connect {
- @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
- my ($self, $scheme, $host, $port) = @_;
-
- if ( $scheme eq 'https' ) {
- eval "require IO::Socket::SSL"
- unless exists $INC{'IO/Socket/SSL.pm'};
- croak(qq/IO::Socket::SSL must be installed for https support\n/)
- unless $INC{'IO/Socket/SSL.pm'};
- }
- elsif ( $scheme ne 'http' ) {
- croak(qq/Unsupported URL scheme '$scheme'/);
- }
-
- $self->{fh} = 'IO::Socket::INET'->new(
- PeerHost => $host,
- PeerPort => $port,
- Proto => 'tcp',
- Type => SOCK_STREAM,
- Timeout => $self->{timeout}
- ) or croak(qq/Could not connect to '$host:$port': $@/);
-
- binmode($self->{fh})
- or croak(qq/Could not binmode() socket: '$!'/);
-
- if ( $scheme eq 'https') {
- IO::Socket::SSL->start_SSL($self->{fh});
- ref($self->{fh}) eq 'IO::Socket::SSL'
- or die(qq/SSL connection failed for $host\n/);
- $self->{fh}->verify_hostname( $host, $ssl_verify_args )
- or die(qq/SSL certificate not valid for $host\n/);
- }
-
- $self->{host} = $host;
- $self->{port} = $port;
-
- return $self;
- }
-
- sub close {
- @_ == 1 || croak(q/Usage: $handle->close()/);
- my ($self) = @_;
- CORE::close($self->{fh})
- or croak(qq/Could not close socket: '$!'/);
- }
-
- sub write {
- @_ == 2 || croak(q/Usage: $handle->write(buf)/);
- my ($self, $buf) = @_;
-
- if ( $] ge '5.008' ) {
- utf8::downgrade($buf, 1)
- or croak(q/Wide character in write()/);
- }
-
- my $len = length $buf;
- my $off = 0;
-
- local $SIG{PIPE} = 'IGNORE';
-
- while () {
- $self->can_write
- or croak(q/Timed out while waiting for socket to become ready for writing/);
- my $r = syswrite($self->{fh}, $buf, $len, $off);
- if (defined $r) {
- $len -= $r;
- $off += $r;
- last unless $len > 0;
- }
- elsif ($! == EPIPE) {
- croak(qq/Socket closed by remote server: $!/);
- }
- elsif ($! != EINTR) {
- croak(qq/Could not write to socket: '$!'/);
- }
- }
- return $off;
- }
-
- sub read {
- @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len [, allow_partial])/);
- my ($self, $len, $allow_partial) = @_;
-
- my $buf = '';
- my $got = length $self->{rbuf};
-
- if ($got) {
- my $take = ($got < $len) ? $got : $len;
- $buf = substr($self->{rbuf}, 0, $take, '');
- $len -= $take;
- }
-
- while ($len > 0) {
- $self->can_read
- or croak(q/Timed out while waiting for socket to become ready for reading/);
- my $r = sysread($self->{fh}, $buf, $len, length $buf);
- if (defined $r) {
- last unless $r;
- $len -= $r;
- }
- elsif ($! != EINTR) {
- croak(qq/Could not read from socket: '$!'/);
- }
- }
- if ($len && !$allow_partial) {
- croak(q/Unexpected end of stream/);
- }
- return $buf;
- }
-
- sub readline {
- @_ == 1 || croak(q/Usage: $handle->readline()/);
- my ($self) = @_;
-
- while () {
- if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
- return $1;
- }
- if (length $self->{rbuf} >= $self->{max_line_size}) {
- croak(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}/);
- }
- $self->can_read
- or croak(q/Timed out while waiting for socket to become ready for reading/);
- my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
- if (defined $r) {
- last unless $r;
- }
- elsif ($! != EINTR) {
- croak(qq/Could not read from socket: '$!'/);
- }
- }
- croak(q/Unexpected end of stream while looking for line/);
- }
-
- sub read_header_lines {
- @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
- my ($self, $headers) = @_;
- $headers ||= {};
- my $lines = 0;
- my $val;
-
- while () {
- my $line = $self->readline;
-
- if (++$lines >= $self->{max_header_lines}) {
- croak(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}/);
- }
- elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
- my ($field_name) = lc $1;
- if (exists $headers->{$field_name}) {
- for ($headers->{$field_name}) {
- $_ = [$_] unless ref $_ eq "ARRAY";
- push @$_, $2;
- $val = \$_->[-1];
- }
- }
- else {
- $val = \($headers->{$field_name} = $2);
- }
- }
- elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
- $val
- or croak(q/Unexpected header continuation line/);
- next unless length $1;
- $$val .= ' ' if length $$val;
- $$val .= $1;
- }
- elsif ($line =~ /\A \x0D?\x0A \z/x) {
- last;
- }
- else {
- croak(q/Malformed header line: / . $Printable->($line));
- }
- }
- return $headers;
- }
-
- sub write_request {
- @_ == 2 || croak(q/Usage: $handle->write_request(request)/);
- my($self, $request) = @_;
- $self->write_request_header(@{$request}{qw/method uri headers/});
- $self->write_body($request) if $request->{cb};
- return;
- }
-
- my %HeaderCase = (
- 'content-md5' => 'Content-MD5',
- 'etag' => 'ETag',
- 'te' => 'TE',
- 'www-authenticate' => 'WWW-Authenticate',
- 'x-xss-protection' => 'X-XSS-Protection',
- );
-
- sub write_header_lines {
- (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
- my($self, $headers) = @_;
-
- my $buf = '';
- while (my ($k, $v) = each %$headers) {
- my $field_name = lc $k;
- if (exists $HeaderCase{$field_name}) {
- $field_name = $HeaderCase{$field_name};
- }
- else {
- $field_name =~ /\A $Token+ \z/xo
- or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
- $field_name =~ s/\b(\w)/\u$1/g;
- $HeaderCase{lc $field_name} = $field_name;
- }
- for (ref $v eq 'ARRAY' ? @$v : $v) {
- /[^\x0D\x0A]/
- or croak(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_));
- $buf .= "$field_name: $_\x0D\x0A";
- }
- }
- $buf .= "\x0D\x0A";
- return $self->write($buf);
- }
-
- sub read_body {
- @_ == 3 || croak(q/Usage: $handle->read_body(callback, response)/);
- my ($self, $cb, $response) = @_;
- my $te = $response->{headers}{'transfer-encoding'} || '';
- if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
- $self->read_chunked_body($cb, $response);
- }
- else {
- $self->read_content_body($cb, $response);
- }
- return;
- }
-
- sub write_body {
- @_ == 2 || croak(q/Usage: $handle->write_body(request)/);
- my ($self, $request) = @_;
- if ($request->{headers}{'content-length'}) {
- return $self->write_content_body($request);
- }
- else {
- return $self->write_chunked_body($request);
- }
- }
-
- sub read_content_body {
- @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
- my ($self, $cb, $response, $content_length) = @_;
- $content_length ||= $response->{headers}{'content-length'};
-
- if ( $content_length ) {
- my $len = $content_length;
- while ($len > 0) {
- my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
- $cb->($self->read($read, 0), $response);
- $len -= $read;
- }
- }
- else {
- my $chunk;
- $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
- }
-
- return;
- }
-
- sub write_content_body {
- @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
- my ($self, $request) = @_;
-
- my ($len, $content_length) = (0, $request->{headers}{'content-length'});
- while () {
- my $data = $request->{cb}->();
-
- defined $data && length $data
- or last;
-
- if ( $] ge '5.008' ) {
- utf8::downgrade($data, 1)
- or croak(q/Wide character in write_content()/);
- }
-
- $len += $self->write($data);
- }
-
- $len == $content_length
- or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
-
- return $len;
- }
-
- sub read_chunked_body {
- @_ == 3 || croak(q/Usage: $handle->read_chunked_body(callback, $response)/);
- my ($self, $cb, $response) = @_;
-
- while () {
- my $head = $self->readline;
-
- $head =~ /\A ([A-Fa-f0-9]+)/x
- or croak(q/Malformed chunk head: / . $Printable->($head));
-
- my $len = hex($1)
- or last;
-
- $self->read_content_body($cb, $response, $len);
-
- $self->read(2) eq "\x0D\x0A"
- or croak(q/Malformed chunk: missing CRLF after chunk data/);
- }
- $self->read_header_lines($response->{headers});
- return;
- }
-
- sub write_chunked_body {
- @_ == 2 || croak(q/Usage: $handle->write_chunked_body(request)/);
- my ($self, $request) = @_;
-
- my $len = 0;
- while () {
- my $data = $request->{cb}->();
-
- defined $data && length $data
- or last;
-
- if ( $] ge '5.008' ) {
- utf8::downgrade($data, 1)
- or croak(q/Wide character in write_chunked_body()/);
- }
-
- $len += length $data;
-
- my $chunk = sprintf '%X', length $data;
- $chunk .= "\x0D\x0A";
- $chunk .= $data;
- $chunk .= "\x0D\x0A";
-
- $self->write($chunk);
- }
- $self->write("0\x0D\x0A");
- $self->write_header_lines($request->{trailer_cb}->())
- if ref $request->{trailer_cb} eq 'CODE';
- return $len;
- }
-
- sub read_response_header {
- @_ == 1 || croak(q/Usage: $handle->read_response_header()/);
- my ($self) = @_;
-
- my $line = $self->readline;
-
- $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
- or croak(q/Malformed Status-Line: / . $Printable->($line));
-
- my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
-
- croak (qq/Unsupported HTTP protocol: $protocol/)
- unless $version =~ /0*1\.0*[01]/;
-
- return {
- status => $status,
- reason => $reason,
- headers => $self->read_header_lines,
- protocol => $protocol,
- };
- }
-
- sub write_request_header {
- @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
- my ($self, $method, $request_uri, $headers) = @_;
-
- return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
- + $self->write_header_lines($headers);
- }
-
- sub _do_timeout {
- my ($self, $type, $timeout) = @_;
- $timeout = $self->{timeout}
- unless defined $timeout && $timeout >= 0;
-
- my $fd = fileno $self->{fh};
- defined $fd && $fd >= 0
- or croak(q/select(2): 'Bad file descriptor'/);
-
- my $initial = time;
- my $pending = $timeout;
- my $nfound;
-
- vec(my $fdset = '', $fd, 1) = 1;
-
- while () {
- $nfound = ($type eq 'read')
- ? select($fdset, undef, undef, $pending)
- : select(undef, $fdset, undef, $pending) ;
- if ($nfound == -1) {
- $! == EINTR
- or croak(qq/select(2): '$!'/);
- redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
- $nfound = 0;
- }
- last;
- }
- $! = 0;
- return $nfound;
- }
-
- sub can_read {
- @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
- my $self = shift;
- return $self->_do_timeout('read', @_)
- }
-
- sub can_write {
- @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
- my $self = shift;
- return $self->_do_timeout('write', @_)
- }
-
- 1;
-
-
-
- __END__
- =pod
-
-HTTP_TINY
-
-$fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
- # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
- # vim:ts=8:sw=2:et:sta:sts=2
- package Module::Metadata;
-
- # Adapted from Perl-licensed code originally distributed with
- # Module-Build by Ken Williams
-
- # This module provides routines to gather information about
- # perl modules (assuming this may be expanded in the distant
- # parrot future to look at other types of modules).
-
- use strict;
- use vars qw($VERSION);
- $VERSION = '1.000003';
- $VERSION = eval $VERSION;
-
- use File::Spec;
- use IO::File;
- use version 0.87;
- BEGIN {
- if ($INC{'Log/Contextual.pm'}) {
- Log::Contextual->import('log_info');
- } else {
- *log_info = sub (&) { warn $_[0]->() };
- }
- }
- use File::Find qw(find);
-
- my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal
-
- my $PKG_REGEXP = qr{ # match a package declaration
- ^[\s\{;]* # intro chars on a line
- package # the word 'package'
- \s+ # whitespace
- ([\w:]+) # a package name
- \s* # optional whitespace
- ($V_NUM_REGEXP)? # optional version number
- \s* # optional whitesapce
- ; # semicolon line terminator
- }x;
-
- my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
- ([\$*]) # sigil - $ or *
- (
- ( # optional leading package name
- (?:::|\')? # possibly starting like just :: (Ì la $::VERSION)
- (?:\w+(?:::|\'))* # Foo::Bar:: ...
- )?
- VERSION
- )\b
- }x;
-
- my $VERS_REGEXP = qr{ # match a VERSION definition
- (?:
- \(\s*$VARNAME_REGEXP\s*\) # with parens
- |
- $VARNAME_REGEXP # without parens
- )
- \s*
- =[^=~] # = but not ==, nor =~
- }x;
-
-
- sub new_from_file {
- my $class = shift;
- my $filename = File::Spec->rel2abs( shift );
-
- return undef unless defined( $filename ) && -f $filename;
- return $class->_init(undef, $filename, @_);
- }
-
- sub new_from_module {
- my $class = shift;
- my $module = shift;
- my %props = @_;
-
- $props{inc} ||= \@INC;
- my $filename = $class->find_module_by_name( $module, $props{inc} );
- return undef unless defined( $filename ) && -f $filename;
- return $class->_init($module, $filename, %props);
- }
-
- {
-
- my $compare_versions = sub {
- my ($v1, $op, $v2) = @_;
- $v1 = version->new($v1)
- unless UNIVERSAL::isa($v1,'version');
-
- my $eval_str = "\$v1 $op \$v2";
- my $result = eval $eval_str;
- log_info { "error comparing versions: '$eval_str' $@" } if $@;
-
- return $result;
- };
-
- my $normalize_version = sub {
- my ($version) = @_;
- if ( $version =~ /[=<>!,]/ ) { # logic, not just version
- # take as is without modification
- }
- elsif ( ref $version eq 'version' ) { # version objects
- $version = $version->is_qv ? $version->normal : $version->stringify;
- }
- elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
- # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
- $version = "v$version";
- }
- else {
- # leave alone
- }
- return $version;
- };
-
- # separate out some of the conflict resolution logic
-
- my $resolve_module_versions = sub {
- my $packages = shift;
-
- my( $file, $version );
- my $err = '';
- foreach my $p ( @$packages ) {
- if ( defined( $p->{version} ) ) {
- if ( defined( $version ) ) {
- if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
- $err .= " $p->{file} ($p->{version})\n";
- } else {
- # same version declared multiple times, ignore
- }
- } else {
- $file = $p->{file};
- $version = $p->{version};
- }
- }
- $file ||= $p->{file} if defined( $p->{file} );
- }
-
- if ( $err ) {
- $err = " $file ($version)\n" . $err;
- }
-
- my %result = (
- file => $file,
- version => $version,
- err => $err
- );
-
- return \%result;
- };
-
- sub package_versions_from_directory {
- my ( $class, $dir, $files ) = @_;
-
- my @files;
-
- if ( $files ) {
- @files = @$files;
- } else {
- find( {
- wanted => sub {
- push @files, $_ if -f $_ && /\.pm$/;
- },
- no_chdir => 1,
- }, $dir );
- }
-
- # First, we enumerate all packages & versions,
- # separating into primary & alternative candidates
- my( %prime, %alt );
- foreach my $file (@files) {
- my $mapped_filename = File::Spec->abs2rel( $file, $dir );
- my @path = split( /\//, $mapped_filename );
- (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
-
- my $pm_info = $class->new_from_file( $file );
-
- foreach my $package ( $pm_info->packages_inside ) {
- next if $package eq 'main'; # main can appear numerous times, ignore
- next if $package eq 'DB'; # special debugging package, ignore
- next if grep /^_/, split( /::/, $package ); # private package, ignore
-
- my $version = $pm_info->version( $package );
-
- if ( $package eq $prime_package ) {
- if ( exists( $prime{$package} ) ) {
- # M::B::ModuleInfo will handle this conflict
- die "Unexpected conflict in '$package'; multiple versions found.\n";
- } else {
- $prime{$package}{file} = $mapped_filename;
- $prime{$package}{version} = $version if defined( $version );
- }
- } else {
- push( @{$alt{$package}}, {
- file => $mapped_filename,
- version => $version,
- } );
- }
- }
- }
-
- # Then we iterate over all the packages found above, identifying conflicts
- # and selecting the "best" candidate for recording the file & version
- # for each package.
- foreach my $package ( keys( %alt ) ) {
- my $result = $resolve_module_versions->( $alt{$package} );
-
- if ( exists( $prime{$package} ) ) { # primary package selected
-
- if ( $result->{err} ) {
- # Use the selected primary package, but there are conflicting
- # errors among multiple alternative packages that need to be
- # reported
- log_info {
- "Found conflicting versions for package '$package'\n" .
- " $prime{$package}{file} ($prime{$package}{version})\n" .
- $result->{err}
- };
-
- } elsif ( defined( $result->{version} ) ) {
- # There is a primary package selected, and exactly one
- # alternative package
-
- if ( exists( $prime{$package}{version} ) &&
- defined( $prime{$package}{version} ) ) {
- # Unless the version of the primary package agrees with the
- # version of the alternative package, report a conflict
- if ( $compare_versions->(
- $prime{$package}{version}, '!=', $result->{version}
- )
- ) {
-
- log_info {
- "Found conflicting versions for package '$package'\n" .
- " $prime{$package}{file} ($prime{$package}{version})\n" .
- " $result->{file} ($result->{version})\n"
- };
- }
-
- } else {
- # The prime package selected has no version so, we choose to
- # use any alternative package that does have a version
- $prime{$package}{file} = $result->{file};
- $prime{$package}{version} = $result->{version};
- }
-
- } else {
- # no alt package found with a version, but we have a prime
- # package so we use it whether it has a version or not
- }
-
- } else { # No primary package was selected, use the best alternative
-
- if ( $result->{err} ) {
- log_info {
- "Found conflicting versions for package '$package'\n" .
- $result->{err}
- };
- }
-
- # Despite possible conflicting versions, we choose to record
- # something rather than nothing
- $prime{$package}{file} = $result->{file};
- $prime{$package}{version} = $result->{version}
- if defined( $result->{version} );
- }
- }
-
- # Normalize versions. Can't use exists() here because of bug in YAML::Node.
- # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
- for (grep defined $_->{version}, values %prime) {
- $_->{version} = $normalize_version->( $_->{version} );
- }
-
- return \%prime;
- }
- }
-
-
- sub _init {
- my $class = shift;
- my $module = shift;
- my $filename = shift;
- my %props = @_;
-
- my( %valid_props, @valid_props );
- @valid_props = qw( collect_pod inc );
- @valid_props{@valid_props} = delete( @props{@valid_props} );
- warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
-
- my %data = (
- module => $module,
- filename => $filename,
- version => undef,
- packages => [],
- versions => {},
- pod => {},
- pod_headings => [],
- collect_pod => 0,
-
- %valid_props,
- );
-
- my $self = bless(\%data, $class);
-
- $self->_parse_file();
-
- unless($self->{module} and length($self->{module})) {
- my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
- if($f =~ /\.pm$/) {
- $f =~ s/\..+$//;
- my @candidates = grep /$f$/, @{$self->{packages}};
- $self->{module} = shift(@candidates); # punt
- }
- else {
- if(grep /main/, @{$self->{packages}}) {
- $self->{module} = 'main';
- }
- else {
- $self->{module} = $self->{packages}[0] || '';
- }
- }
- }
-
- $self->{version} = $self->{versions}{$self->{module}}
- if defined( $self->{module} );
-
- return $self;
- }
-
- # class method
- sub _do_find_module {
- my $class = shift;
- my $module = shift || die 'find_module_by_name() requires a package name';
- my $dirs = shift || \@INC;
-
- my $file = File::Spec->catfile(split( /::/, $module));
- foreach my $dir ( @$dirs ) {
- my $testfile = File::Spec->catfile($dir, $file);
- return [ File::Spec->rel2abs( $testfile ), $dir ]
- if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
- return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
- if -e "$testfile.pm";
- }
- return;
- }
-
- # class method
- sub find_module_by_name {
- my $found = shift()->_do_find_module(@_) or return;
- return $found->[0];
- }
-
- # class method
- sub find_module_dir_by_name {
- my $found = shift()->_do_find_module(@_) or return;
- return $found->[1];
- }
-
-
- # given a line of perl code, attempt to parse it if it looks like a
- # $VERSION assignment, returning sigil, full name, & package name
- sub _parse_version_expression {
- my $self = shift;
- my $line = shift;
-
- my( $sig, $var, $pkg );
- if ( $line =~ $VERS_REGEXP ) {
- ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
- if ( $pkg ) {
- $pkg = ($pkg eq '::') ? 'main' : $pkg;
- $pkg =~ s/::$//;
- }
- }
-
- return ( $sig, $var, $pkg );
- }
-
- sub _parse_file {
- my $self = shift;
-
- my $filename = $self->{filename};
- my $fh = IO::File->new( $filename )
- or die( "Can't open '$filename': $!" );
-
- $self->_parse_fh($fh);
- }
-
- sub _parse_fh {
- my ($self, $fh) = @_;
-
- my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
- my( @pkgs, %vers, %pod, @pod );
- my $pkg = 'main';
- my $pod_sect = '';
- my $pod_data = '';
-
- while (defined( my $line = <$fh> )) {
- my $line_num = $.;
-
- chomp( $line );
- next if $line =~ /^\s*#/;
-
- $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
-
- # Would be nice if we could also check $in_string or something too
- last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
-
- if ( $in_pod || $line =~ /^=cut/ ) {
-
- if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
- push( @pod, $1 );
- if ( $self->{collect_pod} && length( $pod_data ) ) {
- $pod{$pod_sect} = $pod_data;
- $pod_data = '';
- }
- $pod_sect = $1;
-
-
- } elsif ( $self->{collect_pod} ) {
- $pod_data .= "$line\n";
-
- }
-
- } else {
-
- $pod_sect = '';
- $pod_data = '';
-
- # parse $line to see if it's a $VERSION declaration
- my( $vers_sig, $vers_fullname, $vers_pkg ) =
- $self->_parse_version_expression( $line );
-
- if ( $line =~ $PKG_REGEXP ) {
- $pkg = $1;
- push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
- $vers{$pkg} = (defined $2 ? $2 : undef) unless exists( $vers{$pkg} );
- $need_vers = defined $2 ? 0 : 1;
-
- # VERSION defined with full package spec, i.e. $Module::VERSION
- } elsif ( $vers_fullname && $vers_pkg ) {
- push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
- $need_vers = 0 if $vers_pkg eq $pkg;
-
- unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
- $vers{$vers_pkg} =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
- } else {
- # Warn unless the user is using the "$VERSION = eval
- # $VERSION" idiom (though there are probably other idioms
- # that we should watch out for...)
- warn <<"EOM" unless $line =~ /=\s*eval/;
- Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
- ignoring subsequent declaration on line $line_num.
- EOM
- }
-
- # first non-comment line in undeclared package main is VERSION
- } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
- $need_vers = 0;
- my $v =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
- $vers{$pkg} = $v;
- push( @pkgs, 'main' );
-
- # first non-comment line in undeclared package defines package main
- } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
- $need_vers = 1;
- $vers{main} = '';
- push( @pkgs, 'main' );
-
- # only keep if this is the first $VERSION seen
- } elsif ( $vers_fullname && $need_vers ) {
- $need_vers = 0;
- my $v =
- $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
-
-
- unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
- $vers{$pkg} = $v;
- } else {
- warn <<"EOM";
- Package '$pkg' already declared with version '$vers{$pkg}'
- ignoring new version '$v' on line $line_num.
- EOM
- }
-
- }
-
- }
-
- }
-
- if ( $self->{collect_pod} && length($pod_data) ) {
- $pod{$pod_sect} = $pod_data;
- }
-
- $self->{versions} = \%vers;
- $self->{packages} = \@pkgs;
- $self->{pod} = \%pod;
- $self->{pod_headings} = \@pod;
- }
-
- {
- my $pn = 0;
- sub _evaluate_version_line {
- my $self = shift;
- my( $sigil, $var, $line ) = @_;
-
- # Some of this code came from the ExtUtils:: hierarchy.
-
- # We compile into $vsub because 'use version' would cause
- # compiletime/runtime issues with local()
- my $vsub;
- $pn++; # everybody gets their own package
- my $eval = qq{BEGIN { q# Hide from _packages_inside()
- #; package Module::Metadata::_version::p$pn;
- use version;
- no strict;
-
- local $sigil$var;
- \$$var=undef;
- \$vsub = sub {
- $line;
- \$$var
- };
- }};
-
- local $^W;
- # Try to get the $VERSION
- eval $eval;
- # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
- # installed, so we need to hunt in ./lib for it
- if ( $@ =~ /Can't locate/ && -d 'lib' ) {
- local @INC = ('lib',@INC);
- eval $eval;
- }
- warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
- if $@;
- (ref($vsub) eq 'CODE') or
- die "failed to build version sub for $self->{filename}";
- my $result = eval { $vsub->() };
- die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
- if $@;
-
- # Upgrade it into a version object
- my $version = eval { _dwim_version($result) };
-
- die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
- unless defined $version; # "0" is OK!
-
- return $version;
- }
- }
-
- # Try to DWIM when things fail the lax version test in obvious ways
- {
- my @version_prep = (
- # Best case, it just works
- sub { return shift },
-
- # If we still don't have a version, try stripping any
- # trailing junk that is prohibited by lax rules
- sub {
- my $v = shift;
- $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
- return $v;
- },
-
- # Activestate apparently creates custom versions like '1.23_45_01', which
- # cause version.pm to think it's an invalid alpha. So check for that
- # and strip them
- sub {
- my $v = shift;
- my $num_dots = () = $v =~ m{(\.)}g;
- my $num_unders = () = $v =~ m{(_)}g;
- my $leading_v = substr($v,0,1) eq 'v';
- if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
- $v =~ s{_}{}g;
- $num_unders = () = $v =~ m{(_)}g;
- }
- return $v;
- },
-
- # Worst case, try numifying it like we would have before version objects
- sub {
- my $v = shift;
- no warnings 'numeric';
- return 0 + $v;
- },
-
- );
-
- sub _dwim_version {
- my ($result) = shift;
-
- return $result if ref($result) eq 'version';
-
- my ($version, $error);
- for my $f (@version_prep) {
- $result = $f->($result);
- $version = eval { version->new($result) };
- $error ||= $@ if $@; # capture first failure
- last if defined $version;
- }
-
- die $error unless defined $version;
-
- return $version;
- }
- }
-
- ############################################################
-
- # accessors
- sub name { $_[0]->{module} }
-
- sub filename { $_[0]->{filename} }
- sub packages_inside { @{$_[0]->{packages}} }
- sub pod_inside { @{$_[0]->{pod_headings}} }
- sub contains_pod { $#{$_[0]->{pod_headings}} }
-
- sub version {
- my $self = shift;
- my $mod = shift || $self->{module};
- my $vers;
- if ( defined( $mod ) && length( $mod ) &&
- exists( $self->{versions}{$mod} ) ) {
- return $self->{versions}{$mod};
- } else {
- return undef;
- }
- }
-
- sub pod {
- my $self = shift;
- my $sect = shift;
- if ( defined( $sect ) && length( $sect ) &&
- exists( $self->{pod}{$sect} ) ) {
- return $self->{pod}{$sect};
- } else {
- return undef;
- }
- }
-
- 1;
-
-MODULE_METADATA
-
-$fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
- package Parse::CPAN::Meta;
-
- use strict;
- use Carp 'croak';
-
- # UTF Support?
- sub HAVE_UTF8 () { $] >= 5.007003 }
- BEGIN {
- if ( HAVE_UTF8 ) {
- # The string eval helps hide this from Test::MinimumVersion
- eval "require utf8;";
- die "Failed to load UTF-8 support" if $@;
- }
-
- # Class structure
- require 5.004;
- require Exporter;
- $Parse::CPAN::Meta::VERSION = '1.40';
- @Parse::CPAN::Meta::ISA = qw{ Exporter };
- @Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
- }
-
- # Prototypes
- sub LoadFile ($);
- sub Load ($);
- sub _scalar ($$$);
- sub _array ($$$);
- sub _hash ($$$);
-
- # Printable characters for escapes
- my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
- n => "\x0a", v => "\x0b", f => "\x0c",
- r => "\x0d", e => "\x1b", '\\' => '\\',
- );
-
-
-
-
-
- #####################################################################
- # Implementation
-
- # Create an object from a file
- sub LoadFile ($) {
- # Check the file
- my $file = shift;
- croak('You did not specify a file name') unless $file;
- croak( "File '$file' does not exist" ) unless -e $file;
- croak( "'$file' is a directory, not a file" ) unless -f _;
- croak( "Insufficient permissions to read '$file'" ) unless -r _;
-
- # Slurp in the file
- local $/ = undef;
- local *CFG;
- unless ( open( CFG, $file ) ) {
- croak("Failed to open file '$file': $!");
- }
- my $yaml = <CFG>;
- unless ( close(CFG) ) {
- croak("Failed to close file '$file': $!");
- }
-
- # Hand off to the actual parser
- Load( $yaml );
- }
-
- # Parse a document from a string.
- # Doing checks on $_[0] prevents us having to do a string copy.
- sub Load ($) {
- my $string = $_[0];
- unless ( defined $string ) {
- croak("Did not provide a string to load");
- }
-
- # Byte order marks
- if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
- croak("Stream has a non UTF-8 Unicode Byte Order Mark");
- } else {
- # Strip UTF-8 bom if found, we'll just ignore it
- $string =~ s/^\357\273\277//;
- }
-
- # Try to decode as utf8
- utf8::decode($string) if HAVE_UTF8;
-
- # Check for some special cases
- return () unless length $string;
- unless ( $string =~ /[\012\015]+\z/ ) {
- croak("Stream does not end with newline character");
- }
-
- # Split the file into lines
- my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
- split /(?:\015{1,2}\012|\015|\012)/, $string;
-
- # Strip the initial YAML header
- @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
-
- # A nibbling parser
- my @documents = ();
- while ( @lines ) {
- # Do we have a document header?
- if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
- # Handle scalar documents
- shift @lines;
- if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
- push @documents, _scalar( "$1", [ undef ], \@lines );
- next;
- }
- }
-
- if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
- # A naked document
- push @documents, undef;
- while ( @lines and $lines[0] !~ /^---/ ) {
- shift @lines;
- }
-
- } elsif ( $lines[0] =~ /^\s*\-/ ) {
- # An array at the root
- my $document = [ ];
- push @documents, $document;
- _array( $document, [ 0 ], \@lines );
-
- } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
- # A hash at the root
- my $document = { };
- push @documents, $document;
- _hash( $document, [ length($1) ], \@lines );
-
- } else {
- croak("Parse::CPAN::Meta failed to classify line '$lines[0]'");
- }
- }
-
- if ( wantarray ) {
- return @documents;
- } else {
- return $documents[-1];
- }
- }
-
- # Deparse a scalar string to the actual scalar
- sub _scalar ($$$) {
- my ($string, $indent, $lines) = @_;
-
- # Trim trailing whitespace
- $string =~ s/\s*\z//;
-
- # Explitic null/undef
- return undef if $string eq '~';
-
- # Quotes
- if ( $string =~ /^\'(.*?)\'\z/ ) {
- return '' unless defined $1;
- $string = $1;
- $string =~ s/\'\'/\'/g;
- return $string;
- }
- if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
- # Reusing the variable is a little ugly,
- # but avoids a new variable and a string copy.
- $string = $1;
- $string =~ s/\\"/"/g;
- $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
- return $string;
- }
-
- # Special cases
- if ( $string =~ /^[\'\"!&]/ ) {
- croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
- }
- return {} if $string eq '{}';
- return [] if $string eq '[]';
-
- # Regular unquoted string
- return $string unless $string =~ /^[>|]/;
-
- # Error
- croak("Parse::CPAN::Meta failed to find multi-line scalar content") unless @$lines;
-
- # Check the indent depth
- $lines->[0] =~ /^(\s*)/;
- $indent->[-1] = length("$1");
- if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- # Pull the lines
- my @multiline = ();
- while ( @$lines ) {
- $lines->[0] =~ /^(\s*)/;
- last unless length($1) >= $indent->[-1];
- push @multiline, substr(shift(@$lines), length($1));
- }
-
- my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
- my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
- return join( $j, @multiline ) . $t;
- }
-
- # Parse an array
- sub _array ($$$) {
- my ($array, $indent, $lines) = @_;
-
- while ( @$lines ) {
- # Check for a new document
- if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
- while ( @$lines and $lines->[0] !~ /^---/ ) {
- shift @$lines;
- }
- return 1;
- }
-
- # Check the indent level
- $lines->[0] =~ /^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
- # Inline nested hash
- my $indent2 = length("$1");
- $lines->[0] =~ s/-/ /;
- push @$array, { };
- _hash( $array->[-1], [ @$indent, $indent2 ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
- # Array entry with a value
- shift @$lines;
- push @$array, _scalar( "$2", [ @$indent, undef ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
- shift @$lines;
- unless ( @$lines ) {
- push @$array, undef;
- return 1;
- }
- if ( $lines->[0] =~ /^(\s*)\-/ ) {
- my $indent2 = length("$1");
- if ( $indent->[-1] == $indent2 ) {
- # Null array entry
- push @$array, undef;
- } else {
- # Naked indenter
- push @$array, [ ];
- _array( $array->[-1], [ @$indent, $indent2 ], $lines );
- }
-
- } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
- push @$array, { };
- _hash( $array->[-1], [ @$indent, length("$1") ], $lines );
-
- } else {
- croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
- }
-
- } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
- # This is probably a structure like the following...
- # ---
- # foo:
- # - list
- # bar: value
- #
- # ... so lets return and let the hash parser handle it
- return 1;
-
- } else {
- croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
- }
- }
-
- return 1;
- }
-
- # Parse an array
- sub _hash ($$$) {
- my ($hash, $indent, $lines) = @_;
-
- while ( @$lines ) {
- # Check for a new document
- if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
- while ( @$lines and $lines->[0] !~ /^---/ ) {
- shift @$lines;
- }
- return 1;
- }
-
- # Check the indent level
- $lines->[0] =~ /^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- # Get the key
- unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
- if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
- croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
- }
- croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
- }
- my $key = $1;
-
- # Do we have a value?
- if ( length $lines->[0] ) {
- # Yes
- $hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );
- } else {
- # An indent
- shift @$lines;
- unless ( @$lines ) {
- $hash->{$key} = undef;
- return 1;
- }
- if ( $lines->[0] =~ /^(\s*)-/ ) {
- $hash->{$key} = [];
- _array( $hash->{$key}, [ @$indent, length($1) ], $lines );
- } elsif ( $lines->[0] =~ /^(\s*)./ ) {
- my $indent2 = length("$1");
- if ( $indent->[-1] >= $indent2 ) {
- # Null hash entry
- $hash->{$key} = undef;
- } else {
- $hash->{$key} = {};
- _hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
- }
- }
- }
- }
-
- return 1;
- }
-
- 1;
-
- __END__
-
-PARSE_CPAN_META
-
-$fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
- package lib::core::only;
-
- use strict;
- use warnings FATAL => 'all';
- use Config;
-
- sub import {
- @INC = @Config{qw(privlibexp archlibexp)};
- return
- }
-
- 1;
-LIB_CORE_ONLY
-
-$fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
- use strict;
- use warnings;
-
- package local::lib;
-
- use 5.008001; # probably works with earlier versions but I'm not supporting them
- # (patches would, of course, be welcome)
-
- use File::Spec ();
- use File::Path ();
- use Carp ();
- use Config;
-
- our $VERSION = '1.008001'; # 1.8.1
-
- our @KNOWN_FLAGS = qw(--self-contained);
-
- sub import {
- my ($class, @args) = @_;
-
- # Remember what PERL5LIB was when we started
- my $perl5lib = $ENV{PERL5LIB} || '';
-
- my %arg_store;
- for my $arg (@args) {
- # check for lethal dash first to stop processing before causing problems
- if ($arg =~ /−/) {
- die <<'DEATH';
- WHOA THERE! It looks like you've got some fancy dashes in your commandline!
- These are *not* the traditional -- dashes that software recognizes. You
- probably got these by copy-pasting from the perldoc for this module as
- rendered by a UTF8-capable formatter. This most typically happens on an OS X
- terminal, but can happen elsewhere too. Please try again after replacing the
- dashes with normal minus signs.
- DEATH
- }
- elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
- (my $flag = $arg) =~ s/--//;
- $arg_store{$flag} = 1;
- }
- elsif($arg =~ /^--/) {
- die "Unknown import argument: $arg";
- }
- else {
- # assume that what's left is a path
- $arg_store{path} = $arg;
- }
- }
-
- if($arg_store{'self-contained'}) {
- die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n";
- }
-
- $arg_store{path} = $class->resolve_path($arg_store{path});
- $class->setup_local_lib_for($arg_store{path});
-
- for (@INC) { # Untaint @INC
- next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
- m/(.*)/ and $_ = $1;
- }
- }
-
- sub pipeline;
-
- sub pipeline {
- my @methods = @_;
- my $last = pop(@methods);
- if (@methods) {
- \sub {
- my ($obj, @args) = @_;
- $obj->${pipeline @methods}(
- $obj->$last(@args)
- );
- };
- } else {
- \sub {
- shift->$last(@_);
- };
- }
- }
-
- sub _uniq {
- my %seen;
- grep { ! $seen{$_}++ } @_;
- }
-
- sub resolve_path {
- my ($class, $path) = @_;
- $class->${pipeline qw(
- resolve_relative_path
- resolve_home_path
- resolve_empty_path
- )}($path);
- }
-
- sub resolve_empty_path {
- my ($class, $path) = @_;
- if (defined $path) {
- $path;
- } else {
- '~/perl5';
- }
- }
-
- sub resolve_home_path {
- my ($class, $path) = @_;
- return $path unless ($path =~ /^~/);
- my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
- my $tried_file_homedir;
- my $homedir = do {
- if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
- $tried_file_homedir = 1;
- if (defined $user) {
- File::HomeDir->users_home($user);
- } else {
- File::HomeDir->my_home;
- }
- } else {
- if (defined $user) {
- (getpwnam $user)[7];
- } else {
- if (defined $ENV{HOME}) {
- $ENV{HOME};
- } else {
- (getpwuid $<)[7];
- }
- }
- }
- };
- unless (defined $homedir) {
- Carp::croak(
- "Couldn't resolve homedir for "
- .(defined $user ? $user : 'current user')
- .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
- );
- }
- $path =~ s/^~[^\/]*/$homedir/;
- $path;
- }
-
- sub resolve_relative_path {
- my ($class, $path) = @_;
- $path = File::Spec->rel2abs($path);
- }
-
- sub setup_local_lib_for {
- my ($class, $path) = @_;
- $path = $class->ensure_dir_structure_for($path);
- if ($0 eq '-') {
- $class->print_environment_vars_for($path);
- exit 0;
- } else {
- $class->setup_env_hash_for($path);
- @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC);
- }
- }
-
- sub install_base_bin_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'bin');
- }
-
- sub install_base_perl_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'lib', 'perl5');
- }
-
- sub install_base_arch_path {
- my ($class, $path) = @_;
- File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
- }
-
- sub ensure_dir_structure_for {
- my ($class, $path) = @_;
- unless (-d $path) {
- warn "Attempting to create directory ${path}\n";
- }
- File::Path::mkpath($path);
- # Need to have the path exist to make a short name for it, so
- # converting to a short name here.
- $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
-
- return $path;
- }
-
- sub INTERPOLATE_ENV () { 1 }
- sub LITERAL_ENV () { 0 }
-
- sub guess_shelltype {
- my $shellbin = 'sh';
- if(defined $ENV{'SHELL'}) {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
- $shellbin = $shell_bin_path_parts[-1];
- }
- my $shelltype = do {
- local $_ = $shellbin;
- if(/csh/) {
- 'csh'
- } else {
- 'bourne'
- }
- };
-
- # Both Win32 and Cygwin have $ENV{COMSPEC} set.
- if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
- $shellbin = $shell_bin_path_parts[-1];
- $shelltype = do {
- local $_ = $shellbin;
- if(/command\.com/) {
- 'win32'
- } elsif(/cmd\.exe/) {
- 'win32'
- } elsif(/4nt\.exe/) {
- 'win32'
- } else {
- $shelltype
- }
- };
- }
- return $shelltype;
- }
-
- sub print_environment_vars_for {
- my ($class, $path) = @_;
- print $class->environment_vars_string_for($path);
- }
-
- sub environment_vars_string_for {
- my ($class, $path) = @_;
- my @envs = $class->build_environment_vars_for($path, LITERAL_ENV);
- my $out = '';
-
- # rather basic csh detection, goes on the assumption that something won't
- # call itself csh unless it really is. also, default to bourne in the
- # pathological situation where a user doesn't have $ENV{SHELL} defined.
- # note also that shells with funny names, like zoid, are assumed to be
- # bourne.
-
- my $shelltype = $class->guess_shelltype;
-
- while (@envs) {
- my ($name, $value) = (shift(@envs), shift(@envs));
- $value =~ s/(\\")/\\$1/g;
- $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
- }
- return $out;
- }
-
- # simple routines that take two arguments: an %ENV key and a value. return
- # strings that are suitable for passing directly to the relevant shell to set
- # said key to said value.
- sub build_bourne_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return qq{export ${name}="${value}"\n};
- }
-
- sub build_csh_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return qq{setenv ${name} "${value}"\n};
- }
-
- sub build_win32_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return qq{set ${name}=${value}\n};
- }
-
- sub setup_env_hash_for {
- my ($class, $path) = @_;
- my %envs = $class->build_environment_vars_for($path, INTERPOLATE_ENV);
- @ENV{keys %envs} = values %envs;
- }
-
- sub build_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
- return (
- PERL_LOCAL_LIB_ROOT => $path,
- PERL_MB_OPT => "--install_base ${path}",
- PERL_MM_OPT => "INSTALL_BASE=${path}",
- PERL5LIB => join($Config{path_sep},
- $class->install_base_arch_path($path),
- $class->install_base_perl_path($path),
- (($ENV{PERL5LIB}||()) ?
- ($interpolate == INTERPOLATE_ENV
- ? ($ENV{PERL5LIB})
- : (($^O ne 'MSWin32') ? '$PERL5LIB' : '%PERL5LIB%' ))
- : ())
- ),
- PATH => join($Config{path_sep},
- $class->install_base_bin_path($path),
- ($interpolate == INTERPOLATE_ENV
- ? ($ENV{PATH}||())
- : (($^O ne 'MSWin32') ? '$PATH' : '%PATH%' ))
- ),
- )
- }
-
- 1;
-LOCAL_LIB
-
-$fatpacked{"version.pm"} = <<'VERSION';
- #!perl -w
- package version;
-
- use 5.005_04;
- use strict;
-
- use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
-
- $VERSION = 0.88;
-
- $CLASS = 'version';
-
- #--------------------------------------------------------------------------#
- # Version regexp components
- #--------------------------------------------------------------------------#
-
- # Fraction part of a decimal version number. This is a common part of
- # both strict and lax decimal versions
-
- my $FRACTION_PART = qr/\.[0-9]+/;
-
- # First part of either decimal or dotted-decimal strict version number.
- # Unsigned integer with no leading zeroes (except for zero itself) to
- # avoid confusion with octal.
-
- my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
-
- # First part of either decimal or dotted-decimal lax version number.
- # Unsigned integer, but allowing leading zeros. Always interpreted
- # as decimal. However, some forms of the resulting syntax give odd
- # results if used as ordinary Perl expressions, due to how perl treats
- # octals. E.g.
- # version->new("010" ) == 10
- # version->new( 010 ) == 8
- # version->new( 010.2) == 82 # "8" . "2"
-
- my $LAX_INTEGER_PART = qr/[0-9]+/;
-
- # Second and subsequent part of a strict dotted-decimal version number.
- # Leading zeroes are permitted, and the number is always decimal.
- # Limited to three digits to avoid overflow when converting to decimal
- # form and also avoid problematic style with excessive leading zeroes.
-
- my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
-
- # Second and subsequent part of a lax dotted-decimal version number.
- # Leading zeroes are permitted, and the number is always decimal. No
- # limit on the numerical value or number of digits, so there is the
- # possibility of overflow when converting to decimal form.
-
- my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
-
- # Alpha suffix part of lax version number syntax. Acts like a
- # dotted-decimal part.
-
- my $LAX_ALPHA_PART = qr/_[0-9]+/;
-
- #--------------------------------------------------------------------------#
- # Strict version regexp definitions
- #--------------------------------------------------------------------------#
-
- # Strict decimal version number.
-
- my $STRICT_DECIMAL_VERSION =
- qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
-
- # Strict dotted-decimal version number. Must have both leading "v" and
- # at least three parts, to avoid confusion with decimal syntax.
-
- my $STRICT_DOTTED_DECIMAL_VERSION =
- qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
-
- # Complete strict version number syntax -- should generally be used
- # anchored: qr/ \A $STRICT \z /x
-
- $STRICT =
- qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
-
- #--------------------------------------------------------------------------#
- # Lax version regexp definitions
- #--------------------------------------------------------------------------#
-
- # Lax decimal version number. Just like the strict one except for
- # allowing an alpha suffix or allowing a leading or trailing
- # decimal-point
-
- my $LAX_DECIMAL_VERSION =
- qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
- |
- $FRACTION_PART $LAX_ALPHA_PART?
- /x;
-
- # Lax dotted-decimal version number. Distinguished by having either
- # leading "v" or at least three non-alpha parts. Alpha part is only
- # permitted if there are at least two non-alpha parts. Strangely
- # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
- # so when there is no "v", the leading part is optional
-
- my $LAX_DOTTED_DECIMAL_VERSION =
- qr/
- v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
- |
- $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
- /x;
-
- # Complete lax version number syntax -- should generally be used
- # anchored: qr/ \A $LAX \z /x
- #
- # The string 'undef' is a special case to make for easier handling
- # of return values from ExtUtils::MM->parse_version
-
- $LAX =
- qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
-
- #--------------------------------------------------------------------------#
-
- eval "use version::vxs $VERSION";
- if ( $@ ) { # don't have the XS version installed
- eval "use version::vpp $VERSION"; # don't tempt fate
- die "$@" if ( $@ );
- push @ISA, "version::vpp";
- local $^W;
- *version::qv = \&version::vpp::qv;
- *version::declare = \&version::vpp::declare;
- *version::_VERSION = \&version::vpp::_VERSION;
- if ($] >= 5.009000 && $] < 5.011004) {
- no strict 'refs';
- *version::stringify = \&version::vpp::stringify;
- *{'version::(""'} = \&version::vpp::stringify;
- *version::new = \&version::vpp::new;
- *version::parse = \&version::vpp::parse;
- }
- }
- else { # use XS module
- push @ISA, "version::vxs";
- local $^W;
- *version::declare = \&version::vxs::declare;
- *version::qv = \&version::vxs::qv;
- *version::_VERSION = \&version::vxs::_VERSION;
- *version::vcmp = \&version::vxs::VCMP;
- if ($] >= 5.009000 && $] < 5.011004) {
- no strict 'refs';
- *version::stringify = \&version::vxs::stringify;
- *{'version::(""'} = \&version::vxs::stringify;
- *version::new = \&version::vxs::new;
- *version::parse = \&version::vxs::parse;
- }
-
- }
-
- # Preloaded methods go here.
- sub import {
- no strict 'refs';
- my ($class) = shift;
-
- # Set up any derived class
- unless ($class eq 'version') {
- local $^W;
- *{$class.'::declare'} = \&version::declare;
- *{$class.'::qv'} = \&version::qv;
- }
-
- my %args;
- if (@_) { # any remaining terms are arguments
- map { $args{$_} = 1 } @_
- }
- else { # no parameters at all on use line
- %args =
- (
- qv => 1,
- 'UNIVERSAL::VERSION' => 1,
- );
- }
-
- my $callpkg = caller();
-
- if (exists($args{declare})) {
- *{$callpkg.'::declare'} =
- sub {return $class->declare(shift) }
- unless defined(&{$callpkg.'::declare'});
- }
-
- if (exists($args{qv})) {
- *{$callpkg.'::qv'} =
- sub {return $class->qv(shift) }
- unless defined(&{$callpkg.'::qv'});
- }
-
- if (exists($args{'UNIVERSAL::VERSION'})) {
- local $^W;
- *UNIVERSAL::VERSION
- = \&version::_VERSION;
- }
-
- if (exists($args{'VERSION'})) {
- *{$callpkg.'::VERSION'} = \&version::_VERSION;
- }
-
- if (exists($args{'is_strict'})) {
- *{$callpkg.'::is_strict'} = \&version::is_strict
- unless defined(&{$callpkg.'::is_strict'});
- }
-
- if (exists($args{'is_lax'})) {
- *{$callpkg.'::is_lax'} = \&version::is_lax
- unless defined(&{$callpkg.'::is_lax'});
- }
- }
-
- sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
- sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
-
- 1;
-VERSION
-
-$fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
- package charstar;
- # a little helper class to emulate C char* semantics in Perl
- # so that prescan_version can use the same code as in C
-
- use overload (
- '""' => \&thischar,
- '0+' => \&thischar,
- '++' => \&increment,
- '--' => \&decrement,
- '+' => \&plus,
- '-' => \&minus,
- '*' => \&multiply,
- 'cmp' => \&cmp,
- '<=>' => \&spaceship,
- 'bool' => \&thischar,
- '=' => \&clone,
- );
-
- sub new {
- my ($self, $string) = @_;
- my $class = ref($self) || $self;
-
- my $obj = {
- string => [split(//,$string)],
- current => 0,
- };
- return bless $obj, $class;
- }
-
- sub thischar {
- my ($self) = @_;
- my $last = $#{$self->{string}};
- my $curr = $self->{current};
- if ($curr >= 0 && $curr <= $last) {
- return $self->{string}->[$curr];
- }
- else {
- return '';
- }
- }
-
- sub increment {
- my ($self) = @_;
- $self->{current}++;
- }
-
- sub decrement {
- my ($self) = @_;
- $self->{current}--;
- }
-
- sub plus {
- my ($self, $offset) = @_;
- my $rself = $self->clone;
- $rself->{current} += $offset;
- return $rself;
- }
-
- sub minus {
- my ($self, $offset) = @_;
- my $rself = $self->clone;
- $rself->{current} -= $offset;
- return $rself;
- }
-
- sub multiply {
- my ($left, $right, $swapped) = @_;
- my $char = $left->thischar();
- return $char * $right;
- }
-
- sub spaceship {
- my ($left, $right, $swapped) = @_;
- unless (ref($right)) { # not an object already
- $right = $left->new($right);
- }
- return $left->{current} <=> $right->{current};
- }
-
- sub cmp {
- my ($left, $right, $swapped) = @_;
- unless (ref($right)) { # not an object already
- if (length($right) == 1) { # comparing single character only
- return $left->thischar cmp $right;
- }
- $right = $left->new($right);
- }
- return $left->currstr cmp $right->currstr;
- }
-
- sub bool {
- my ($self) = @_;
- my $char = $self->thischar;
- return ($char ne '');
- }
-
- sub clone {
- my ($left, $right, $swapped) = @_;
- $right = {
- string => [@{$left->{string}}],
- current => $left->{current},
- };
- return bless $right, ref($left);
- }
-
- sub currstr {
- my ($self, $s) = @_;
- my $curr = $self->{current};
- my $last = $#{$self->{string}};
- if (defined($s) && $s->{current} < $last) {
- $last = $s->{current};
- }
-
- my $string = join('', @{$self->{string}}[$curr..$last]);
- return $string;
- }
-
- package version::vpp;
- use strict;
-
- use POSIX qw/locale_h/;
- use locale;
- use vars qw ($VERSION @ISA @REGEXS);
- $VERSION = 0.88;
-
- use overload (
- '""' => \&stringify,
- '0+' => \&numify,
- 'cmp' => \&vcmp,
- '<=>' => \&vcmp,
- 'bool' => \&vbool,
- 'nomethod' => \&vnoop,
- );
-
- eval "use warnings";
- if ($@) {
- eval '
- package warnings;
- sub enabled {return $^W;}
- 1;
- ';
- }
-
- my $VERSION_MAX = 0x7FFFFFFF;
-
- # implement prescan_version as closely to the C version as possible
- use constant TRUE => 1;
- use constant FALSE => 0;
-
- sub isDIGIT {
- my ($char) = shift->thischar();
- return ($char =~ /\d/);
- }
-
- sub isALPHA {
- my ($char) = shift->thischar();
- return ($char =~ /[a-zA-Z]/);
- }
-
- sub isSPACE {
- my ($char) = shift->thischar();
- return ($char =~ /\s/);
- }
-
- sub BADVERSION {
- my ($s, $errstr, $error) = @_;
- if ($errstr) {
- $$errstr = $error;
- }
- return $s;
- }
-
- sub prescan_version {
- my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_;
- my $qv = defined $sqv ? $$sqv : FALSE;
- my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0;
- my $width = defined $swidth ? $$swidth : 3;
- my $alpha = defined $salpha ? $$salpha : FALSE;
-
- my $d = $s;
-
- if ($qv && isDIGIT($d)) {
- goto dotted_decimal_version;
- }
-
- if ($d eq 'v') { # explicit v-string
- $d++;
- if (isDIGIT($d)) {
- $qv = TRUE;
- }
- else { # degenerate v-string
- # requires v1.2.3
- return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
- }
-
- dotted_decimal_version:
- if ($strict && $d eq '0' && isDIGIT($d+1)) {
- # no leading zeros allowed
- return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
- }
-
- while (isDIGIT($d)) { # integer part
- $d++;
- }
-
- if ($d eq '.')
- {
- $saw_decimal++;
- $d++; # decimal point
- }
- else
- {
- if ($strict) {
- # require v1.2.3
- return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
- }
- else {
- goto version_prescan_finish;
- }
- }
-
- {
- my $i = 0;
- my $j = 0;
- while (isDIGIT($d)) { # just keep reading
- $i++;
- while (isDIGIT($d)) {
- $d++; $j++;
- # maximum 3 digits between decimal
- if ($strict && $j > 3) {
- return BADVERSION($s,$errstr,"Invalid version format (maximum 3 digits between decimals)");
- }
- }
- if ($d eq '_') {
- if ($strict) {
- return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
- }
- if ( $alpha ) {
- return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
- }
- $d++;
- $alpha = TRUE;
- }
- elsif ($d eq '.') {
- if ($alpha) {
- return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
- }
- $saw_decimal++;
- $d++;
- }
- elsif (!isDIGIT($d)) {
- last;
- }
- $j = 0;
- }
-
- if ($strict && $i < 2) {
- # requires v1.2.3
- return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
- }
- }
- } # end if dotted-decimal
- else
- { # decimal versions
- # special $strict case for leading '.' or '0'
- if ($strict) {
- if ($d eq '.') {
- return BADVERSION($s,$errstr,"Invalid version format (0 before decimal required)");
- }
- if ($d eq '0' && isDIGIT($d+1)) {
- return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
- }
- }
-
- # consume all of the integer part
- while (isDIGIT($d)) {
- $d++;
- }
-
- # look for a fractional part
- if ($d eq '.') {
- # we found it, so consume it
- $saw_decimal++;
- $d++;
- }
- elsif (!$d || $d eq ';' || isSPACE($d) || $d eq '}') {
- if ( $d == $s ) {
- # found nothing
- return BADVERSION($s,$errstr,"Invalid version format (version required)");
- }
- # found just an integer
- goto version_prescan_finish;
- }
- elsif ( $d == $s ) {
- # didn't find either integer or period
- return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
- }
- elsif ($d eq '_') {
- # underscore can't come after integer part
- if ($strict) {
- return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
- }
- elsif (isDIGIT($d+1)) {
- return BADVERSION($s,$errstr,"Invalid version format (alpha without decimal)");
- }
- else {
- return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
- }
- }
- elsif ($d) {
- # anything else after integer part is just invalid data
- return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
- }
-
- # scan the fractional part after the decimal point
- if ($d && !isDIGIT($d) && ($strict || ! ($d eq ';' || isSPACE($d) || $d eq '}') )) {
- # $strict or lax-but-not-the-end
- return BADVERSION($s,$errstr,"Invalid version format (fractional part required)");
- }
-
- while (isDIGIT($d)) {
- $d++;
- if ($d eq '.' && isDIGIT($d-1)) {
- if ($alpha) {
- return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
- }
- if ($strict) {
- return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
- }
- $d = $s; # start all over again
- $qv = TRUE;
- goto dotted_decimal_version;
- }
- if ($d eq '_') {
- if ($strict) {
- return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
- }
- if ( $alpha ) {
- return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
- }
- if ( ! isDIGIT($d+1) ) {
- return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
- }
- $d++;
- $alpha = TRUE;
- }
- }
- }
-
- version_prescan_finish:
- while (isSPACE($d)) {
- $d++;
- }
-
- if ($d && !isDIGIT($d) && (! ($d eq ';' || $d eq '}') )) {
- # trailing non-numeric data
- return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
- }
-
- if (defined $sqv) {
- $$sqv = $qv;
- }
- if (defined $swidth) {
- $$swidth = $width;
- }
- if (defined $ssaw_decimal) {
- $$ssaw_decimal = $saw_decimal;
- }
- if (defined $salpha) {
- $$salpha = $alpha;
- }
- return $d;
- }
-
- sub scan_version {
- my ($s, $rv, $qv) = @_;
- my $start;
- my $pos;
- my $last;
- my $errstr;
- my $saw_decimal = 0;
- my $width = 3;
- my $alpha = FALSE;
- my $vinf = FALSE;
- my @av;
-
- $s = new charstar $s;
-
- while (isSPACE($s)) { # leading whitespace is OK
- $s++;
- }
-
- $last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal,
- \$width, \$alpha);
-
- if ($errstr) {
- # 'undef' is a special case and not an error
- if ( $s ne 'undef') {
- use Carp;
- Carp::croak($errstr);
- }
- }
-
- $start = $s;
- if ($s eq 'v') {
- $s++;
- }
- $pos = $s;
-
- if ( $qv ) {
- $$rv->{qv} = $qv;
- }
- if ( $alpha ) {
- $$rv->{alpha} = $alpha;
- }
- if ( !$qv && $width < 3 ) {
- $$rv->{width} = $width;
- }
-
- while (isDIGIT($pos)) {
- $pos++;
- }
- if (!isALPHA($pos)) {
- my $rev;
-
- for (;;) {
- $rev = 0;
- {
- # this is atoi() that delimits on underscores
- my $end = $pos;
- my $mult = 1;
- my $orev;
-
- # the following if() will only be true after the decimal
- # point of a version originally created with a bare
- # floating point number, i.e. not quoted in any way
- #
- if ( !$qv && $s > $start && $saw_decimal == 1 ) {
- $mult *= 100;
- while ( $s < $end ) {
- $orev = $rev;
- $rev += $s * $mult;
- $mult /= 10;
- if ( (abs($orev) > abs($rev))
- || (abs($rev) > $VERSION_MAX )) {
- warn("Integer overflow in version %d",
- $VERSION_MAX);
- $s = $end - 1;
- $rev = $VERSION_MAX;
- $vinf = 1;
- }
- $s++;
- if ( $s eq '_' ) {
- $s++;
- }
- }
- }
- else {
- while (--$end >= $s) {
- $orev = $rev;
- $rev += $end * $mult;
- $mult *= 10;
- if ( (abs($orev) > abs($rev))
- || (abs($rev) > $VERSION_MAX )) {
- warn("Integer overflow in version");
- $end = $s - 1;
- $rev = $VERSION_MAX;
- $vinf = 1;
- }
- }
- }
- }
-
- # Append revision
- push @av, $rev;
- if ( $vinf ) {
- $s = $last;
- last;
- }
- elsif ( $pos eq '.' ) {
- $s = ++$pos;
- }
- elsif ( $pos eq '_' && isDIGIT($pos+1) ) {
- $s = ++$pos;
- }
- elsif ( $pos eq ',' && isDIGIT($pos+1) ) {
- $s = ++$pos;
- }
- elsif ( isDIGIT($pos) ) {
- $s = $pos;
- }
- else {
- $s = $pos;
- last;
- }
- if ( $qv ) {
- while ( isDIGIT($pos) ) {
- $pos++;
- }
- }
- else {
- my $digits = 0;
- while ( ( isDIGIT($pos) || $pos eq '_' ) && $digits < 3 ) {
- if ( $pos ne '_' ) {
- $digits++;
- }
- $pos++;
- }
- }
- }
- }
- if ( $qv ) { # quoted versions always get at least three terms
- my $len = $#av;
- # This for loop appears to trigger a compiler bug on OS X, as it
- # loops infinitely. Yes, len is negative. No, it makes no sense.
- # Compiler in question is:
- # gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
- # for ( len = 2 - len; len > 0; len-- )
- # av_push(MUTABLE_AV(sv), newSViv(0));
- #
- $len = 2 - $len;
- while ($len-- > 0) {
- push @av, 0;
- }
- }
-
- # need to save off the current version string for later
- if ( $vinf ) {
- $$rv->{original} = "v.Inf";
- $$rv->{vinf} = 1;
- }
- elsif ( $s > $start ) {
- $$rv->{original} = $start->currstr($s);
- if ( $qv && $saw_decimal == 1 && $start ne 'v' ) {
- # need to insert a v to be consistent
- $$rv->{original} = 'v' . $$rv->{original};
- }
- }
- else {
- $$rv->{original} = '0';
- push(@av, 0);
- }
-
- # And finally, store the AV in the hash
- $$rv->{version} = \@av;
-
- # fix RT#19517 - special case 'undef' as string
- if ($s eq 'undef') {
- $s += 5;
- }
-
- return $s;
- }
-
- sub new
- {
- my ($class, $value) = @_;
- my $self = bless ({}, ref ($class) || $class);
- my $qv = FALSE;
-
- if ( ref($value) && eval('$value->isa("version")') ) {
- # Can copy the elements directly
- $self->{version} = [ @{$value->{version} } ];
- $self->{qv} = 1 if $value->{qv};
- $self->{alpha} = 1 if $value->{alpha};
- $self->{original} = ''.$value->{original};
- return $self;
- }
-
- my $currlocale = setlocale(LC_ALL);
-
- # if the current locale uses commas for decimal points, we
- # just replace commas with decimal places, rather than changing
- # locales
- if ( localeconv()->{decimal_point} eq ',' ) {
- $value =~ tr/,/./;
- }
-
- if ( not defined $value or $value =~ /^undef$/ ) {
- # RT #19517 - special case for undef comparison
- # or someone forgot to pass a value
- push @{$self->{version}}, 0;
- $self->{original} = "0";
- return ($self);
- }
-
- if ( $#_ == 2 ) { # must be CVS-style
- $value = $_[2];
- $qv = TRUE;
- }
-
- $value = _un_vstring($value);
-
- # exponential notation
- if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
- $value = sprintf("%.9f",$value);
- $value =~ s/(0+)$//; # trim trailing zeros
- }
-
- my $s = scan_version($value, \$self, $qv);
-
- if ($s) { # must be something left over
- warn("Version string '%s' contains invalid data; "
- ."ignoring: '%s'", $value, $s);
- }
-
- return ($self);
- }
-
- *parse = \&new;
-
- sub numify
- {
- my ($self) = @_;
- unless (_verify($self)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- my $width = $self->{width} || 3;
- my $alpha = $self->{alpha} || "";
- my $len = $#{$self->{version}};
- my $digit = $self->{version}[0];
- my $string = sprintf("%d.", $digit );
-
- for ( my $i = 1 ; $i < $len ; $i++ ) {
- $digit = $self->{version}[$i];
- if ( $width < 3 ) {
- my $denom = 10**(3-$width);
- my $quot = int($digit/$denom);
- my $rem = $digit - ($quot * $denom);
- $string .= sprintf("%0".$width."d_%d", $quot, $rem);
- }
- else {
- $string .= sprintf("%03d", $digit);
- }
- }
-
- if ( $len > 0 ) {
- $digit = $self->{version}[$len];
- if ( $alpha && $width == 3 ) {
- $string .= "_";
- }
- $string .= sprintf("%0".$width."d", $digit);
- }
- else # $len = 0
- {
- $string .= sprintf("000");
- }
-
- return $string;
- }
-
- sub normal
- {
- my ($self) = @_;
- unless (_verify($self)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- my $alpha = $self->{alpha} || "";
- my $len = $#{$self->{version}};
- my $digit = $self->{version}[0];
- my $string = sprintf("v%d", $digit );
-
- for ( my $i = 1 ; $i < $len ; $i++ ) {
- $digit = $self->{version}[$i];
- $string .= sprintf(".%d", $digit);
- }
-
- if ( $len > 0 ) {
- $digit = $self->{version}[$len];
- if ( $alpha ) {
- $string .= sprintf("_%0d", $digit);
- }
- else {
- $string .= sprintf(".%0d", $digit);
- }
- }
-
- if ( $len <= 2 ) {
- for ( $len = 2 - $len; $len != 0; $len-- ) {
- $string .= sprintf(".%0d", 0);
- }
- }
-
- return $string;
- }
-
- sub stringify
- {
- my ($self) = @_;
- unless (_verify($self)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- return exists $self->{original}
- ? $self->{original}
- : exists $self->{qv}
- ? $self->normal
- : $self->numify;
- }
-
- sub vcmp
- {
- require UNIVERSAL;
- my ($left,$right,$swap) = @_;
- my $class = ref($left);
- unless ( UNIVERSAL::isa($right, $class) ) {
- $right = $class->new($right);
- }
-
- if ( $swap ) {
- ($left, $right) = ($right, $left);
- }
- unless (_verify($left)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- unless (_verify($right)) {
- require Carp;
- Carp::croak("Invalid version object");
- }
- my $l = $#{$left->{version}};
- my $r = $#{$right->{version}};
- my $m = $l < $r ? $l : $r;
- my $lalpha = $left->is_alpha;
- my $ralpha = $right->is_alpha;
- my $retval = 0;
- my $i = 0;
- while ( $i <= $m && $retval == 0 ) {
- $retval = $left->{version}[$i] <=> $right->{version}[$i];
- $i++;
- }
-
- # tiebreaker for alpha with identical terms
- if ( $retval == 0
- && $l == $r
- && $left->{version}[$m] == $right->{version}[$m]
- && ( $lalpha || $ralpha ) ) {
-
- if ( $lalpha && !$ralpha ) {
- $retval = -1;
- }
- elsif ( $ralpha && !$lalpha) {
- $retval = +1;
- }
- }
-
- # possible match except for trailing 0's
- if ( $retval == 0 && $l != $r ) {
- if ( $l < $r ) {
- while ( $i <= $r && $retval == 0 ) {
- if ( $right->{version}[$i] != 0 ) {
- $retval = -1; # not a match after all
- }
- $i++;
- }
- }
- else {
- while ( $i <= $l && $retval == 0 ) {
- if ( $left->{version}[$i] != 0 ) {
- $retval = +1; # not a match after all
- }
- $i++;
- }
- }
- }
-
- return $retval;
- }
-
- sub vbool {
- my ($self) = @_;
- return vcmp($self,$self->new("0"),1);
- }
-
- sub vnoop {
- require Carp;
- Carp::croak("operation not supported with version object");
- }
-
- sub is_alpha {
- my ($self) = @_;
- return (exists $self->{alpha});
- }
-
- sub qv {
- my $value = shift;
- my $class = 'version';
- if (@_) {
- $class = ref($value) || $value;
- $value = shift;
- }
-
- $value = _un_vstring($value);
- $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
- my $version = $class->new($value);
- return $version;
- }
-
- *declare = \&qv;
-
- sub is_qv {
- my ($self) = @_;
- return (exists $self->{qv});
- }
-
-
- sub _verify {
- my ($self) = @_;
- if ( ref($self)
- && eval { exists $self->{version} }
- && ref($self->{version}) eq 'ARRAY'
- ) {
- return 1;
- }
- else {
- return 0;
- }
- }
-
- sub _is_non_alphanumeric {
- my $s = shift;
- $s = new charstar $s;
- while ($s) {
- return 0 if isSPACE($s); # early out
- return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/);
- $s++;
- }
- return 0;
- }
-
- sub _un_vstring {
- my $value = shift;
- # may be a v-string
- if ( length($value) >= 3 && $value !~ /[._]/
- && _is_non_alphanumeric($value)) {
- my $tvalue;
- if ( $] ge 5.008_001 ) {
- $tvalue = _find_magic_vstring($value);
- $value = $tvalue if length $tvalue;
- }
- elsif ( $] ge 5.006_000 ) {
- $tvalue = sprintf("v%vd",$value);
- if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
- # must be a v-string
- $value = $tvalue;
- }
- }
- }
- return $value;
- }
-
- sub _find_magic_vstring {
- my $value = shift;
- my $tvalue = '';
- require B;
- my $sv = B::svref_2object(\$value);
- my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef;
- while ( $magic ) {
- if ( $magic->TYPE eq 'V' ) {
- $tvalue = $magic->PTR;
- $tvalue =~ s/^v?(.+)$/v$1/;
- last;
- }
- else {
- $magic = $magic->MOREMAGIC;
- }
- }
- return $tvalue;
- }
-
- sub _VERSION {
- my ($obj, $req) = @_;
- my $class = ref($obj) || $obj;
-
- no strict 'refs';
- if ( exists $INC{"$class.pm"} and not %{"$class\::"} and $] >= 5.008) {
- # file but no package
- require Carp;
- Carp::croak( "$class defines neither package nor VERSION"
- ."--version check failed");
- }
-
- my $version = eval "\$$class\::VERSION";
- if ( defined $version ) {
- local $^W if $] <= 5.008;
- $version = version::vpp->new($version);
- }
-
- if ( defined $req ) {
- unless ( defined $version ) {
- require Carp;
- my $msg = $] < 5.006
- ? "$class version $req required--this is only version "
- : "$class does not define \$$class\::VERSION"
- ."--version check failed";
-
- if ( $ENV{VERSION_DEBUG} ) {
- Carp::confess($msg);
- }
- else {
- Carp::croak($msg);
- }
- }
-
- $req = version::vpp->new($req);
-
- if ( $req > $version ) {
- require Carp;
- if ( $req->is_qv ) {
- Carp::croak(
- sprintf ("%s version %s required--".
- "this is only version %s", $class,
- $req->normal, $version->normal)
- );
- }
- else {
- Carp::croak(
- sprintf ("%s version %s required--".
- "this is only version %s", $class,
- $req->stringify, $version->stringify)
- );
- }
- }
- }
-
- return defined $version ? $version->stringify : undef;
- }
-
- 1; #this line is important and will help the module return a true value
-VERSION_VPP
-
-s/^ //mg for values %fatpacked;
-
-unshift @INC, sub {
- if (my $fat = $fatpacked{$_[1]}) {
- open my $fh, '<', \$fat
- or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
- return $fh;
- }
- return
-};
-
-} # END OF FATPACK CODE
-
-use strict;
-use App::cpanminus::script;
-
-unless (caller) {
- my $app = App::cpanminus::script->new;
- $app->parse_options(@ARGV);
- $app->doit or exit(1);
-}
-
-__END__
-
-=head1 NAME
-
-cpanm - get, unpack build and install modules from CPAN
-
-=head1 SYNOPSIS
-
- cpanm Test::More # install Test::More
- cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path
- cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL
- cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file
- cpanm --interactive Task::Kensho # Configure interactively
- cpanm . # install from local directory
- cpanm --installdeps . # install all the deps for the current directory
- cpanm -L extlib Plack # install Plack and all non-core deps into extlib
- cpanm --mirror http://cpan.cpantesters.org/ DBI # use the fast-syncing mirror
- cpanm --scandeps Moose # See what modules will be installed for Moose
-
-=head1 COMMANDS
-
-=over 4
-
-=item -i, --install
-
-Installs the modules. This is a default behavior and this is just a
-compatibility option to make it work like L<cpan> or L<cpanp>.
-
-=item --self-upgrade
-
-Upgrades itself. It's just an alias for:
-
- cpanm App::cpanminus
-
-=item --info
-
-Displays the distribution information in
-C<AUTHOR/Dist-Name-ver.tar.gz> format in the standard out.
-
-=item --installdeps
-
-Installs the dependencies of the target distribution but won't build
-itself. Handy if you want to try the application from a version
-controlled repository such as git.
-
- cpanm --installdeps .
-
-=item --look
-
-Download and unpack the distribution and then open the directory with
-your shell. Handy to poke around the source code or do the manual
-testing.
-
-=item -h, --help
-
-Displays the help message.
-
-=item -V, --version
-
-Displays the version number.
-
-=back
-
-=head1 OPTIONS
-
-You can specify the default options in C<PERL_CPANM_OPT> environment variable.
-
-=over 4
-
-=item -f, --force
-
-Force install modules even when testing failed.
-
-=item -n, --notest
-
-Skip the testing of modules. Use this only when you just want to save
-time for installing hundreds of distributions to the same perl and
-architecture you've already tested to make sure it builds fine.
-
-Defaults to false, and you can say C<--no-notest> to override when it
-is set in the default options in C<PERL_CPANM_OPT>.
-
-=item -S, --sudo
-
-Switch to the root user with C<sudo> when installing modules. Use this
-if you want to install modules to the system perl include path.
-
-Defaults to false, and you can say C<--no-sudo> to override when it is
-set in the default options in C<PERL_CPANM_OPT>.
-
-=item -v, --verbose
-
-Makes the output verbose. It also enables the interactive
-configuration. (See --interactive)
-
-=item -q, --quiet
-
-Makes the output even more quiet than the default. It doesn't print
-anything to the STDERR.
-
-=item -l, --local-lib
-
-Sets the L<local::lib> compatible path to install modules to. You
-don't need to set this if you already configure the shell environment
-variables using L<local::lib>, but this can be used to override that
-as well.
-
-=item -L, --local-lib-contained
-
-Same with C<--local-lib> but when examining the dependencies, it
-assumes no non-core modules are installed on the system. It's handy if
-you want to bundle application dependencies in one directory so you
-can distribute to other machines.
-
-For instance,
-
- cpanm -L extlib Plack
-
-would install Plack and all of its non-core dependencies into the
-directory C<extlib>, which can be loaded from your application with:
-
- use local::lib '/path/to/extlib';
-
-=item --mirror
-
-Specifies the base URL for the CPAN mirror to use, such as
-C<http://cpan.cpantesters.org/> (you can omit the trailing slash). You
-can specify multiple mirror URLs by repeating the command line option.
-
-Defaults to C<http://search.cpan.org/CPAN> which is a geo location
-aware redirector.
-
-=item --mirror-only
-
-Download the mirror's 02packages.details.txt.gz index file instead of
-querying the CPAN Meta DB.
-
-Select this option if you are using a local mirror of CPAN, such as
-minicpan when you're offline, or your own CPAN index (a.k.a darkpan).
-
-B<Tip:> It might be useful if you name these mirror options with your
-shell aliases, like:
-
- alias minicpanm='cpanm --mirror ~/minicpan --mirror-only'
- alias darkpan='cpanm --mirror http://mycompany.example.com/DPAN --mirror-only'
-
-=item --prompt
-
-Prompts when a test fails so that you can skip, force install, retry
-or look in the shell to see what's going wrong. It also prompts when
-one of the dependency failed if you want to proceed the installation.
-
-Defaults to false, and you can say C<--no-prompt> to override if it's
-set in the default options in C<PERL_CPANM_OPT>.
-
-=item --reinstall
-
-cpanm, when given a module name in the command line (i.e. C<cpanm
-Plack>), checks the locally installed version first and skips if it is
-already installed. This option makes it skip the check, so:
-
- cpanm --reinstall Plack
-
-would reinstall L<Plack> even if your locally installed version is
-latest, or even newer (which would happen if you install a developer
-release from version control repositories).
-
-Defaults to false.
-
-=item --interactive
-
-Makes the configuration (such as C<Makefile.PL> and C<Build.PL>)
-interactive, so you can answer questions in the distribution that
-requires custom configuration or Task:: distributions.
-
-Defaults to false, and you can say C<--no-interactive> to override
-when it's set in the default options in C<PERL_CPANM_OPT>.
-
-=item --scandeps
-
-Scans the depencencies of given modules and output the tree in a text
-format. (See C<--format> below for more options)
-
-Because this command doesn't actually install any distributions, it
-will be useful that by typing:
-
- cpanm --scandeps Catalyst::Runtime
-
-you can make sure what modules will be installed.
-
-This command takes into account which modules you already have
-installed in your system. If you want to see what modules will be
-installed against a vanilla perl installation, you might want to
-combine it with C<-L> option.
-
-=item --format
-
-Determines what format to display the scanned dependency
-tree. Available options are C<tree>, C<json>, C<yaml> and C<dists>.
-
-=over 8
-
-=item tree
-
-Displays the tree in a plain text format. This is the default value.
-
-=item json, yaml
-
-Outputs the tree in a JSON or YAML format. L<JSON> and L<YAML> modules
-need to be installed respectively. The output tree is represented as a
-recursive tuple of:
-
- [ distribution, dependencies ]
-
-and the container is an array containing the root elements. Note that
-there may be multiple root nodes, since you can give multiple modules
-to the C<--scandeps> command.
-
-=item dists
-
-C<dists> is a special output format, where it prints the distribution
-filename in the I<depth first order> after the dependency resolution,
-like:
-
- GAAS/MIME-Base64-3.13.tar.gz
- GAAS/URI-1.58.tar.gz
- PETDANCE/HTML-Tagset-3.20.tar.gz
- GAAS/HTML-Parser-3.68.tar.gz
- GAAS/libwww-perl-5.837.tar.gz
-
-which means you can install these distributions in this order without
-extra dependencies. When combined with C<-L> option, it will be useful
-to replay installations on other machines.
-
-=back
-
-=item --save-dists
-
-Specifies the optional directory path to copy downloaded tarballs in
-the CPAN mirror compatible directory structure
-i.e. I<authors/id/A/AU/AUTHORS/Foo-Bar-version.tar.gz>
-
-=item --uninst-shadows
-
-Uninstalls the shadow files of the distribution that you're
-installing. This eliminates the confusion if you're trying to install
-core (dual-life) modules from CPAN against perl 5.10 or older, or
-modules that used to be XS-based but switched to pure perl at some
-version.
-
-If you run cpanm as root and use C<INSTALL_BASE> or equivalent to
-specify custom installation path, you SHOULD disable this option so
-you won't accidentally uninstall dual-life modules from the core
-include path.
-
-Defaults to true if your perl version is smaller than 5.12, and you
-can disable that with C<--no-uninst-shadows>.
-
-B<NOTE>: Since version 1.3000 this flag is turned off by default for
-perl newer than 5.12, since with 5.12 @INC contains site_perl directory
-I<before> the perl core library path, and uninstalling shadows is not
-necessary anymore and does more harm by deleting files from the core
-library path.
-
-=item --auto-cleanup
-
-Specifies the number of days in whcih cpanm's work directories
-expire. Defaults to 7, which means old work directories will be
-cleaned up in one week.
-
-You can set the value to C<0> to make cpan never cleanup those
-directories.
-
-=item --man-pages
-
-Generates man pages for executables (man1) and libraries (man3).
-
-Defaults to false (no man pages generated) if
-C<-L|--local-lib-contained> option is supplied. Otherwise, defaults to
-true, and you can disable it with C<--no-man-pages>.
-
-=item --lwp
-
-Uses L<LWP> module to download stuff over HTTP. Defaults to true, and
-you can say C<--no-lwp> to disable using LWP, when you want to upgrade
-LWP from CPAN on some broken perl systems.
-
-=item --wget
-
-Uses GNU Wget (if available) to download stuff. Defaults to true, and
-you can say C<--no-wget> to disable using Wget (versions of Wget older
-than 1.9 don't support the C<--retry-connrefused> option used by cpanm).
-
-=item --curl
-
-Uses cURL (if available) to download stuff. Defaults to true, and
-you can say C<--no-curl> to disable using cURL.
-
-Normally with C<--lwp>, C<--wget> and C<--curl> options set to true
-(which is the default) cpanm tries L<LWP>, Wget, cURL and L<HTTP::Tiny>
-(in that order) and uses the first one available.
-
-=back
-
-=head1 SEE ALSO
-
-L<App::cpanminus>
-
-=head1 COPYRIGHT
-
-Copyright 2010 Tatsuhiko Miyagawa.
-
-=head1 AUTHOR
-
-Tatsuhiko Miyagawa
-
-=cut
diff --git a/perl-external/bin/module-manage.pl b/perl-external/bin/module-manage.pl
deleted file mode 100755
index 5e826aabf..000000000
--- a/perl-external/bin/module-manage.pl
+++ /dev/null
@@ -1,265 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use IPC::Run3;
-use LWP::Simple;
-use File::Slurp;
-use Path::Class;
-use List::MoreUtils 'uniq';
-
-# TODO - 'updates' action that lists packages that could be updated
-# TODO - add smarts to strip out old packages (could switch to building using files.txt after)
-
-my $root_dir = file(__FILE__)->dir->parent->absolute->stringify;
-my $module_list = "$root_dir/modules.txt";
-my $file_list = "$root_dir/files.txt";
-my $minicpan = "$root_dir/minicpan";
-my $local_packages_file = "$minicpan/modules/02packages.details.txt";
-my $local_packages_file_gz = "$local_packages_file.gz";
-
-my %actions = (
- add => \&add,
- build_all => \&build_all,
- fetch_all => \&fetch_all,
- force_install => \&force_install,
- index_minicpan => \&index_minicpan,
- init => \&init,
- setup => \&setup,
- sort_files => \&sort_files,
- zap => \&zap,
-);
-
-# work out what to run
-my ( $action, @args ) = @ARGV;
-$actions{$action}
- ? $actions{$action}->(@args)
- : die("Usage: $0 action [...]\n actions: "
- . join( ', ', sort keys %actions )
- . "\n" );
-
-exit;
-
-############################################################################
-
-sub init {
- add('App::cpanminus');
-}
-
-sub setup {
- fetch_all();
- build('App::cpanminus');
- build_all();
-}
-
-sub add {
- my $module = shift || die "Usage: $0 add Dist::To::Add";
-
- # try to install the distribution using cpanm
- my $out = '';
- my $cmd = "cpanm --reinstall --save-dists $minicpan $module";
-
- run3( $cmd, undef, undef, undef )
- || die "Error running '$cmd'";
-
- write_file( $module_list, { append => 1 }, "$module\n" );
-
- index_minicpan();
- sort_files();
-}
-
-sub index_minicpan {
-
- # Go through all files in minicpan and add to files.txt
- my @files = sort map { s{^.*?(/authors/id/.*)$}{$1}; $_ }
- split '\s', `find $minicpan/authors -type f`;
- write_file( $file_list, map { "$_\n" } @files );
-
- # work out which ones are not currently in packages
- my @local_packages_lines = read_packages_txt_gz($local_packages_file_gz);
-
- # Are there any missing files?
- my @missing_files = ();
- MINICPAN_FILE:
- foreach my $file (@files) {
- my ($auth_and_file) = $file =~ m{/authors/id/./../(.*)$};
-
- foreach my $line (@local_packages_lines) {
- next MINICPAN_FILE if $line =~ m{$auth_and_file};
- }
-
- push @missing_files, $auth_and_file;
- }
-
- # If there are no missing files we can stop
- return unless @missing_files;
-
- # Fetch 02packages off live cpan
- my $remote_packages_url =
- 'http://cpan.perl.org/modules/02packages.details.txt.gz';
- my $remote_packages_file = "$minicpan/modules/remote_packages.txt.gz";
- print " Fetching '$remote_packages_url'...\n";
- is_error( mirror( $remote_packages_url, $remote_packages_file ) )
- && die "Could not retrieve '$remote_packages_url'";
- print " done...\n";
-
- my @remote_packages_lines = read_packages_txt_gz($remote_packages_file);
-
- # Find remaining in live file and add to local file
- my %lines_to_add = ();
- foreach my $missing (@missing_files) {
- print " Finding matches for '$missing'\n";
- my @matches = grep { m{$missing} } @remote_packages_lines;
- next unless @matches;
- $lines_to_add{$missing} = \@matches;
- }
-
- # for packages still not found parse out the contents
- foreach my $missing (@missing_files) {
- next if $lines_to_add{$missing};
-
- # do a require here so that this module does not prevent 'setup' from
- # being run - needed to install it.
- require CPAN::ParseDistribution;
-
- print " Parsing out matches for '$missing'\n";
-
- my ( $A, $B ) = $missing =~ m{^(.)(.)};
- my $dist =
- CPAN::ParseDistribution->new("$minicpan/authors/id/$A/$A$B/$missing");
-
- my $modules = $dist->modules();
- my @matches = ();
-
- foreach my $module ( sort keys %$modules ) {
- my $version = $modules->{$module} || 'undef';
-
- # Zucchini 0.000017 C/CH/CHISEL/Zucchini-0.0.17.tar.gz
- push @matches, "$module $version $A/$A$B/$missing\n";
- }
-
- $lines_to_add{$missing} = \@matches;
- }
-
- # combine and sort the lines found
- my @new_lines = sort @local_packages_lines,
- map { @$_ } values %lines_to_add;
- unlink $local_packages_file_gz;
- write_file( $local_packages_file, map { "$_\n" } packages_file_headers(),
- @new_lines );
- system "gzip -v $local_packages_file";
-}
-
-sub read_packages_txt_gz {
- my $file = shift;
-
- return unless -e $file;
-
- my @lines = split /\n/, `zcat $file`;
-
- # ditch the headers
- while ( my $line = shift @lines ) {
- last if $line =~ m{^\s*$};
- }
-
- return @lines;
-}
-
-sub packages_file_headers {
-
- # this is all fake stuff
-
- return << 'END_OF_LINES';
-Allow-Packages-Only-Once: 0
-Columns: package name, version, path
-Description: Package names for my private CPAN
-File: 02packages.details.txt
-Intended-For: My private CPAN
-Last-Updated: Wed, 04 May 2011 09:59:13 GMT
-Line-Count: 1389
-URL: http://example.com/MyCPAN/modules/02packages.details.txt
-Written-By: /home/evdb/fixmystreet/perl-external/local-lib/bin/dpan using CPAN::PackageDetails 0.25
-
-END_OF_LINES
-}
-
-sub build_all {
- my @modules = sort uniq map { s{\s+$}{}; $_; } read_file($module_list);
- build($_) for @modules;
-}
-
-sub build {
- my $module = shift #
- || die "Usage: $0 build Module::To::Build\n";
-
- print " --- checking/installing $module ---\n";
-
- my $out = '';
- my $cmd = "cpanm --mirror $minicpan --mirror-only $module";
-
- # print " running '$cmd'\n";
-
- run3( $cmd, undef, \$out, \$out )
- || die "Error running '$cmd'";
-
- my @lines =
- grep { m{\S} }
- split /\n+/, $out;
- my $last_line = $lines[-1];
-
- die "Error building '$module':\n\n$last_line\n\n$out\n\n"
- unless $last_line =~ m{Successfully installed }
- || $last_line =~ m{is up to date}
- || $last_line =~ m{\d+ distributions? installed};
-}
-
-sub fetch_all {
- my @urls = sort uniq map { s{\s+$}{}; $_; } read_file($file_list);
- fetch($_) for @urls;
-}
-
-sub fetch {
- my $filename = shift;
-
- my $destination = file("$minicpan/$filename");
- $destination->dir->mkpath;
-
- return if -e $destination;
-
- # create a list of urls to try in order
- my @urls = (
- "http://search.cpan.org/CPAN" . $filename,
- "http://backpan.perl.org" . $filename,
- );
-
- while ( scalar @urls ) {
- my $url = shift @urls;
-
- # try to fetch
- print " Fetching '$url'...\n";
- last if is_success( getstore( $url, "$destination" ) );
-
- # if more options try again
- next if scalar @urls;
-
- # could not retrieve - die
- die "ERROR - ran out of urls fetching '$filename'";
- }
-}
-
-sub zap {
-
- # delete all the bits that are generated
- my $local_lib_root = $ENV{PERL_LOCAL_LIB_ROOT} || die;
- dir($local_lib_root)->rmtree(1);
- dir($minicpan)->subdir('authors')->rmtree(1);
-}
-
-sub sort_files {
- foreach my $file ( $file_list, $module_list ) {
- my @entries = read_file($file);
- @entries = uniq sort @entries;
- write_file( $file, @entries );
- }
-}
diff --git a/perl-external/files.txt b/perl-external/files.txt
deleted file mode 100644
index 781a2564e..000000000
--- a/perl-external/files.txt
+++ /dev/null
@@ -1,261 +0,0 @@
-/authors/id/A/AB/ABRAXXA/Catalyst-View-TT-0.36.tar.gz
-/authors/id/A/AB/ABRAXXA/DBIx-Class-0.08127.tar.gz
-/authors/id/A/AB/ABW/AppConfig-1.66.tar.gz
-/authors/id/A/AB/ABW/Template-Toolkit-2.22.tar.gz
-/authors/id/A/AC/ACALPINI/Lingua-Stem-It-0.02.tar.gz
-/authors/id/A/AC/ACOBURN/Lingua-EN-Tagger-0.16.tar.gz
-/authors/id/A/AD/ADAMK/Archive-Zip-1.30.tar.gz
-/authors/id/A/AD/ADAMK/Class-Inspector-1.25.tar.gz
-/authors/id/A/AD/ADAMK/DBD-SQLite-1.31.tar.gz
-/authors/id/A/AD/ADAMK/File-Remove-1.48.tar.gz
-/authors/id/A/AD/ADAMK/File-ShareDir-1.03.tar.gz
-/authors/id/A/AD/ADAMK/Module-Install-1.00.tar.gz
-/authors/id/A/AD/ADAMK/Object-Signature-1.05.tar.gz
-/authors/id/A/AD/ADAMK/PPI-1.215.tar.gz
-/authors/id/A/AD/ADAMK/Params-Util-1.03.tar.gz
-/authors/id/A/AD/ADAMK/Task-Weaken-1.04.tar.gz
-/authors/id/A/AD/ADAMK/Test-NoWarnings-1.02.tar.gz
-/authors/id/A/AD/ADAMK/Test-Object-0.07.tar.gz
-/authors/id/A/AD/ADAMK/Test-SubCalls-1.09.tar.gz
-/authors/id/A/AD/ADAMK/YAML-Tiny-1.48.tar.gz
-/authors/id/A/AD/ADIE/Test-Exception-0.31.tar.gz
-/authors/id/A/AL/ALEXP/Net-Domain-TLD-1.68.tar.gz
-/authors/id/A/AL/ALGDR/Lingua-Stem-Ru-0.01.tar.gz
-/authors/id/A/AN/ANDK/CPAN-Checksums-2.07.tar.gz
-/authors/id/A/AN/ANDYA/CGI-Simple-1.113.tar.gz
-/authors/id/A/AN/ANDYA/Test-Harness-3.23.tar.gz
-/authors/id/A/AR/ARJAY/Compress-Bzip2-2.09.tar.gz
-/authors/id/A/AS/ASKSH/Snowball-Norwegian-1.2.tar.gz
-/authors/id/A/AS/ASKSH/Snowball-Swedish-1.2.tar.gz
-/authors/id/A/AU/AUDREYT/Test-use-ok-0.02.tar.gz
-/authors/id/B/BD/BDFOY/CPAN-PackageDetails-0.25.tar.gz
-/authors/id/B/BD/BDFOY/ConfigReader-Simple-1.28.tar.gz
-/authors/id/B/BD/BDFOY/Distribution-Guess-BuildSystem-0.12.tar.gz
-/authors/id/B/BD/BDFOY/File-Find-Closures-1.09.tar.gz
-/authors/id/B/BD/BDFOY/Module-Extract-Namespaces-0.14.tar.gz
-/authors/id/B/BD/BDFOY/Module-Extract-Use-0.17.tar.gz
-/authors/id/B/BD/BDFOY/Module-Extract-VERSION-0.13.tar.gz
-/authors/id/B/BD/BDFOY/MyCPAN-App-DPAN-1.28.tar.gz
-/authors/id/B/BD/BDFOY/MyCPAN-Indexer-1.28.tar.gz
-/authors/id/B/BD/BDFOY/Test-Output-0.16.tar.gz
-/authors/id/B/BI/BINGOS/Archive-Tar-1.76.tar.gz
-/authors/id/B/BI/BINGOS/Module-CoreList-2.45.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Action-RenderView-0.16.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Authentication-Store-DBIx-Class-0.1401.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Devel-1.31.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Model-Adaptor-0.10.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Plugin-Authentication-0.10017.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Plugin-Session-0.31.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Plugin-Session-Store-Delegate-0.06.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Plugin-Unicode-0.93.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Plugin-Unicode-Encoding-1.1.tar.gz
-/authors/id/B/BO/BOBTFISH/Catalyst-Runtime-5.80032.tar.gz
-/authors/id/B/BO/BOBTFISH/CatalystX-Component-Traits-0.16.tar.gz
-/authors/id/B/BO/BOBTFISH/MooseX-Getopt-0.35.tar.gz
-/authors/id/B/BO/BOBTFISH/Test-WWW-Mechanize-Catalyst-0.53.tar.gz
-/authors/id/B/BO/BOBTFISH/namespace-autoclean-0.12.tar.gz
-/authors/id/B/BP/BPOWERS/Memoize-ExpireLRU-0.55.tar.gz
-/authors/id/B/BR/BRICAS/Catalyst-Plugin-ConfigLoader-0.30.tar.gz
-/authors/id/B/BR/BRICAS/Config-Any-0.20.tar.gz
-/authors/id/C/CH/CHOCOLATE/Scope-Guard-0.20.tar.gz
-/authors/id/C/CH/CHORNY/Hook-LexWrap-0.24.tar.gz
-/authors/id/C/CH/CHORNY/Test-Warn-0.23.tar.gz
-/authors/id/C/CH/CHORNY/Tie-IxHash-1.22.tar.gz
-/authors/id/C/CI/CINE/Lingua-Stem-Snowball-Da-1.01.tar.gz
-/authors/id/C/CK/CKRAS/DateTime-Format-HTTP-0.40.tar.gz
-/authors/id/C/CO/COGENT/Tree-DAG_Node-1.06.tar.gz
-/authors/id/C/CO/CORION/parent-0.225.tar.gz
-/authors/id/C/CR/CRENZ/Module-Find-0.10.tar.gz
-/authors/id/D/DA/DAGOLDEN/CPAN-Meta-2.110580.tar.gz
-/authors/id/D/DA/DAGOLDEN/CPAN-Meta-YAML-0.003.tar.gz
-/authors/id/D/DA/DAGOLDEN/ExtUtils-CBuilder-0.280202.tar.gz
-/authors/id/D/DA/DAGOLDEN/ExtUtils-ParseXS-2.2206.tar.gz
-/authors/id/D/DA/DAGOLDEN/Module-Build-0.3800.tar.gz
-/authors/id/D/DA/DAGOLDEN/Module-Metadata-1.000004.tar.gz
-/authors/id/D/DA/DAGOLDEN/Parse-CPAN-Meta-1.4401.tar.gz
-/authors/id/D/DA/DAGOLDEN/Perl-OSType-1.002.tar.gz
-/authors/id/D/DA/DAGOLDEN/Sub-Uplevel-0.22.tar.gz
-/authors/id/D/DC/DCANTRELL/CPAN-ParseDistribution-1.3.tar.gz
-/authors/id/D/DC/DCANTRELL/Data-Compare-1.22.tar.gz
-/authors/id/D/DC/DCONWAY/Lingua-EN-Inflect-1.893.tar.gz
-/authors/id/D/DL/DLAND/File-Path-2.08.tar.gz
-/authors/id/D/DL/DLUX/Parallel-ForkManager-0.7.9.tar.gz
-/authors/id/D/DM/DMAKI/DateTime-Format-Pg-0.16005.tar.gz
-/authors/id/D/DM/DMUEY/File-Copy-Recursive-0.38.tar.gz
-/authors/id/D/DM/DMUEY/Hash-Merge-0.12.tar.gz
-/authors/id/D/DO/DOY/Dist-CheckConflicts-0.02.tar.gz
-/authors/id/D/DO/DOY/Package-Stash-0.26.tar.gz
-/authors/id/D/DO/DOY/Package-Stash-XS-0.22.tar.gz
-/authors/id/D/DO/DOY/Try-Tiny-0.09.tar.gz
-/authors/id/D/DR/DROLSKY/Class-Factory-Util-1.7.tar.gz
-/authors/id/D/DR/DROLSKY/DateTime-0.70.tar.gz
-/authors/id/D/DR/DROLSKY/DateTime-Format-Builder-0.80.tar.gz
-/authors/id/D/DR/DROLSKY/DateTime-Format-Strptime-1.5000.tar.gz
-/authors/id/D/DR/DROLSKY/DateTime-Locale-0.45.tar.gz
-/authors/id/D/DR/DROLSKY/DateTime-TimeZone-1.34.tar.gz
-/authors/id/D/DR/DROLSKY/File-ChangeNotify-0.19.tar.gz
-/authors/id/D/DR/DROLSKY/File-Slurp-9999.13.tar.gz
-/authors/id/D/DR/DROLSKY/Moose-1.24.tar.gz
-/authors/id/D/DR/DROLSKY/MooseX-Params-Validate-0.16.tar.gz
-/authors/id/D/DR/DROLSKY/MooseX-SemiAffordanceAccessor-0.09.tar.gz
-/authors/id/D/DR/DROLSKY/MooseX-Types-0.25.tar.gz
-/authors/id/D/DR/DROLSKY/Package-DeprecationManager-0.10.tar.gz
-/authors/id/D/DR/DRTECH/Locale-Maketext-Lexicon-0.86.tar.gz
-/authors/id/F/FD/FDALY/Test-Tester-0.107.tar.gz
-/authors/id/F/FE/FERREIRA/Devel-Hide-0.0008.tar.gz
-/authors/id/F/FE/FERREIRA/Exporter-5.63.tar.gz
-/authors/id/F/FE/FERREIRA/Term-Size-Any-0.001.tar.gz
-/authors/id/F/FE/FERREIRA/Term-Size-Perl-0.029.tar.gz
-/authors/id/F/FL/FLORA/B-Hooks-EndOfScope-0.09.tar.gz
-/authors/id/F/FL/FLORA/Catalyst-Plugin-Session-Store-DBIC-0.11.tar.gz
-/authors/id/F/FL/FLORA/Class-C3-0.23.tar.gz
-/authors/id/F/FL/FLORA/Class-C3-Adopt-NEXT-0.13.tar.gz
-/authors/id/F/FL/FLORA/Class-MOP-1.12.tar.gz
-/authors/id/F/FL/FLORA/Data-Visitor-0.27.tar.gz
-/authors/id/F/FL/FLORA/Devel-GlobalDestruction-0.03.tar.gz
-/authors/id/F/FL/FLORA/HTTP-Request-AsCGI-1.2.tar.gz
-/authors/id/F/FL/FLORA/MRO-Compat-0.11.tar.gz
-/authors/id/F/FL/FLORA/MooseX-Emulate-Class-Accessor-Fast-0.00903.tar.gz
-/authors/id/F/FL/FLORA/MooseX-MethodAttributes-0.24.tar.gz
-/authors/id/F/FL/FLORA/MooseX-Role-WithOverloading-0.09.tar.gz
-/authors/id/F/FL/FLORA/Sub-Name-0.05.tar.gz
-/authors/id/F/FL/FLORA/namespace-clean-0.20.tar.gz
-/authors/id/F/FR/FREW/Data-Dumper-Concise-2.020.tar.gz
-/authors/id/F/FR/FREW/SQL-Abstract-1.72.tar.gz
-/authors/id/G/GA/GAAS/Data-Dump-1.19.tar.gz
-/authors/id/G/GA/GAAS/Digest-HMAC-1.02.tar.gz
-/authors/id/G/GA/GAAS/Encode-Locale-1.01.tar.gz
-/authors/id/G/GA/GAAS/File-Listing-6.00.tar.gz
-/authors/id/G/GA/GAAS/HTML-Form-6.00.tar.gz
-/authors/id/G/GA/GAAS/HTML-Parser-3.68.tar.gz
-/authors/id/G/GA/GAAS/HTTP-Cookies-6.00.tar.gz
-/authors/id/G/GA/GAAS/HTTP-Daemon-6.00.tar.gz
-/authors/id/G/GA/GAAS/HTTP-Date-6.00.tar.gz
-/authors/id/G/GA/GAAS/HTTP-Message-6.01.tar.gz
-/authors/id/G/GA/GAAS/HTTP-Negotiate-6.00.tar.gz
-/authors/id/G/GA/GAAS/IO-String-1.08.tar.gz
-/authors/id/G/GA/GAAS/LWP-MediaTypes-6.01.tar.gz
-/authors/id/G/GA/GAAS/Net-HTTP-6.00.tar.gz
-/authors/id/G/GA/GAAS/URI-1.58.tar.gz
-/authors/id/G/GA/GAAS/WWW-RobotRules-6.00.tar.gz
-/authors/id/G/GA/GAAS/libwww-perl-6.01.tar.gz
-/authors/id/G/GA/GAAS/libwww-perl-6.02.tar.gz
-/authors/id/G/GB/GBARR/CPAN-DistnameInfo-0.12.tar.gz
-/authors/id/G/GB/GBARR/Scalar-List-Utils-1.23.tar.gz
-/authors/id/G/GE/GETTY/HTTP-Body-1.11.tar.gz
-/authors/id/G/GR/GRODITI/MooseX-Types-Common-0.001002.tar.gz
-/authors/id/G/GR/GROMMEL/Math-Round-0.06.tar.gz
-/authors/id/G/GW/GWILLIAMS/DateTime-Format-W3CDTF-0.06.tar.gz
-/authors/id/I/IL/ILMARI/Class-Unload-0.07.tar.gz
-/authors/id/I/IN/INGY/Spiffy-0.30.tar.gz
-/authors/id/I/IN/INGY/Test-Base-0.59.tar.gz
-/authors/id/J/JE/JESSE/HTTP-Server-Simple-0.43.tar.gz
-/authors/id/J/JE/JESSE/HTTP-Server-Simple-0.44.tar.gz
-/authors/id/J/JH/JHOBLITT/DateTime-Format-ISO8601-0.07.tar.gz
-/authors/id/J/JP/JPEACOCK/version-0.88.tar.gz
-/authors/id/J/JR/JROCKWAY/Context-Preserve-0.01.tar.gz
-/authors/id/J/JR/JROCKWAY/Template-Plugin-DateTime-Format-0.02.tar.gz
-/authors/id/K/KA/KASEI/Class-Accessor-0.34.tar.gz
-/authors/id/K/KW/KWILLIAMS/Path-Class-0.23.tar.gz
-/authors/id/K/KW/KWILLIAMS/Probe-Perl-0.01.tar.gz
-/authors/id/L/LB/LBROCARD/Data-Page-2.02.tar.gz
-/authors/id/M/MA/MAKAMAKA/JSON-2.51.tar.gz
-/authors/id/M/MA/MAKAMAKA/JSON-PP-2.27105.tar.gz
-/authors/id/M/MA/MANU/Net-IP-1.25.tar.gz
-/authors/id/M/MA/MARKOV/MIME-Types-1.31.tar.gz
-/authors/id/M/MA/MAUKE/Dir-Self-0.10.tar.gz
-/authors/id/M/MH/MHX/Devel-PPPort-3.19.tar.gz
-/authors/id/M/MI/MIROD/HTML-TreeBuilder-XPath-0.12.tar.gz
-/authors/id/M/MI/MIROD/XML-XPathEngine-0.12.tar.gz
-/authors/id/M/MI/MIYAGAWA/App-cpanminus-1.4004.tar.gz
-/authors/id/M/MI/MIYAGAWA/App-cpanminus-1.4007.tar.gz
-/authors/id/M/MI/MIYAGAWA/HTML-Selector-XPath-0.07.tar.gz
-/authors/id/M/MI/MIYAGAWA/Template-Plugin-Comma-0.04.tar.gz
-/authors/id/M/MI/MIYAGAWA/Web-Scraper-0.34.tar.gz
-/authors/id/M/ML/MLEHMANN/JSON-XS-2.3.tar.gz
-/authors/id/M/ML/MLEHMANN/common-sense-3.4.tar.gz
-/authors/id/M/MR/MRAMBERG/Text-SimpleTable-2.03.tar.gz
-/authors/id/M/MS/MSCHILLI/Log-Log4perl-1.32.tar.gz
-/authors/id/M/MS/MSCHWERN/Carp-Assert-0.20.tar.gz
-/authors/id/M/MS/MSCHWERN/ExtUtils-MakeMaker-6.56.tar.gz
-/authors/id/M/MS/MSCHWERN/Test-Simple-0.98.tar.gz
-/authors/id/M/MS/MSCHWERN/UNIVERSAL-require-0.13.tar.gz
-/authors/id/M/MS/MSTROUT/Catalyst-Plugin-Session-State-Cookie-0.17.tar.gz
-/authors/id/M/MS/MSTROUT/Catalyst-Plugin-Static-Simple-0.29.tar.gz
-/authors/id/N/NU/NUFFIN/Tie-ToObject-0.03.tar.gz
-/authors/id/O/OL/OLAF/Net-DNS-0.66.tar.gz
-/authors/id/O/OV/OVID/Sub-Override-0.08.tar.gz
-/authors/id/O/OV/OVID/aliased-0.30.tar.gz
-/authors/id/P/PE/PETDANCE/Carp-Assert-More-1.12.tar.gz
-/authors/id/P/PE/PETDANCE/Template-Timer-1.00.tar.gz
-/authors/id/P/PE/PETDANCE/Test-WWW-Mechanize-1.30.tar.gz
-/authors/id/P/PE/PETDANCE/WWW-Mechanize-1.66.tar.gz
-/authors/id/P/PM/PMQS/Compress-Raw-Bzip2-2.033.tar.gz
-/authors/id/P/PM/PMQS/Compress-Raw-Zlib-2.033.tar.gz
-/authors/id/P/PM/PMQS/IO-Compress-2.033.tar.gz
-/authors/id/R/RC/RCLAMP/Class-Accessor-Chained-0.01.tar.gz
-/authors/id/R/RC/RCLAMP/Devel-Caller-2.05.tar.gz
-/authors/id/R/RC/RCLAMP/File-Find-Rule-0.32.tar.gz
-/authors/id/R/RC/RCLAMP/Number-Compare-0.01.tar.gz
-/authors/id/R/RC/RCLAMP/Text-Glob-0.09.tar.gz
-/authors/id/R/RD/RDF/Clone-0.31.tar.gz
-/authors/id/R/RG/RGARCIA/Sub-Identify-0.04.tar.gz
-/authors/id/R/RG/RGARCIA/Test-LongString-0.14.tar.gz
-/authors/id/R/RG/RGARCIA/Test-LongString-0.15.tar.gz
-/authors/id/R/RI/RIBASUSHI/Class-C3-Componentised-1.0008.tar.gz
-/authors/id/R/RJ/RJBS/Data-OptList-0.106.tar.gz
-/authors/id/R/RJ/RJBS/Email-Address-1.892.tar.gz
-/authors/id/R/RJ/RJBS/Email-Date-Format-1.002.tar.gz
-/authors/id/R/RJ/RJBS/Email-MIME-1.908.tar.gz
-/authors/id/R/RJ/RJBS/Email-MIME-ContentType-1.015.tar.gz
-/authors/id/R/RJ/RJBS/Email-MIME-Encodings-1.313.tar.gz
-/authors/id/R/RJ/RJBS/Email-MessageID-1.402.tar.gz
-/authors/id/R/RJ/RJBS/Email-Send-2.198.tar.gz
-/authors/id/R/RJ/RJBS/Email-Simple-2.100.tar.gz
-/authors/id/R/RJ/RJBS/Email-Valid-0.184.tar.gz
-/authors/id/R/RJ/RJBS/Getopt-Long-Descriptive-0.089.tar.gz
-/authors/id/R/RJ/RJBS/Return-Value-1.666001.tar.gz
-/authors/id/R/RJ/RJBS/String-RewritePrefix-0.006.tar.gz
-/authors/id/R/RJ/RJBS/Sub-Exporter-0.982.tar.gz
-/authors/id/R/RJ/RJBS/Sub-Install-0.925.tar.gz
-/authors/id/R/RJ/RJBS/Test-Deep-0.108.tar.gz
-/authors/id/R/RJ/RJBS/Test-Fatal-0.003.tar.gz
-/authors/id/R/RJ/RJBS/Version-Requirements-0.101020.tar.gz
-/authors/id/R/RK/RKITOVER/Catalyst-Model-DBIC-Schema-0.48.tar.gz
-/authors/id/R/RK/RKITOVER/Catalyst-Plugin-SmartURI-0.036.tar.gz
-/authors/id/R/RK/RKITOVER/Class-Accessor-Grouped-0.10002.tar.gz
-/authors/id/R/RK/RKITOVER/DBIx-Class-Schema-Loader-0.07010.tar.gz
-/authors/id/R/RK/RKITOVER/Lingua-EN-Inflect-Phrase-0.04.tar.gz
-/authors/id/R/RK/RKITOVER/MooseX-Traits-Pluggable-0.10.tar.gz
-/authors/id/R/RK/RKITOVER/URI-SmartURI-0.031.tar.gz
-/authors/id/R/RO/ROBIN/PadWalker-1.92.tar.gz
-/authors/id/R/RO/ROODE/Readonly-1.03.tar.gz
-/authors/id/R/RS/RSCHUPP/Module-ScanDeps-1.00.tar.gz
-/authors/id/S/SA/SALVA/Sort-Key-1.28.tar.gz
-/authors/id/S/SA/SARTAK/Class-Load-0.06.tar.gz
-/authors/id/S/SD/SDP/Lingua-Stem-Fr-0.02.tar.gz
-/authors/id/S/SI/SIMON/Lingua-EN-Inflect-Number-1.1.tar.gz
-/authors/id/S/SI/SIMONW/Module-Pluggable-3.9.tar.gz
-/authors/id/S/SM/SMUELLER/Class-XSAccessor-1.11.tar.gz
-/authors/id/S/SM/SMUELLER/PAR-Dist-0.47.tar.gz
-/authors/id/S/SM/SMUELLER/PathTools-3.33.tar.gz
-/authors/id/S/SN/SNOWHARE/Lingua-Stem-0.84.tar.gz
-/authors/id/S/ST/STBEY/Carp-Clan-6.04.tar.gz
-/authors/id/S/ST/STEVAN/Tree-Simple-1.18.tar.gz
-/authors/id/S/ST/STEVAN/Tree-Simple-VisitorFactory-0.10.tar.gz
-/authors/id/T/TI/TIMB/DBI-1.616.tar.gz
-/authors/id/T/TJ/TJENNESS/File-Temp-0.22.tar.gz
-/authors/id/T/TL/TLINDEN/Config-General-2.50.tar.gz
-/authors/id/T/TM/TMTM/Class-Data-Inheritable-0.08.tar.gz
-/authors/id/T/TO/TODDR/Locale-Maketext-1.19.tar.gz
-/authors/id/T/TO/TOKUHIROM/Test-Requires-0.06.tar.gz
-/authors/id/T/TU/TURNSTEP/DBD-Pg-2.17.2.tar.gz
-/authors/id/T/TU/TURNSTEP/DBD-Pg-2.18.1.tar.gz
-/authors/id/U/UL/ULPFR/Text-German-0.06.tar.gz
-/authors/id/V/VP/VPIT/Variable-Magic-0.46.tar.gz
-/authors/id/W/WR/WREIS/DBIx-Class-EncodedColumn-0.00011.tar.gz
-/authors/id/X/XE/XERN/Lingua-PT-Stemmer-0.01.tar.gz
-/authors/id/Y/YV/YVES/ExtUtils-Install-1.54.tar.gz
-/authors/id/Z/ZE/ZEFRAM/Class-Mix-0.004.tar.gz
-/authors/id/Z/ZE/ZEFRAM/Crypt-Eksblowfish-0.009.tar.gz
-/authors/id/Z/ZE/ZEFRAM/Params-Classify-0.013.tar.gz
diff --git a/perl-external/lib/perl5/local/lib.pm b/perl-external/lib/perl5/local/lib.pm
deleted file mode 100644
index 87d186903..000000000
--- a/perl-external/lib/perl5/local/lib.pm
+++ /dev/null
@@ -1,1030 +0,0 @@
-use strict;
-use warnings;
-
-package local::lib;
-
-use 5.008001; # probably works with earlier versions but I'm not supporting them
- # (patches would, of course, be welcome)
-
-use File::Spec ();
-use File::Path ();
-use Carp ();
-use Config;
-
-our $VERSION = '1.008004'; # 1.8.4
-
-our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all);
-
-sub DEACTIVATE_ONE () { 1 }
-sub DEACTIVATE_ALL () { 2 }
-
-sub INTERPOLATE_ENV () { 1 }
-sub LITERAL_ENV () { 0 }
-
-sub import {
- my ($class, @args) = @_;
-
- # Remember what PERL5LIB was when we started
- my $perl5lib = $ENV{PERL5LIB} || '';
-
- my %arg_store;
- for my $arg (@args) {
- # check for lethal dash first to stop processing before causing problems
- if ($arg =~ /−/) {
- die <<'DEATH';
-WHOA THERE! It looks like you've got some fancy dashes in your commandline!
-These are *not* the traditional -- dashes that software recognizes. You
-probably got these by copy-pasting from the perldoc for this module as
-rendered by a UTF8-capable formatter. This most typically happens on an OS X
-terminal, but can happen elsewhere too. Please try again after replacing the
-dashes with normal minus signs.
-DEATH
- }
- elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
- (my $flag = $arg) =~ s/--//;
- $arg_store{$flag} = 1;
- }
- elsif($arg =~ /^--/) {
- die "Unknown import argument: $arg";
- }
- else {
- # assume that what's left is a path
- $arg_store{path} = $arg;
- }
- }
-
- if($arg_store{'self-contained'}) {
- die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n";
- }
-
- my $deactivating = 0;
- if ($arg_store{deactivate}) {
- $deactivating = DEACTIVATE_ONE;
- }
- if ($arg_store{'deactivate-all'}) {
- $deactivating = DEACTIVATE_ALL;
- }
-
- $arg_store{path} = $class->resolve_path($arg_store{path});
- $class->setup_local_lib_for($arg_store{path}, $deactivating);
-
- for (@INC) { # Untaint @INC
- next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
- m/(.*)/ and $_ = $1;
- }
-}
-
-sub pipeline;
-
-sub pipeline {
- my @methods = @_;
- my $last = pop(@methods);
- if (@methods) {
- \sub {
- my ($obj, @args) = @_;
- $obj->${pipeline @methods}(
- $obj->$last(@args)
- );
- };
- } else {
- \sub {
- shift->$last(@_);
- };
- }
-}
-
-=begin testing
-
-#:: test pipeline
-
-package local::lib;
-
-{ package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
-my $foo = bless({}, 'Foo');
-Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
-
-=end testing
-
-=cut
-
-sub _uniq {
- my %seen;
- grep { ! $seen{$_}++ } @_;
-}
-
-sub resolve_path {
- my ($class, $path) = @_;
- $class->${pipeline qw(
- resolve_relative_path
- resolve_home_path
- resolve_empty_path
- )}($path);
-}
-
-sub resolve_empty_path {
- my ($class, $path) = @_;
- if (defined $path) {
- $path;
- } else {
- '~/perl5';
- }
-}
-
-=begin testing
-
-#:: test classmethod setup
-
-my $c = 'local::lib';
-
-=end testing
-
-=begin testing
-
-#:: test classmethod
-
-is($c->resolve_empty_path, '~/perl5');
-is($c->resolve_empty_path('foo'), 'foo');
-
-=end testing
-
-=cut
-
-sub resolve_home_path {
- my ($class, $path) = @_;
- return $path unless ($path =~ /^~/);
- my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
- my $tried_file_homedir;
- my $homedir = do {
- if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
- $tried_file_homedir = 1;
- if (defined $user) {
- File::HomeDir->users_home($user);
- } else {
- File::HomeDir->my_home;
- }
- } else {
- if (defined $user) {
- (getpwnam $user)[7];
- } else {
- if (defined $ENV{HOME}) {
- $ENV{HOME};
- } else {
- (getpwuid $<)[7];
- }
- }
- }
- };
- unless (defined $homedir) {
- Carp::croak(
- "Couldn't resolve homedir for "
- .(defined $user ? $user : 'current user')
- .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
- );
- }
- $path =~ s/^~[^\/]*/$homedir/;
- $path;
-}
-
-sub resolve_relative_path {
- my ($class, $path) = @_;
- $path = File::Spec->rel2abs($path);
-}
-
-=begin testing
-
-#:: test classmethod
-
-local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; };
-is($c->resolve_relative_path('bar'),'FOObar');
-
-=end testing
-
-=cut
-
-sub setup_local_lib_for {
- my ($class, $path, $deactivating) = @_;
-
- my $interpolate = LITERAL_ENV;
- my @active_lls = $class->active_paths;
-
- $path = $class->ensure_dir_structure_for($path);
-
- if (! $deactivating) {
- if (@active_lls && $active_lls[-1] eq $path) {
- exit 0 if $0 eq '-';
- return; # Asked to add what's already at the top of the stack
- } elsif (grep { $_ eq $path} @active_lls) {
- # Asked to add a dir that's lower in the stack -- so we remove it from
- # where it is, and then add it back at the top.
- $class->setup_env_hash_for($path, DEACTIVATE_ONE);
- # Which means we can no longer output "PERL5LIB=...:$PERL5LIB" stuff
- # anymore because we're taking something *out*.
- $interpolate = INTERPOLATE_ENV;
- }
- }
-
- if ($0 eq '-') {
- $class->print_environment_vars_for($path, $deactivating, $interpolate);
- exit 0;
- } else {
- $class->setup_env_hash_for($path, $deactivating);
- @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC);
- }
-}
-
-sub install_base_bin_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'bin');
-}
-
-sub install_base_perl_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'lib', 'perl5');
-}
-
-sub install_base_arch_path {
- my ($class, $path) = @_;
- File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
-}
-
-sub ensure_dir_structure_for {
- my ($class, $path) = @_;
- unless (-d $path) {
- warn "Attempting to create directory ${path}\n";
- }
- File::Path::mkpath($path);
- # Need to have the path exist to make a short name for it, so
- # converting to a short name here.
- $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
-
- return $path;
-}
-
-sub guess_shelltype {
- my $shellbin = 'sh';
- if(defined $ENV{'SHELL'}) {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
- $shellbin = $shell_bin_path_parts[-1];
- }
- my $shelltype = do {
- local $_ = $shellbin;
- if(/csh/) {
- 'csh'
- } else {
- 'bourne'
- }
- };
-
- # Both Win32 and Cygwin have $ENV{COMSPEC} set.
- if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
- $shellbin = $shell_bin_path_parts[-1];
- $shelltype = do {
- local $_ = $shellbin;
- if(/command\.com/) {
- 'win32'
- } elsif(/cmd\.exe/) {
- 'win32'
- } elsif(/4nt\.exe/) {
- 'win32'
- } else {
- $shelltype
- }
- };
- }
- return $shelltype;
-}
-
-sub print_environment_vars_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
- print $class->environment_vars_string_for($path, $deactivating, $interpolate);
-}
-
-sub environment_vars_string_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
- my @envs = $class->build_environment_vars_for($path, $deactivating, $interpolate);
- my $out = '';
-
- # rather basic csh detection, goes on the assumption that something won't
- # call itself csh unless it really is. also, default to bourne in the
- # pathological situation where a user doesn't have $ENV{SHELL} defined.
- # note also that shells with funny names, like zoid, are assumed to be
- # bourne.
-
- my $shelltype = $class->guess_shelltype;
-
- while (@envs) {
- my ($name, $value) = (shift(@envs), shift(@envs));
- $value =~ s/(\\")/\\$1/g if defined $value;
- $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
- }
- return $out;
-}
-
-# simple routines that take two arguments: an %ENV key and a value. return
-# strings that are suitable for passing directly to the relevant shell to set
-# said key to said value.
-sub build_bourne_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{export ${name}="${value}";\n} : qq{unset ${name};\n};
-}
-
-sub build_csh_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n};
-}
-
-sub build_win32_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{set ${name}=${value}\n} : qq{set ${name}=\n};
-}
-
-sub setup_env_hash_for {
- my ($class, $path, $deactivating) = @_;
- my %envs = $class->build_environment_vars_for($path, $deactivating, INTERPOLATE_ENV);
- @ENV{keys %envs} = values %envs;
-}
-
-sub build_environment_vars_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
-
- if ($deactivating == DEACTIVATE_ONE) {
- return $class->build_deactivate_environment_vars_for($path, $interpolate);
- } elsif ($deactivating == DEACTIVATE_ALL) {
- return $class->build_deact_all_environment_vars_for($path, $interpolate);
- } else {
- return $class->build_activate_environment_vars_for($path, $interpolate);
- }
-}
-
-sub build_activate_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
- return (
- PERL_LOCAL_LIB_ROOT => join($Config{path_sep},
- (($ENV{PERL_LOCAL_LIB_ROOT}||()) ?
- ($interpolate == INTERPOLATE_ENV
- ? ($ENV{PERL_LOCAL_LIB_ROOT}||())
- : (($^O ne 'MSWin32') ? '$PERL_LOCAL_LIB_ROOT'
- : '%PERL_LOCAL_LIB_ROOT%' ))
- : ()),
- $path
- ),
- PERL_MB_OPT => "--install_base ${path}",
- PERL_MM_OPT => "INSTALL_BASE=${path}",
- PERL5LIB => join($Config{path_sep},
- $class->install_base_arch_path($path),
- $class->install_base_perl_path($path),
- (($ENV{PERL5LIB}||()) ?
- ($interpolate == INTERPOLATE_ENV
- ? ($ENV{PERL5LIB})
- : (($^O ne 'MSWin32') ? '$PERL5LIB' : '%PERL5LIB%' ))
- : ())
- ),
- PATH => join($Config{path_sep},
- $class->install_base_bin_path($path),
- ($interpolate == INTERPOLATE_ENV
- ? ($ENV{PATH}||())
- : (($^O ne 'MSWin32') ? '$PATH' : '%PATH%' ))
- ),
- )
-}
-
-sub active_paths {
- my ($class) = @_;
-
- return () unless defined $ENV{PERL_LOCAL_LIB_ROOT};
- return split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT};
-}
-
-sub build_deactivate_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
-
- my @active_lls = $class->active_paths;
-
- if (!grep { $_ eq $path } @active_lls) {
- warn "Tried to deactivate inactive local::lib '$path'\n";
- return ();
- }
-
- my @new_ll_root = grep { $_ ne $path } @active_lls;
- my @new_perl5lib = grep {
- $_ ne $class->install_base_arch_path($path) &&
- $_ ne $class->install_base_perl_path($path)
- } split /\Q$Config{path_sep}/, $ENV{PERL5LIB};
-
- my %env = (
- PERL_LOCAL_LIB_ROOT => (@new_ll_root ?
- join($Config{path_sep}, @new_ll_root) : undef
- ),
- PERL5LIB => (@new_perl5lib ?
- join($Config{path_sep}, @new_perl5lib) : undef
- ),
- PATH => join($Config{path_sep},
- grep { $_ ne $class->install_base_bin_path($path) }
- split /\Q$Config{path_sep}/, $ENV{PATH}
- ),
- );
-
- # If removing ourselves from the "top of the stack", set install paths to
- # correspond with the new top of stack.
- if ($active_lls[-1] eq $path) {
- if (@active_lls > 1) {
- my $new_top = $active_lls[-2];
- %env = (%env,
- PERL_MB_OPT => "--install_base ${new_top}",
- PERL_MM_OPT => "INSTALL_BASE=${new_top}",
- );
- } else {
- %env = (%env,
- PERL_MB_OPT => undef,
- PERL_MM_OPT => undef,
- );
- }
- }
-
- return %env;
-}
-
-sub build_deact_all_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
-
- my @active_lls = $class->active_paths;
-
- my @new_perl5lib = split /\Q$Config{path_sep}/, $ENV{PERL5LIB};
- my @new_path = split /\Q$Config{path_sep}/, $ENV{PATH};
-
- for my $path (@active_lls) {
- @new_perl5lib = grep {
- $_ ne $class->install_base_arch_path($path) &&
- $_ ne $class->install_base_perl_path($path)
- } @new_perl5lib;
-
- @new_path = grep {
- $_ ne $class->install_base_bin_path($path)
- } @new_path;
- }
-
- my %env = (
- PERL_LOCAL_LIB_ROOT => undef,
- PERL_MM_OPT => undef,
- PERL_MB_OPT => undef,
- PERL5LIB => (@new_perl5lib ?
- join($Config{path_sep}, @new_perl5lib) : undef
- ),
- PATH => join($Config{path_sep}, @new_path),
- );
-
- return %env;
-}
-
-=begin testing
-
-#:: test classmethod
-
-File::Path::rmtree('t/var/splat');
-
-$c->ensure_dir_structure_for('t/var/splat');
-
-ok(-d 't/var/splat');
-
-=end testing
-
-=encoding utf8
-
-=head1 NAME
-
-local::lib - create and use a local lib/ for perl modules with PERL5LIB
-
-=head1 SYNOPSIS
-
-In code -
-
- use local::lib; # sets up a local lib at ~/perl5
-
- use local::lib '~/foo'; # same, but ~/foo
-
- # Or...
- use FindBin;
- use local::lib "$FindBin::Bin/../support"; # app-local support library
-
-From the shell -
-
- # Install LWP and its missing dependencies to the '~/perl5' directory
- perl -MCPAN -Mlocal::lib -e 'CPAN::install(LWP)'
-
- # Just print out useful shell commands
- $ perl -Mlocal::lib
- export PERL_MB_OPT='--install_base /home/username/perl5'
- export PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'
- export PERL5LIB='/home/username/perl5/lib/perl5/i386-linux:/home/username/perl5/lib/perl5'
- export PATH="/home/username/perl5/bin:$PATH"
-
-=head2 The bootstrapping technique
-
-A typical way to install local::lib is using what is known as the
-"bootstrapping" technique. You would do this if your system administrator
-hasn't already installed local::lib. In this case, you'll need to install
-local::lib in your home directory.
-
-If you do have administrative privileges, you will still want to set up your
-environment variables, as discussed in step 4. Without this, you would still
-install the modules into the system CPAN installation and also your Perl scripts
-will not use the lib/ path you bootstrapped with local::lib.
-
-By default local::lib installs itself and the CPAN modules into ~/perl5.
-
-Windows users must also see L</Differences when using this module under Win32>.
-
-1. Download and unpack the local::lib tarball from CPAN (search for "Download"
-on the CPAN page about local::lib). Do this as an ordinary user, not as root
-or administrator. Unpack the file in your home directory or in any other
-convenient location.
-
-2. Run this:
-
- perl Makefile.PL --bootstrap
-
-If the system asks you whether it should automatically configure as much
-as possible, you would typically answer yes.
-
-In order to install local::lib into a directory other than the default, you need
-to specify the name of the directory when you call bootstrap, as follows:
-
- perl Makefile.PL --bootstrap=~/foo
-
-3. Run this: (local::lib assumes you have make installed on your system)
-
- make test && make install
-
-4. Now we need to setup the appropriate environment variables, so that Perl
-starts using our newly generated lib/ directory. If you are using bash or
-any other Bourne shells, you can add this to your shell startup script this
-way:
-
- echo 'eval $(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)' >>~/.bashrc
-
-If you are using C shell, you can do this as follows:
-
- /bin/csh
- echo $SHELL
- /bin/csh
- perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc
-
-If you passed to bootstrap a directory other than default, you also need to give that as
-import parameter to the call of the local::lib module like this way:
-
- echo 'eval $(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)' >>~/.bashrc
-
-After writing your shell configuration file, be sure to re-read it to get the
-changed settings into your current shell's environment. Bourne shells use
-C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>.
-
-If you're on a slower machine, or are operating under draconian disk space
-limitations, you can disable the automatic generation of manpages from POD when
-installing modules by using the C<--no-manpages> argument when bootstrapping:
-
- perl Makefile.PL --bootstrap --no-manpages
-
-To avoid doing several bootstrap for several Perl module environments on the
-same account, for example if you use it for several different deployed
-applications independently, you can use one bootstrapped local::lib
-installation to install modules in different directories directly this way:
-
- cd ~/mydir1
- perl -Mlocal::lib=./
- eval $(perl -Mlocal::lib=./) ### To set the environment for this shell alone
- printenv ### You will see that ~/mydir1 is in the PERL5LIB
- perl -MCPAN -e install ... ### whatever modules you want
- cd ../mydir2
- ... REPEAT ...
-
-If you are working with several C<local::lib> environments, you may want to
-remove some of them from the current environment without disturbing the others.
-You can deactivate one environment like this (using bourne sh):
-
- eval $(perl -Mlocal::lib=--deactivate,~/path)
-
-which will generate and run the commands needed to remove C<~/path> from your
-various search paths. Whichever environment was B<activated most recently> will
-remain the target for module installations. That is, if you activate
-C<~/path_A> and then you activate C<~/path_B>, new modules you install will go
-in C<~/path_B>. If you deactivate C<~/path_B> then modules will be installed
-into C<~/pathA> -- but if you deactivate C<~/path_A> then they will still be
-installed in C<~/pathB> because pathB was activated later.
-
-You can also ask C<local::lib> to clean itself completely out of the current
-shell's environment with the C<--deactivate-all> option.
-For multiple environments for multiple apps you may need to include a modified
-version of the C<< use FindBin >> instructions in the "In code" sample above.
-If you did something like the above, you have a set of Perl modules at C<<
-~/mydir1/lib >>. If you have a script at C<< ~/mydir1/scripts/myscript.pl >>,
-you need to tell it where to find the modules you installed for it at C<<
-~/mydir1/lib >>.
-
-In C<< ~/mydir1/scripts/myscript.pl >>:
-
- use strict;
- use warnings;
- use local::lib "$FindBin::Bin/.."; ### points to ~/mydir1 and local::lib finds lib
- use lib "$FindBin::Bin/../lib"; ### points to ~/mydir1/lib
-
-Put this before any BEGIN { ... } blocks that require the modules you installed.
-
-=head2 Differences when using this module under Win32
-
-To set up the proper environment variables for your current session of
-C<CMD.exe>, you can use this:
-
- C:\>perl -Mlocal::lib
- set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5
- set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5
- set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5;C:\DOCUME~1\ADMINI~1\perl5\lib\perl5\MSWin32-x86-multi-thread
- set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH%
-
- ### To set the environment for this shell alone
- C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\temp.bat
- ### instead of $(perl -Mlocal::lib=./)
-
-If you want the environment entries to persist, you'll need to add then to the
-Control Panel's System applet yourself or use L<App::local::lib::Win32Helper>.
-
-The "~" is translated to the user's profile directory (the directory named for
-the user under "Documents and Settings" (Windows XP or earlier) or "Users"
-(Windows Vista or later)) unless $ENV{HOME} exists. After that, the home
-directory is translated to a short name (which means the directory must exist)
-and the subdirectories are created.
-
-=head1 RATIONALE
-
-The version of a Perl package on your machine is not always the version you
-need. Obviously, the best thing to do would be to update to the version you
-need. However, you might be in a situation where you're prevented from doing
-this. Perhaps you don't have system administrator privileges; or perhaps you
-are using a package management system such as Debian, and nobody has yet gotten
-around to packaging up the version you need.
-
-local::lib solves this problem by allowing you to create your own directory of
-Perl packages downloaded from CPAN (in a multi-user system, this would typically
-be within your own home directory). The existing system Perl installation is
-not affected; you simply invoke Perl with special options so that Perl uses the
-packages in your own local package directory rather than the system packages.
-local::lib arranges things so that your locally installed version of the Perl
-packages takes precedence over the system installation.
-
-If you are using a package management system (such as Debian), you don't need to
-worry about Debian and CPAN stepping on each other's toes. Your local version
-of the packages will be written to an entirely separate directory from those
-installed by Debian.
-
-=head1 DESCRIPTION
-
-This module provides a quick, convenient way of bootstrapping a user-local Perl
-module library located within the user's home directory. It also constructs and
-prints out for the user the list of environment variables using the syntax
-appropriate for the user's current shell (as specified by the C<SHELL>
-environment variable), suitable for directly adding to one's shell
-configuration file.
-
-More generally, local::lib allows for the bootstrapping and usage of a
-directory containing Perl modules outside of Perl's C<@INC>. This makes it
-easier to ship an application with an app-specific copy of a Perl module, or
-collection of modules. Useful in cases like when an upstream maintainer hasn't
-applied a patch to a module of theirs that you need for your application.
-
-On import, local::lib sets the following environment variables to appropriate
-values:
-
-=over 4
-
-=item PERL_MB_OPT
-
-=item PERL_MM_OPT
-
-=item PERL5LIB
-
-=item PATH
-
-PATH is appended to, rather than clobbered.
-
-=back
-
-These values are then available for reference by any code after import.
-
-=head1 CREATING A SELF-CONTAINED SET OF MODULES
-
-See L<lib::core::only> for one way to do this - but note that
-there are a number of caveats, and the best approach is always to perform a
-build against a clean perl (i.e. site and vendor as close to empty as possible).
-
-=head1 OPTIONS
-
-Options are values that can be passed to the C<local::lib> import besides the
-directory to use. They are specified as C<use local::lib '--option'[, path];>
-or C<perl -Mlocal::lib=--option[,path]>.
-
-=head2 --deactivate
-
-Remove the chosen path (or the default path) from the module search paths if it
-was added by C<local::lib>, instead of adding it.
-
-=head2 --deactivate-all
-
-Remove all directories that were added to search paths by C<local::lib> from the
-search paths.
-
-=head1 METHODS
-
-=head2 ensure_dir_structure_for
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: None
-
-=back
-
-Attempts to create the given path, and all required parent directories. Throws
-an exception on failure.
-
-=head2 print_environment_vars_for
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: None
-
-=back
-
-Prints to standard output the variables listed above, properly set to use the
-given path as the base directory.
-
-=head2 build_environment_vars_for
-
-=over 4
-
-=item Arguments: $path, $interpolate
-
-=item Return value: \%environment_vars
-
-=back
-
-Returns a hash with the variables listed above, properly set to use the
-given path as the base directory.
-
-=head2 setup_env_hash_for
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: None
-
-=back
-
-Constructs the C<%ENV> keys for the given path, by calling
-L</build_environment_vars_for>.
-
-=head2 active_paths
-
-=over 4
-
-=item Arguments: None
-
-=item Return value: @paths
-
-=back
-
-Returns a list of active C<local::lib> paths, according to the
-C<PERL_LOCAL_LIB_ROOT> environment variable.
-
-=head2 install_base_perl_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $install_base_perl_path
-
-=back
-
-Returns a path describing where to install the Perl modules for this local
-library installation. Appends the directories C<lib> and C<perl5> to the given
-path.
-
-=head2 install_base_arch_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $install_base_arch_path
-
-=back
-
-Returns a path describing where to install the architecture-specific Perl
-modules for this local library installation. Based on the
-L</install_base_perl_path> method's return value, and appends the value of
-C<$Config{archname}>.
-
-=head2 install_base_bin_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $install_base_bin_path
-
-=back
-
-Returns a path describing where to install the executable programs for this
-local library installation. Based on the L</install_base_perl_path> method's
-return value, and appends the directory C<bin>.
-
-=head2 resolve_empty_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $base_path
-
-=back
-
-Builds and returns the base path into which to set up the local module
-installation. Defaults to C<~/perl5>.
-
-=head2 resolve_home_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $home_path
-
-=back
-
-Attempts to find the user's home directory. If installed, uses C<File::HomeDir>
-for this purpose. If no definite answer is available, throws an exception.
-
-=head2 resolve_relative_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $absolute_path
-
-=back
-
-Translates the given path into an absolute path.
-
-=head2 resolve_path
-
-=over 4
-
-=item Arguments: $path
-
-=item Return value: $absolute_path
-
-=back
-
-Calls the following in a pipeline, passing the result from the previous to the
-next, in an attempt to find where to configure the environment for a local
-library installation: L</resolve_empty_path>, L</resolve_home_path>,
-L</resolve_relative_path>. Passes the given path argument to
-L</resolve_empty_path> which then returns a result that is passed to
-L</resolve_home_path>, which then has its result passed to
-L</resolve_relative_path>. The result of this final call is returned from
-L</resolve_path>.
-
-=head1 A WARNING ABOUT UNINST=1
-
-Be careful about using local::lib in combination with "make install UNINST=1".
-The idea of this feature is that will uninstall an old version of a module
-before installing a new one. However it lacks a safety check that the old
-version and the new version will go in the same directory. Used in combination
-with local::lib, you can potentially delete a globally accessible version of a
-module while installing the new version in a local place. Only combine "make
-install UNINST=1" and local::lib if you understand these possible consequences.
-
-=head1 LIMITATIONS
-
-The perl toolchain is unable to handle directory names with spaces in it,
-so you cant put your local::lib bootstrap into a directory with spaces. What
-you can do is moving your local::lib to a directory with spaces B<after> you
-installed all modules inside your local::lib bootstrap. But be aware that you
-cant update or install CPAN modules after the move.
-
-Rather basic shell detection. Right now anything with csh in its name is
-assumed to be a C shell or something compatible, and everything else is assumed
-to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is
-not set, a Bourne-compatible shell is assumed.
-
-Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you
-have CPANPLUS installed.
-
-Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT.
-
-Should probably auto-fixup CPAN config if not already done.
-
-Patches very much welcome for any of the above.
-
-On Win32 systems, does not have a way to write the created environment variables
-to the registry, so that they can persist through a reboot.
-
-=head1 TROUBLESHOOTING
-
-If you've configured local::lib to install CPAN modules somewhere in to your
-home directory, and at some point later you try to install a module with C<cpan
--i Foo::Bar>, but it fails with an error like: C<Warning: You do not have
-permissions to install into /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux at
-/usr/lib64/perl5/5.8.8/Foo/Bar.pm> and buried within the install log is an
-error saying C<'INSTALL_BASE' is not a known MakeMaker parameter name>, then
-you've somehow lost your updated ExtUtils::MakeMaker module.
-
-To remedy this situation, rerun the bootstrapping procedure documented above.
-
-Then, run C<rm -r ~/.cpan/build/Foo-Bar*>
-
-Finally, re-run C<cpan -i Foo::Bar> and it should install without problems.
-
-=head1 ENVIRONMENT
-
-=over 4
-
-=item SHELL
-
-=item COMSPEC
-
-local::lib looks at the user's C<SHELL> environment variable when printing out
-commands to add to the shell configuration file.
-
-On Win32 systems, C<COMSPEC> is also examined.
-
-=back
-
-=head1 SUPPORT
-
-IRC:
-
- Join #local-lib on irc.perl.org.
-
-=head1 AUTHOR
-
-Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/
-
-auto_install fixes kindly sponsored by http://www.takkle.com/
-
-=head1 CONTRIBUTORS
-
-Patches to correctly output commands for csh style shells, as well as some
-documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
-
-Doc patches for a custom local::lib directory, more cleanups in the english
-documentation and a L<german documentation|POD2::DE::local::lib> contributed by Torsten Raudssus
-<torsten@raudssus.de>.
-
-Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring
-things will install properly, submitted a fix for the bug causing problems with
-writing Makefiles during bootstrapping, contributed an example program, and
-submitted yet another fix to ensure that local::lib can install and bootstrap
-properly. Many, many thanks!
-
-pattern of Freenode IRC contributed the beginnings of the Troubleshooting
-section. Many thanks!
-
-Patch to add Win32 support contributed by Curtis Jewell <csjewell@cpan.org>.
-
-Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced
-by a patch from Marco Emilio Poleggi.
-
-Mark Stosberg <mark@summersault.com> provided the code for the now deleted
-'--self-contained' option.
-
-Documentation patches to make win32 usage clearer by
-David Mertens <dcmertens.perl@gmail.com> (run4flat).
-
-Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc patches contributed by Breno
-G. de Oliveira <garu@cpan.org>.
-
-Improvements to stacking multiple local::lib dirs and removing them from the
-environment later on contributed by Andrew Rodland <arodland@cpan.org>.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2007 - 2010 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as
-listed above.
-
-=head1 LICENSE
-
-This library is free software and may be distributed under the same terms
-as perl itself.
-
-=cut
-
-1;
diff --git a/perl-external/minicpan/.gitignore b/perl-external/minicpan/.gitignore
deleted file mode 100644
index 40c08735d..000000000
--- a/perl-external/minicpan/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-authors
-modules/remote_packages.txt.gz
-indexer_reports
diff --git a/perl-external/minicpan/modules/02packages.details.txt.gz b/perl-external/minicpan/modules/02packages.details.txt.gz
deleted file mode 100644
index dda827b07..000000000
--- a/perl-external/minicpan/modules/02packages.details.txt.gz
+++ /dev/null
Binary files differ
diff --git a/perl-external/minicpan/modules/03modlist.data.gz b/perl-external/minicpan/modules/03modlist.data.gz
deleted file mode 100644
index 9c8cc712e..000000000
--- a/perl-external/minicpan/modules/03modlist.data.gz
+++ /dev/null
Binary files differ
diff --git a/perl-external/modules.txt b/perl-external/modules.txt
deleted file mode 100644
index 5ad9b477c..000000000
--- a/perl-external/modules.txt
+++ /dev/null
@@ -1,62 +0,0 @@
-App::cpanminus
-Bundle::DBD::Pg
-CPAN::ParseDistribution
-Catalyst
-Catalyst::Action::RenderView
-Catalyst::Authentication::Store::DBIx::Class
-Catalyst::Devel
-Catalyst::Model::Adaptor
-Catalyst::Plugin::Authentication
-Catalyst::Plugin::ConfigLoader
-Catalyst::Plugin::Session::Store::DBIC
-Catalyst::Plugin::SmartURI
-Catalyst::Plugin::Static::Simple
-Catalyst::Plugin::Unicode
-Catalyst::Plugin::Unicode::Encoding
-Catalyst::Runtime
-Catalyst::View::TT
-Class::Accessor
-Class::Unload
-Config::General
-Crypt::Eksblowfish::Bcrypt
-DBIx::Class
-DBIx::Class::EncodedColumn
-DBIx::Class::EncodedColumn::Crypt::Eksblowfish::Bcrypt
-DBIx::Class::FilterColumn
-DBIx::Class::Schema::Loader
-DBIx::Class::Storage::DBI
-DateTime::Format::HTTP
-DateTime::Format::ISO8601
-DateTime::Format::Pg
-DateTime::Format::W3CDTF
-Email::Address
-Email::MIME
-Email::Send
-Email::Simple
-Email::Valid
-File::Path
-HTML::Entities
-HTML::Form
-HTTP::Server::Simple
-HTTP::Server::Simple::CGI
-IO::String
-JSON
-LWP::UserAgent
-Locale::Maketext::Lexicon
-Moose
-Net::Domain::TLD
-Path::Class
-Readonly
-Return::Value
-Sort::Key
-Spiffy
-Sub::Override
-Template::Plugin::Comma
-Template::Plugin::DateTime::Format
-Term::Size::Any
-Test::More
-Test::WWW::Mechanize
-Test::WWW::Mechanize::Catalyst
-URI
-Web::Scraper
-namespace::autoclean
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-26 18:57:42 +0000