#!perl
# 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 = "0.9932";
  
  =head1 NAME
  
  App::cpanminus - get, unpack, build and install modules from CPAN
  
  =head1 SYNOPSIS
  
      cpanm Module
      cpanm MIYAGAWA/Plack-1.0000.tar.gz
      cpanm ~/mydists/MyCompany-Framework-1.0.tar.gz
      cpanm http://example.com/MyModule-0.1.tar.gz
      cpanm http://github.com/miyagawa/Tatsumaki/tarball/master
      cpanm --interactive Task::Kensho
  
  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 -- but
  it's maintainable and extensible with plugins and friendly to shell scripting.
  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.
  
  If you want to build the latest from source,
  
      git clone git://github.com/miyagawa/cpanminus.git
      cd cpanminus
      perl Makefile.PL
      make install # or sudo make install if you're non root
  
  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 to sudo. 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 (Actually I believe it works with pre 5.8 too but
  I haven't tested this).
  
  =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.
  
  =back
  
  And optionally:
  
  =over 4
  
  =item *
  
  make, if you want to reliably install MakeMaker based modules
  
  =item *
  
  Module::Build (core in 5.10) to install Build.PL based modules
  
  =back
  
  =head1 PLUGINS
  
  B<WARNING: plugin API is not stable so this feature is turned off by
  default for now. To enable plugins you have to be savvy enough to look
  at the build.log or read the source code to see how :)>
  
  The cpanminus core is a compact and simple 1000 lines of code (with some
  embedded utilities and documents) but can be extended by writing plugins.
  Plugins are flat perl scripts placed inside C<~/.cpanm/plugins>. You can copy
  (or symlink, if you're a developer) a plugin file to the directory to enable
  plugins.  Delete the file or symlink to disable it.
  
  See the C<plugins/> directory in the git repository
  L<http://github.com/miyagawa/cpanminus> for the list of available and
  sample plugins.
  
  =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.
  
  In particular, here are the few issues I've observed:
  
  =over
  
  =item *
  
  They ask too many questions and do not provide enough sane defaults. A normal
  user doesn't (and shouldn't have to) know what's the right answer for the
  question C<Parameters for the 'perl Build.PL' command? []>
  
  =item *
  
  They provide very noisy output by default.
  
  =item *
  
  They fetch and rebuild their indexes almost every day, and this takes time.
  
  =item *
  
  ... and they hog 200MB of memory and thrashes/OOMs on my 256MB VPS
  
  =back
  
  cpanminus is designed to be very quiet (but logs all output to
  C<~/.cpanm/build.log>) and to pick the sanest possible defaults without asking
  any questions -- to I<just work>.
  
  Note that most of these problems with existing tools are rare, or are just
  overstated.  They might already be fixed, or can be configured to work nicer.
  For instance, the latest CPAN.pm dev release has a much better first time
  configuration experience than ever before.
  
  I know there's a reason for them to have many options and questions, because
  they're meant to work everywhere for everybody.
  
  Of course I should have contributed back to CPAN/CPANPLUS
  instead of writing a new client, but CPAN.pm is nearly impossible
  (for anyone other than andk or xdg) to maintain (that's why CPANPLUS
  was born, right?) and CPANPLUS is a huge beast for me to start working
  on.
  
  =head2 Are you on drugs?
  
  Yeah, I think my brain has been damaged since I looked at PyPI,
  gemcutter, pip and rip. They're quite nice and I really wanted
  something as nice for CPAN which I love.
  
  =head2 How does this thing work?
  
  Imagine you don't have CPAN or CPANPLUS. You search for a module on the CPAN
  search site, download a tarball, unpack it and then run C<perl Makefile.PL> (or
  C<perl Build.PL>). If the module has dependencies you probably have to resolve
  those dependencies by hand before doing so. Then you run the unit tests and
  C<make install> (or C<./Build install>).
  
  cpanminus automates that.
  
  =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 or with C<--sudo> option.
  
  This L<local::lib> automatic integration is still considered alpha and
  in the work -- more bootstrapping is under development. Stay tuned.
  
  =head2 Does this really work?
  
  I tested installing MojoMojo, Task::Kensho, KiokuDB, Catalyst, Jifty and Plack
  using cpanminus and the installations including dependencies were mostly
  successful. More than I<half of CPAN> behaves really nicely and appears to
  work.
  
  However, there might be some distributions that will miserably fail, because of
  nasty edge cases. Here are some examples:
  
  =over 4
  
  =item *
  
  Packages uploaded to PAUSE in 90s which don't live under the standard
  C<authors/id/A/AA> directory hierarchy.
  
  =item *
  
  Distributions with a C<Makefile.PL> or C<Build.PL> that asks you questions
  without using C<prompt> function. However cpanminus has a mechanism to kill
  those questions with a timeout, and you can always say C<--interactive> to make
  the configuration interactive.
  
  =item *
  
  Distributions that do not shipped with C<META.yml> file but do require
  some specific version of toolchain for configuration.
  
  =item *
  
  Distributions that test a SIGNATURE in the C<*.t> unit tests and has
  C<MANIFEST.SKIP> file in the distribution at the same time. The intent of
  signature testing is to provide some degree of security, but running it in unit
  tests is too late as it occurs I<after> running C<Makefile.PL>.  cpanminus has
  a C<verify_signature> plugin to verify the dist before configurations.
  
  =item *
  
  Distributions that have a C<META.yml> file that is encoded in YAML 1.1 format
  using L<YAML::XS>. This will be eventually solved once we move to C<META.json>.
  
  =back
  
  cpanminus intends to work for 99.9% of modules on CPAN for 99.9% of people. It
  may not be perfect, but it should just work in most cases.
  
  If this tool doesn't work for your very rare environment, then I'm sorry, but
  you should use CPAN or CPANPLUS, or build and install modules manually.
  
  =head2 That sounds fantastic. Should I switch to this from CPAN(PLUS)?
  
  If you have CPAN or CPANPLUS working then you may want to keep using
  CPAN or CPANPLUS in the longer term, but I hope this can be a
  quite handy alternative to them for people in other situations. And
  apparently, many people love (at least the idea of) this software :)
  
  =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 constant WIN32 => $^O eq 'MSWin32';
  use constant SUNOS => $^O eq 'solaris';
  use constant PLUGIN_API_VERSION => 0.1;
  
  our $VERSION = "0.9932";
  $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 => [],
          perl => $^X,
          argv => [],
          hooks => {},
          plugins => [],
          local_lib => undef,
          self_contained => undef,
          configure_timeout => 60,
          try_lwp => 1,
          @_,
      }, $class;
  }
  
  sub env {
      my($self, $key) = @_;
      $ENV{"PERL_CPANM_" . $key} || $ENV{"CPANMINUS_" . $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!'  => \$self->{force},
          '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' => \$self->{local_lib},
          'L|local-lib-contained=s' => sub { $self->{local_lib} = $_[1]; $self->{self_contained} = 1 },
          'recent'    => sub { $self->{action} = 'show_recent' },
          'list-plugins' => sub { $self->{action} = 'list_plugins' },
          'installdeps' => \$self->{installdeps},
          'skip-installed!' => \$self->{skip_installed},
          'interactive!' => \$self->{interactive},
          'i|install' => sub { $self->{cmd} = 'install' },
          'look'      => sub { $self->{cmd} = 'look' },
          'info'      => sub { $self->{cmd} = 'info' },
          'self-upgrade' => sub { $self->{cmd} = 'install'; $self->{skip_installed} = 1; push @ARGV, 'App::cpanminus' },
          'disable-plugins!' => \$self->{disable_plugins},
          'lwp!'    => \$self->{try_lwp},
      );
  
      $self->{argv} = \@ARGV;
  }
  
  sub init {
      my $self = shift;
  
      $self->setup_home;
      $self->load_plugins;
      $self->bootstrap;
      $self->init_tools;
  
      if (@{$self->{bootstrap_deps} || []}) {
          $self->configure_mirrors;
          local $self->{force} = 1; # to force install EUMM
          $self->install_deps(Cwd::cwd, 0, @{$self->{bootstrap_deps}});
      }
  }
  
  sub doit {
      my $self = shift;
  
      if ($self->should_init) {
          $self->init;
          $self->configure_mirrors;
      }
  
      if (my $action = $self->{action}) {
          $self->$action() and return;
      }
  
      $self->show_help(1) unless @{$self->{argv}};
  
      for my $module (@{$self->{argv}}) {
          $self->install_module($module, 0);
      }
  
      $self->run_hooks(finalize => {});
  }
  
  sub should_init {
      my $self = shift;
      my $action = $self->{action} or return 1;
      return (grep $action eq $_, qw(show_help show_version)) ? 0 : 1;
  }
  
  sub setup_home {
      my $self = shift;
  
      $self->{home} = $self->env('HOME') if $self->env('HOME');
  
      $self->{base} = "$self->{home}/work/" . time . ".$$";
      $self->{plugin_dir} = "$self->{home}/plugins";
      File::Path::mkpath([ $self->{base}, $self->{plugin_dir} ], 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 register_core_hooks {
      my $self = shift;
  
      $self->hook('core', search_module => sub {
          my $args = shift;
          my $self   = $args->{app};
          my $module = $args->{module};
          push @{$args->{uris}}, sub {
              $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_uri($meta->{distfile});
              }
              $self->diag("! Finding $module on cpanmetadb failed.\n");
              return;
          };
      });
  
      $self->hook('core', search_module => sub {
          my $args = shift;
          my $self   = $args->{app};
          my $module = $args->{module};
          push @{$args->{uris}}, sub {
              $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_uri($1);
              $self->diag("! Finding $module on search.cpan.org failed.\n");
              return;
          };
      });
  
      $self->hook('core', show_recent => sub {
          my $args = shift;
          my $self = $args->{app};
  
          $self->chat("Fetching recent feed from search.cpan.org ...\n");
          my $feed = $self->get("http://search.cpan.org/uploads.rdf");
  
          my @dists;
          while ($feed =~ m!<link>http://search\.cpan\.org/~([a-z_\-0-9]+)/(.*?)/</link>!g) {
              my($pause_id, $dist) = (uc $1, $2);
              # FIXME Yes, it doesn't always have to be 'tar.gz'
              push @dists, substr($pause_id, 0, 1) . "/" . substr($pause_id, 0, 2) . "/" . $pause_id . "/$dist.tar.gz";
              last if @dists >= 50;
          }
  
          return \@dists;
      });
  }
  
  sub load_plugins {
      my $self = shift;
  
      $self->_load_plugins;
      $self->register_core_hooks;
  
      for my $hook (keys %{$self->{hooks}}) {
          $self->{hooks}->{$hook} = [ sort { $a->[0] <=> $b->[0] } @{$self->{hooks}->{$hook}} ];
      }
  
      $self->run_hooks(init => {});
  }
  
  sub _load_plugins {
      my $self = shift;
      return if $self->{disable_plugins};
      return unless $self->{plugin_dir} && -e $self->{plugin_dir};
  
      opendir my $dh, $self->{plugin_dir} or return;
      my @plugins;
      while (my $e = readdir $dh) {
          my $f = "$self->{plugin_dir}/$e";
          next unless -f $f && $e =~ /^[A-Za-z0-9_]+$/ && $e ne 'README';
          push @plugins, [ $f, $e ];
      }
  
      for my $plugin (sort { $a->[1] <=> $b->[1] } @plugins) {
          $self->load_plugin(@$plugin);
      }
  }
  
  sub load_plugin {
      my($self, $file, $name) = @_;
  
      # TODO remove this once plugin API is official
      unless ($self->env('DEV')) {
          $self->chat("! Found plugin $file but PERL_CPANM_DEV is not set. Skipping.\n");
          return;
      }
  
      $self->chat("Loading plugin $file\n");
  
      my $plugin = { name => $name, file => $file };
      my @attr   = qw( name description author version synopsis );
      my $dsl    = join "\n", map "sub $_ { \$plugin->{$_} = shift }", @attr;
  
      (my $package = $file) =~ s/[^a-zA-Z0-9_]/_/g;
      my $code = do { open my $io, "<$file"; local $/; <$io> };
  
      my $api_version = PLUGIN_API_VERSION;
  
      my @hooks;
      eval "package App::cpanplus::plugin::$package;\n".
          "use strict;\n$dsl\n" .
          'sub api_version { die "API_COMPAT: $_[0]" if $_[0] < $api_version }' . "\n" .
          "sub hook { push \@hooks, [\@_] };\n$code";
  
      if ($@ =~ /API_COMPAT: (\S+)/) {
          $self->diag("! $plugin->{name} plugin API version is outdated ($1 < $api_version) and needs an update.\n");
          return;
      } elsif ($@) {
          $self->diag("! Loading $name plugin failed. See $self->{log} for details.\n");
          $self->chat($@);
          return;
      }
  
      for my $hook (@hooks) {
          $self->hook($plugin->{name}, @$hook);
      }
  
      push @{$self->{plugins}}, $plugin;
  }
  
  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 hook {
      my $cb = pop;
      my($self, $name, $hook, $order) = @_;
      $order = 50 unless defined $order;
      push @{$self->{hooks}->{$hook}}, [ $order, $cb, $name ];
  }
  
  sub run_hook {
      my($self, $hook, $args) = @_;
      $self->run_hooks($hook, $args, 1);
  }
  
  sub run_hooks {
      my($self, $hook, $args, $first) = @_;
      $args->{app} = $self;
      my $res;
      for my $plugin (@{$self->{hooks}->{$hook} || []}) {
          $res = eval { $plugin->[1]->($args) };
          $self->chat("Running hook '$plugin->[2]' error: $@") if $@;
          last if $res && $first;
      }
  
      return $res;
  }
  
  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` for more options.
  USAGE
      }
  
      print <<HELP;
  Usage: cpanm [options] Module [...]
  
  Options:
    -v,--verbose       Turns on chatty 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
    --skip-installed   Skip installation if you already have the latest version installed
    --disable-plugins  Disable plugin loading
  
  Commands:
    --self-upgrade     upgrades itself
    --look             Download the tarball and open the directory with your shell
    --info             Displays distribution info on CPAN
    --recent           Show recently updated modules
  
  Examples:
  
    cpanm CGI                                                 # install CGI
    cpanm MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution name
    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
  
  HELP
  
      return 1;
  }
  
  sub bootstrap {
      my $self = shift;
  
      # If -l is specified, use that.
      if ($self->{local_lib}) {
          my $lib = $self->{local_lib} =~ /^~/ ? $self->{local_lib} : Cwd::abs_path($self->{local_lib});
          return $self->_try_local_lib($lib);
      }
  
      # root, locally-installed perl or --sudo: don't care about install_base
      return if $self->{sudo} or (-w $Config{installsitelib} and -w $Config{installsitebin});
  
      # local::lib is configured in the shell -- yay
      return if $ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT});
  
      $self->_try_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 4 options:
  !   - 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 _dump_inc {
      my $self = shift;
  
      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 _try_local_lib {
      my($self, $base) = @_;
  
      require local::lib;
      {
          local $0 = 'cpanm'; # so curl/wget | perl works
          $base ||= "~/perl5";
          if ($self->{self_contained}) {
              my @inc = @INC;
              local $ENV{PERL5LIB} = '';
              $self->_import_local_lib('--self-contained', $base);
              $self->_dump_inc;
              $self->{search_inc} = [ @INC ];
              @INC = @inc;
          } else {
              $self->_import_local_lib($base);
          }
      }
  
      push @{$self->{bootstrap_deps}},
          'ExtUtils::MakeMaker' => 6.31,
          'ExtUtils::Install'   => 1.43,
          'Module::Build'       => 0.28; # TODO: 0.36 or later for MYMETA.yml once we do --bootstrap command
  }
  
  sub diag {
      my $self = shift;
      print STDERR @_ if $self->{verbose} or !$self->{quiet};
      $self->log(@_);
  }
  
  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 (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("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) = @_;
      $self->run_timeout($cmd, $self->{build_timeout});
  }
  
  sub test {
      my($self, $cmd) = @_;
      return 1 if $self->{notest};
      local $ENV{AUTOMATED_TESTING} = 1;
      return $self->run_timeout($cmd,  $self->{test_timeout}) || $self->{force};
  }
  
  sub install {
      my($self, $cmd) = @_;
      unshift @$cmd, "sudo" if $self->{sudo};
      $self->run($cmd);
  }
  
  sub chdir {
      my $self = shift;
      chdir(File::Spec->canonpath($_[0])) or die "$_[0]: $!";
  }
  
  sub configure_mirrors {
      my $self = shift;
  
      my @mirrors;
      $self->run_hook(configure_mirrors => { mirrors => \@mirrors });
  
      @mirrors = ('http://search.cpan.org/CPAN') unless @mirrors;
      $self->{mirrors} = \@mirrors;
  }
  
  sub show_recent {
      my $self = shift;
  
      my $dists = $self->run_hook(show_recent => {});
      for my $dist (@$dists) {
          print $dist, "\n";
      }
  
      return 1;
  }
  
  sub list_plugins {
      my $self = shift;
  
      for my $plugin (@{$self->{plugins}}) {
          print "$plugin->{name} - $plugin->{description}\n";
      }
  
      return 1;
  }
  
  sub self_upgrade {
      my $self = shift;
      $self->{argv} = [ 'App::cpanminus' ];
      return; # continue
  }
  
  sub install_module {
      my($self, $module, $depth) = @_;
  
      if ($self->{seen}{$module}++) {
          $self->diag("Already tried $module. Skipping.\n");
          return;
      }
  
      # FIXME return richer data strture including version number here
      # so --skip-installed option etc. can skip it
      my $dir = $self->fetch_module($module);
  
      return if $self->{cmd} eq 'info';
  
      unless ($dir) {
          $self->diag("! Couldn't find module or a distribution $module\n");
          return;
      }
  
      if ($module ne $dir && $self->{seen}{$dir}++) {
          $self->diag("Already built the distribution $dir. Skipping.\n");
          return;
      }
  
      $self->chat("Entering $dir\n");
      $self->chdir($self->{base});
      $self->chdir($dir);
  
      if ($self->{cmd} eq 'look') {
          my $shell = $ENV{SHELL};
          $shell  ||= $ENV{COMSPEC} if WIN32;
          if ($shell) {
              $self->diag("Entering $dir with $shell\n");
              system $shell;
          } else {
              $self->diag("! You don't seem to have a SHELL :/\n");
          }
      } else {
          $self->build_stuff($module, $dir, $depth);
      }
  }
  
  sub generator_cb {
      my($self, $ref) = @_;
  
      $ref = [ $ref ] unless ref $ref eq 'ARRAY';
  
      my @stack;
      return sub {
          if (@stack) {
              return shift @stack;
          }
  
          return -1 unless @$ref;
          my $curr = (shift @$ref)->();
          if (ref $curr eq 'ARRAY') {
              @stack = @$curr;
              return shift @stack;
          } else {
              return $curr;
          }
      };
  }
  
  sub fetch_module {
      my($self, $module) = @_;
  
      my($uris, $local_dir) = $self->locate_dist($module);
  
      return $local_dir if $local_dir;
      return unless $uris;
  
      my $iter = $self->generator_cb($uris);
  
      while (1) {
          my $uri = $iter->();
          last if $uri == -1;
          next unless $uri;
  
          # Yikes this is dirty
          if ($self->{cmd} eq 'info') {
              $uri =~ s!.*authors/id/!!;
              print $uri, "\n";
              return;
          }
  
          if ($uri =~ m{/perl-5}){
              $self->diag("skip $uri\n");
              next;
          }
  
          $self->chdir($self->{base});
          $self->diag("Fetching $uri ... ");
  
          my $name = File::Basename::basename $uri;
  
          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\nDownload $uri failed. Retrying ... ");
          }
  
          if ($cancelled) {
              $self->diag("\n! Download cancelled.\n");
              return;
          }
  
          unless ($file) {
              $self->diag("FAIL\n! Failed to download $uri\n");
              next;
          }
  
          $self->diag("OK\n");
  
          # TODO add more metadata so plugins can tell how to verify and pass through
          my $args = { file => $file, uri => $uri, fail => 0 };
          $self->run_hooks(verify_archive => $args);
  
          if ($args->{fail} && !$self->{force}) {
              $self->diag("! Verifying the archive $file failed. Skipping. (use --force to install)\n");
              next;
          }
  
          my $dir = $self->unpack($file);
  
          next unless $dir; # unpack failed
  
          return $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("! Failed to unpack $file: no directory\n");
      }
      return $dir;
  }
  
  sub locate_dist {
      my($self, $module) = @_;
  
      if (my $located = $self->run_hook(locate_dist => { module => $module })) {
          return ref $located eq 'ARRAY' ? @$located :
                 ref $located eq 'CODE'  ? $located  : sub { $located };
      }
  
      # URL
      return sub { $module } if $module =~ /^(ftp|https?|file):/;
  
      # Directory
      return undef, Cwd::abs_path($module) if $module =~ m!^[\./]! && -d $module;
  
      # File
      return sub { "file://" . Cwd::abs_path($module) } if -f $module;
  
      # cpan URI
      $module =~ s!^cpan:///distfile/!!;
  
      # PAUSEID/foo
      $module =~ s!^([A-Z]{3,})/!substr($1, 0, 1)."/".substr($1, 0, 2) ."/" . $1 . "/"!e;
  
      # CPAN tarball
      return sub { $self->cpan_uri($module) } if $module =~ m!^[A-Z]/[A-Z]{2}/!;
  
      # Module name -- search.cpan.org
      return $self->search_module($module);
  }
  
  sub cpan_uri {
      my($self, $dist) = @_;
  
      my @mirrors = @{$self->{mirrors}};
      my @urls    = map "$_/authors/id/$dist", @mirrors;
  
      return wantarray ? @urls : $urls[int(rand($#urls))];
  }
  
  sub search_module {
      my($self, $module) = @_;
  
      my @cbs;
      $self->run_hooks(search_module => { module => $module, uris => \@cbs });
  
      return \@cbs;
  }
  
  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;
      while (my($mod, $ver) = each %deps) {
          next if $mod eq 'perl' or $mod eq 'Config';
          push @install, $self->should_install($mod, $ver);
      }
  
      if (@install) {
          $self->diag("==> Found dependencies: ", join(", ", @install), "\n");
      }
  
      for my $mod (@install) {
          $self->install_module($mod, $depth + 1);
      }
  
      $self->chdir($self->{base});
      $self->chdir($dir) if $dir;
  }
  
  sub build_stuff {
      my($self, $module, $dir, $depth) = @_;
  
      my $args = { module => $module, dir => $dir };
      $self->run_hooks(verify_dist => $args);
  
      if ($args->{fail} && !$self->{force}) {
          $self->diag("! Verifying the module $module failed. Skipping. (use --force to install)\n");
          return;
      }
  
      my($meta, @config_deps);
      if (-e 'META.yml') {
          $self->chat("Checking configure dependencies from META.yml ...\n");
          $meta = $self->parse_meta('META.yml');
          push @config_deps, %{$meta->{configure_requires} || {}};
      }
  
      # TODO yikes, $module doesn't always have to be CPAN module
      # TODO extract/fetch meta info earlier so you don't need to download tarballs
      if ($depth == 0 && $meta->{version} && $module =~ /^[a-zA-Z0-9_:]+$/) {
          my($ok, $local) = $self->check_module($module, $meta->{version});
          if ($self->{skip_installed} && $ok) {
              $self->diag("$module is up to date. ($local)\n");
              return;
          }
      }
  
      # get more configure_requires
      $self->run_hooks(pre_configure => { meta => $meta, deps => \@config_deps });
      $self->install_deps($dir, $depth, @config_deps);
  
      # Let plugins to take over the build process -- dzil for instance
      my $builder = $self->run_hook(build_dist => { meta => $meta });
      return $builder->() if $builder;
  
      my $target = $meta->{name} ? "$meta->{name}-$meta->{version}" : $dir;
      $self->diag("Configuring $target ... ");
  
      my $configure_state = $self->configure_this($meta->{name});
  
      $self->diag($configure_state->{configured_ok} ? "OK\n" : "N/A\n");
  
      my %deps = $self->find_prereqs($meta);
  
      $self->run_hooks(find_deps => { deps => \%deps, module => $module, meta => $meta });
  
      $self->install_deps($dir, $depth, %deps);
  
      if ($self->{installdeps} && $depth == 0) {
          $self->diag("<== Installed dependencies for $module. Finishing.\n");
          return 1;
      }
  
      my $installed;
      if ($configure_state->{use_module_build} && -e 'Build' && -f _) {
          $self->diag("Building ", ($self->{notest} ? "" : "and testing "), "$target for $module ... ");
          $self->build([ $self->{perl}, "./Build" ]) &&
          $self->test([ $self->{perl}, "./Build", "test" ]) &&
          $self->install([ $self->{perl}, "./Build", "install" ]) &&
          $installed++;
      } elsif ($self->{make} && -e 'Makefile') {
          $self->diag("Building ", ($self->{notest} ? "" : "and testing "), "$target for $module ... ");
          $self->build([ $self->{make} ]) &&
          $self->test([ $self->{make}, "test" ]) &&
          $self->install([ $self->{make}, "install" ]) &&
          $installed++;
      } else {
          my $why;
          my $configure_failed = $configure_state->{configured} && !$configure_state->{configured_ok};
          if ($configure_failed) { $why = "Configure failed on $dir." }
          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("! $why See $self->{log} for details.\n");
          $self->run_hooks(configure_failure => { module => $module, build_dir => $dir, meta => $meta });
          return;
      }
  
      # TODO calculate this earlier and put it in the stash
      my $distname = $meta->{name} ? "$meta->{name}-$meta->{version}" : $module;
  
      if ($installed) {
          my $local = $self->{local_versions}{$module};
          my $reinstall = $local && $local eq $meta->{version};
  
          my $how = $reinstall ? "reinstalled $distname"
                  : $local     ? "installed $distname (upgraded from $local)"
                               : "installed $distname" ;
          my $msg = "Successfully $how";
          $self->diag("OK\n$msg\n");
          $self->run_hooks(install_success => {
              module => $module, build_dir => $dir, meta => $meta,
              local => $local, reinstall => $reinstall, depth => $depth,
              message => $msg, dist => $distname
          });
          return 1;
      } else {
          my $msg = "Building $distname failed";
          $self->diag("FAIL\n! Installing $module failed. See $self->{log} for details.\n");
          $self->run_hooks(build_failure => {
              module => $module, build_dir => $dir, meta => $meta,
              message => $msg, dist => $distname,
          });
          return;
      }
  }
  
  sub configure_this {
      my($self, $name) = @_;
  
      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 ($name && $should_use_mm{$name}) {
          @try = ($try_eumm, $try_mb);
      } else {
          @try = ($try_mb, $try_eumm);
      }
  
      for my $try (@try) {
          $try->();
          last if $state->{configured_ok};
      }
  
      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 => ({.*?})/) {
                  my $prereq = $self->safe_eval("no strict; +$1");
                  %deps = (%deps, %$prereq) if $prereq;
                  last;
              }
          }
      }
  
      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 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 (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 $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 (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`) =~ /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("! Bad archive: $tarfile\n");
              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("! Bad archive: $tarfile\n");
              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];
              $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("! Bad archive: [$root] $zipfile\n");
              return undef;
          }
      } elsif (eval { require Archive::Zip }) {
          $self->chat("You have Archive::Zip $Archive::Zip::VERSION\n");
          $self->{_backends}{unzip} = sub {
              my($self, $file) = @_;
              my $zip = Archive::Zip->new();
              my $status;
              $status = $zip->read($file);
              $self->diag("Read of file[$file] failed\n")
                  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("Extracting of file[$af] from zipfile[$file failed\n") if $status != Archive::Zip::AZ_OK();
              }
              return -d $root ? $root : undef;
          };
      } else {
          $self->{_backends}{unzip} = sub {
              die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";
          };
      }
  }
  
  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{"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.004009'; # 1.4.9
  my @KNOWN_FLAGS = (qw/--self-contained/);
  
  sub import {
    my ($class, @args) = @_;
    @args <= 1 + @KNOWN_FLAGS or die <<'DEATH';
  Please see `perldoc local::lib` for directions on using this module.
  DEATH
  
    # 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'}) {
      # The only directories that remain are those that we just defined and those
      # where core modules are stored.  We put PERL5LIB first, so it'll be favored
      # over privlibexp and archlibexp
  
      @INC = _uniq(
        $class->install_base_arch_path($arg_store{path}),
        $class->install_base_perl_path($arg_store{path}),
        split( $Config{path_sep}, $perl5lib ),
        $Config::Config{archlibexp},
        $Config::Config{privlibexp},
      );
  
      # We explicitly set PERL5LIB here to the above de-duped list to prevent
      # @INC from growing with each invocation
      $ENV{PERL5LIB} = join( $Config{path_sep}, @INC );
    }
  
    $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 it's missing dependencies to the 'my_lwp' directory
    perl -MCPAN -Mlocal::lib=my_lwp -e 'CPAN::install(LWP)'
  
    # Install LWP and *all non-core* dependencies to the 'my_lwp' directory 
    perl -MCPAN -Mlocal::lib=--self-contained,my_lwp -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.
  
    . ~/.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
  
    source ~/.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
  
    . ~/.bashrc
  
  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 evelopment, 
  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 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
  
  Chris Nehren <apeiron@cpan.org> now oversees maintenance of local::lib, in
  addition to providing doc patches and bootstrap fixes to prevent users from
  shooting themselves in the foot (it's more likely than you think).
  
  Patches to correctly output commands for csh style shells, as well as some
  documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
  
  '--self-contained' feature contributed by Mark Stosberg <mark@summersault.com>.
  
  Ability to pass '--self-contained' without a directory inspired by frew on
  irc.perl.org/#catalyst.
  
  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>.
  
  kgish/#perl-help@irc.perl.org suggested revamping the section on sourcing the
  shell file to make it clearer to those quickly reading the POD.
  
  t0m and chrisa on #local-lib@irc.perl.org pointed out a PERL5LIB ordering issue
  with C<--self-contained>.
  
  =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;
use Parse::CPAN::Meta;

unless (caller) {
    my $app = App::cpanminus::script->new;
    $app->parse_options(@ARGV);
    $app->doit;
}
