#!perl
#
# 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/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
  package App::cpanminus::script;
  use strict;
  use Config;
  use Cwd ();
  use File::Basename ();
  use File::Find ();
  use File::Path ();
  use File::Spec ();
  use File::Copy ();
  use Getopt::Long ();
  use Parse::CPAN::Meta;
  use Symbol ();
  
  use constant WIN32 => $^O eq 'MSWin32';
  use constant SUNOS => $^O eq 'solaris';
  
  our $VERSION = "1.5021";
  
  my $quote = WIN32 ? q/"/ : q/'/;
  
  sub new {
      my $class = shift;
  
      bless {
          home => "$ENV{HOME}/.cpanm",
          cmd  => 'install',
          seen => {},
          notest => undef,
          test_only => undef,
          installdeps => undef,
          force => undef,
          sudo => undef,
          make  => undef,
          verbose => undef,
          quiet => undef,
          interactive => undef,
          log => undef,
          mirrors => [],
          mirror_only => undef,
          mirror_index => undef,
          perl => $^X,
          argv => [],
          local_lib => undef,
          self_contained => undef,
          prompt_timeout => 0,
          prompt => undef,
          configure_timeout => 60,
          try_lwp => 1,
          try_wget => 1,
          try_curl => 1,
          uninstall_shadows => ($] < 5.012),
          skip_installed => 1,
          skip_satisfied => 0,
          auto_cleanup => 7, # days
          pod2man => 1,
          installed_dists => 0,
          showdeps => 0,
          scandeps => 0,
          scandeps_tree => [],
          format   => 'tree',
          save_dists => undef,
          skip_configure => 0,
          verify => 0,
          @_,
      }, $class;
  }
  
  sub env {
      my($self, $key) = @_;
      $ENV{"PERL_CPANM_" . $key};
  }
  
  sub parse_options {
      my $self = shift;
  
      local @ARGV = @{$self->{argv}};
      push @ARGV, split /\s+/, $self->env('OPT');
      push @ARGV, @_;
  
      Getopt::Long::Configure("bundling");
      Getopt::Long::GetOptions(
          'f|force'   => sub { $self->{skip_installed} = 0; $self->{force} = 1 },
          'n|notest!' => \$self->{notest},
          'test-only' => sub { $self->{notest} = 0; $self->{skip_installed} = 0; $self->{test_only} = 1 },
          'S|sudo!'   => \$self->{sudo},
          'v|verbose' => sub { $self->{verbose} = $self->{interactive} = 1 },
          'verify!'   => \$self->{verify},
          'q|quiet!'  => \$self->{quiet},
          'h|help'    => sub { $self->{action} = 'show_help' },
          'V|version' => sub { $self->{action} = 'show_version' },
          'perl=s'    => \$self->{perl},
          'l|local-lib=s' => sub { $self->{local_lib} = $self->maybe_abs($_[1]) },
          'L|local-lib-contained=s' => sub {
              $self->{local_lib} = $self->maybe_abs($_[1]);
              $self->{self_contained} = 1;
              $self->{pod2man} = undef;
          },
          'mirror=s@' => $self->{mirrors},
          'mirror-only!' => \$self->{mirror_only},
          'mirror-index=s'  => sub { $self->{mirror_index} = $_[1]; $self->{mirror_only} = 1 },
          'cascade-search!' => \$self->{cascade_search},
          'prompt!'   => \$self->{prompt},
          'installdeps' => \$self->{installdeps},
          'skip-installed!' => \$self->{skip_installed},
          'skip-satisfied!' => \$self->{skip_satisfied},
          'reinstall'    => sub { $self->{skip_installed} = 0 },
          'interactive!' => \$self->{interactive},
          'i|install' => sub { $self->{cmd} = 'install' },
          'info'      => sub { $self->{cmd} = 'info' },
          'look'      => sub { $self->{cmd} = 'look'; $self->{skip_installed} = 0 },
          'self-upgrade' => sub { $self->check_upgrade; $self->{cmd} = 'install'; $self->{skip_installed} = 1; push @ARGV, 'App::cpanminus' },
          'uninst-shadows!'  => \$self->{uninstall_shadows},
          'lwp!'    => \$self->{try_lwp},
          'wget!'   => \$self->{try_wget},
          'curl!'   => \$self->{try_curl},
          'auto-cleanup=s' => \$self->{auto_cleanup},
          'man-pages!' => \$self->{pod2man},
          'scandeps'   => \$self->{scandeps},
          'showdeps'   => sub { $self->{showdeps} = 1; $self->{skip_installed} = 0 },
          'format=s'   => \$self->{format},
          'save-dists=s' => sub {
              $self->{save_dists} = $self->maybe_abs($_[1]);
          },
          'skip-configure!' => \$self->{skip_configure},
          'metacpan'   => \$self->{metacpan},
      );
  
      if (!@ARGV && $0 ne '-' && !-t STDIN){ # e.g. # cpanm < author/requires.cpanm
          push @ARGV, $self->load_argv_from_fh(\*STDIN);
          $self->{load_from_stdin} = 1;
      }
  
      $self->{argv} = \@ARGV;
  }
  
  sub check_upgrade {
      if ($0 !~ /^$Config{installsitebin}/) {
          if ($0 =~ m!perlbrew/bin!) {
              warn <<WARN;
  It appears your cpanm executable was installed via `perlbrew install-cpanm`.
  cpanm --self-upgrade won't upgrade the version of cpanm you're running.
  
  Run the following command to get it upgraded.
  
    perlbrew install-cpanm
  
  WARN
          } else {
              warn <<WARN;
  You are running cpanm from the path where your current perl won't install executables to.
  Because of that, cpanm --self-upgrade won't upgrade the version of cpanm you're running.
  
    cpanm path   : $0
    Install path : $Config{installsitebin}
  
  It means you either installed cpanm globally with system perl, or use distro packages such
  as rpm or apt-get, and you have to use them again to upgrade cpanm.
  WARN
          }
      }
  }
  
  sub check_libs {
      my $self = shift;
      return if $self->{_checked}++;
  
      $self->bootstrap_local_lib;
      if (@{$self->{bootstrap_deps} || []}) {
          local $self->{notest} = 1; # test failure in bootstrap should be tolerated
          local $self->{scandeps} = 0;
          $self->install_deps(Cwd::cwd, 0, @{$self->{bootstrap_deps}});
      }
  }
  
  sub setup_verify {
      my $self = shift;
  
      my $has_modules = eval { require Module::Signature; require Digest::SHA; 1 };
      $self->{cpansign} = $self->which('cpansign');
  
      unless ($has_modules && $self->{cpansign}) {
          warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";
          $self->{verify} = 0;
      }
  }
  
  sub doit {
      my $self = shift;
  
      $self->setup_home;
      $self->init_tools;
      $self->setup_verify if $self->{verify};
  
      if (my $action = $self->{action}) {
          $self->$action() and return 1;
      }
  
      $self->show_help(1)
          unless @{$self->{argv}} or $self->{load_from_stdin};
  
      $self->configure_mirrors;
  
      my $cwd = Cwd::cwd;
  
      my @fail;
      for my $module (@{$self->{argv}}) {
          if ($module =~ s/\.pm$//i) {
              my ($volume, $dirs, $file) = File::Spec->splitpath($module);
              $module = join '::', grep { $_ } File::Spec->splitdir($dirs), $file;
          }
  
          ($module, my $version) = split /\~/, $module, 2 if $module =~ /\~[v\d\._]+$/;
          if ($self->{skip_satisfied} or defined $version) {
              $self->check_libs;
              my($ok, $local) = $self->check_module($module, $version || 0);
              if ($ok) {
                  $self->diag("You have $module ($local)\n", 1);
                  next;
              }
          }
  
          $self->chdir($cwd);
          $self->install_module($module, 0, $version)
              or push @fail, $module;
      }
  
      if ($self->{base} && $self->{auto_cleanup}) {
          $self->cleanup_workdirs;
      }
  
      if ($self->{installed_dists}) {
          my $dists = $self->{installed_dists} > 1 ? "distributions" : "distribution";
          $self->diag("$self->{installed_dists} $dists installed\n", 1);
      }
  
      if ($self->{scandeps}) {
          $self->dump_scandeps();
      }
      # Workaround for older File::Temp's
      # where creating a tempdir with an implicit $PWD
      # causes tempdir non-cleanup if $PWD changes
      # as paths are stored internally without being resolved
      # absolutely.
      # https://rt.cpan.org/Public/Bug/Display.html?id=44924
      $self->chdir($cwd);
  
      return !@fail;
  }
  
  sub setup_home {
      my $self = shift;
  
      $self->{home} = $self->env('HOME') if $self->env('HOME');
  
      unless (_writable($self->{home})) {
          die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n";
      }
  
      $self->{base} = "$self->{home}/work/" . time . ".$$";
      File::Path::mkpath([ $self->{base} ], 0, 0777);
  
      my $link = "$self->{home}/latest-build";
      eval { unlink $link; symlink $self->{base}, $link };
  
      $self->{log} = File::Spec->catfile($self->{home}, "build.log"); # because we use shell redirect
  
      {
          my $log = $self->{log}; my $base = $self->{base};
          $self->{at_exit} = sub {
              my $self = shift;
              File::Copy::copy($self->{log}, "$self->{base}/build.log");
          };
      }
  
      { open my $out, ">$self->{log}" or die "$self->{log}: $!" }
  
      $self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" .
                  "Work directory is $self->{base}\n");
  }
  
  sub fetch_meta_sco {
      my($self, $dist) = @_;
      return if $self->{mirror_only};
  
      my $meta_yml = $self->get("http://search.cpan.org/meta/$dist->{distvname}/META.yml");
      return $self->parse_meta_string($meta_yml);
  }
  
  sub package_index_for {
      my ($self, $mirror) = @_;
      return $self->source_for($mirror) . "/02packages.details.txt";
  }
  
  sub generate_mirror_index {
      my ($self, $mirror) = @_;
      my $file = $self->package_index_for($mirror);
      my $gz_file = $file . '.gz';
      my $index_mtime = (stat $gz_file)[9];
  
      unless (-e $file && (stat $file)[9] >= $index_mtime) {
          $self->chat("Uncompressing index file...\n");
          if (eval {require Compress::Zlib}) {
              my $gz = Compress::Zlib::gzopen($gz_file, "rb")
                  or do { $self->diag_fail("$Compress::Zlib::gzerrno opening compressed index"); return};
              open my $fh, '>', $file
                  or do { $self->diag_fail("$! opening uncompressed index for write"); return };
              my $buffer;
              while (my $status = $gz->gzread($buffer)) {
                  if ($status < 0) {
                      $self->diag_fail($gz->gzerror . " reading compressed index");
                      return;
                  }
                  print $fh $buffer;
              }
          } else {
              if (system("gunzip -c $gz_file > $file")) {
                  $self->diag_fail("Cannot uncompress -- please install gunzip or Compress::Zlib");
                  return;
              }
          }
          utime $index_mtime, $index_mtime, $file;
      }
      return 1;
  }
  
  sub search_mirror_index {
      my ($self, $mirror, $module, $version) = @_;
      $self->search_mirror_index_file($self->package_index_for($mirror), $module, $version);
  }
  
  sub search_mirror_index_file {
      my($self, $file, $module, $version) = @_;
  
      open my $fh, '<', $file or return;
      my $found;
      while (<$fh>) {
          if (m!^\Q$module\E\s+([\w\.]+)\s+(.*)!m) {
              $found = $self->cpan_module($module, $2, $1);
              last;
          }
      }
  
      return $found unless $self->{cascade_search};
  
      if ($found) {
          if (!$version or
              version->new($found->{module_version} || 0) >= version->new($version)) {
              return $found;
          } else {
              $self->chat("Found $module version $found->{module_version} < $version.\n");
          }
      }
  
      return;
  }
  
  sub search_module {
      my($self, $module, $version) = @_;
  
      if ($self->{mirror_index}) {
          $self->chat("Searching $module on mirror index $self->{mirror_index} ...\n");
          my $pkg = $self->search_mirror_index_file($self->{mirror_index}, $module, $version);
          return $pkg if $pkg;
  
          unless ($self->{cascade_search}) {
             $self->diag_fail("Finding $module ($version) on mirror index $self->{mirror_index} failed.");
             return;
          }
      }
  
      unless ($self->{mirror_only}) {
          if ($self->{metacpan}) {
              require JSON::PP;
              $self->chat("Searching $module on metacpan ...\n");
              my $module_uri  = "http://api.metacpan.org/module/$module";
              my $module_json = $self->get($module_uri);
              my $module_meta = eval { JSON::PP::decode_json($module_json) };
              if ($module_meta && $module_meta->{distribution}) {
                  my $dist_uri = "http://api.metacpan.org/release/$module_meta->{distribution}";
                  my $dist_json = $self->get($dist_uri);
                  my $dist_meta = eval { JSON::PP::decode_json($dist_json) };
                  if ($dist_meta && $dist_meta->{download_url}) {
                      (my $distfile = $dist_meta->{download_url}) =~ s!.+/authors/id/!!;
                      local $self->{mirrors} = $self->{mirrors};
                      if ($dist_meta->{stat}->{mtime} > time()-24*60*60) {
                          $self->{mirrors} = ['http://cpan.metacpan.org'];
                      }
                      return $self->cpan_module($module, $distfile, $dist_meta->{version});
                  }
              }
              $self->diag_fail("Finding $module on metacpan failed.");
          }
  
          $self->chat("Searching $module on cpanmetadb ...\n");
          my $uri  = "http://cpanmetadb.plackperl.org/v1.0/package/$module";
          my $yaml = $self->get($uri);
          my $meta = $self->parse_meta_string($yaml);
          if ($meta && $meta->{distfile}) {
              return $self->cpan_module($module, $meta->{distfile}, $meta->{version});
          }
  
          $self->diag_fail("Finding $module on cpanmetadb failed.");
  
          $self->chat("Searching $module on search.cpan.org ...\n");
          my $uri  = "http://search.cpan.org/perldoc?$module";
          my $html = $self->get($uri);
          $html =~ m!<a href="/CPAN/authors/id/(.*?\.(?:tar\.gz|tgz|tar\.bz2|zip))">!
              and return $self->cpan_module($module, $1);
  
          $self->diag_fail("Finding $module on search.cpan.org failed.");
      }
  
      MIRROR: for my $mirror (@{ $self->{mirrors} }) {
          $self->chat("Searching $module on mirror $mirror ...\n");
          my $name = '02packages.details.txt.gz';
          my $uri  = "$mirror/modules/$name";
          my $gz_file = $self->package_index_for($mirror) . '.gz';
  
          unless ($self->{pkgs}{$uri}) {
              $self->chat("Downloading index file $uri ...\n");
              $self->mirror($uri, $gz_file);
              $self->generate_mirror_index($mirror) or next MIRROR;
              $self->{pkgs}{$uri} = "!!retrieved!!";
          }
  
          my $pkg = $self->search_mirror_index($mirror, $module, $version);
          return $pkg if $pkg;
  
          $self->diag_fail("Finding $module ($version) on mirror $mirror failed.");
      }
  
      return;
  }
  
  sub source_for {
      my($self, $mirror) = @_;
      $mirror =~ s/[^\w\.\-]+/%/g;
  
      my $dir = "$self->{home}/sources/$mirror";
      File::Path::mkpath([ $dir ], 0, 0777);
  
      return $dir;
  }
  
  sub load_argv_from_fh {
      my($self, $fh) = @_;
  
      my @argv;
      while(defined(my $line = <$fh>)){
          chomp $line;
          $line =~ s/#.+$//; # comment
          $line =~ s/^\s+//; # trim spaces
          $line =~ s/\s+$//; # trim spaces
  
          push @argv, split ' ', $line if $line;
      }
      return @argv;
  }
  
  sub show_version {
      print "cpanm (App::cpanminus) version $VERSION\n";
      return 1;
  }
  
  sub show_help {
      my $self = shift;
  
      if ($_[0]) {
          die <<USAGE;
  Usage: cpanm [options] Module [...]
  
  Try `cpanm --help` or `man cpanm` for more options.
  USAGE
      }
  
      print <<HELP;
  Usage: cpanm [options] Module [...]
  
  Options:
    -v,--verbose              Turns on chatty output
    -q,--quiet                Turns off the most output
    --interactive             Turns on interactive configure (required for Task:: modules)
    -f,--force                force install
    -n,--notest               Do not run unit tests
    --test-only               Run tests only, do not install
    -S,--sudo                 sudo to run install commands
    --installdeps             Only install dependencies
    --showdeps                Only display direct dependencies
    --reinstall               Reinstall the distribution even if you already have the latest version installed
    --mirror                  Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
    --mirror-only             Use the mirror's index file instead of the CPAN Meta DB
    --prompt                  Prompt when configure/build/test fails
    -l,--local-lib            Specify the install base to install modules
    -L,--local-lib-contained  Specify the install base to install all non-core modules
    --auto-cleanup            Number of days that cpanm's work directories expire in. Defaults to 7
  
  Commands:
    --self-upgrade            upgrades itself
    --info                    Displays distribution info on CPAN
    --look                    Opens the distribution with your SHELL
    -V,--version              Displays software version
  
  Examples:
  
    cpanm Test::More                                          # install Test::More
    cpanm MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution path
    cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz           # install from URL
    cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz            # install from a local file
    cpanm --interactive Task::Kensho                          # Configure interactively
    cpanm .                                                   # install from local directory
    cpanm --installdeps .                                     # install all the deps for the current directory
    cpanm -L extlib Plack                                     # install Plack and all non-core deps into extlib
    cpanm --mirror http://cpan.cpantesters.org/ DBI           # use the fast-syncing mirror
  
  You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
  
    export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
  
  Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
  
  HELP
  
      return 1;
  }
  
  sub _writable {
      my $dir = shift;
      my @dir = File::Spec->splitdir($dir);
      while (@dir) {
          $dir = File::Spec->catdir(@dir);
          if (-e $dir) {
              return -w _;
          }
          pop @dir;
      }
  
      return;
  }
  
  sub maybe_abs {
      my($self, $lib) = @_;
      return $lib if $lib eq '_'; # special case: gh-113
      $lib =~ /^[~\/]/ ? $lib : File::Spec->canonpath(Cwd::cwd . "/$lib");
  }
  
  sub bootstrap_local_lib {
      my $self = shift;
  
      # If -l is specified, use that.
      if ($self->{local_lib}) {
          return $self->setup_local_lib($self->{local_lib});
      }
  
      # root, locally-installed perl or --sudo: don't care about install_base
      return if $self->{sudo} or (_writable($Config{installsitelib}) and _writable($Config{installsitebin}));
  
      # local::lib is configured in the shell -- yay
      if ($ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT})) {
          $self->bootstrap_local_lib_deps;
          return;
      }
  
      $self->setup_local_lib;
  
      $self->diag(<<DIAG);
  !
  ! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
  ! To turn off this warning, you have to do one of the following:
  !   - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
  !   - Configure local::lib your existing local::lib in this shell to set PERL_MM_OPT etc.
  !   - Install local::lib by running the following commands
  !
  !         cpanm --local-lib=~/perl5 local::lib && eval \$(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
  !
  DIAG
      sleep 2;
  }
  
  sub _core_only_inc {
      my($self, $base) = @_;
      require local::lib;
      (
          local::lib->resolve_path(local::lib->install_base_perl_path($base)),
          local::lib->resolve_path(local::lib->install_base_arch_path($base)),
          @Config{qw(privlibexp archlibexp)},
      );
  }
  
  sub _diff {
      my($self, $old, $new) = @_;
  
      my @diff;
      my %old = map { $_ => 1 } @$old;
      for my $n (@$new) {
          push @diff, $n unless exists $old{$n};
      }
  
      @diff;
  }
  
  sub _setup_local_lib_env {
      my($self, $base) = @_;
      local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
      local::lib->setup_env_hash_for($base);
  }
  
  sub setup_local_lib {
      my($self, $base) = @_;
      $base = undef if $base eq '_';
  
      require local::lib;
      {
          local $0 = 'cpanm'; # so curl/wget | perl works
          $base ||= "~/perl5";
          if ($self->{self_contained}) {
              my @inc = $self->_core_only_inc($base);
              $self->{search_inc} = [ @inc ];
          } else {
              $self->{search_inc} = [
                  local::lib->resolve_path(local::lib->install_base_arch_path($base)),
                  local::lib->resolve_path(local::lib->install_base_perl_path($base)),
                  @INC,
              ];
          }
          $self->_setup_local_lib_env($base);
      }
  
      $self->bootstrap_local_lib_deps;
  }
  
  sub bootstrap_local_lib_deps {
      my $self = shift;
      push @{$self->{bootstrap_deps}},
          'ExtUtils::MakeMaker' => 6.31,
          'ExtUtils::Install'   => 1.46;
  }
  
  sub prompt_bool {
      my($self, $mess, $def) = @_;
  
      my $val = $self->prompt($mess, $def);
      return lc $val eq 'y';
  }
  
  sub prompt {
      my($self, $mess, $def) = @_;
  
      my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
      my $dispdef = defined $def ? "[$def] " : " ";
      $def = defined $def ? $def : "";
  
      if (!$self->{prompt} || (!$isa_tty && eof STDIN)) {
          return $def;
      }
  
      local $|=1;
      local $\;
      my $ans;
      eval {
          local $SIG{ALRM} = sub { undef $ans; die "alarm\n" };
          print STDOUT "$mess $dispdef";
          alarm $self->{prompt_timeout} if $self->{prompt_timeout};
          $ans = <STDIN>;
          alarm 0;
      };
      if ( defined $ans ) {
          chomp $ans;
      } else { # user hit ctrl-D or alarm timeout
          print STDOUT "\n";
      }
  
      return (!defined $ans || $ans eq '') ? $def : $ans;
  }
  
  sub diag_ok {
      my($self, $msg) = @_;
      chomp $msg;
      $msg ||= "OK";
      if ($self->{in_progress}) {
          $self->_diag("$msg\n");
          $self->{in_progress} = 0;
      }
      $self->log("-> $msg\n");
  }
  
  sub diag_fail {
      my($self, $msg, $always) = @_;
      chomp $msg;
      if ($self->{in_progress}) {
          $self->_diag("FAIL\n");
          $self->{in_progress} = 0;
      }
  
      if ($msg) {
          $self->_diag("! $msg\n", $always);
          $self->log("-> FAIL $msg\n");
      }
  }
  
  sub diag_progress {
      my($self, $msg) = @_;
      chomp $msg;
      $self->{in_progress} = 1;
      $self->_diag("$msg ... ");
      $self->log("$msg\n");
  }
  
  sub _diag {
      my($self, $msg, $always) = @_;
      print STDERR $msg if $always or $self->{verbose} or !$self->{quiet};
  }
  
  sub diag {
      my($self, $msg, $always) = @_;
      $self->_diag($msg, $always);
      $self->log($msg);
  }
  
  sub chat {
      my $self = shift;
      print STDERR @_ if $self->{verbose};
      $self->log(@_);
  }
  
  sub log {
      my $self = shift;
      open my $out, ">>$self->{log}";
      print $out @_;
  }
  
  sub run {
      my($self, $cmd) = @_;
  
      if (WIN32 && ref $cmd eq 'ARRAY') {
          $cmd = join q{ }, map { $self->shell_quote($_) } @$cmd;
      }
  
      if (ref $cmd eq 'ARRAY') {
          my $pid = fork;
          if ($pid) {
              waitpid $pid, 0;
              return !$?;
          } else {
              $self->run_exec($cmd);
          }
      } else {
          unless ($self->{verbose}) {
              $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
          }
          !system $cmd;
      }
  }
  
  sub run_exec {
      my($self, $cmd) = @_;
  
      if (ref $cmd eq 'ARRAY') {
          unless ($self->{verbose}) {
              open my $logfh, ">>", $self->{log};
              open STDERR, '>&', $logfh;
              open STDOUT, '>&', $logfh;
              close $logfh;
          }
          exec @$cmd;
      } else {
          unless ($self->{verbose}) {
              $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
          }
          exec $cmd;
      }
  }
  
  sub run_timeout {
      my($self, $cmd, $timeout) = @_;
      return $self->run($cmd) if WIN32 || $self->{verbose} || !$timeout;
  
      my $pid = fork;
      if ($pid) {
          eval {
              local $SIG{ALRM} = sub { die "alarm\n" };
              alarm $timeout;
              waitpid $pid, 0;
              alarm 0;
          };
          if ($@ && $@ eq "alarm\n") {
              $self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");
              local $SIG{TERM} = 'IGNORE';
              kill TERM => 0;
              waitpid $pid, 0;
              return;
          }
          return !$?;
      } elsif ($pid == 0) {
          $self->run_exec($cmd);
      } else {
          $self->chat("! fork failed: falling back to system()\n");
          $self->run($cmd);
      }
  }
  
  sub configure {
      my($self, $cmd) = @_;
  
      # trick AutoInstall
      local $ENV{PERL5_CPAN_IS_RUNNING} = local $ENV{PERL5_CPANPLUS_IS_RUNNING} = $$;
  
      # e.g. skip CPAN configuration on local::lib
      local $ENV{PERL5_CPANM_IS_RUNNING} = $$;
  
      my $use_default = !$self->{interactive};
      local $ENV{PERL_MM_USE_DEFAULT} = $use_default;
  
      # skip man page generation
      local $ENV{PERL_MM_OPT} = $ENV{PERL_MM_OPT};
      unless ($self->{pod2man}) {
          $ENV{PERL_MM_OPT} .= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";
      }
  
      local $self->{verbose} = $self->{verbose} || $self->{interactive};
      $self->run_timeout($cmd, $self->{configure_timeout});
  }
  
  sub build {
      my($self, $cmd, $distname) = @_;
  
      return 1 if $self->run_timeout($cmd, $self->{build_timeout});
      while (1) {
          my $ans = lc $self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
          return                               if $ans eq 's';
          return $self->build($cmd, $distname) if $ans eq 'r';
          $self->show_build_log                if $ans eq 'e';
          $self->look                          if $ans eq 'l';
      }
  }
  
  sub test {
      my($self, $cmd, $distname) = @_;
      return 1 if $self->{notest};
  
      # https://rt.cpan.org/Ticket/Display.html?id=48965#txn-1013385
      local $ENV{PERL_MM_USE_DEFAULT} = 1;
  
      return 1 if $self->run_timeout($cmd, $self->{test_timeout});
      if ($self->{force}) {
          $self->diag_fail("Testing $distname failed but installing it anyway.");
          return 1;
      } else {
          $self->diag_fail;
          while (1) {
              my $ans = lc $self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?", "s");
              return                              if $ans eq 's';
              return $self->test($cmd, $distname) if $ans eq 'r';
              return 1                            if $ans eq 'f';
              $self->show_build_log               if $ans eq 'e';
              $self->look                         if $ans eq 'l';
          }
      }
  }
  
  sub install {
      my($self, $cmd, $uninst_opts, $depth) = @_;
  
      if ($depth == 0 && $self->{test_only}) {
          return 1;
      }
  
      if ($self->{sudo}) {
          unshift @$cmd, "sudo";
      }
  
      if ($self->{uninstall_shadows} && !$ENV{PERL_MM_OPT}) {
          push @$cmd, @$uninst_opts;
      }
  
      $self->run($cmd);
  }
  
  sub look {
      my $self = shift;
  
      my $shell = $ENV{SHELL};
      $shell  ||= $ENV{COMSPEC} if WIN32;
      if ($shell) {
          my $cwd = Cwd::cwd;
          $self->diag("Entering $cwd with $shell\n");
          system $shell;
      } else {
          $self->diag_fail("You don't seem to have a SHELL :/");
      }
  }
  
  sub show_build_log {
      my $self = shift;
  
      my @pagers = (
          $ENV{PAGER},
          (WIN32 ? () : ('less')),
          'more'
      );
      my $pager;
      while (@pagers) {
          $pager = shift @pagers;
          next unless $pager;
          $pager = $self->which($pager);
          next unless $pager;
          last;
      }
  
      if ($pager) {
          # win32 'more' doesn't allow "more build.log", the < is required
          system("$pager < $self->{log}");
      }
      else {
          $self->diag_fail("You don't seem to have a PAGER :/");
      }
  }
  
  sub chdir {
      my $self = shift;
      Cwd::chdir(File::Spec->canonpath($_[0])) or die "$_[0]: $!";
  }
  
  sub configure_mirrors {
      my $self = shift;
      unless (@{$self->{mirrors}}) {
          $self->{mirrors} = [ 'http://www.cpan.org' ];
      }
      for (@{$self->{mirrors}}) {
          s!^/!file:///!;
          s!/$!!;
      }
  }
  
  sub self_upgrade {
      my $self = shift;
      $self->{argv} = [ 'App::cpanminus' ];
      return; # continue
  }
  
  sub install_module {
      my($self, $module, $depth, $version) = @_;
  
      if ($self->{seen}{$module}++) {
          $self->chat("Already tried $module. Skipping.\n");
          return 1;
      }
  
      my $dist = $self->resolve_name($module, $version);
      unless ($dist) {
          $self->diag_fail("Couldn't find module or a distribution $module ($version)", 1);
          return;
      }
  
      if ($dist->{distvname} && $self->{seen}{$dist->{distvname}}++) {
          $self->chat("Already tried $dist->{distvname}. Skipping.\n");
          return 1;
      }
  
      if ($self->{cmd} eq 'info') {
          print $self->format_dist($dist), "\n";
          return 1;
      }
  
      $self->check_libs;
      $self->setup_module_build_patch unless $self->{pod2man};
  
      if ($dist->{module}) {
          my($ok, $local) = $self->check_module($dist->{module}, $dist->{module_version} || 0);
          if ($self->{skip_installed} && $ok) {
              $self->diag("$dist->{module} is up to date. ($local)\n", 1);
              return 1;
          }
      }
  
      if ($dist->{dist} eq 'perl'){
          $self->diag("skipping $dist->{pathname}\n");
          return 1;
      }
  
      $self->diag("--> Working on $module\n");
  
      $dist->{dir} ||= $self->fetch_module($dist);
  
      unless ($dist->{dir}) {
          $self->diag_fail("Failed to fetch distribution $dist->{distvname}", 1);
          return;
      }
  
      $self->chat("Entering $dist->{dir}\n");
      $self->chdir($self->{base});
      $self->chdir($dist->{dir});
  
      if ($self->{cmd} eq 'look') {
          $self->look;
          return 1;
      }
  
      return $self->build_stuff($module, $dist, $depth);
  }
  
  sub format_dist {
      my($self, $dist) = @_;
  
      # TODO support --dist-format?
      return "$dist->{cpanid}/$dist->{filename}";
  }
  
  sub fetch_module {
      my($self, $dist) = @_;
  
      $self->chdir($self->{base});
  
      for my $uri (@{$dist->{uris}}) {
          $self->diag_progress("Fetching $uri");
  
          # Ugh, $dist->{filename} can contain sub directory
          my $filename = $dist->{filename} || $uri;
          my $name = File::Basename::basename($filename);
  
          my $cancelled;
          my $fetch = sub {
              my $file;
              eval {
                  local $SIG{INT} = sub { $cancelled = 1; die "SIGINT\n" };
                  $self->mirror($uri, $name);
                  $file = $name if -e $name;
              };
              $self->chat("$@") if $@ && $@ ne "SIGINT\n";
              return $file;
          };
  
          my($try, $file);
          while ($try++ < 3) {
              $file = $fetch->();
              last if $cancelled or $file;
              $self->diag_fail("Download $uri failed. Retrying ... ");
          }
  
          if ($cancelled) {
              $self->diag_fail("Download cancelled.");
              return;
          }
  
          unless ($file) {
              $self->diag_fail("Failed to download $uri");
              next;
          }
  
          $self->diag_ok;
          $dist->{local_path} = File::Spec->rel2abs($name);
  
          my $dir = $self->unpack($file, $uri, $dist);
          next unless $dir; # unpack failed
  
          if (my $save = $self->{save_dists}) {
              my $path = "$save/authors/id/$dist->{pathname}";
              $self->chat("Copying $name to $path\n");
              File::Path::mkpath([ File::Basename::dirname($path) ], 0, 0777);
              File::Copy::copy($file, $path) or warn $!;
          }
  
          return $dist, $dir;
      }
  }
  
  sub unpack {
      my($self, $file, $uri, $dist) = @_;
  
      if ($self->{verify}) {
          $self->verify_archive($file, $uri, $dist) or return;
      }
  
      $self->chat("Unpacking $file\n");
      my $dir = $file =~ /\.zip/i ? $self->unzip($file) : $self->untar($file);
      unless ($dir) {
          $self->diag_fail("Failed to unpack $file: no directory");
      }
      return $dir;
  }
  
  sub verify_checksums_signature {
      my($self, $chk_file) = @_;
  
      require Module::Signature;
  
      $self->chat("Verifying the signature of CHECKSUMS\n");
  
      my $rv = eval {
          local $SIG{__WARN__} = sub {}; # suppress warnings
          my $v = Module::Signature::_verify($chk_file);
          $v == Module::Signature::SIGNATURE_OK();
      };
      if ($rv) {
          $self->chat("Verified OK!\n");
      } else {
          $self->diag_fail("Verifying CHECKSUMS signature failed: $rv\n");
          return;
      }
  
      return 1;
  }
  
  sub verify_archive {
      my($self, $file, $uri, $dist) = @_;
  
      unless ($dist->{cpanid}) {
          $self->chat("Archive '$file' does not seem to be from PAUSE. Skip verification.\n");
      }
  
      (my $mirror = $uri) =~ s!/authors/id.*$!!;
  
      (my $chksum_uri = $uri) =~ s!/[^/]*$!/CHECKSUMS!;
      my $chk_file = $self->source_for($mirror) . "/$dist->{cpanid}.CHECKSUMS";
      $self->diag_progress("Fetching $chksum_uri");
      $self->mirror($chksum_uri, $chk_file);
  
      unless (-e $chk_file) {
          $self->diag_fail("Fetching $chksum_uri failed.\n");
          return;
      }
  
      $self->diag_ok;
      $self->verify_checksums_signature($chk_file) or return;
      $self->verify_checksum($file, $chk_file);
  }
  
  sub verify_checksum {
      my($self, $file, $chk_file) = @_;
  
      $self->chat("Verifying the SHA1 for $file\n");
  
      open my $fh, "<$chk_file" or die "$chk_file: $!";
      my $data = join '', <$fh>;
      $data =~ s/\015?\012/\n/g;
  
      require Safe;
      my $chksum = Safe->new->reval($data);
  
      if (!ref $chksum or ref $chksum ne 'HASH') {
          $self->diag_fail("! Checksum file downloaded from $chk_file is broken.\n");
          return;
      }
  
      if (my $sha = $chksum->{$file}{sha256}) {
          my $hex = $self->sha1_for($file);
          if ($hex eq $sha) {
              $self->chat("Checksum for $file: Verified!\n");
          } else {
              $self->diag_fail("Checksum mismatch for $file\n");
              return;
          }
      } else {
          $self->chat("Checksum for $file not found in CHECKSUMS.\n");
          return;
      }
  }
  
  sub sha1_for {
      my($self, $file) = @_;
  
      require Digest::SHA;
  
      open my $fh, "<", $file or die "$file: $!";
      my $dg = Digest::SHA->new(256);
      my($data);
      while (read($fh, $data, 4096)) {
          $dg->add($data);
      }
  
      return $dg->hexdigest;
  }
  
  sub verify_signature {
      my($self, $dist) = @_;
  
      $self->diag_progress("Verifying the SIGNATURE file");
      my $out = `$self->{cpansign} -v --skip 2>&1`;
      $self->log($out);
  
      if ($out =~ /Signature verified OK/) {
          $self->diag_ok("Verified OK");
          return 1;
      } else {
          $self->diag_fail("SIGNATURE verificaion for $dist->{filename} failed\n");
          return;
      }
  }
  
  sub resolve_name {
      my($self, $module, $version) = @_;
  
      # URL
      if ($module =~ /^(ftp|https?|file):/) {
          if ($module =~ m!authors/id/!) {
              return $self->cpan_dist($module, $module);
          } else {
              return { uris => [ $module ] };
          }
      }
  
      # Directory
      if ($module =~ m!^[\./]! && -d $module) {
          return {
              source => 'local',
              dir => Cwd::abs_path($module),
          };
      }
  
      # File
      if (-f $module) {
          return {
              source => 'local',
              uris => [ "file://" . Cwd::abs_path($module) ],
          };
      }
  
      # cpan URI
      if ($module =~ s!^cpan:///distfile/!!) {
          return $self->cpan_dist($module);
      }
  
      # PAUSEID/foo
      if ($module =~ m!([A-Z]{3,})/!) {
          return $self->cpan_dist($module);
      }
  
      # Module name
      return $self->search_module($module, $version);
  }
  
  sub cpan_module {
      my($self, $module, $dist, $version) = @_;
  
      my $dist = $self->cpan_dist($dist);
      $dist->{module} = $module;
      $dist->{module_version} = $version if $version && $version ne 'undef';
  
      return $dist;
  }
  
  sub cpan_dist {
      my($self, $dist, $url) = @_;
  
      $dist =~ s!^([A-Z]{3})!substr($1,0,1)."/".substr($1,0,2)."/".$1!e;
  
      require CPAN::DistnameInfo;
      my $d = CPAN::DistnameInfo->new($dist);
  
      if ($url) {
          $url = [ $url ] unless ref $url eq 'ARRAY';
      } else {
          my $id = $d->cpanid;
          my $fn = substr($id, 0, 1) . "/" . substr($id, 0, 2) . "/" . $id . "/" . $d->filename;
  
          my @mirrors = @{$self->{mirrors}};
          my @urls    = map "$_/authors/id/$fn", @mirrors;
  
          $url = \@urls,
      }
  
      return {
          $d->properties,
          source  => 'cpan',
          uris    => $url,
      };
  }
  
  sub setup_module_build_patch {
      my $self = shift;
  
      open my $out, ">$self->{base}/ModuleBuildSkipMan.pm" or die $!;
      print $out <<EOF;
  package ModuleBuildSkipMan;
  CHECK {
    if (%Module::Build::) {
      no warnings 'redefine';
      *Module::Build::Base::ACTION_manpages = sub {};
      *Module::Build::Base::ACTION_docs     = sub {};
    }
  }
  1;
  EOF
  }
  
  sub check_module {
      my($self, $mod, $want_ver) = @_;
  
      require Module::Metadata;
      my $meta = Module::Metadata->new_from_module($mod, inc => $self->{search_inc})
          or return 0, undef;
  
      my $version = $meta->version;
  
      # When -L is in use, the version loaded from 'perl' library path
      # might be newer than (or actually wasn't core at) the version
      # that is shipped with the current perl
      if ($self->{self_contained} && $self->loaded_from_perl_lib($meta)) {
          require Module::CoreList;
          unless (exists $Module::CoreList::version{$]+0}{$mod}) {
              return 0, undef;
          }
          $version = $Module::CoreList::version{$]+0}{$mod};
      }
  
      $self->{local_versions}{$mod} = $version;
  
      if ($self->is_deprecated($meta)){
          return 0, $version;
      } elsif (!$want_ver or $version >= version->new($want_ver)) {
          return 1, ($version || 'undef');
      } else {
          return 0, $version;
      }
  }
  
  sub is_deprecated {
      my($self, $meta) = @_;
  
      my $deprecated = eval {
          require Module::CoreList;
          Module::CoreList::is_deprecated($meta->{module});
      };
  
      return unless $deprecated;
      return $self->loaded_from_perl_lib($meta);
  }
  
  sub loaded_from_perl_lib {
      my($self, $meta) = @_;
  
      require Config;
      for my $dir (qw(archlibexp privlibexp)) {
          my $confdir = $Config{$dir};
          if ($confdir eq substr($meta->filename, 0, length($confdir))) {
              return 1;
          }
      }
  
      return;
  }
  
  sub should_install {
      my($self, $mod, $ver) = @_;
  
      $self->chat("Checking if you have $mod $ver ... ");
      my($ok, $local) = $self->check_module($mod, $ver);
  
      if ($ok)       { $self->chat("Yes ($local)\n") }
      elsif ($local) { $self->chat("No ($local < $ver)\n") }
      else           { $self->chat("No\n") }
  
      return $mod unless $ok;
      return;
  }
  
  sub install_deps {
      my($self, $dir, $depth, @deps) = @_;
  
      my(@install, %seen);
      while (my($mod, $ver) = splice @deps, 0, 2) {
          next if $seen{$mod} or $mod eq 'perl' or $mod eq 'Config';
          if ($self->should_install($mod, $ver)) {
              push @install, [ $mod, $ver ];
              $seen{$mod} = 1;
          }
      }
  
      if (@install) {
          $self->diag("==> Found dependencies: " . join(", ",  map $_->[0], @install) . "\n");
      }
  
      my @fail;
      for my $mod (@install) {
          $self->install_module($mod->[0], $depth + 1, $mod->[1])
              or push @fail, $mod->[0];
      }
  
      $self->chdir($self->{base});
      $self->chdir($dir) if $dir;
  
      return @fail;
  }
  
  sub install_deps_bailout {
      my($self, $target, $dir, $depth, @deps) = @_;
  
      my @fail = $self->install_deps($dir, $depth, @deps);
      if (@fail) {
          unless ($self->prompt_bool("Installing the following dependencies failed:\n==> " .
                                     join(", ", @fail) . "\nDo you want to continue building $target anyway?", "n")) {
              $self->diag_fail("Bailing out the installation for $target. Retry with --prompt or --force.", 1);
              return;
          }
      }
  
      return 1;
  }
  
  sub build_stuff {
      my($self, $stuff, $dist, $depth) = @_;
  
      if ($self->{verify} && -e 'SIGNATURE') {
          $self->verify_signature($dist) or return;
      }
  
      my @config_deps;
      if (!%{$dist->{meta} || {}} && -e 'META.yml') {
          $self->chat("Checking configure dependencies from META.yml\n");
          $dist->{meta} = $self->parse_meta('META.yml');
      }
  
      if (!$dist->{meta} && $dist->{source} eq 'cpan') {
          $self->chat("META.yml not found or unparsable. Fetching META.yml from search.cpan.org\n");
          $dist->{meta} = $self->fetch_meta_sco($dist);
      }
  
      $dist->{meta} ||= {};
  
      push @config_deps, %{$dist->{meta}{configure_requires} || {}};
  
      my $target = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};
  
      $self->install_deps_bailout($target, $dist->{dir}, $depth, @config_deps)
          or return;
  
      $self->diag_progress("Configuring $target");
  
      my $configure_state = $self->configure_this($dist, $depth);
  
      $self->diag_ok($configure_state->{configured_ok} ? "OK" : "N/A");
  
      my @deps = $self->find_prereqs($dist);
      my $module_name = $self->find_module_name($configure_state) || $dist->{meta}{name};
      $module_name =~ s/-/::/g;
  
      if ($self->{showdeps}) {
          my %rootdeps = (@config_deps, @deps); # merge
          for my $mod (keys %rootdeps) {
              my $ver = $rootdeps{$mod};
              print $mod, ($ver ? "~$ver" : ""), "\n";
          }
          return 1;
      }
  
      my $distname = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;
  
      my $walkup;
      if ($self->{scandeps}) {
          $walkup = $self->scandeps_append_child($dist);
      }
  
      $self->install_deps_bailout($distname, $dist->{dir}, $depth, @deps)
          or return;
  
      if ($self->{scandeps}) {
          unless ($configure_state->{configured_ok}) {
              my $diag = <<DIAG;
  ! Configuring $distname failed. See $self->{log} for details.
  ! You might have to install the following modules first to get --scandeps working correctly.
  DIAG
              if (@config_deps) {
                  my @tree = @{$self->{scandeps_tree}};
                  $diag .= "!\n" . join("", map "! * $_->[0]{module}\n", @tree[0..$#tree-1]) if @tree;
              }
              $self->diag("!\n$diag!\n", 1);
          }
          $walkup->();
          return 1;
      }
  
      if ($self->{installdeps} && $depth == 0) {
          if ($configure_state->{configured_ok}) {
              $self->diag("<== Installed dependencies for $stuff. Finishing.\n");
              return 1;
          } else {
              $self->diag("! Configuring $distname failed. See $self->{log} for details.\n", 1);
              return;
          }
      }
  
      my $installed;
      if ($configure_state->{use_module_build} && -e 'Build' && -f _) {
          my @switches = $self->{pod2man} ? () : ("-I$self->{base}", "-MModuleBuildSkipMan");
          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
          $self->build([ $self->{perl}, @switches, "./Build" ], $distname) &&
          $self->test([ $self->{perl}, "./Build", "test" ], $distname) &&
          $self->install([ $self->{perl}, @switches, "./Build", "install" ], [ "--uninst", 1 ], $depth) &&
          $installed++;
      } elsif ($self->{make} && -e 'Makefile') {
          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
          $self->build([ $self->{make} ], $distname) &&
          $self->test([ $self->{make}, "test" ], $distname) &&
          $self->install([ $self->{make}, "install" ], [ "UNINST=1" ], $depth) &&
          $installed++;
      } else {
          my $why;
          my $configure_failed = $configure_state->{configured} && !$configure_state->{configured_ok};
          if ($configure_failed) { $why = "Configure failed for $distname." }
          elsif ($self->{make})  { $why = "The distribution doesn't have a proper Makefile.PL/Build.PL" }
          else                   { $why = "Can't configure the distribution. You probably need to have 'make'." }
  
          $self->diag_fail("$why See $self->{log} for details.", 1);
          return;
      }
  
      if ($installed && $self->{test_only}) {
          $self->diag_ok;
          $self->diag("Successfully tested $distname\n", 1);
      } elsif ($installed) {
          my $local   = $self->{local_versions}{$dist->{module} || ''};
          my $version = $dist->{module_version} || $dist->{meta}{version} || $dist->{version};
          my $reinstall = $local && ($local eq $version);
  
          my $how = $reinstall ? "reinstalled $distname"
                  : $local     ? "installed $distname (upgraded from $local)"
                               : "installed $distname" ;
          my $msg = "Successfully $how";
          $self->diag_ok;
          $self->diag("$msg\n", 1);
          $self->{installed_dists}++;
          $self->save_meta($stuff, $dist, $module_name, \@config_deps, \@deps);
          return 1;
      } else {
          my $what = $self->{test_only} ? "Testing" : "Installing";
          $self->diag_fail("$what $stuff failed. See $self->{log} for details.", 1);
          return;
      }
  }
  
  sub configure_this {
      my($self, $dist, $depth) = @_;
  
      if (-e 'cpanfile' && $self->{installdeps} && $depth == 0) {
          require Module::CPANfile;
          $dist->{cpanfile} = eval { Module::CPANfile->load('cpanfile') };
          return {
              configured       => 1,
              configured_ok    => !!$dist->{cpanfile},
              use_module_build => 0,
          };
      }
  
      if ($self->{skip_configure}) {
          my $eumm = -e 'Makefile';
          my $mb   = -e 'Build' && -f _;
          return {
              configured => 1,
              configured_ok => $eumm || $mb,
              use_module_build => $mb,
          };
      }
  
      my @mb_switches;
      unless ($self->{pod2man}) {
          # it has to be push, so Module::Build is loaded from the adjusted path when -L is in use
          push @mb_switches, ("-I$self->{base}", "-MModuleBuildSkipMan");
      }
  
      my $state = {};
  
      my $try_eumm = sub {
          if (-e 'Makefile.PL') {
              $self->chat("Running Makefile.PL\n");
  
              # 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}, "Makefile.PL" ])) {
                  $state->{configured_ok} = -e 'Makefile';
              }
              $state->{configured}++;
          }
      };
  
      my $try_mb = sub {
          if (-e 'Build.PL') {
              $self->chat("Running Build.PL\n");
              if ($self->configure([ $self->{perl}, @mb_switches, "Build.PL" ])) {
                  $state->{configured_ok} = -e 'Build' && -f _;
              }
              $state->{use_module_build}++;
              $state->{configured}++;
          }
      };
  
      # Module::Build deps should use MakeMaker because that causes circular deps and fail
      # Otherwise we should prefer Build.PL
      my %should_use_mm = map { $_ => 1 } qw( version ExtUtils-ParseXS ExtUtils-Install ExtUtils-Manifest );
  
      my @try;
      if ($dist->{dist} && $should_use_mm{$dist->{dist}}) {
          @try = ($try_eumm, $try_mb);
      } else {
          @try = ($try_mb, $try_eumm);
      }
  
      for my $try (@try) {
          $try->();
          last if $state->{configured_ok};
      }
  
      unless ($state->{configured_ok}) {
          while (1) {
              my $ans = lc $self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
              last                                        if $ans eq 's';
              return $self->configure_this($dist, $depth) if $ans eq 'r';
              $self->show_build_log                       if $ans eq 'e';
              $self->look                                 if $ans eq 'l';
          }
      }
  
      return $state;
  }
  
  sub find_module_name {
      my($self, $state) = @_;
  
      return unless $state->{configured_ok};
  
      if ($state->{use_module_build} &&
          -e "_build/build_params") {
          my $params = do { open my $in, "_build/build_params"; $self->safe_eval(join "", <$in>) };
          return eval { $params->[2]{module_name} } || undef;
      } elsif (-e "Makefile") {
          open my $mf, "Makefile";
          while (<$mf>) {
              if (/^\#\s+NAME\s+=>\s+(.*)/) {
                  return $self->safe_eval($1);
              }
          }
      }
  
      return;
  }
  
  sub save_meta {
      my($self, $module, $dist, $module_name, $config_deps, $build_deps) = @_;
  
      return unless $dist->{distvname} && $dist->{source} eq 'cpan';
  
      my $base = ($ENV{PERL_MM_OPT} || '') =~ /INSTALL_BASE=/
          ? ($self->install_base($ENV{PERL_MM_OPT}) . "/lib/perl5") : $Config{sitelibexp};
  
      my $provides = $self->_merge_hashref(
          map Module::Metadata->package_versions_from_directory($_),
              qw( blib/lib blib/arch ) # FCGI.pm :(
      );
  
      mkdir "blib/meta", 0777 or die $!;
  
      my $local = {
          name => $module_name,
          target => $module,
          version => $provides->{$module_name}{version} || $dist->{version},
          dist => $dist->{distvname},
          pathname => $dist->{pathname},
          provides => $provides,
      };
  
      require JSON::PP;
      open my $fh, ">", "blib/meta/install.json" or die $!;
      print $fh JSON::PP::encode_json($local);
  
      # Existence of MYMETA.* Depends on EUMM/M::B versions and CPAN::Meta
      if (-e "MYMETA.json") {
          File::Copy::copy("MYMETA.json", "blib/meta/MYMETA.json");
      }
  
      my @cmd = (
          ($self->{sudo} ? 'sudo' : ()),
          $^X,
          '-MExtUtils::Install=install',
          '-e',
          qq[install({ 'blib/meta' => '$base/$Config{archname}/.meta/$dist->{distvname}' })],
      );
      $self->run(\@cmd);
  }
  
  sub _merge_hashref {
      my($self, @hashrefs) = @_;
  
      my %hash;
      for my $h (@hashrefs) {
          %hash = (%hash, %$h);
      }
  
      return \%hash;
  }
  
  sub install_base {
      my($self, $mm_opt) = @_;
      $mm_opt =~ /INSTALL_BASE=(\S+)/ and return $1;
      die "Your PERL_MM_OPT doesn't contain INSTALL_BASE";
  }
  
  sub safe_eval {
      my($self, $code) = @_;
      eval $code;
  }
  
  sub find_prereqs {
      my($self, $dist) = @_;
  
      my @deps = $self->extract_meta_prereqs($dist);
  
      if ($dist->{module} =~ /^Bundle::/i) {
          push @deps, $self->bundle_deps($dist);
      }
  
      return @deps;
  }
  
  sub extract_meta_prereqs {
      my($self, $dist) = @_;
  
      if ($dist->{cpanfile}) {
          my $prereq = $dist->{cpanfile}->prereq;
          my @phase = $self->{notest} ? qw( build runtime ) : qw( build test runtime );
          require CPAN::Meta::Requirements;
          my $req = CPAN::Meta::Requirements->new;
          $req->add_requirements($prereq->requirements_for($_, 'requires')) for @phase;
          return %{$req->as_string_hash};
      }
  
      my $meta = $dist->{meta};
  
      my @deps;
      if (-e "MYMETA.json") {
          require JSON::PP;
          $self->chat("Checking dependencies from MYMETA.json ...\n");
          my $json = do { open my $in, "<MYMETA.json"; local $/; <$in> };
          my $mymeta = JSON::PP::decode_json($json);
          if ($mymeta) {
              $meta->{$_} = $mymeta->{$_} for qw(name version);
              return $self->extract_requires($mymeta);
          }
      }
  
      if (-e 'MYMETA.yml') {
          $self->chat("Checking dependencies from MYMETA.yml ...\n");
          my $mymeta = $self->parse_meta('MYMETA.yml');
          if ($mymeta) {
              $meta->{$_} = $mymeta->{$_} for qw(name version);
              return $self->extract_requires($mymeta);
          }
      }
  
      if (-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);
      } elsif (-e 'Makefile') {
          $self->chat("Finding PREREQ from Makefile ...\n");
          open my $mf, "Makefile";
          while (<$mf>) {
              if (/^\#\s+PREREQ_PM => \{\s*(.*?)\s*\}/) {
                  my @all;
                  my @pairs = split ', ', $1;
                  for (@pairs) {
                      my ($pkg, $v) = split '=>', $_;
                      push @all, [ $pkg, $v ];
                  }
                  my $list = join ", ", map { "'$_->[0]' => $_->[1]" } @all;
                  my $prereq = $self->safe_eval("no strict; +{ $list }");
                  push @deps, %$prereq if $prereq;
                  last;
              }
          }
      }
  
      return @deps;
  }
  
  sub bundle_deps {
      my($self, $dist) = @_;
  
      my @files;
      File::Find::find({
          wanted => sub { push @files, File::Spec->rel2abs($_) if /\.pm/i },
          no_chdir => 1,
      }, '.');
  
      my @deps;
  
      for my $file (@files) {
          open my $pod, "<", $file or next;
          my $in_contents;
          while (<$pod>) {
              if (/^=head\d\s+CONTENTS/) {
                  $in_contents = 1;
              } elsif (/^=/) {
                  $in_contents = 0;
              } elsif ($in_contents) {
                  /^(\S+)\s*(\S+)?/
                      and push @deps, $1, $self->maybe_version($2);
              }
          }
      }
  
      return @deps;
  }
  
  sub maybe_version {
      my($self, $string) = @_;
      return $string && $string =~ /^\.?\d/ ? $string : undef;
  }
  
  sub extract_requires {
      my($self, $meta) = @_;
  
      if ($meta->{'meta-spec'} && $meta->{'meta-spec'}{version} == 2) {
          my @phase = $self->{notest} ? qw( build runtime ) : qw( build test runtime );
          my @deps = map {
              my $p = $meta->{prereqs}{$_} || {};
              %{$p->{requires} || {}};
          } @phase;
          return @deps;
      }
  
      my @deps;
      push @deps, %{$meta->{build_requires}} if $meta->{build_requires};
      push @deps, %{$meta->{requires}} if $meta->{requires};
  
      return @deps;
  }
  
  sub cleanup_workdirs {
      my $self = shift;
  
      my $expire = time - 24 * 60 * 60 * $self->{auto_cleanup};
      my @targets;
  
      opendir my $dh, "$self->{home}/work";
      while (my $e = readdir $dh) {
          next if $e !~ /^(\d+)\.\d+$/; # {UNIX time}.{PID}
          my $time = $1;
          if ($time < $expire) {
              push @targets, "$self->{home}/work/$e";
          }
      }
  
      if (@targets) {
          $self->chat("Expiring ", scalar(@targets), " work directories.\n");
          File::Path::rmtree(\@targets, 0, 0); # safe = 0, since blib usually doesn't have write bits
      }
  }
  
  sub scandeps_append_child {
      my($self, $dist) = @_;
  
      my $new_node = [ $dist, [] ];
  
      my $curr_node = $self->{scandeps_current} || [ undef, $self->{scandeps_tree} ];
      push @{$curr_node->[1]}, $new_node;
  
      $self->{scandeps_current} = $new_node;
  
      return sub { $self->{scandeps_current} = $curr_node };
  }
  
  sub dump_scandeps {
      my $self = shift;
  
      if ($self->{format} eq 'tree') {
          $self->walk_down(sub {
              my($dist, $depth) = @_;
              if ($depth == 0) {
                  print "$dist->{distvname}\n";
              } else {
                  print " " x ($depth - 1);
                  print "\\_ $dist->{distvname}\n";
              }
          }, 1);
      } elsif ($self->{format} =~ /^dists?$/) {
          $self->walk_down(sub {
              my($dist, $depth) = @_;
              print $self->format_dist($dist), "\n";
          }, 0);
      } elsif ($self->{format} eq 'json') {
          require JSON::PP;
          print JSON::PP::encode_json($self->{scandeps_tree});
      } elsif ($self->{format} eq 'yaml') {
          require YAML;
          print YAML::Dump($self->{scandeps_tree});
      } else {
          $self->diag("Unknown format: $self->{format}\n");
      }
  }
  
  sub walk_down {
      my($self, $cb, $pre) = @_;
      $self->_do_walk_down($self->{scandeps_tree}, $cb, 0, $pre);
  }
  
  sub _do_walk_down {
      my($self, $children, $cb, $depth, $pre) = @_;
  
      # DFS - $pre determines when we call the callback
      for my $node (@$children) {
          $cb->($node->[0], $depth) if $pre;
          $self->_do_walk_down($node->[1], $cb, $depth + 1, $pre);
          $cb->($node->[0], $depth) unless $pre;
      }
  }
  
  sub DESTROY {
      my $self = shift;
      $self->{at_exit}->($self) if $self->{at_exit};
  }
  
  # Utils
  
  sub shell_quote {
      my($self, $stuff) = @_;
      $stuff =~ /^${quote}.+${quote}$/ ? $stuff : ($quote . $stuff . $quote);
  }
  
  sub which {
      my($self, $name) = @_;
      my $exe_ext = $Config{_exe};
      for my $dir (File::Spec->path) {
          my $fullpath = File::Spec->catfile($dir, $name);
          if (-x $fullpath || -x ($fullpath .= $exe_ext)) {
              if ($fullpath =~ /\s/ && $fullpath !~ /^$quote/) {
                  $fullpath = $self->shell_quote($fullpath);
              }
              return $fullpath;
          }
      }
      return;
  }
  
  sub get      { $_[0]->{_backends}{get}->(@_) };
  sub mirror   { $_[0]->{_backends}{mirror}->(@_) };
  sub untar    { $_[0]->{_backends}{untar}->(@_) };
  sub unzip    { $_[0]->{_backends}{unzip}->(@_) };
  
  sub file_get {
      my($self, $uri) = @_;
      open my $fh, "<$uri" or return;
      join '', <$fh>;
  }
  
  sub file_mirror {
      my($self, $uri, $path) = @_;
      File::Copy::copy($uri, $path);
  }
  
  sub init_tools {
      my $self = shift;
  
      return if $self->{initialized}++;
  
      if ($self->{make} = $self->which($Config{make})) {
          $self->chat("You have make $self->{make}\n");
      }
  
      # use --no-lwp if they have a broken LWP, to upgrade LWP
      if ($self->{try_lwp} && eval { require LWP::UserAgent; LWP::UserAgent->VERSION(5.802) }) {
          $self->chat("You have LWP $LWP::VERSION\n");
          my $ua = sub {
              LWP::UserAgent->new(
                  parse_head => 0,
                  env_proxy => 1,
                  agent => "cpanminus/$VERSION",
                  timeout => 30,
                  @_,
              );
          };
          $self->{_backends}{get} = sub {
              my $self = shift;
              my $res = $ua->()->request(HTTP::Request->new(GET => $_[0]));
              return unless $res->is_success;
              return $res->decoded_content;
          };
          $self->{_backends}{mirror} = sub {
              my $self = shift;
              my $res = $ua->()->mirror(@_);
              $res->code;
          };
      } elsif ($self->{try_wget} and my $wget = $self->which('wget')) {
          $self->chat("You have $wget\n");
          $self->{_backends}{get} = sub {
              my($self, $uri) = @_;
              return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
              $self->safeexec( my $fh, $wget, $uri, ( $self->{verbose} ? () : '-q' ), '-O', '-' ) or die "wget $uri: $!";
              local $/;
              <$fh>;
          };
          $self->{_backends}{mirror} = sub {
              my($self, $uri, $path) = @_;
              return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;
              $self->safeexec( my $fh, $wget, '--retry-connrefused', $uri, ( $self->{verbose} ? () : '-q' ), '-O', $path ) or die "wget $uri: $!";
              local $/;
              <$fh>;
          };
      } elsif ($self->{try_curl} and my $curl = $self->which('curl')) {
          $self->chat("You have $curl\n");
          $self->{_backends}{get} = sub {
              my($self, $uri) = @_;
              return $self->file_get($uri) if $uri =~ s!^file:/+!/!;
              $self->safeexec( my $fh, $curl, '-L', ( $self->{verbose} ? () : '-s' ), $uri ) or die "curl $uri: $!";
              local $/;
              <$fh>;
          };
          $self->{_backends}{mirror} = sub {
              my($self, $uri, $path) = @_;
              return $self->file_mirror($uri, $path) if $uri =~ s!^file:/+!/!;
              $self->safeexec( my $fh, $curl, '-L', $uri, ( $self->{verbose} ? () : '-s' ), '-#', '-o', $path ) or die "curl $uri: $!";
              local $/;
              <$fh>;
          };
      } else {
          require HTTP::Tiny;
          $self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");
  
          $self->{_backends}{get} = sub {
              my $self = shift;
              my $res = HTTP::Tiny->new->get($_[0]);
              return unless $res->{success};
              return $res->{content};
          };
          $self->{_backends}{mirror} = sub {
              my $self = shift;
              my $res = HTTP::Tiny->new->mirror(@_);
              return $res->{status};
          };
      }
  
      my $tar = $self->which('tar');
      my $tar_ver;
      my $maybe_bad_tar = sub { WIN32 || SUNOS || (($tar_ver = `$tar --version 2>/dev/null`) =~ /GNU.*1\.13/i) };
  
      if ($tar && !$maybe_bad_tar->()) {
          chomp $tar_ver;
          $self->chat("You have $tar: $tar_ver\n");
          $self->{_backends}{untar} = sub {
              my($self, $tarfile) = @_;
  
              my $xf = ($self->{verbose} ? 'v' : '')."xf";
              my $ar = $tarfile =~ /bz2$/ ? 'j' : 'z';
  
              my($root, @others) = `$tar ${ar}tf $tarfile`
                  or return undef;
  
              FILE: {
                  chomp $root;
                  $root =~ s!^\./!!;
                  $root =~ s{^(.+?)/.*$}{$1};
  
                  if (!length($root)) {
                      # archive had ./ as the first entry, so try again
                      $root = shift(@others);
                      redo FILE if $root;
                  }
              }
  
              system "$tar $ar$xf $tarfile";
              return $root if -d $root;
  
              $self->diag_fail("Bad archive: $tarfile");
              return undef;
          }
      } elsif (    $tar
               and my $gzip = $self->which('gzip')
               and my $bzip2 = $self->which('bzip2')) {
          $self->chat("You have $tar, $gzip and $bzip2\n");
          $self->{_backends}{untar} = sub {
              my($self, $tarfile) = @_;
  
              my $x  = "x" . ($self->{verbose} ? 'v' : '') . "f -";
              my $ar = $tarfile =~ /bz2$/ ? $bzip2 : $gzip;
  
              my($root, @others) = `$ar -dc $tarfile | $tar tf -`
                  or return undef;
  
              FILE: {
                  chomp $root;
                  $root =~ s!^\./!!;
                  $root =~ s{^(.+?)/.*$}{$1};
  
                  if (!length($root)) {
                      # archive had ./ as the first entry, so try again
                      $root = shift(@others);
                      redo FILE if $root;
                  }
              }
  
              system "$ar -dc $tarfile | $tar $x";
              return $root if -d $root;
  
              $self->diag_fail("Bad archive: $tarfile");
              return undef;
          }
      } elsif (eval { require Archive::Tar }) { # uses too much memory!
          $self->chat("Falling back to Archive::Tar $Archive::Tar::VERSION\n");
          $self->{_backends}{untar} = sub {
              my $self = shift;
              my $t = Archive::Tar->new($_[0]);
              my($root, @others) = $t->list_files;
              FILE: {
                  $root =~ s!^\./!!;
                  $root =~ s{^(.+?)/.*$}{$1};
  
                  if (!length($root)) {
                      # archive had ./ as the first entry, so try again
                      $root = shift(@others);
                      redo FILE if $root;
                  }
              }
              $t->extract;
              return -d $root ? $root : undef;
          };
      } else {
          $self->{_backends}{untar} = sub {
              die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n";
          };
      }
  
      if (my $unzip = $self->which('unzip')) {
          $self->chat("You have $unzip\n");
          $self->{_backends}{unzip} = sub {
              my($self, $zipfile) = @_;
  
              my $opt = $self->{verbose} ? '' : '-q';
              my(undef, $root, @others) = `$unzip -t $zipfile`
                  or return undef;
  
              chomp $root;
              $root =~ s{^\s+testing:\s+(.+?)/\s+OK$}{$1};
  
              system "$unzip $opt $zipfile";
              return $root if -d $root;
  
              $self->diag_fail("Bad archive: [$root] $zipfile");
              return undef;
          }
      } else {
          $self->{_backends}{unzip} = sub {
              eval { require Archive::Zip }
                  or  die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";
              my($self, $file) = @_;
              my $zip = Archive::Zip->new();
              my $status;
              $status = $zip->read($file);
              $self->diag_fail("Read of file[$file] failed")
                  if $status != Archive::Zip::AZ_OK();
              my @members = $zip->members();
              my $root;
              for my $member ( @members ) {
                  my $af = $member->fileName();
                  next if ($af =~ m!^(/|\.\./)!);
                  $root = $af unless $root;
                  $status = $member->extractToFileNamed( $af );
                  $self->diag_fail("Extracting of file[$af] from zipfile[$file failed")
                      if $status != Archive::Zip::AZ_OK();
              }
              return -d $root ? $root : undef;
          };
      }
  }
  
  sub safeexec {
      my $self = shift;
      my $rdr = $_[0] ||= Symbol::gensym();
  
      if (WIN32) {
          my $cmd = join q{ }, map { $self->shell_quote($_) } @_[ 1 .. $#_ ];
          return open( $rdr, "$cmd |" );
      }
  
      if ( my $pid = open( $rdr, '-|' ) ) {
          return $pid;
      }
      elsif ( defined $pid ) {
          exec( @_[ 1 .. $#_ ] );
          exit 1;
      }
      else {
          return;
      }
  }
  
  sub parse_meta {
      my($self, $file) = @_;
      return eval { (Parse::CPAN::Meta::LoadFile($file))[0] } || undef;
  }
  
  sub parse_meta_string {
      my($self, $yaml) = @_;
      return eval { (Parse::CPAN::Meta::Load($yaml))[0] } || undef;
  }
  
  1;
APP_CPANMINUS_SCRIPT

$fatpacked{"App/cpantimes.pm"} = <<'APP_CPANTIMES';
  package App::cpantimes;
  our $VERSION = "1.502101";
  
  =encoding utf8
  
  =head1 NAME
  
  App::cpantimes - get, unpack, build, install and report on modules from CPAN
  
  =head1 SYNOPSIS
  
      cpant Module
  
  Run C<cpant -h> or C<perldoc cpant> for more options.
  
  =head1 DESCRIPTION
  
  C<cpant> is a fairly trivial fork of L<cpanm>, adding support for
  submitting reports to the CPAN testers service.
  
  =head1 SEE ALSO
  
  This is severely based on L<App::cpanminus>, so see that for help,
  credits, etc.
  
  =head1 COPYRIGHT
  
  Copyright 2012-2013 Toby Inkster.
  
  The standalone executable contains the following modules embedded.
  
  =over 4
  
  =item L<App::cpanminus::script> Copyright 2010- Tatsuhiko Miyagawa
  
  =item L<CPAN::DistnameInfo> Copyright 2003 Graham Barr
  
  =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
  
  =item L<local::lib> Copyright 2007-2009 Matt S Trout
  
  =item L<HTTP::Tiny> Copyright 2011 Christian Hansen
  
  =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
  
  =item L<version> Copyright 2004-2010 John Peacock
  
  =item L<JSON::PP> Copyright 2007−2011 by Makamaka Hannyaharamitu
  
  =item L<CPAN::Meta> Copyright (c) 2010 by David Golden and Ricardo Signes
  
  =item L<Try::Tiny> Copyright (c) 2009 Yuval Kogman
  
  =item L<parent> Copyright (c) 2007-10 Max Maischein
  
  =item L<Version::Requirements> copyright (c) 2010 by Ricardo Signes
  
  =item L<CPAN::Meta::YAML> copyright (c) 2010 by Adam Kennedy
  
  =back
  
  =head1 LICENSE
  
  Same as Perl.
  
  =cut
  
  1;
APP_CPANTIMES

$fatpacked{"App/cpantimes/script.pm"} = <<'APP_CPANTIMES_SCRIPT';
  package App::cpantimes::script;
  
  our $VERSION = "1.502101";
  
  use 5.008;
  use strict;
  use base 'App::cpanminus::script';
  
  my $HOME =
  	defined $ENV{HOME}     ? $ENV{HOME} :
  	defined $ENV{APPDATA}  ? $ENV{APPDATA} :
  	die("Could not determine home directory!");
  
  sub new
  {
  	my ($class, @args) = @_;
  	my $self = $class->SUPER::new(@args);
  	
  	$self->{_metabase_api}  = 'https://metabase.cpantesters.org/api/v1/';
  	$self->{_metabase_file} = "File::Spec"->catfile(
  		$HOME,
  		qw< .cpantesters metabase_id.json >,
  	);
  
  	eval {
  		require Test::Reporter;
  		require Test::Reporter::Transport::Metabase;
  		require LWP::Protocol::https;
  		-r $self->{_metabase_file};
  	} or warn <<"WARNING";
  
  *** WARNING ***
  You are using cpantimes, a modified version of cpanminus with CPAN testers
  support, but it is not correctly configured. Please ensure Test::Reporter,
  Test::Reporter::Transport::Metabase and LWP::Protocol::https are installed,
  and use the `metabase-profile` tool to create Metabase login details as
  "$self->{_metabase_file}".
  
  Installation will now continue as normal, but test reports will NOT be
  sent!
  
  WARNING
  
  	return $self;
  }
  
  # Need to clear _current_dist before each installation, to ensure reports
  # don't get sent based on incorrect info.
  sub install_module
  {
  	my ($self, @args) = @_;
  	delete $self->{_current_dist};
  	$self->SUPER::install_module(@args);
  }
  
  sub resolve_name
  {
  	my ($self, @args) = @_;
  	my $dist = $self->SUPER::resolve_name(@args);
  	$self->{_current_dist} = $dist;
  	return $dist;
  }
  
  sub cpants_report
  {	
  	my ($self, $grade, $distname) = @_;
  	eval {
  		require Test::Reporter;
  		require Test::Reporter::Transport::Metabase;
  		require LWP::Protocol::https;
  		-r $self->{_metabase_file} and exists $self->{_current_dist}{filename};
  	} or return;
  	
  	my $report = <<"REPORT";
  $distname ... @{[ uc $grade ]}
  
  Perl           : $^V
  System         : $^O
  Local Versions :
  REPORT
  
  	for my $mod (keys %{ $self->{local_versions} }) {
  		$report .= sprintf("    %-32s : %s\n", $mod, $self->{local_versions}{$mod});
  	}
  	$report .= "\n";
  	
  	$report .= "Test Output    :\n\n";
  	$report .= do {
  		open my $log, '<', $self->{log};
  		local $/ = <$log>;
  	};
  	$report .= "\n";
  
  	my $Report = "Test::Reporter"->new(
  		transport      => 'Metabase',
  		transport_args => [
  			uri     => $self->{_metabase_api},
  			id_file => $self->{_metabase_file},
  		],
  		distribution   => $distname,
  		distfile       => sprintf(
  			'%s/%s',
  			$self->{_current_dist}{cpanid},
  			$self->{_current_dist}{filename},
  		),
  		grade          => $grade,
  		from           => 'null@invalid.invalid',
  		comments       => $report,
  	);
  
  	$Report->send;
  	warn $Report->errstr if $Report->errstr;
  }
  
  sub test
  {
  	my($self, $cmd, $distname) = @_;
  	return 1 if $self->{notest};
  
  	my $oldlog  = $self->{log};
  	my $logfile = "File::Spec"->catfile($self->{home}, "test.log");
  	1 while unlink $logfile;
  
  	local $ENV{PERL_MM_USE_DEFAULT} = 1;
  	local $self->{log} = $logfile;
  
  	my $return;
  	if ( $self->run_timeout($cmd, $self->{test_timeout}) )
  	{
  		$self->cpants_report(pass => $distname);
  		$return = 1;
  	}
  	else
  	{
  		$self->cpants_report(fail => $distname);
  	}
  		
  	open my $FULL, '>>', $oldlog;
  	open my $TEST, '<',  $self->{log};
  	while (<$TEST>) { print {$FULL} $_ };
  	$self->{log} = $oldlog;
  	return $return if defined $return;
  	
  	if ($self->{force})
  	{
  		$self->diag_fail("Testing $distname failed but installing it anyway.");
  		return 1;
  	}	
  	else
  	{
  		$self->diag_fail;
  		while (1)
  		{
  			my $ans = lc $self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?", "s");
  			return                              if $ans eq 's';
  			return $self->test($cmd, $distname) if $ans eq 'r';
  			return 1                            if $ans eq 'f';
  			$self->show_build_log               if $ans eq 'e';
  			$self->look                         if $ans eq 'l';
  		}
  	}
  }
  
  sub show_help {
      my $self = shift;
  
      if ($_[0]) {
          die <<USAGE;
  Usage: cpant [options] Module [...]
  
  Try `cpant --help` or `man cpant` for more options.
  USAGE
      }
  
      print <<HELP;
  Usage: cpant [options] Module [...]
  
  Options:
    -v,--verbose              Turns on chatty output
    -q,--quiet                Turns off the most output
    --interactive             Turns on interactive configure (required for Task:: modules)
    -f,--force                force install
    -n,--notest               Do not run unit tests
    --test-only               Run tests only, do not install
    -S,--sudo                 sudo to run install commands
    --installdeps             Only install dependencies
    --showdeps                Only display direct dependencies
    --reinstall               Reinstall the distribution even if you already have the latest version installed
    --mirror                  Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
    --mirror-only             Use the mirror's index file instead of the CPAN Meta DB
    --prompt                  Prompt when configure/build/test fails
    -l,--local-lib            Specify the install base to install modules
    -L,--local-lib-contained  Specify the install base to install all non-core modules
    --verify                  Verify the integrity of distribution files. Defaults to false
    --auto-cleanup            Number of days that cpant's work directories expire in. Defaults to 7
  
  Commands:
    --self-upgrade            upgrades itself
    --info                    Displays distribution info on CPAN
    --look                    Opens the distribution with your SHELL
    -V,--version              Displays software version
  
  Examples:
  
    cpant Test::More                                          # install Test::More
    cpant MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution path
    cpant http://example.org/LDS/CGI.pm-3.20.tar.gz           # install from URL
    cpant ~/dists/MyCompany-Enterprise-1.00.tar.gz            # install from a local file
    cpant --interactive Task::Kensho                          # Configure interactively
    cpant .                                                   # install from local directory
    cpant --installdeps .                                     # install all the deps for the current directory
    cpant -L extlib Plack                                     # install Plack and all non-core deps into extlib
    cpant --mirror http://cpan.cpantesters.org/ DBI           # use the fast-syncing mirror
  
  You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
  
    export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
  
  Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
  
  HELP
  
      return 1;
  }
  
  
  1;
APP_CPANTIMES_SCRIPT

$fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
  
  package CPAN::DistnameInfo;
  
  $VERSION = "0.11";
  use strict;
  
  sub distname_info {
    my $file = shift or return;
  
    my ($dist, $version) = $file =~ /^
      ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
       (?:
  	[A-Za-z](?=[^A-Za-z]|$)
  	|
  	\d(?=-)
       )(?<![._-][vV])
      )+)(.*)
    $/xs or return ($file,undef,undef);
  
    if ($dist =~ /-undef\z/ and ! length $version) {
      $dist =~ s/-undef\z//;
    }
  
    # Remove potential -withoutworldwriteables suffix
    $version =~ s/-withoutworldwriteables$//;
  
    if ($version =~ /^(-[Vv].*)-(\d.*)/) {
     
      # Catch names like Unicode-Collate-Standard-V3_1_1-0.1
      # where the V3_1_1 is part of the distname
      $dist .= $1;
      $version = $2;
    }
  
    # Normalize the Dist.pm-1.23 convention which CGI.pm and
    # a few others use.
    $dist =~ s{\.pm$}{};
  
    $version = $1
      if !length $version and $dist =~ s/-(\d+\w)$//;
  
    $version = $1 . $version
      if $version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;
  
    if ($version =~ /\d\.\d/) {
      $version =~ s/^[-_.]+//;
    }
    else {
      $version =~ s/^[-_]+//;
    }
  
    my $dev;
    if (length $version) {
      if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/) {
        $dev = 1 if (($1 > 6 and $1 & 1) or ($2 and $2 >= 50)) or $3;
      }
      elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/) {
        $dev = 1;
      }
    }
    else {
      $version = undef;
    }
  
    ($dist, $version, $dev);
  }
  
  sub new {
    my $class = shift;
    my $distfile = shift;
  
    $distfile =~ s,//+,/,g;
  
    my %info = ( pathname => $distfile );
  
    ($info{filename} = $distfile) =~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,,
      and $info{cpanid} = $6;
  
    if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i) { # support more ?
      $info{distvname} = $1;
      $info{extension} = $2;
    }
  
    @info{qw(dist version beta)} = distname_info($info{distvname});
    $info{maturity} = delete $info{beta} ? 'developer' : 'released';
  
    return bless \%info, $class;
  }
  
  sub dist      { shift->{dist} }
  sub version   { shift->{version} }
  sub maturity  { shift->{maturity} }
  sub filename  { shift->{filename} }
  sub cpanid    { shift->{cpanid} }
  sub distvname { shift->{distvname} }
  sub extension { shift->{extension} }
  sub pathname  { shift->{pathname} }
  
  sub properties { %{ $_[0] } }
  
  1;
  
  __END__
  
CPAN_DISTNAMEINFO

$fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta;
  BEGIN {
    $CPAN::Meta::VERSION = '2.110930';
  }
  # ABSTRACT: the distribution metadata for a CPAN dist
  
  
  use Carp qw(carp croak);
  use CPAN::Meta::Feature;
  use CPAN::Meta::Prereqs;
  use CPAN::Meta::Converter;
  use CPAN::Meta::Validator;
  use Parse::CPAN::Meta 1.4400 ();
  
  sub _dclone {
    my $ref = shift;
    my $backend = Parse::CPAN::Meta->json_backend();
    return $backend->new->decode(
      $backend->new->convert_blessed->encode($ref)
    );
  }
  
  
  BEGIN {
    my @STRING_READERS = qw(
      abstract
      description
      dynamic_config
      generated_by
      name
      release_status
      version
    );
  
    no strict 'refs';
    for my $attr (@STRING_READERS) {
      *$attr = sub { $_[0]{ $attr } };
    }
  }
  
  
  BEGIN {
    my @LIST_READERS = qw(
      author
      keywords
      license
    );
  
    no strict 'refs';
    for my $attr (@LIST_READERS) {
      *$attr = sub {
        my $value = $_[0]{ $attr };
        croak "$attr must be called in list context"
          unless wantarray;
        return @{ _dclone($value) } if ref $value;
        return $value;
      };
    }
  }
  
  sub authors  { $_[0]->author }
  sub licenses { $_[0]->license }
  
  
  BEGIN {
    my @MAP_READERS = qw(
      meta-spec
      resources
      provides
      no_index
  
      prereqs
      optional_features
    );
  
    no strict 'refs';
    for my $attr (@MAP_READERS) {
      (my $subname = $attr) =~ s/-/_/;
      *$subname = sub {
        my $value = $_[0]{ $attr };
        return _dclone($value) if $value;
        return {};
      };
    }
  }
  
  
  sub custom_keys {
    return grep { /^x_/i } keys %{$_[0]};
  }
  
  sub custom {
    my ($self, $attr) = @_;
    my $value = $self->{$attr};
    return _dclone($value) if ref $value;
    return $value;
  }
  
  
  sub _new {
    my ($class, $struct, $options) = @_;
    my $self;
  
    if ( $options->{lazy_validation} ) {
      # try to convert to a valid structure; if succeeds, then return it
      my $cmc = CPAN::Meta::Converter->new( $struct );
      $self = $cmc->convert( version => 2 ); # valid or dies
      return bless $self, $class;
    }
    else {
      # validate original struct
      my $cmv = CPAN::Meta::Validator->new( $struct );
      unless ( $cmv->is_valid) {
        die "Invalid metadata structure. Errors: "
          . join(", ", $cmv->errors) . "\n";
      }
    }
  
    # up-convert older spec versions
    my $version = $struct->{'meta-spec'}{version} || '1.0';
    if ( $version == 2 ) {
      $self = $struct;
    }
    else {
      my $cmc = CPAN::Meta::Converter->new( $struct );
      $self = $cmc->convert( version => 2 );
    }
  
    return bless $self, $class;
  }
  
  sub new {
    my ($class, $struct, $options) = @_;
    my $self = eval { $class->_new($struct, $options) };
    croak($@) if $@;
    return $self;
  }
  
  
  sub create {
    my ($class, $struct, $options) = @_;
    my $version = __PACKAGE__->VERSION || 2;
    $struct->{generated_by} ||= __PACKAGE__ . " version $version" ;
    $struct->{'meta-spec'}{version} ||= int($version);
    my $self = eval { $class->_new($struct, $options) };
    croak ($@) if $@;
    return $self;
  }
  
  
  sub load_file {
    my ($class, $file, $options) = @_;
    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
  
    croak "load_file() requires a valid, readable filename"
      unless -r $file;
  
    my $self;
    eval {
      my $struct = Parse::CPAN::Meta->load_file( $file );
      $self = $class->_new($struct, $options);
    };
    croak($@) if $@;
    return $self;
  }
  
  
  sub load_yaml_string {
    my ($class, $yaml, $options) = @_;
    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
  
    my $self;
    eval {
      my ($struct) = Parse::CPAN::Meta->load_yaml_string( $yaml );
      $self = $class->_new($struct, $options);
    };
    croak($@) if $@;
    return $self;
  }
  
  
  sub load_json_string {
    my ($class, $json, $options) = @_;
    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
  
    my $self;
    eval {
      my $struct = Parse::CPAN::Meta->load_json_string( $json );
      $self = $class->_new($struct, $options);
    };
    croak($@) if $@;
    return $self;
  }
  
  
  sub save {
    my ($self, $file, $options) = @_;
  
    my $version = $options->{version} || '2';
    my $layer = $] ge '5.008001' ? ':utf8' : '';
  
    if ( $version ge '2' ) {
      carp "'$file' should end in '.json'"
        unless $file =~ m{\.json$};
    }
    else {
      carp "'$file' should end in '.yml'"
        unless $file =~ m{\.yml$};
    }
  
    my $data = $self->as_string( $options );
    open my $fh, ">$layer", $file
      or die "Error opening '$file' for writing: $!\n";
  
    print {$fh} $data;
    close $fh
      or die "Error closing '$file': $!\n";
  
    return 1;
  }
  
  
  sub meta_spec_version {
    my ($self) = @_;
    return $self->meta_spec->{version};
  }
  
  
  sub effective_prereqs {
    my ($self, $features) = @_;
    $features ||= [];
  
    my $prereq = CPAN::Meta::Prereqs->new($self->prereqs);
  
    return $prereq unless @$features;
  
    my @other = map {; $self->feature($_)->prereqs } @$features;
  
    return $prereq->with_merged_prereqs(\@other);
  }
  
  
  sub should_index_file {
    my ($self, $filename) = @_;
  
    for my $no_index_file (@{ $self->no_index->{file} || [] }) {
      return if $filename eq $no_index_file;
    }
  
    for my $no_index_dir (@{ $self->no_index->{directory} }) {
      $no_index_dir =~ s{$}{/} unless $no_index_dir =~ m{/\z};
      return if index($filename, $no_index_dir) == 0;
    }
  
    return 1;
  }
  
  
  sub should_index_package {
    my ($self, $package) = @_;
  
    for my $no_index_pkg (@{ $self->no_index->{package} || [] }) {
      return if $package eq $no_index_pkg;
    }
  
    for my $no_index_ns (@{ $self->no_index->{namespace} }) {
      return if index($package, "${no_index_ns}::") == 0;
    }
  
    return 1;
  }
  
  
  sub features {
    my ($self) = @_;
  
    my $opt_f = $self->optional_features;
    my @features = map {; CPAN::Meta::Feature->new($_ => $opt_f->{ $_ }) }
                   keys %$opt_f;
  
    return @features;
  }
  
  
  sub feature {
    my ($self, $ident) = @_;
  
    croak "no feature named $ident"
      unless my $f = $self->optional_features->{ $ident };
  
    return CPAN::Meta::Feature->new($ident, $f);
  }
  
  
  sub as_struct {
    my ($self, $options) = @_;
    my $struct = _dclone($self);
    if ( $options->{version} ) {
      my $cmc = CPAN::Meta::Converter->new( $struct );
      $struct = $cmc->convert( version => $options->{version} );
    }
    return $struct;
  }
  
  
  sub as_string {
    my ($self, $options) = @_;
  
    my $version = $options->{version} || '2';
  
    my $struct;
    if ( $self->meta_spec_version ne $version ) {
      my $cmc = CPAN::Meta::Converter->new( $self->as_struct );
      $struct = $cmc->convert( version => $version );
    }
    else {
      $struct = $self->as_struct;
    }
  
    my ($data, $backend);
    if ( $version ge '2' ) {
      $backend = Parse::CPAN::Meta->json_backend();
      $data = $backend->new->pretty->canonical->encode($struct);
    }
    else {
      $backend = Parse::CPAN::Meta->yaml_backend();
      $data = eval { no strict 'refs'; &{"$backend\::Dump"}($struct) };
      if ( $@ ) {
        croak $backend->can('errstr') ? $backend->errstr : $@
      }
    }
  
    return $data;
  }
  
  # Used by JSON::PP, etc. for "convert_blessed"
  sub TO_JSON {
    return { %{ $_[0] } };
  }
  
  1;
  
  
  
  
  __END__
  
  
CPAN_META

$fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Converter;
  BEGIN {
    $CPAN::Meta::Converter::VERSION = '2.110930';
  }
  # ABSTRACT: Convert CPAN distribution metadata structures
  
  
  use CPAN::Meta::Validator;
  use version 0.82 ();
  use Parse::CPAN::Meta 1.4400 ();
  
  sub _dclone {
    my $ref = shift;
    my $backend = Parse::CPAN::Meta->json_backend();
    return $backend->new->decode(
      $backend->new->convert_blessed->encode($ref)
    );
  }
  
  my %known_specs = (
      '2'   => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
      '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
      '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
      '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
      '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
      '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
  );
  
  my @spec_list = sort { $a <=> $b } keys %known_specs;
  my ($LOWEST, $HIGHEST) = @spec_list[0,-1];
  
  #--------------------------------------------------------------------------#
  # converters
  #
  # called as $converter->($element, $field_name, $full_meta, $to_version)
  #
  # defined return value used for field
  # undef return value means field is skipped
  #--------------------------------------------------------------------------#
  
  sub _keep { $_[0] }
  
  sub _keep_or_one { defined($_[0]) ? $_[0] : 1 }
  
  sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 }
  
  sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" }
  
  sub _generated_by {
    my $gen = shift;
    my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>");
  
    return $sig unless defined $gen and length $gen;
    return $gen if $gen =~ /(, )\Q$sig/;
    return "$gen, $sig";
  }
  
  sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] }
  
  sub _prefix_custom {
    my $key = shift;
    $key =~ s/^(?!x_)   # Unless it already starts with x_
               (?:x-?)? # Remove leading x- or x (if present)
             /x_/ix;    # and prepend x_
    return $key;
  }
  
  sub _ucfirst_custom {
    my $key = shift;
    $key = ucfirst $key unless $key =~ /[A-Z]/;
    return $key;
  }
  
  sub _change_meta_spec {
    my ($element, undef, undef, $version) = @_;
    $element->{version} = $version;
    $element->{url} = $known_specs{$version};
    return $element;
  }
  
  my @valid_licenses_1 = (
    'perl',
    'gpl',
    'apache',
    'artistic',
    'artistic_2',
    'lgpl',
    'bsd',
    'gpl',
    'mit',
    'mozilla',
    'open_source',
    'unrestricted',
    'restrictive',
    'unknown',
  );
  
  my %license_map_1 = (
    ( map { $_ => $_ } @valid_licenses_1 ),
    artistic2 => 'artistic_2',
  );
  
  sub _license_1 {
    my ($element) = @_;
    return 'unknown' unless defined $element;
    if ( $license_map_1{lc $element} ) {
      return $license_map_1{lc $element};
    }
    return 'unknown';
  }
  
  my @valid_licenses_2 = qw(
    agpl_3
    apache_1_1
    apache_2_0
    artistic_1
    artistic_2
    bsd
    freebsd
    gfdl_1_2
    gfdl_1_3
    gpl_1
    gpl_2
    gpl_3
    lgpl_2_1
    lgpl_3_0
    mit
    mozilla_1_0
    mozilla_1_1
    openssl
    perl_5
    qpl_1_0
    ssleay
    sun
    zlib
    open_source
    restricted
    unrestricted
    unknown
  );
  
  # The "old" values were defined by Module::Build, and were often vague.  I have
  # made the decisions below based on reading Module::Build::API and how clearly
  # it specifies the version of the license.
  my %license_map_2 = (
    (map { $_ => $_ } @valid_licenses_2),
    apache      => 'apache_2_0',  # clearly stated as 2.0
    artistic    => 'artistic_1',  # clearly stated as 1
    artistic2   => 'artistic_2',  # clearly stated as 2
    gpl         => 'open_source', # we don't know which GPL; punt
    lgpl        => 'open_source', # we don't know which LGPL; punt
    mozilla     => 'open_source', # we don't know which MPL; punt
    perl        => 'perl_5',      # clearly Perl 5
    restrictive => 'restricted',
  );
  
  sub _license_2 {
    my ($element) = @_;
    return [ 'unknown' ] unless defined $element;
    $element = [ $element ] unless ref $element eq 'ARRAY';
    my @new_list;
    for my $lic ( @$element ) {
      next unless defined $lic;
      if ( my $new = $license_map_2{lc $lic} ) {
        push @new_list, $new;
      }
    }
    return @new_list ? \@new_list : [ 'unknown' ];
  }
  
  my %license_downgrade_map = qw(
    agpl_3            open_source
    apache_1_1        apache
    apache_2_0        apache
    artistic_1        artistic
    artistic_2        artistic_2
    bsd               bsd
    freebsd           open_source
    gfdl_1_2          open_source
    gfdl_1_3          open_source
    gpl_1             gpl
    gpl_2             gpl
    gpl_3             gpl
    lgpl_2_1          lgpl
    lgpl_3_0          lgpl
    mit               mit
    mozilla_1_0       mozilla
    mozilla_1_1       mozilla
    openssl           open_source
    perl_5            perl
    qpl_1_0           open_source
    ssleay            open_source
    sun               open_source
    zlib              open_source
    open_source       open_source
    restricted        restrictive
    unrestricted      unrestricted
    unknown           unknown
  );
  
  sub _downgrade_license {
    my ($element) = @_;
    if ( ! defined $element ) {
      return "unknown";
    }
    elsif( ref $element eq 'ARRAY' ) {
      if ( @$element == 1 ) {
        return $license_downgrade_map{$element->[0]} || "unknown";
      }
    }
    elsif ( ! ref $element ) {
      return $license_downgrade_map{$element} || "unknown";
    }
    return "unknown";
  }
  
  my $no_index_spec_1_2 = {
    'file' => \&_listify,
    'dir' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_1_3 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_2 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _no_index_1_2 {
    my (undef, undef, $meta) = @_;
    my $no_index = $meta->{no_index} || $meta->{private};
    return unless $no_index;
  
    # cleanup wrong format
    if ( ! ref $no_index ) {
      my $item = $no_index;
      $no_index = { dir => [ $item ], file => [ $item ] };
    }
    elsif ( ref $no_index eq 'ARRAY' ) {
      my $list = $no_index;
      $no_index = { dir => [ @$list ], file => [ @$list ] };
    }
  
    # common mistake: files -> file
    if ( exists $no_index->{files} ) {
      $no_index->{file} = delete $no_index->{file};
    }
    # common mistake: modules -> module
    if ( exists $no_index->{modules} ) {
      $no_index->{module} = delete $no_index->{module};
    }
    return _convert($no_index, $no_index_spec_1_2);
  }
  
  sub _no_index_directory {
    my ($element, $key, $meta, $version) = @_;
    return unless $element;
  
    # cleanup wrong format
    if ( ! ref $element ) {
      my $item = $element;
      $element = { directory => [ $item ], file => [ $item ] };
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $list = $element;
      $element = { directory => [ @$list ], file => [ @$list ] };
    }
  
    if ( exists $element->{dir} ) {
      $element->{directory} = delete $element->{dir};
    }
    # common mistake: files -> file
    if ( exists $element->{files} ) {
      $element->{file} = delete $element->{file};
    }
    # common mistake: modules -> module
    if ( exists $element->{modules} ) {
      $element->{module} = delete $element->{module};
    }
    my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3;
    return _convert($element, $spec);
  }
  
  sub _is_module_name {
    my $mod = shift;
    return unless defined $mod && length $mod;
    return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$};
  }
  
  sub _clean_version {
    my ($element, $key, $meta, $to_version) = @_;
    return 0 if ! defined $element;
  
    $element =~ s{^\s*}{};
    $element =~ s{\s*$}{};
    $element =~ s{^\.}{0.};
  
    return 0 if ! length $element;
    return 0 if ( $element eq 'undef' || $element eq '<undef>' );
  
    if ( my $v = eval { version->new($element) } ) {
      return $v->is_qv ? $v->normal : $element;
    }
    else {
      return 0;
    }
  }
  
  sub _version_map {
    my ($element) = @_;
    return undef unless defined $element;
    if ( ref $element eq 'HASH' ) {
      my $new_map = {};
      for my $k ( keys %$element ) {
        next unless _is_module_name($k);
        my $value = $element->{$k};
        if ( ! ( defined $value && length $value ) ) {
          $new_map->{$k} = 0;
        }
        elsif ( $value eq 'undef' || $value eq '<undef>' ) {
          $new_map->{$k} = 0;
        }
        elsif ( _is_module_name( $value ) ) { # some weird, old META have this
          $new_map->{$k} = 0;
          $new_map->{$value} = 0;
        }
        else {
          $new_map->{$k} = _clean_version($value);
        }
      }
      return $new_map;
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $hashref = { map { $_ => 0 } @$element };
      return _version_map($hashref); # cleanup any weird stuff
    }
    elsif ( ref $element eq '' && length $element ) {
      return { $element => 0 }
    }
    return;
  }
  
  sub _prereqs_from_1 {
    my (undef, undef, $meta) = @_;
    my $prereqs = {};
    for my $phase ( qw/build configure/ ) {
      my $key = "${phase}_requires";
      $prereqs->{$phase}{requires} = _version_map($meta->{$key})
        if $meta->{$key};
    }
    for my $rel ( qw/requires recommends conflicts/ ) {
      $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
        if $meta->{$rel};
    }
    return $prereqs;
  }
  
  my $prereqs_spec = {
    configure => \&_prereqs_rel,
    build     => \&_prereqs_rel,
    test      => \&_prereqs_rel,
    runtime   => \&_prereqs_rel,
    develop   => \&_prereqs_rel,
    ':custom'  => \&_prefix_custom,
  };
  
  my $relation_spec = {
    requires   => \&_version_map,
    recommends => \&_version_map,
    suggests   => \&_version_map,
    conflicts  => \&_version_map,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _cleanup_prereqs {
    my ($prereqs, $key, $meta, $to_version) = @_;
    return unless $prereqs && ref $prereqs eq 'HASH';
    return _convert( $prereqs, $prereqs_spec, $to_version );
  }
  
  sub _prereqs_rel {
    my ($relation, $key, $meta, $to_version) = @_;
    return unless $relation && ref $relation eq 'HASH';
    return _convert( $relation, $relation_spec, $to_version );
  }
  
  
  BEGIN {
    my @old_prereqs = qw(
      requires
      configure_requires
      recommends
      conflicts
    );
  
    for ( @old_prereqs ) {
      my $sub = "_get_$_";
      my ($phase,$type) = split qr/_/, $_;
      if ( ! defined $type ) {
        $type = $phase;
        $phase = 'runtime';
      }
      no strict 'refs';
      *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
    }
  }
  
  sub _get_build_requires {
    my ($data, $key, $meta) = @_;
  
    my $test_h  = _extract_prereqs($_[2]->{prereqs}, qw(test  requires)) || {};
    my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
  
    require Version::Requirements;
    my $test_req  = Version::Requirements->from_string_hash($test_h);
    my $build_req = Version::Requirements->from_string_hash($build_h);
  
    $test_req->add_requirements($build_req)->as_string_hash;
  }
  
  sub _extract_prereqs {
    my ($prereqs, $phase, $type) = @_;
    return unless ref $prereqs eq 'HASH';
    return $prereqs->{$phase}{$type};
  }
  
  sub _downgrade_optional_features {
    my (undef, undef, $meta) = @_;
    return undef unless exists $meta->{optional_features};
    my $origin = $meta->{optional_features};
    my $features = {};
    for my $name ( keys %$origin ) {
      $features->{$name} = {
        description => $origin->{$name}{description},
        requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),
        configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),
        build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),
        recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),
        conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),
      };
      for my $k (keys %{$features->{$name}} ) {
        delete $features->{$name}{$k} unless defined $features->{$name}{$k};
      }
    }
    return $features;
  }
  
  sub _upgrade_optional_features {
    my (undef, undef, $meta) = @_;
    return undef unless exists $meta->{optional_features};
    my $origin = $meta->{optional_features};
    my $features = {};
    for my $name ( keys %$origin ) {
      $features->{$name} = {
        description => $origin->{$name}{description},
        prereqs => _prereqs_from_1(undef, undef, $origin->{$name}),
      };
      delete $features->{$name}{prereqs}{configure};
    }
    return $features;
  }
  
  my $optional_features_2_spec = {
    description => \&_keep,
    prereqs => \&_cleanup_prereqs,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _feature_2 {
    my ($element, $key, $meta, $to_version) = @_;
    return unless $element && ref $element eq 'HASH';
    _convert( $element, $optional_features_2_spec, $to_version );
  }
  
  sub _cleanup_optional_features_2 {
    my ($element, $key, $meta, $to_version) = @_;
    return unless $element && ref $element eq 'HASH';
    my $new_data = {};
    for my $k ( keys %$element ) {
      $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version );
    }
    return unless keys %$new_data;
    return $new_data;
  }
  
  sub _optional_features_1_4 {
    my ($element) = @_;
    return unless $element;
    $element = _optional_features_as_map($element);
    for my $name ( keys %$element ) {
      for my $drop ( qw/requires_packages requires_os excluded_os/ ) {
        delete $element->{$name}{$drop};
      }
    }
    return $element;
  }
  
  sub _optional_features_as_map {
    my ($element) = @_;
    return unless $element;
    if ( ref $element eq 'ARRAY' ) {
      my %map;
      for my $feature ( @$element ) {
        my (@parts) = %$feature;
        $map{$parts[0]} = $parts[1];
      }
      $element = \%map;
    }
    return $element;
  }
  
  sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
  
  sub _url_or_drop {
    my ($element) = @_;
    return $element if _is_urlish($element);
    return;
  }
  
  sub _url_list {
    my ($element) = @_;
    return unless $element;
    $element = _listify( $element );
    $element = [ grep { _is_urlish($_) } @$element ];
    return unless @$element;
    return $element;
  }
  
  sub _author_list {
    my ($element) = @_;
    return [ 'unknown' ] unless $element;
    $element = _listify( $element );
    $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ];
    return [ 'unknown' ] unless @$element;
    return $element;
  }
  
  my $resource2_upgrade = {
    license    => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef },
    homepage   => \&_url_or_drop,
    bugtracker => sub {
      my ($item) = @_;
      return unless $item;
      if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
      elsif( _is_urlish($item) ) { return { web => $item } }
      else { return undef }
    },
    repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
    ':custom'  => \&_prefix_custom,
  };
  
  sub _upgrade_resources_2 {
    my (undef, undef, $meta, $version) = @_;
    return undef unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource2_upgrade);
  }
  
  my $bugtracker2_spec = {
    web => \&_url_or_drop,
    mailto => \&_keep,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _repo_type {
    my ($element, $key, $meta, $to_version) = @_;
    return $element if defined $element;
    return unless exists $meta->{url};
    my $repo_url = $meta->{url};
    for my $type ( qw/git svn/ ) {
      return $type if $repo_url =~ m{\A$type};
    }
    return;
  }
  
  my $repository2_spec = {
    web => \&_url_or_drop,
    url => \&_url_or_drop,
    type => \&_repo_type,
    ':custom'  => \&_prefix_custom,
  };
  
  my $resources2_cleanup = {
    license    => \&_url_list,
    homepage   => \&_url_or_drop,
    bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef },
    repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef },
    ':custom'  => \&_prefix_custom,
  };
  
  sub _cleanup_resources_2 {
    my ($resources, $key, $meta, $to_version) = @_;
    return undef unless $resources && ref $resources eq 'HASH';
    return _convert($resources, $resources2_cleanup, $to_version);
  }
  
  my $resource1_spec = {
    license    => \&_url_or_drop,
    homepage   => \&_url_or_drop,
    bugtracker => \&_url_or_drop,
    repository => \&_url_or_drop,
    ':custom'  => \&_keep,
  };
  
  sub _resources_1_3 {
    my (undef, undef, $meta, $version) = @_;
    return undef unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource1_spec);
  }
  
  *_resources_1_4 = *_resources_1_3;
  
  sub _resources_1_2 {
    my (undef, undef, $meta) = @_;
    my $resources = $meta->{resources} || {};
    if ( $meta->{license_url} && ! $resources->{license} ) {
      $resources->{license} = $meta->license_url
        if _is_urlish($meta->{license_url});
    }
    return undef unless keys %$resources;
    return _convert($resources, $resource1_spec);
  }
  
  my $resource_downgrade_spec = {
    license    => sub { return ref $_[0] ? $_[0]->[0] : $_[0] },
    homepage   => \&_url_or_drop,
    bugtracker => sub { return $_[0]->{web} },
    repository => sub { return $_[0]->{url} || $_[0]->{web} },
    ':custom'  => \&_ucfirst_custom,
  };
  
  sub _downgrade_resources {
    my (undef, undef, $meta, $version) = @_;
    return undef unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource_downgrade_spec);
  }
  
  sub _release_status {
    my ($element, undef, $meta) = @_;
    return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z};
    return _release_status_from_version(undef, undef, $meta);
  }
  
  sub _release_status_from_version {
    my (undef, undef, $meta) = @_;
    my $version = $meta->{version} || '';
    return ( $version =~ /_/ ) ? 'testing' : 'stable';
  }
  
  my $provides_spec = {
    file => \&_keep,
    version => \&_clean_version,
  };
  
  my $provides_spec_2 = {
    file => \&_keep,
    version => \&_clean_version,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _provides {
    my ($element, $key, $meta, $to_version) = @_;
    return unless defined $element && ref $element eq 'HASH';
    my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
    my $new_data = {};
    for my $k ( keys %$element ) {
      $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
    }
    return $new_data;
  }
  
  sub _convert {
    my ($data, $spec, $to_version) = @_;
  
    my $new_data = {};
    for my $key ( keys %$spec ) {
      next if $key eq ':custom' || $key eq ':drop';
      next unless my $fcn = $spec->{$key};
      die "spec for '$key' is not a coderef"
        unless ref $fcn && ref $fcn eq 'CODE';
      my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
      $new_data->{$key} = $new_value if defined $new_value;
    }
  
    my $drop_list   = $spec->{':drop'};
    my $customizer  = $spec->{':custom'} || \&_keep;
  
    for my $key ( keys %$data ) {
      next if $drop_list && grep { $key eq $_ } @$drop_list;
      next if exists $spec->{$key}; # we handled it
      $new_data->{ $customizer->($key) } = $data->{$key};
    }
  
    return $new_data;
  }
  
  #--------------------------------------------------------------------------#
  # define converters for each conversion
  #--------------------------------------------------------------------------#
  
  # each converts from prior version
  # special ":custom" field is used for keys not recognized in spec
  my %up_convert = (
    '2-from-1.4' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_2,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'dynamic_config'      => \&_keep_or_one,
      # ADDED MANDATORY
      'release_status'      => \&_release_status_from_version,
      # PRIOR OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_upgrade_optional_features,
      'provides'            => \&_provides,
      'resources'           => \&_upgrade_resources_2,
      # ADDED OPTIONAL
      'description'         => \&_keep,
      'prereqs'             => \&_prereqs_from_1,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
          build_requires
          configure_requires
          conflicts
          distribution_type
          license_url
          private
          recommends
          requires
      ) ],
  
      # other random keys need x_ prefixing
      ':custom'              => \&_prefix_custom,
    },
    '1.4-from-1.3' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_1_4,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_4,
      # ADDED OPTIONAL
      'configure_requires'  => \&_keep,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.3-from-1.2' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.2-from-1.1' => {
      # PRIOR MANDATORY
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'license'             => \&_license_1,
      'name'                => \&_keep,
      'generated_by'        => \&_generated_by,
      # ADDED MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'resources'           => \&_resources_1_2,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.1-from-1.0' => {
      # CHANGED TO MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'license_url'         => \&_url_or_drop,
      'private'             => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
  );
  
  my %down_convert = (
    '1.4-from-2' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_downgrade_license,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_get_build_requires,
      'configure_requires'  => \&_get_configure_requires,
      'conflicts'           => \&_get_conflicts,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_downgrade_optional_features,
      'provides'            => \&_provides,
      'recommends'          => \&_get_recommends,
      'requires'            => \&_get_requires,
      'resources'           => \&_downgrade_resources,
  
      # drop these unsupported fields (after conversion)
      ':drop' => [ qw(
        description
        prereqs
        release_status
      )],
  
      # custom keys will be left unchanged
      ':custom'              => \&_keep
    },
    '1.3-from-1.4' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # drop these unsupported fields, but only after we convert
      ':drop' => [ qw(
        configure_requires
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.2-from-1.3' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.1-from-1.2' => {
      # MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'private'             => \&_keep,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # drop unsupported fields
      ':drop' => [ qw(
        abstract
        author
        provides
        no_index
        keywords
        resources
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.0-from-1.1' => {
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
  );
  
  my %cleanup = (
    '2' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_2,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'dynamic_config'      => \&_keep_or_one,
      # ADDED MANDATORY
      'release_status'      => \&_release_status,
      # PRIOR OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_cleanup_optional_features_2,
      'provides'            => \&_provides,
      'resources'           => \&_cleanup_resources_2,
      # ADDED OPTIONAL
      'description'         => \&_keep,
      'prereqs'             => \&_cleanup_prereqs,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
          build_requires
          configure_requires
          conflicts
          distribution_type
          license_url
          private
          recommends
          requires
      ) ],
  
      # other random keys need x_ prefixing
      ':custom'              => \&_prefix_custom,
    },
    '1.4' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_1_4,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_4,
      # ADDED OPTIONAL
      'configure_requires'  => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.3' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.2' => {
      # PRIOR MANDATORY
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'license'             => \&_license_1,
      'name'                => \&_keep,
      'generated_by'        => \&_generated_by,
      # ADDED MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'resources'           => \&_resources_1_2,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.1' => {
      # CHANGED TO MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'license_url'         => \&_url_or_drop,
      'private'             => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.0' => {
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      'version'             => \&_keep,
      # IMPLIED OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep,
    },
  );
  
  #--------------------------------------------------------------------------#
  # Code
  #--------------------------------------------------------------------------#
  
  
  sub new {
    my ($class,$data) = @_;
  
    # create an attributes hash
    my $self = {
      'data'    => $data,
      'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
    };
  
    # create the object
    return bless $self, $class;
  }
  
  
  sub convert {
    my ($self, %args) = @_;
    my $args = { %args };
  
    my $new_version = $args->{version} || $HIGHEST;
  
    my ($old_version) = $self->{spec};
    my $converted = _dclone($self->{data});
  
    if ( $old_version == $new_version ) {
      $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
      my $cmv = CPAN::Meta::Validator->new( $converted );
      unless ( $cmv->is_valid ) {
        my $errs = join("\n", $cmv->errors);
        die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
      }
      return $converted;
    }
    elsif ( $old_version > $new_version )  {
      my @vers = sort { $b <=> $a } keys %known_specs;
      for my $i ( 0 .. $#vers-1 ) {
        next if $vers[$i] > $old_version;
        last if $vers[$i+1] < $new_version;
        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
        $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
        my $cmv = CPAN::Meta::Validator->new( $converted );
        unless ( $cmv->is_valid ) {
          my $errs = join("\n", $cmv->errors);
          die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
        }
      }
      return $converted;
    }
    else {
      my @vers = sort { $a <=> $b } keys %known_specs;
      for my $i ( 0 .. $#vers-1 ) {
        next if $vers[$i] < $old_version;
        last if $vers[$i+1] > $new_version;
        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
        $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
        my $cmv = CPAN::Meta::Validator->new( $converted );
        unless ( $cmv->is_valid ) {
          my $errs = join("\n", $cmv->errors);
          die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
        }
      }
      return $converted;
    }
  }
  
  1;
  
  
  
  
  __END__
  
  
CPAN_META_CONVERTER

$fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Feature;
  BEGIN {
    $CPAN::Meta::Feature::VERSION = '2.110930';
  }
  # ABSTRACT: an optional feature provided by a CPAN distribution
  
  use CPAN::Meta::Prereqs;
  
  
  sub new {
    my ($class, $identifier, $spec) = @_;
  
    my %guts = (
      identifier  => $identifier,
      description => $spec->{description},
      prereqs     => CPAN::Meta::Prereqs->new($spec->{prereqs}),
    );
  
    bless \%guts => $class;
  }
  
  
  sub identifier  { $_[0]{identifier}  }
  
  
  sub description { $_[0]{description} }
  
  
  sub prereqs     { $_[0]{prereqs} }
  
  1;
  
  
  
  
  __END__
  
  
  
CPAN_META_FEATURE

$fatpacked{"CPAN/Meta/History.pm"} = <<'CPAN_META_HISTORY';
  # vi:tw=72
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::History;
  BEGIN {
    $CPAN::Meta::History::VERSION = '2.110930';
  }
  # ABSTRACT: history of CPAN Meta Spec changes
  1;
  
  
  
  __END__
  =pod
  
CPAN_META_HISTORY

$fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Prereqs;
  BEGIN {
    $CPAN::Meta::Prereqs::VERSION = '2.110930';
  }
  # ABSTRACT: a set of distribution prerequisites by phase and type
  
  
  use Carp qw(confess);
  use Scalar::Util qw(blessed);
  use Version::Requirements 0.101020; # finalize
  
  
  sub __legal_phases { qw(configure build test runtime develop)   }
  sub __legal_types  { qw(requires recommends suggests conflicts) }
  
  # expect a prereq spec from META.json -- rjbs, 2010-04-11
  sub new {
    my ($class, $prereq_spec) = @_;
    $prereq_spec ||= {};
  
    my %is_legal_phase = map {; $_ => 1 } $class->__legal_phases;
    my %is_legal_type  = map {; $_ => 1 } $class->__legal_types;
  
    my %guts;
    PHASE: for my $phase (keys %$prereq_spec) {
      next PHASE unless $phase =~ /\Ax_/i or $is_legal_phase{$phase};
  
      my $phase_spec = $prereq_spec->{ $phase };
      next PHASE unless keys %$phase_spec;
  
      TYPE: for my $type (keys %$phase_spec) {
        next TYPE unless $type =~ /\Ax_/i or $is_legal_type{$type};
  
        my $spec = $phase_spec->{ $type };
  
        next TYPE unless keys %$spec;
  
        $guts{prereqs}{$phase}{$type} = Version::Requirements->from_string_hash(
          $spec
        );
      }
    }
  
    return bless \%guts => $class;
  }
  
  
  sub requirements_for {
    my ($self, $phase, $type) = @_;
  
    confess "requirements_for called without phase" unless defined $phase;
    confess "requirements_for called without type"  unless defined $type;
  
    unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) {
      confess "requested requirements for unknown phase: $phase";
    }
  
    unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) {
      confess "requested requirements for unknown type: $type";
    }
  
    my $req = ($self->{prereqs}{$phase}{$type} ||= Version::Requirements->new);
  
    $req->finalize if $self->is_finalized;
  
    return $req;
  }
  
  
  sub with_merged_prereqs {
    my ($self, $other) = @_;
  
    my @other = blessed($other) ? $other : @$other;
  
    my @prereq_objs = ($self, @other);
  
    my %new_arg;
  
    for my $phase ($self->__legal_phases) {
      for my $type ($self->__legal_types) {
        my $req = Version::Requirements->new;
  
        for my $prereq (@prereq_objs) {
          my $this_req = $prereq->requirements_for($phase, $type);
          next unless $this_req->required_modules;
  
          $req->add_requirements($this_req);
        }
  
        next unless $req->required_modules;
  
        $new_arg{ $phase }{ $type } = $req->as_string_hash;
      }
    }
  
    return (ref $self)->new(\%new_arg);
  }
  
  
  sub as_string_hash {
    my ($self) = @_;
  
    my %hash;
  
    for my $phase ($self->__legal_phases) {
      for my $type ($self->__legal_types) {
        my $req = $self->requirements_for($phase, $type);
        next unless $req->required_modules;
  
        $hash{ $phase }{ $type } = $req->as_string_hash;
      }
    }
  
    return \%hash;
  }
  
  
  sub is_finalized { $_[0]{finalized} }
  
  
  sub finalize {
    my ($self) = @_;
  
    $self->{finalized} = 1;
  
    for my $phase (keys %{ $self->{prereqs} }) {
      $_->finalize for values %{ $self->{prereqs}{$phase} };
    }
  }
  
  
  sub clone {
    my ($self) = @_;
  
    my $clone = (ref $self)->new( $self->as_string_hash );
  }
  
  1;
  
  
  
  
  __END__
  
  
  
CPAN_META_PREREQS

$fatpacked{"CPAN/Meta/Spec.pm"} = <<'CPAN_META_SPEC';
  # vi:tw=72
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Spec;
  BEGIN {
    $CPAN::Meta::Spec::VERSION = '2.110930';
  }
  # ABSTRACT: specification for CPAN distribution metadata
  1;
  
  
  
  __END__
  =pod
  
CPAN_META_SPEC

$fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Validator;
  BEGIN {
    $CPAN::Meta::Validator::VERSION = '2.110930';
  }
  # ABSTRACT: validate CPAN distribution metadata structures
  
  
  #--------------------------------------------------------------------------#
  # This code copied and adapted from Test::CPAN::Meta
  # by Barbie, <barbie@cpan.org> for Miss Barbell Productions,
  # L<http://www.missbarbell.co.uk>
  #--------------------------------------------------------------------------#
  
  #--------------------------------------------------------------------------#
  # Specification Definitions
  #--------------------------------------------------------------------------#
  
  my %known_specs = (
      '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
      '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
      '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
      '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
      '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
  );
  my %known_urls = map {$known_specs{$_} => $_} keys %known_specs;
  
  my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } };
  
  my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version   } } };
  
  my $no_index_2 = {
      'map'       => { file       => { list => { value => \&string } },
                       directory  => { list => { value => \&string } },
                       'package'  => { list => { value => \&string } },
                       namespace  => { list => { value => \&string } },
                      ':key'      => { name => \&custom_2, value => \&anything },
      }
  };
  
  my $no_index_1_3 = {
      'map'       => { file       => { list => { value => \&string } },
                       directory  => { list => { value => \&string } },
                       'package'  => { list => { value => \&string } },
                       namespace  => { list => { value => \&string } },
                       ':key'     => { name => \&string, value => \&anything },
      }
  };
  
  my $no_index_1_2 = {
      'map'       => { file       => { list => { value => \&string } },
                       dir        => { list => { value => \&string } },
                       'package'  => { list => { value => \&string } },
                       namespace  => { list => { value => \&string } },
                       ':key'     => { name => \&string, value => \&anything },
      }
  };
  
  my $no_index_1_1 = {
      'map'       => { ':key'     => { name => \&string, list => { value => \&string } },
      }
  };
  
  my $prereq_map = {
    map => {
      ':key' => {
        name => \&phase,
        'map' => {
          ':key'  => {
            name => \&relation,
            %$module_map1,
          },
        },
      }
    },
  };
  
  my %definitions = (
    '2' => {
      # REQUIRED
      'abstract'            => { mandatory => 1, value => \&string  },
      'author'              => { mandatory => 1, lazylist => { value => \&string } },
      'dynamic_config'      => { mandatory => 1, value => \&boolean },
      'generated_by'        => { mandatory => 1, value => \&string  },
      'license'             => { mandatory => 1, lazylist => { value => \&license } },
      'meta-spec' => {
        mandatory => 1,
        'map' => {
          version => { mandatory => 1, value => \&version},
          url     => { value => \&url },
          ':key' => { name => \&custom_2, value => \&anything },
        }
      },
      'name'                => { mandatory => 1, value => \&string  },
      'release_status'      => { mandatory => 1, value => \&release_status },
      'version'             => { mandatory => 1, value => \&version },
  
      # OPTIONAL
      'description' => { value => \&string },
      'keywords'    => { lazylist => { value => \&string } },
      'no_index'    => $no_index_2,
      'optional_features'   => {
        'map'       => {
          ':key'  => {
            name => \&string,
            'map'   => {
              description        => { value => \&string },
              prereqs => $prereq_map,
              ':key' => { name => \&custom_2, value => \&anything },
            }
          }
        }
      },
      'prereqs' => $prereq_map,
      'provides'    => {
        'map'       => {
          ':key' => {
            name  => \&module,
            'map' => {
              file    => { mandatory => 1, value => \&file },
              version => { value => \&version },
              ':key' => { name => \&custom_2, value => \&anything },
            }
          }
        }
      },
      'resources'   => {
        'map'       => {
          license    => { lazylist => { value => \&url } },
          homepage   => { value => \&url },
          bugtracker => {
            'map' => {
              web => { value => \&url },
              mailto => { value => \&string},
              ':key' => { name => \&custom_2, value => \&anything },
            }
          },
          repository => {
            'map' => {
              web => { value => \&url },
              url => { value => \&url },
              type => { value => \&string },
              ':key' => { name => \&custom_2, value => \&anything },
            }
          },
          ':key'     => { value => \&string, name => \&custom_2 },
        }
      },
  
      # CUSTOM -- additional user defined key/value pairs
      # note we can only validate the key name, as the structure is user defined
      ':key'        => { name => \&custom_2, value => \&anything },
    },
  
  '1.4' => {
    'meta-spec'           => {
      mandatory => 1,
      'map' => {
        version => { mandatory => 1, value => \&version},
        url     => { mandatory => 1, value => \&urlspec },
        ':key'  => { name => \&string, value => \&anything },
      },
    },
  
    'name'                => { mandatory => 1, value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'abstract'            => { mandatory => 1, value => \&string  },
    'author'              => { mandatory => 1, list  => { value => \&string } },
    'license'             => { mandatory => 1, value => \&license },
    'generated_by'        => { mandatory => 1, value => \&string  },
  
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'configure_requires'  => $module_map1,
    'conflicts'           => $module_map2,
  
    'optional_features'   => {
      'map'       => {
          ':key'  => { name => \&string,
              'map'   => { description        => { value => \&string },
                           requires           => $module_map1,
                           recommends         => $module_map1,
                           build_requires     => $module_map1,
                           conflicts          => $module_map2,
                           ':key'  => { name => \&string, value => \&anything },
              }
          }
       }
    },
  
    'provides'    => {
      'map'       => {
        ':key' => { name  => \&module,
          'map' => {
            file    => { mandatory => 1, value => \&file },
            version => { value => \&version },
            ':key'  => { name => \&string, value => \&anything },
          }
        }
      }
    },
  
    'no_index'    => $no_index_1_3,
    'private'     => $no_index_1_3,
  
    'keywords'    => { list => { value => \&string } },
  
    'resources'   => {
      'map'       => { license    => { value => \&url },
                       homepage   => { value => \&url },
                       bugtracker => { value => \&url },
                       repository => { value => \&url },
                       ':key'     => { value => \&string, name => \&custom_1 },
      }
    },
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  '1.3' => {
    'meta-spec'           => {
      mandatory => 1,
      'map' => {
        version => { mandatory => 1, value => \&version},
        url     => { mandatory => 1, value => \&urlspec },
        ':key'  => { name => \&string, value => \&anything },
      },
    },
  
    'name'                => { mandatory => 1, value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'abstract'            => { mandatory => 1, value => \&string  },
    'author'              => { mandatory => 1, list  => { value => \&string } },
    'license'             => { mandatory => 1, value => \&license },
    'generated_by'        => { mandatory => 1, value => \&string  },
  
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    'optional_features'   => {
      'map'       => {
          ':key'  => { name => \&string,
              'map'   => { description        => { value => \&string },
                           requires           => $module_map1,
                           recommends         => $module_map1,
                           build_requires     => $module_map1,
                           conflicts          => $module_map2,
                           ':key'  => { name => \&string, value => \&anything },
              }
          }
       }
    },
  
    'provides'    => {
      'map'       => {
        ':key' => { name  => \&module,
          'map' => {
            file    => { mandatory => 1, value => \&file },
            version => { value => \&version },
            ':key'  => { name => \&string, value => \&anything },
          }
        }
      }
    },
  
  
    'no_index'    => $no_index_1_3,
    'private'     => $no_index_1_3,
  
    'keywords'    => { list => { value => \&string } },
  
    'resources'   => {
      'map'       => { license    => { value => \&url },
                       homepage   => { value => \&url },
                       bugtracker => { value => \&url },
                       repository => { value => \&url },
                       ':key'     => { value => \&string, name => \&custom_1 },
      }
    },
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  # v1.2 is misleading, it seems to assume that a number of fields where created
  # within v1.1, when they were created within v1.2. This may have been an
  # original mistake, and that a v1.1 was retro fitted into the timeline, when
  # v1.2 was originally slated as v1.1. But I could be wrong ;)
  '1.2' => {
    'meta-spec'           => {
      mandatory => 1,
      'map' => {
        version => { mandatory => 1, value => \&version},
        url     => { mandatory => 1, value => \&urlspec },
        ':key'  => { name => \&string, value => \&anything },
      },
    },
  
  
    'name'                => { mandatory => 1, value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'license'             => { mandatory => 1, value => \&license },
    'generated_by'        => { mandatory => 1, value => \&string  },
    'author'              => { mandatory => 1, list => { value => \&string } },
    'abstract'            => { mandatory => 1, value => \&string  },
  
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'keywords'            => { list => { value => \&string } },
  
    'private'             => $no_index_1_2,
    '$no_index'           => $no_index_1_2,
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    'optional_features'   => {
      'map'       => {
          ':key'  => { name => \&string,
              'map'   => { description        => { value => \&string },
                           requires           => $module_map1,
                           recommends         => $module_map1,
                           build_requires     => $module_map1,
                           conflicts          => $module_map2,
                           ':key'  => { name => \&string, value => \&anything },
              }
          }
       }
    },
  
    'provides'    => {
      'map'       => {
        ':key' => { name  => \&module,
          'map' => {
            file    => { mandatory => 1, value => \&file },
            version => { value => \&version },
            ':key'  => { name => \&string, value => \&anything },
          }
        }
      }
    },
  
    'resources'   => {
      'map'       => { license    => { value => \&url },
                       homepage   => { value => \&url },
                       bugtracker => { value => \&url },
                       repository => { value => \&url },
                       ':key'     => { value => \&string, name => \&custom_1 },
      }
    },
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  # note that the 1.1 spec only specifies 'version' as mandatory
  '1.1' => {
    'name'                => { value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'license'             => { value => \&license },
    'generated_by'        => { value => \&string  },
  
    'license_uri'         => { value => \&url },
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'private'             => $no_index_1_1,
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  # note that the 1.0 spec doesn't specify optional or mandatory fields
  # but we will treat version as mandatory since otherwise META 1.0 is
  # completely arbitrary and pointless
  '1.0' => {
    'name'                => { value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'license'             => { value => \&license },
    'generated_by'        => { value => \&string  },
  
    'license_uri'         => { value => \&url },
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  );
  
  #--------------------------------------------------------------------------#
  # Code
  #--------------------------------------------------------------------------#
  
  
  sub new {
    my ($class,$data) = @_;
  
    # create an attributes hash
    my $self = {
      'data'    => $data,
      'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
      'errors'  => undef,
    };
  
    # create the object
    return bless $self, $class;
  }
  
  
  sub is_valid {
      my $self = shift;
      my $data = $self->{data};
      my $spec_version = $self->{spec};
      $self->check_map($definitions{$spec_version},$data);
      return ! $self->errors;
  }
  
  
  sub errors {
      my $self = shift;
      return ()   unless(defined $self->{errors});
      return @{$self->{errors}};
  }
  
  
  my $spec_error = "Missing validation action in specification. "
    . "Must be one of 'map', 'list', 'lazylist', or 'value'";
  
  sub check_map {
      my ($self,$spec,$data) = @_;
  
      if(ref($spec) ne 'HASH') {
          $self->_error( "Unknown META specification, cannot validate." );
          return;
      }
  
      if(ref($data) ne 'HASH') {
          $self->_error( "Expected a map structure from string or file." );
          return;
      }
  
      for my $key (keys %$spec) {
          next    unless($spec->{$key}->{mandatory});
          next    if(defined $data->{$key});
          push @{$self->{stack}}, $key;
          $self->_error( "Missing mandatory field, '$key'" );
          pop @{$self->{stack}};
      }
  
      for my $key (keys %$data) {
          push @{$self->{stack}}, $key;
          if($spec->{$key}) {
              if($spec->{$key}{value}) {
                  $spec->{$key}{value}->($self,$key,$data->{$key});
              } elsif($spec->{$key}{'map'}) {
                  $self->check_map($spec->{$key}{'map'},$data->{$key});
              } elsif($spec->{$key}{'list'}) {
                  $self->check_list($spec->{$key}{'list'},$data->{$key});
              } elsif($spec->{$key}{'lazylist'}) {
                  $self->check_lazylist($spec->{$key}{'lazylist'},$data->{$key});
              } else {
                  $self->_error( "$spec_error for '$key'" );
              }
  
          } elsif ($spec->{':key'}) {
              $spec->{':key'}{name}->($self,$key,$key);
              if($spec->{':key'}{value}) {
                  $spec->{':key'}{value}->($self,$key,$data->{$key});
              } elsif($spec->{':key'}{'map'}) {
                  $self->check_map($spec->{':key'}{'map'},$data->{$key});
              } elsif($spec->{':key'}{'list'}) {
                  $self->check_list($spec->{':key'}{'list'},$data->{$key});
              } elsif($spec->{':key'}{'lazylist'}) {
                  $self->check_lazylist($spec->{':key'}{'lazylist'},$data->{$key});
              } else {
                  $self->_error( "$spec_error for ':key'" );
              }
  
  
          } else {
              $self->_error( "Unknown key, '$key', found in map structure" );
          }
          pop @{$self->{stack}};
      }
  }
  
  # if it's a string, make it into a list and check the list
  sub check_lazylist {
      my ($self,$spec,$data) = @_;
  
      if ( defined $data && ! ref($data) ) {
        $data = [ $data ];
      }
  
      $self->check_list($spec,$data);
  }
  
  sub check_list {
      my ($self,$spec,$data) = @_;
  
      if(ref($data) ne 'ARRAY') {
          $self->_error( "Expected a list structure" );
          return;
      }
  
      if(defined $spec->{mandatory}) {
          if(!defined $data->[0]) {
              $self->_error( "Missing entries from mandatory list" );
          }
      }
  
      for my $value (@$data) {
          push @{$self->{stack}}, $value || "<undef>";
          if(defined $spec->{value}) {
              $spec->{value}->($self,'list',$value);
          } elsif(defined $spec->{'map'}) {
              $self->check_map($spec->{'map'},$value);
          } elsif(defined $spec->{'list'}) {
              $self->check_list($spec->{'list'},$value);
          } elsif(defined $spec->{'lazylist'}) {
              $self->check_lazylist($spec->{'lazylist'},$value);
          } elsif ($spec->{':key'}) {
              $self->check_map($spec,$value);
          } else {
            $self->_error( "$spec_error associated with '$self->{stack}[-2]'" );
          }
          pop @{$self->{stack}};
      }
  }
  
  
  sub header {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value && $value =~ /^--- #YAML:1.0/);
      }
      $self->_error( "file does not have a valid YAML header." );
      return 0;
  }
  
  sub release_status {
    my ($self,$key,$value) = @_;
    if(defined $value) {
      my $version = $self->{data}{version} || '';
      if ( $version =~ /_/ ) {
        return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
        $self->_error( "'$value' for '$key' is invalid for version '$version'" );
      }
      else {
        return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
        $self->_error( "'$value' for '$key' is invalid" );
      }
    }
    else {
      $self->_error( "'$key' is not defined" );
    }
    return 0;
  }
  
  # _uri_split taken from URI::Split by Gisle Aas, Copyright 2003
  sub _uri_split {
       return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
  }
  
  sub url {
      my ($self,$key,$value) = @_;
      if(defined $value) {
        my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
        unless ( defined $scheme && length $scheme ) {
          $self->_error( "'$value' for '$key' does not have a URL scheme" );
          return 0;
        }
        unless ( defined $auth && length $auth ) {
          $self->_error( "'$value' for '$key' does not have a URL authority" );
          return 0;
        }
        return 1;
      }
      $value ||= '';
      $self->_error( "'$value' for '$key' is not a valid URL." );
      return 0;
  }
  
  sub urlspec {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value && $known_specs{$self->{spec}} eq $value);
          if($value && $known_urls{$value}) {
              $self->_error( 'META specification URL does not match version' );
              return 0;
          }
      }
      $self->_error( 'Unknown META specification' );
      return 0;
  }
  
  sub anything { return 1 }
  
  sub string {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value || $value =~ /^0$/);
      }
      $self->_error( "value is an undefined string" );
      return 0;
  }
  
  sub string_or_undef {
      my ($self,$key,$value) = @_;
      return 1    unless(defined $value);
      return 1    if($value || $value =~ /^0$/);
      $self->_error( "No string defined for '$key'" );
      return 0;
  }
  
  sub file {
      my ($self,$key,$value) = @_;
      return 1    if(defined $value);
      $self->_error( "No file defined for '$key'" );
      return 0;
  }
  
  sub exversion {
      my ($self,$key,$value) = @_;
      if(defined $value && ($value || $value =~ /0/)) {
          my $pass = 1;
          for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
          return $pass;
      }
      $value = '<undef>'  unless(defined $value);
      $self->_error( "'$value' for '$key' is not a valid version." );
      return 0;
  }
  
  sub version {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 0    unless($value || $value =~ /0/);
          return 1    if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
      } else {
          $value = '<undef>';
      }
      $self->_error( "'$value' for '$key' is not a valid version." );
      return 0;
  }
  
  sub boolean {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value =~ /^(0|1|true|false)$/);
      } else {
          $value = '<undef>';
      }
      $self->_error( "'$value' for '$key' is not a boolean value." );
      return 0;
  }
  
  my %v1_licenses = (
      'perl'         => 'http://dev.perl.org/licenses/',
      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
      'apache'       => 'http://apache.org/licenses/LICENSE-2.0',
      'artistic'     => 'http://opensource.org/licenses/artistic-license.php',
      'artistic_2'   => 'http://opensource.org/licenses/artistic-license-2.0.php',
      'lgpl'         => 'http://www.opensource.org/licenses/lgpl-license.phpt',
      'bsd'          => 'http://www.opensource.org/licenses/bsd-license.php',
      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
      'mit'          => 'http://opensource.org/licenses/mit-license.php',
      'mozilla'      => 'http://opensource.org/licenses/mozilla1.1.php',
      'open_source'  => undef,
      'unrestricted' => undef,
      'restrictive'  => undef,
      'unknown'      => undef,
  );
  
  my %v2_licenses = map { $_ => 1 } qw(
    agpl_3
    apache_1_1
    apache_2_0
    artistic_1
    artistic_2
    bsd
    freebsd
    gfdl_1_2
    gfdl_1_3
    gpl_1
    gpl_2
    gpl_3
    lgpl_2_1
    lgpl_3_0
    mit
    mozilla_1_0
    mozilla_1_1
    openssl
    perl_5
    qpl_1_0
    ssleay
    sun
    zlib
    open_source
    restricted
    unrestricted
    unknown
  );
  
  sub license {
      my ($self,$key,$value) = @_;
      my $licenses = $self->{spec} < 2 ? \%v1_licenses : \%v2_licenses;
      if(defined $value) {
          return 1    if($value && exists $licenses->{$value});
      } else {
          $value = '<undef>';
      }
      $self->_error( "License '$value' is invalid" );
      return 0;
  }
  
  sub custom_1 {
      my ($self,$key) = @_;
      if(defined $key) {
          # a valid user defined key should be alphabetic
          # and contain at least one capital case letter.
          return 1    if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/);
      } else {
          $key = '<undef>';
      }
      $self->_error( "Custom resource '$key' must be in CamelCase." );
      return 0;
  }
  
  sub custom_2 {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^x_/i);  # user defined
      } else {
          $key = '<undef>';
      }
      $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." );
      return 0;
  }
  
  sub identifier {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^([a-z][_a-z]+)$/i);    # spec 2.0 defined
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal identifier." );
      return 0;
  }
  
  sub module {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal module name." );
      return 0;
  }
  
  my @valid_phases = qw/ configure build test runtime develop /;
  sub phase {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1 if( length $key && grep { $key eq $_ } @valid_phases );
          return 1 if $key =~ /x_/i;
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal phase." );
      return 0;
  }
  
  my @valid_relations = qw/ requires recommends suggests conflicts /;
  sub relation {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1 if( length $key && grep { $key eq $_ } @valid_relations );
          return 1 if $key =~ /x_/i;
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal prereq relationship." );
      return 0;
  }
  
  sub _error {
      my $self = shift;
      my $mess = shift;
  
      $mess .= ' ('.join(' -> ',@{$self->{stack}}).')'  if($self->{stack});
      $mess .= " [Validation: $self->{spec}]";
  
      push @{$self->{errors}}, $mess;
  }
  
  1;
  
  
  
  
  __END__
  
  
  
CPAN_META_VALIDATOR

$fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
  package CPAN::Meta::YAML;
  BEGIN {
    $CPAN::Meta::YAML::VERSION = '0.003';
  }
  
  use strict;
  
  # 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;
  	require Carp;
  	@CPAN::Meta::YAML::ISA       = qw{ Exporter  };
  	@CPAN::Meta::YAML::EXPORT    = qw{ Load Dump };
  	@CPAN::Meta::YAML::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
  
  	# Error storage
  	$CPAN::Meta::YAML::errstr    = '';
  }
  
  # The character class of all characters we need to escape
  # NOTE: Inlined, since it's only used once
  # my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
  
  # Printed form of the unprintable characters in the lowest range
  # of ASCII characters, listed by ASCII ordinal position.
  my @UNPRINTABLE = qw(
  	z    x01  x02  x03  x04  x05  x06  a
  	x08  t    n    v    f    r    x0e  x0f
  	x10  x11  x12  x13  x14  x15  x16  x17
  	x18  x19  x1a  e    x1c  x1d  x1e  x1f
  );
  
  # Printable characters for escapes
  my %UNESCAPES = (
  	z => "\x00", a => "\x07", t    => "\x09",
  	n => "\x0a", v => "\x0b", f    => "\x0c",
  	r => "\x0d", e => "\x1b", '\\' => '\\',
  );
  
  # Special magic boolean words
  my %QUOTE = map { $_ => 1 } qw{
  	null Null NULL
  	y Y yes Yes YES n N no No NO
  	true True TRUE false False FALSE
  	on On ON off Off OFF
  };
  
  
  
  
  
  #####################################################################
  # Implementation
  
  # Create an empty CPAN::Meta::YAML object
  sub new {
  	my $class = shift;
  	bless [ @_ ], $class;
  }
  
  # Create an object from a file
  sub read {
  	my $class = ref $_[0] ? ref shift : shift;
  
  	# Check the file
  	my $file = shift or return $class->_error( 'You did not specify a file name' );
  	return $class->_error( "File '$file' does not exist" )              unless -e $file;
  	return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
  	return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
  
  	# Slurp in the file
  	local $/ = undef;
  	local *CFG;
  	unless ( open(CFG, $file) ) {
  		return $class->_error("Failed to open file '$file': $!");
  	}
  	my $contents = <CFG>;
  	unless ( close(CFG) ) {
  		return $class->_error("Failed to close file '$file': $!");
  	}
  
  	$class->read_string( $contents );
  }
  
  # Create an object from a string
  sub read_string {
  	my $class  = ref $_[0] ? ref shift : shift;
  	my $self   = bless [], $class;
  	my $string = $_[0];
  	eval {
  		unless ( defined $string ) {
  			die \"Did not provide a string to load";
  		}
  
  		# Byte order marks
  		# NOTE: Keeping this here to educate maintainers
  		# my %BOM = (
  		#     "\357\273\277" => 'UTF-8',
  		#     "\376\377"     => 'UTF-16BE',
  		#     "\377\376"     => 'UTF-16LE',
  		#     "\377\376\0\0" => 'UTF-32LE'
  		#     "\0\0\376\377" => 'UTF-32BE',
  		# );
  		if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
  			die \"Stream has a non UTF-8 BOM";
  		} 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 $self unless length $string;
  		unless ( $string =~ /[\012\015]+\z/ ) {
  			die \"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
  		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 @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
  					next;
  				}
  			}
  
  			if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
  				# A naked document
  				push @$self, undef;
  				while ( @lines and $lines[0] !~ /^---/ ) {
  					shift @lines;
  				}
  
  			} elsif ( $lines[0] =~ /^\s*\-/ ) {
  				# An array at the root
  				my $document = [ ];
  				push @$self, $document;
  				$self->_read_array( $document, [ 0 ], \@lines );
  
  			} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
  				# A hash at the root
  				my $document = { };
  				push @$self, $document;
  				$self->_read_hash( $document, [ length($1) ], \@lines );
  
  			} else {
  				die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
  			}
  		}
  	};
  	if ( ref $@ eq 'SCALAR' ) {
  		return $self->_error(${$@});
  	} elsif ( $@ ) {
  		require Carp;
  		Carp::croak($@);
  	}
  
  	return $self;
  }
  
  # Deparse a scalar string to the actual scalar
  sub _read_scalar {
  	my ($self, $string, $indent, $lines) = @_;
  
  	# Trim trailing whitespace
  	$string =~ s/\s*\z//;
  
  	# Explitic null/undef
  	return undef if $string eq '~';
  
  	# Single quote
  	if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
  		return '' unless defined $1;
  		$string = $1;
  		$string =~ s/\'\'/\'/g;
  		return $string;
  	}
  
  	# Double quote.
  	# The commented out form is simpler, but overloaded the Perl regex
  	# engine due to recursion and backtracking problems on strings
  	# larger than 32,000ish characters. Keep it for reference purposes.
  	# if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
  	if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\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 =~ /^[\'\"!&]/ ) {
  		die \"CPAN::Meta::YAML does not support a feature in line '$string'";
  	}
  	return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
  	return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
  
  	# Regular unquoted string
  	if ( $string !~ /^[>|]/ ) {
  		if (
  			$string =~ /^(?:-(?:\s|$)|[\@\%\`])/
  			or
  			$string =~ /:(?:\s|$)/
  		) {
  			die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'";
  		}
  		$string =~ s/\s+#.*\z//;
  		return $string;
  	}
  
  	# Error
  	die \"CPAN::Meta::YAML 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] ) {
  		die \"CPAN::Meta::YAML 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 _read_array {
  	my ($self, $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] ) {
  			die \"CPAN::Meta::YAML 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, { };
  			$self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
  
  		} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
  			# Array entry with a value
  			shift @$lines;
  			push @$array, $self->_read_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, [ ];
  					$self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
  				}
  
  			} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
  				push @$array, { };
  				$self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
  
  			} else {
  				die \"CPAN::Meta::YAML 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 {
  			die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
  		}
  	}
  
  	return 1;
  }
  
  # Parse an array
  sub _read_hash {
  	my ($self, $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] ) {
  			die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
  		}
  
  		# Get the key
  		unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
  			if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
  				die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
  			}
  			die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
  		}
  		my $key = $1;
  
  		# Do we have a value?
  		if ( length $lines->[0] ) {
  			# Yes
  			$hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
  		} else {
  			# An indent
  			shift @$lines;
  			unless ( @$lines ) {
  				$hash->{$key} = undef;
  				return 1;
  			}
  			if ( $lines->[0] =~ /^(\s*)-/ ) {
  				$hash->{$key} = [];
  				$self->_read_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} = {};
  					$self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
  				}
  			}
  		}
  	}
  
  	return 1;
  }
  
  # Save an object to a file
  sub write {
  	my $self = shift;
  	my $file = shift or return $self->_error('No file name provided');
  
  	# Write it to the file
  	open( CFG, '>' . $file ) or return $self->_error(
  		"Failed to open file '$file' for writing: $!"
  		);
  	print CFG $self->write_string;
  	close CFG;
  
  	return 1;
  }
  
  # Save an object to a string
  sub write_string {
  	my $self = shift;
  	return '' unless @$self;
  
  	# Iterate over the documents
  	my $indent = 0;
  	my @lines  = ();
  	foreach my $cursor ( @$self ) {
  		push @lines, '---';
  
  		# An empty document
  		if ( ! defined $cursor ) {
  			# Do nothing
  
  		# A scalar document
  		} elsif ( ! ref $cursor ) {
  			$lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );
  
  		# A list at the root
  		} elsif ( ref $cursor eq 'ARRAY' ) {
  			unless ( @$cursor ) {
  				$lines[-1] .= ' []';
  				next;
  			}
  			push @lines, $self->_write_array( $cursor, $indent, {} );
  
  		# A hash at the root
  		} elsif ( ref $cursor eq 'HASH' ) {
  			unless ( %$cursor ) {
  				$lines[-1] .= ' {}';
  				next;
  			}
  			push @lines, $self->_write_hash( $cursor, $indent, {} );
  
  		} else {
  			Carp::croak("Cannot serialize " . ref($cursor));
  		}
  	}
  
  	join '', map { "$_\n" } @lines;
  }
  
  sub _write_scalar {
  	my $string = $_[1];
  	return '~'  unless defined $string;
  	return "''" unless length  $string;
  	if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
  		$string =~ s/\\/\\\\/g;
  		$string =~ s/"/\\"/g;
  		$string =~ s/\n/\\n/g;
  		$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
  		return qq|"$string"|;
  	}
  	if ( $string =~ /(?:^\W|\s)/ or $QUOTE{$string} ) {
  		return "'$string'";
  	}
  	return $string;
  }
  
  sub _write_array {
  	my ($self, $array, $indent, $seen) = @_;
  	if ( $seen->{refaddr($array)}++ ) {
  		die "CPAN::Meta::YAML does not support circular references";
  	}
  	my @lines  = ();
  	foreach my $el ( @$array ) {
  		my $line = ('  ' x $indent) . '-';
  		my $type = ref $el;
  		if ( ! $type ) {
  			$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
  			push @lines, $line;
  
  		} elsif ( $type eq 'ARRAY' ) {
  			if ( @$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_array( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' []';
  				push @lines, $line;
  			}
  
  		} elsif ( $type eq 'HASH' ) {
  			if ( keys %$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_hash( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' {}';
  				push @lines, $line;
  			}
  
  		} else {
  			die "CPAN::Meta::YAML does not support $type references";
  		}
  	}
  
  	@lines;
  }
  
  sub _write_hash {
  	my ($self, $hash, $indent, $seen) = @_;
  	if ( $seen->{refaddr($hash)}++ ) {
  		die "CPAN::Meta::YAML does not support circular references";
  	}
  	my @lines  = ();
  	foreach my $name ( sort keys %$hash ) {
  		my $el   = $hash->{$name};
  		my $line = ('  ' x $indent) . "$name:";
  		my $type = ref $el;
  		if ( ! $type ) {
  			$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
  			push @lines, $line;
  
  		} elsif ( $type eq 'ARRAY' ) {
  			if ( @$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_array( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' []';
  				push @lines, $line;
  			}
  
  		} elsif ( $type eq 'HASH' ) {
  			if ( keys %$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_hash( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' {}';
  				push @lines, $line;
  			}
  
  		} else {
  			die "CPAN::Meta::YAML does not support $type references";
  		}
  	}
  
  	@lines;
  }
  
  # Set error
  sub _error {
  	$CPAN::Meta::YAML::errstr = $_[1];
  	undef;
  }
  
  # Retrieve error
  sub errstr {
  	$CPAN::Meta::YAML::errstr;
  }
  
  
  
  
  
  #####################################################################
  # YAML Compatibility
  
  sub Dump {
  	CPAN::Meta::YAML->new(@_)->write_string;
  }
  
  sub Load {
  	my $self = CPAN::Meta::YAML->read_string(@_);
  	unless ( $self ) {
  		Carp::croak("Failed to load YAML document from string");
  	}
  	if ( wantarray ) {
  		return @$self;
  	} else {
  		# To match YAML.pm, return the last document
  		return $self->[-1];
  	}
  }
  
  BEGIN {
  	*freeze = *Dump;
  	*thaw   = *Load;
  }
  
  sub DumpFile {
  	my $file = shift;
  	CPAN::Meta::YAML->new(@_)->write($file);
  }
  
  sub LoadFile {
  	my $self = CPAN::Meta::YAML->read($_[0]);
  	unless ( $self ) {
  		Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
  	}
  	if ( wantarray ) {
  		return @$self;
  	} else {
  		# Return only the last document to match YAML.pm, 
  		return $self->[-1];
  	}
  }
  
  
  
  
  
  #####################################################################
  # Use Scalar::Util if possible, otherwise emulate it
  
  BEGIN {
  	eval {
  		require Scalar::Util;
  		*refaddr = *Scalar::Util::refaddr;
  	};
  	eval <<'END_PERL' if $@;
  # Failed to load Scalar::Util	
  sub refaddr {
  	my $pkg = ref($_[0]) or return undef;
  	if ( !! UNIVERSAL::can($_[0], 'can') ) {
  		bless $_[0], 'Scalar::Util::Fake';
  	} else {
  		$pkg = undef;
  	}
  	"$_[0]" =~ /0x(\w+)/;
  	my $i = do { local $^W; hex $1 };
  	bless $_[0], $pkg if defined $pkg;
  	$i;
  }
  END_PERL
  
  }
  
  1;
  
  
  
  
  __END__
  
  
  # ABSTRACT: Read and write a subset of YAML for CPAN Meta files
  
  
CPAN_META_YAML

$fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
  # vim: ts=4 sts=4 sw=4 et:
  #
  # This file is part of HTTP-Tiny
  #
  # This software is copyright (c) 2011 by Christian Hansen.
  #
  # This is free software; you can redistribute it and/or modify it under
  # the same terms as the Perl 5 programming language system itself.
  #
  package HTTP::Tiny;
  BEGIN {
    $HTTP::Tiny::VERSION = '0.009';
  }
  use strict;
  use warnings;
  # ABSTRACT: A small, simple, correct HTTP/1.1 client
  
  use Carp ();
  
  
  my @attributes;
  BEGIN {
      @attributes = qw(agent default_headers max_redirect max_size proxy timeout);
      no strict 'refs';
      for my $accessor ( @attributes ) {
          *{$accessor} = sub {
              @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
          };
      }
  }
  
  sub new {
      my($class, %args) = @_;
      (my $agent = $class) =~ s{::}{-}g;
      my $self = {
          agent        => $agent . "/" . ($class->VERSION || 0),
          max_redirect => 5,
          timeout      => 60,
      };
      for my $key ( @attributes ) {
          $self->{$key} = $args{$key} if exists $args{$key}
      }
      return bless $self, $class;
  }
  
  
  sub get {
      my ($self, $url, $args) = @_;
      @_ == 2 || (@_ == 3 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->get(URL, [HASHREF])/);
      return $self->request('GET', $url, $args || {});
  }
  
  
  sub mirror {
      my ($self, $url, $file, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/);
      if ( -e $file and my $mtime = (stat($file))[9] ) {
          $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
      }
      my $tempfile = $file . int(rand(2**31));
      open my $fh, ">", $tempfile
          or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!/);
      $args->{data_callback} = sub { print {$fh} $_[0] };
      my $response = $self->request('GET', $url, $args);
      close $fh
          or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!/);
      if ( $response->{success} ) {
          rename $tempfile, $file
              or Carp::croak "Error replacing $file with $tempfile: $!\n";
          my $lm = $response->{headers}{'last-modified'};
          if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
              utime $mtime, $mtime, $file;
          }
      }
      $response->{success} ||= $response->{status} eq '304';
      unlink $tempfile;
      return $response;
  }
  
  
  my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
  
  sub request {
      my ($self, $method, $url, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/);
      $args ||= {}; # we keep some state in this during _request
  
      # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
      my $response;
      for ( 0 .. 1 ) {
          $response = eval { $self->_request($method, $url, $args) };
          last unless $@ && $idempotent{$method}
              && $@ =~ m{^(?:Socket closed|Unexpected end)};
      }
  
      if (my $e = "$@") {
          $response = {
              success => q{},
              status  => 599,
              reason  => 'Internal Exception',
              content => $e,
              headers => {
                  'content-type'   => 'text/plain',
                  'content-length' => length $e,
              }
          };
      }
      return $response;
  }
  
  my %DefaultPort = (
      http => 80,
      https => 443,
  );
  
  sub _request {
      my ($self, $method, $url, $args) = @_;
  
      my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
  
      my $request = {
          method    => $method,
          scheme    => $scheme,
          host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
          uri       => $path_query,
          headers   => {},
      };
  
      my $handle  = HTTP::Tiny::Handle->new(timeout => $self->{timeout});
  
      if ($self->{proxy}) {
          $request->{uri} = "$scheme://$request->{host_port}$path_query";
          croak(qq/HTTPS via proxy is not supported/)
              if $request->{scheme} eq 'https';
          $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
      }
      else {
          $handle->connect($scheme, $host, $port);
      }
  
      $self->_prepare_headers_and_cb($request, $args);
      $handle->write_request($request);
  
      my $response;
      do { $response = $handle->read_response_header }
          until (substr($response->{status},0,1) ne '1');
  
      if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
          $handle->close;
          return $self->_request(@redir_args, $args);
      }
  
      if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
          # response has no message body
      }
      else {
          my $data_cb = $self->_prepare_data_cb($response, $args);
          $handle->read_body($data_cb, $response);
      }
  
      $handle->close;
      $response->{success} = substr($response->{status},0,1) eq '2';
      return $response;
  }
  
  sub _prepare_headers_and_cb {
      my ($self, $request, $args) = @_;
  
      for ($self->{default_headers}, $args->{headers}) {
          next unless defined;
          while (my ($k, $v) = each %$_) {
              $request->{headers}{lc $k} = $v;
          }
      }
      $request->{headers}{'host'}         = $request->{host_port};
      $request->{headers}{'connection'}   = "close";
      $request->{headers}{'user-agent'} ||= $self->{agent};
  
      if (defined $args->{content}) {
          $request->{headers}{'content-type'} ||= "application/octet-stream";
          if (ref $args->{content} eq 'CODE') {
              $request->{headers}{'transfer-encoding'} = 'chunked'
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = $args->{content};
          }
          else {
              my $content = $args->{content};
              if ( $] ge '5.008' ) {
                  utf8::downgrade($content, 1)
                      or Carp::croak(q/Wide character in request message body/);
              }
              $request->{headers}{'content-length'} = length $content
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = sub { substr $content, 0, length $content, '' };
          }
          $request->{trailer_cb} = $args->{trailer_callback}
              if ref $args->{trailer_callback} eq 'CODE';
      }
      return;
  }
  
  sub _prepare_data_cb {
      my ($self, $response, $args) = @_;
      my $data_cb = $args->{data_callback};
      $response->{content} = '';
  
      if (!$data_cb || $response->{status} !~ /^2/) {
          if (defined $self->{max_size}) {
              $data_cb = sub {
                  $_[1]->{content} .= $_[0];
                  die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
                    if length $_[1]->{content} > $self->{max_size};
              };
          }
          else {
              $data_cb = sub { $_[1]->{content} .= $_[0] };
          }
      }
      return $data_cb;
  }
  
  sub _maybe_redirect {
      my ($self, $request, $response, $args) = @_;
      my $headers = $response->{headers};
      my ($status, $method) = ($response->{status}, $request->{method});
      if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
          and $headers->{location}
          and ++$args->{redirects} <= $self->{max_redirect}
      ) {
          my $location = ($headers->{location} =~ /^\//)
              ? "$request->{scheme}://$request->{host_port}$headers->{location}"
              : $headers->{location} ;
          return (($status eq '303' ? 'GET' : $method), $location);
      }
      return;
  }
  
  sub _split_url {
      my $url = pop;
  
      # URI regex adapted from the URI module
      my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
        or Carp::croak(qq/Cannot parse URL: '$url'/);
  
      $scheme     = lc $scheme;
      $path_query = "/$path_query" unless $path_query =~ m<\A/>;
  
      my $host = (length($authority)) ? lc $authority : 'localhost';
         $host =~ s/\A[^@]*@//;   # userinfo
      my $port = do {
         $host =~ s/:([0-9]*)\z// && length $1
           ? $1
           : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef);
      };
  
      return ($scheme, $host, $port, $path_query);
  }
  
  # Date conversions adapted from HTTP::Date
  my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
  my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
  sub _http_date {
      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
      return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
          substr($DoW,$wday*4,3),
          $mday, substr($MoY,$mon*4,3), $year+1900,
          $hour, $min, $sec
      );
  }
  
  sub _parse_http_date {
      my ($self, $str) = @_;
      require Time::Local;
      my @tl_parts;
      if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
          @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
      }
      return eval {
          my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
          $t < 0 ? undef : $t;
      };
  }
  
  package
      HTTP::Tiny::Handle; # hide from PAUSE/indexers
  use strict;
  use warnings;
  
  use Carp       qw[croak];
  use Errno      qw[EINTR EPIPE];
  use IO::Socket qw[SOCK_STREAM];
  
  sub BUFSIZE () { 32768 }
  
  my $Printable = sub {
      local $_ = shift;
      s/\r/\\r/g;
      s/\n/\\n/g;
      s/\t/\\t/g;
      s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
      $_;
  };
  
  my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
  
  sub new {
      my ($class, %args) = @_;
      return bless {
          rbuf             => '',
          timeout          => 60,
          max_line_size    => 16384,
          max_header_lines => 64,
          %args
      }, $class;
  }
  
  my $ssl_verify_args = {
      check_cn => "when_only",
      wildcards_in_alt => "anywhere",
      wildcards_in_cn => "anywhere"
  };
  
  sub connect {
      @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
      my ($self, $scheme, $host, $port) = @_;
  
      if ( $scheme eq 'https' ) {
          eval "require IO::Socket::SSL"
              unless exists $INC{'IO/Socket/SSL.pm'};
          croak(qq/IO::Socket::SSL must be installed for https support\n/)
              unless $INC{'IO/Socket/SSL.pm'};
      }
      elsif ( $scheme ne 'http' ) {
        croak(qq/Unsupported URL scheme '$scheme'/);
      }
  
      $self->{fh} = 'IO::Socket::INET'->new(
          PeerHost  => $host,
          PeerPort  => $port,
          Proto     => 'tcp',
          Type      => SOCK_STREAM,
          Timeout   => $self->{timeout}
      ) or croak(qq/Could not connect to '$host:$port': $@/);
  
      binmode($self->{fh})
        or croak(qq/Could not binmode() socket: '$!'/);
  
      if ( $scheme eq 'https') {
          IO::Socket::SSL->start_SSL($self->{fh});
          ref($self->{fh}) eq 'IO::Socket::SSL'
              or die(qq/SSL connection failed for $host\n/);
          $self->{fh}->verify_hostname( $host, $ssl_verify_args )
              or die(qq/SSL certificate not valid for $host\n/);
      }
  
      $self->{host} = $host;
      $self->{port} = $port;
  
      return $self;
  }
  
  sub close {
      @_ == 1 || croak(q/Usage: $handle->close()/);
      my ($self) = @_;
      CORE::close($self->{fh})
        or croak(qq/Could not close socket: '$!'/);
  }
  
  sub write {
      @_ == 2 || croak(q/Usage: $handle->write(buf)/);
      my ($self, $buf) = @_;
  
      if ( $] ge '5.008' ) {
          utf8::downgrade($buf, 1)
              or croak(q/Wide character in write()/);
      }
  
      my $len = length $buf;
      my $off = 0;
  
      local $SIG{PIPE} = 'IGNORE';
  
      while () {
          $self->can_write
            or croak(q/Timed out while waiting for socket to become ready for writing/);
          my $r = syswrite($self->{fh}, $buf, $len, $off);
          if (defined $r) {
              $len -= $r;
              $off += $r;
              last unless $len > 0;
          }
          elsif ($! == EPIPE) {
              croak(qq/Socket closed by remote server: $!/);
          }
          elsif ($! != EINTR) {
              croak(qq/Could not write to socket: '$!'/);
          }
      }
      return $off;
  }
  
  sub read {
      @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len [, allow_partial])/);
      my ($self, $len, $allow_partial) = @_;
  
      my $buf  = '';
      my $got = length $self->{rbuf};
  
      if ($got) {
          my $take = ($got < $len) ? $got : $len;
          $buf  = substr($self->{rbuf}, 0, $take, '');
          $len -= $take;
      }
  
      while ($len > 0) {
          $self->can_read
            or croak(q/Timed out while waiting for socket to become ready for reading/);
          my $r = sysread($self->{fh}, $buf, $len, length $buf);
          if (defined $r) {
              last unless $r;
              $len -= $r;
          }
          elsif ($! != EINTR) {
              croak(qq/Could not read from socket: '$!'/);
          }
      }
      if ($len && !$allow_partial) {
          croak(q/Unexpected end of stream/);
      }
      return $buf;
  }
  
  sub readline {
      @_ == 1 || croak(q/Usage: $handle->readline()/);
      my ($self) = @_;
  
      while () {
          if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
              return $1;
          }
          if (length $self->{rbuf} >= $self->{max_line_size}) {
              croak(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}/);
          }
          $self->can_read
            or croak(q/Timed out while waiting for socket to become ready for reading/);
          my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
          if (defined $r) {
              last unless $r;
          }
          elsif ($! != EINTR) {
              croak(qq/Could not read from socket: '$!'/);
          }
      }
      croak(q/Unexpected end of stream while looking for line/);
  }
  
  sub read_header_lines {
      @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
      my ($self, $headers) = @_;
      $headers ||= {};
      my $lines   = 0;
      my $val;
  
      while () {
           my $line = $self->readline;
  
           if (++$lines >= $self->{max_header_lines}) {
               croak(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}/);
           }
           elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
               my ($field_name) = lc $1;
               if (exists $headers->{$field_name}) {
                   for ($headers->{$field_name}) {
                       $_ = [$_] unless ref $_ eq "ARRAY";
                       push @$_, $2;
                       $val = \$_->[-1];
                   }
               }
               else {
                   $val = \($headers->{$field_name} = $2);
               }
           }
           elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
               $val
                 or croak(q/Unexpected header continuation line/);
               next unless length $1;
               $$val .= ' ' if length $$val;
               $$val .= $1;
           }
           elsif ($line =~ /\A \x0D?\x0A \z/x) {
              last;
           }
           else {
              croak(q/Malformed header line: / . $Printable->($line));
           }
      }
      return $headers;
  }
  
  sub write_request {
      @_ == 2 || croak(q/Usage: $handle->write_request(request)/);
      my($self, $request) = @_;
      $self->write_request_header(@{$request}{qw/method uri headers/});
      $self->write_body($request) if $request->{cb};
      return;
  }
  
  my %HeaderCase = (
      'content-md5'      => 'Content-MD5',
      'etag'             => 'ETag',
      'te'               => 'TE',
      'www-authenticate' => 'WWW-Authenticate',
      'x-xss-protection' => 'X-XSS-Protection',
  );
  
  sub write_header_lines {
      (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
      my($self, $headers) = @_;
  
      my $buf = '';
      while (my ($k, $v) = each %$headers) {
          my $field_name = lc $k;
          if (exists $HeaderCase{$field_name}) {
              $field_name = $HeaderCase{$field_name};
          }
          else {
              $field_name =~ /\A $Token+ \z/xo
                or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
              $field_name =~ s/\b(\w)/\u$1/g;
              $HeaderCase{lc $field_name} = $field_name;
          }
          for (ref $v eq 'ARRAY' ? @$v : $v) {
              /[^\x0D\x0A]/
                or croak(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_));
              $buf .= "$field_name: $_\x0D\x0A";
          }
      }
      $buf .= "\x0D\x0A";
      return $self->write($buf);
  }
  
  sub read_body {
      @_ == 3 || croak(q/Usage: $handle->read_body(callback, response)/);
      my ($self, $cb, $response) = @_;
      my $te = $response->{headers}{'transfer-encoding'} || '';
      if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
          $self->read_chunked_body($cb, $response);
      }
      else {
          $self->read_content_body($cb, $response);
      }
      return;
  }
  
  sub write_body {
      @_ == 2 || croak(q/Usage: $handle->write_body(request)/);
      my ($self, $request) = @_;
      if ($request->{headers}{'content-length'}) {
          return $self->write_content_body($request);
      }
      else {
          return $self->write_chunked_body($request);
      }
  }
  
  sub read_content_body {
      @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
      my ($self, $cb, $response, $content_length) = @_;
      $content_length ||= $response->{headers}{'content-length'};
  
      if ( $content_length ) {
          my $len = $content_length;
          while ($len > 0) {
              my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
              $cb->($self->read($read, 0), $response);
              $len -= $read;
          }
      }
      else {
          my $chunk;
          $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
      }
  
      return;
  }
  
  sub write_content_body {
      @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
      my ($self, $request) = @_;
  
      my ($len, $content_length) = (0, $request->{headers}{'content-length'});
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or croak(q/Wide character in write_content()/);
          }
  
          $len += $self->write($data);
      }
  
      $len == $content_length
        or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
  
      return $len;
  }
  
  sub read_chunked_body {
      @_ == 3 || croak(q/Usage: $handle->read_chunked_body(callback, $response)/);
      my ($self, $cb, $response) = @_;
  
      while () {
          my $head = $self->readline;
  
          $head =~ /\A ([A-Fa-f0-9]+)/x
            or croak(q/Malformed chunk head: / . $Printable->($head));
  
          my $len = hex($1)
            or last;
  
          $self->read_content_body($cb, $response, $len);
  
          $self->read(2) eq "\x0D\x0A"
            or croak(q/Malformed chunk: missing CRLF after chunk data/);
      }
      $self->read_header_lines($response->{headers});
      return;
  }
  
  sub write_chunked_body {
      @_ == 2 || croak(q/Usage: $handle->write_chunked_body(request)/);
      my ($self, $request) = @_;
  
      my $len = 0;
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or croak(q/Wide character in write_chunked_body()/);
          }
  
          $len += length $data;
  
          my $chunk  = sprintf '%X', length $data;
             $chunk .= "\x0D\x0A";
             $chunk .= $data;
             $chunk .= "\x0D\x0A";
  
          $self->write($chunk);
      }
      $self->write("0\x0D\x0A");
      $self->write_header_lines($request->{trailer_cb}->())
          if ref $request->{trailer_cb} eq 'CODE';
      return $len;
  }
  
  sub read_response_header {
      @_ == 1 || croak(q/Usage: $handle->read_response_header()/);
      my ($self) = @_;
  
      my $line = $self->readline;
  
      $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
        or croak(q/Malformed Status-Line: / . $Printable->($line));
  
      my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
  
      croak (qq/Unsupported HTTP protocol: $protocol/)
          unless $version =~ /0*1\.0*[01]/;
  
      return {
          status   => $status,
          reason   => $reason,
          headers  => $self->read_header_lines,
          protocol => $protocol,
      };
  }
  
  sub write_request_header {
      @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
      my ($self, $method, $request_uri, $headers) = @_;
  
      return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
           + $self->write_header_lines($headers);
  }
  
  sub _do_timeout {
      my ($self, $type, $timeout) = @_;
      $timeout = $self->{timeout}
          unless defined $timeout && $timeout >= 0;
  
      my $fd = fileno $self->{fh};
      defined $fd && $fd >= 0
        or croak(q/select(2): 'Bad file descriptor'/);
  
      my $initial = time;
      my $pending = $timeout;
      my $nfound;
  
      vec(my $fdset = '', $fd, 1) = 1;
  
      while () {
          $nfound = ($type eq 'read')
              ? select($fdset, undef, undef, $pending)
              : select(undef, $fdset, undef, $pending) ;
          if ($nfound == -1) {
              $! == EINTR
                or croak(qq/select(2): '$!'/);
              redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
              $nfound = 0;
          }
          last;
      }
      $! = 0;
      return $nfound;
  }
  
  sub can_read {
      @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
      my $self = shift;
      return $self->_do_timeout('read', @_)
  }
  
  sub can_write {
      @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
      my $self = shift;
      return $self->_do_timeout('write', @_)
  }
  
  1;
  
  
  
  __END__
  =pod
  
HTTP_TINY

$fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
  package JSON::PP;
  
  # JSON-2.0
  
  use 5.005;
  use strict;
  use base qw(Exporter);
  use overload ();
  
  use Carp ();
  use B ();
  #use Devel::Peek;
  
  $JSON::PP::VERSION = '2.27200';
  
  @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
  
  # instead of hash-access, i tried index-access for speed.
  # but this method is not faster than what i expected. so it will be changed.
  
  use constant P_ASCII                => 0;
  use constant P_LATIN1               => 1;
  use constant P_UTF8                 => 2;
  use constant P_INDENT               => 3;
  use constant P_CANONICAL            => 4;
  use constant P_SPACE_BEFORE         => 5;
  use constant P_SPACE_AFTER          => 6;
  use constant P_ALLOW_NONREF         => 7;
  use constant P_SHRINK               => 8;
  use constant P_ALLOW_BLESSED        => 9;
  use constant P_CONVERT_BLESSED      => 10;
  use constant P_RELAXED              => 11;
  
  use constant P_LOOSE                => 12;
  use constant P_ALLOW_BIGNUM         => 13;
  use constant P_ALLOW_BAREKEY        => 14;
  use constant P_ALLOW_SINGLEQUOTE    => 15;
  use constant P_ESCAPE_SLASH         => 16;
  use constant P_AS_NONBLESSED        => 17;
  
  use constant P_ALLOW_UNKNOWN        => 18;
  
  use constant OLD_PERL => $] < 5.008 ? 1 : 0;
  
  BEGIN {
      my @xs_compati_bit_properties = qw(
              latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
              allow_blessed convert_blessed relaxed allow_unknown
      );
      my @pp_bit_properties = qw(
              allow_singlequote allow_bignum loose
              allow_barekey escape_slash as_nonblessed
      );
  
      # Perl version check, Unicode handling is enable?
      # Helper module sets @JSON::PP::_properties.
      if ($] < 5.008 ) {
          my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
          eval qq| require $helper |;
          if ($@) { Carp::croak $@; }
      }
  
      for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
          my $flag_name = 'P_' . uc($name);
  
          eval qq/
              sub $name {
                  my \$enable = defined \$_[1] ? \$_[1] : 1;
  
                  if (\$enable) {
                      \$_[0]->{PROPS}->[$flag_name] = 1;
                  }
                  else {
                      \$_[0]->{PROPS}->[$flag_name] = 0;
                  }
  
                  \$_[0];
              }
  
              sub get_$name {
                  \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
              }
          /;
      }
  
  }
  
  
  
  # Functions
  
  my %encode_allow_method
       = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
                            allow_blessed convert_blessed indent indent_length allow_bignum
                            as_nonblessed
                          /;
  my %decode_allow_method
       = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
                            allow_barekey max_size relaxed/;
  
  
  my $JSON; # cache
  
  sub encode_json ($) { # encode
      ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
  }
  
  
  sub decode_json { # decode
      ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
  }
  
  # Obsoleted
  
  sub to_json($) {
     Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
  }
  
  
  sub from_json($) {
     Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
  }
  
  
  # Methods
  
  sub new {
      my $class = shift;
      my $self  = {
          max_depth   => 512,
          max_size    => 0,
          indent      => 0,
          FLAGS       => 0,
          fallback      => sub { encode_error('Invalid value. JSON can only reference.') },
          indent_length => 3,
      };
  
      bless $self, $class;
  }
  
  
  sub encode {
      return $_[0]->PP_encode_json($_[1]);
  }
  
  
  sub decode {
      return $_[0]->PP_decode_json($_[1], 0x00000000);
  }
  
  
  sub decode_prefix {
      return $_[0]->PP_decode_json($_[1], 0x00000001);
  }
  
  
  # accessor
  
  
  # pretty printing
  
  sub pretty {
      my ($self, $v) = @_;
      my $enable = defined $v ? $v : 1;
  
      if ($enable) { # indent_length(3) for JSON::XS compatibility
          $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
      }
      else {
          $self->indent(0)->space_before(0)->space_after(0);
      }
  
      $self;
  }
  
  # etc
  
  sub max_depth {
      my $max  = defined $_[1] ? $_[1] : 0x80000000;
      $_[0]->{max_depth} = $max;
      $_[0];
  }
  
  
  sub get_max_depth { $_[0]->{max_depth}; }
  
  
  sub max_size {
      my $max  = defined $_[1] ? $_[1] : 0;
      $_[0]->{max_size} = $max;
      $_[0];
  }
  
  
  sub get_max_size { $_[0]->{max_size}; }
  
  
  sub filter_json_object {
      $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
  
  sub filter_json_single_key_object {
      if (@_ > 1) {
          $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
      }
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
  
  sub indent_length {
      if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
      }
      else {
          $_[0]->{indent_length} = $_[1];
      }
      $_[0];
  }
  
  sub get_indent_length {
      $_[0]->{indent_length};
  }
  
  sub sort_by {
      $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
      $_[0];
  }
  
  sub allow_bigint {
      Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
  }
  
  ###############################
  
  ###
  ### Perl => JSON
  ###
  
  
  { # Convert
  
      my $max_depth;
      my $indent;
      my $ascii;
      my $latin1;
      my $utf8;
      my $space_before;
      my $space_after;
      my $canonical;
      my $allow_blessed;
      my $convert_blessed;
  
      my $indent_length;
      my $escape_slash;
      my $bignum;
      my $as_nonblessed;
  
      my $depth;
      my $indent_count;
      my $keysort;
  
  
      sub PP_encode_json {
          my $self = shift;
          my $obj  = shift;
  
          $indent_count = 0;
          $depth        = 0;
  
          my $idx = $self->{PROPS};
  
          ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
              $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
           = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
                      P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
  
          ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
  
          $keysort = $canonical ? sub { $a cmp $b } : undef;
  
          if ($self->{sort_by}) {
              $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
                       : $self->{sort_by} =~ /\D+/       ? $self->{sort_by}
                       : sub { $a cmp $b };
          }
  
          encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
               if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
  
          my $str  = $self->object_to_json($obj);
  
          $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
  
          unless ($ascii or $latin1 or $utf8) {
              utf8::upgrade($str);
          }
  
          if ($idx->[ P_SHRINK ]) {
              utf8::downgrade($str, 1);
          }
  
          return $str;
      }
  
  
      sub object_to_json {
          my ($self, $obj) = @_;
          my $type = ref($obj);
  
          if($type eq 'HASH'){
              return $self->hash_to_json($obj);
          }
          elsif($type eq 'ARRAY'){
              return $self->array_to_json($obj);
          }
          elsif ($type) { # blessed object?
              if (blessed($obj)) {
  
                  return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
  
                  if ( $convert_blessed and $obj->can('TO_JSON') ) {
                      my $result = $obj->TO_JSON();
                      if ( defined $result and ref( $result ) ) {
                          if ( refaddr( $obj ) eq refaddr( $result ) ) {
                              encode_error( sprintf(
                                  "%s::TO_JSON method returned same object as was passed instead of a new one",
                                  ref $obj
                              ) );
                          }
                      }
  
                      return $self->object_to_json( $result );
                  }
  
                  return "$obj" if ( $bignum and _is_bignum($obj) );
                  return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
  
                  encode_error( sprintf("encountered object '%s', but neither allow_blessed "
                      . "nor convert_blessed settings are enabled", $obj)
                  ) unless ($allow_blessed);
  
                  return 'null';
              }
              else {
                  return $self->value_to_json($obj);
              }
          }
          else{
              return $self->value_to_json($obj);
          }
      }
  
  
      sub hash_to_json {
          my ($self, $obj) = @_;
          my @res;
  
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
  
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
          my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
  
          for my $k ( _sort( $obj ) ) {
              if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
              push @res, string_to_json( $self, $k )
                            .  $del
                            . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
          }
  
          --$depth;
          $self->_down_indent() if ($indent);
  
          return   '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' )  . '}';
      }
  
  
      sub array_to_json {
          my ($self, $obj) = @_;
          my @res;
  
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
  
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
  
          for my $v (@$obj){
              push @res, $self->object_to_json($v) || $self->value_to_json($v);
          }
  
          --$depth;
          $self->_down_indent() if ($indent);
  
          return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
      }
  
  
      sub value_to_json {
          my ($self, $value) = @_;
  
          return 'null' if(!defined $value);
  
          my $b_obj = B::svref_2object(\$value);  # for round trip problem
          my $flags = $b_obj->FLAGS;
  
          return $value # as is 
              if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
  
          my $type = ref($value);
  
          if(!$type){
              return string_to_json($self, $value);
          }
          elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
              return $$value == 1 ? 'true' : 'false';
          }
          elsif ($type) {
              if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
                  return $self->value_to_json("$value");
              }
  
              if ($type eq 'SCALAR' and defined $$value) {
                  return   $$value eq '1' ? 'true'
                         : $$value eq '0' ? 'false'
                         : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
                         : encode_error("cannot encode reference to scalar");
              }
  
               if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
                   return 'null';
               }
               else {
                   if ( $type eq 'SCALAR' or $type eq 'REF' ) {
                      encode_error("cannot encode reference to scalar");
                   }
                   else {
                      encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
                   }
               }
  
          }
          else {
              return $self->{fallback}->($value)
                   if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
              return 'null';
          }
  
      }
  
  
      my %esc = (
          "\n" => '\n',
          "\r" => '\r',
          "\t" => '\t',
          "\f" => '\f',
          "\b" => '\b',
          "\"" => '\"',
          "\\" => '\\\\',
          "\'" => '\\\'',
      );
  
  
      sub string_to_json {
          my ($self, $arg) = @_;
  
          $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
          $arg =~ s/\//\\\//g if ($escape_slash);
          $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
  
          if ($ascii) {
              $arg = JSON_PP_encode_ascii($arg);
          }
  
          if ($latin1) {
              $arg = JSON_PP_encode_latin1($arg);
          }
  
          if ($utf8) {
              utf8::encode($arg);
          }
  
          return '"' . $arg . '"';
      }
  
  
      sub blessed_to_json {
          my $reftype = reftype($_[1]) || '';
          if ($reftype eq 'HASH') {
              return $_[0]->hash_to_json($_[1]);
          }
          elsif ($reftype eq 'ARRAY') {
              return $_[0]->array_to_json($_[1]);
          }
          else {
              return 'null';
          }
      }
  
  
      sub encode_error {
          my $error  = shift;
          Carp::croak "$error";
      }
  
  
      sub _sort {
          defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
      }
  
  
      sub _up_indent {
          my $self  = shift;
          my $space = ' ' x $indent_length;
  
          my ($pre,$post) = ('','');
  
          $post = "\n" . $space x $indent_count;
  
          $indent_count++;
  
          $pre = "\n" . $space x $indent_count;
  
          return ($pre,$post);
      }
  
  
      sub _down_indent { $indent_count--; }
  
  
      sub PP_encode_box {
          {
              depth        => $depth,
              indent_count => $indent_count,
          };
      }
  
  } # Convert
  
  
  sub _encode_ascii {
      join('',
          map {
              $_ <= 127 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
  
  
  sub _encode_latin1 {
      join('',
          map {
              $_ <= 255 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
  
  
  sub _encode_surrogates { # from perlunicode
      my $uni = $_[0] - 0x10000;
      return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
  }
  
  
  sub _is_bignum {
      $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
  }
  
  
  
  #
  # JSON => Perl
  #
  
  my $max_intsize;
  
  BEGIN {
      my $checkint = 1111;
      for my $d (5..64) {
          $checkint .= 1;
          my $int   = eval qq| $checkint |;
          if ($int =~ /[eE]/) {
              $max_intsize = $d - 1;
              last;
          }
      }
  }
  
  { # PARSE 
  
      my %escapes = ( #  by Jeremy Muhlich <jmuhlich [at] bitflood.org>
          b    => "\x8",
          t    => "\x9",
          n    => "\xA",
          f    => "\xC",
          r    => "\xD",
          '\\' => '\\',
          '"'  => '"',
          '/'  => '/',
      );
  
      my $text; # json data
      my $at;   # offset
      my $ch;   # 1chracter
      my $len;  # text length (changed according to UTF8 or NON UTF8)
      # INTERNAL
      my $depth;          # nest counter
      my $encoding;       # json text encoding
      my $is_valid_utf8;  # temp variable
      my $utf8_len;       # utf8 byte length
      # FLAGS
      my $utf8;           # must be utf8
      my $max_depth;      # max nest nubmer of objects and arrays
      my $max_size;
      my $relaxed;
      my $cb_object;
      my $cb_sk_object;
  
      my $F_HOOK;
  
      my $allow_bigint;   # using Math::BigInt
      my $singlequote;    # loosely quoting
      my $loose;          # 
      my $allow_barekey;  # bareKey
  
      # $opt flag
      # 0x00000001 .... decode_prefix
      # 0x10000000 .... incr_parse
  
      sub PP_decode_json {
          my ($self, $opt); # $opt is an effective flag during this decode_json.
  
          ($self, $text, $opt) = @_;
  
          ($at, $ch, $depth) = (0, '', 0);
  
          if ( !defined $text or ref $text ) {
              decode_error("malformed JSON string, neither array, object, number, string or atom");
          }
  
          my $idx = $self->{PROPS};
  
          ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
              = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
  
          if ( $utf8 ) {
              utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
          }
          else {
              utf8::upgrade( $text );
          }
  
          $len = length $text;
  
          ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
               = @{$self}{qw/max_depth  max_size cb_object cb_sk_object F_HOOK/};
  
          if ($max_size > 1) {
              use bytes;
              my $bytes = length $text;
              decode_error(
                  sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
                      , $bytes, $max_size), 1
              ) if ($bytes > $max_size);
          }
  
          # Currently no effect
          # should use regexp
          my @octets = unpack('C4', $text);
          $encoding =   ( $octets[0] and  $octets[1]) ? 'UTF-8'
                      : (!$octets[0] and  $octets[1]) ? 'UTF-16BE'
                      : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
                      : ( $octets[2]                ) ? 'UTF-16LE'
                      : (!$octets[2]                ) ? 'UTF-32LE'
                      : 'unknown';
  
          white(); # remove head white space
  
          my $valid_start = defined $ch; # Is there a first character for JSON structure?
  
          my $result = value();
  
          return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
  
          decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
  
          if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
                  decode_error(
                  'JSON text must be an object or array (but found number, string, true, false or null,'
                         . ' use allow_nonref to allow this)', 1);
          }
  
          Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
  
          my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
  
          white(); # remove tail white space
  
          if ( $ch ) {
              return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
              decode_error("garbage after JSON object");
          }
  
          ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
      }
  
  
      sub next_chr {
          return $ch = undef if($at >= $len);
          $ch = substr($text, $at++, 1);
      }
  
  
      sub value {
          white();
          return          if(!defined $ch);
          return object() if($ch eq '{');
          return array()  if($ch eq '[');
          return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
          return number() if($ch =~ /[0-9]/ or $ch eq '-');
          return word();
      }
  
      sub string {
          my ($i, $s, $t, $u);
          my $utf16;
          my $is_utf8;
  
          ($is_valid_utf8, $utf8_len) = ('', 0);
  
          $s = ''; # basically UTF8 flag on
  
          if($ch eq '"' or ($singlequote and $ch eq "'")){
              my $boundChar = $ch;
  
              OUTER: while( defined(next_chr()) ){
  
                  if($ch eq $boundChar){
                      next_chr();
  
                      if ($utf16) {
                          decode_error("missing low surrogate character in surrogate pair");
                      }
  
                      utf8::decode($s) if($is_utf8);
  
                      return $s;
                  }
                  elsif($ch eq '\\'){
                      next_chr();
                      if(exists $escapes{$ch}){
                          $s .= $escapes{$ch};
                      }
                      elsif($ch eq 'u'){ # UNICODE handling
                          my $u = '';
  
                          for(1..4){
                              $ch = next_chr();
                              last OUTER if($ch !~ /[0-9a-fA-F]/);
                              $u .= $ch;
                          }
  
                          # U+D800 - U+DBFF
                          if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
                              $utf16 = $u;
                          }
                          # U+DC00 - U+DFFF
                          elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
                              unless (defined $utf16) {
                                  decode_error("missing high surrogate character in surrogate pair");
                              }
                              $is_utf8 = 1;
                              $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
                              $utf16 = undef;
                          }
                          else {
                              if (defined $utf16) {
                                  decode_error("surrogate pair expected");
                              }
  
                              if ( ( my $hex = hex( $u ) ) > 127 ) {
                                  $is_utf8 = 1;
                                  $s .= JSON_PP_decode_unicode($u) || next;
                              }
                              else {
                                  $s .= chr $hex;
                              }
                          }
  
                      }
                      else{
                          unless ($loose) {
                              $at -= 2;
                              decode_error('illegal backslash escape sequence in string');
                          }
                          $s .= $ch;
                      }
                  }
                  else{
  
                      if ( ord $ch  > 127 ) {
                          if ( $utf8 ) {
                              unless( $ch = is_valid_utf8($ch) ) {
                                  $at -= 1;
                                  decode_error("malformed UTF-8 character in JSON string");
                              }
                              else {
                                  $at += $utf8_len - 1;
                              }
                          }
                          else {
                              utf8::encode( $ch );
                          }
  
                          $is_utf8 = 1;
                      }
  
                      if (!$loose) {
                          if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
                              $at--;
                              decode_error('invalid character encountered while parsing JSON string');
                          }
                      }
  
                      $s .= $ch;
                  }
              }
          }
  
          decode_error("unexpected end of string while parsing JSON string");
      }
  
  
      sub white {
          while( defined $ch  ){
              if($ch le ' '){
                  next_chr();
              }
              elsif($ch eq '/'){
                  next_chr();
                  if(defined $ch and $ch eq '/'){
                      1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
                  }
                  elsif(defined $ch and $ch eq '*'){
                      next_chr();
                      while(1){
                          if(defined $ch){
                              if($ch eq '*'){
                                  if(defined(next_chr()) and $ch eq '/'){
                                      next_chr();
                                      last;
                                  }
                              }
                              else{
                                  next_chr();
                              }
                          }
                          else{
                              decode_error("Unterminated comment");
                          }
                      }
                      next;
                  }
                  else{
                      $at--;
                      decode_error("malformed JSON string, neither array, object, number, string or atom");
                  }
              }
              else{
                  if ($relaxed and $ch eq '#') { # correctly?
                      pos($text) = $at;
                      $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
                      $at = pos($text);
                      next_chr;
                      next;
                  }
  
                  last;
              }
          }
      }
  
  
      sub array {
          my $a  = $_[0] || []; # you can use this code to use another array ref object.
  
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                      if (++$depth > $max_depth);
  
          next_chr();
          white();
  
          if(defined $ch and $ch eq ']'){
              --$depth;
              next_chr();
              return $a;
          }
          else {
              while(defined($ch)){
                  push @$a, value();
  
                  white();
  
                  if (!defined $ch) {
                      last;
                  }
  
                  if($ch eq ']'){
                      --$depth;
                      next_chr();
                      return $a;
                  }
  
                  if($ch ne ','){
                      last;
                  }
  
                  next_chr();
                  white();
  
                  if ($relaxed and $ch eq ']') {
                      --$depth;
                      next_chr();
                      return $a;
                  }
  
              }
          }
  
          decode_error(", or ] expected while parsing array");
      }
  
  
      sub object {
          my $o = $_[0] || {}; # you can use this code to use another hash ref object.
          my $k;
  
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                  if (++$depth > $max_depth);
          next_chr();
          white();
  
          if(defined $ch and $ch eq '}'){
              --$depth;
              next_chr();
              if ($F_HOOK) {
                  return _json_object_hook($o);
              }
              return $o;
          }
          else {
              while (defined $ch) {
                  $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
                  white();
  
                  if(!defined $ch or $ch ne ':'){
                      $at--;
                      decode_error("':' expected");
                  }
  
                  next_chr();
                  $o->{$k} = value();
                  white();
  
                  last if (!defined $ch);
  
                  if($ch eq '}'){
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
  
                  if($ch ne ','){
                      last;
                  }
  
                  next_chr();
                  white();
  
                  if ($relaxed and $ch eq '}') {
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
  
              }
  
          }
  
          $at--;
          decode_error(", or } expected while parsing object/hash");
      }
  
  
      sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
          my $key;
          while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
              $key .= $ch;
              next_chr();
          }
          return $key;
      }
  
  
      sub word {
          my $word =  substr($text,$at-1,4);
  
          if($word eq 'true'){
              $at += 3;
              next_chr;
              return $JSON::PP::true;
          }
          elsif($word eq 'null'){
              $at += 3;
              next_chr;
              return undef;
          }
          elsif($word eq 'fals'){
              $at += 3;
              if(substr($text,$at,1) eq 'e'){
                  $at++;
                  next_chr;
                  return $JSON::PP::false;
              }
          }
  
          $at--; # for decode_error report
  
          decode_error("'null' expected")  if ($word =~ /^n/);
          decode_error("'true' expected")  if ($word =~ /^t/);
          decode_error("'false' expected") if ($word =~ /^f/);
          decode_error("malformed JSON string, neither array, object, number, string or atom");
      }
  
  
      sub number {
          my $n    = '';
          my $v;
  
          # According to RFC4627, hex or oct digts are invalid.
          if($ch eq '0'){
              my $peek = substr($text,$at,1);
              my $hex  = $peek =~ /[xX]/; # 0 or 1
  
              if($hex){
                  decode_error("malformed number (leading zero must not be followed by another digit)");
                  ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
              }
              else{ # oct
                  ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
                  if (defined $n and length $n > 1) {
                      decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
              }
  
              if(defined $n and length($n)){
                  if (!$hex and length($n) == 1) {
                     decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
                  $at += length($n) + $hex;
                  next_chr;
                  return $hex ? hex($n) : oct($n);
              }
          }
  
          if($ch eq '-'){
              $n = '-';
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after initial minus)");
              }
          }
  
          while(defined $ch and $ch =~ /\d/){
              $n .= $ch;
              next_chr;
          }
  
          if(defined $ch and $ch eq '.'){
              $n .= '.';
  
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after decimal point)");
              }
              else {
                  $n .= $ch;
              }
  
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
          }
  
          if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
              $n .= $ch;
              next_chr;
  
              if(defined($ch) and ($ch eq '+' or $ch eq '-')){
                  $n .= $ch;
                  next_chr;
                  if (!defined $ch or $ch =~ /\D/) {
                      decode_error("malformed number (no digits after exp sign)");
                  }
                  $n .= $ch;
              }
              elsif(defined($ch) and $ch =~ /\d/){
                  $n .= $ch;
              }
              else {
                  decode_error("malformed number (no digits after exp sign)");
              }
  
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
  
          }
  
          $v .= $n;
  
          if ($v !~ /[.eE]/ and length $v > $max_intsize) {
              if ($allow_bigint) { # from Adam Sussman
                  require Math::BigInt;
                  return Math::BigInt->new($v);
              }
              else {
                  return "$v";
              }
          }
          elsif ($allow_bigint) {
              require Math::BigFloat;
              return Math::BigFloat->new($v);
          }
  
          return 0+$v;
      }
  
  
      sub is_valid_utf8 {
  
          $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
                    : $_[0] =~ /[\xC2-\xDF]/  ? 2
                    : $_[0] =~ /[\xE0-\xEF]/  ? 3
                    : $_[0] =~ /[\xF0-\xF4]/  ? 4
                    : 0
                    ;
  
          return unless $utf8_len;
  
          my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
  
          return ( $is_valid_utf8 =~ /^(?:
               [\x00-\x7F]
              |[\xC2-\xDF][\x80-\xBF]
              |[\xE0][\xA0-\xBF][\x80-\xBF]
              |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
              |[\xED][\x80-\x9F][\x80-\xBF]
              |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
              |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
          )$/x )  ? $is_valid_utf8 : '';
      }
  
  
      sub decode_error {
          my $error  = shift;
          my $no_rep = shift;
          my $str    = defined $text ? substr($text, $at) : '';
          my $mess   = '';
          my $type   = $] >= 5.008           ? 'U*'
                     : $] <  5.006           ? 'C*'
                     : utf8::is_utf8( $str ) ? 'U*' # 5.6
                     : 'C*'
                     ;
  
          for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
              $mess .=  $c == 0x07 ? '\a'
                      : $c == 0x09 ? '\t'
                      : $c == 0x0a ? '\n'
                      : $c == 0x0d ? '\r'
                      : $c == 0x0c ? '\f'
                      : $c <  0x20 ? sprintf('\x{%x}', $c)
                      : $c == 0x5c ? '\\\\'
                      : $c <  0x80 ? chr($c)
                      : sprintf('\x{%x}', $c)
                      ;
              if ( length $mess >= 20 ) {
                  $mess .= '...';
                  last;
              }
          }
  
          unless ( length $mess ) {
              $mess = '(end of string)';
          }
  
          Carp::croak (
              $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
          );
  
      }
  
  
      sub _json_object_hook {
          my $o    = $_[0];
          my @ks = keys %{$o};
  
          if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
              my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
              if (@val == 1) {
                  return $val[0];
              }
          }
  
          my @val = $cb_object->($o) if ($cb_object);
          if (@val == 0 or @val > 1) {
              return $o;
          }
          else {
              return $val[0];
          }
      }
  
  
      sub PP_decode_box {
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
      }
  
  } # PARSE
  
  
  sub _decode_surrogates { # from perlunicode
      my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
      my $un  = pack('U*', $uni);
      utf8::encode( $un );
      return $un;
  }
  
  
  sub _decode_unicode {
      my $un = pack('U', hex shift);
      utf8::encode( $un );
      return $un;
  }
  
  #
  # Setup for various Perl versions (the code from JSON::PP58)
  #
  
  BEGIN {
  
      unless ( defined &utf8::is_utf8 ) {
         require Encode;
         *utf8::is_utf8 = *Encode::is_utf8;
      }
  
      if ( $] >= 5.008 ) {
          *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
          *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
          *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
          *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
      }
  
      if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
          package JSON::PP;
          require subs;
          subs->import('join');
          eval q|
              sub join {
                  return '' if (@_ < 2);
                  my $j   = shift;
                  my $str = shift;
                  for (@_) { $str .= $j . $_; }
                  return $str;
              }
          |;
      }
  
  
      sub JSON::PP::incr_parse {
          local $Carp::CarpLevel = 1;
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
      }
  
  
      sub JSON::PP::incr_skip {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
      }
  
  
      sub JSON::PP::incr_reset {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
      }
  
      eval q{
          sub JSON::PP::incr_text : lvalue {
              $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
  
              if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
                  Carp::croak("incr_text can not be called when the incremental parser already started parsing");
              }
              $_[0]->{_incr_parser}->{incr_text};
          }
      } if ( $] >= 5.006 );
  
  } # Setup for various Perl versions (the code from JSON::PP58)
  
  
  ###############################
  # Utilities
  #
  
  BEGIN {
      eval 'require Scalar::Util';
      unless($@){
          *JSON::PP::blessed = \&Scalar::Util::blessed;
          *JSON::PP::reftype = \&Scalar::Util::reftype;
          *JSON::PP::refaddr = \&Scalar::Util::refaddr;
      }
      else{ # This code is from Sclar::Util.
          # warn $@;
          eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
          *JSON::PP::blessed = sub {
              local($@, $SIG{__DIE__}, $SIG{__WARN__});
              ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
          };
          my %tmap = qw(
              B::NULL   SCALAR
              B::HV     HASH
              B::AV     ARRAY
              B::CV     CODE
              B::IO     IO
              B::GV     GLOB
              B::REGEXP REGEXP
          );
          *JSON::PP::reftype = sub {
              my $r = shift;
  
              return undef unless length(ref($r));
  
              my $t = ref(B::svref_2object($r));
  
              return
                  exists $tmap{$t} ? $tmap{$t}
                : length(ref($$r)) ? 'REF'
                :                    'SCALAR';
          };
          *JSON::PP::refaddr = sub {
            return undef unless length(ref($_[0]));
  
            my $addr;
            if(defined(my $pkg = blessed($_[0]))) {
              $addr .= bless $_[0], 'Scalar::Util::Fake';
              bless $_[0], $pkg;
            }
            else {
              $addr .= $_[0]
            }
  
            $addr =~ /0x(\w+)/;
            local $^W;
            #no warnings 'portable';
            hex($1);
          }
      }
  }
  
  
  # shamely copied and modified from JSON::XS code.
  
  $JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
  $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
  
  sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
  
  sub true  { $JSON::PP::true  }
  sub false { $JSON::PP::false }
  sub null  { undef; }
  
  ###############################
  
  package JSON::PP::Boolean;
  
  use overload (
     "0+"     => sub { ${$_[0]} },
     "++"     => sub { $_[0] = ${$_[0]} + 1 },
     "--"     => sub { $_[0] = ${$_[0]} - 1 },
     fallback => 1,
  );
  
  
  ###############################
  
  package JSON::PP::IncrParser;
  
  use strict;
  
  use constant INCR_M_WS   => 0; # initial whitespace skipping
  use constant INCR_M_STR  => 1; # inside string
  use constant INCR_M_BS   => 2; # inside backslash
  use constant INCR_M_JSON => 3; # outside anything, count nesting
  use constant INCR_M_C0   => 4;
  use constant INCR_M_C1   => 5;
  
  $JSON::PP::IncrParser::VERSION = '1.01';
  
  my $unpack_format = $] < 5.006 ? 'C*' : 'U*';
  
  sub new {
      my ( $class ) = @_;
  
      bless {
          incr_nest    => 0,
          incr_text    => undef,
          incr_parsing => 0,
          incr_p       => 0,
      }, $class;
  }
  
  
  sub incr_parse {
      my ( $self, $coder, $text ) = @_;
  
      $self->{incr_text} = '' unless ( defined $self->{incr_text} );
  
      if ( defined $text ) {
          if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
              utf8::upgrade( $self->{incr_text} ) ;
              utf8::decode( $self->{incr_text} ) ;
          }
          $self->{incr_text} .= $text;
      }
  
  
      my $max_size = $coder->get_max_size;
  
      if ( defined wantarray ) {
  
          $self->{incr_mode} = INCR_M_WS unless defined $self->{incr_mode};
  
          if ( wantarray ) {
              my @ret;
  
              $self->{incr_parsing} = 1;
  
              do {
                  push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
  
                  unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
                      $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR;
                  }
  
              } until ( length $self->{incr_text} >= $self->{incr_p} );
  
              $self->{incr_parsing} = 0;
  
              return @ret;
          }
          else { # in scalar context
              $self->{incr_parsing} = 1;
              my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
              $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans
              return $obj ? $obj : undef; # $obj is an empty string, parsing was completed.
          }
  
      }
  
  }
  
  
  sub _incr_parse {
      my ( $self, $coder, $text, $skip ) = @_;
      my $p = $self->{incr_p};
      my $restore = $p;
  
      my @obj;
      my $len = length $text;
  
      if ( $self->{incr_mode} == INCR_M_WS ) {
          while ( $len > $p ) {
              my $s = substr( $text, $p, 1 );
              $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
              $self->{incr_mode} = INCR_M_JSON;
              last;
         }
      }
  
      while ( $len > $p ) {
          my $s = substr( $text, $p++, 1 );
  
          if ( $s eq '"' ) {
              if (substr( $text, $p - 2, 1 ) eq '\\' ) {
                  next;
              }
  
              if ( $self->{incr_mode} != INCR_M_STR  ) {
                  $self->{incr_mode} = INCR_M_STR;
              }
              else {
                  $self->{incr_mode} = INCR_M_JSON;
                  unless ( $self->{incr_nest} ) {
                      last;
                  }
              }
          }
  
          if ( $self->{incr_mode} == INCR_M_JSON ) {
  
              if ( $s eq '[' or $s eq '{' ) {
                  if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
                      Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
                  }
              }
              elsif ( $s eq ']' or $s eq '}' ) {
                  last if ( --$self->{incr_nest} <= 0 );
              }
              elsif ( $s eq '#' ) {
                  while ( $len > $p ) {
                      last if substr( $text, $p++, 1 ) eq "\n";
                  }
              }
  
          }
  
      }
  
      $self->{incr_p} = $p;
  
      return if ( $self->{incr_mode} == INCR_M_STR and not $self->{incr_nest} );
      return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
  
      return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
  
      local $Carp::CarpLevel = 2;
  
      $self->{incr_p} = $restore;
      $self->{incr_c} = $p;
  
      my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
  
      $self->{incr_text} = substr( $self->{incr_text}, $p );
      $self->{incr_p} = 0;
  
      return $obj or '';
  }
  
  
  sub incr_text {
      if ( $_[0]->{incr_parsing} ) {
          Carp::croak("incr_text can not be called when the incremental parser already started parsing");
      }
      $_[0]->{incr_text};
  }
  
  
  sub incr_skip {
      my $self  = shift;
      $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
      $self->{incr_p} = 0;
  }
  
  
  sub incr_reset {
      my $self = shift;
      $self->{incr_text}    = undef;
      $self->{incr_p}       = 0;
      $self->{incr_mode}    = 0;
      $self->{incr_nest}    = 0;
      $self->{incr_parsing} = 0;
  }
  
  ###############################
  
  
  1;
  __END__
  =pod
  
JSON_PP

$fatpacked{"JSON/PP/Boolean.pm"} = <<'JSON_PP_BOOLEAN';
  use JSON::PP ();
  use strict;
  
  1;
  
JSON_PP_BOOLEAN

$fatpacked{"Module/CPANfile.pm"} = <<'MODULE_CPANFILE';
  package Module::CPANfile;
  use strict;
  use warnings;
  use Cwd;
  
  our $VERSION = '0.9007';
  
  sub new {
      my($class, $file) = @_;
      bless {}, $class;
  }
  
  sub load {
      my($proto, $file) = @_;
      my $self = ref $proto ? $proto : $proto->new;
      $self->{file} = $file || "cpanfile";
      $self->parse;
      $self;
  }
  
  sub parse {
      my $self = shift;
  
      my $file = Cwd::abs_path($self->{file});
      $self->{result} = Module::CPANfile::Environment::parse($file) or die $@;
  }
  
  sub prereqs { shift->prereq }
  
  sub prereq {
      my $self = shift;
      require CPAN::Meta::Prereqs;
      CPAN::Meta::Prereqs->new($self->prereq_specs);
  }
  
  sub prereq_specs {
      my $self = shift;
      $self->{result}{spec};
  }
  
  package Module::CPANfile::Environment;
  use strict;
  
  my @bindings = qw(
      on requires recommends suggests conflicts
      osname perl
      configure_requires build_requires test_requires author_requires
  );
  
  my $file_id = 1;
  
  sub import {
      my($class, $result_ref) = @_;
      my $pkg = caller;
  
      $$result_ref = Module::CPANfile::Result->new;
      for my $binding (@bindings) {
          no strict 'refs';
          *{"$pkg\::$binding"} = sub { $$result_ref->$binding(@_) };
      }
  }
  
  sub parse {
      my $file = shift;
  
      my $code = do {
          open my $fh, "<", $file or die "$file: $!";
          join '', <$fh>;
      };
  
      my($res, $err);
  
      {
          local $@;
          $res = eval sprintf <<EVAL, $file_id++;
  package Module::CPANfile::Sandbox%d;
  no warnings;
  my \$_result;
  BEGIN { import Module::CPANfile::Environment \\\$_result };
  
  $code;
  
  \$_result;
  EVAL
          $err = $@;
      }
  
      if ($err) { die "Parsing $file failed: $err" };
  
      return $res;
  }
  
  package Module::CPANfile::Result;
  use strict;
  
  sub new {
      bless {
          phase => 'runtime', # default phase
          spec  => {},
      }, shift;
  }
  
  sub on {
      my($self, $phase, $code) = @_;
      local $self->{phase} = $phase;
      $code->()
  }
  
  sub osname { die "TODO" }
  sub perl { die "TODO" }
  
  sub requires {
      my($self, $module, $requirement) = @_;
      $self->{spec}{$self->{phase}}{requires}{$module} = $requirement || 0;
  }
  
  sub recommends {
      my($self, $module, $requirement) = @_;
      $self->{spec}->{$self->{phase}}{recommends}{$module} = $requirement || 0;
  }
  
  sub suggests {
      my($self, $module, $requirement) = @_;
      $self->{spec}->{$self->{phase}}{suggests}{$module} = $requirement || 0;
  }
  
  sub conflicts {
      my($self, $module, $requirement) = @_;
      $self->{spec}->{$self->{phase}}{conflicts}{$module} = $requirement || 0;
  }
  
  # Module::Install compatible shortcuts
  
  sub configure_requires {
      my($self, @args) = @_;
      $self->on(configure => sub { $self->requires(@args) });
  }
  
  sub build_requires {
      my($self, @args) = @_;
      $self->on(build => sub { $self->requires(@args) });
  }
  
  sub test_requires {
      my($self, @args) = @_;
      $self->on(test => sub { $self->requires(@args) });
  }
  
  sub author_requires {
      my($self, @args) = @_;
      $self->on(develop => sub { $self->requires(@args) });
  }
  
  package Module::CPANfile;
  
  1;
  
  __END__
  
  =head1 NAME
  
  Module::CPANfile - Parse cpanfile
  
  =head1 SYNOPSIS
  
    use Module::CPANfile;
  
    my $file = Module::CPANfile->load("cpanfile");
    my $prereqs = $file->prereqs; # CPAN::Meta::Prereqs object
  
  =head1 DESCRIPTION
  
  Module::CPANfile is a tool to handle L<cpanfile> format to load application
  specific dependencies, not just for CPAN distributions.
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa
  
  =head1 SEE ALSO
  
  L<cpanfile>, L<CPAN::Meta>, L<CPAN::Meta::Spec>
  
  =cut
  
  
MODULE_CPANFILE

$fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
  # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
  # vim:ts=8:sw=2:et:sta:sts=2
  package Module::Metadata;
  
  # Adapted from Perl-licensed code originally distributed with
  # Module-Build by Ken Williams
  
  # This module provides routines to gather information about
  # perl modules (assuming this may be expanded in the distant
  # parrot future to look at other types of modules).
  
  use strict;
  use vars qw($VERSION);
  $VERSION = '1.000007';
  $VERSION = eval $VERSION;
  
  use File::Spec;
  use IO::File;
  use version 0.87;
  BEGIN {
    if ($INC{'Log/Contextual.pm'}) {
      Log::Contextual->import('log_info');
    } else {
      *log_info = sub (&) { warn $_[0]->() };
    }
  }
  use File::Find qw(find);
  
  my $V_NUM_REGEXP = qr{v?[0-9._]+};  # crudely, a v-string or decimal
  
  my $PKG_REGEXP  = qr{   # match a package declaration
    ^[\s\{;]*             # intro chars on a line
    package               # the word 'package'
    \s+                   # whitespace
    ([\w:]+)              # a package name
    \s*                   # optional whitespace
    ($V_NUM_REGEXP)?        # optional version number
    \s*                   # optional whitesapce
    [;\{]                 # semicolon line terminator or block start (since 5.16)
  }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_handle {
    my $class    = shift;
    my $handle   = shift;
    my $filename = shift;
    return undef unless defined($handle) && defined($filename);
    $filename = File::Spec->rel2abs( $filename );
  
    return $class->_init(undef, $filename, @_, handle => $handle);
  
  }
  
  
  sub new_from_module {
    my $class   = shift;
    my $module  = shift;
    my %props   = @_;
  
    $props{inc} ||= \@INC;
    my $filename = $class->find_module_by_name( $module, $props{inc} );
    return undef unless defined( $filename ) && -f $filename;
    return $class->_init($module, $filename, %props);
  }
  
  {
    
    my $compare_versions = sub {
      my ($v1, $op, $v2) = @_;
      $v1 = version->new($v1)
        unless UNIVERSAL::isa($v1,'version');
    
      my $eval_str = "\$v1 $op \$v2";
      my $result   = eval $eval_str;
      log_info { "error comparing versions: '$eval_str' $@" } if $@;
    
      return $result;
    };
  
    my $normalize_version = sub {
      my ($version) = @_;
      if ( $version =~ /[=<>!,]/ ) { # logic, not just version
        # take as is without modification
      }
      elsif ( ref $version eq 'version' ) { # version objects
        $version = $version->is_qv ? $version->normal : $version->stringify;
      }
      elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
        # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
        $version = "v$version";
      }
      else {
        # leave alone
      }
      return $version;
    };
  
    # separate out some of the conflict resolution logic
  
    my $resolve_module_versions = sub {
      my $packages = shift;
    
      my( $file, $version );
      my $err = '';
        foreach my $p ( @$packages ) {
          if ( defined( $p->{version} ) ) {
    	if ( defined( $version ) ) {
     	  if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
    	    $err .= "  $p->{file} ($p->{version})\n";
    	  } else {
    	    # same version declared multiple times, ignore
    	  }
    	} else {
    	  $file    = $p->{file};
    	  $version = $p->{version};
    	}
          }
          $file ||= $p->{file} if defined( $p->{file} );
        }
    
      if ( $err ) {
        $err = "  $file ($version)\n" . $err;
      }
    
      my %result = (
        file    => $file,
        version => $version,
        err     => $err
      );
    
      return \%result;
    };
  
    sub package_versions_from_directory {
      my ( $class, $dir, $files ) = @_;
  
      my @files;
  
      if ( $files ) {
        @files = @$files;
      } else {
        find( {
          wanted => sub {
            push @files, $_ if -f $_ && /\.pm$/;
          },
          no_chdir => 1,
        }, $dir );
      }
  
      # First, we enumerate all packages & versions,
      # separating into primary & alternative candidates
      my( %prime, %alt );
      foreach my $file (@files) {
        my $mapped_filename = File::Spec->abs2rel( $file, $dir );
        my @path = split( /\//, $mapped_filename );
        (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
    
        my $pm_info = $class->new_from_file( $file );
    
        foreach my $package ( $pm_info->packages_inside ) {
          next if $package eq 'main';  # main can appear numerous times, ignore
          next if $package eq 'DB';    # special debugging package, ignore
          next if grep /^_/, split( /::/, $package ); # private package, ignore
    
          my $version = $pm_info->version( $package );
    
          if ( $package eq $prime_package ) {
            if ( exists( $prime{$package} ) ) {
              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 $handle = delete $props{handle};
    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);
  
    if ( $handle ) {
      $self->_parse_fh($handle);
    }
    else {
      $self->_parse_file();
    }
  
    unless($self->{module} and length($self->{module})) {
      my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
      if($f =~ /\.pm$/) {
        $f =~ s/\..+$//;
        my @candidates = grep /$f$/, @{$self->{packages}};
        $self->{module} = shift(@candidates); # punt
      }
      else {
        if(grep /main/, @{$self->{packages}}) {
          $self->{module} = 'main';
        }
        else {
          $self->{module} = $self->{packages}[0] || '';
        }
      }
    }
  
    $self->{version} = $self->{versions}{$self->{module}}
        if defined( $self->{module} );
  
    return $self;
  }
  
  # class method
  sub _do_find_module {
    my $class   = shift;
    my $module  = shift || die 'find_module_by_name() requires a package name';
    my $dirs    = shift || \@INC;
  
    my $file = File::Spec->catfile(split( /::/, $module));
    foreach my $dir ( @$dirs ) {
      my $testfile = File::Spec->catfile($dir, $file);
      return [ File::Spec->rel2abs( $testfile ), $dir ]
  	if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
      return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
  	if -e "$testfile.pm";
    }
    return;
  }
  
  # class method
  sub find_module_by_name {
    my $found = shift()->_do_find_module(@_) or return;
    return $found->[0];
  }
  
  # class method
  sub find_module_dir_by_name {
    my $found = shift()->_do_find_module(@_) or return;
    return $found->[1];
  }
  
  
  # given a line of perl code, attempt to parse it if it looks like a
  # $VERSION assignment, returning sigil, full name, & package name
  sub _parse_version_expression {
    my $self = shift;
    my $line = shift;
  
    my( $sig, $var, $pkg );
    if ( $line =~ $VERS_REGEXP ) {
      ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
      if ( $pkg ) {
        $pkg = ($pkg eq '::') ? 'main' : $pkg;
        $pkg =~ s/::$//;
      }
    }
  
    return ( $sig, $var, $pkg );
  }
  
  sub _parse_file {
    my $self = shift;
  
    my $filename = $self->{filename};
    my $fh = IO::File->new( $filename )
      or die( "Can't open '$filename': $!" );
  
    $self->_parse_fh($fh);
  }
  
  sub _parse_fh {
    my ($self, $fh) = @_;
  
    my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
    my( @pkgs, %vers, %pod, @pod );
    my $pkg = 'main';
    my $pod_sect = '';
    my $pod_data = '';
  
    while (defined( my $line = <$fh> )) {
      my $line_num = $.;
  
      chomp( $line );
      next if $line =~ /^\s*#/;
  
      $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
  
      # Would be nice if we could also check $in_string or something too
      last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
  
      if ( $in_pod || $line =~ /^=cut/ ) {
  
        if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
  	push( @pod, $1 );
  	if ( $self->{collect_pod} && length( $pod_data ) ) {
            $pod{$pod_sect} = $pod_data;
            $pod_data = '';
          }
  	$pod_sect = $1;
  
  
        } elsif ( $self->{collect_pod} ) {
  	$pod_data .= "$line\n";
  
        }
  
      } else {
  
        $pod_sect = '';
        $pod_data = '';
  
        # parse $line to see if it's a $VERSION declaration
        my( $vers_sig, $vers_fullname, $vers_pkg ) =
  	  $self->_parse_version_expression( $line );
  
        if ( $line =~ $PKG_REGEXP ) {
          $pkg = $1;
          push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
          $vers{$pkg} = (defined $2 ? $2 : undef)  unless exists( $vers{$pkg} );
          $need_vers = defined $2 ? 0 : 1;
  
        # VERSION defined with full package spec, i.e. $Module::VERSION
        } elsif ( $vers_fullname && $vers_pkg ) {
  	push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
  	$need_vers = 0 if $vers_pkg eq $pkg;
  
  	unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
  	  $vers{$vers_pkg} =
  	    $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
  	} else {
  	  # Warn unless the user is using the "$VERSION = eval
  	  # $VERSION" idiom (though there are probably other idioms
  	  # that we should watch out for...)
  	  warn <<"EOM" unless $line =~ /=\s*eval/;
  Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
  ignoring subsequent declaration on line $line_num.
  EOM
  	}
  
        # first non-comment line in undeclared package main is VERSION
        } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
  	$need_vers = 0;
  	my $v =
  	  $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
  	$vers{$pkg} = $v;
  	push( @pkgs, 'main' );
  
        # first non-comment line in undeclared package defines package main
        } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
  	$need_vers = 1;
  	$vers{main} = '';
  	push( @pkgs, 'main' );
  
        # only keep if this is the first $VERSION seen
        } elsif ( $vers_fullname && $need_vers ) {
  	$need_vers = 0;
  	my $v =
  	  $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
  
  
  	unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
  	  $vers{$pkg} = $v;
  	} else {
  	  warn <<"EOM";
  Package '$pkg' already declared with version '$vers{$pkg}'
  ignoring new version '$v' on line $line_num.
  EOM
  	}
  
        }
  
      }
  
    }
  
    if ( $self->{collect_pod} && length($pod_data) ) {
      $pod{$pod_sect} = $pod_data;
    }
  
    $self->{versions} = \%vers;
    $self->{packages} = \@pkgs;
    $self->{pod} = \%pod;
    $self->{pod_headings} = \@pod;
  }
  
  {
  my $pn = 0;
  sub _evaluate_version_line {
    my $self = shift;
    my( $sigil, $var, $line ) = @_;
  
    # Some of this code came from the ExtUtils:: hierarchy.
  
    # We compile into $vsub because 'use version' would cause
    # compiletime/runtime issues with local()
    my $vsub;
    $pn++; # everybody gets their own package
    my $eval = qq{BEGIN { q#  Hide from _packages_inside()
      #; package Module::Metadata::_version::p$pn;
      use version;
      no strict;
  
        \$vsub = sub {
          local $sigil$var;
          \$$var=undef;
          $line;
          \$$var
        };
    }};
  
    local $^W;
    # Try to get the $VERSION
    eval $eval;
    # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
    # installed, so we need to hunt in ./lib for it
    if ( $@ =~ /Can't locate/ && -d 'lib' ) {
      local @INC = ('lib',@INC);
      eval $eval;
    }
    warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
      if $@;
    (ref($vsub) eq 'CODE') or
      die "failed to build version sub for $self->{filename}";
    my $result = eval { $vsub->() };
    die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
      if $@;
  
    # Upgrade it into a version object
    my $version = eval { _dwim_version($result) };
  
    die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
      unless defined $version; # "0" is OK!
  
    return $version;
  }
  }
  
  # Try to DWIM when things fail the lax version test in obvious ways
  {
    my @version_prep = (
      # Best case, it just works
      sub { return shift },
  
      # If we still don't have a version, try stripping any
      # trailing junk that is prohibited by lax rules
      sub {
        my $v = shift;
        $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
        return $v;
      },
  
      # Activestate apparently creates custom versions like '1.23_45_01', which
      # cause version.pm to think it's an invalid alpha.  So check for that
      # and strip them
      sub {
        my $v = shift;
        my $num_dots = () = $v =~ m{(\.)}g;
        my $num_unders = () = $v =~ m{(_)}g;
        my $leading_v = substr($v,0,1) eq 'v';
        if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
          $v =~ s{_}{}g;
          $num_unders = () = $v =~ m{(_)}g;
        }
        return $v;
      },
  
      # Worst case, try numifying it like we would have before version objects
      sub {
        my $v = shift;
        no warnings 'numeric';
        return 0 + $v;
      },
  
    );
  
    sub _dwim_version {
      my ($result) = shift;
  
      return $result if ref($result) eq 'version';
  
      my ($version, $error);
      for my $f (@version_prep) {
        $result = $f->($result);
        $version = eval { version->new($result) };
        $error ||= $@ if $@; # capture first failure
        last if defined $version;
      }
  
      die $error unless defined $version;
  
      return $version;
    }
  }
  
  ############################################################
  
  # accessors
  sub name            { $_[0]->{module}           }
  
  sub filename        { $_[0]->{filename}         }
  sub packages_inside { @{$_[0]->{packages}}      }
  sub pod_inside      { @{$_[0]->{pod_headings}}  }
  sub contains_pod    { $#{$_[0]->{pod_headings}} }
  
  sub version {
      my $self = shift;
      my $mod  = shift || $self->{module};
      my $vers;
      if ( defined( $mod ) && length( $mod ) &&
  	 exists( $self->{versions}{$mod} ) ) {
  	return $self->{versions}{$mod};
      } else {
  	return undef;
      }
  }
  
  sub pod {
      my $self = shift;
      my $sect = shift;
      if ( defined( $sect ) && length( $sect ) &&
  	 exists( $self->{pod}{$sect} ) ) {
  	return $self->{pod}{$sect};
      } else {
  	return undef;
      }
  }
  
  1;
  
MODULE_METADATA

$fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
  package Parse::CPAN::Meta;
  
  use strict;
  use Carp 'croak';
  
  # UTF Support?
  sub HAVE_UTF8 () { $] >= 5.007003 }
  sub IO_LAYER () { $] >= 5.008001 ? ":utf8" : "" }  
  
  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.4401';
  	@Parse::CPAN::Meta::ISA       = qw{ Exporter      };
  	@Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
  }
  
  sub load_file {
    my ($class, $filename) = @_;
  
    if ($filename =~ /\.ya?ml$/) {
      return $class->load_yaml_string(_slurp($filename));
    }
  
    if ($filename =~ /\.json$/) {
      return $class->load_json_string(_slurp($filename));
    }
  
    croak("file type cannot be determined by filename");
  }
  
  sub load_yaml_string {
    my ($class, $string) = @_;
    my $backend = $class->yaml_backend();
    my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
    if ( $@ ) { 
      croak $backend->can('errstr') ? $backend->errstr : $@
    }
    return $data || {}; # in case document was valid but empty
  }
  
  sub load_json_string {
    my ($class, $string) = @_;
    return $class->json_backend()->new->decode($string);
  }
  
  sub yaml_backend {
    local $Module::Load::Conditional::CHECK_INC_HASH = 1;
    if (! defined $ENV{PERL_YAML_BACKEND} ) {
      _can_load( 'CPAN::Meta::YAML', 0.002 )
        or croak "CPAN::Meta::YAML 0.002 is not available\n";
      return "CPAN::Meta::YAML";
    }
    else {
      my $backend = $ENV{PERL_YAML_BACKEND};
      _can_load( $backend )
        or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
      $backend->can("Load")
        or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
      return $backend;
    }
  }
  
  sub json_backend {
    local $Module::Load::Conditional::CHECK_INC_HASH = 1;
    if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
      _can_load( 'JSON::PP' => 2.27103 )
        or croak "JSON::PP 2.27103 is not available\n";
      return 'JSON::PP';
    }
    else {
      _can_load( 'JSON' => 2.5 )
        or croak  "JSON 2.5 is required for " .
                  "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
      return "JSON";
    }
  }
  
  sub _slurp {
    open my $fh, "<" . IO_LAYER, "$_[0]"
      or die "can't open $_[0] for reading: $!";
    return do { local $/; <$fh> };
  }
    
  sub _can_load {
    my ($module, $version) = @_;
    (my $file = $module) =~ s{::}{/}g;
    $file .= ".pm";
    return 1 if $INC{$file};
    return 0 if exists $INC{$file}; # prior load failed
    eval { require $file; 1 }
      or return 0;
    if ( defined $version ) {
      eval { $module->VERSION($version); 1 }
        or return 0;
    }
    return 1;
  }
  
  # Kept for backwards compatibility only
  # Create an object from a file
  sub LoadFile ($) {
    require CPAN::Meta::YAML;
    return CPAN::Meta::YAML::LoadFile(shift)
      or die CPAN::Meta::YAML->errstr;
  }
  
  # Parse a document from a string.
  sub Load ($) {
    require CPAN::Meta::YAML;
    return CPAN::Meta::YAML::Load(shift)
      or die CPAN::Meta::YAML->errstr;
  }
  
  1;
  
  __END__
  
PARSE_CPAN_META

$fatpacked{"Try/Tiny.pm"} = <<'TRY_TINY';
  package Try::Tiny;
  
  use strict;
  #use warnings;
  
  use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA);
  
  BEGIN {
  	require Exporter;
  	@ISA = qw(Exporter);
  }
  
  $VERSION = "0.09";
  
  $VERSION = eval $VERSION;
  
  @EXPORT = @EXPORT_OK = qw(try catch finally);
  
  $Carp::Internal{+__PACKAGE__}++;
  
  # Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
  # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
  # context & not a scalar one
  
  sub try (&;@) {
  	my ( $try, @code_refs ) = @_;
  
  	# we need to save this here, the eval block will be in scalar context due
  	# to $failed
  	my $wantarray = wantarray;
  
  	my ( $catch, @finally );
  
  	# find labeled blocks in the argument list.
  	# catch and finally tag the blocks by blessing a scalar reference to them.
  	foreach my $code_ref (@code_refs) {
  		next unless $code_ref;
  
  		my $ref = ref($code_ref);
  
  		if ( $ref eq 'Try::Tiny::Catch' ) {
  			$catch = ${$code_ref};
  		} elsif ( $ref eq 'Try::Tiny::Finally' ) {
  			push @finally, ${$code_ref};
  		} else {
  			use Carp;
  			confess("Unknown code ref type given '${ref}'. Check your usage & try again");
  		}
  	}
  
  	# save the value of $@ so we can set $@ back to it in the beginning of the eval
  	my $prev_error = $@;
  
  	my ( @ret, $error, $failed );
  
  	# FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
  	# not perfect, but we could provide a list of additional errors for
  	# $catch->();
  
  	{
  		# localize $@ to prevent clobbering of previous value by a successful
  		# eval.
  		local $@;
  
  		# failed will be true if the eval dies, because 1 will not be returned
  		# from the eval body
  		$failed = not eval {
  			$@ = $prev_error;
  
  			# evaluate the try block in the correct context
  			if ( $wantarray ) {
  				@ret = $try->();
  			} elsif ( defined $wantarray ) {
  				$ret[0] = $try->();
  			} else {
  				$try->();
  			};
  
  			return 1; # properly set $fail to false
  		};
  
  		# copy $@ to $error; when we leave this scope, local $@ will revert $@
  		# back to its previous value
  		$error = $@;
  	}
  
  	# set up a scope guard to invoke the finally block at the end
  	my @guards =
      map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) }
      @finally;
  
  	# at this point $failed contains a true value if the eval died, even if some
  	# destructor overwrote $@ as the eval was unwinding.
  	if ( $failed ) {
  		# if we got an error, invoke the catch block.
  		if ( $catch ) {
  			# This works like given($error), but is backwards compatible and
  			# sets $_ in the dynamic scope for the body of C<$catch>
  			for ($error) {
  				return $catch->($error);
  			}
  
  			# in case when() was used without an explicit return, the C<for>
  			# loop will be aborted and there's no useful return value
  		}
  
  		return;
  	} else {
  		# no failure, $@ is back to what it was, everything is fine
  		return $wantarray ? @ret : $ret[0];
  	}
  }
  
  sub catch (&;@) {
  	my ( $block, @rest ) = @_;
  
  	return (
  		bless(\$block, 'Try::Tiny::Catch'),
  		@rest,
  	);
  }
  
  sub finally (&;@) {
  	my ( $block, @rest ) = @_;
  
  	return (
  		bless(\$block, 'Try::Tiny::Finally'),
  		@rest,
  	);
  }
  
  {
    package # hide from PAUSE
      Try::Tiny::ScopeGuard;
  
    sub _new {
      shift;
      bless [ @_ ];
    }
  
    sub DESTROY {
      my @guts = @{ shift() };
      my $code = shift @guts;
      $code->(@guts);
    }
  }
  
  __PACKAGE__
  
  __END__
  
TRY_TINY

$fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
  package lib::core::only;
  
  use strict;
  use warnings FATAL => 'all';
  use Config;
  
  sub import {
    @INC = @Config{qw(privlibexp archlibexp)};
    return
  }
  
  1;
LIB_CORE_ONLY

$fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
  use strict;
  use warnings;
  
  package local::lib;
  
  use 5.008001; # probably works with earlier versions but I'm not supporting them
                # (patches would, of course, be welcome)
  
  use File::Spec ();
  use File::Path ();
  use Carp ();
  use Config;
  
  our $VERSION = '1.008001'; # 1.8.1
  
  our @KNOWN_FLAGS = qw(--self-contained);
  
  sub import {
    my ($class, @args) = @_;
  
    # Remember what PERL5LIB was when we started
    my $perl5lib = $ENV{PERL5LIB} || '';
  
    my %arg_store;
    for my $arg (@args) {
      # check for lethal dash first to stop processing before causing problems
      if ($arg =~ /−/) {
        die <<'DEATH';
  WHOA THERE! It looks like you've got some fancy dashes in your commandline!
  These are *not* the traditional -- dashes that software recognizes. You
  probably got these by copy-pasting from the perldoc for this module as
  rendered by a UTF8-capable formatter. This most typically happens on an OS X
  terminal, but can happen elsewhere too. Please try again after replacing the
  dashes with normal minus signs.
  DEATH
      }
      elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
        (my $flag = $arg) =~ s/--//;
        $arg_store{$flag} = 1;
      }
      elsif($arg =~ /^--/) {
        die "Unknown import argument: $arg";
      }
      else {
        # assume that what's left is a path
        $arg_store{path} = $arg;
      }
    }
  
    if($arg_store{'self-contained'}) {
      die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n";
    }
  
    $arg_store{path} = $class->resolve_path($arg_store{path});
    $class->setup_local_lib_for($arg_store{path});
  
    for (@INC) { # Untaint @INC
      next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
      m/(.*)/ and $_ = $1;
    }
  }
  
  sub pipeline;
  
  sub pipeline {
    my @methods = @_;
    my $last = pop(@methods);
    if (@methods) {
      \sub {
        my ($obj, @args) = @_;
        $obj->${pipeline @methods}(
          $obj->$last(@args)
        );
      };
    } else {
      \sub {
        shift->$last(@_);
      };
    }
  }
  
  sub _uniq {
      my %seen;
      grep { ! $seen{$_}++ } @_;
  }
  
  sub resolve_path {
    my ($class, $path) = @_;
    $class->${pipeline qw(
      resolve_relative_path
      resolve_home_path
      resolve_empty_path
    )}($path);
  }
  
  sub resolve_empty_path {
    my ($class, $path) = @_;
    if (defined $path) {
      $path;
    } else {
      '~/perl5';
    }
  }
  
  sub resolve_home_path {
    my ($class, $path) = @_;
    return $path unless ($path =~ /^~/);
    my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
    my $tried_file_homedir;
    my $homedir = do {
      if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
        $tried_file_homedir = 1;
        if (defined $user) {
          File::HomeDir->users_home($user);
        } else {
          File::HomeDir->my_home;
        }
      } else {
        if (defined $user) {
          (getpwnam $user)[7];
        } else {
          if (defined $ENV{HOME}) {
            $ENV{HOME};
          } else {
            (getpwuid $<)[7];
          }
        }
      }
    };
    unless (defined $homedir) {
      Carp::croak(
        "Couldn't resolve homedir for "
        .(defined $user ? $user : 'current user')
        .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
      );
    }
    $path =~ s/^~[^\/]*/$homedir/;
    $path;
  }
  
  sub resolve_relative_path {
    my ($class, $path) = @_;
    $path = File::Spec->rel2abs($path);
  }
  
  sub setup_local_lib_for {
    my ($class, $path) = @_;
    $path = $class->ensure_dir_structure_for($path);
    if ($0 eq '-') {
      $class->print_environment_vars_for($path);
      exit 0;
    } else {
      $class->setup_env_hash_for($path);
      @INC = _uniq(split($Config{path_sep}, $ENV{PERL5LIB}), @INC);
    }
  }
  
  sub install_base_bin_path {
    my ($class, $path) = @_;
    File::Spec->catdir($path, 'bin');
  }
  
  sub install_base_perl_path {
    my ($class, $path) = @_;
    File::Spec->catdir($path, 'lib', 'perl5');
  }
  
  sub install_base_arch_path {
    my ($class, $path) = @_;
    File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
  }
  
  sub ensure_dir_structure_for {
    my ($class, $path) = @_;
    unless (-d $path) {
      warn "Attempting to create directory ${path}\n";
    }
    File::Path::mkpath($path);
    # Need to have the path exist to make a short name for it, so
    # converting to a short name here.
    $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
  
    return $path;
  }
  
  sub INTERPOLATE_ENV () { 1 }
  sub LITERAL_ENV     () { 0 }
  
  sub guess_shelltype {
    my $shellbin = 'sh';
    if(defined $ENV{'SHELL'}) {
        my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
        $shellbin = $shell_bin_path_parts[-1];
    }
    my $shelltype = do {
        local $_ = $shellbin;
        if(/csh/) {
            'csh'
        } else {
            'bourne'
        }
    };
  
    # Both Win32 and Cygwin have $ENV{COMSPEC} set.
    if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
        my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
        $shellbin = $shell_bin_path_parts[-1];
           $shelltype = do {
                   local $_ = $shellbin;
                   if(/command\.com/) {
                           'win32'
                   } elsif(/cmd\.exe/) {
                           'win32'
                   } elsif(/4nt\.exe/) {
                           'win32'
                   } else {
                           $shelltype
                   }
           };
    }
    return $shelltype;
  }
  
  sub print_environment_vars_for {
    my ($class, $path) = @_;
    print $class->environment_vars_string_for($path);
  }
  
  sub environment_vars_string_for {
    my ($class, $path) = @_;
    my @envs = $class->build_environment_vars_for($path, LITERAL_ENV);
    my $out = '';
  
    # rather basic csh detection, goes on the assumption that something won't
    # call itself csh unless it really is. also, default to bourne in the
    # pathological situation where a user doesn't have $ENV{SHELL} defined.
    # note also that shells with funny names, like zoid, are assumed to be
    # bourne.
  
    my $shelltype = $class->guess_shelltype;
  
    while (@envs) {
      my ($name, $value) = (shift(@envs), shift(@envs));
      $value =~ s/(\\")/\\$1/g;
      $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
    }
    return $out;
  }
  
  # simple routines that take two arguments: an %ENV key and a value. return
  # strings that are suitable for passing directly to the relevant shell to set
  # said key to said value.
  sub build_bourne_env_declaration {
    my $class = shift;
    my($name, $value) = @_;
    return qq{export ${name}="${value}"\n};
  }
  
  sub build_csh_env_declaration {
    my $class = shift;
    my($name, $value) = @_;
    return qq{setenv ${name} "${value}"\n};
  }
  
  sub build_win32_env_declaration {
    my $class = shift;
    my($name, $value) = @_;
    return qq{set ${name}=${value}\n};
  }
  
  sub setup_env_hash_for {
    my ($class, $path) = @_;
    my %envs = $class->build_environment_vars_for($path, INTERPOLATE_ENV);
    @ENV{keys %envs} = values %envs;
  }
  
  sub build_environment_vars_for {
    my ($class, $path, $interpolate) = @_;
    return (
      PERL_LOCAL_LIB_ROOT => $path,
      PERL_MB_OPT => "--install_base ${path}",
      PERL_MM_OPT => "INSTALL_BASE=${path}",
      PERL5LIB => join($Config{path_sep},
                    $class->install_base_arch_path($path),
                    $class->install_base_perl_path($path),
                    (($ENV{PERL5LIB}||()) ?
                      ($interpolate == INTERPOLATE_ENV
                        ? ($ENV{PERL5LIB})
                        : (($^O ne 'MSWin32') ? '$PERL5LIB' : '%PERL5LIB%' ))
                      : ())
                  ),
      PATH => join($Config{path_sep},
                $class->install_base_bin_path($path),
                ($interpolate == INTERPOLATE_ENV
                  ? ($ENV{PATH}||())
                  : (($^O ne 'MSWin32') ? '$PATH' : '%PATH%' ))
               ),
    )
  }
  
  1;
LOCAL_LIB

$fatpacked{"parent.pm"} = <<'PARENT';
  package parent;
  use strict;
  use vars qw($VERSION);
  $VERSION = '0.225';
  
  sub import {
      my $class = shift;
  
      my $inheritor = caller(0);
  
      if ( @_ and $_[0] eq '-norequire' ) {
          shift @_;
      } else {
          for ( my @filename = @_ ) {
              if ( $_ eq $inheritor ) {
                  warn "Class '$inheritor' tried to inherit from itself\n";
              };
  
              s{::|'}{/}g;
              require "$_.pm"; # dies if the file is not found
          }
      }
  
      {
          no strict 'refs';
          push @{"$inheritor\::ISA"}, @_;
      };
  };
  
  "All your base are belong to us"
  
  __END__
  
PARENT

$fatpacked{"version.pm"} = <<'VERSION';
  #!perl -w
  package version;
  
  use 5.005_04;
  use strict;
  
  use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
  
  $VERSION = 0.88;
  
  $CLASS = 'version';
  
  #--------------------------------------------------------------------------#
  # Version regexp components
  #--------------------------------------------------------------------------#
  
  # Fraction part of a decimal version number.  This is a common part of
  # both strict and lax decimal versions
  
  my $FRACTION_PART = qr/\.[0-9]+/;
  
  # First part of either decimal or dotted-decimal strict version number.
  # Unsigned integer with no leading zeroes (except for zero itself) to
  # avoid confusion with octal.
  
  my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
  
  # First part of either decimal or dotted-decimal lax version number.
  # Unsigned integer, but allowing leading zeros.  Always interpreted
  # as decimal.  However, some forms of the resulting syntax give odd
  # results if used as ordinary Perl expressions, due to how perl treats
  # octals.  E.g.
  #   version->new("010" ) == 10
  #   version->new( 010  ) == 8
  #   version->new( 010.2) == 82  # "8" . "2"
  
  my $LAX_INTEGER_PART = qr/[0-9]+/;
  
  # Second and subsequent part of a strict dotted-decimal version number.
  # Leading zeroes are permitted, and the number is always decimal.
  # Limited to three digits to avoid overflow when converting to decimal
  # form and also avoid problematic style with excessive leading zeroes.
  
  my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
  
  # Second and subsequent part of a lax dotted-decimal version number.
  # Leading zeroes are permitted, and the number is always decimal.  No
  # limit on the numerical value or number of digits, so there is the
  # possibility of overflow when converting to decimal form.
  
  my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
  
  # Alpha suffix part of lax version number syntax.  Acts like a
  # dotted-decimal part.
  
  my $LAX_ALPHA_PART = qr/_[0-9]+/;
  
  #--------------------------------------------------------------------------#
  # Strict version regexp definitions
  #--------------------------------------------------------------------------#
  
  # Strict decimal version number.
  
  my $STRICT_DECIMAL_VERSION =
      qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
  
  # Strict dotted-decimal version number.  Must have both leading "v" and
  # at least three parts, to avoid confusion with decimal syntax.
  
  my $STRICT_DOTTED_DECIMAL_VERSION =
      qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
  
  # Complete strict version number syntax -- should generally be used
  # anchored: qr/ \A $STRICT \z /x
  
  $STRICT =
      qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
  
  #--------------------------------------------------------------------------#
  # Lax version regexp definitions
  #--------------------------------------------------------------------------#
  
  # Lax decimal version number.  Just like the strict one except for
  # allowing an alpha suffix or allowing a leading or trailing
  # decimal-point
  
  my $LAX_DECIMAL_VERSION =
      qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
  	|
  	$FRACTION_PART $LAX_ALPHA_PART?
      /x;
  
  # Lax dotted-decimal version number.  Distinguished by having either
  # leading "v" or at least three non-alpha parts.  Alpha part is only
  # permitted if there are at least two non-alpha parts. Strangely
  # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
  # so when there is no "v", the leading part is optional
  
  my $LAX_DOTTED_DECIMAL_VERSION =
      qr/
  	v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
  	|
  	$LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
      /x;
  
  # Complete lax version number syntax -- should generally be used
  # anchored: qr/ \A $LAX \z /x
  #
  # The string 'undef' is a special case to make for easier handling
  # of return values from ExtUtils::MM->parse_version
  
  $LAX =
      qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
  
  #--------------------------------------------------------------------------#
  
  eval "use version::vxs $VERSION";
  if ( $@ ) { # don't have the XS version installed
      eval "use version::vpp $VERSION"; # don't tempt fate
      die "$@" if ( $@ );
      push @ISA, "version::vpp";
      local $^W;
      *version::qv = \&version::vpp::qv;
      *version::declare = \&version::vpp::declare;
      *version::_VERSION = \&version::vpp::_VERSION;
      if ($] >= 5.009000 && $] < 5.011004) {
  	no strict 'refs';
  	*version::stringify = \&version::vpp::stringify;
  	*{'version::(""'} = \&version::vpp::stringify;
  	*version::new = \&version::vpp::new;
  	*version::parse = \&version::vpp::parse;
      }
  }
  else { # use XS module
      push @ISA, "version::vxs";
      local $^W;
      *version::declare = \&version::vxs::declare;
      *version::qv = \&version::vxs::qv;
      *version::_VERSION = \&version::vxs::_VERSION;
      *version::vcmp = \&version::vxs::VCMP;
      if ($] >= 5.009000 && $] < 5.011004) {
  	no strict 'refs';
  	*version::stringify = \&version::vxs::stringify;
  	*{'version::(""'} = \&version::vxs::stringify;
  	*version::new = \&version::vxs::new;
  	*version::parse = \&version::vxs::parse;
      }
  
  }
  
  # Preloaded methods go here.
  sub import {
      no strict 'refs';
      my ($class) = shift;
  
      # Set up any derived class
      unless ($class eq 'version') {
  	local $^W;
  	*{$class.'::declare'} =  \&version::declare;
  	*{$class.'::qv'} = \&version::qv;
      }
  
      my %args;
      if (@_) { # any remaining terms are arguments
  	map { $args{$_} = 1 } @_
      }
      else { # no parameters at all on use line
      	%args = 
  	(
  	    qv => 1,
  	    'UNIVERSAL::VERSION' => 1,
  	);
      }
  
      my $callpkg = caller();
      
      if (exists($args{declare})) {
  	*{$callpkg.'::declare'} = 
  	    sub {return $class->declare(shift) }
  	  unless defined(&{$callpkg.'::declare'});
      }
  
      if (exists($args{qv})) {
  	*{$callpkg.'::qv'} =
  	    sub {return $class->qv(shift) }
  	  unless defined(&{$callpkg.'::qv'});
      }
  
      if (exists($args{'UNIVERSAL::VERSION'})) {
  	local $^W;
  	*UNIVERSAL::VERSION 
  		= \&version::_VERSION;
      }
  
      if (exists($args{'VERSION'})) {
  	*{$callpkg.'::VERSION'} = \&version::_VERSION;
      }
  
      if (exists($args{'is_strict'})) {
  	*{$callpkg.'::is_strict'} = \&version::is_strict
  	  unless defined(&{$callpkg.'::is_strict'});
      }
  
      if (exists($args{'is_lax'})) {
  	*{$callpkg.'::is_lax'} = \&version::is_lax
  	  unless defined(&{$callpkg.'::is_lax'});
      }
  }
  
  sub is_strict	{ defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
  sub is_lax	{ defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
  
  1;
VERSION

$fatpacked{"Version/Requirements.pm"} = <<'VERSION_REQUIREMENTS';
  use strict;
  use warnings;
  package Version::Requirements;
  BEGIN {
    $Version::Requirements::VERSION = '0.101020';
  }
  # ABSTRACT: a set of version requirements for a CPAN dist
  
  
  use Carp ();
  use Scalar::Util ();
  use version 0.77 (); # the ->parse method
  
  
  sub new {
    my ($class) = @_;
    return bless {} => $class;
  }
  
  sub _version_object {
    my ($self, $version) = @_;
  
    $version = (! defined $version)                ? version->parse(0)
             : (! Scalar::Util::blessed($version)) ? version->parse($version)
             :                                       $version;
  
    return $version;
  }
  
  
  BEGIN {
    for my $type (qw(minimum maximum exclusion exact_version)) {
      my $method = "with_$type";
      my $to_add = $type eq 'exact_version' ? $type : "add_$type";
  
      my $code = sub {
        my ($self, $name, $version) = @_;
  
        $version = $self->_version_object( $version );
  
        $self->__modify_entry_for($name, $method, $version);
  
        return $self;
      };
      
      no strict 'refs';
      *$to_add = $code;
    }
  }
  
  
  sub add_requirements {
    my ($self, $req) = @_;
  
    for my $module ($req->required_modules) {
      my $modifiers = $req->__entry_for($module)->as_modifiers;
      for my $modifier (@$modifiers) {
        my ($method, @args) = @$modifier;
        $self->$method($module => @args);
      };
    }
  
    return $self;
  }
  
  
  sub accepts_module {
    my ($self, $module, $version) = @_;
  
    $version = $self->_version_object( $version );
  
    return 1 unless my $range = $self->__entry_for($module);
    return $range->_accepts($version);
  }
  
  
  sub clear_requirement {
    my ($self, $module) = @_;
  
    return $self unless $self->__entry_for($module);
  
    Carp::confess("can't clear requirements on finalized requirements")
      if $self->is_finalized;
  
    delete $self->{requirements}{ $module };
  
    return $self;
  }
  
  
  sub required_modules { keys %{ $_[0]{requirements} } }
  
  
  sub clone {
    my ($self) = @_;
    my $new = (ref $self)->new;
  
    return $new->add_requirements($self);
  }
  
  sub __entry_for     { $_[0]{requirements}{ $_[1] } }
  
  sub __modify_entry_for {
    my ($self, $name, $method, $version) = @_;
  
    my $fin = $self->is_finalized;
    my $old = $self->__entry_for($name);
  
    Carp::confess("can't add new requirements to finalized requirements")
      if $fin and not $old;
  
    my $new = ($old || 'Version::Requirements::_Range::Range')
            ->$method($version);
  
    Carp::confess("can't modify finalized requirements")
      if $fin and $old->as_string ne $new->as_string;
  
    $self->{requirements}{ $name } = $new;
  }
  
  
  sub is_simple {
    my ($self) = @_;
    for my $module ($self->required_modules) {
      # XXX: This is a complete hack, but also entirely correct.
      return if $self->__entry_for($module)->as_string =~ /\s/;
    }
  
    return 1;
  }
  
  
  sub is_finalized { $_[0]{finalized} }
  
  
  sub finalize { $_[0]{finalized} = 1 }
  
  
  sub as_string_hash {
    my ($self) = @_;
  
    my %hash = map {; $_ => $self->{requirements}{$_}->as_string }
               $self->required_modules;
  
    return \%hash;
  }
  
  
  my %methods_for_op = (
    '==' => [ qw(exact_version) ],
    '!=' => [ qw(add_exclusion) ],
    '>=' => [ qw(add_minimum)   ],
    '<=' => [ qw(add_maximum)   ],
    '>'  => [ qw(add_minimum add_exclusion) ],
    '<'  => [ qw(add_maximum add_exclusion) ],
  );
  
  sub from_string_hash {
    my ($class, $hash) = @_;
  
    my $self = $class->new;
  
    for my $module (keys %$hash) {
      my @parts = split qr{\s*,\s*}, $hash->{ $module };
      for my $part (@parts) {
        my ($op, $ver) = split /\s+/, $part, 2;
  
        if (! defined $ver) {
          $self->add_minimum($module => $op);
        } else {
          Carp::confess("illegal requirement string: $hash->{ $module }")
            unless my $methods = $methods_for_op{ $op };
  
          $self->$_($module => $ver) for @$methods;
        }
      }
    }
  
    return $self;
  }
  
  ##############################################################
  
  {
    package
      Version::Requirements::_Range::Exact;
  BEGIN {
    $Version::Requirements::_Range::Exact::VERSION = '0.101020';
  }
    sub _new     { bless { version => $_[1] } => $_[0] }
  
    sub _accepts { return $_[0]{version} == $_[1] }
  
    sub as_string { return "== $_[0]{version}" }
  
    sub as_modifiers { return [ [ exact_version => $_[0]{version} ] ] }
  
    sub _clone {
      (ref $_[0])->_new( version->new( $_[0]{version} ) )
    }
  
    sub with_exact_version {
      my ($self, $version) = @_;
  
      return $self->_clone if $self->_accepts($version);
  
      Carp::confess("illegal requirements: unequal exact version specified");
    }
  
    sub with_minimum {
      my ($self, $minimum) = @_;
      return $self->_clone if $self->{version} >= $minimum;
      Carp::confess("illegal requirements: minimum above exact specification");
    }
  
    sub with_maximum {
      my ($self, $maximum) = @_;
      return $self->_clone if $self->{version} <= $maximum;
      Carp::confess("illegal requirements: maximum below exact specification");
    }
  
    sub with_exclusion {
      my ($self, $exclusion) = @_;
      return $self->_clone unless $exclusion == $self->{version};
      Carp::confess("illegal requirements: excluded exact specification");
    }
  }
  
  ##############################################################
  
  {
    package
      Version::Requirements::_Range::Range;
  BEGIN {
    $Version::Requirements::_Range::Range::VERSION = '0.101020';
  }
  
    sub _self { ref($_[0]) ? $_[0] : (bless { } => $_[0]) }
  
    sub _clone {
      return (bless { } => $_[0]) unless ref $_[0];
  
      my ($s) = @_;
      my %guts = (
        (exists $s->{minimum} ? (minimum => version->new($s->{minimum})) : ()),
        (exists $s->{maximum} ? (maximum => version->new($s->{maximum})) : ()),
  
        (exists $s->{exclusions}
          ? (exclusions => [ map { version->new($_) } @{ $s->{exclusions} } ])
          : ()),
      );
  
      bless \%guts => ref($s);
    }
  
    sub as_modifiers {
      my ($self) = @_;
      my @mods;
      push @mods, [ add_minimum => $self->{minimum} ] if exists $self->{minimum};
      push @mods, [ add_maximum => $self->{maximum} ] if exists $self->{maximum};
      push @mods, map {; [ add_exclusion => $_ ] } @{$self->{exclusions} || []};
      return \@mods;
    }
  
    sub as_string {
      my ($self) = @_;
  
      return 0 if ! keys %$self;
  
      return "$self->{minimum}" if (keys %$self) == 1 and exists $self->{minimum};
  
      my @exclusions = @{ $self->{exclusions} || [] };
  
      my @parts;
  
      for my $pair (
        [ qw( >= > minimum ) ],
        [ qw( <= < maximum ) ],
      ) {
        my ($op, $e_op, $k) = @$pair;
        if (exists $self->{$k}) {
          my @new_exclusions = grep { $_ != $self->{ $k } } @exclusions;
          if (@new_exclusions == @exclusions) {
            push @parts, "$op $self->{ $k }";
          } else {
            push @parts, "$e_op $self->{ $k }";
            @exclusions = @new_exclusions;
          }
        }
      }
  
      push @parts, map {; "!= $_" } @exclusions;
  
      return join q{, }, @parts;
    }
  
    sub with_exact_version {
      my ($self, $version) = @_;
      $self = $self->_clone;
  
      Carp::confess("illegal requirements: exact specification outside of range")
        unless $self->_accepts($version);
  
      return Version::Requirements::_Range::Exact->_new($version);
    }
  
    sub _simplify {
      my ($self) = @_;
  
      if (defined $self->{minimum} and defined $self->{maximum}) {
        if ($self->{minimum} == $self->{maximum}) {
          Carp::confess("illegal requirements: excluded all values")
            if grep { $_ == $self->{minimum} } @{ $self->{exclusions} || [] };
  
          return Version::Requirements::_Range::Exact->_new($self->{minimum})
        }
  
        Carp::confess("illegal requirements: minimum exceeds maximum")
          if $self->{minimum} > $self->{maximum};
      }
  
      # eliminate irrelevant exclusions
      if ($self->{exclusions}) {
        my %seen;
        @{ $self->{exclusions} } = grep {
          (! defined $self->{minimum} or $_ >= $self->{minimum})
          and
          (! defined $self->{maximum} or $_ <= $self->{maximum})
          and
          ! $seen{$_}++
        } @{ $self->{exclusions} };
      }
  
      return $self;
    }
  
    sub with_minimum {
      my ($self, $minimum) = @_;
      $self = $self->_clone;
  
      if (defined (my $old_min = $self->{minimum})) {
        $self->{minimum} = (sort { $b cmp $a } ($minimum, $old_min))[0];
      } else {
        $self->{minimum} = $minimum;
      }
  
      return $self->_simplify;
    }
  
    sub with_maximum {
      my ($self, $maximum) = @_;
      $self = $self->_clone;
  
      if (defined (my $old_max = $self->{maximum})) {
        $self->{maximum} = (sort { $a cmp $b } ($maximum, $old_max))[0];
      } else {
        $self->{maximum} = $maximum;
      }
  
      return $self->_simplify;
    }
  
    sub with_exclusion {
      my ($self, $exclusion) = @_;
      $self = $self->_clone;
  
      push @{ $self->{exclusions} ||= [] }, $exclusion;
  
      return $self->_simplify;
    }
  
    sub _accepts {
      my ($self, $version) = @_;
  
      return if defined $self->{minimum} and $version < $self->{minimum};
      return if defined $self->{maximum} and $version > $self->{maximum};
      return if defined $self->{exclusions}
            and grep { $version == $_ } @{ $self->{exclusions} };
  
      return 1;
    }
  }
  
  1;
  
  __END__
  =pod
  
VERSION_REQUIREMENTS

$fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
  package charstar;
  # a little helper class to emulate C char* semantics in Perl
  # so that prescan_version can use the same code as in C
  
  use overload (
      '""'	=> \&thischar,
      '0+'	=> \&thischar,
      '++'	=> \&increment,
      '--'	=> \&decrement,
      '+'		=> \&plus,
      '-'		=> \&minus,
      '*'		=> \&multiply,
      'cmp'	=> \&cmp,
      '<=>'	=> \&spaceship,
      'bool'	=> \&thischar,
      '='		=> \&clone,
  );
  
  sub new {
      my ($self, $string) = @_;
      my $class = ref($self) || $self;
  
      my $obj = {
  	string  => [split(//,$string)],
  	current => 0,
      };
      return bless $obj, $class;
  }
  
  sub thischar {
      my ($self) = @_;
      my $last = $#{$self->{string}};
      my $curr = $self->{current};
      if ($curr >= 0 && $curr <= $last) {
  	return $self->{string}->[$curr];
      }
      else {
  	return '';
      }
  }
  
  sub increment {
      my ($self) = @_;
      $self->{current}++;
  }
  
  sub decrement {
      my ($self) = @_;
      $self->{current}--;
  }
  
  sub plus {
      my ($self, $offset) = @_;
      my $rself = $self->clone;
      $rself->{current} += $offset;
      return $rself;
  }
  
  sub minus {
      my ($self, $offset) = @_;
      my $rself = $self->clone;
      $rself->{current} -= $offset;
      return $rself;
  }
  
  sub multiply {
      my ($left, $right, $swapped) = @_;
      my $char = $left->thischar();
      return $char * $right;
  }
  
  sub spaceship {
      my ($left, $right, $swapped) = @_;
      unless (ref($right)) { # not an object already
  	$right = $left->new($right);
      }
      return $left->{current} <=> $right->{current};
  }
  
  sub cmp {
      my ($left, $right, $swapped) = @_;
      unless (ref($right)) { # not an object already
  	if (length($right) == 1) { # comparing single character only
  	    return $left->thischar cmp $right;
  	}
  	$right = $left->new($right);
      }
      return $left->currstr cmp $right->currstr;
  }
  
  sub bool {
      my ($self) = @_;
      my $char = $self->thischar;
      return ($char ne '');
  }
  
  sub clone {
      my ($left, $right, $swapped) = @_;
      $right = {
  	string  => [@{$left->{string}}],
  	current => $left->{current},
      };
      return bless $right, ref($left);
  }
  
  sub currstr {
      my ($self, $s) = @_;
      my $curr = $self->{current};
      my $last = $#{$self->{string}};
      if (defined($s) && $s->{current} < $last) {
  	$last = $s->{current};
      }
  
      my $string = join('', @{$self->{string}}[$curr..$last]);
      return $string;
  }
  
  package version::vpp;
  use strict;
  
  use POSIX qw/locale_h/;
  use locale;
  use vars qw ($VERSION @ISA @REGEXS);
  $VERSION = 0.88;
  
  use overload (
      '""'       => \&stringify,
      '0+'       => \&numify,
      'cmp'      => \&vcmp,
      '<=>'      => \&vcmp,
      'bool'     => \&vbool,
      'nomethod' => \&vnoop,
  );
  
  eval "use warnings";
  if ($@) {
      eval '
  	package warnings;
  	sub enabled {return $^W;}
  	1;
      ';
  }
  
  my $VERSION_MAX = 0x7FFFFFFF;
  
  # implement prescan_version as closely to the C version as possible
  use constant TRUE  => 1;
  use constant FALSE => 0;
  
  sub isDIGIT {
      my ($char) = shift->thischar();
      return ($char =~ /\d/);
  }
  
  sub isALPHA {
      my ($char) = shift->thischar();
      return ($char =~ /[a-zA-Z]/);
  }
  
  sub isSPACE {
      my ($char) = shift->thischar();
      return ($char =~ /\s/);
  }
  
  sub BADVERSION {
      my ($s, $errstr, $error) = @_;
      if ($errstr) {
  	$$errstr = $error;
      }
      return $s;
  }
  
  sub prescan_version {
      my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_;
      my $qv          = defined $sqv          ? $$sqv          : FALSE;
      my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0;
      my $width       = defined $swidth       ? $$swidth       : 3;
      my $alpha       = defined $salpha       ? $$salpha       : FALSE;
  
      my $d = $s;
  
      if ($qv && isDIGIT($d)) {
  	goto dotted_decimal_version;
      }
  
      if ($d eq 'v') { # explicit v-string
  	$d++;
  	if (isDIGIT($d)) {
  	    $qv = TRUE;
  	}
  	else { # degenerate v-string
  	    # requires v1.2.3
  	    return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
  	}
  
  dotted_decimal_version:
  	if ($strict && $d eq '0' && isDIGIT($d+1)) {
  	    # no leading zeros allowed
  	    return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
  	}
  
  	while (isDIGIT($d)) { 	# integer part
  	    $d++;
  	}
  
  	if ($d eq '.')
  	{
  	    $saw_decimal++;
  	    $d++; 		# decimal point
  	}
  	else
  	{
  	    if ($strict) {
  		# require v1.2.3
  		return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
  	    }
  	    else {
  		goto version_prescan_finish;
  	    }
  	}
  
  	{
  	    my $i = 0;
  	    my $j = 0;
  	    while (isDIGIT($d)) {	# just keep reading
  		$i++;
  		while (isDIGIT($d)) {
  		    $d++; $j++;
  		    # maximum 3 digits between decimal
  		    if ($strict && $j > 3) {
  			return BADVERSION($s,$errstr,"Invalid version format (maximum 3 digits between decimals)");
  		    }
  		}
  		if ($d eq '_') {
  		    if ($strict) {
  			return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
  		    }
  		    if ( $alpha ) {
  			return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
  		    }
  		    $d++;
  		    $alpha = TRUE;
  		}
  		elsif ($d eq '.') {
  		    if ($alpha) {
  			return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
  		    }
  		    $saw_decimal++;
  		    $d++;
  		}
  		elsif (!isDIGIT($d)) {
  		    last;
  		}
  		$j = 0;
  	    }
  	
  	    if ($strict && $i < 2) {
  		# requires v1.2.3
  		return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
  	    }
  	}
      } 					# end if dotted-decimal
      else
      {					# decimal versions
  	# special $strict case for leading '.' or '0'
  	if ($strict) {
  	    if ($d eq '.') {
  		return BADVERSION($s,$errstr,"Invalid version format (0 before decimal required)");
  	    }
  	    if ($d eq '0' && isDIGIT($d+1)) {
  		return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
  	    }
  	}
  
  	# consume all of the integer part
  	while (isDIGIT($d)) {
  	    $d++;
  	}
  
  	# look for a fractional part
  	if ($d eq '.') {
  	    # we found it, so consume it
  	    $saw_decimal++;
  	    $d++;
  	}
  	elsif (!$d || $d eq ';' || isSPACE($d) || $d eq '}') {
  	    if ( $d == $s ) {
  		# found nothing
  		return BADVERSION($s,$errstr,"Invalid version format (version required)");
  	    }
  	    # found just an integer
  	    goto version_prescan_finish;
  	}
  	elsif ( $d == $s ) {
  	    # didn't find either integer or period
  	    return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
  	}
  	elsif ($d eq '_') {
  	    # underscore can't come after integer part
  	    if ($strict) {
  		return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
  	    }
  	    elsif (isDIGIT($d+1)) {
  		return BADVERSION($s,$errstr,"Invalid version format (alpha without decimal)");
  	    }
  	    else {
  		return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
  	    }
  	}
  	elsif ($d) {
  	    # anything else after integer part is just invalid data
  	    return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
  	}
  
  	# scan the fractional part after the decimal point
  	if ($d && !isDIGIT($d) && ($strict || ! ($d eq ';' || isSPACE($d) || $d eq '}') )) {
  		# $strict or lax-but-not-the-end
  		return BADVERSION($s,$errstr,"Invalid version format (fractional part required)");
  	}
  
  	while (isDIGIT($d)) {
  	    $d++;
  	    if ($d eq '.' && isDIGIT($d-1)) {
  		if ($alpha) {
  		    return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
  		}
  		if ($strict) {
  		    return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
  		}
  		$d = $s; # start all over again
  		$qv = TRUE;
  		goto dotted_decimal_version;
  	    }
  	    if ($d eq '_') {
  		if ($strict) {
  		    return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
  		}
  		if ( $alpha ) {
  		    return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
  		}
  		if ( ! isDIGIT($d+1) ) {
  		    return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
  		}
  		$d++;
  		$alpha = TRUE;
  	    }
  	}
      }
  
  version_prescan_finish:
      while (isSPACE($d)) {
  	$d++;
      }
  
      if ($d && !isDIGIT($d) && (! ($d eq ';' || $d eq '}') )) {
  	# trailing non-numeric data
  	return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
      }
  
      if (defined $sqv) {
  	$$sqv = $qv;
      }
      if (defined $swidth) {
  	$$swidth = $width;
      }
      if (defined $ssaw_decimal) {
  	$$ssaw_decimal = $saw_decimal;
      }
      if (defined $salpha) {
  	$$salpha = $alpha;
      }
      return $d;
  }
  
  sub scan_version {
      my ($s, $rv, $qv) = @_;
      my $start;
      my $pos;
      my $last;
      my $errstr;
      my $saw_decimal = 0;
      my $width = 3;
      my $alpha = FALSE;
      my $vinf = FALSE;
      my @av;
  
      $s = new charstar $s;
  
      while (isSPACE($s)) { # leading whitespace is OK
  	$s++;
      }
  
      $last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal,
  	\$width, \$alpha);
  
      if ($errstr) {
  	# 'undef' is a special case and not an error
  	if ( $s ne 'undef') {
  	    use Carp;
  	    Carp::croak($errstr);
  	}
      }
  
      $start = $s;
      if ($s eq 'v') {
  	$s++;
      }
      $pos = $s;
  
      if ( $qv ) {
  	$$rv->{qv} = $qv;
      }
      if ( $alpha ) {
  	$$rv->{alpha} = $alpha;
      }
      if ( !$qv && $width < 3 ) {
  	$$rv->{width} = $width;
      }
      
      while (isDIGIT($pos)) {
  	$pos++;
      }
      if (!isALPHA($pos)) {
  	my $rev;
  
  	for (;;) {
  	    $rev = 0;
  	    {
    		# this is atoi() that delimits on underscores
    		my $end = $pos;
    		my $mult = 1;
  		my $orev;
  
  		#  the following if() will only be true after the decimal
  		#  point of a version originally created with a bare
  		#  floating point number, i.e. not quoted in any way
  		#
   		if ( !$qv && $s > $start && $saw_decimal == 1 ) {
  		    $mult *= 100;
   		    while ( $s < $end ) {
  			$orev = $rev;
   			$rev += $s * $mult;
   			$mult /= 10;
  			if (   (abs($orev) > abs($rev)) 
  			    || (abs($rev) > $VERSION_MAX )) {
  			    warn("Integer overflow in version %d",
  					   $VERSION_MAX);
  			    $s = $end - 1;
  			    $rev = $VERSION_MAX;
  			    $vinf = 1;
  			}
   			$s++;
  			if ( $s eq '_' ) {
  			    $s++;
  			}
   		    }
    		}
   		else {
   		    while (--$end >= $s) {
  			$orev = $rev;
   			$rev += $end * $mult;
   			$mult *= 10;
  			if (   (abs($orev) > abs($rev)) 
  			    || (abs($rev) > $VERSION_MAX )) {
  			    warn("Integer overflow in version");
  			    $end = $s - 1;
  			    $rev = $VERSION_MAX;
  			    $vinf = 1;
  			}
   		    }
   		} 
    	    }
  
    	    # Append revision
  	    push @av, $rev;
  	    if ( $vinf ) {
  		$s = $last;
  		last;
  	    }
  	    elsif ( $pos eq '.' ) {
  		$s = ++$pos;
  	    }
  	    elsif ( $pos eq '_' && isDIGIT($pos+1) ) {
  		$s = ++$pos;
  	    }
  	    elsif ( $pos eq ',' && isDIGIT($pos+1) ) {
  		$s = ++$pos;
  	    }
  	    elsif ( isDIGIT($pos) ) {
  		$s = $pos;
  	    }
  	    else {
  		$s = $pos;
  		last;
  	    }
  	    if ( $qv ) {
  		while ( isDIGIT($pos) ) {
  		    $pos++;
  		}
  	    }
  	    else {
  		my $digits = 0;
  		while ( ( isDIGIT($pos) || $pos eq '_' ) && $digits < 3 ) {
  		    if ( $pos ne '_' ) {
  			$digits++;
  		    }
  		    $pos++;
  		}
  	    }
  	}
      }
      if ( $qv ) { # quoted versions always get at least three terms
  	my $len = $#av;
  	#  This for loop appears to trigger a compiler bug on OS X, as it
  	#  loops infinitely. Yes, len is negative. No, it makes no sense.
  	#  Compiler in question is:
  	#  gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
  	#  for ( len = 2 - len; len > 0; len-- )
  	#  av_push(MUTABLE_AV(sv), newSViv(0));
  	# 
  	$len = 2 - $len;
  	while ($len-- > 0) {
  	    push @av, 0;
  	}
      }
  
      # need to save off the current version string for later
      if ( $vinf ) {
  	$$rv->{original} = "v.Inf";
  	$$rv->{vinf} = 1;
      }
      elsif ( $s > $start ) {
  	$$rv->{original} = $start->currstr($s);
  	if ( $qv && $saw_decimal == 1 && $start ne 'v' ) {
  	    # need to insert a v to be consistent
  	    $$rv->{original} = 'v' . $$rv->{original};
  	}
      }
      else {
  	$$rv->{original} = '0';
  	push(@av, 0);
      }
  
      # And finally, store the AV in the hash
      $$rv->{version} = \@av;
  
      # fix RT#19517 - special case 'undef' as string
      if ($s eq 'undef') {
  	$s += 5;
      }
  
      return $s;
  }
  
  sub new
  {
  	my ($class, $value) = @_;
  	my $self = bless ({}, ref ($class) || $class);
  	my $qv = FALSE;
  	
  	if ( ref($value) && eval('$value->isa("version")') ) {
  	    # Can copy the elements directly
  	    $self->{version} = [ @{$value->{version} } ];
  	    $self->{qv} = 1 if $value->{qv};
  	    $self->{alpha} = 1 if $value->{alpha};
  	    $self->{original} = ''.$value->{original};
  	    return $self;
  	}
  
  	my $currlocale = setlocale(LC_ALL);
  
  	# if the current locale uses commas for decimal points, we
  	# just replace commas with decimal places, rather than changing
  	# locales
  	if ( localeconv()->{decimal_point} eq ',' ) {
  	    $value =~ tr/,/./;
  	}
  
  	if ( not defined $value or $value =~ /^undef$/ ) {
  	    # RT #19517 - special case for undef comparison
  	    # or someone forgot to pass a value
  	    push @{$self->{version}}, 0;
  	    $self->{original} = "0";
  	    return ($self);
  	}
  
  	if ( $#_ == 2 ) { # must be CVS-style
  	    $value = $_[2];
  	    $qv = TRUE;
  	}
  
  	$value = _un_vstring($value);
  
  	# exponential notation
  	if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
  	    $value = sprintf("%.9f",$value);
  	    $value =~ s/(0+)$//; # trim trailing zeros
  	}
  	
  	my $s = scan_version($value, \$self, $qv);
  
  	if ($s) { # must be something left over
  	    warn("Version string '%s' contains invalid data; "
                         ."ignoring: '%s'", $value, $s);
  	}
  
  	return ($self);
  }
  
  *parse = \&new;
  
  sub numify 
  {
      my ($self) = @_;
      unless (_verify($self)) {
  	require Carp;
  	Carp::croak("Invalid version object");
      }
      my $width = $self->{width} || 3;
      my $alpha = $self->{alpha} || "";
      my $len = $#{$self->{version}};
      my $digit = $self->{version}[0];
      my $string = sprintf("%d.", $digit );
  
      for ( my $i = 1 ; $i < $len ; $i++ ) {
  	$digit = $self->{version}[$i];
  	if ( $width < 3 ) {
  	    my $denom = 10**(3-$width);
  	    my $quot = int($digit/$denom);
  	    my $rem = $digit - ($quot * $denom);
  	    $string .= sprintf("%0".$width."d_%d", $quot, $rem);
  	}
  	else {
  	    $string .= sprintf("%03d", $digit);
  	}
      }
  
      if ( $len > 0 ) {
  	$digit = $self->{version}[$len];
  	if ( $alpha && $width == 3 ) {
  	    $string .= "_";
  	}
  	$string .= sprintf("%0".$width."d", $digit);
      }
      else # $len = 0
      {
  	$string .= sprintf("000");
      }
  
      return $string;
  }
  
  sub normal 
  {
      my ($self) = @_;
      unless (_verify($self)) {
  	require Carp;
  	Carp::croak("Invalid version object");
      }
      my $alpha = $self->{alpha} || "";
      my $len = $#{$self->{version}};
      my $digit = $self->{version}[0];
      my $string = sprintf("v%d", $digit );
  
      for ( my $i = 1 ; $i < $len ; $i++ ) {
  	$digit = $self->{version}[$i];
  	$string .= sprintf(".%d", $digit);
      }
  
      if ( $len > 0 ) {
  	$digit = $self->{version}[$len];
  	if ( $alpha ) {
  	    $string .= sprintf("_%0d", $digit);
  	}
  	else {
  	    $string .= sprintf(".%0d", $digit);
  	}
      }
  
      if ( $len <= 2 ) {
  	for ( $len = 2 - $len; $len != 0; $len-- ) {
  	    $string .= sprintf(".%0d", 0);
  	}
      }
  
      return $string;
  }
  
  sub stringify
  {
      my ($self) = @_;
      unless (_verify($self)) {
  	require Carp;
  	Carp::croak("Invalid version object");
      }
      return exists $self->{original} 
      	? $self->{original} 
  	: exists $self->{qv} 
  	    ? $self->normal
  	    : $self->numify;
  }
  
  sub vcmp
  {
      require UNIVERSAL;
      my ($left,$right,$swap) = @_;
      my $class = ref($left);
      unless ( UNIVERSAL::isa($right, $class) ) {
  	$right = $class->new($right);
      }
  
      if ( $swap ) {
  	($left, $right) = ($right, $left);
      }
      unless (_verify($left)) {
  	require Carp;
  	Carp::croak("Invalid version object");
      }
      unless (_verify($right)) {
  	require Carp;
  	Carp::croak("Invalid version object");
      }
      my $l = $#{$left->{version}};
      my $r = $#{$right->{version}};
      my $m = $l < $r ? $l : $r;
      my $lalpha = $left->is_alpha;
      my $ralpha = $right->is_alpha;
      my $retval = 0;
      my $i = 0;
      while ( $i <= $m && $retval == 0 ) {
  	$retval = $left->{version}[$i] <=> $right->{version}[$i];
  	$i++;
      }
  
      # tiebreaker for alpha with identical terms
      if ( $retval == 0 
  	&& $l == $r 
  	&& $left->{version}[$m] == $right->{version}[$m]
  	&& ( $lalpha || $ralpha ) ) {
  
  	if ( $lalpha && !$ralpha ) {
  	    $retval = -1;
  	}
  	elsif ( $ralpha && !$lalpha) {
  	    $retval = +1;
  	}
      }
  
      # possible match except for trailing 0's
      if ( $retval == 0 && $l != $r ) {
  	if ( $l < $r ) {
  	    while ( $i <= $r && $retval == 0 ) {
  		if ( $right->{version}[$i] != 0 ) {
  		    $retval = -1; # not a match after all
  		}
  		$i++;
  	    }
  	}
  	else {
  	    while ( $i <= $l && $retval == 0 ) {
  		if ( $left->{version}[$i] != 0 ) {
  		    $retval = +1; # not a match after all
  		}
  		$i++;
  	    }
  	}
      }
  
      return $retval;  
  }
  
  sub vbool {
      my ($self) = @_;
      return vcmp($self,$self->new("0"),1);
  }
  
  sub vnoop { 
      require Carp; 
      Carp::croak("operation not supported with version object");
  }
  
  sub is_alpha {
      my ($self) = @_;
      return (exists $self->{alpha});
  }
  
  sub qv {
      my $value = shift;
      my $class = 'version';
      if (@_) {
  	$class = ref($value) || $value;
  	$value = shift;
      }
  
      $value = _un_vstring($value);
      $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
      my $version = $class->new($value);
      return $version;
  }
  
  *declare = \&qv;
  
  sub is_qv {
      my ($self) = @_;
      return (exists $self->{qv});
  }
  
  
  sub _verify {
      my ($self) = @_;
      if ( ref($self)
  	&& eval { exists $self->{version} }
  	&& ref($self->{version}) eq 'ARRAY'
  	) {
  	return 1;
      }
      else {
  	return 0;
      }
  }
  
  sub _is_non_alphanumeric {
      my $s = shift;
      $s = new charstar $s;
      while ($s) {
  	return 0 if isSPACE($s); # early out
  	return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/);
  	$s++;
      }
      return 0;
  }
  
  sub _un_vstring {
      my $value = shift;
      # may be a v-string
      if ( length($value) >= 3 && $value !~ /[._]/ 
  	&& _is_non_alphanumeric($value)) {
  	my $tvalue;
  	if ( $] ge 5.008_001 ) {
  	    $tvalue = _find_magic_vstring($value);
  	    $value = $tvalue if length $tvalue;
  	}
  	elsif ( $] ge 5.006_000 ) {
  	    $tvalue = sprintf("v%vd",$value);
  	    if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
  		# must be a v-string
  		$value = $tvalue;
  	    }
  	}
      }
      return $value;
  }
  
  sub _find_magic_vstring {
      my $value = shift;
      my $tvalue = '';
      require B;
      my $sv = B::svref_2object(\$value);
      my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef;
      while ( $magic ) {
  	if ( $magic->TYPE eq 'V' ) {
  	    $tvalue = $magic->PTR;
  	    $tvalue =~ s/^v?(.+)$/v$1/;
  	    last;
  	}
  	else {
  	    $magic = $magic->MOREMAGIC;
  	}
      }
      return $tvalue;
  }
  
  sub _VERSION {
      my ($obj, $req) = @_;
      my $class = ref($obj) || $obj;
  
      no strict 'refs';
      if ( exists $INC{"$class.pm"} and not %{"$class\::"} and $] >= 5.008) {
  	 # file but no package
  	require Carp;
  	Carp::croak( "$class defines neither package nor VERSION"
  	    ."--version check failed");
      }
  
      my $version = eval "\$$class\::VERSION";
      if ( defined $version ) {
  	local $^W if $] <= 5.008;
  	$version = version::vpp->new($version);
      }
  
      if ( defined $req ) {
  	unless ( defined $version ) {
  	    require Carp;
  	    my $msg =  $] < 5.006 
  	    ? "$class version $req required--this is only version "
  	    : "$class does not define \$$class\::VERSION"
  	      ."--version check failed";
  
  	    if ( $ENV{VERSION_DEBUG} ) {
  		Carp::confess($msg);
  	    }
  	    else {
  		Carp::croak($msg);
  	    }
  	}
  
  	$req = version::vpp->new($req);
  
  	if ( $req > $version ) {
  	    require Carp;
  	    if ( $req->is_qv ) {
  		Carp::croak( 
  		    sprintf ("%s version %s required--".
  			"this is only version %s", $class,
  			$req->normal, $version->normal)
  		);
  	    }
  	    else {
  		Carp::croak( 
  		    sprintf ("%s version %s required--".
  			"this is only version %s", $class,
  			$req->stringify, $version->stringify)
  		);
  	    }
  	}
      }
  
      return defined $version ? $version->stringify : undef;
  }
  
  1; #this line is important and will help the module return a true value
VERSION_VPP

s/^  //mg for values %fatpacked;

unshift @INC, sub {
  if (my $fat = $fatpacked{$_[1]}) {
    if ($] < 5.008) {
      return sub {
        return 0 unless length $fat;
        $fat =~ s/^([^\n]*\n?)//;
        $_ = $1;
        return 1;
      };
    }
    open my $fh, '<', \$fat
      or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
    return $fh;
  }
  return
};

} # END OF FATPACK CODE

use strict;
use App::cpantimes::script;

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

__END__

=head1 NAME

cpant - get, unpack, build, install and report on modules from CPAN

=head1 SEE ALSO

L<App::cpantimes>,
L<cpanm>.