cpanm

#!/usr/bin/env perl
#
# 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.1004";
  
  =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.
  
  Why? It's dependency free, requires zero configuration, and stands
  alone. When running, it requires only 10MB of RAM.
  
  =head1 INSTALLATION
  
  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.
  
  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 might need the C<--sudo> option.
  
  Later you can say C<cpanm --self-upgrade --sudo> to upgrade to the
  latest version.
  
  Otherwise,
  
      cd ~/bin
      wget http://xrl.us/cpanm
      chmod +x cpanm
      # edit shebang if you don't have /usr/bin/env
  
  just works, but be sure to grab the new version manually when you
  upgrade (C<--self-upgrade> might not work).
  
  =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, I have no intention to dis CPAN or CPANPLUS
  developers. Don't get me wrong. They're 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 the site L<http://search.cpan.org/>. I've been talking to and working with
  with the QA/toolchain people for building a more reliable CPAN DB website.
  
  Fetched files are unpacked in C<~/.cpanm>.  You can configure 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<MODULEBUILDRC>). So if
  you're using local::lib, then it installs to your local perl5
  directory. Otherwise it installs to the siteperl directory.
  
  cpanminus at a boot time checks whether you have configured local::lib, or have
  the permission to install modules to the sitelib 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.
  
  =head1 COPYRIGHT
  
  Copyright 2010- Tatsuhiko Miyagawa
  
  The standalone executable contains the following modules embedded.
  
  =over 4
  
  =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
  
  =item L<local::lib> Copyright 2007-2009 Matt S Trout
  
  =item L<HTTP::Lite> Copyright 2000-2002 Roy Hopper, 2009 Adam Kennedy
  
  =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
  
  =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::Path ();
  use File::Spec ();
  use File::Copy ();
  use Getopt::Long ();
  use Parse::CPAN::Meta;
  
  use constant WIN32 => $^O eq 'MSWin32';
  use constant SUNOS => $^O eq 'solaris';
  
  our $VERSION = "1.1004";
  $VERSION = eval $VERSION;
  
  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 => 1,
          skip_installed => 1,
          auto_cleanup => 7, # days
          @_,
      }, $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, @_;
  
      if ($0 ne '-' && !-t STDIN){ # e.g. $ cpanm < author/requires.cpanm
          push @ARGV, $self->load_argv_from_fh(\*STDIN);
      }
  
      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 },
          '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},
      );
  
      $self->{argv} = \@ARGV;
  }
  
  sub check_libs {
      my $self = shift;
      return if $self->{_checked}++;
  
      $self->bootstrap_local_lib;
      if (@{$self->{bootstrap_deps} || []}) {
          local $self->{force} = 1; # to force install EUMM
          $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}};
  
      $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;
      }
  
      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}: $!";
      print $out "cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n";
      print $out "Work directory is $self->{base}\n";
  }
  
  sub fetch_meta {
      my($self, $dist) = @_;
  
      unless ($self->{mirror_only}) {
          my $meta_yml = $self->get("http://cpansearch.perl.org/src/$dist->{cpanid}/$dist->{distvname}/META.yml");
          return $self->parse_meta_string($meta_yml);
      }
  
      return undef;
  }
  
  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 {
              unless (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->{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 all 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) = @_;
  
      my @inc = map { qq('$_') } (@$inc, '.'); # . for inc/Module/Install.pm
  
      open my $out, ">$self->{base}/DumpedINC.pm" or die $!;
      local $" = ",";
      print $out "BEGIN { \@INC = (@inc) }\n1;\n";
  }
  
  sub _import_local_lib {
      my($self, @args) = @_;
      local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
      local::lib->import(@args);
  }
  
  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);
              $self->{search_inc} = [ @inc ];
          }
          $self->_import_local_lib($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.28; # TODO: 0.36 or later for MYMETA.yml once we do --bootstrap command
  }
  
  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->{quiet} || !$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) = @_;
      chomp $msg;
      if ($self->{in_progress}) {
          $self->_diag("FAIL\n");
          $self->{in_progress} = 0;
      }
  
      if ($msg) {
          $self->_diag("! $msg\n");
          $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 = shift;
      print STDERR @_ if $self->{verbose} or !$self->{quiet};
  }
  
  sub diag {
      my($self, $msg) = @_;
      $self->_diag($msg);
      $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} = $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;
  
      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};
      local $ENV{AUTOMATED_TESTING} = 1;
  
      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");
          return;
      }
  
      if ($dist->{distvname} && $self->{seen}{$dist->{distvname}}++) {
          $self->chat("Already tried $dist->{distvname}. Skipping.\n");
          return 1;
      }
  
      if ($dist->{source} eq 'cpan') {
          $dist->{meta} = $self->fetch_meta($dist);
      }
  
      if ($self->{cmd} eq 'info') {
          print $dist->{cpanid}, "/", $dist->{filename}, "\n";
          return 1;
      }
  
      $self->check_libs;
  
      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");
              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}");
          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 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;
  
          my $dir = $self->unpack($file);
          next unless $dir; # unpack failed
  
          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 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;
      $self->{local_versions}{$mod} = $version;
  
      if ($self->is_deprecated($meta)){
          return 0, $version;
      } elsif (!$want_ver or $version >= Module::Metadata::Version->new($want_ver)) {
          return 1, $version;
      } 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;
  
      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.");
              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');
      }
  
      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->{meta});
  
      my $distname = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;
  
      $self->install_deps_bailout($distname, $dist->{dir}, $depth, @deps)
          or return;
  
      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 _) {
          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
          $self->build([ $self->{perl}, "./Build" ], $distname) &&
          $self->test([ $self->{perl}, "./Build", "test" ], $distname) &&
          $self->install([ $self->{perl}, "./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.");
          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");
          return 1;
      } else {
          my $msg = "Building $distname failed";
          $self->diag_fail("Installing $stuff failed. See $self->{log} for details.");
          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 $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}, @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, $meta) = @_;
  
      my @deps;
      if (-e 'MYMETA.yml') {
          $self->chat("Checking dependencies from MYMETA.yml ...\n");
          my $mymeta = $self->parse_meta('MYMETA.yml');
          @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;
              }
          }
      }
  
      # No need to remove, but this gets in the way of signature testing :/
      unlink 'MYMETA.yml';
  
      return @deps;
  }
  
  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 DESTROY {
      my $self = shift;
      $self->{at_exit}->($self) if $self->{at_exit};
  }
  
  # Utils
  
  sub shell_quote {
      my($self, $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 redirect { $_[0]->{_backends}{redirect}->(@_) };
  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;
          };
          $self->{_backends}{redirect} = sub {
              my $self = shift;
              my $res  = $ua->(max_redirect => 1)->simple_request(HTTP::Request->new(GET => $_[0]));
              return $res->header('Location') if $res->is_redirect;
              return;
          };
      } 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:/+!/!;
              my $q = $self->{verbose} ? '' : '-q';
              open my $fh, "$wget $uri $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:/+!/!;
              my $q = $self->{verbose} ? '' : '-q';
              system "$wget --retry-connrefused $uri $q -O $path";
          };
          $self->{_backends}{redirect} = sub {
              my($self, $uri) = @_;
              my $out = `$wget --max-redirect=0 $uri 2>&1`;
              if ($out =~ /^Location: (\S+)/m) {
                  return $1;
              }
              return;
          };
      } 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:/+!/!;
              my $q = $self->{verbose} ? '' : '-s';
              open my $fh, "$curl -L $q $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:/+!/!;
              my $q = $self->{verbose} ? '' : '-s';
              system "$curl -L $uri $q -# -o $path";
          };
          $self->{_backends}{redirect} = sub {
              my($self, $uri) = @_;
              my $out = `$curl -I -s $uri 2>&1`;
              if ($out =~ /^Location: (\S+)/m) {
                  return $1;
              }
              return;
          };
      } else {
          require HTTP::Lite;
          $self->chat("Falling back to HTTP::Lite $HTTP::Lite::VERSION\n");
          my $http_cb = sub {
              my($uri, $redir, $cb_gen) = @_;
  
              my $http = HTTP::Lite->new;
  
              my($data_cb, $done_cb) = $cb_gen ? $cb_gen->() : ();
              my $req = $http->request($uri, $data_cb);
              $done_cb->($req) if $done_cb;
  
              my $redir_count;
              while ($req == 302 or $req == 301)  {
                  last if $redir_count++ > 5;
                  my $loc;
                  for ($http->headers_array) {
                      /Location: (\S+)/ and $loc = $1, last;
                  }
                  $loc or last;
                  if ($loc =~ m!^/!) {
                      $uri =~ s!^(\w+?://[^/]+)/.*$!$1!;
                      $uri .= $loc;
                  } else {
                      $uri = $loc;
                  }
  
                  return $uri if $redir;
  
                  my($data_cb, $done_cb) = $cb_gen ? $cb_gen->() : ();
                  $req = $http->request($uri, $data_cb);
                  $done_cb->($req) if $done_cb;
              }
  
              return if $redir;
              return ($http, $req);
          };
  
          $self->{_backends}{get} = sub {
              my($self, $uri) = @_;
              return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
              my($http, $req) = $http_cb->($uri);
              return $http->body;
          };
  
          $self->{_backends}{mirror} = sub {
              my($self, $uri, $path) = @_;
              return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;
  
              my($http, $req) = $http_cb->($uri, undef, sub {
                  open my $out, ">$path" or die "$path: $!";
                  binmode $out;
                  sub { print $out ${$_[1]} }, sub { close $out };
              });
  
              return $req;
          };
  
          $self->{_backends}{redirect} = sub {
              my($self, $uri) = @_;
              return $http_cb->($uri, 1);
          };
      }
  
      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{^(.+?)/.*$}{$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 parse_meta {
      my($self, $file) = @_;
      return eval { (Parse::CPAN::Meta::LoadFile($file))[0] } || {};
  }
  
  sub parse_meta_string {
      my($self, $yaml) = @_;
      return eval { (Parse::CPAN::Meta::Load($yaml))[0] } || {};
  }
  
  1;
APP_CPANMINUS_SCRIPT

$fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
  
  package CPAN::DistnameInfo;
  
  $VERSION = "0.10";
  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//;
    }
  
    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__
  
  =head1 NAME
  
  CPAN::DistnameInfo - Extract distribution name and version from a distribution filename
  
  =head1 SYNOPSIS
  
    my $pathname = "authors/id/G/GB/GBARR/CPAN-DistnameInfo-0.02.tar.gz";
  
    my $d = CPAN::DistnameInfo->new($pathname);
  
    my $dist      = $d->dist;      # "CPAN-DistnameInfo"
    my $version   = $d->version;   # "0.02"
    my $maturity  = $d->maturity;  # "released"
    my $filename  = $d->filename;  # "CPAN-DistnameInfo-0.02.tar.gz"
    my $cpanid    = $d->cpanid;    # "GBARR"
    my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
    my $extension = $d->extension; # "tar.gz"
    my $pathname  = $d->pathname;  # "authors/id/G/GB/GBARR/..."
  
    my %prop = $d->properties;
  
  =head1 DESCRIPTION
  
  Many online services that are centered around CPAN attempt to
  associate multiple uploads by extracting a distribution name from
  the filename of the upload. For most distributions this is easy as
  they have used ExtUtils::MakeMaker or Module::Build to create the
  distribution, which results in a uniform name. But sadly not all
  uploads are created in this way.
  
  C<CPAN::DistnameInfo> uses heuristics that have been learnt by
  L<http://search.cpan.org/> to extract the distribution name and
  version from filenames and also report if the version is to be
  treated as a developer release
  
  The constructor takes a single pathname, returning an object with the following methods
  
  =over
  
  =item cpanid
  
  If the path given looked like a CPAN authors directory path, then this will be the
  the CPAN id of the author.
  
  =item dist
  
  The name of the distribution
  
  =item distvname
  
  The file name with any suffix and leading directory names removed
  
  =item filename
  
  If the path given looked like a CPAN authors directory path, then this will be the
  path to the file relative to the detected CPAN author directory. Otherwise it is the path
  that was passed in.
  
  =item maturity
  
  The maturity of the distribution. This will be either C<released> or C<developer>
  
  =item extension
  
  The extension of the distribution, often used to denote the archive type (e.g. 'tar.gz')
  
  =item pathname
  
  The pathname that was passed to the constructor when creating the object.
  
  =item properties
  
  This will return a list of key-value pairs, suitable for assigning to a hash,
  for the known properties.
  
  =item version
  
  The extracted version
  
  =back
  
  =head1 AUTHOR
  
  Graham Barr <gbarr@pobox.com>
  
  =head1 COPYRIGHT 
  
  Copyright (c) 2003 Graham Barr. All rights reserved. This program is
  free software; you can redistribute it and/or modify it under the same
  terms as Perl itself.
  
  =cut
  
CPAN_DISTNAMEINFO

$fatpacked{"HTTP/Lite.pm"} = <<'HTTP_LITE';
  package HTTP::Lite;
  
  use 5.005;
  use strict;
  use Socket 1.3;
  use Fcntl;
  use Errno qw(EAGAIN);
  
  use vars qw($VERSION);
  BEGIN {
  	$VERSION = "2.2";
  }
  
  my $BLOCKSIZE = 65536;
  my $CRLF = "\r\n";
  my $URLENCODE_VALID = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-.";
  
  # Forward declarations
  sub prepare_post;
  sub http_write;
  sub http_readline;
  sub http_read;
  sub http_readbytes;
  
  # Prepare the urlencode validchars lookup hash
  my @urlencode_valid;
  foreach my $char (split('', $URLENCODE_VALID)) {
    $urlencode_valid[ord $char]=$char;
  }
  for (my $n=0;$n<255;$n++) {
    if (!defined($urlencode_valid[$n])) {
      $urlencode_valid[$n]=sprintf("%%%02X", $n);
    }
  }
  
  sub new 
  {
    my $self = {};
    bless $self;
    $self->initialize();
    return $self;
  }
  
  sub initialize
  {
    my $self = shift;
    $self->reset;
    $self->{timeout} = 120;
    $self->{HTTP11} = 0;
    $self->{DEBUG} = 0;
    $self->{header_at_once} = 0; 
    $self->{holdback} = 0;       # needed for http_write 
  }
  
  sub header_at_once
  {
    my $self=shift;
    $self->{header_at_once} = 1;
  }
  
  sub local_addr
  {
    my $self = shift;
    my $val = shift;
    my $oldval = $self->{'local_addr'};
    if (defined($val)) {
      $self->{'local_addr'} = $val;
    }
    return $oldval;
  }
  
  sub local_port
  {
    my $self = shift;
    my $val = shift;
    my $oldval = $self->{'local_port'};
    if (defined($val)) {
      $self->{'local_port'} = $val;
     }
    return $oldval;
  }
  
  sub method
  {
    my $self = shift;
    my $method = shift;
    $method = uc($method);
    $self->{method} = $method;
  }
  
  sub DEBUG
  {
    my $self = shift;
    if ($self->{DEBUG}) {
      print STDERR join(" ", @_),"\n";
    }
  }
  
  sub reset
  {
    my $self = shift;
    foreach my $var ("body", "request", "content", "status", "proxy",
      "proxyport", "resp-protocol", "error-message",  
      "resp-headers", "CBARGS", "callback_function", "callback_params")
    {
      $self->{$var} = undef;
    }
    $self->{HTTPReadBuffer} = "";
    $self->{method} = "GET";
    $self->{headers} = { 'user-agent' => "HTTP::Lite/$VERSION" };
    $self->{headermap} = { 'user-agent'  => 'User-Agent' };
  }
  
  
  # URL-encode data
  sub escape {
    my $toencode = shift;
    return join('', 
      map { $urlencode_valid[ord $_] } split('', $toencode));
  }
  
  sub set_callback {
    my ($self, $callback, @callbackparams) = @_;
    $self->{'callback_function'} = $callback;
    $self->{'callback_params'} = [ @callbackparams ];
  }
  
  sub request
  {
    my ($self, $url, $data_callback, $cbargs) = @_;
    
    my $method = $self->{method};
    if (defined($cbargs)) {
      $self->{CBARGS} = $cbargs;
    }
  
    my $callback_func = $self->{'callback_function'};
    my $callback_params = $self->{'callback_params'};
  
    # Parse URL 
    my ($protocol,$host,$junk,$port,$object) = 
      $url =~ m{^([^:/]+)://([^/:]*)(:(\d+))?(/.*)$};
  
    # Only HTTP is supported here
    if ($protocol ne "http")
    {
      warn "Only http is supported by HTTP::Lite";
      return undef;
    }
    
    # Setup the connection
    my $proto = getprotobyname('tcp');
    local *FH;
    socket(FH, PF_INET, SOCK_STREAM, $proto);
    $port = 80 if !$port;
  
    my $connecthost = $self->{'proxy'} || $host;
    $connecthost = $connecthost ? $connecthost : $host;
    my $connectport = $self->{'proxyport'} || $port;
    $connectport = $connectport ? $connectport : $port;
    my $addr = inet_aton($connecthost);
    if (!$addr) {
      close(FH);
      return undef;
    }
    if ($connecthost ne $host)
    {
      # if proxy active, use full URL as object to request
      $object = "$url";
    }
  
    # choose local port and address
    my $local_addr = INADDR_ANY; 
    my $local_port = "0";
    if (defined($self->{'local_addr'})) {
      $local_addr = $self->{'local_addr'};
      if ($local_addr eq "0.0.0.0" || $local_addr eq "0") {
        $local_addr = INADDR_ANY;
      } else {
        $local_addr = inet_aton($local_addr);
      }
    }
    if (defined($self->{'local_port'})) {
      $local_port = $self->{'local_port'};
    }
    my $paddr = pack_sockaddr_in($local_port, $local_addr); 
    bind(FH, $paddr) || return undef;  # Failing to bind is fatal.
  
    my $sin = sockaddr_in($connectport,$addr);
    connect(FH, $sin) || return undef;
    # Set nonblocking IO on the handle to allow timeouts
    if ( $^O ne "MSWin32" ) {
      fcntl(FH, F_SETFL, O_NONBLOCK);
    }
  
    if (defined($callback_func)) {
      &$callback_func($self, "connect", undef, @$callback_params);
    }  
  
    if ($self->{header_at_once}) {
      $self->{holdback} = 1;    # http_write should buffer only, no sending yet
    }
  
    # Start the request (HTTP/1.1 mode)
    if ($self->{HTTP11}) {
      $self->http_write(*FH, "$method $object HTTP/1.1$CRLF");
    } else {
      $self->http_write(*FH, "$method $object HTTP/1.0$CRLF");
    }
  
    # Add some required headers
    # we only support a single transaction per request in this version.
    $self->add_req_header("Connection", "close");    
    if ($port != 80) {
      $self->add_req_header("Host", "$host:$port");
    } else {
      $self->add_req_header("Host", $host);
    }
    if (!defined($self->get_req_header("Accept"))) {
      $self->add_req_header("Accept", "*/*");
    }
  
    if ($method eq 'POST') {
      $self->http_write(*FH, "Content-Type: application/x-www-form-urlencoded$CRLF");
    }
    
    # Purge a couple others
    $self->delete_req_header("Content-Type");
    $self->delete_req_header("Content-Length");
    
    # Output headers
    foreach my $header ($self->enum_req_headers())
    {
      my $value = $self->get_req_header($header);
      $self->http_write(*FH, $self->{headermap}{$header}.": ".$value."$CRLF");
    }
    
    my $content_length;
    if (defined($self->{content}))
    {
      $content_length = length($self->{content});
    }
    if (defined($callback_func)) {
      my $ncontent_length = &$callback_func($self, "content-length", undef, @$callback_params);
      if (defined($ncontent_length)) {
        $content_length = $ncontent_length;
      }
    }  
  
    if ($content_length) {
      $self->http_write(*FH, "Content-Length: $content_length$CRLF");
    }
    
    if (defined($callback_func)) {
      &$callback_func($self, "done-headers", undef, @$callback_params);
    }  
    # End of headers
    $self->http_write(*FH, "$CRLF");
    
    if ($self->{header_at_once}) {
      $self->{holdback} = 0; 
      $self->http_write(*FH, ""); # pseudocall to get http_write going
    }  
    
    my $content_out = 0;
    if (defined($callback_func)) {
      while (my $content = &$callback_func($self, "content", undef, @$callback_params)) {
        $self->http_write(*FH, $content);
        $content_out++;
      }
    } 
    
    # Output content, if any
    if (!$content_out && defined($self->{content}))
    {
      $self->http_write(*FH, $self->{content});
    }
    
    if (defined($callback_func)) {
      &$callback_func($self, "content-done", undef, @$callback_params);
    }  
  
  
    # Read response from server
    my $headmode=1;
    my $chunkmode=0;
    my $chunksize=0;
    my $chunklength=0;
    my $chunk;
    my $line = 0;
    my $data;
    while ($data = $self->http_read(*FH,$headmode,$chunkmode,$chunksize))
    {
      $self->{DEBUG} && $self->DEBUG("reading: $chunkmode, $chunksize, $chunklength, $headmode, ".
          length($self->{'body'}));
      if ($self->{DEBUG}) {
        foreach my $var ("body", "request", "content", "status", "proxy",
          "proxyport", "resp-protocol", "error-message", 
          "resp-headers", "CBARGS", "HTTPReadBuffer") 
        {
          $self->DEBUG("state $var ".length($self->{$var}));
        }
      }
      $line++;
      if ($line == 1)
      {
        my ($proto,$status,$message) = split(' ', $$data, 3);
        $self->{DEBUG} && $self->DEBUG("header $$data");
        $self->{status}=$status;
        $self->{'resp-protocol'}=$proto;
        $self->{'error-message'}=$message;
        next;
      } 
      if (($headmode || $chunkmode eq "entity-header") && $$data =~ /^[\r\n]*$/)
      {
        if ($chunkmode)
        {
          $chunkmode = 0;
        }
        $headmode = 0;
        
        # Check for Transfer-Encoding
        my $te = $self->get_header("Transfer-Encoding");
        if (defined($te)) {
          my $header = join(' ',@{$te});
          if ($header =~ /chunked/i)
          {
            $chunkmode = "chunksize";
          }
        }
        next;
      }
      if ($headmode || $chunkmode eq "entity-header")
      {
        my ($var,$datastr) = $$data =~ /^([^:]*):\s*(.*)$/;
        if (defined($var))
        {
          $datastr =~s/[\r\n]$//g;
          $var = lc($var);
          $var =~ s/^(.)/&upper($1)/ge;
          $var =~ s/(-.)/&upper($1)/ge;
          my $hr = ${$self->{'resp-headers'}}{$var};
          if (!ref($hr))
          {
            $hr = [ $datastr ];
          }
          else 
          {
            push @{ $hr }, $datastr;
          }
          ${$self->{'resp-headers'}}{$var} = $hr;
        }
      } elsif ($chunkmode)
      {
        if ($chunkmode eq "chunksize")
        {
          $chunksize = $$data;
          $chunksize =~ s/^\s*|;.*$//g;
          $chunksize =~ s/\s*$//g;
          my $cshx = $chunksize;
          if (length($chunksize) > 0) {
            # read another line
            if ($chunksize !~ /^[a-f0-9]+$/i) {
              $self->{DEBUG} && $self->DEBUG("chunksize not a hex string");
            }
            $chunksize = hex($chunksize);
            $self->{DEBUG} && $self->DEBUG("chunksize was $chunksize (HEX was $cshx)");
            if ($chunksize == 0)
            {
              $chunkmode = "entity-header";
            } else {
              $chunkmode = "chunk";
              $chunklength = 0;
            }
          } else {
            $self->{DEBUG} && $self->DEBUG("chunksize empty string, checking next line!");
          }
        } elsif ($chunkmode eq "chunk")
        {
          $chunk .= $$data;
          $chunklength += length($$data);
          if ($chunklength >= $chunksize)
          {
            $chunkmode = "chunksize";
            if ($chunklength > $chunksize)
            {
              $chunk = substr($chunk,0,$chunksize);
            } 
            elsif ($chunklength == $chunksize && $chunk !~ /$CRLF$/) 
            {
              # chunk data is exactly chunksize -- need CRLF still
              $chunkmode = "ignorecrlf";
            }
            $self->add_to_body(\$chunk, $data_callback);
            $chunk="";
            $chunklength = 0;
            $chunksize = "";
          } 
        } elsif ($chunkmode eq "ignorecrlf")
        {
          $chunkmode = "chunksize";
        }
      } else {
        $self->add_to_body($data, $data_callback);
      }
    }
    if (defined($callback_func)) {
      &$callback_func($self, "done", undef, @$callback_params);
    }
    close(FH);
    return $self->{status};
  }
  
  sub add_to_body
  {
    my $self = shift;
    my ($dataref, $data_callback) = @_;
    
    my $callback_func = $self->{'callback_function'};
    my $callback_params = $self->{'callback_params'};
  
    if (!defined($data_callback) && !defined($callback_func)) {
      $self->{DEBUG} && $self->DEBUG("no callback");
      $self->{'body'}.=$$dataref;
    } else {
      my $newdata;
      if (defined($callback_func)) {
        $newdata = &$callback_func($self, "data", $dataref, @$callback_params);
      } else {
        $newdata = &$data_callback($self, $dataref, $self->{CBARGS});
      }
      if ($self->{DEBUG}) {
        $self->DEBUG("callback got back a ".ref($newdata));
        if (ref($newdata) eq "SCALAR") {
          $self->DEBUG("callback got back ".length($$newdata)." bytes");
        }
      }
      if (defined($newdata) && ref($newdata) eq "SCALAR") {
        $self->{'body'} .= $$newdata;
      }
    }
  }
  
  sub add_req_header
  {
    my $self = shift;
    my ($header, $value) = @_;
    
    my $lcheader = lc($header);
    $self->{DEBUG} && $self->DEBUG("add_req_header $header $value");
    ${$self->{headers}}{$lcheader} = $value;
    ${$self->{headermap}}{$lcheader} = $header;
  }
  
  sub get_req_header
  {
    my $self = shift;
    my ($header) = @_;
    
    return $self->{headers}{lc($header)};
  }
  
  sub delete_req_header
  {
    my $self = shift;
    my ($header) = @_;
    
    my $exists;
    if ($exists=defined(${$self->{headers}}{lc($header)}))
    {
      delete ${$self->{headers}}{lc($header)};
      delete ${$self->{headermap}}{lc($header)};
    }
    return $exists;
  }
  
  sub enum_req_headers
  {
    my $self = shift;
    my ($header) = @_;
    
    my $exists;
    return keys %{$self->{headermap}};
  }
  
  sub body
  {
    my $self = shift;
    return $self->{'body'};
  }
  
  sub status
  {
    my $self = shift;
    return $self->{status};
  }
  
  sub protocol
  {
    my $self = shift;
    return $self->{'resp-protocol'};
  }
  
  sub status_message
  {
    my $self = shift;
    return $self->{'error-message'};
  }
  
  sub proxy
  {
    my $self = shift;
    my ($value) = @_;
    
    # Parse URL 
    my ($protocol,$host,$junk,$port,$object) = 
      $value =~ m{^(\S+)://([^/:]*)(:(\d+))?(/.*)$};
    if (!$host)
    {
      ($host,$port) = $value =~ /^([^:]+):(.*)$/;
    }
  
    $self->{'proxy'} = $host || $value;
    $self->{'proxyport'} = $port || 80;
  }
  
  sub headers_array
  {
    my $self = shift;
    
    my @array = ();
    
    foreach my $header (keys %{$self->{'resp-headers'}})
    {
      my $aref = ${$self->{'resp-headers'}}{$header};
      foreach my $value (@$aref)
      {
        push @array, "$header: $value";
      }
    }
    return @array;
  }
  
  sub headers_string
  {
    my $self = shift;
    
    my $string = "";
    
    foreach my $header (keys %{$self->{'resp-headers'}})
    {
      my $aref = ${$self->{'resp-headers'}}{$header};
      foreach my $value (@$aref)
      {
        $string .= "$header: $value\n";
      }
    }
    return $string;
  }
  
  sub get_header
  {
    my $self = shift;
    my $header = shift;
  
    return $self->{'resp-headers'}{$header};
  }
  
  sub http11_mode
  {
    my $self = shift;
    my $mode = shift;
  
    $self->{HTTP11} = $mode;
  }
  
  sub prepare_post
  {
    my $self = shift;
    my $varref = shift;
    
    my $body = "";
    while (my ($var,$value) = map { escape($_) } each %$varref)
    {
      if ($body)
      {
        $body .= "&$var=$value";
      } else {
        $body = "$var=$value";
      }
    }
    $self->{content} = $body;
    $self->{headers}{'Content-Type'} = "application/x-www-form-urlencoded"
      unless defined ($self->{headers}{'Content-Type'}) and 
      $self->{headers}{'Content-Type'};
    $self->{method} = "POST";
  }
  
  sub http_write
  {
    my $self = shift;
    my ($fh,$line) = @_;
  
    if ($self->{holdback}) {
       $self->{HTTPWriteBuffer} .= $line;
       return;
    } else {
       if (defined $self->{HTTPWriteBuffer}) {   # copy previously buffered, if any
           $line = $self->{HTTPWriteBuffer} . $line;
       }
    }
  
    my $size = length($line);
    my $bytes = syswrite($fh, $line, length($line) , 0 );  # please double check new length limit
                                                           # is this ok?
    while ( ($size - $bytes) > 0) {
      $bytes += syswrite($fh, $line, length($line)-$bytes, $bytes );  # also here
    }
  }
   
  sub http_read
  {
    my $self = shift;
    my ($fh,$headmode,$chunkmode,$chunksize) = @_;
  
    $self->{DEBUG} && $self->DEBUG("read handle=$fh, headm=$headmode, chunkm=$chunkmode, chunksize=$chunksize");
  
    my $res;
    if (($headmode == 0 && $chunkmode eq "0") || ($chunkmode eq "chunk")) {
      my $bytes_to_read = $chunkmode eq "chunk" ?
          ($chunksize < $BLOCKSIZE ? $chunksize : $BLOCKSIZE) :
          $BLOCKSIZE;
      $res = $self->http_readbytes($fh,$self->{timeout},$bytes_to_read);
    } else { 
      $res = $self->http_readline($fh,$self->{timeout});  
    }
    if ($res) {
      if ($self->{DEBUG}) {
        $self->DEBUG("read got ".length($$res)." bytes");
        my $str = $$res;
        $str =~ s{([\x00-\x1F\x7F-\xFF])}{.}g;
        $self->DEBUG("read: ".$str);
      }
    }
    return $res;
  }
  
  sub http_readline
  {
    my $self = shift;
    my ($fh, $timeout) = @_;
    my $EOL = "\n";
  
    $self->{DEBUG} && $self->DEBUG("readline handle=$fh, timeout=$timeout");
    
    # is there a line in the buffer yet?
    while ($self->{HTTPReadBuffer} !~ /$EOL/)
    {
      # nope -- wait for incoming data
      my ($inbuf,$bits,$chars) = ("","",0);
      vec($bits,fileno($fh),1)=1;
      my $nfound = select($bits, undef, $bits, $timeout);
      if ($nfound == 0)
      {
        # Timed out
        return undef;
      } else {
        # Get the data
        $chars = sysread($fh, $inbuf, $BLOCKSIZE);
        $self->{DEBUG} && $self->DEBUG("sysread $chars bytes");
      }
      # End of stream?
      if ($chars <= 0 && !$!{EAGAIN})
      {
        last;
      }
      # tag data onto end of buffer
      $self->{HTTPReadBuffer}.=$inbuf;
    }
    # get a single line from the buffer
    my $nlat = index($self->{HTTPReadBuffer}, $EOL);
    my $newline;
    my $oldline;
    if ($nlat > -1)
    {
      $newline = substr($self->{HTTPReadBuffer},0,$nlat+1);
      $oldline = substr($self->{HTTPReadBuffer},$nlat+1);
    } else {
      $newline = substr($self->{HTTPReadBuffer},0);
      $oldline = "";
    }
    # and update the buffer
    $self->{HTTPReadBuffer}=$oldline;
    return length($newline) ? \$newline : 0;
  }
  
  sub http_readbytes
  {
    my $self = shift;
    my ($fh, $timeout, $bytes) = @_;
    my $EOL = "\n";
  
    $self->{DEBUG} && $self->DEBUG("readbytes handle=$fh, timeout=$timeout, bytes=$bytes");
    
    # is there enough data in the buffer yet?
    while (length($self->{HTTPReadBuffer}) < $bytes)
    {
      # nope -- wait for incoming data
      my ($inbuf,$bits,$chars) = ("","",0);
      vec($bits,fileno($fh),1)=1;
      my $nfound = select($bits, undef, $bits, $timeout);
      if ($nfound == 0)
      {
        # Timed out
        return undef;
      } else {
        # Get the data
        $chars = sysread($fh, $inbuf, $BLOCKSIZE);
        $self->{DEBUG} && $self->DEBUG("sysread $chars bytes");
      }
      # End of stream?
      if ($chars <= 0 && !$!{EAGAIN})
      {
        last;
      }
      # tag data onto end of buffer
      $self->{HTTPReadBuffer}.=$inbuf;
    }
    my $newline;
    my $buflen;
    if (($buflen=length($self->{HTTPReadBuffer})) >= $bytes)
    {
      $newline = substr($self->{HTTPReadBuffer},0,$bytes+1);
      if ($bytes+1 < $buflen) {
        $self->{HTTPReadBuffer} = substr($self->{HTTPReadBuffer},$bytes+1);
      } else {
        $self->{HTTPReadBuffer} = "";
      }
    } else {
      $newline = substr($self->{HTTPReadBuffer},0);
      $self->{HTTPReadBuffer} = "";
    }
    return length($newline) ? \$newline : 0;
  }
  
  sub upper
  {
    my ($str) = @_;
    if (defined($str)) {
      return uc($str);
    } else {
      return undef;
    }
  }
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  HTTP::Lite - Lightweight HTTP implementation
  
  =head1 SYNOPSIS
  
      use HTTP::Lite;
      $http = new HTTP::Lite;
      $req = $http->request("http://www.cpan.org/") 
          or die "Unable to get document: $!";
      print $http->body();
  
  =head1 DESCRIPTION
  
      HTTP::Lite is a stand-alone lightweight HTTP/1.1 implementation
      for perl.  It is not intended as a replacement for the
      fully-features LWP module.  Instead, it is intended for use in
      situations where it is desirable to install the minimal number of
      modules to achieve HTTP support, or where LWP is not a good
      candidate due to CPU overhead, such as slower processors.
      HTTP::Lite is also significantly faster than LWP.
  
      HTTP::Lite is ideal for CGI (or mod_perl) programs or for bundling
      for redistribution with larger packages where only HTTP GET and
      POST functionality are necessary.
  
      HTTP::Lite supports basic POST and GET operations only.  As of
      0.2.1, HTTP::Lite supports HTTP/1.1 and is compliant with the Host
      header, necessary for name based virtual hosting.  Additionally,
      HTTP::Lite now supports Proxies.
  
      As of 2.0.0 HTTP::Lite now supports a callback to allow processing
      of request data as it arrives.  This is useful for handling very
      large files without consuming memory.
  
      If you require more functionality, such as FTP or HTTPS, please
      see libwwwperl (LWP).  LWP is a significantly better and more
      comprehensive package than HTTP::Lite, and should be used instead
      of HTTP::Lite whenever possible.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new
  
  This is the constructor for HTTP::Lite.  It presently takes no
  arguments.  A future version of HTTP::Lite might accept parameters.
  
  =back
  
  =head1 METHODS
  
  =over 4
  
  
  =item request ( $url, $data_callback, $cbargs )
  
  Initiates a request to the specified URL.
  
  Returns undef if an I/O error is encountered, otherwise the HTTP
  status code will be returned.  200 series status codes represent
  success, 300 represent temporary errors, 400 represent permanent
  errors, and 500 represent server errors.
  
  See F<http://www.w3.org/Protocols/HTTP/HTRESP.html> for detailled
  information about HTTP status codes.
  
  The $data_callback parameter, if used, is a way to filter the data as it is
  received or to handle large transfers.  It must be a function reference, and
  will be passed: a reference to the instance of the http request making the
  callback, a reference to the current block of data about to be added to the
  body, and the $cbargs parameter (which may be anything).  It must return
  either a reference to the data to add to the body of the document, or undef.
  
  If set_callback is used, $data_callback and $cbargs are not used.  $cbargs
  may be either a scalar or a reference.
  
  The data_callback is called as: 
    &$data_callback( $self, $dataref, $cbargs )
  
  An example use to save a document to file is:
  
    # Write the data to the filehandle $cbargs
    sub savetofile {
      my ($self,$phase,$dataref,$cbargs) = @_;
      print $cbargs $$dataref;
      return undef;
    }
  
    $url = "$testpath/bigbinary.dat";
    open OUT, ">bigbinary.dat";
    $res = $http->request($url, \&savetofile, OUT);
    close OUT;
  
  =item set_callback ( $functionref, $dataref )
  
  At various stages of the request, callbacks may be used to modify the
  behaviour or to monitor the status of the request.  These work like the
  $data_callback parameter to request(), but are more verstaile.  Using
  set_callback disables $data_callback in request()
  
  The callbacks are called as: 
    callback ( $self, $phase, $dataref, $cbargs )
  
  The current phases are:
  
    connect - connection has been established and headers are being
              transmitted.
              
    content-length - return value is used as the content-length.  If undef,
              and prepare_post() was used, the content length is
              calculated.
                     
    done-headers - all headers have been sent
    
    content - return value is used as content and is sent to client.  Return
              undef to use the internal content defined by prepare_post().
              
    content-done - content has been successfuly transmitted.
    
    data - A block of data has been received.  The data is referenced by
              $dataref.  The return value is dereferenced and replaces the
              content passed in.  Return undef to avoid using memory for large
              documents.
  
    done - Request is done.
  
  
  
  =item prepare_post ( $hashref )
  
  Takes a reference to a hashed array of post form variables to upload. 
  Create the HTTP body and sets the method to POST.
  
  =item http11_mode ( 0 | 1 )
  
  Turns on or off HTTP/1.1 support.  This is off by default due to
  broken HTTP/1.1 servers.  Use 1 to enable HTTP/1.1 support.
  
  =item add_req_header ( $header, $value )
  
  =item get_req_header ( $header )
  
  =item delete_req_header ( $header )
  
  Add, Delete, or a HTTP header(s) for the request.  These functions
  allow you to override any header.  Presently, Host, User-Agent,
  Content-Type, Accept, and Connection are pre-defined by the HTTP::Lite
  module.  You may not override Host, Connection, or Accept.
  
  To provide (proxy) authentication or authorization, you would use:
  
      use HTTP::Lite;
      use MIME::Base64;
      $http = new HTTP::Lite;
      $encoded = encode_base64('username:password');
      $http->add_req_header("Authorization", $encoded);
  
  B<NOTE>: The present implementation limits you to one instance
  of each header.
  
  =item body
  
  Returns the body of the document retured by the remote server.
  
  =item headers_array
  
  Returns an array of the HTTP headers returned by the remote
  server.
  
  =item headers_string
  
  Returns a string representation of the HTTP headers returned by
  the remote server.
  
  =item get_header ( $header )
  
  Returns an array of values for the requested header.  
  
  B<NOTE>: HTTP requests are not limited to a single instance of
  each header.  As a result, there may be more than one entry for
  every header.
  
  =item protocol
  
  Returns the HTTP protocol identifier, as reported by the remote
  server.  This will generally be either HTTP/1.0 or HTTP/1.1.
  
  =item proxy ( $proxy_server )
  
  The URL or hostname of the proxy to use for the next request.
  
  =item status
  
  Returns the HTTP status code returned by the server.  This is
  also reported as the return value of I<request()>.
  
  =item status_message
  
  Returns the textual description of the status code as returned
  by the server.  The status string is not required to adhere to
  any particular format, although most HTTP servers use a standard
  set of descriptions.
  
  =item reset
  
  You must call this prior to re-using an HTTP::Lite handle,
  otherwise the results are undefined.
  
  =item local_addr ( $ip )
  
  Explicity select the local IP address.  0.0.0.0 (default) lets the system
  choose.
  
  =item local_port ( $port )
  
  Explicity select the local port.  0 (default and reccomended) lets the
  system choose.
  
  =item method ( $method )
  
  Explicity set the method.  Using prepare_post or reset overrides this
  setting.  Usual choices are GET, POST, PUT, HEAD
  
  =back
  
  =head1 EXAMPLES
  
      # Get and print out the headers and body of the CPAN homepage
      use HTTP::Lite;
      $http = new HTTP::Lite;
      $req = $http->request("http://www.cpan.org/")
          or die "Unable to get document: $!";
      die "Request failed ($req): ".$http->status_message()
        if $req ne "200";
      @headers = $http->headers_array();
      $body = $http->body();
      foreach $header (@headers)
      {
        print "$header$CRLF";
      }
      print "$CRLF";
      print "$body$CRLF";
  
      # POST a query to the dejanews USENET search engine
      use HTTP::Lite;
      $http = new HTTP::Lite;
      %vars = (
               "QRY" => "perl",
               "ST" => "MS",
               "svcclass" => "dncurrent",
               "DBS" => "2"
              );
      $http->prepare_post(\%vars);
      $req = $http->request("http://www.deja.com/dnquery.xp")
        or die "Unable to get document: $!";
      print "req: $req\n";
      print $http->body();
  
  =head1 UNIMPLEMENTED
  
      - FTP 
      - HTTPS (SSL)
      - Authenitcation/Authorizaton/Proxy-Authorization
        are not directly supported, and require MIME::Base64.
      - Redirects (Location) are not automatically followed
      - multipart/form-data POSTs are not directly supported (necessary
        for File uploads).
      
  =head1 BUGS
  
      Some broken HTTP/1.1 servers send incorrect chunk sizes
      when transferring files.  HTTP/1.1 mode is now disabled by
      default.
  
  =head1 AUTHOR
  
  Roy Hooper <rhooper@thetoybox.org>
  
  =head1 SEE ALSO
  
  L<LWP>
  RFC 2068 - HTTP/1.1 -http://www.w3.org/
  
  =head1 COPYRIGHT
  
  Copyright (c) 2000-2002 Roy Hooper.  All rights reserved.
  
  Some parts copyright 2009 Adam Kennedy.
  
  This program is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
  
  =cut
HTTP_LITE

$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;
  
  # stolen from Module::Build::Version and ::Base - this is perl licensed code,
  # copyright them.
  
  # 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 = '0.36_04';
  $VERSION = eval $VERSION;
  
  use File::Spec;
  use IO::File;
  use Module::Metadata::Version;
  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 = Module::Metadata::Version->new($v1)
        unless UNIVERSAL::isa($v1,'Module::Metadata::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' ||
              ref $version eq 'Module::Metadata::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 Module::Metadata::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 $@;
  
    # Activestate apparently creates custom versions like '1.23_45_01', which
    # cause M::B::Version to think it's an invalid alpha.  So check for that
    # and strip them
    my $num_dots = () = $result =~ m{\.}g;
    my $num_unders = () = $result =~ m{_}g;
    if ( substr($result,0,1) ne 'v' && $num_dots < 2 && $num_unders > 1 ) {
      $result =~ s{_}{}g;
    }
  
    # Bless it into our own version class
    eval { $result = Module::Metadata::Version->new($result) };
    die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
      if $@;
  
    return $result;
  }
  }
  
  
  ############################################################
  
  # 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;
  
  __END__
  
  =for :stopwords ModuleInfo
  
  =head1 NAME
  
  ModuleInfo - Gather package and POD information from a perl module file
  
  
  =head1 DESCRIPTION
  
  =over 4
  
  =item new_from_file($filename, collect_pod => 1)
  
  Construct a C<ModuleInfo> object given the path to a file. Takes an optional
  argument C<collect_pod> which is a boolean that determines whether
  POD data is collected and stored for reference. POD data is not
  collected by default. POD headings are always collected.
  
  =item new_from_module($module, collect_pod => 1, inc => \@dirs)
  
  Construct a C<ModuleInfo> object given a module or package name. In addition
  to accepting the C<collect_pod> argument as described above, this
  method accepts a C<inc> argument which is a reference to an array of
  of directories to search for the module. If none are given, the
  default is @INC.
  
  =item name()
  
  Returns the name of the package represented by this module. If there
  are more than one packages, it makes a best guess based on the
  filename. If it's a script (i.e. not a *.pm) the package name is
  'main'.
  
  =item version($package)
  
  Returns the version as defined by the $VERSION variable for the
  package as returned by the C<name> method if no arguments are
  given. If given the name of a package it will attempt to return the
  version of that package if it is specified in the file.
  
  =item filename()
  
  Returns the absolute path to the file.
  
  =item packages_inside()
  
  Returns a list of packages.
  
  =item pod_inside()
  
  Returns a list of POD sections.
  
  =item contains_pod()
  
  Returns true if there is any POD in the file.
  
  =item pod($section)
  
  Returns the POD data in the given section.
  
  =item find_module_by_name($module, \@dirs)
  
  Returns the path to a module given the module or package name. A list
  of directories can be passed in as an optional parameter, otherwise
  @INC is searched.
  
  Can be called as either an object or a class method.
  
  =item find_module_dir_by_name($module, \@dirs)
  
  Returns the entry in C<@dirs> (or C<@INC> by default) that contains
  the module C<$module>. A list of directories can be passed in as an
  optional parameter, otherwise @INC is searched.
  
  Can be called as either an object or a class method.
  
  =back
  
  
  =head1 AUTHOR
  
  Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
  
  
  =head1 COPYRIGHT
  
  Copyright (c) 2001-2006 Ken Williams.  All rights reserved.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  
  =head1 SEE ALSO
  
  perl(1), L<Module::Metadata>(3)
  
  =cut
  
MODULE_METADATA

$fatpacked{"Module/Metadata/Version.pm"} = <<'MODULE_METADATA_VERSION';
  package Module::Metadata::Version;
  use strict;
  
  # stolen from Module::Build::Version - this is perl licensed code,
  # copyright them.
  
  use vars qw($VERSION);
  $VERSION = 0.77;
  
  eval "use version $VERSION";
  if ($@) { # can't locate version files, use our own
  
      # Avoid redefined warnings if an old version.pm was available
      delete $version::{$_} foreach keys %version::;
  
      # first we get the stub version module
      my $version;
      while (<DATA>) {
  	s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
  	$version .= $_ if $_;
  	last if /^1;$/;
      }
  
      # and now get the current version::vpp code
      my $vpp;
      while (<DATA>) {
  	s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
  	$vpp .= $_ if $_;
  	last if /^1;$/;
      }
  
      # but we eval them in reverse order since version depends on
      # version::vpp to already exist
      eval $vpp; die $@ if $@;
      $INC{'version/vpp.pm'} = 'inside Module::Metadata::Version';
      eval $version; die $@ if $@;
      $INC{'version.pm'} = 'inside Module::Metadata::Version';
  }
  
  # now we can safely subclass version, installed or not
  use vars qw(@ISA);
  @ISA = qw(version);
  
  1;
  __DATA__
  # stub version module to make everything else happy
  package version;
  
  use 5.005_04;
  use strict;
  
  use vars qw(@ISA $VERSION $CLASS *declare *qv);
  
  $VERSION = 0.77;
  
  $CLASS = 'version';
  
  push @ISA, "version::vpp";
  local $^W;
  *version::qv = \&version::vpp::qv;
  *version::declare = \&version::vpp::declare;
  *version::_VERSION = \&version::vpp::_VERSION;
  if ($] > 5.009001 && $] <= 5.010000) {
      no strict 'refs';
      *{'version::stringify'} = \*version::vpp::stringify;
      *{'version::(""'} = \*version::vpp::stringify;
      *{'version::new'} = \*version::vpp::new;
  }
  
  # 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;
      }
  }
  
  1;
  
  # replace everything from here to the end with the current version/vpp.pm
  package version::vpp;
  use strict;
  
  use POSIX qw/locale_h/;
  use locale;
  use vars qw ($VERSION @ISA @REGEXS);
  $VERSION = '0.77';
  $VERSION = eval $VERSION;
  
  push @REGEXS, qr/
  	^v?	# optional leading 'v'
  	(\d*)	# major revision not required
  	\.	# requires at least one decimal
  	(?:(\d+)\.?){1,}
  	/x;
  
  use overload (
      '""'       => \&stringify,
      '0+'       => \&numify,
      'cmp'      => \&vcmp,
      '<=>'      => \&vcmp,
      'bool'     => \&vbool,
      'nomethod' => \&vnoop,
  );
  
  my $VERSION_MAX = 0x7FFFFFFF;
  
  eval "use warnings";
  if ($@) {
      eval '
  	package warnings;
  	sub enabled {return $^W;}
  	1;
      ';
  }
  
  sub new
  {
  	my ($class, $value) = @_;
  	my $self = bless ({}, ref ($class) || $class);
  
  	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 = 'v'.$_[2];
  	}
  
  	$value = _un_vstring($value);
  
  	# exponential notation
  	if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
  	    $value = sprintf("%.9f",$value);
  	    $value =~ s/(0+)$//; # trim trailing zeros
  	}
  
  	# This is not very efficient, but it is morally equivalent
  	# to the XS code (as that is the reference implementation).
  	# See vutil/vutil.c for details
  	my $qv = 0;
  	my $alpha = 0;
  	my $width = 3;
  	my $saw_period = 0;
  	my $vinf = 0;
  	my ($start, $last, $pos, $s);
  	$s = 0;
  
  	while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
  	    $s++;
  	}
  
  	if (substr($value,$s,1) eq 'v') {
  	    $s++;    # get past 'v'
  	    $qv = 1; # force quoted version processing
  	}
  
  	$start = $last = $pos = $s;
  
  	# pre-scan the input string to check for decimals/underbars
  	while ( substr($value,$pos,1) =~ /[._\d,]/ ) {
  	    if ( substr($value,$pos,1) eq '.' ) {
  		if ($alpha) {
  		    Carp::croak("Invalid version format ".
  		      "(underscores before decimal)");
  		}
  		$saw_period++;
  		$last = $pos;
  	    }
  	    elsif ( substr($value,$pos,1) eq '_' ) {
  		if ($alpha) {
  		    require Carp;
  		    Carp::croak("Invalid version format ".
  			"(multiple underscores)");
  		}
  		$alpha = 1;
  		$width = $pos - $last - 1; # natural width of sub-version
  	    }
  	    elsif ( substr($value,$pos,1) eq ','
  		    and substr($value,$pos+1,1) =~ /[0-9]/ ) {
  		# looks like an unhandled locale
  		$saw_period++;
  		$last = $pos;
  	    }
  	    $pos++;
  	}
  
  	if ( $alpha && !$saw_period ) {
  	    require Carp;
  	    Carp::croak("Invalid version format ".
  		"(alpha without decimal)");
  	}
  
  	if ( $alpha && $saw_period && $width == 0 ) {
  	    require Carp;
  	    Carp::croak("Invalid version format ".
  		"(misplaced _ in number)");
  	}
  
  	if ( $saw_period > 1 ) {
  	    $qv = 1; # force quoted version processing
  	}
  
  	$last = $pos;
  	$pos = $s;
  
  	if ( $qv ) {
  	    $self->{qv} = 1;
  	}
  
  	if ( $alpha ) {
  	    $self->{alpha} = 1;
  	}
  
  	if ( !$qv && $width < 3 ) {
  	    $self->{width} = $width;
  	}
  
  	while ( substr($value,$pos,1) =~ /\d/ ) {
  	    $pos++;
  	}
  
  	if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
  	    my $rev;
  
  	    while (1) {
  		$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_period == 1 ) {
  			$mult *= 100;
  			while ( $s < $end ) {
  			    $orev = $rev;
  			    $rev += substr($value,$s,1) * $mult;
  			    $mult /= 10;
  			    if (   abs($orev) > abs($rev)
  				|| abs($rev) > abs($VERSION_MAX) ) {
  				if ( warnings::enabled("overflow") ) {
  				    require Carp;
  				    Carp::carp("Integer overflow in version");
  				}
  				$s = $end - 1;
  				$rev = $VERSION_MAX;
  			    }
  			    $s++;
  			    if ( substr($value,$s,1) eq '_' ) {
  				$s++;
  			    }
  			}
  		    }
  		    else {
  			while (--$end >= $s) {
  			    $orev = $rev;
  			    $rev += substr($value,$end,1) * $mult;
  			    $mult *= 10;
  			    if (   abs($orev) > abs($rev)
  				|| abs($rev) > abs($VERSION_MAX) ) {
  				if ( warnings::enabled("overflow") ) {
  				    require Carp;
  				    Carp::carp("Integer overflow in version");
  				}
  				$end = $s - 1;
  				$rev = $VERSION_MAX;
  			    }
  			}
  		    }
  		}
  
  		# Append revision
  		push @{$self->{version}}, $rev;
  		if ( substr($value,$pos,1) eq '.'
  		    && substr($value,$pos+1,1) =~ /\d/ ) {
  		    $s = ++$pos;
  		}
  		elsif ( substr($value,$pos,1) eq '_'
  		    && substr($value,$pos+1,1) =~ /\d/ ) {
  		    $s = ++$pos;
  		}
  		elsif ( substr($value,$pos,1) eq ','
  		    && substr($value,$pos+1,1) =~ /\d/ ) {
  		    $s = ++$pos;
  		}
  		elsif ( substr($value,$pos,1) =~ /\d/ ) {
  		    $s = $pos;
  		}
  		else {
  		    $s = $pos;
  		    last;
  		}
  		if ( $qv ) {
  		    while ( substr($value,$pos,1) =~ /\d/ ) {
  			$pos++;
  		    }
  		}
  		else {
  		    my $digits = 0;
  		    while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
  			if ( substr($value,$pos,1) ne '_' ) {
  			    $digits++;
  			}
  			$pos++;
  		    }
  		}
  	    }
  	}
  	if ( $qv ) { # quoted versions always get at least three terms
  	    my $len = scalar @{$self->{version}};
  	    $len = 3 - $len;
  	    while ($len-- > 0) {
  		push @{$self->{version}}, 0;
  	    }
  	}
  
  	if ( substr($value,$pos) ) { # any remaining text
  	    if ( warnings::enabled("misc") ) {
  		require Carp;
  		Carp::carp("Version string '$value' contains invalid data; ".
  		     "ignoring: '".substr($value,$pos)."'");
  	    }
  	}
  
  	# cache the original value for use when stringification
  	if ( $vinf ) {
  	    $self->{vinf} = 1;
  	    $self->{original} = 'v.Inf';
  	}
  	else {
  	    $self->{original} = substr($value,0,$pos);
  	}
  
  	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 _un_vstring {
      my $value = shift;
      # may be a v-string
      if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
  	my $tvalue = sprintf("v%vd",$value);
  	if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
  	    # must be a v-string
  	    $value = $tvalue;
  	}
      }
      return $value;
  }
  
  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
MODULE_METADATA_VERSION

$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__
  
  =pod
  
  =head1 NAME
  
  Parse::CPAN::Meta - Parse META.yml and other similar CPAN metadata files
  
  =head1 SYNOPSIS
  
      #############################################
      # In your file
      
      ---
      rootproperty: blah
      section:
        one: two
        three: four
        Foo: Bar
        empty: ~
      
      
      
      #############################################
      # In your program
      
      use Parse::CPAN::Meta;
      
      # Create a YAML file
      my @yaml = Parse::CPAN::Meta::LoadFile( 'Meta.yml' );
      
      # Reading properties
      my $root = $yaml[0]->{rootproperty};
      my $one  = $yaml[0]->{section}->{one};
      my $Foo  = $yaml[0]->{section}->{Foo};
  
  =head1 DESCRIPTION
  
  B<Parse::CPAN::Meta> is a parser for F<META.yml> files, based on the
  parser half of L<YAML::Tiny>.
  
  It supports a basic subset of the full YAML specification, enough to
  implement parsing of typical F<META.yml> files, and other similarly simple
  YAML files.
  
  If you need something with more power, move up to a full YAML parser such
  as L<YAML>, L<YAML::Syck> or L<YAML::LibYAML>.
  
  B<Parse::CPAN::Meta> provides a very simply API of only two functions,
  based on the YAML functions of the same name. Wherever possible,
  identical calling semantics are used.
  
  All error reporting is done with exceptions (die'ing).
  
  =head1 FUNCTIONS
  
  For maintenance clarity, no functions are exported.
  
  =head2 Load
  
    my @yaml = Load( $string );
  
  Parses a string containing a valid YAML stream into a list of Perl data
  structures.
  
  =head2 LoadFile
  
    my @yaml = LoadFile( 'META.yml' );
  
  Reads the YAML stream from a file instead of a string.
  
  =head1 SUPPORT
  
  Bugs should be reported via the CPAN bug tracker at
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
  L<http://use.perl.org/~Alias/journal/29427>, L<http://ali.as/>
  
  =head1 COPYRIGHT
  
  Copyright 2006 - 2009 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PARSE_CPAN_META

$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.006000'; # 1.6.0
  
  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(@_);
      };
    }
  }
  
  =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) = @_;
    $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 modulebuildrc_path {
    my ($class, $path) = @_;
    File::Spec->catfile($path, '.modulebuildrc');
  }
  
  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';
    my $modulebuildrc_path = $class->modulebuildrc_path($path);
    if (-e $modulebuildrc_path) {
      unless (-f _) {
        Carp::croak("${modulebuildrc_path} exists but is not a plain file");
      }
    } else {
      warn "Attempting to create file ${modulebuildrc_path}\n";
      open MODULEBUILDRC, '>', $modulebuildrc_path
        || Carp::croak("Couldn't open ${modulebuildrc_path} for writing: $!");
      print MODULEBUILDRC qq{install  --install_base  ${path}\n}
        || Carp::croak("Couldn't write line to ${modulebuildrc_path}: $!");
      close MODULEBUILDRC
        || Carp::croak("Couldn't close file ${modulebuildrc_path}: $@");
    }
  
    return $path;
  }
  
  sub INTERPOLATE_ENV () { 1 }
  sub LITERAL_ENV     () { 0 }
  
  sub print_environment_vars_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 $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
                   }
           };
    }
  
    while (@envs) {
      my ($name, $value) = (shift(@envs), shift(@envs));
      $value =~ s/(\\")/\\$1/g;
      $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
    }
    print $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 (
      MODULEBUILDRC => $class->modulebuildrc_path($path),
      PERL_MM_OPT => "INSTALL_BASE=${path}",
      PERL5LIB => join($Config{path_sep},
                    $class->install_base_perl_path($path),
                    $class->install_base_arch_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%' ))
               ),
    )
  }
  
  =begin testing
  
  #:: test classmethod
  
  File::Path::rmtree('t/var/splat');
  
  $c->ensure_dir_structure_for('t/var/splat');
  
  ok(-d 't/var/splat');
  
  ok(-f 't/var/splat/.modulebuildrc');
  
  =end testing
  
  =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 MODULEBUILDRC=/home/username/perl/.modulebuildrc
    export PERL_MM_OPT='INSTALL_BASE=/home/username/perl'
    export PERL5LIB='/home/username/perl/lib/perl5:/home/username/perl/lib/perl5/i386-linux'
    export PATH="/home/username/perl/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.
  
  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.
  
  3. Run this:
  
    make test && make install
  
  4. Arrange for Perl to use your own packages instead of the system
  packages.  If you are using bash, you can do this as follows:
  
    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
  
  You can also pass --bootstrap=~/foo to get a different location -
  
    perl Makefile.PL --bootstrap=~/foo
    make test && make install
  
    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>. Replace .bashrc or
  .cshrc with the name of the file you wrote above with the echo command.
  
  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
  
  If you want to install multiple Perl module environments, say for application development, 
  install local::lib globally and then:
  
    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 ...
  
  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
  
    C:\>perl -Mlocal::lib
    set MODULEBUILDRC=C:\DOCUME~1\ADMINI~1\perl5\.modulebuildrc
    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 at the moment.
  
  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 MODULEBUILDRC
  
  =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|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 METHODS
  
  =head2 ensure_directory_structure_for
  
  =over 4
  
  =item Arguments: path
  
  =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
  
  =back
  
  Prints to standard output 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
  
  =back
  
  Constructs the C<%ENV> keys for the given path, by calling
  C<build_environment_vars_for>.
  
  =head2 install_base_perl_path
  
  =over 4
  
  =item Arguments: 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
  
  =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
  
  =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 modulebuildrc_path
  
  =over 4
  
  =item Arguments: path
  
  =back
  
  Returns a path describing where to install the C<.modulebuildrc> file, based on
  the given path.
  
  =head2 resolve_empty_path
  
  =over 4
  
  =item Arguments: 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
  
  =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
  
  =back
  
  Translates the given path into an absolute path.
  
  =head2 resolve_path
  
  =over 4
  
  =item Arguments: 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
  
  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 MODULEBUILDRC.
  
  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 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 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.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2007 - 2009 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;
LOCAL_LIB

s/^  //mg for values %fatpacked;

unshift @INC, sub {
  if (my $fat = $fatpacked{$_[1]}) {
    open my $fh, '<', \$fat;
    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

=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 --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, and you can disable that with
C<--no-uninst-shadows>.

=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 --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::Lite>
(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