diff options
Diffstat (limited to 'perl-external')
| -rw-r--r-- | perl-external/.gitignore | 1 | ||||
| -rwxr-xr-x | perl-external/bin/cpanm | 5748 | ||||
| -rwxr-xr-x | perl-external/bin/module-manage.pl | 265 | ||||
| -rw-r--r-- | perl-external/files.txt | 261 | ||||
| -rw-r--r-- | perl-external/lib/perl5/local/lib.pm | 1030 | ||||
| -rw-r--r-- | perl-external/minicpan/.gitignore | 3 | ||||
| -rw-r--r-- | perl-external/minicpan/modules/02packages.details.txt.gz | bin | 20439 -> 0 bytes | |||
| -rw-r--r-- | perl-external/minicpan/modules/03modlist.data.gz | bin | 222 -> 0 bytes | |||
| -rw-r--r-- | perl-external/modules.txt | 62 |
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 Binary files differdeleted file mode 100644 index dda827b07..000000000 --- a/perl-external/minicpan/modules/02packages.details.txt.gz +++ /dev/null diff --git a/perl-external/minicpan/modules/03modlist.data.gz b/perl-external/minicpan/modules/03modlist.data.gz Binary files differdeleted file mode 100644 index 9c8cc712e..000000000 --- a/perl-external/minicpan/modules/03modlist.data.gz +++ /dev/null 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 |