#!/usr/bin/env 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/FatPacker.pm"} = <<'APP_FATPACKER';
  package App::FatPacker;
  
  use strict;
  use warnings FATAL => 'all';
  use 5.008001;
  use Getopt::Long;
  use Cwd qw(cwd);
  use File::Find qw(find);
  use File::Spec::Functions qw(
    catdir splitpath splitdir catpath rel2abs abs2rel
  );
  use File::Spec::Unix;
  use File::Copy qw(copy);
  use File::Path qw(mkpath rmtree);
  use B qw(perlstring);
  
  our $VERSION = '0.009018'; # 0.009.017
  
  $VERSION = eval $VERSION;
  
  sub call_parser {
    my $self = shift;
    my ($args, $options) = @_;
  
    local *ARGV = [ @{$args} ];
    $self->{option_parser}->getoptions(@$options);
  
    return [ @ARGV ];
  }
  
  sub lines_of {
    map +(chomp,$_)[1], do { local @ARGV = ($_[0]); <> };
  }
  
  sub stripspace {
    my ($text) = @_;
    $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
    $text;
  }
  
  sub import {
    $_[1] && $_[1] eq '-run_script'
      and return shift->new->run_script;
  }
  
  sub new {
    bless {
      option_parser => Getopt::Long::Parser->new(
        config => [ qw(require_order pass_through bundling no_auto_abbrev) ]
      ),
    }, $_[0];
  }
  
  sub run_script {
    my ($self, $args) = @_;
    my @args = $args ? @$args : @ARGV;
    (my $cmd = shift @args || 'help') =~ s/-/_/g;
  
    if (my $meth = $self->can("script_command_${cmd}")) {
      $self->$meth(\@args);
    } else {
      die "No such command ${cmd}";
    }
  }
  
  sub script_command_help {
    print "Try `perldoc fatpack` for how to use me\n";
  }
  
  sub script_command_pack {
    my ($self, $args) = @_;
  
    my @modules = split /\r?\n/, $self->trace(args => $args);
    my @packlists = $self->packlists_containing(\@modules);
  
    my $base = catdir(cwd, 'fatlib');
    $self->packlists_to_tree($base, \@packlists);
  
    my $file = shift @$args;
    print $self->fatpack_file($file);
  }
  
  sub script_command_trace {
    my ($self, $args) = @_;
  
    $args = $self->call_parser($args => [
      'to=s' => \my $file,
      'to-stderr' => \my $to_stderr,
      'use=s' => \my @additional_use
    ]);
  
    die "Can't use to and to-stderr on same call" if $file && $to_stderr;
  
    $file ||= 'fatpacker.trace';
  
    if (!$to_stderr and -e $file) {
      unlink $file or die "Couldn't remove old trace file: $!";
    }
    my $arg = do {
      if ($to_stderr) {
        ">&STDERR"
      } elsif ($file) {
        ">>${file}"
      }
    };
  
    $self->trace(
      use => \@additional_use,
      args => $args,
      output => $arg,
    );
  }
  
  sub trace {
    my ($self, %opts) = @_;
  
    my $output = $opts{output};
    my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]};
  
    local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$trace_opts;
  
    my @args = @{$opts{args}||[]};
  
    if ($output) {
      # user specified output target, JFDI
      system $^X, @args;
      return;
    } else {
      # no output target specified, slurp
      open my $out_fh, "$^X @args |";
      return do { local $/; <$out_fh> };
    }
  }
  
  sub script_command_packlists_for {
    my ($self, $args) = @_;
    foreach my $pl ($self->packlists_containing($args)) {
      print "${pl}\n";
    }
  }
  
  sub packlists_containing {
    my ($self, $targets) = @_;
    my @targets = @$targets;
    foreach my $t (@targets) {
      require $t;
    }
    my @search = grep -d $_, map catdir($_, 'auto'), @INC;
    my %pack_rev;
    find({
      no_chdir => 1,
      wanted => sub {
        return unless /[\\\/]\.packlist$/ && -f $_;
        $pack_rev{$_} = $File::Find::name for lines_of $File::Find::name;
      },
    }, @search);
    my %found; @found{map +($pack_rev{Cwd::abs_path($INC{$_})}||()), @targets} = ();
    sort keys %found;
  }
  
  sub script_command_tree {
    my ($self, $args) = @_;
    my $base = catdir(cwd,'fatlib');
    $self->packlists_to_tree($base, $args);
  }
  
  sub packlists_to_tree {
    my ($self, $where, $packlists) = @_;
    rmtree $where;
    mkpath $where;
    foreach my $pl (@$packlists) {
      my ($vol, $dirs, $file) = splitpath $pl;
      my @dir_parts = splitdir $dirs;
      my $pack_base;
      PART: foreach my $p (0 .. $#dir_parts) {
        if ($dir_parts[$p] eq 'auto') {
          # $p-2 since it's <wanted path>/$Config{archname}/auto
          $pack_base = catpath $vol, catdir @dir_parts[0..$p-2];
          last PART;
        }
      }
      die "Couldn't figure out base path of packlist ${pl}" unless $pack_base;
      foreach my $source (lines_of $pl) {
        # there is presumably a better way to do "is this under this base?"
        # but if so, it's not obvious to me in File::Spec
        next unless substr($source,0,length $pack_base) eq $pack_base;
        my $target = rel2abs( abs2rel($source, $pack_base), $where );
        my $target_dir = catpath((splitpath $target)[0,1]);
        mkpath $target_dir;
        copy $source => $target;
      }
    }
  }
  
  sub script_command_file {
    my ($self, $args) = @_;
    my $file = shift @$args;
    print $self->fatpack_file($file);
  }
  
  sub fatpack_file {
    my ($self, $file) = @_;
    my $cwd = cwd;
    my @dirs = grep -d, map rel2abs($_, $cwd), ('lib','fatlib');
    my %files;
    foreach my $dir (@dirs) {
      find(sub {
        return unless -f $_;
        !/\.pm$/ and warn "File ${File::Find::name} isn't a .pm file - can't pack this -- if you hoped we were going to, things may not be what you expected later\n" and return;
        $files{File::Spec::Unix->abs2rel($File::Find::name,$dir)} = do {
          local (@ARGV, $/) = ($File::Find::name); <>
        };
        close ARGV;
      }, $dir);
    }
    my $start = stripspace <<'  END_START';
      # 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;
    END_START
    my $end = stripspace <<'  END_END';
      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
    END_END
    my @segments = map {
      (my $stub = $_) =~ s/\.pm$//;
      my $name = uc join '_', split '/', $stub;
      my $data = $files{$_}; $data =~ s/^/  /mg; $data =~ s/(?<!\n)\z/\n/;
      '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
      .qq!${data}${name}\n!;
    } sort keys %files;
    my $shebang = "";
    my $script = "";
    if ( defined $file and -r $file ) {
      open my $fh, "<", $file or die("Can't read $file: $!");
      $shebang = <$fh>;
      $script = join "", <$fh>;
      close $fh;
      unless ( index($shebang, '#!') == 0 ) {
        $script = $shebang . $script;
        $shebang = "";
      }
    }
    return join "\n", $shebang, $start, @segments, $end, $script;
  }
  
  =encoding UTF-8
  
  =head1 NAME
  
  App::FatPacker - pack your dependencies onto your script file
  
  =head1 SYNOPSIS
  
    $ fatpack pack myscript.pl >myscript.packed.pl
  
  Or, with more step-by-step control:
  
    $ fatpack trace myscript.pl
    $ fatpack packlists-for `cat fatpacker.trace` >packlists
    $ fatpack tree `cat packlists`
    $ fatpack file myscript.pl >myscript.packed.pl
  
  See the documentation for the L<fatpack> script itself for more information.
  
  The programmatic API for this code is not yet fully decided, hence the 0.9
  release version. Expect that to be cleaned up for 1.0.
  
  =head1 SEE ALSO
  
  L<article for Perl Advent 2012|http://www.perladvent.org/2012/2012-12-14.html>
  
  =head1 SUPPORT
  
  Your current best avenue is to come annoy annoy mst on #toolchain on
  irc.perl.org. There should be a non-IRC means of support by 1.0.
  
  =head1 AUTHOR
  
  Matt S. Trout (mst) <mst@shadowcat.co.uk>
  
  =head2 CONTRIBUTORS
  
  miyagawa - Tatsuhiko Miyagawa (cpan:MIYAGAWA) <miyagawa@bulknews.net>
  
  tokuhirom - MATSUNO★Tokuhiro (cpan:TOKUHIROM) <tokuhirom@gmail.com>
  
  dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
  
  gugod - 劉康民 (cpan:GUGOD) <gugod@cpan.org>
  
  t0m - Tomas Doran (cpan:BOBTFISH) <bobtfish@bobtfish.net>
  
  sawyer - Sawyer X (cpan:XSAWYERX) <xsawyerx@cpan.org>
  
  ether - Karen Etheridge (cpan:ETHER) <ether@cpan.org>
  
  Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
  
  Many more people are probably owed thanks for ideas. Yet
  another doc nit to fix.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010 the App::FatPacker L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
  
  1;
  
APP_FATPACKER

$fatpacked{"App/FatPacker/Trace.pm"} = <<'APP_FATPACKER_TRACE';
  package App::FatPacker::Trace;
  
  use strict;
  use warnings FATAL => 'all';
  use B ();
  
  my $trace_file;
  my %initial_inc;
  
  sub import {
    my (undef, $file, @extras) = @_;
  
    $trace_file = $file || '>>fatpacker.trace';
    # For filtering out our own deps later.
    # (Not strictly required as these are core only and won't have packlists, but 
    # looks neater.)
    %initial_inc = %INC;
  
    # Use any extra modules specified
    eval "use $_" for @extras;
  
    B::minus_c;
  }
  
  CHECK {
    return unless $trace_file; # not imported
  
    open my $trace, $trace_file
        or die "Couldn't open $trace_file to trace to: $!";
  
    for my $inc (keys %INC) {
      next if exists $initial_inc{$inc};
      print $trace "$inc\n";
    }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  App::FatPacker::Trace - Tracing module usage using compilation checking
  
  =head1 SYNOPSIS
  
      # open STDERR for writing
      # will be like: open my $fh, '>', '&STDERR'...
      perl -MApp::FatPacker::Trace=>&STDERR myscript.pl
  
      # open a file for writing
      # will be like: open my $fh, '>>', 'fatpacker.trace'
      perl -MApp::FatPacker::Trace=>>fatpacker.trace myscript.pl
  
  =head1 DESCRIPTION
  
  This module allows tracing the modules being used by your code. It does that
  using clever trickery using the C<import> method, the C<CHECK> block and
  L<B>'s C<minus_c> function.
  
  When App::FatPacker::Trace is being used, the import() method will call
  C<B::minus_c> in order to set up the global compilation-only flag perl
  (the interpreter) has. This will prevent any other code from being run.
  
  Then in the C<CHECK> block which is reached at the end of the compilation
  phase (see L<perlmod>), it will gather all modules that have been loaded,
  using C<%INC>, and will write it to a file or to STDERR, determined by
  parameters sent to the C<import> method.
  
  =head1 METHODS
  
  =head2 import
  
  This method gets run when you just load L<App::FatPacker::Trace>. It will
  note the current C<%INC> and will set up the output to be written to, and
  raise the compilation-only flag, which will prevent anything from being
  run past that point. This flag cannot be unset, so this is most easily run
  from the command line as such:
  
      perl -MApp::FatPacker::Trace [...]
  
  You can control the paramters to the import using an equal sign, as such:
  
      # send the parameter "hello"
      perl -MApp::FatPacker::Trace=hello [...]
  
      # send the parameter ">&STDERR"
      perl -MApp::FatPacker::Trace=>&STDERR [...]
  
  The import method accepts a first parameter telling it which output to open
  and how. These are both sent in a single parameter.
  
      # append to mytrace.txt
      perl -MApp::FatPacker::Trace=>>mytrace.txt myscript.pl
  
      # write to STDERR
      perl -MApp::FatPacker::Trace=>&STDERR myscript.pl
  
  The import method accepts additional parameters of extra modules to load.
  It will then add these modules to the trace. This is helpful if you want
  to explicitly indicate additional modules to trace, even if they aren't
  used in your script. Perhaps you're conditionally using them, perhaps
  they're for additional features, perhaps they're loaded lazily, whatever
  the reason.
  
      # Add Moo to the trace, even if you don't trace it in myscript.pl
      perl -MApp::FatPacker::Trace=>&STDERR,Moo myscript.pl
  
APP_FATPACKER_TRACE

$fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
  package App::cpanminus;
  our $VERSION = "1.7001";
  
  =encoding utf8
  
  =head1 NAME
  
  App::cpanminus - get, unpack, build and install modules from CPAN
  
  =head1 SYNOPSIS
  
      cpanm Module
  
  Run C<cpanm -h> or C<perldoc cpanm> for more options.
  
  =head1 DESCRIPTION
  
  cpanminus is a script to get, unpack, build and install modules from
  CPAN and does nothing else.
  
  It's dependency free (can bootstrap itself), requires zero
  configuration, and stands alone. When running, it requires only 10MB
  of RAM.
  
  =head1 INSTALLATION
  
  There are several ways to install cpanminus to your system.
  
  =head2 Package management system
  
  There are Debian packages, RPMs, FreeBSD ports, and packages for other
  operation systems available. If you want to use the package management system,
  search for cpanminus and use the appropriate command to install. This makes it
  easy to install C<cpanm> to your system without thinking about where to
  install, and later upgrade.
  
  =head2 Installing to system perl
  
  You can also use the latest cpanminus to install cpanminus itself:
  
      curl -L http://cpanmin.us | perl - --sudo App::cpanminus
  
  This will install C<cpanm> to your bin directory like
  C</usr/local/bin> (unless you configured C<INSTALL_BASE> with
  L<local::lib>), so you probably need the C<--sudo> option.
  
  =head2 Installing to local perl (perlbrew)
  
  If you have perl in your home directory, which is the case if you use
  tools like L<perlbrew>, you don't need the C<--sudo> option, since
  you're most likely to have a write permission to the perl's library
  path. You can just do:
  
      curl -L http://cpanmin.us | perl - App::cpanminus
  
  to install the C<cpanm> executable to the perl's bin path, like
  C<~/perl5/perlbrew/bin/cpanm>.
  
  =head2 Downloading the standalone executable
  
  You can also copy the standalone executable to whatever location you'd like.
  
      cd ~/bin
      curl -LO http://xrl.us/cpanm
      chmod +x cpanm
      # edit shebang if you don't have /usr/bin/env
  
  This just works, but be sure to grab the new version manually when you
  upgrade because C<--self-upgrade> might not work for this.
  
  =head1 DEPENDENCIES
  
  perl 5.8 or later.
  
  =over 4
  
  =item *
  
  'tar' executable (bsdtar or GNU tar version 1.22 are recommended) or Archive::Tar to unpack files.
  
  =item *
  
  C compiler, if you want to build XS modules.
  
  =item *
  
  make
  
  =item *
  
  Module::Build (core in 5.10)
  
  =back
  
  =head1 QUESTIONS
  
  =head2 Another CPAN installer?
  
  OK, the first motivation was this: the CPAN shell runs out of memory (or swaps
  heavily and gets really slow) on Slicehost/linode's most affordable plan with
  only 256MB RAM. Should I pay more to install perl modules from CPAN? I don't
  think so.
  
  =head2 But why a new client?
  
  First of all, let me be clear that CPAN and CPANPLUS are great tools
  I've used for I<literally> years (you know how many modules I have on
  CPAN, right?). I really respect their efforts of maintaining the most
  important tools in the CPAN toolchain ecosystem.
  
  However, for less experienced users (mostly from outside the Perl community),
  or even really experienced Perl developers who know how to shoot themselves in
  their feet, setting up the CPAN toolchain often feels like yak shaving,
  especially when all they want to do is just install some modules and start
  writing code.
  
  =head2 Zero-conf? How does this module get/parse/update the CPAN index?
  
  It queries the CPAN Meta DB site at L<http://cpanmetadb.plackperl.org/>.
  The site is updated at least every hour to reflect the latest changes
  from fast syncing mirrors. The script then also falls back to query the
  module at L<http://metacpan.org/> using its wonderful API.
  
  Upon calling these API hosts, cpanm (1.6004 or later) will send the
  local perl versions to the server in User-Agent string by default. You
  can turn it off with C<--no-report-perl-version> option. Read more
  about the option with L<cpanm>, and read more about the privacy policy
  about this data collection at L<http://cpanmetadb.plackperl.org/#privacy>
  
  Fetched files are unpacked in C<~/.cpanm> and automatically cleaned up
  periodically.  You can configure the location of this with the
  C<PERL_CPANM_HOME> environment variable.
  
  =head2 Where does this install modules to? Do I need root access?
  
  It installs to wherever ExtUtils::MakeMaker and Module::Build are
  configured to (via C<PERL_MM_OPT> and C<PERL_MB_OPT>). So if you're
  using local::lib, then it installs to your local perl5
  directory. Otherwise it installs to the site_perl directory that
  belongs to your perl.
  
  cpanminus at a boot time checks whether you have configured
  local::lib, or have the permission to install modules to the site_perl
  directory.  If neither, it automatically sets up local::lib compatible
  installation path in a C<perl5> directory under your home
  directory. To avoid this, run the script as the root user, with
  C<--sudo> option or with C<--local-lib> option.
  
  =head2 cpanminus can't install the module XYZ. Is it a bug?
  
  It is more likely a problem with the distribution itself. cpanminus
  doesn't support or is known to have issues with distributions like as
  follows:
  
  =over 4
  
  =item *
  
  Tests that require input from STDIN.
  
  =item *
  
  Tests that might fail when C<AUTOMATED_TESTING> is enabled.
  
  =item *
  
  Modules that have invalid numeric values as VERSION (such as C<1.1a>)
  
  =back
  
  These failures can be reported back to the author of the module so
  that they can fix it accordingly, rather than me.
  
  =head2 Does cpanm support the feature XYZ of L<CPAN> and L<CPANPLUS>?
  
  Most likely not. Here are the things that cpanm doesn't do by
  itself. And it's a feature - you got that from the name I<minus>,
  right?
  
  If you need these features, use L<CPAN>, L<CPANPLUS> or the standalone
  tools that are mentioned.
  
  =over 4
  
  =item *
  
  CPAN testers reporting. See L<App::cpanminus::reporter>
  
  =item *
  
  Building RPM packages from CPAN modules
  
  =item *
  
  Listing the outdated modules that needs upgrading. See L<App::cpanoutdated>
  
  =item *
  
  Showing the changes of the modules you're about to upgrade. See L<cpan-listchanges>
  
  =item *
  
  Patching CPAN modules with distroprefs.
  
  =back
  
  See L<cpanm> or C<cpanm -h> to see what cpanminus I<can> do :)
  
  =head1 COPYRIGHT
  
  Copyright 2010- Tatsuhiko Miyagawa
  
  The standalone executable contains the following modules embedded.
  
  =over 4
  
  =item L<CPAN::DistnameInfo> Copyright 2003 Graham Barr
  
  =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
  
  =item L<local::lib> Copyright 2007-2009 Matt S Trout
  
  =item L<HTTP::Tiny> Copyright 2011 Christian Hansen
  
  =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
  
  =item L<version> Copyright 2004-2010 John Peacock
  
  =item L<JSON::PP> Copyright 2007-2011 by Makamaka Hannyaharamitu
  
  =item L<CPAN::Meta>, L<CPAN::Meta::Requirements> Copyright (c) 2010 by David Golden and Ricardo Signes
  
  =item L<CPAN::Meta::YAML> Copyright 2010 Adam Kennedy
  
  =item L<File::pushd> Copyright 2012 David Golden
  
  =back
  
  =head1 LICENSE
  
  This software is licensed under the same terms as Perl.
  
  =head1 CREDITS
  
  =head2 CONTRIBUTORS
  
  Patches and code improvements were contributed by:
  
  Goro Fuji, Kazuhiro Osawa, Tokuhiro Matsuno, Kenichi Ishigaki, Ian
  Wells, Pedro Melo, Masayoshi Sekimura, Matt S Trout (mst), squeeky,
  horus and Ingy dot Net.
  
  =head2 ACKNOWLEDGEMENTS
  
  Bug reports, suggestions and feedbacks were sent by, or general
  acknowledgement goes to:
  
  Jesse Vincent, David Golden, Andreas Koenig, Jos Boumans, Chris
  Williams, Adam Kennedy, Audrey Tang, J. Shirley, Chris Prather, Jesse
  Luehrs, Marcus Ramberg, Shawn M Moore, chocolateboy, Chirs Nehren,
  Jonathan Rockway, Leon Brocard, Simon Elliott, Ricardo Signes, AEvar
  Arnfjord Bjarmason, Eric Wilhelm, Florian Ragwitz and xaicron.
  
  =head1 COMMUNITY
  
  =over 4
  
  =item L<http://github.com/miyagawa/cpanminus> - source code repository, issue tracker
  
  =item L<irc://irc.perl.org/#toolchain> - discussions about Perl toolchain. I'm there.
  
  =back
  
  =head1 NO WARRANTY
  
  This software is provided "as-is," without any express or implied
  warranty. In no event shall the author be held liable for any damages
  arising from the use of the software.
  
  =head1 SEE ALSO
  
  L<CPAN> L<CPANPLUS> L<pip>
  
  =cut
  
  1;
APP_CPANMINUS

$fatpacked{"App/cpanminus/fatscript.pm"} = <<'APP_CPANMINUS_FATSCRIPT';
  package App::cpanminus::fatscript;
  #
  # You want to install cpanminus? Run the following command and it will
  # install itself for you. You might want to run it as a root with sudo
  # if you want to install to places like /usr/local/bin.
  #
  #   % curl -L http://cpanmin.us | perl - App::cpanminus
  #
  # If you don't have curl but wget, replace `curl -L` with `wget -O -`.
  #
  # For more details about this program, visit http://search.cpan.org/dist/App-cpanminus
  
  our $VERSION = "1.6928";
  # DO NOT EDIT -- this is an auto generated file
  
  # This chunk of stuff was generated by App::FatPacker. To find the original
  # file's code, look for the end of this BEGIN block or the string 'FATPACK'
  BEGIN {
  my %fatpacked;
  
  $fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
    package App::cpanminus;
    our $VERSION = "1.7001";
    
    =encoding utf8
    
    =head1 NAME
    
    App::cpanminus - get, unpack, build and install modules from CPAN
    
    =head1 SYNOPSIS
    
        cpanm Module
    
    Run C<cpanm -h> or C<perldoc cpanm> for more options.
    
    =head1 DESCRIPTION
    
    cpanminus is a script to get, unpack, build and install modules from
    CPAN and does nothing else.
    
    It's dependency free (can bootstrap itself), requires zero
    configuration, and stands alone. When running, it requires only 10MB
    of RAM.
    
    =head1 INSTALLATION
    
    There are several ways to install cpanminus to your system.
    
    =head2 Package management system
    
    There are Debian packages, RPMs, FreeBSD ports, and packages for other
    operation systems available. If you want to use the package management system,
    search for cpanminus and use the appropriate command to install. This makes it
    easy to install C<cpanm> to your system without thinking about where to
    install, and later upgrade.
    
    =head2 Installing to system perl
    
    You can also use the latest cpanminus to install cpanminus itself:
    
        curl -L http://cpanmin.us | perl - --sudo App::cpanminus
    
    This will install C<cpanm> to your bin directory like
    C</usr/local/bin> (unless you configured C<INSTALL_BASE> with
    L<local::lib>), so you probably need the C<--sudo> option.
    
    =head2 Installing to local perl (perlbrew)
    
    If you have perl in your home directory, which is the case if you use
    tools like L<perlbrew>, you don't need the C<--sudo> option, since
    you're most likely to have a write permission to the perl's library
    path. You can just do:
    
        curl -L http://cpanmin.us | perl - App::cpanminus
    
    to install the C<cpanm> executable to the perl's bin path, like
    C<~/perl5/perlbrew/bin/cpanm>.
    
    =head2 Downloading the standalone executable
    
    You can also copy the standalone executable to whatever location you'd like.
    
        cd ~/bin
        curl -LO http://xrl.us/cpanm
        chmod +x cpanm
        # edit shebang if you don't have /usr/bin/env
    
    This just works, but be sure to grab the new version manually when you
    upgrade because C<--self-upgrade> might not work for this.
    
    =head1 DEPENDENCIES
    
    perl 5.8 or later.
    
    =over 4
    
    =item *
    
    'tar' executable (bsdtar or GNU tar version 1.22 are recommended) or Archive::Tar to unpack files.
    
    =item *
    
    C compiler, if you want to build XS modules.
    
    =item *
    
    make
    
    =item *
    
    Module::Build (core in 5.10)
    
    =back
    
    =head1 QUESTIONS
    
    =head2 Another CPAN installer?
    
    OK, the first motivation was this: the CPAN shell runs out of memory (or swaps
    heavily and gets really slow) on Slicehost/linode's most affordable plan with
    only 256MB RAM. Should I pay more to install perl modules from CPAN? I don't
    think so.
    
    =head2 But why a new client?
    
    First of all, let me be clear that CPAN and CPANPLUS are great tools
    I've used for I<literally> years (you know how many modules I have on
    CPAN, right?). I really respect their efforts of maintaining the most
    important tools in the CPAN toolchain ecosystem.
    
    However, for less experienced users (mostly from outside the Perl community),
    or even really experienced Perl developers who know how to shoot themselves in
    their feet, setting up the CPAN toolchain often feels like yak shaving,
    especially when all they want to do is just install some modules and start
    writing code.
    
    =head2 Zero-conf? How does this module get/parse/update the CPAN index?
    
    It queries the CPAN Meta DB site at L<http://cpanmetadb.plackperl.org/>.
    The site is updated at least every hour to reflect the latest changes
    from fast syncing mirrors. The script then also falls back to query the
    module at L<http://metacpan.org/> using its wonderful API.
    
    Upon calling these API hosts, cpanm (1.6004 or later) will send the
    local perl versions to the server in User-Agent string by default. You
    can turn it off with C<--no-report-perl-version> option. Read more
    about the option with L<cpanm>, and read more about the privacy policy
    about this data collection at L<http://cpanmetadb.plackperl.org/#privacy>
    
    Fetched files are unpacked in C<~/.cpanm> and automatically cleaned up
    periodically.  You can configure the location of this with the
    C<PERL_CPANM_HOME> environment variable.
    
    =head2 Where does this install modules to? Do I need root access?
    
    It installs to wherever ExtUtils::MakeMaker and Module::Build are
    configured to (via C<PERL_MM_OPT> and C<PERL_MB_OPT>). So if you're
    using local::lib, then it installs to your local perl5
    directory. Otherwise it installs to the site_perl directory that
    belongs to your perl.
    
    cpanminus at a boot time checks whether you have configured
    local::lib, or have the permission to install modules to the site_perl
    directory.  If neither, it automatically sets up local::lib compatible
    installation path in a C<perl5> directory under your home
    directory. To avoid this, run the script as the root user, with
    C<--sudo> option or with C<--local-lib> option.
    
    =head2 cpanminus can't install the module XYZ. Is it a bug?
    
    It is more likely a problem with the distribution itself. cpanminus
    doesn't support or is known to have issues with distributions like as
    follows:
    
    =over 4
    
    =item *
    
    Tests that require input from STDIN.
    
    =item *
    
    Tests that might fail when C<AUTOMATED_TESTING> is enabled.
    
    =item *
    
    Modules that have invalid numeric values as VERSION (such as C<1.1a>)
    
    =back
    
    These failures can be reported back to the author of the module so
    that they can fix it accordingly, rather than me.
    
    =head2 Does cpanm support the feature XYZ of L<CPAN> and L<CPANPLUS>?
    
    Most likely not. Here are the things that cpanm doesn't do by
    itself. And it's a feature - you got that from the name I<minus>,
    right?
    
    If you need these features, use L<CPAN>, L<CPANPLUS> or the standalone
    tools that are mentioned.
    
    =over 4
    
    =item *
    
    CPAN testers reporting. See L<App::cpanminus::reporter>
    
    =item *
    
    Building RPM packages from CPAN modules
    
    =item *
    
    Listing the outdated modules that needs upgrading. See L<App::cpanoutdated>
    
    =item *
    
    Showing the changes of the modules you're about to upgrade. See L<cpan-listchanges>
    
    =item *
    
    Patching CPAN modules with distroprefs.
    
    =back
    
    See L<cpanm> or C<cpanm -h> to see what cpanminus I<can> do :)
    
    =head1 COPYRIGHT
    
    Copyright 2010- Tatsuhiko Miyagawa
    
    The standalone executable contains the following modules embedded.
    
    =over 4
    
    =item L<CPAN::DistnameInfo> Copyright 2003 Graham Barr
    
    =item L<Parse::CPAN::Meta> Copyright 2006-2009 Adam Kennedy
    
    =item L<local::lib> Copyright 2007-2009 Matt S Trout
    
    =item L<HTTP::Tiny> Copyright 2011 Christian Hansen
    
    =item L<Module::Metadata> Copyright 2001-2006 Ken Williams. 2010 Matt S Trout
    
    =item L<version> Copyright 2004-2010 John Peacock
    
    =item L<JSON::PP> Copyright 2007-2011 by Makamaka Hannyaharamitu
    
    =item L<CPAN::Meta>, L<CPAN::Meta::Requirements> Copyright (c) 2010 by David Golden and Ricardo Signes
    
    =item L<CPAN::Meta::YAML> Copyright 2010 Adam Kennedy
    
    =item L<File::pushd> Copyright 2012 David Golden
    
    =back
    
    =head1 LICENSE
    
    This software is licensed under the same terms as Perl.
    
    =head1 CREDITS
    
    =head2 CONTRIBUTORS
    
    Patches and code improvements were contributed by:
    
    Goro Fuji, Kazuhiro Osawa, Tokuhiro Matsuno, Kenichi Ishigaki, Ian
    Wells, Pedro Melo, Masayoshi Sekimura, Matt S Trout (mst), squeeky,
    horus and Ingy dot Net.
    
    =head2 ACKNOWLEDGEMENTS
    
    Bug reports, suggestions and feedbacks were sent by, or general
    acknowledgement goes to:
    
    Jesse Vincent, David Golden, Andreas Koenig, Jos Boumans, Chris
    Williams, Adam Kennedy, Audrey Tang, J. Shirley, Chris Prather, Jesse
    Luehrs, Marcus Ramberg, Shawn M Moore, chocolateboy, Chirs Nehren,
    Jonathan Rockway, Leon Brocard, Simon Elliott, Ricardo Signes, AEvar
    Arnfjord Bjarmason, Eric Wilhelm, Florian Ragwitz and xaicron.
    
    =head1 COMMUNITY
    
    =over 4
    
    =item L<http://github.com/miyagawa/cpanminus> - source code repository, issue tracker
    
    =item L<irc://irc.perl.org/#toolchain> - discussions about Perl toolchain. I'm there.
    
    =back
    
    =head1 NO WARRANTY
    
    This software is provided "as-is," without any express or implied
    warranty. In no event shall the author be held liable for any damages
    arising from the use of the software.
    
    =head1 SEE ALSO
    
    L<CPAN> L<CPANPLUS> L<pip>
    
    =cut
    
    1;
  APP_CPANMINUS
  
  $fatpacked{"App/cpanminus/CPANVersion.pm"} = <<'APP_CPANMINUS_CPANVERSION';
    package App::cpanminus::CPANVersion;
    # copy of CPAN::Version since it's not core on older 5.8
    
    use strict;
    #use vars qw($VERSION);
    #$VERSION = "5.5001";
    
    # CPAN::Version::vcmp courtesy Jost Krieger
    sub vcmp {
        my($self,$l,$r) = @_;
        local($^W) = 0;
        #CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
    
        return 0 if $l eq $r; # short circuit for quicker success
    
        for ($l,$r) {
            s/_//g;
        }
        #CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
        for ($l,$r) {
            next unless tr/.// > 1 || /^v/;
            s/^v?/v/;
            1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group
        }
        #CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
        if ($l=~/^v/ <=> $r=~/^v/) {
            for ($l,$r) {
                next if /^v/;
                $_ = $self->float2vv($_);
            }
        }
        #CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG;
        my $lvstring = "v0";
        my $rvstring = "v0";
        if ($] >= 5.006
         && $l =~ /^v/
         && $r =~ /^v/) {
            $lvstring = $self->vstring($l);
            $rvstring = $self->vstring($r);
            #CPAN->debug(sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring) if $CPAN::DEBUG;
        }
    
        return (
                ($l ne "undef") <=> ($r ne "undef")
                ||
                $lvstring cmp $rvstring
                ||
                $l <=> $r
                ||
                $l cmp $r
        );
    }
    
    sub vgt {
        my($self,$l,$r) = @_;
        $self->vcmp($l,$r) > 0;
    }
    
    sub vlt {
        my($self,$l,$r) = @_;
        $self->vcmp($l,$r) < 0;
    }
    
    sub vge {
        my($self,$l,$r) = @_;
        $self->vcmp($l,$r) >= 0;
    }
    
    sub vle {
        my($self,$l,$r) = @_;
        $self->vcmp($l,$r) <= 0;
    }
    
    sub vstring {
        my($self,$n) = @_;
        $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]";
        pack "U*", split /\./, $n;
    }
    
    # vv => visible vstring
    sub float2vv {
        my($self,$n) = @_;
        my($rev) = int($n);
        $rev ||= 0;
        my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
                                              # architecture influence
        $mantissa ||= 0;
        $mantissa .= "0" while length($mantissa)%3;
        my $ret = "v" . $rev;
        while ($mantissa) {
            $mantissa =~ s/(\d{1,3})// or
                die "Panic: length>0 but not a digit? mantissa[$mantissa]";
            $ret .= ".".int($1);
        }
        # warn "n[$n]ret[$ret]";
        $ret =~ s/(\.0)+/.0/; # v1.0.0 => v1.0
        $ret;
    }
    
    sub readable {
        my($self,$n) = @_;
        $n =~ /^([\w\-\+\.]+)/;
    
        return $1 if defined $1 && length($1)>0;
        # if the first user reaches version v43, he will be treated as "+".
        # We'll have to decide about a new rule here then, depending on what
        # will be the prevailing versioning behavior then.
    
        if ($] < 5.006) { # or whenever v-strings were introduced
            # we get them wrong anyway, whatever we do, because 5.005 will
            # have already interpreted 0.2.4 to be "0.24". So even if he
            # indexer sends us something like "v0.2.4" we compare wrongly.
    
            # And if they say v1.2, then the old perl takes it as "v12"
    
    #        if (defined $CPAN::Frontend) {
    #            $CPAN::Frontend->mywarn("Suspicious version string seen [$n]\n");
    #        } else {
                warn("Suspicious version string seen [$n]\n");
    #        }
            return $n;
        }
        my $better = sprintf "v%vd", $n;
        #CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG;
        return $better;
    }
    
    1;
    
    __END__
  APP_CPANMINUS_CPANVERSION
  
  $fatpacked{"App/cpanminus/Dependency.pm"} = <<'APP_CPANMINUS_DEPENDENCY';
    package App::cpanminus::Dependency;
    use strict;
    use CPAN::Meta::Requirements;
    
    sub from_prereqs {
        my($class, $prereq, $phases, $types) = @_;
    
        my @deps;
    
        for my $type (@$types) {
            my $req = CPAN::Meta::Requirements->new;
            $req->add_requirements($prereq->requirements_for($_, $type))
              for @$phases;
    
            push @deps, $class->from_versions($req->as_string_hash, $type);
        }
    
        return @deps;
    }
    
    sub from_versions {
        my($class, $versions, $type) = @_;
    
        my @deps;
        while (my($module, $version) = each %$versions) {
            push @deps, $class->new($module, $version, $type)
        }
    
        @deps;
    }
    
    sub new {
        my($class, $module, $version, $type) = @_;
    
        bless {
            module => $module,
            version => $version,
            type => $type || 'requires',
        }, $class;
    }
    
    sub module  { $_[0]->{module} }
    sub version { $_[0]->{version} }
    sub type    { $_[0]->{type} }
    
    sub is_requirement {
        $_[0]->{type} eq 'requires';
    }
    
    1;
  APP_CPANMINUS_DEPENDENCY
  
  $fatpacked{"App/cpanminus/ParsePM.pm"} = <<'APP_CPANMINUS_PARSEPM';
    package App::cpanminus::ParsePM;
    # fork of Parse::PMFile, use JSON::PP instead of JSON
    
    use strict;
    use warnings;
    use Safe;
    use JSON::PP;
    use Dumpvalue;
    #use CPAN::Version;
    use version ();
    use File::Spec ();
    use File::Temp ();
    use POSIX ':sys_wait_h';
    use App::cpanminus::CPANVersion;
    
    our $VERSION = '0.04';
    our $VERBOSE = 0;
    our $ALLOW_DEV_VERSION = 0;
    
    sub new {
        my ($class, $meta) = @_;
        bless {META_CONTENT => $meta}, $class;
    }
    
    # from PAUSE::pmfile::examine_fio
    sub parse {
        my ($self, $pmfile) = @_;
    
        $pmfile =~ s|\\|/|g;
    
        my($filemtime) = (stat $pmfile)[9];
        $self->{MTIME} = $filemtime;
        $self->{PMFILE} = $pmfile;
    
        unless ($self->_version_from_meta_ok) {
            $self->{VERSION} = $self->_parse_version;
            if ($self->{VERSION} =~ /^\{.*\}$/) {
                # JSON error message
            } elsif ($self->{VERSION} =~ /[_\s]/ && !$ALLOW_DEV_VERSION){   # ignore developer releases and "You suck!"
                return;
            }
        }
    
        my($ppp) = $self->_packages_per_pmfile;
        my @keys_ppp = $self->_filter_ppps(sort keys %$ppp);
        $self->_verbose(1,"Will check keys_ppp[@keys_ppp]\n");
    
        #
        # Immediately after each package (pmfile) examined contact
        # the database
        #
    
        my ($package);
      DBPACK: foreach $package (@keys_ppp) {
            # this part is taken from PAUSE::package::examine_pkg
            if ($package !~ /^\w[\w\:\']*\w?\z/
                ||
                $package !~ /\w\z/
                ||
                $package =~ /:/ && $package !~ /::/
                ||
                $package =~ /\w:\w/
                ||
                $package =~ /:::/
            ){
                $self->_verbose(1,"Package[$package] did not pass the ultimate sanity check");
                delete $ppp->{$package};
                next;
            }
    
            # Can't do perm_check() here.
    
            my $pp = $ppp->{$package};
            if ($pp->{version} && $pp->{version} =~ /^\{.*\}$/) { # JSON parser error
                my $err = JSON::PP::decode_json($pp->{version});
                if ($err->{openerr}) {
                    $self->_verbose(1,
                                  qq{Parse::PMFile was not able to
            read the file. It issued the following error: C< $err->{r} >},
                                  );
                } else {
                    $self->_verbose(1, 
                                  qq{Parse::PMFile was not able to
            parse the following line in that file: C< $err->{line} >
    
            Note: the indexer is running in a Safe compartement and cannot
            provide the full functionality of perl in the VERSION line. It
            is trying hard, but sometime it fails. As a workaround, please
            consider writing a META.yml that contains a 'provides'
            attribute or contact the CPAN admins to investigate (yet
            another) workaround against "Safe" limitations.)},
    
                                  );
                }
                delete $ppp->{$package};
                next;
            }
    
            # Sanity checks
    
            for (
                $package,
                $pp->{version},
            ) {
                if (!defined || /^\s*$/ || /\s/){  # for whatever reason I come here
                    delete $ppp->{$package};
                    next;            # don't screw up 02packages
                }
            }
        }                       # end foreach package
    
        return $ppp;
    }
    
    # from PAUSE::pmfile;
    sub _parse_version {
        my $self = shift;
    
        use strict;
    
        my $pmfile = $self->{PMFILE};
        my $tmpfile = File::Spec->catfile(File::Spec->tmpdir, "ParsePMFile$$" . rand(1000));
    
        my $pmcp = $pmfile;
        for ($pmcp) {
            s/([^\\](\\\\)*)@/$1\\@/g; # thanks to Raphael Manfredi for the
            # solution to escape @s and \
        }
        my($v);
        {
    
            package main; # seems necessary
    
            # XXX: do we need to fork as PAUSE does?
            # or, is alarm() just fine?
            my $pid = fork();
            die "Can't fork: $!" unless defined $pid;
            if ($pid) {
                waitpid($pid, 0);
                if (open my $fh, '<', $tmpfile) {
                    $v = <$fh>;
                }
            } else {
                # XXX Limit Resources too
    
                my($comp) = Safe->new("_pause::mldistwatch");
                my $eval = qq{
                  local(\$^W) = 0;
                  App::cpanminus::ParsePM::_parse_version_safely("$pmcp");
                  };
                $comp->permit("entereval"); # for MBARBON/Module-Info-0.30.tar.gz
                $comp->share("*App::cpanminus::ParsePM::_parse_version_safely");
                $comp->share("*version::new");
                $comp->share("*version::numify");
                $comp->share_from('main', ['*version::',
                                            '*Exporter::',
                                            '*DynaLoader::']);
                $comp->share_from('version', ['&qv']);
                # $comp->permit("require"); # no strict!
                $comp->deny(qw/enteriter iter unstack goto/); # minimum protection against Acme::BadExample
                {
                    no strict;
                    $v = $comp->reval($eval);
                }
                if ($@){ # still in the child process, out of Safe::reval
                    my $err = $@;
                    # warn ">>>>>>>err[$err]<<<<<<<<";
                    if (ref $err) {
                        if ($err->{line} =~ /[\$*]([\w\:\']*)\bVERSION\b.*?\=(.*)/) {
                            # $v = $comp->reval($2);
                            local *qv = \&version::qv; # equiv. of $comp->share_from('version', ['&qv']);
                            $v = eval "$2";
                        }
                        if ($@) {
                            $self->_verbose(1, sprintf("reval failed: err[%s] for eval[%s]",
                                          JSON::PP::encode_json($err),
                                          $eval,
                                        ));
                            $v = JSON::PP::encode_json($err);
                        }
                    } else {
                        $v = JSON::PP::encode_json({ openerr => $err });
                    }
                }
                if (defined $v) {
                    $v = $v->numify if ref($v) eq 'version';
                } else {
                    $v = "";
                }
                open my $fh, '>:utf8', $tmpfile;
                print $fh $v;
                exit 0;
            }
        }
        unlink $tmpfile if -e $tmpfile;
    
        return $self->_normalize_version($v);
    }
    
    # from PAUSE::pmfile;
    sub _packages_per_pmfile {
        my $self = shift;
    
        my $ppp = {};
        my $pmfile = $self->{PMFILE};
        my $filemtime = $self->{MTIME};
        my $version = $self->{VERSION};
    
        $DB::single++;
        open my $fh, "<", "$pmfile" or return $ppp;
    
        local $/ = "\n";
        my $inpod = 0;
    
      PLINE: while (<$fh>) {
            chomp;
            my($pline) = $_;
            $inpod = $pline =~ /^=(?!cut)/ ? 1 :
                $pline =~ /^=cut/ ? 0 : $inpod;
            next if $inpod;
            next if substr($pline,0,4) eq "=cut";
    
            $pline =~ s/\#.*//;
            next if $pline =~ /^\s*$/;
            if ($pline =~ /\b__(?:END|DATA)__\b/
                and $pmfile !~ /\.PL$/   # PL files may well have code after __DATA__
                ){
                last PLINE;
            }
    
            my $pkg;
            my $strict_version;
    
            if (
                $pline =~ m{
                          # (.*) # takes too much time if $pline is long
                          \bpackage\s+
                          ([\w\:\']+)
                          \s*
                          (?: $ | [\}\;] | \s+($version::STRICT) )
                        }x) {
                $pkg = $1;
                $strict_version = $2;
                if ($pkg eq "DB"){
                    # XXX if pumpkin and perl make him comaintainer! I
                    # think I always made the pumpkins comaint on DB
                    # without further ado (?)
                    next PLINE;
                }
            }
    
            if ($pkg) {
                # Found something
    
                # from package
                $pkg =~ s/\'/::/;
                next PLINE unless $pkg =~ /^[A-Za-z]/;
                next PLINE unless $pkg =~ /\w$/;
                next PLINE if $pkg eq "main";
                # Perl::Critic::Policy::TestingAndDebugging::ProhibitShebangWarningsArg
                # database for modid in mods, package in packages, package in perms
                # alter table mods modify modid varchar(128) binary NOT NULL default '';
                # alter table packages modify package varchar(128) binary NOT NULL default '';
                next PLINE if length($pkg) > 128;
                #restriction
                $ppp->{$pkg}{parsed}++;
                $ppp->{$pkg}{infile} = $pmfile;
                if ($self->_simile($pmfile,$pkg)) {
                    $ppp->{$pkg}{simile} = $pmfile;
                    if ($self->_version_from_meta_ok) {
                        my $provides = $self->{META_CONTENT}{provides};
                        if (exists $provides->{$pkg}) {
                            if (exists $provides->{$pkg}{version}) {
                                my $v = $provides->{$pkg}{version};
                                if ($v =~ /[_\s]/ && !$ALLOW_DEV_VERSION){   # ignore developer releases and "You suck!"
                                    next PLINE;
                                } else {
                                    $ppp->{$pkg}{version} = $self->_normalize_version($v);
                                }
                            } else {
                                $ppp->{$pkg}{version} = "undef";
                            }
                        }
                    } else {
                        if (defined $strict_version){
                            $ppp->{$pkg}{version} = $strict_version ;
                        } else {
                            $ppp->{$pkg}{version} = defined $version ? $version : "";
                        }
                        no warnings;
                        if ($version eq 'undef') {
                            $ppp->{$pkg}{version} = $version unless defined $ppp->{$pkg}{version};
                        } else {
                            $ppp->{$pkg}{version} =
                                $version
                                    if $version
                                        > $ppp->{$pkg}{version} ||
                                            $version
                                                gt $ppp->{$pkg}{version};
                        }
                    }
                } else {        # not simile
                    #### it comes later, it would be nonsense
                    #### to set to "undef". MM_Unix gives us
                    #### the best we can reasonably consider
                    $ppp->{$pkg}{version} =
                        $version
                            unless defined $ppp->{$pkg}{version} &&
                                length($ppp->{$pkg}{version});
                }
                $ppp->{$pkg}{filemtime} = $filemtime;
            } else {
                # $self->_verbose(2,"no pkg found");
            }
        }
    
        $fh->close;
        $ppp;
    }
    
    # from PAUSE::pmfile;
    {
        no strict;
        sub _parse_version_safely {
            my($parsefile) = @_;
            my $result;
            local *FH;
            local $/ = "\n";
            open(FH,$parsefile) or die "Could not open '$parsefile': $!";
            my $inpod = 0;
            while (<FH>) {
                $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
                next if $inpod || /^\s*#/;
                # last if /\b__(?:END|DATA)__\b/; # fails on quoted __END__ but this is rare
                chop;
                # next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
                next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
                my $current_parsed_line = $_;
                my $eval = qq{
              package #
                  ExtUtils::MakeMaker::_version;
    
              local $1$2;
              \$$2=undef; do {
                  $_
              }; \$$2
          };
                local $^W = 0;
                local $SIG{__WARN__} = sub {};
                $result = eval($eval);
                # warn "current_parsed_line[$current_parsed_line]\$\@[$@]";
                if ($@ or !defined $result){
                    die +{
                          eval => $eval,
                          line => $current_parsed_line,
                          file => $parsefile,
                          err => $@,
                          };
                }
                last;
            } #;
            close FH;
    
            $result = "undef" unless defined $result;
            return $result;
        }
    }
    
    # from PAUSE::pmfile;
    sub _filter_ppps {
        my($self,@ppps) = @_;
        my @res;
    
        # very similar code is in PAUSE::dist::filter_pms
      MANI: for my $ppp ( @ppps ) {
            if ($self->{META_CONTENT}){
                my $no_index = $self->{META_CONTENT}{no_index}
                                || $self->{META_CONTENT}{private}; # backward compat
                if (ref($no_index) eq 'HASH') {
                    my %map = (
                                package => qr{\z},
                                namespace => qr{::},
                              );
                    for my $k (qw(package namespace)) {
                        next unless my $v = $no_index->{$k};
                        my $rest = $map{$k};
                        if (ref $v eq "ARRAY") {
                            for my $ve (@$v) {
                                $ve =~ s|::$||;
                                if ($ppp =~ /^$ve$rest/){
                                    $self->_verbose(1,"Skipping ppp[$ppp] due to ve[$ve]");
                                    next MANI;
                                } else {
                                    $self->_verbose(1,"NOT skipping ppp[$ppp] due to ve[$ve]");
                                }
                            }
                        } else {
                            $v =~ s|::$||;
                            if ($ppp =~ /^$v$rest/){
                                $self->_verbose(1,"Skipping ppp[$ppp] due to v[$v]");
                                next MANI;
                            } else {
                                $self->_verbose(1,"NOT skipping ppp[$ppp] due to v[$v]");
                            }
                        }
                    }
                } else {
                    $self->_verbose(1,"No keyword 'no_index' or 'private' in META_CONTENT");
                }
            } else {
                # $self->_verbose(1,"no META_CONTENT"); # too noisy
            }
            push @res, $ppp;
        }
        $self->_verbose(1,"Result of filter_ppps: res[@res]");
        @res;
    }
    
    # from PAUSE::pmfile;
    sub _simile {
        my($self,$file,$package) = @_;
        # MakeMaker gives them the chance to have the file Simple.pm in
        # this directory but have the package HTML::Simple in it.
        # Afaik, they wouldn't be able to do so with deeper nested packages
        $file =~ s|.*/||;
        $file =~ s|\.pm(?:\.PL)?||;
        my $ret = $package =~ m/\b\Q$file\E$/;
        $ret ||= 0;
        unless ($ret) {
            # Apache::mod_perl_guide stuffs it into Version.pm
            $ret = 1 if lc $file eq 'version';
        }
        $self->_verbose(1,"Result of simile(): file[$file] package[$package] ret[$ret]\n");
        $ret;
    }
    
    # from PAUSE::pmfile
    sub _normalize_version {
        my($self,$v) = @_;
        $v = "undef" unless defined $v;
        my $dv = Dumpvalue->new;
        my $sdv = $dv->stringify($v,1); # second argument prevents ticks
        $self->_verbose(1,"Result of normalize_version: sdv[$sdv]\n");
    
        return $v if $v eq "undef";
        return $v if $v =~ /^\{.*\}$/; # JSON object
        $v =~ s/^\s+//;
        $v =~ s/\s+\z//;
        if ($v =~ /_/) {
            # XXX should pass something like EDEVELOPERRELEASE up e.g.
            # SIXTEASE/XML-Entities-0.0306.tar.gz had nothing but one
            # such modules and the mesage was not helpful that "nothing
            # was found".
            return $v ;
        }
        # may warn "Integer overflow"
        my $vv = eval { no warnings; version->new($v)->numify };
        if ($@) {
            # warn "$v: $@";
            return "undef";
        }
        if ($vv eq $v) {
            # the boring 3.14
        } else {
            my $forced = $self->_force_numeric($v);
            if ($forced eq $vv) {
            } elsif ($forced =~ /^v(.+)/) {
                # rare case where a v1.0.23 slipped in (JANL/w3mir-1.0.10.tar.gz)
                $vv = version->new($1)->numify;
            } else {
                # warn "Unequal forced[$forced] and vv[$vv]";
                if ($forced == $vv) {
                    # the trailing zeroes would cause unnecessary havoc
                    $vv = $forced;
                }
            }
        }
        return $vv;
    }
    
    # from PAUSE::pmfile;
    sub _force_numeric {
        my($self,$v) = @_;
        $v = App::cpanminus::CPANVersion->readable($v);
    
        if (
            $v =~
            /^(\+?)(\d*)(\.(\d*))?/ &&
            # "$2$4" ne ''
            (
              defined $2 && length $2
              ||
              defined $4 && length $4
            )
            ) {
            my $two = defined $2 ? $2 : "";
            my $three = defined $3 ? $3 : "";
            $v = "$two$three";
        }
        # no else branch! We simply say, everything else is a string.
        $v;
    }
    
    # from PAUSE::dist
    sub _version_from_meta_ok {
      my($self) = @_;
      return $self->{VERSION_FROM_META_OK} if exists $self->{VERSION_FROM_META_OK};
      my $c = $self->{META_CONTENT};
    
      # If there's no provides hash, we can't get our module versions from the
      # provides hash! -- rjbs, 2012-03-31
      return($self->{VERSION_FROM_META_OK} = 0) unless $c->{provides};
    
      # Some versions of Module::Build geneated an empty provides hash.  If we're
      # *not* looking at a Module::Build-generated metafile, then it's okay.
      my ($mb_v) = (defined $c->{generated_by} ? $c->{generated_by} : '') =~ /Module::Build version ([\d\.]+)/;
      return($self->{VERSION_FROM_META_OK} = 1) unless $mb_v;
    
      # ??? I don't know why this is here.
      return($self->{VERSION_FROM_META_OK} = 1) if $mb_v eq '0.250.0';
    
      if ($mb_v >= 0.19 && $mb_v < 0.26 && ! keys %{$c->{provides}}) {
          # RSAVAGE/Javascript-SHA1-1.01.tgz had an empty provides hash. Ron
          # did not find the reason why this happened, but let's not go
          # overboard, 0.26 seems a good threshold from the statistics: there
          # are not many empty provides hashes from 0.26 up.
          return($self->{VERSION_FROM_META_OK} = 0);
      }
    
      # We're not in the suspect range of M::B versions.  It's good to go.
      return($self->{VERSION_FROM_META_OK} = 1);
    }
    
    sub _verbose {
        my($self,$level,@what) = @_;
        warn @what if $level <= $VERBOSE;
    }
    
    1;
    
    __END__
  APP_CPANMINUS_PARSEPM
  
  $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
    package App::cpanminus::script;
    use strict;
    use Config;
    use Cwd ();
    use App::cpanminus;
    use File::Basename ();
    use File::Find ();
    use File::Path ();
    use File::Spec ();
    use File::Copy ();
    use File::Temp ();
    use Getopt::Long ();
    use Parse::CPAN::Meta;
    use Symbol ();
    use String::ShellQuote ();
    use version ();
    
    use aliased 'App::cpanminus::Dependency';
    
    use constant WIN32 => $^O eq 'MSWin32';
    use constant SUNOS => $^O eq 'solaris';
    use constant CAN_SYMLINK => eval { symlink("", ""); 1 };
    
    our $VERSION = $App::cpanminus::VERSION;
    
    if ($INC{"App/FatPacker/Trace.pm"}) {
        require JSON::PP;
        require CPAN::Meta::YAML;
        require CPAN::Meta::Prereqs;
        require version::vpp;
        require File::pushd;
    }
    
    my $quote = WIN32 ? q/"/ : q/'/;
    
    sub agent {
        my $self = shift;
        my $agent = "cpanminus/$VERSION";
        $agent .= " perl/$]" if $self->{report_perl_version};
        $agent;
    }
    
    sub determine_home {
        my $class = shift;
    
        my $homedir = $ENV{HOME}
          || eval { require File::HomeDir; File::HomeDir->my_home }
          || join('', @ENV{qw(HOMEDRIVE HOMEPATH)}); # Win32
    
        if (WIN32) {
            require Win32; # no fatpack
            $homedir = Win32::GetShortPathName($homedir);
        }
    
        return "$homedir/.cpanm";
    }
    
    sub new {
        my $class = shift;
    
        bless {
            home => $class->determine_home,
            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,
            cpanmetadb => "http://cpanmetadb.plackperl.org/v1.0/",
            perl => $^X,
            argv => [],
            local_lib => undef,
            self_contained => undef,
            prompt_timeout => 0,
            prompt => undef,
            configure_timeout => 60,
            build_timeout => 3600,
            test_timeout => 1800,
            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,
            install_types => ['requires'],
            with_develop => 0,
            showdeps => 0,
            scandeps => 0,
            scandeps_tree => [],
            format   => 'tree',
            save_dists => undef,
            skip_configure => 0,
            verify => 0,
            report_perl_version => 1,
            build_args => {},
            features => {},
            pure_perl => 0,
            cpanfile_path => 'cpanfile',
            @_,
        }, $class;
    }
    
    sub env {
        my($self, $key) = @_;
        $ENV{"PERL_CPANM_" . $key};
    }
    
    sub install_type_handlers {
        my $self = shift;
    
        my @handlers;
        for my $type (qw( recommends suggests )) {
            push @handlers, "with-$type" => sub {
                my %uniq;
                $self->{install_types} = [ grep !$uniq{$_}++, @{$self->{install_types}}, $type ];
            };
            push @handlers, "without-$type" => sub {
                $self->{install_types} = [ grep $_ ne $type, @{$self->{install_types}} ];
            };
        }
    
        @handlers;
    }
    
    sub build_args_handlers {
        my $self = shift;
    
        my @handlers;
        for my $phase (qw( configure build test install )) {
            push @handlers, "$phase-args=s" => \($self->{build_args}{$phase});
        }
    
        @handlers;
    }
    
    sub parse_options {
        my $self = shift;
    
        local @ARGV = @{$self->{argv}};
        push @ARGV, grep length, 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' => \$self->{verbose},
            '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;
            },
            'self-contained!' => \$self->{self_contained},
            'mirror=s@' => $self->{mirrors},
            'mirror-only!' => \$self->{mirror_only},
            'mirror-index=s'  => \$self->{mirror_index},
            'cpanmetadb=s'    => \$self->{cpanmetadb},
            '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 },
            'U|uninstall'  => sub { $self->{cmd} = 'uninstall' },
            'self-upgrade' => sub { $self->{action} = 'self_upgrade' },
            '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},
            'dev!'       => \$self->{dev_release},
            'metacpan!'  => \$self->{metacpan},
            'report-perl-version!' => \$self->{report_perl_version},
            'configure-timeout=i' => \$self->{configure_timeout},
            'build-timeout=i' => \$self->{build_timeout},
            'test-timeout=i' => \$self->{test_timeout},
            'with-develop' => \$self->{with_develop},
            'without-develop' => sub { $self->{with_develop} = 0 },
            'with-feature=s' => sub { $self->{features}{$_[1]} = 1 },
            'without-feature=s' => sub { $self->{features}{$_[1]} = 0 },
            'with-all-features' => sub { $self->{features}{__all} = 1 },
            'pp|pureperl!' => \$self->{pure_perl},
            "cpanfile=s" => \$self->{cpanfile_path},
            $self->install_type_handlers,
            $self->build_args_handlers,
        );
    
        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 {
        my $self = shift;
        my $install_base = $ENV{PERL_LOCAL_LIB_ROOT} ? $self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}) : $Config{installsitebin};
        if ($0 eq '-') {
            # run from curl, that's fine
            return;
        } elsif ($0 !~ /^$install_base/) {
            if ($0 =~ m!perlbrew/bin!) {
                die <<DIE;
    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
    
    DIE
            } else {
                die <<DIE;
    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.
    DIE
            }
        }
    }
    
    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 parse_module_args {
        my($self, $module) = @_;
    
        # Plack@1.2 -> Plack~"==1.2"
        # BUT don't expand @ in git URLs
        $module =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;
    
        # Plack~1.20, DBI~"> 1.0, <= 2.0"
        if ($module =~ /\~[v\d\._,\!<>= ]+$/) {
            return split /\~/, $module, 2;
        } else {
            return $module, undef;
        }
    }
    
    sub _exit {
        my($self, $code) = @_;
        die App::cpanminus::CommandExit->new($code);
    }
    
    sub doit {
        my $self = shift;
    
        my $code;
        eval {
            $code = ($self->_doit == 0);
        }; if (my $e = $@) {
            if (ref $e eq 'App::cpanminus::CommandExit') {
                $code = $e->code;
            } else {
                warn $e;
                $code = 1;
            }
        }
    
        return $code;
    }
    
    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) = $self->parse_module_args($module);
    
            $self->chdir($cwd);
            if ($self->{cmd} eq 'uninstall') {
                $self->uninstall_module($module)
                  or push @fail, $module;
            } else {
                $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);
    
        # native path because we use shell redirect
        $self->{log} = File::Spec->catfile($self->{base}, "build.log");
        my $final_log = "$self->{home}/build.log";
    
        { open my $out, ">$self->{log}" or die "$self->{log}: $!" }
    
        if (CAN_SYMLINK) {
            my $build_link = "$self->{home}/latest-build";
            unlink $build_link;
            symlink $self->{base}, $build_link;
    
            unlink $final_log;
            symlink $self->{log}, $final_log;
        } else {
            my $log = $self->{log}; my $home = $self->{home};
            $self->{at_exit} = sub {
                my $self = shift;
                my $temp_log = "$home/build.log." . time . ".$$";
                File::Copy::copy($log, $temp_log)
                    && unlink($final_log)
                    && rename($temp_log, $final_log);
            }
        }
    
        $self->chat("cpanm (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" .
                    "Work directory is $self->{base}\n");
    }
    
    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+(\S*)!m) {
                $found = $self->cpan_module($module, $2, $1);
                last;
            }
        }
    
        return $found unless $self->{cascade_search};
    
        if ($found) {
            if ($self->satisfy_version($module, $found->{module_version}, $version)) {
                return $found;
            } else {
                $self->chat("Found $module $found->{module_version} which doesn't satisfy $version.\n");
            }
        }
    
        return;
    }
    
    sub with_version_range {
        my($self, $version) = @_;
        defined($version) && $version =~ /[<>=]/;
    }
    
    sub encode_json {
        my($self, $data) = @_;
        require JSON::PP;
    
        my $json = JSON::PP::encode_json($data);
        $json =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
        $json;
    }
    
    # TODO extract this as a module?
    sub version_to_query {
        my($self, $module, $version) = @_;
    
        require CPAN::Meta::Requirements;
    
        my $requirements = CPAN::Meta::Requirements->new;
        $requirements->add_string_requirement($module, $version || '0');
    
        my $req = $requirements->requirements_for_module($module);
    
        if ($req =~ s/^==\s*//) {
            return {
                term => { 'module.version' => $req },
            };
        } elsif ($req !~ /\s/) {
            return {
                range => { 'module.version_numified' => { 'gte' => $self->numify_ver($req) } },
            };
        } else {
            my %ops = qw(< lt <= lte > gt >= gte);
            my(%range, @exclusion);
            my @requirements = split /,\s*/, $req;
            for my $r (@requirements) {
                if ($r =~ s/^([<>]=?)\s*//) {
                    $range{$ops{$1}} = $self->numify_ver($r);
                } elsif ($r =~ s/\!=\s*//) {
                    push @exclusion, $self->numify_ver($r);
                }
            }
    
            my @filters= (
                { range => { 'module.version_numified' => \%range } },
            );
    
            if (@exclusion) {
                push @filters, {
                    not => { or => [ map { +{ term => { 'module.version_numified' => $self->numify_ver($_) } } } @exclusion ] },
                };
            }
    
            return @filters;
        }
    }
    
    sub numify_ver {
        my($self, $ver) = @_;
        version->new($ver)->numify;
    }
    
    sub maturity_filter {
        my($self, $module, $version) = @_;
    
        my @filters;
    
        # TODO: dev release should be enabled per dist
        if (!$self->with_version_range($version) or $self->{dev_release}) {
            # backpan'ed dev release are considered "cancelled"
            push @filters, { not => { term => { status => 'backpan' } } };
        }
    
        unless ($self->{dev_release} or $version =~ /==/) {
            push @filters, { term => { maturity => 'released' } };
        }
    
        return @filters;
    }
    
    sub by_version {
        my %s = qw( latest 3  cpan 2  backpan 1 );
        $b->{_score} <=> $a->{_score} ||                             # version: higher version that satisfies the query
        $s{ $b->{fields}{status} } <=> $s{ $a->{fields}{status} };   # prefer non-BackPAN dist
    }
    
    sub by_first_come {
        $a->{fields}{date} cmp $b->{fields}{date};                   # first one wins, if all are in BackPAN/CPAN
    }
    
    sub by_date {
        $b->{fields}{date} cmp $a->{fields}{date};                   # prefer new uploads, when searching for dev
    }
    
    sub find_best_match {
        my($self, $match, $version) = @_;
        return unless $match && @{$match->{hits}{hits} || []};
        my @hits = $self->{dev_release}
            ? sort { by_version || by_date } @{$match->{hits}{hits}}
            : sort { by_version || by_first_come } @{$match->{hits}{hits}};
        $hits[0]->{fields};
    }
    
    sub search_metacpan {
        my($self, $module, $version) = @_;
    
        require JSON::PP;
    
        $self->chat("Searching $module ($version) on metacpan ...\n");
    
        my $metacpan_uri = 'http://api.metacpan.org/v0';
    
        my @filter = $self->maturity_filter($module, $version);
    
        my $query = { filtered => {
            (@filter ? (filter => { and => \@filter }) : ()),
            query => { nested => {
                score_mode => 'max',
                path => 'module',
                query => { custom_score => {
                    metacpan_script => "score_version_numified",
                    query => { constant_score => {
                        filter => { and => [
                            { term => { 'module.authorized' => JSON::PP::true() } },
                            { term => { 'module.indexed' => JSON::PP::true() } },
                            { term => { 'module.name' => $module } },
                            $self->version_to_query($module, $version),
                        ] }
                    } },
                } },
            } },
        } };
    
        my $module_uri = "$metacpan_uri/file/_search?source=";
        $module_uri .= $self->encode_json({
            query => $query,
            fields => [ 'date', 'release', 'module', 'status' ],
        });
    
        my($release, $module_version);
    
        my $module_json = $self->get($module_uri);
        my $module_meta = eval { JSON::PP::decode_json($module_json) };
        my $match = $self->find_best_match($module_meta);
        if ($match) {
            $release = $match->{release};
            my $module_matched = (grep { $_->{name} eq $module } @{$match->{module}})[0];
            $module_version = $module_matched->{version};
        }
    
        unless ($release) {
            $self->chat("! Could not find a release matching $module ($version) on MetaCPAN.\n");
            return;
        }
    
        my $dist_uri = "$metacpan_uri/release/_search?source=";
        $dist_uri .= $self->encode_json({
            filter => {
                term => { 'release.name' => $release },
            },
            fields => [ 'download_url', 'stat', 'status' ],
        });
    
        my $dist_json = $self->get($dist_uri);
        my $dist_meta = eval { JSON::PP::decode_json($dist_json) };
    
        if ($dist_meta) {
            $dist_meta = $dist_meta->{hits}{hits}[0]{fields};
        }
        if ($dist_meta && $dist_meta->{download_url}) {
            (my $distfile = $dist_meta->{download_url}) =~ s!.+/authors/id/!!;
            local $self->{mirrors} = $self->{mirrors};
            if ($dist_meta->{status} eq 'backpan') {
                $self->{mirrors} = [ 'http://backpan.perl.org' ];
            } elsif ($dist_meta->{stat}{mtime} > time()-24*60*60) {
                $self->{mirrors} = [ 'http://cpan.metacpan.org' ];
            }
            return $self->cpan_module($module, $distfile, $module_version);
        }
    
        $self->diag_fail("Finding $module on metacpan failed.");
        return;
    }
    
    sub search_database {
        my($self, $module, $version) = @_;
    
        my $found;
        my $range = ($self->with_version_range($version) || $self->{dev_release});
    
        if ($range or $self->{metacpan}) {
            $found = $self->search_metacpan($module, $version)   and return $found;
            $found = $self->search_cpanmetadb($module, $version) and return $found;
        } else {
            $found = $self->search_cpanmetadb($module, $version) and return $found;
            $found = $self->search_metacpan($module, $version)   and return $found;
        }
    }
    
    sub search_cpanmetadb {
        my($self, $module, $version) = @_;
    
        $self->chat("Searching $module on cpanmetadb ...\n");
    
        (my $uri = $self->{cpanmetadb}) =~ s{/?$}{/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.");
        return;
    }
    
    sub search_module {
        my($self, $module, $version) = @_;
    
        if ($self->{mirror_index}) {
            $self->mask_output( 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->mask_output( diag_fail => "Finding $module ($version) on mirror index $self->{mirror_index} failed." );
               return;
            }
        }
    
        unless ($self->{mirror_only}) {
            my $found = $self->search_database($module, $version);
            return $found if $found;
        }
    
        MIRROR: for my $mirror (@{ $self->{mirrors} }) {
            $self->mask_output( 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->mask_output( 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->mask_output( 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 {
        my $self = shift;
    
        print "cpanm (App::cpanminus) version $VERSION ($0)\n";
        print "perl version $] ($^X)\n\n";
    
        print "  \%Config:\n";
        for my $key (qw( archname installsitelib installsitebin installman1dir installman3dir
                         sitelibexp archlibexp privlibexp )) {
            print "    $key=$Config{$key}\n";
        }
    
        print "  \%ENV:\n";
        for my $key (grep /^PERL/, sort keys %ENV) {
            print "    $key=$ENV{$key}\n";
        }
    
        print "  \@INC:\n";
        for my $inc (@INC) {
            print "    $inc\n" unless ref($inc) eq 'CODE';
        }
    
        return 1;
    }
    
    sub show_help {
        my $self = shift;
    
        if ($_[0]) {
            print <<USAGE;
    Usage: cpanm [options] Module [...]
    
    Try `cpanm --help` or `man cpanm` for more options.
    USAGE
            $self->_exit(1);
        }
    
        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
      --self-contained          Install all non-core modules, even if they're already installed.
      --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
      -U,--uninstall            Uninstalls the modules (EXPERIMENTAL)
      -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) = @_;
        if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)) {
            return $lib;
        } else {
            return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(), $lib));
        }
    }
    
    sub local_lib_target {
        my($self, $root) = @_;
        (grep { $_ ne '' } split /\Q$Config{path_sep}/, $root)[-1];
    }
    
    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});
        }
    
        # PERL_LOCAL_LIB_ROOT is defined. Run as local::lib mode without overwriting ENV
        if ($ENV{PERL_LOCAL_LIB_ROOT} && $ENV{PERL_MM_OPT}) {
            return $self->setup_local_lib($self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}), 1);
        }
    
        # 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, 1);
    !
    ! 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) = @_;
    
        $self->diag(<<WARN, 1) if $base =~ /\s/;
    WARNING: Your lib directory name ($base) contains a space in it. It's known to cause issues with perl builder tools such as local::lib and MakeMaker. You're recommended to rename your directory.
    WARN
    
        local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
        local::lib->setup_env_hash_for($base, 0);
    }
    
    sub setup_local_lib {
        my($self, $base, $no_env) = @_;
        $base = undef if $base eq '_';
    
        require local::lib;
        {
            local $0 = 'cpanm'; # so curl/wget | perl works
            $base ||= "~/perl5";
            $base = local::lib->resolve_path($base);
            if ($self->{self_contained}) {
                my @inc = $self->_core_only_inc($base);
                $self->{search_inc} = [ @inc ];
            } else {
                $self->{search_inc} = [
                    local::lib->install_base_arch_path($base),
                    local::lib->install_base_perl_path($base),
                    @INC,
                ];
            }
            $self->_setup_local_lib_env($base) unless $no_env;
            $self->{local_lib} = $base;
        }
    
        $self->bootstrap_local_lib_deps;
    }
    
    sub bootstrap_local_lib_deps {
        my $self = shift;
        push @{$self->{bootstrap_deps}},
            Dependency->new('ExtUtils::MakeMaker' => 6.31),
            Dependency->new('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, 1);
            $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, $error) = @_;
        my $fh = $error ? *STDERR : *STDOUT;
        print {$fh} $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 mask_output {
        my $self = shift;
        my $method = shift;
        $self->$method( $self->mask_uri_passwords(@_) );
    }
    
    sub log {
        my $self = shift;
        open my $out, ">>$self->{log}";
        print $out @_;
    }
    
    sub run {
        my($self, $cmd) = @_;
    
        if (WIN32) {
            $cmd = $self->shell_quote(@$cmd) if ref $cmd eq 'ARRAY';
            unless ($self->{verbose}) {
                $cmd .= " >> " . $self->shell_quote($self->{log}) . " 2>&1";
            }
            !system $cmd;
        } else {
            my $pid = fork;
            if ($pid) {
                waitpid $pid, 0;
                return !$?;
            } else {
                $self->run_exec($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 append_args {
        my($self, $cmd, $phase) = @_;
    
        if (my $args = $self->{build_args}{$phase}) {
            $cmd = join ' ', $self->shell_quote(@$cmd), $args;
        }
    
        $cmd;
    }
    
    sub configure {
        my($self, $cmd, $depth) = @_;
    
        # 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;
    
        local $ENV{PERL_MM_OPT} = $ENV{PERL_MM_OPT};
        local $ENV{PERL_MB_OPT} = $ENV{PERL_MB_OPT};
    
        # skip man page generation
        unless ($self->{pod2man}) {
            $ENV{PERL_MM_OPT} .= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";
            $ENV{PERL_MB_OPT} .= " --config installman1dir= --config installsiteman1dir= --config installman3dir= --config installsiteman3dir=";
        }
    
        # Lancaster Consensus
        if ($self->{pure_perl}) {
            $ENV{PERL_MM_OPT} .= " PUREPERL_ONLY=1";
            $ENV{PERL_MB_OPT} .= " --pureperl-only";
        }
    
        $cmd = $self->append_args($cmd, 'configure') if $depth == 0;
    
        local $self->{verbose} = $self->{verbose} || $self->{interactive};
        $self->run_timeout($cmd, $self->{configure_timeout});
    }
    
    sub build {
        my($self, $cmd, $distname, $depth) = @_;
    
        local $ENV{PERL_MM_USE_DEFAULT} = !$self->{interactive};
    
        $cmd = $self->append_args($cmd, 'build') if $depth == 0;
    
        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, $depth) if $ans eq 'r';
            $self->show_build_log                        if $ans eq 'e';
            $self->look                                  if $ans eq 'l';
        }
    }
    
    sub test {
        my($self, $cmd, $distname, $depth) = @_;
        return 1 if $self->{notest};
    
        # https://rt.cpan.org/Ticket/Display.html?id=48965#txn-1013385
        local $ENV{PERL_MM_USE_DEFAULT} = !$self->{interactive};
    
        # https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md
        local $ENV{NONINTERACTIVE_TESTING} = !$self->{interactive};
    
        $cmd = $self->append_args($cmd, 'test') if $depth == 0;
    
        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, $depth) 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;
        }
    
        $cmd = $self->append_args($cmd, 'install') if $depth == 0;
    
        $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->check_upgrade;
        $self->{argv} = [ 'App::cpanminus' ];
        return; # continue
    }
    
    sub install_module {
        my($self, $module, $depth, $version) = @_;
    
        $self->check_libs;
    
        if ($self->{seen}{$module}++) {
            # TODO: circular dependencies
            $self->chat("Already tried $module. Skipping.\n");
            return 1;
        }
    
        if ($self->{skip_satisfied}) {
            my($ok, $local) = $self->check_module($module, $version || 0);
            if ($ok) {
                $self->diag("You have $module ($local)\n", 1);
                return 1;
            }
        }
    
        my $dist = $self->resolve_name($module, $version);
        unless ($dist) {
            my $what = $module . ($version ? " ($version)" : "");
            $self->diag_fail("Couldn't find module or a distribution $what", 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;
        }
    
        $dist->{depth} = $depth; # ugly hack
    
        if ($dist->{module}) {
            unless ($self->satisfy_version($dist->{module}, $dist->{module_version}, $version)) {
                $self->diag("Found $dist->{module} $dist->{module_version} which doesn't satisfy $version.\n", 1);
                return;
            }
    
            # If a version is requested, it has to be the exact same version, otherwise, check as if
            # it is the minimum version you need.
            my $cmp = $version ? "==" : "";
            my $requirement = $dist->{module_version} ? "$cmp$dist->{module_version}" : 0;
            my($ok, $local) = $self->check_module($dist->{module}, $requirement);
            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 uninstall_search_path {
        my $self = shift;
    
        $self->{local_lib}
            ? (local::lib->install_base_arch_path($self->{local_lib}),
               local::lib->install_base_perl_path($self->{local_lib}))
            : @Config{qw(installsitearch installsitelib)};
    }
    
    sub uninstall_module {
        my ($self, $module) = @_;
    
        $self->check_libs;
    
        my @inc = $self->uninstall_search_path;
    
        my($metadata, $packlist) = $self->packlists_containing($module, \@inc);
        unless ($packlist) {
            $self->diag_fail(<<DIAG, 1);
    $module is not found in the following directories and can't be uninstalled.
    
    @{[ join("  \n", map "  $_", @inc) ]}
    
    DIAG
            return;
        }
    
        my @uninst_files = $self->uninstall_target($metadata, $packlist);
    
        $self->ask_permission($module, \@uninst_files) or return;
        $self->uninstall_files(@uninst_files, $packlist);
    
        $self->diag("Successfully uninstalled $module\n", 1);
    
        return 1;
    }
    
    sub packlists_containing {
        my($self, $module, $inc) = @_;
    
        require Module::Metadata;
        my $metadata = Module::Metadata->new_from_module($module, inc => $inc)
            or return;
    
        my $packlist;
        my $wanted = sub {
            return unless $_ eq '.packlist' && -f $_;
            for my $file ($self->unpack_packlist($File::Find::name)) {
                $packlist ||= $File::Find::name if $file eq $metadata->filename;
            }
        };
    
        {
            require File::pushd;
            my $pushd = File::pushd::pushd();
            my @search = grep -d $_, map File::Spec->catdir($_, 'auto'), @$inc;
            File::Find::find($wanted, @search);
        }
    
        return $metadata, $packlist;
    }
    
    sub uninstall_target {
        my($self, $metadata, $packlist) = @_;
    
        # If the module has a shadow install, or uses local::lib, then you can't just remove
        # all files in .packlist since it might have shadows in there
        if ($self->has_shadow_install($metadata) or $self->{local_lib}) {
            grep $self->should_unlink($_), $self->unpack_packlist($packlist);
        } else {
            $self->unpack_packlist($packlist);
        }
    }
    
    sub has_shadow_install {
        my($self, $metadata) = @_;
    
        # check if you have the module in site_perl *and* perl
        my @shadow = grep defined, map Module::Metadata->new_from_module($metadata->name, inc => [$_]), @INC;
        @shadow >= 2;
    }
    
    sub should_unlink {
        my($self, $file) = @_;
    
        # If local::lib is used, everything under the directory can be safely removed
        # Otherwise, bin and man files might be shared with the shadows i.e. site_perl vs perl
        # This is not 100% safe to keep the script there hoping to work with older version of .pm
        # files in the shadow, but there's nothing you can do about it.
        if ($self->{local_lib}) {
            $file =~ /^\Q$self->{local_lib}\E/;
        } else {
            !(grep $file =~ /^\Q$_\E/, @Config{qw(installbin installscript installman1dir installman3dir)});
        }
    }
    
    sub ask_permission {
        my ($self, $module, $files) = @_;
    
        $self->diag("$module contains the following files:\n\n");
        for my $file (@$files) {
            $self->diag("  $file\n");
        }
        $self->diag("\n");
    
        return 'force uninstall' if $self->{force};
        local $self->{prompt} = 1;
        return $self->prompt_bool("Are you sure you want to uninstall $module?", 'y');
    }
    
    sub unpack_packlist {
        my ($self, $packlist) = @_;
        open my $fh, '<', $packlist or die "$packlist: $!";
        map { chomp; $_ } <$fh>;
    }
    
    sub uninstall_files {
        my ($self, @files) = @_;
    
        $self->diag("\n");
    
        for my $file (@files) {
            $self->diag("Unlink: $file\n");
            unlink $file or $self->diag_fail("$!: $file");
        }
    
        $self->diag("\n");
    
        return 1;
    }
    
    sub format_dist {
        my($self, $dist) = @_;
    
        # TODO support --dist-format?
        return "$dist->{cpanid}/$dist->{filename}";
    }
    
    sub trim {
        local $_ = shift;
        tr/\n/ /d;
        s/^\s*|\s*$//g;
        $_;
    }
    
    sub fetch_module {
        my($self, $dist) = @_;
    
        $self->chdir($self->{base});
    
        for my $uri (@{$dist->{uris}}) {
            $self->mask_output( 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->diag("ERROR: " . trim("$@") . "\n", 1) 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}) {
                # Only distros retrieved from CPAN have a pathname set
                my $path = $dist->{pathname} ? "$save/authors/id/$dist->{pathname}"
                                             : "$save/vendor/$file";
                $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; # no fatpack
    
        $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->mask_output( 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; # no fatpack
        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; # no fatpack
    
        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($1, $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) ],
            };
        }
    
        # Git
        if ($module =~ /(?:^git:|\.git(?:@.+)?$)/) {
            return $self->git_uri($module);
        }
    
        # cpan URI
        if ($module =~ s!^cpan:///distfile/!!) {
            return $self->cpan_dist($module);
        }
    
        # PAUSEID/foo
        # P/PA/PAUSEID/foo
        if ($module =~ m!^(?:[A-Z]/[A-Z]{2}/)?([A-Z]{2}[\-A-Z0-9]*/.*)$!) {
            return $self->cpan_dist($1);
        }
    
        # 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]{2})!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 git_uri {
        my ($self, $uri) = @_;
    
        # similar to http://www.pip-installer.org/en/latest/logic.html#vcs-support
        # git URL has to end with .git when you need to use pin @ commit/tag/branch
    
        ($uri, my $commitish) = split /(?<=\.git)@/i, $uri, 2;
    
        my $dir = File::Temp::tempdir(CLEANUP => 1);
    
        $self->mask_output( diag_progress => "Cloning $uri" );
        $self->run([ 'git', 'clone', $uri, $dir ]);
    
        unless (-e "$dir/.git") {
            $self->diag_fail("Failed cloning git repository $uri", 1);
            return;
        }
    
        if ($commitish) {
            require File::pushd;
            my $dir = File::pushd::pushd($dir);
    
            unless ($self->run([ 'git', 'checkout', $commitish ])) {
                $self->diag_fail("Failed to checkout '$commitish' in git repository $uri\n");
                return;
            }
        }
    
        $self->diag_ok;
    
        return {
            source => 'local',
            dir    => $dir,
        };
    }
    
    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 core_version_for {
        my($self, $module) = @_;
    
        require Module::CoreList; # no fatpack
        unless (exists $Module::CoreList::version{$]+0}) {
            die sprintf("Module::CoreList %s (loaded from %s) doesn't seem to have entries for perl $]. " .
                        "You're strongly recommended to upgrade Module::CoreList from CPAN.\n",
                        $Module::CoreList::VERSION, $INC{"Module/CoreList.pm"});
        }
    
        unless (exists $Module::CoreList::version{$]+0}{$module}) {
            return -1;
        }
    
        return $Module::CoreList::version{$]+0}{$module};
    }
    
    
    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)) {
            $version = $self->core_version_for($mod);
            return 0, undef if $version && $version == -1;
        }
    
        $self->{local_versions}{$mod} = $version;
    
        if ($self->is_deprecated($meta)){
            return 0, $version;
        } elsif ($self->satisfy_version($mod, $version, $want_ver)) {
            return 1, ($version || 'undef');
        } else {
            return 0, $version;
        }
    }
    
    sub satisfy_version {
        my($self, $mod, $version, $want_ver) = @_;
    
        $want_ver = '0' unless defined($want_ver) && length($want_ver);
    
        require CPAN::Meta::Requirements;
        my $requirements = CPAN::Meta::Requirements->new;
        $requirements->add_string_requirement($mod, $want_ver);
        $requirements->accepts_module($mod, $version);
    }
    
    sub unsatisfy_how {
        my($self, $ver, $want_ver) = @_;
    
        if ($want_ver =~ /^[v0-9\.\_]+$/) {
            return "$ver < $want_ver";
        } else {
            return "$ver doesn't satisfy $want_ver";
        }
    }
    
    sub is_deprecated {
        my($self, $meta) = @_;
    
        my $deprecated = eval {
            require Module::CoreList; # no fatpack
            Module::CoreList::is_deprecated($meta->{module});
        };
    
        return $deprecated && $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 (" . $self->unsatisfy_how($local, $ver) . ")\n") }
        else           { $self->chat("No\n") }
    
        return $mod unless $ok;
        return;
    }
    
    sub check_perl_version {
        my($self, $version) = @_;
        require CPAN::Meta::Requirements;
        my $req = CPAN::Meta::Requirements->from_string_hash({ perl => $version });
        $req->accepts_module(perl => $]);
    }
    
    sub install_deps {
        my($self, $dir, $depth, @deps) = @_;
    
        my(@install, %seen, @fail);
        for my $dep (@deps) {
            next if $seen{$dep->module};
            if ($dep->module eq 'perl') {
                if ($dep->is_requirement && !$self->check_perl_version($dep->version)) {
                    $self->diag("Needs perl @{[$dep->version]}, you have $]\n");
                    push @fail, 'perl';
                }
            } elsif ($self->should_install($dep->module, $dep->version)) {
                push @install, $dep;
                $seen{$dep->module} = 1;
            }
        }
    
        if (@install) {
            $self->diag("==> Found dependencies: " . join(", ",  map $_->module, @install) . "\n");
        }
    
        for my $dep (@install) {
            $self->install_module($dep->module, $depth + 1, $dep->version);
        }
    
        $self->chdir($self->{base});
        $self->chdir($dir) if $dir;
    
        if ($self->{scandeps}) {
            return 1; # Don't check if dependencies are installed, since with --scandeps they aren't
        }
        my @not_ok = $self->unsatisfied_deps(@deps);
        if (@not_ok) {
            return 0, \@not_ok;
        } else {
            return 1;
        }
    }
    
    sub unsatisfied_deps {
        my($self, @deps) = @_;
    
        require CPAN::Meta::Check;
        require CPAN::Meta::Requirements;
    
        my $reqs = CPAN::Meta::Requirements->new;
        for my $dep (grep $_->is_requirement, @deps) {
            $reqs->add_string_requirement($dep->module => $dep->version || '0');
        }
    
        my $ret = CPAN::Meta::Check::check_requirements($reqs, 'requires', $self->{search_inc});
        grep defined, values %$ret;
    }
    
    sub install_deps_bailout {
        my($self, $target, $dir, $depth, @deps) = @_;
    
        my($ok, $fail) = $self->install_deps($dir, $depth, @deps);
        if (!$ok) {
            $self->diag_fail("Installing the dependencies failed: " . join(", ", @$fail), 1);
            unless ($self->prompt_bool("Do you want to continue building $target anyway?", "n")) {
                $self->diag_fail("Bailing out the installation for $target.", 1);
                return;
            }
        }
    
        return 1;
    }
    
    sub build_stuff {
        my($self, $stuff, $dist, $depth) = @_;
    
        if ($self->{verify} && -e 'SIGNATURE') {
            $self->verify_signature($dist) or return;
        }
    
        require CPAN::Meta;
    
        my($meta_file) = grep -f, qw(META.json META.yml);
        if ($meta_file) {
            $self->chat("Checking configure dependencies from $meta_file\n");
            $dist->{cpanmeta} = eval { CPAN::Meta->load_file($meta_file) };
        } elsif ($dist->{dist} && $dist->{version}) {
            $self->chat("META.yml/json not found. Creating skeleton for it.\n");
            $dist->{cpanmeta} = CPAN::Meta->new({ name => $dist->{dist}, version => $dist->{version} });
        }
    
        $dist->{meta} = $dist->{cpanmeta} ? $dist->{cpanmeta}->as_struct : {};
    
        my @config_deps;
    
        if ($dist->{cpanmeta}) {
            push @config_deps, Dependency->from_prereqs(
                $dist->{cpanmeta}->effective_prereqs, ['configure'], $self->{install_types},
            );
        } else {
            push @config_deps, Dependency->from_versions(
                $dist->{meta}{configure_requires} || {}, 'configure',
            );
        }
    
        # workaround for bad M::B based dists with no configure_requires
        # https://github.com/miyagawa/cpanminus/issues/273
        if (-e 'Build.PL' && !$self->should_use_mm($dist->{dist})) {
            push @config_deps, Dependency->from_versions(
                { 'Module::Build' => '0.36' }, 'configure',
            );
        }
    
        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");
    
        $dist->{provides} = $self->extract_packages($dist->{cpanmeta}, ".")
            if $dist->{cpanmeta} && $dist->{source} eq 'cpan';
    
        # install direct 'test' dependencies for --installdeps, even with --notest
        my $root_target = (($self->{installdeps} or $self->{showdeps}) and $depth == 0);
        $dist->{want_phases} = $self->{notest} && !$root_target
                             ? [qw( build runtime )] : [qw( build test runtime )];
    
        push @{$dist->{want_phases}}, 'develop' if $self->{with_develop} && $depth == 0;
    
        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}) {
            for my $dep (@config_deps, @deps) {
                print $dep->module, ($dep->version ? ("~".$dep->version) : ""), "\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 _) {
            $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
            $self->build([ $self->{perl}, "./Build" ], $distname, $depth) &&
            $self->test([ $self->{perl}, "./Build", "test" ], $distname, $depth) &&
            $self->install([ $self->{perl}, "./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, $depth) &&
            $self->test([ $self->{make}, "test" ], $distname, $depth) &&
            $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 $action  = $local && !$reinstall
                        ? $self->numify_ver($version) < $self->numify_ver($local)
                            ? "downgraded"
                            : "upgraded"
                        : undef;
    
            my $how = $reinstall ? "reinstalled $distname"
                    : $local     ? "installed $distname ($action 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. Retry with --force to force install it.", 1);
            return;
        }
    }
    
    sub perl_requirements {
        my($self, @requires) = @_;
    
        my @perl;
        for my $requires (grep defined, @requires) {
            if (exists $requires->{perl}) {
                push @perl, Dependency->new(perl => $requires->{perl});
            }
        }
    
        return @perl;
    }
    
    sub should_use_mm {
        my($self, $dist) = @_;
    
        # 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 );
    
        $should_use_mm{$dist};
    }
    
    sub configure_this {
        my($self, $dist, $depth) = @_;
    
        if (-e $self->{cpanfile_path} && $self->{installdeps} && $depth == 0) {
            require Module::CPANfile;
            $dist->{cpanfile} = eval { Module::CPANfile->load($self->{cpanfile_path}) };
            $self->diag_fail($@, 1) if $@;
            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 $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" ], $depth)) {
                    $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}, "Build.PL" ], $depth)) {
                    $state->{configured_ok} = -e 'Build' && -f _;
                }
                $state->{use_module_build}++;
                $state->{configured}++;
            }
        };
    
        my @try;
        if ($dist->{dist} && $self->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 list_files {
        my $self = shift;
    
        if (-e 'MANIFEST') {
            require ExtUtils::Manifest;
            my $manifest = eval { ExtUtils::Manifest::manifind() } || {};
            return sort { lc $a cmp lc $b } keys %$manifest;
        } else {
            require File::Find;
            my @files;
            my $finder = sub {
                my $name = $File::Find::name;
                $name =~ s!\.[/\\]!!;
                push @files, $name;
            };
            File::Find::find($finder, ".");
            return sort { lc $a cmp lc $b } @files;
        }
    }
    
    sub extract_packages {
        my($self, $meta, $dir) = @_;
    
        my $try = sub {
            my $file = shift;
            return 1 unless $meta->{no_index};
            return 0 if grep { $file =~ m!^$_/! } @{$meta->{no_index}{directory} || []};
            return 0 if grep { $file eq $_ } @{$meta->{no_index}{file} || []};
            return 1;
        };
    
        require App::cpanminus::ParsePM;
    
        my @files = grep { /\.pm(?:\.PL)?$/ && $try->($_) } $self->list_files;
    
        my $provides = {};
    
        for my $file (@files) {
            my $parser = App::cpanminus::ParsePM->new($meta);
            my $packages = $parser->parse($file);
    
            while (my($package, $meta) = each %$packages) {
                $provides->{$package} ||= {
                    file => $meta->{infile},
                    ($meta->{version} eq 'undef') ? () : (version => $meta->{version}),
                };
            }
        }
    
        return $provides;
    }
    
    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 = $dist->{provides};
    
        File::Path::mkpath("blib/meta", 0, 0777);
    
        my $local = {
            name => $module_name,
            target => $module,
            version => exists $provides->{$module_name}
                ? ($provides->{$module_name}{version} || $dist->{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 configure_features {
        my($self, $dist, @features) = @_;
        map $_->identifier, grep { $self->effective_feature($dist, $_) } @features;
    }
    
    sub effective_feature {
        my($self, $dist, $feature) = @_;
    
        if ($dist->{depth} == 0) {
            my $value = $self->{features}{$feature->identifier};
            return $value if defined $value;
            return 1 if $self->{features}{__all};
        }
    
        if ($self->{interactive}) {
            require CPAN::Meta::Requirements;
    
            $self->diag("[@{[ $feature->description ]}]\n", 1);
    
            my $req = CPAN::Meta::Requirements->new;
            for my $phase (@{$dist->{want_phases}}) {
                for my $type (@{$self->{install_types}}) {
                    $req->add_requirements($feature->prereqs->requirements_for($phase, $type));
                }
            }
    
            my $reqs = $req->as_string_hash;
            my @missing;
            for my $module (keys %$reqs) {
                if ($self->should_install($module, $req->{$module})) {
                    push @missing, $module;
                }
            }
    
            if (@missing) {
                my $howmany = @missing;
                $self->diag("==> Found missing dependencies: " . join(", ", @missing) . "\n", 1);
                local $self->{prompt} = 1;
                return $self->prompt_bool("Install the $howmany optional module(s)?", "y");
            }
        }
    
        return;
    }
    
    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 @features = $self->configure_features($dist, $dist->{cpanfile}->features);
            my $prereqs = $dist->{cpanfile}->prereqs_with(@features);
            return Dependency->from_prereqs($prereqs, $dist->{want_phases}, $self->{install_types});
        }
    
        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_prereqs($mymeta, $dist);
            }
        }
    
        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_prereqs($mymeta, $dist);
            }
        }
    
        if (-e '_build/prereqs') {
            $self->chat("Checking dependencies from _build/prereqs ...\n");
            my $prereqs = do { open my $in, "_build/prereqs"; $self->safe_eval(join "", <$in>) };
            @deps = $self->extract_prereqs({ name => $meta->{name}, version => $meta->{version}, %$prereqs }, $dist);
        } 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, Dependency->from_versions($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, Dependency->new($1, $self->maybe_version($2));
                }
            }
        }
    
        return @deps;
    }
    
    sub maybe_version {
        my($self, $string) = @_;
        return $string && $string =~ /^\.?\d/ ? $string : undef;
    }
    
    sub extract_prereqs {
        my($self, $metadata, $dist) = @_;
    
        require CPAN::Meta;
        my $meta = CPAN::Meta->new($metadata, { lazy_validation => 1 });
        my @features = $self->configure_features($dist, $meta->features);
    
        return Dependency->from_prereqs($meta->effective_prereqs(\@features), $dist->{want_phases}, $self->{install_types});
    }
    
    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) {
            if (@targets >= 64) {
                $self->diag("Expiring " . scalar(@targets) . " work directories. This might take long...\n");
            } else {
                $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; # no fatpack
            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) = @_;
        if (WIN32) {
            join ' ', map { /^${quote}.+${quote}$/ ? $_ : ($quote . $_ . $quote) } @stuff;
        } else {
            String::ShellQuote::shell_quote_best_effort(@stuff);
        }
    }
    
    sub which {
        my($self, $name) = @_;
        return $name if File::Spec->file_name_is_absolute($name) && -x $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 = $self->shell_quote($fullpath);
                }
                return $fullpath;
            }
        }
        return;
    }
    
    sub get {
        my($self, $uri) = @_;
        if ($uri =~ /^file:/) {
            $self->file_get($uri);
        } else {
            $self->{_backends}{get}->(@_);
        }
    }
    
    sub mirror {
        my($self, $uri, $local) = @_;
        if ($uri =~ /^file:/) {
            $self->file_mirror($uri, $local);
        } else {
            $self->{_backends}{mirror}->(@_);
        }
    }
    
    sub untar    { $_[0]->{_backends}{untar}->(@_) };
    sub unzip    { $_[0]->{_backends}{unzip}->(@_) };
    
    sub uri_to_file {
        my($self, $uri) = @_;
    
        # file:///path/to/file -> /path/to/file
        # file://C:/path       -> C:/path
        if ($uri =~ s!file:/+!!) {
            $uri = "/$uri" unless $uri =~ m![a-zA-Z]:!;
        }
    
        return $uri;
    }
    
    sub file_get {
        my($self, $uri) = @_;
        my $file = $self->uri_to_file($uri);
        open my $fh, "<$file" or return;
        join '', <$fh>;
    }
    
    sub file_mirror {
        my($self, $uri, $path) = @_;
        my $file = $self->uri_to_file($uri);
        File::Copy::copy($file, $path);
    }
    
    sub has_working_lwp {
        my($self, $mirrors) = @_;
        my $https = grep /^https:/, @$mirrors;
        eval {
            require LWP::UserAgent; # no fatpack
            LWP::UserAgent->VERSION(5.802);
            require LWP::Protocol::https if $https; # no fatpack
            1;
        };
    }
    
    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} && $self->has_working_lwp($self->{mirrors})) {
            $self->chat("You have LWP $LWP::VERSION\n");
            my $ua = sub {
                LWP::UserAgent->new(
                    parse_head => 0,
                    env_proxy => 1,
                    agent => $self->agent,
                    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(@_);
                die $res->content if $res->code == 501;
                $res->code;
            };
        } elsif ($self->{try_wget} and my $wget = $self->which('wget')) {
            $self->chat("You have $wget\n");
            my @common = (
                '--user-agent', $self->agent,
                '--retry-connrefused',
                ($self->{verbose} ? () : ('-q')),
            );
            $self->{_backends}{get} = sub {
                my($self, $uri) = @_;
                $self->safeexec( my $fh, $wget, $uri, @common, '-O', '-' ) or die "wget $uri: $!";
                local $/;
                <$fh>;
            };
            $self->{_backends}{mirror} = sub {
                my($self, $uri, $path) = @_;
                $self->safeexec( my $fh, $wget, $uri, @common, '-O', $path ) or die "wget $uri: $!";
                local $/;
                <$fh>;
            };
        } elsif ($self->{try_curl} and my $curl = $self->which('curl')) {
            $self->chat("You have $curl\n");
            my @common = (
                '--location',
                '--user-agent', $self->agent,
                ($self->{verbose} ? () : '-s'),
            );
            $self->{_backends}{get} = sub {
                my($self, $uri) = @_;
                $self->safeexec( my $fh, $curl, @common, $uri ) or die "curl $uri: $!";
                local $/;
                <$fh>;
            };
            $self->{_backends}{mirror} = sub {
                my($self, $uri, $path) = @_;
                $self->safeexec( my $fh, $curl, @common, $uri, '-#', '-o', $path ) or die "curl $uri: $!";
                local $/;
                <$fh>;
            };
        } else {
            require HTTP::Tiny;
            $self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");
            my %common = (
                agent => $self->agent,
            );
            $self->{_backends}{get} = sub {
                my $self = shift;
                my $res = HTTP::Tiny->new(%common)->get($_[0]);
                return unless $res->{success};
                return $res->{content};
            };
            $self->{_backends}{mirror} = sub {
                my $self = shift;
                my $res = HTTP::Tiny->new(%common)->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();
                for my $member ( @members ) {
                    my $af = $member->fileName();
                    next if ($af =~ m!^(/|\.\./)!);
                    $status = $member->extractToFileNamed( $af );
                    $self->diag_fail("Extracting of file[$af] from zipfile[$file failed")
                        if $status != Archive::Zip::AZ_OK();
                }
    
                my ($root) = $zip->membersMatching( qr<^[^/]+/$> );
                $root &&= $root->fileName;
                return -d $root ? $root : undef;
            };
        }
    }
    
    sub safeexec {
        my $self = shift;
        my $rdr = $_[0] ||= Symbol::gensym();
    
        if (WIN32) {
            my $cmd = $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 mask_uri_passwords {
        my($self, @strings) = @_;
        s{ (https?://) ([^:/]+) : [^@/]+ @ }{$1$2:*password*@}gx for @strings;
        return @strings;
    }
    
    sub parse_meta {
        my($self, $file) = @_;
        return eval { Parse::CPAN::Meta->load_file($file) };
    }
    
    sub parse_meta_string {
        my($self, $yaml) = @_;
        return eval { Parse::CPAN::Meta->load_yaml_string($yaml) };
    }
    
    package App::cpanminus::CommandExit;
    sub new {
        bless { code => $_[1] }, $_[0];
    }
    
    sub code { $_[0]->{code} }
    
    1;
  APP_CPANMINUS_SCRIPT
  
  $fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
    
    package CPAN::DistnameInfo;
    
    $VERSION = "0.12";
    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;
      }
    
      if ($version =~ /(.+_.*)-(\d.*)/) {
          # Catch names like Task-Deprecations5_14-1.00.tar.gz where the 5_14 is
          # part of the distname. However, names like libao-perl_0.03-1.tar.gz
          # should still have 0.03-1 as their version.
          $dist .= $1;
          $version = $2;
      }
    
      # Normalize the Dist.pm-1.23 convention which CGI.pm and
      # a few others use.
      $dist =~ s{\.pm$}{};
    
      $version = $1
        if !length $version and $dist =~ s/-(\d+\w)$//;
    
      $version = $1 . $version
        if $version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;
    
      if ($version =~ /\d\.\d/) {
        $version =~ s/^[-_.]+//;
      }
      else {
        $version =~ s/^[-_]+//;
      }
    
      my $dev;
      if (length $version) {
        if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/) {
          $dev = 1 if (($1 > 6 and $1 & 1) or ($2 and $2 >= 50)) or $3;
        }
        elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/) {
          $dev = 1;
        }
      }
      else {
        $version = undef;
      }
    
      ($dist, $version, $dev);
    }
    
    sub new {
      my $class = shift;
      my $distfile = shift;
    
      $distfile =~ s,//+,/,g;
    
      my %info = ( pathname => $distfile );
    
      ($info{filename} = $distfile) =~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,,
        and $info{cpanid} = $6;
    
      if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i) { # support more ?
        $info{distvname} = $1;
        $info{extension} = $2;
      }
    
      @info{qw(dist version beta)} = distname_info($info{distvname});
      $info{maturity} = delete $info{beta} ? 'developer' : 'released';
    
      return bless \%info, $class;
    }
    
    sub dist      { shift->{dist} }
    sub version   { shift->{version} }
    sub maturity  { shift->{maturity} }
    sub filename  { shift->{filename} }
    sub cpanid    { shift->{cpanid} }
    sub distvname { shift->{distvname} }
    sub extension { shift->{extension} }
    sub pathname  { shift->{pathname} }
    
    sub properties { %{ $_[0] } }
    
    1;
    
    __END__
    
    =head1 NAME
    
    CPAN::DistnameInfo - Extract distribution name and version from a distribution filename
    
    =head1 SYNOPSIS
    
      my $pathname = "authors/id/G/GB/GBARR/CPAN-DistnameInfo-0.02.tar.gz";
    
      my $d = CPAN::DistnameInfo->new($pathname);
    
      my $dist      = $d->dist;      # "CPAN-DistnameInfo"
      my $version   = $d->version;   # "0.02"
      my $maturity  = $d->maturity;  # "released"
      my $filename  = $d->filename;  # "CPAN-DistnameInfo-0.02.tar.gz"
      my $cpanid    = $d->cpanid;    # "GBARR"
      my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
      my $extension = $d->extension; # "tar.gz"
      my $pathname  = $d->pathname;  # "authors/id/G/GB/GBARR/..."
    
      my %prop = $d->properties;
    
    =head1 DESCRIPTION
    
    Many online services that are centered around CPAN attempt to
    associate multiple uploads by extracting a distribution name from
    the filename of the upload. For most distributions this is easy as
    they have used ExtUtils::MakeMaker or Module::Build to create the
    distribution, which results in a uniform name. But sadly not all
    uploads are created in this way.
    
    C<CPAN::DistnameInfo> uses heuristics that have been learnt by
    L<http://search.cpan.org/> to extract the distribution name and
    version from filenames and also report if the version is to be
    treated as a developer release
    
    The constructor takes a single pathname, returning an object with the following methods
    
    =over
    
    =item cpanid
    
    If the path given looked like a CPAN authors directory path, then this will be the
    the CPAN id of the author.
    
    =item dist
    
    The name of the distribution
    
    =item distvname
    
    The file name with any suffix and leading directory names removed
    
    =item filename
    
    If the path given looked like a CPAN authors directory path, then this will be the
    path to the file relative to the detected CPAN author directory. Otherwise it is the path
    that was passed in.
    
    =item maturity
    
    The maturity of the distribution. This will be either C<released> or C<developer>
    
    =item extension
    
    The extension of the distribution, often used to denote the archive type (e.g. 'tar.gz')
    
    =item pathname
    
    The pathname that was passed to the constructor when creating the object.
    
    =item properties
    
    This will return a list of key-value pairs, suitable for assigning to a hash,
    for the known properties.
    
    =item version
    
    The extracted version
    
    =back
    
    =head1 AUTHOR
    
    Graham Barr <gbarr@pobox.com>
    
    =head1 COPYRIGHT 
    
    Copyright (c) 2003 Graham Barr. All rights reserved. This program is
    free software; you can redistribute it and/or modify it under the same
    terms as Perl itself.
    
    =cut
    
  CPAN_DISTNAMEINFO
  
  $fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
    use 5.006;
    use strict;
    use warnings;
    package CPAN::Meta;
    our $VERSION = '2.132510'; # VERSION
    
    
    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.4403 ();
    
    BEGIN { *_dclone = \&CPAN::Meta::Converter::_dclone }
    
    
    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;
    
    # ABSTRACT: the distribution metadata for a CPAN dist
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta - the distribution metadata for a CPAN dist
    
    =head1 VERSION
    
    version 2.132510
    
    =head1 SYNOPSIS
    
        use v5.10;
        use strict;
        use warnings;
        use CPAN::Meta;
        use Module::Load;
    
        my $meta = CPAN::Meta->load_file('META.json');
    
        printf "testing requirements for %s version %s\n",
        $meta->name,
        $meta->version;
    
        my $prereqs = $meta->effective_prereqs;
    
        for my $phase ( qw/configure runtime build test/ ) {
            say "Requirements for $phase:";
            my $reqs = $prereqs->requirements_for($phase, "requires");
            for my $module ( sort $reqs->required_modules ) {
                my $status;
                if ( eval { load $module unless $module eq 'perl'; 1 } ) {
                    my $version = $module eq 'perl' ? $] : $module->VERSION;
                    $status = $reqs->accepts_module($module, $version)
                            ? "$version ok" : "$version not ok";
                } else {
                    $status = "missing"
                };
                say "  $module ($status)";
            }
        }
    
    =head1 DESCRIPTION
    
    Software distributions released to the CPAN include a F<META.json> or, for
    older distributions, F<META.yml>, which describes the distribution, its
    contents, and the requirements for building and installing the distribution.
    The data structure stored in the F<META.json> file is described in
    L<CPAN::Meta::Spec>.
    
    CPAN::Meta provides a simple class to represent this distribution metadata (or
    I<distmeta>), along with some helpful methods for interrogating that data.
    
    The documentation below is only for the methods of the CPAN::Meta object.  For
    information on the meaning of individual fields, consult the spec.
    
    =head1 METHODS
    
    =head2 new
    
      my $meta = CPAN::Meta->new($distmeta_struct, \%options);
    
    Returns a valid CPAN::Meta object or dies if the supplied metadata hash
    reference fails to validate.  Older-format metadata will be up-converted to
    version 2 if they validate against the original stated specification.
    
    It takes an optional hashref of options. Valid options include:
    
    =over
    
    =item *
    
    lazy_validation -- if true, new will attempt to convert the given metadata
    to version 2 before attempting to validate it.  This means than any
    fixable errors will be handled by CPAN::Meta::Converter before validation.
    (Note that this might result in invalid optional data being silently
    dropped.)  The default is false.
    
    =back
    
    =head2 create
    
      my $meta = CPAN::Meta->create($distmeta_struct, \%options);
    
    This is same as C<new()>, except that C<generated_by> and C<meta-spec> fields
    will be generated if not provided.  This means the metadata structure is
    assumed to otherwise follow the latest L<CPAN::Meta::Spec>.
    
    =head2 load_file
    
      my $meta = CPAN::Meta->load_file($distmeta_file, \%options);
    
    Given a pathname to a file containing metadata, this deserializes the file
    according to its file suffix and constructs a new C<CPAN::Meta> object, just
    like C<new()>.  It will die if the deserialized version fails to validate
    against its stated specification version.
    
    It takes the same options as C<new()> but C<lazy_validation> defaults to
    true.
    
    =head2 load_yaml_string
    
      my $meta = CPAN::Meta->load_yaml_string($yaml, \%options);
    
    This method returns a new CPAN::Meta object using the first document in the
    given YAML string.  In other respects it is identical to C<load_file()>.
    
    =head2 load_json_string
    
      my $meta = CPAN::Meta->load_json_string($json, \%options);
    
    This method returns a new CPAN::Meta object using the structure represented by
    the given JSON string.  In other respects it is identical to C<load_file()>.
    
    =head2 save
    
      $meta->save($distmeta_file, \%options);
    
    Serializes the object as JSON and writes it to the given file.  The only valid
    option is C<version>, which defaults to '2'. On Perl 5.8.1 or later, the file
    is saved with UTF-8 encoding.
    
    For C<version> 2 (or higher), the filename should end in '.json'.  L<JSON::PP>
    is the default JSON backend. Using another JSON backend requires L<JSON> 2.5 or
    later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate
    backend like L<JSON::XS>.
    
    For C<version> less than 2, the filename should end in '.yml'.
    L<CPAN::Meta::Converter> is used to generate an older metadata structure, which
    is serialized to YAML.  CPAN::Meta::YAML is the default YAML backend.  You may
    set the C<$ENV{PERL_YAML_BACKEND}> to a supported alternative backend, though
    this is not recommended due to subtle incompatibilities between YAML parsers on
    CPAN.
    
    =head2 meta_spec_version
    
    This method returns the version part of the C<meta_spec> entry in the distmeta
    structure.  It is equivalent to:
    
      $meta->meta_spec->{version};
    
    =head2 effective_prereqs
    
      my $prereqs = $meta->effective_prereqs;
    
      my $prereqs = $meta->effective_prereqs( \@feature_identifiers );
    
    This method returns a L<CPAN::Meta::Prereqs> object describing all the
    prereqs for the distribution.  If an arrayref of feature identifiers is given,
    the prereqs for the identified features are merged together with the
    distribution's core prereqs before the CPAN::Meta::Prereqs object is returned.
    
    =head2 should_index_file
    
      ... if $meta->should_index_file( $filename );
    
    This method returns true if the given file should be indexed.  It decides this
    by checking the C<file> and C<directory> keys in the C<no_index> property of
    the distmeta structure.
    
    C<$filename> should be given in unix format.
    
    =head2 should_index_package
    
      ... if $meta->should_index_package( $package );
    
    This method returns true if the given package should be indexed.  It decides
    this by checking the C<package> and C<namespace> keys in the C<no_index>
    property of the distmeta structure.
    
    =head2 features
    
      my @feature_objects = $meta->features;
    
    This method returns a list of L<CPAN::Meta::Feature> objects, one for each
    optional feature described by the distribution's metadata.
    
    =head2 feature
    
      my $feature_object = $meta->feature( $identifier );
    
    This method returns a L<CPAN::Meta::Feature> object for the optional feature
    with the given identifier.  If no feature with that identifier exists, an
    exception will be raised.
    
    =head2 as_struct
    
      my $copy = $meta->as_struct( \%options );
    
    This method returns a deep copy of the object's metadata as an unblessed hash
    reference.  It takes an optional hashref of options.  If the hashref contains
    a C<version> argument, the copied metadata will be converted to the version
    of the specification and returned.  For example:
    
      my $old_spec = $meta->as_struct( {version => "1.4"} );
    
    =head2 as_string
    
      my $string = $meta->as_string( \%options );
    
    This method returns a serialized copy of the object's metadata as a character
    string.  (The strings are B<not> UTF-8 encoded.)  It takes an optional hashref
    of options.  If the hashref contains a C<version> argument, the copied metadata
    will be converted to the version of the specification and returned.  For
    example:
    
      my $string = $meta->as_struct( {version => "1.4"} );
    
    For C<version> greater than or equal to 2, the string will be serialized as
    JSON.  For C<version> less than 2, the string will be serialized as YAML.  In
    both cases, the same rules are followed as in the C<save()> method for choosing
    a serialization backend.
    
    =head1 STRING DATA
    
    The following methods return a single value, which is the value for the
    corresponding entry in the distmeta structure.  Values should be either undef
    or strings.
    
    =over 4
    
    =item *
    
    abstract
    
    =item *
    
    description
    
    =item *
    
    dynamic_config
    
    =item *
    
    generated_by
    
    =item *
    
    name
    
    =item *
    
    release_status
    
    =item *
    
    version
    
    =back
    
    =head1 LIST DATA
    
    These methods return lists of string values, which might be represented in the
    distmeta structure as arrayrefs or scalars:
    
    =over 4
    
    =item *
    
    authors
    
    =item *
    
    keywords
    
    =item *
    
    licenses
    
    =back
    
    The C<authors> and C<licenses> methods may also be called as C<author> and
    C<license>, respectively, to match the field name in the distmeta structure.
    
    =head1 MAP DATA
    
    These readers return hashrefs of arbitrary unblessed data structures, each
    described more fully in the specification:
    
    =over 4
    
    =item *
    
    meta_spec
    
    =item *
    
    resources
    
    =item *
    
    provides
    
    =item *
    
    no_index
    
    =item *
    
    prereqs
    
    =item *
    
    optional_features
    
    =back
    
    =head1 CUSTOM DATA
    
    A list of custom keys are available from the C<custom_keys> method and
    particular keys may be retrieved with the C<custom> method.
    
      say $meta->custom($_) for $meta->custom_keys;
    
    If a custom key refers to a data structure, a deep clone is returned.
    
    =for Pod::Coverage TO_JSON abstract author authors custom custom_keys description dynamic_config
    generated_by keywords license licenses meta_spec name no_index
    optional_features prereqs provides release_status resources version
    
    =head1 BUGS
    
    Please report any bugs or feature using the CPAN Request Tracker.
    Bugs can be submitted through the web interface at
    L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
    
    When submitting a bug or request, please include a test-file or a patch to an
    existing test-file that illustrates the bug or desired feature.
    
    =head1 SEE ALSO
    
    =over 4
    
    =item *
    
    L<CPAN::Meta::Converter>
    
    =item *
    
    L<CPAN::Meta::Validator>
    
    =back
    
    =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
    
    =head1 SUPPORT
    
    =head2 Bugs / Feature Requests
    
    Please report any bugs or feature requests through the issue tracker
    at L<https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues>.
    You will be notified automatically of any progress on your issue.
    
    =head2 Source Code
    
    This is open source software.  The code repository is available for
    public review and contribution under the terms of the license.
    
    L<https://github.com/Perl-Toolchain-Gang/CPAN-Meta>
    
      git clone https://github.com/Perl-Toolchain-Gang/CPAN-Meta.git
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 CONTRIBUTORS
    
    =over 4
    
    =item *
    
    Ansgar Burchardt <ansgar@cpan.org>
    
    =item *
    
    Avar Arnfjord Bjarmason <avar@cpan.org>
    
    =item *
    
    Christopher J. Madsen <cjm@cpan.org>
    
    =item *
    
    Cory G Watson <gphat@cpan.org>
    
    =item *
    
    Damyan Ivanov <dam@cpan.org>
    
    =item *
    
    Eric Wilhelm <ewilhelm@cpan.org>
    
    =item *
    
    Gregor Hermann <gregoa@debian.org>
    
    =item *
    
    Karen Etheridge <ether@cpan.org>
    
    =item *
    
    Ken Williams <kwilliams@cpan.org>
    
    =item *
    
    Kenichi Ishigaki <ishigaki@cpan.org>
    
    =item *
    
    Lars Dieckow <daxim@cpan.org>
    
    =item *
    
    Leon Timmermans <leont@cpan.org>
    
    =item *
    
    Mark Fowler <markf@cpan.org>
    
    =item *
    
    Michael G. Schwern <mschwern@cpan.org>
    
    =item *
    
    Olaf Alders <olaf@wundersolutions.com>
    
    =item *
    
    Olivier Mengu <dolmen@cpan.org>
    
    =item *
    
    Randy Sims <randys@thepierianspring.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META
  
  $fatpacked{"CPAN/Meta/Check.pm"} = <<'CPAN_META_CHECK';
    package CPAN::Meta::Check;
    {
      $CPAN::Meta::Check::VERSION = '0.007';
    }
    use strict;
    use warnings;
    
    use Exporter 5.57 'import';
    our @EXPORT = qw//;
    our @EXPORT_OK = qw/check_requirements requirements_for verify_dependencies/;
    our %EXPORT_TAGS = (all => [ @EXPORT, @EXPORT_OK ] );
    
    use CPAN::Meta::Requirements 2.120920;
    use Module::Metadata;
    
    sub _check_dep {
    	my ($reqs, $module, $dirs) = @_;
    
    	my $version = $module eq 'perl' ? $] : do { 
    		my $metadata = Module::Metadata->new_from_module($module, inc => $dirs);
    		return "Module '$module' is not installed" if not defined $metadata;
    		eval { $metadata->version };
    	};
    	return "Missing version info for module '$module'" if $reqs->requirements_for_module($module) and not $version;
    	return sprintf 'Installed version (%s) of %s is not in range \'%s\'', $version, $module, $reqs->requirements_for_module($module) if not $reqs->accepts_module($module, $version || 0);
    	return;
    }
    
    sub _check_conflict {
    	my ($reqs, $module, $dirs) = @_;
    	my $metadata = Module::Metadata->new_from_module($module, inc => $dirs);
    	return if not defined $metadata;
    	my $version = eval { $metadata->version };
    	return "Missing version info for module '$module'" if not $version;
    	return sprintf 'Installed version (%s) of %s is in range \'%s\'', $version, $module, $reqs->requirements_for_module($module) if $reqs->accepts_module($module, $version);
    	return;
    }
    
    sub requirements_for {
    	my ($meta, $phases, $type) = @_;
    	my $prereqs = ref($meta) eq 'CPAN::Meta' ? $meta->effective_prereqs : $meta;
    	if (!ref $phases) {
    		return $prereqs->requirements_for($phases, $type);
    	}
    	else {
    		my $ret = CPAN::Meta::Requirements->new;
    		for my $phase (@{ $phases }) {
    			$ret->add_requirements($prereqs->requirements_for($phase, $type));
    		}
    		return $ret;
    	}
    }
    
    sub check_requirements {
    	my ($reqs, $type, $dirs) = @_;
    
    	my %ret;
    	if ($type ne 'conflicts') {
    		for my $module ($reqs->required_modules) {
    			$ret{$module} = _check_dep($reqs, $module, $dirs);
    		}
    	}
    	else {
    		for my $module ($reqs->required_modules) {
    			$ret{$module} = _check_conflict($reqs, $module, $dirs);
    		}
    	}
    	return \%ret;
    }
    
    sub verify_dependencies {
    	my ($meta, $phases, $type, $dirs) = @_;
    	my $reqs = requirements_for($meta, $phases, $type);
    	my $issues = check_requirements($reqs, $type, $dirs);
    	return grep { defined } values %{ $issues };
    }
    
    # vi:noet:sts=2:sw=2:ts=2
    1;
    
    #ABSTRACT: Verify requirements in a CPAN::Meta object
    
    __END__
    
    =pod
    
    =head1 NAME
    
    CPAN::Meta::Check - Verify requirements in a CPAN::Meta object
    
    =head1 VERSION
    
    version 0.007
    
    =head1 SYNOPSIS
    
     warn "$_\n" for verify_requirements($meta, [qw/runtime build test/], 'requires');
    
    =head1 DESCRIPTION
    
    This module verifies if requirements described in a CPAN::Meta object are present.
    
    =head1 FUNCTIONS
    
    =head2 check_requirements($reqs, $type)
    
    This function checks if all dependencies in C<$reqs> (a L<CPAN::Meta::Requirements|CPAN::Meta::Requirements> object) are met, taking into account that 'conflicts' dependencies have to be checked in reverse. It returns a hash with the modules as keys and any problems as values; the value for a successfully found module will be undef.
    
    =head2 verify_dependencies($meta, $phases, $types, $incdirs)
    
    Check all requirements in C<$meta> for phases C<$phases> and types C<$types>. Modules are searched for in C<@$incdirs>, defaulting to C<@INC>.
    
    =head2 requirements_for($meta, $phases, $types, incdirs)
    
    This function returns a unified L<CPAN::Meta::Requirements|CPAN::Meta::Requirements> object for all C<$type> requirements for C<$phases>. $phases may be either one (scalar) value or an arrayref of valid values as defined by the L<CPAN::Meta spec|CPAN::Meta::Spec>. C<$type> must be a relationship as defined by the same spec. Modules are searched for in C<@$incdirs>, defaulting to C<@INC>.
    
    =head1 SEE ALSO
    
    =over 4
    
    =item * L<Test::CheckDeps|Test::CheckDeps>
    
    =item * L<CPAN::Meta|CPAN::Meta>
    
    =back
    
    =head1 AUTHOR
    
    Leon Timmermans <leont@cpan.org>
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2012 by Leon Timmermans.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META_CHECK
  
  $fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
    use 5.006;
    use strict;
    use warnings;
    package CPAN::Meta::Converter;
    our $VERSION = '2.132510'; # VERSION
    
    
    use CPAN::Meta::Validator;
    use CPAN::Meta::Requirements;
    use version 0.88 ();
    use Parse::CPAN::Meta 1.4400 ();
    
    sub _dclone {
      my $ref = shift;
    
      # if an object is in the data structure and doesn't specify how to
      # turn itself into JSON, we just stringify the object.  That does the
      # right thing for typical things that might be there, like version objects,
      # Path::Class objects, etc.
      no warnings 'once';
      local *UNIVERSAL::TO_JSON = sub { return "$_[0]" };
    
      my $backend = Parse::CPAN::Meta->json_backend();
      return $backend->new->utf8->decode(
        $backend->new->utf8->allow_blessed->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 _no_prefix_ucfirst_custom {
      my $key = shift;
      $key =~ s/^x_//;
      return _ucfirst_custom($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) = @_;
      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>' );
    
      my $v = eval { version->new($element) };
      # XXX check defined $v and not just $v because version objects leak memory
      # in boolean context -- dagolden, 2012-02-03
      if ( defined $v ) {
        return $v->is_qv ? $v->normal : $element;
      }
      else {
        return 0;
      }
    }
    
    sub _bad_version_hook {
      my ($v) = @_;
      $v =~ s{[a-z]+$}{}; # strip trailing alphabetics
      my $vobj = eval { version->parse($v) };
      return defined($vobj) ? $vobj : version->parse(0); # or give up
    }
    
    sub _version_map {
      my ($element) = @_;
      return unless defined $element;
      if ( ref $element eq 'HASH' ) {
        # XXX turn this into CPAN::Meta::Requirements with bad version hook
        # and then turn it back into a hash
        my $new_map = CPAN::Meta::Requirements->new(
          { bad_version_hook => sub { version->new(0) } } # punt
        );
        while ( my ($k,$v) = each %$element ) {
          next unless _is_module_name($k);
          if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>'  ) {
            $v = 0;
          }
          # some weird, old META have bad yml with module => module
          # so check if value is like a module name and not like a version
          if ( _is_module_name($v) && ! version::is_lax($v) ) {
            $new_map->add_minimum($k => 0);
            $new_map->add_minimum($v => 0);
          }
          $new_map->add_string_requirement($k => $v);
        }
        return $new_map->as_string_hash;
      }
      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)) || {};
    
      my $test_req  = CPAN::Meta::Requirements->from_string_hash($test_h);
      my $build_req = CPAN::Meta::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 scalar _version_map($prereqs->{$phase}{$type});
    }
    
    sub _downgrade_optional_features {
      my (undef, undef, $meta) = @_;
      return 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 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 }
      },
      repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
      ':custom'  => \&_prefix_custom,
    };
    
    sub _upgrade_resources_2 {
      my (undef, undef, $meta, $version) = @_;
      return 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 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 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 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'  => \&_no_prefix_ucfirst_custom,
    };
    
    sub _downgrade_resources {
      my (undef, undef, $meta, $version) = @_;
      return 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 => \&_keep,
    };
    
    my $provides_spec_2 = {
      file => \&_keep,
      version => \&_keep,
      ':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);
        $new_data->{$k}{version} = _clean_version($element->{$k}{version})
          if exists $element->{$k}{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;
    
    # ABSTRACT: Convert CPAN distribution metadata structures
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta::Converter - Convert CPAN distribution metadata structures
    
    =head1 VERSION
    
    version 2.132510
    
    =head1 SYNOPSIS
    
      my $struct = decode_json_file('META.json');
    
      my $cmc = CPAN::Meta::Converter->new( $struct );
    
      my $new_struct = $cmc->convert( version => "2" );
    
    =head1 DESCRIPTION
    
    This module converts CPAN Meta structures from one form to another.  The
    primary use is to convert older structures to the most modern version of
    the specification, but other transformations may be implemented in the
    future as needed.  (E.g. stripping all custom fields or stripping all
    optional fields.)
    
    =head1 METHODS
    
    =head2 new
    
      my $cmc = CPAN::Meta::Converter->new( $struct );
    
    The constructor should be passed a valid metadata structure but invalid
    structures are accepted.  If no meta-spec version is provided, version 1.0 will
    be assumed.
    
    =head2 convert
    
      my $new_struct = $cmc->convert( version => "2" );
    
    Returns a new hash reference with the metadata converted to a different form.
    C<convert> will die if any conversion/standardization still results in an
    invalid structure.
    
    Valid parameters include:
    
    =over
    
    =item *
    
    C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
    Defaults to the latest version of the CPAN Meta Spec.
    
    =back
    
    Conversion proceeds through each version in turn.  For example, a version 1.2
    structure might be converted to 1.3 then 1.4 then finally to version 2. The
    conversion process attempts to clean-up simple errors and standardize data.
    For example, if C<author> is given as a scalar, it will converted to an array
    reference containing the item. (Converting a structure to its own version will
    also clean-up and standardize.)
    
    When data are cleaned and standardized, missing or invalid fields will be
    replaced with sensible defaults when possible.  This may be lossy or imprecise.
    For example, some badly structured META.yml files on CPAN have prerequisite
    modules listed as both keys and values:
    
      requires => { 'Foo::Bar' => 'Bam::Baz' }
    
    These would be split and each converted to a prerequisite with a minimum
    version of zero.
    
    When some mandatory fields are missing or invalid, the conversion will attempt
    to provide a sensible default or will fill them with a value of 'unknown'.  For
    example a missing or unrecognized C<license> field will result in a C<license>
    field of 'unknown'.  Fields that may get an 'unknown' include:
    
    =over 4
    
    =item *
    
    abstract
    
    =item *
    
    author
    
    =item *
    
    license
    
    =back
    
    =head1 BUGS
    
    Please report any bugs or feature using the CPAN Request Tracker.
    Bugs can be submitted through the web interface at
    L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
    
    When submitting a bug or request, please include a test-file or a patch to an
    existing test-file that illustrates the bug or desired feature.
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META_CONVERTER
  
  $fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
    use 5.006;
    use strict;
    use warnings;
    package CPAN::Meta::Feature;
    our $VERSION = '2.132510'; # VERSION
    
    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;
    
    # ABSTRACT: an optional feature provided by a CPAN distribution
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
    
    =head1 VERSION
    
    version 2.132510
    
    =head1 DESCRIPTION
    
    A CPAN::Meta::Feature object describes an optional feature offered by a CPAN
    distribution and specified in the distribution's F<META.json> (or F<META.yml>)
    file.
    
    For the most part, this class will only be used when operating on the result of
    the C<feature> or C<features> methods on a L<CPAN::Meta> object.
    
    =head1 METHODS
    
    =head2 new
    
      my $feature = CPAN::Meta::Feature->new( $identifier => \%spec );
    
    This returns a new Feature object.  The C<%spec> argument to the constructor
    should be the same as the value of the C<optional_feature> entry in the
    distmeta.  It must contain entries for C<description> and C<prereqs>.
    
    =head2 identifier
    
    This method returns the feature's identifier.
    
    =head2 description
    
    This method returns the feature's long description.
    
    =head2 prereqs
    
    This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs>
    object.
    
    =head1 BUGS
    
    Please report any bugs or feature using the CPAN Request Tracker.
    Bugs can be submitted through the web interface at
    L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
    
    When submitting a bug or request, please include a test-file or a patch to an
    existing test-file that illustrates the bug or desired feature.
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  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;
    our $VERSION = '2.132510'; # VERSION
    
    1;
    
    # ABSTRACT: history of CPAN Meta Spec changes
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta::History - history of CPAN Meta Spec changes
    
    =head1 VERSION
    
    version 2.132510
    
    =head1 DESCRIPTION
    
    The CPAN Meta Spec has gone through several iterations.  It was
    originally written in HTML and later revised into POD (though published
    in HTML generated from the POD).  Fields were added, removed or changed,
    sometimes by design and sometimes to reflect real-world usage after the
    fact.
    
    This document reconstructs the history of the CPAN Meta Spec based on
    change logs, repository commit messages and the published HTML files.
    In some cases, particularly prior to version 1.2, the exact version
    when certain fields were introduced or changed is inconsistent between
    sources.  When in doubt, the published HTML files for versions 1.0 to
    1.4 as they existed when version 2 was developed are used as the
    definitive source.
    
    Starting with version 2, the specification document is part of the
    CPAN-Meta distribution and will be published on CPAN as
    L<CPAN::Meta::Spec>.
    
    Going forward, specification version numbers will be integers and
    decimal portions will correspond to a release date for the CPAN::Meta
    library.
    
    =head1 HISTORY
    
    =head2 Version 2
    
    April 2010
    
    =over
    
    =item *
    
    Revised spec examples as perl data structures rather than YAML
    
    =item *
    
    Switched to JSON serialization from YAML
    
    =item *
    
    Specified allowed version number formats
    
    =item *
    
    Replaced 'requires', 'build_requires', 'configure_requires',
    'recommends' and 'conflicts' with new 'prereqs' data structure divided
    by I<phase> (configure, build, test, runtime, etc.) and I<relationship>
    (requires, recommends, suggests, conflicts)
    
    =item *
    
    Added support for 'develop' phase for requirements for maintaining
    a list of authoring tools
    
    =item *
    
    Changed 'license' to a list and revised the set of valid licenses
    
    =item *
    
    Made 'dynamic_config' mandatory to reduce confusion
    
    =item *
    
    Changed 'resources' subkey 'repository' to a hash that clarifies
    repository type, url for browsing and url for checkout
    
    =item *
    
    Changed 'resources' subkey 'bugtracker' to a hash for either web
    or mailto resource
    
    =item *
    
    Changed specification of 'optional_features':
    
    =over
    
    =item *
    
    Added formal specification and usage guide instead of just example
    
    =item *
    
    Changed to use new prereqs data structure instead of individual keys
    
    =back
    
    =item *
    
    Clarified intended use of 'author' as generalized contact list
    
    =item *
    
    Added 'release_status' field to indicate stable, testing or unstable
    status to provide hints to indexers
    
    =item *
    
    Added 'description' field for a longer description of the distribution
    
    =item *
    
    Formalized use of "x_" or "X_" for all custom keys not listed in the
    official spec
    
    =back
    
    =head2 Version 1.4
    
    June 2008
    
    =over
    
    =item *
    
    Noted explicit support for 'perl' in prerequisites
    
    =item *
    
    Added 'configure_requires' prerequisite type
    
    =item *
    
    Changed 'optional_features'
    
    =over
    
    =item *
    
    Example corrected to show map of maps instead of list of maps
    (though descriptive text said 'map' even in v1.3)
    
    =item *
    
    Removed 'requires_packages', 'requires_os' and 'excluded_os'
    as valid subkeys
    
    =back
    
    =back
    
    =head2 Version 1.3
    
    November 2006
    
    =over
    
    =item *
    
    Added 'no_index' subkey 'directory' and removed 'dir' to match actual
    usage in the wild
    
    =item *
    
    Added a 'repository' subkey to 'resources'
    
    =back
    
    =head2 Version 1.2
    
    August 2005
    
    =over
    
    =item *
    
    Re-wrote and restructured spec in POD syntax
    
    =item *
    
    Changed 'name' to be mandatory
    
    =item *
    
    Changed 'generated_by' to be mandatory
    
    =item *
    
    Changed 'license' to be mandatory
    
    =item *
    
    Added version range specifications for prerequisites
    
    =item *
    
    Added required 'abstract' field
    
    =item *
    
    Added required 'author' field
    
    =item *
    
    Added required 'meta-spec' field to define 'version' (and 'url') of the
    CPAN Meta Spec used for metadata
    
    =item *
    
    Added 'provides' field
    
    =item *
    
    Added 'no_index' field and deprecated 'private' field.  'no_index'
    subkeys include 'file', 'dir', 'package' and 'namespace'
    
    =item *
    
    Added 'keywords' field
    
    =item *
    
    Added 'resources' field with subkeys 'homepage', 'license', and
    'bugtracker'
    
    =item *
    
    Added 'optional_features' field as an alternate under 'recommends'.
    Includes 'description', 'requires', 'build_requires', 'conflicts',
    'requires_packages', 'requires_os' and 'excluded_os' as valid subkeys
    
    =item *
    
    Removed 'license_uri' field
    
    =back
    
    =head2 Version 1.1
    
    May 2003
    
    =over
    
    =item *
    
    Changed 'version' to be mandatory
    
    =item *
    
    Added 'private' field
    
    =item *
    
    Added 'license_uri' field
    
    =back
    
    =head2 Version 1.0
    
    March 2003
    
    =over
    
    =item *
    
    Original release (in HTML format only)
    
    =item *
    
    Included 'name', 'version', 'license', 'distribution_type', 'requires',
    'recommends', 'build_requires', 'conflicts', 'dynamic_config',
    'generated_by'
    
    =back
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META_HISTORY
  
  $fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
    use 5.006;
    use strict;
    use warnings;
    package CPAN::Meta::Prereqs;
    our $VERSION = '2.132510'; # VERSION
    
    
    use Carp qw(confess);
    use Scalar::Util qw(blessed);
    use CPAN::Meta::Requirements 2.121;
    
    
    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} = CPAN::Meta::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} ||= CPAN::Meta::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 = CPAN::Meta::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;
    
    # ABSTRACT: a set of distribution prerequisites by phase and type
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
    
    =head1 VERSION
    
    version 2.132510
    
    =head1 DESCRIPTION
    
    A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN
    distribution or one of its optional features.  Each set of prereqs is
    organized by phase and type, as described in L<CPAN::Meta::Prereqs>.
    
    =head1 METHODS
    
    =head2 new
    
      my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec );
    
    This method returns a new set of Prereqs.  The input should look like the
    contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning
    something more or less like this:
    
      my $prereq = CPAN::Meta::Prereqs->new({
        runtime => {
          requires => {
            'Some::Module' => '1.234',
            ...,
          },
          ...,
        },
        ...,
      });
    
    You can also construct an empty set of prereqs with:
    
      my $prereqs = CPAN::Meta::Prereqs->new;
    
    This empty set of prereqs is useful for accumulating new prereqs before finally
    dumping the whole set into a structure or string.
    
    =head2 requirements_for
    
      my $requirements = $prereqs->requirements_for( $phase, $type );
    
    This method returns a L<CPAN::Meta::Requirements> object for the given
    phase/type combination.  If no prerequisites are registered for that
    combination, a new CPAN::Meta::Requirements object will be returned, and it may
    be added to as needed.
    
    If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
    be raised.
    
    =head2 with_merged_prereqs
    
      my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
    
      my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs );
    
    This method returns a new CPAN::Meta::Prereqs objects in which all the
    other prerequisites given are merged into the current set.  This is primarily
    provided for combining a distribution's core prereqs with the prereqs of one of
    its optional features.
    
    The new prereqs object has no ties to the originals, and altering it further
    will not alter them.
    
    =head2 as_string_hash
    
    This method returns a hashref containing structures suitable for dumping into a
    distmeta data structure.  It is made up of hashes and strings, only; there will
    be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it.
    
    =head2 is_finalized
    
    This method returns true if the set of prereqs has been marked "finalized," and
    cannot be altered.
    
    =head2 finalize
    
    Calling C<finalize> on a Prereqs object will close it for further modification.
    Attempting to make any changes that would actually alter the prereqs will
    result in an exception being thrown.
    
    =head2 clone
    
      my $cloned_prereqs = $prereqs->clone;
    
    This method returns a Prereqs object that is identical to the original object,
    but can be altered without affecting the original object.  Finalization does
    not survive cloning, meaning that you may clone a finalized set of prereqs and
    then modify the clone.
    
    =head1 BUGS
    
    Please report any bugs or feature using the CPAN Request Tracker.
    Bugs can be submitted through the web interface at
    L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
    
    When submitting a bug or request, please include a test-file or a patch to an
    existing test-file that illustrates the bug or desired feature.
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META_PREREQS
  
  $fatpacked{"CPAN/Meta/Requirements.pm"} = <<'CPAN_META_REQUIREMENTS';
    use strict;
    use warnings;
    package CPAN::Meta::Requirements;
    our $VERSION = '2.123'; # VERSION
    # ABSTRACT: a set of version requirements for a CPAN dist
    
    
    use Carp ();
    use Scalar::Util ();
    use version 0.77 (); # the ->parse method
    
    
    my @valid_options = qw( bad_version_hook );
    
    sub new {
      my ($class, $options) = @_;
      $options ||= {};
      Carp::croak "Argument to $class\->new() must be a hash reference"
        unless ref $options eq 'HASH';
      my %self = map {; $_ => $options->{$_}} @valid_options;
    
      return bless \%self => $class;
    }
    
    sub _version_object {
      my ($self, $version) = @_;
    
      my $vobj;
    
      eval {
        $vobj  = (! defined $version)                ? version->parse(0)
               : (! Scalar::Util::blessed($version)) ? version->parse($version)
               :                                       $version;
      };
    
      if ( my $err = $@ ) {
        my $hook = $self->{bad_version_hook};
        $vobj = eval { $hook->($version) }
          if ref $hook eq 'CODE';
        unless (Scalar::Util::blessed($vobj) && $vobj->isa("version")) {
          $err =~ s{ at .* line \d+.*$}{};
          die "Can't convert '$version': $err";
        }
      }
    
      # ensure no leading '.'
      if ( $vobj =~ m{\A\.} ) {
        $vobj = version->parse("0$vobj");
      }
    
      # ensure normal v-string form
      if ( $vobj->is_qv ) {
        $vobj = version->parse($vobj->normal);
      }
    
      return $vobj;
    }
    
    
    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 requirements_for_module {
      my ($self, $module) = @_;
      my $entry = $self->__entry_for($module);
      return unless $entry;
      return $entry->as_string;
    }
    
    
    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 || 'CPAN::Meta::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 add_string_requirement {
      my ($self, $module, $req) = @_;
    
      Carp::confess("No requirement string provided for $module")
        unless defined $req && length $req;
    
      my @parts = split qr{\s*,\s*}, $req;
    
    
      for my $part (@parts) {
        my ($op, $ver) = $part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z};
    
        if (! defined $op) {
          $self->add_minimum($module => $part);
        } else {
          Carp::confess("illegal requirement string: $req")
            unless my $methods = $methods_for_op{ $op };
    
          $self->$_($module => $ver) for @$methods;
        }
      }
    }
    
    
    sub from_string_hash {
      my ($class, $hash) = @_;
    
      my $self = $class->new;
    
      for my $module (keys %$hash) {
        my $req = $hash->{$module};
        unless ( defined $req && length $req ) {
          $req = 0;
          Carp::carp("Undefined requirement for $module treated as '0'");
        }
        $self->add_string_requirement($module, $req);
      }
    
      return $self;
    }
    
    ##############################################################
    
    {
      package
        CPAN::Meta::Requirements::_Range::Exact;
      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
        CPAN::Meta::Requirements::_Range::Range;
    
      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 CPAN::Meta::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 CPAN::Meta::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;
    # vim: ts=2 sts=2 sw=2 et:
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta::Requirements - a set of version requirements for a CPAN dist
    
    =head1 VERSION
    
    version 2.123
    
    =head1 SYNOPSIS
    
      use CPAN::Meta::Requirements;
    
      my $build_requires = CPAN::Meta::Requirements->new;
    
      $build_requires->add_minimum('Library::Foo' => 1.208);
    
      $build_requires->add_minimum('Library::Foo' => 2.602);
    
      $build_requires->add_minimum('Module::Bar'  => 'v1.2.3');
    
      $METAyml->{build_requires} = $build_requires->as_string_hash;
    
    =head1 DESCRIPTION
    
    A CPAN::Meta::Requirements object models a set of version constraints like
    those specified in the F<META.yml> or F<META.json> files in CPAN distributions.
    It can be built up by adding more and more constraints, and it will reduce them
    to the simplest representation.
    
    Logically impossible constraints will be identified immediately by thrown
    exceptions.
    
    =head1 METHODS
    
    =head2 new
    
      my $req = CPAN::Meta::Requirements->new;
    
    This returns a new CPAN::Meta::Requirements object.  It takes an optional
    hash reference argument.  The following keys are supported:
    
    =over 4
    
    =item *
    
    <bad_version_hook> -- if provided, when a version cannot be parsed into
    
    a version object, this code reference will be called with the invalid version
    string as an argument.  It must return a valid version object.
    
    =back
    
    All other keys are ignored.
    
    =head2 add_minimum
    
      $req->add_minimum( $module => $version );
    
    This adds a new minimum version requirement.  If the new requirement is
    redundant to the existing specification, this has no effect.
    
    Minimum requirements are inclusive.  C<$version> is required, along with any
    greater version number.
    
    This method returns the requirements object.
    
    =head2 add_maximum
    
      $req->add_maximum( $module => $version );
    
    This adds a new maximum version requirement.  If the new requirement is
    redundant to the existing specification, this has no effect.
    
    Maximum requirements are inclusive.  No version strictly greater than the given
    version is allowed.
    
    This method returns the requirements object.
    
    =head2 add_exclusion
    
      $req->add_exclusion( $module => $version );
    
    This adds a new excluded version.  For example, you might use these three
    method calls:
    
      $req->add_minimum( $module => '1.00' );
      $req->add_maximum( $module => '1.82' );
    
      $req->add_exclusion( $module => '1.75' );
    
    Any version between 1.00 and 1.82 inclusive would be acceptable, except for
    1.75.
    
    This method returns the requirements object.
    
    =head2 exact_version
    
      $req->exact_version( $module => $version );
    
    This sets the version required for the given module to I<exactly> the given
    version.  No other version would be considered acceptable.
    
    This method returns the requirements object.
    
    =head2 add_requirements
    
      $req->add_requirements( $another_req_object );
    
    This method adds all the requirements in the given CPAN::Meta::Requirements object
    to the requirements object on which it was called.  If there are any conflicts,
    an exception is thrown.
    
    This method returns the requirements object.
    
    =head2 accepts_module
    
      my $bool = $req->accepts_modules($module => $version);
    
    Given an module and version, this method returns true if the version
    specification for the module accepts the provided version.  In other words,
    given:
    
      Module => '>= 1.00, < 2.00'
    
    We will accept 1.00 and 1.75 but not 0.50 or 2.00.
    
    For modules that do not appear in the requirements, this method will return
    true.
    
    =head2 clear_requirement
    
      $req->clear_requirement( $module );
    
    This removes the requirement for a given module from the object.
    
    This method returns the requirements object.
    
    =head2 requirements_for_module
    
      $req->requirements_for_module( $module );
    
    This returns a string containing the version requirements for a given module in
    the format described in L<CPAN::Meta::Spec> or undef if the given module has no
    requirements. This should only be used for informational purposes such as error
    messages and should not be interpreted or used for comparison (see
    L</accepts_module> instead.)
    
    =head2 required_modules
    
    This method returns a list of all the modules for which requirements have been
    specified.
    
    =head2 clone
    
      $req->clone;
    
    This method returns a clone of the invocant.  The clone and the original object
    can then be changed independent of one another.
    
    =head2 is_simple
    
    This method returns true if and only if all requirements are inclusive minimums
    -- that is, if their string expression is just the version number.
    
    =head2 is_finalized
    
    This method returns true if the requirements have been finalized by having the
    C<finalize> method called on them.
    
    =head2 finalize
    
    This method marks the requirements finalized.  Subsequent attempts to change
    the requirements will be fatal, I<if> they would result in a change.  If they
    would not alter the requirements, they have no effect.
    
    If a finalized set of requirements is cloned, the cloned requirements are not
    also finalized.
    
    =head2 as_string_hash
    
    This returns a reference to a hash describing the requirements using the
    strings in the F<META.yml> specification.
    
    For example after the following program:
    
      my $req = CPAN::Meta::Requirements->new;
    
      $req->add_minimum('CPAN::Meta::Requirements' => 0.102);
    
      $req->add_minimum('Library::Foo' => 1.208);
    
      $req->add_maximum('Library::Foo' => 2.602);
    
      $req->add_minimum('Module::Bar'  => 'v1.2.3');
    
      $req->add_exclusion('Module::Bar'  => 'v1.2.8');
    
      $req->exact_version('Xyzzy'  => '6.01');
    
      my $hashref = $req->as_string_hash;
    
    C<$hashref> would contain:
    
      {
        'CPAN::Meta::Requirements' => '0.102',
        'Library::Foo' => '>= 1.208, <= 2.206',
        'Module::Bar'  => '>= v1.2.3, != v1.2.8',
        'Xyzzy'        => '== 6.01',
      }
    
    =head2 add_string_requirement
    
      $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206');
    
    This method parses the passed in string and adds the appropriate requirement
    for the given module.  It understands version ranges as described in the
    L<CPAN::Meta::Spec/Version Ranges>. For example:
    
    =over 4
    
    =item 1.3
    
    =item >= 1.3
    
    =item <= 1.3
    
    =item == 1.3
    
    =item != 1.3
    
    =item > 1.3
    
    =item < 1.3
    
    =item >= 1.3, != 1.5, <= 2.0
    
    A version number without an operator is equivalent to specifying a minimum
    (C<E<gt>=>).  Extra whitespace is allowed.
    
    =back
    
    =head2 from_string_hash
    
      my $req = CPAN::Meta::Requirements->from_string_hash( \%hash );
    
    This is an alternate constructor for a CPAN::Meta::Requirements object.  It takes
    a hash of module names and version requirement strings and returns a new
    CPAN::Meta::Requirements object.
    
    =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
    
    =head1 SUPPORT
    
    =head2 Bugs / Feature Requests
    
    Please report any bugs or feature requests through the issue tracker
    at L<https://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta-Requirements>.
    You will be notified automatically of any progress on your issue.
    
    =head2 Source Code
    
    This is open source software.  The code repository is available for
    public review and contribution under the terms of the license.
    
    L<https://github.com/dagolden/cpan-meta-requirements>
    
      git clone git://github.com/dagolden/cpan-meta-requirements.git
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META_REQUIREMENTS
  
  $fatpacked{"CPAN/Meta/Spec.pm"} = <<'CPAN_META_SPEC';
    # XXX RULES FOR PATCHING THIS FILE XXX
    # Patches that fix typos or formatting are acceptable.  Patches
    # that change semantics are not acceptable without prior approval
    # by David Golden or Ricardo Signes.
    
    use 5.006;
    use strict;
    use warnings;
    package CPAN::Meta::Spec;
    our $VERSION = '2.132510'; # VERSION
    
    1;
    
    # ABSTRACT: specification for CPAN distribution metadata
    
    
    # vi:tw=72
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta::Spec - specification for CPAN distribution metadata
    
    =head1 VERSION
    
    version 2.132510
    
    =head1 SYNOPSIS
    
      my $distmeta = {
        name => 'Module-Build',
        abstract => 'Build and install Perl modules',
        description =>  "Module::Build is a system for "
          . "building, testing, and installing Perl modules. "
          . "It is meant to ... blah blah blah ...",
        version  => '0.36',
        release_status => 'stable',
        author   => [
          'Ken Williams <kwilliams@cpan.org>',
          'Module-Build List <module-build@perl.org>', # additional contact
        ],
        license  => [ 'perl_5' ],
        prereqs => {
          runtime => {
            requires => {
              'perl'   => '5.006',
              'ExtUtils::Install' => '0',
              'File::Basename' => '0',
              'File::Compare'  => '0',
              'IO::File'   => '0',
            },
            recommends => {
              'Archive::Tar' => '1.00',
              'ExtUtils::Install' => '0.3',
              'ExtUtils::ParseXS' => '2.02',
            },
          },
          build => {
            requires => {
              'Test::More' => '0',
            },
          }
        },
        resources => {
          license => ['http://dev.perl.org/licenses/'],
        },
        optional_features => {
          domination => {
            description => 'Take over the world',
            prereqs     => {
              develop => { requires => { 'Genius::Evil'     => '1.234' } },
              runtime => { requires => { 'Machine::Weather' => '2.0'   } },
            },
          },
        },
        dynamic_config => 1,
        keywords => [ qw/ toolchain cpan dual-life / ],
        'meta-spec' => {
          version => '2',
          url     => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
        },
        generated_by => 'Module::Build version 0.36',
      };
    
    =head1 DESCRIPTION
    
    This document describes version 2 of the CPAN distribution metadata
    specification, also known as the "CPAN Meta Spec".
    
    Revisions of this specification for typo corrections and prose
    clarifications may be issued as CPAN::Meta::Spec 2.I<x>.  These
    revisions will never change semantics or add or remove specified
    behavior.
    
    Distribution metadata describe important properties of Perl
    distributions. Distribution building tools like Module::Build,
    Module::Install, ExtUtils::MakeMaker or Dist::Zilla should create a
    metadata file in accordance with this specification and include it with
    the distribution for use by automated tools that index, examine, package
    or install Perl distributions.
    
    =head1 TERMINOLOGY
    
    =over 4
    
    =item distribution
    
    This is the primary object described by the metadata. In the context of
    this document it usually refers to a collection of modules, scripts,
    and/or documents that are distributed together for other developers to
    use.  Examples of distributions are C<Class-Container>, C<libwww-perl>,
    or C<DBI>.
    
    =item module
    
    This refers to a reusable library of code contained in a single file.
    Modules usually contain one or more packages and are often referred
    to by the name of a primary package that can be mapped to the file
    name. For example, one might refer to C<File::Spec> instead of
    F<File/Spec.pm>
    
    =item package
    
    This refers to a namespace declared with the Perl C<package> statement.
    In Perl, packages often have a version number property given by the
    C<$VERSION> variable in the namespace.
    
    =item consumer
    
    This refers to code that reads a metadata file, deserializes it into a
    data structure in memory, or interprets a data structure of metadata
    elements.
    
    =item producer
    
    This refers to code that constructs a metadata data structure,
    serializes into a bytestream and/or writes it to disk.
    
    =item must, should, may, etc.
    
    These terms are interpreted as described in IETF RFC 2119.
    
    =back
    
    =head1 DATA TYPES
    
    Fields in the L</STRUCTURE> section describe data elements, each of
    which has an associated data type as described herein.  There are four
    primitive types: Boolean, String, List and Map.  Other types are
    subtypes of primitives and define compound data structures or define
    constraints on the values of a data element.
    
    =head2 Boolean
    
    A I<Boolean> is used to provide a true or false value.  It B<must> be
    represented as a defined value.
    
    =head2 String
    
    A I<String> is data element containing a non-zero length sequence of
    Unicode characters, such as an ordinary Perl scalar that is not a
    reference.
    
    =head2 List
    
    A I<List> is an ordered collection of zero or more data elements.
    Elements of a List may be of mixed types.
    
    Producers B<must> represent List elements using a data structure which
    unambiguously indicates that multiple values are possible, such as a
    reference to a Perl array (an "arrayref").
    
    Consumers expecting a List B<must> consider a String as equivalent to a
    List of length 1.
    
    =head2 Map
    
    A I<Map> is an unordered collection of zero or more data elements
    ("values"), indexed by associated String elements ("keys").  The Map's
    value elements may be of mixed types.
    
    =head2 License String
    
    A I<License String> is a subtype of String with a restricted set of
    values.  Valid values are described in detail in the description of
    the L</license> field.
    
    =head2 URL
    
    I<URL> is a subtype of String containing a Uniform Resource Locator or
    Identifier.  [ This type is called URL and not URI for historical reasons. ]
    
    =head2 Version
    
    A I<Version> is a subtype of String containing a value that describes
    the version number of packages or distributions.  Restrictions on format
    are described in detail in the L</Version Formats> section.
    
    =head2 Version Range
    
    The I<Version Range> type is a subtype of String.  It describes a range
    of Versions that may be present or installed to fulfill prerequisites.
    It is specified in detail in the L</Version Ranges> section.
    
    =head1 STRUCTURE
    
    The metadata structure is a data element of type Map.  This section
    describes valid keys within the Map.
    
    Any keys not described in this specification document (whether top-level
    or within compound data structures described herein) are considered
    I<custom keys> and B<must> begin with an "x" or "X" and be followed by an
    underscore; i.e. they must match the pattern: C<< qr{\Ax_}i >>.  If a
    custom key refers to a compound data structure, subkeys within it do not
    need an "x_" or "X_" prefix.
    
    Consumers of metadata may ignore any or all custom keys.  All other keys
    not described herein are invalid and should be ignored by consumers.
    Producers must not generate or output invalid keys.
    
    For each key, an example is provided followed by a description.  The
    description begins with the version of spec in which the key was added
    or in which the definition was modified, whether the key is I<required>
    or I<optional> and the data type of the corresponding data element.
    These items are in parentheses, brackets and braces, respectively.
    
    If a data type is a Map or Map subtype, valid subkeys will be described
    as well.
    
    Some fields are marked I<Deprecated>.  These are shown for historical
    context and must not be produced in or consumed from any metadata structure
    of version 2 or higher.
    
    =head2 REQUIRED FIELDS
    
    =head3 abstract
    
    Example:
    
      abstract => 'Build and install Perl modules'
    
    (Spec 1.2) [required] {String}
    
    This is a short description of the purpose of the distribution.
    
    =head3 author
    
    Example:
    
      author => [ 'Ken Williams <kwilliams@cpan.org>' ]
    
    (Spec 1.2) [required] {List of one or more Strings}
    
    This List indicates the person(s) to contact concerning the
    distribution. The preferred form of the contact string is:
    
      contact-name <email-address>
    
    This field provides a general contact list independent of other
    structured fields provided within the L</resources> field, such as
    C<bugtracker>.  The addressee(s) can be contacted for any purpose
    including but not limited to (security) problems with the distribution,
    questions about the distribution or bugs in the distribution.
    
    A distribution's original author is usually the contact listed within
    this field.  Co-maintainers, successor maintainers or mailing lists
    devoted to the distribution may also be listed in addition to or instead
    of the original author.
    
    =head3 dynamic_config
    
    Example:
    
      dynamic_config => 1
    
    (Spec 2) [required] {Boolean}
    
    A boolean flag indicating whether a F<Build.PL> or F<Makefile.PL> (or
    similar) must be executed to determine prerequisites.
    
    This field should be set to a true value if the distribution performs
    some dynamic configuration (asking questions, sensing the environment,
    etc.) as part of its configuration.  This field should be set to a false
    value to indicate that prerequisites included in metadata may be
    considered final and valid for static analysis.
    
    This field explicitly B<does not> indicate whether installation may be
    safely performed without using a Makefile or Build file, as there may be
    special files to install or custom installation targets (e.g. for
    dual-life modules that exist on CPAN as well as in the Perl core).  This
    field only defines whether prerequisites are complete as given in the
    metadata.
    
    =head3 generated_by
    
    Example:
    
      generated_by => 'Module::Build version 0.36'
    
    (Spec 1.0) [required] {String}
    
    This field indicates the tool that was used to create this metadata.
    There are no defined semantics for this field, but it is traditional to
    use a string in the form "Generating::Package version 1.23" or the
    author's name, if the file was generated by hand.
    
    =head3 license
    
    Example:
    
      license => [ 'perl_5' ]
    
      license => [ 'apache_2', 'mozilla_1_0' ]
    
    (Spec 2) [required] {List of one or more License Strings}
    
    One or more licenses that apply to some or all of the files in the
    distribution.  If multiple licenses are listed, the distribution
    documentation should be consulted to clarify the interpretation of
    multiple licenses.
    
    The following list of license strings are valid:
    
     string          description
     -------------   -----------------------------------------------
     agpl_3          GNU Affero General Public License, Version 3
     apache_1_1      Apache Software License, Version 1.1
     apache_2_0      Apache License, Version 2.0
     artistic_1      Artistic License, (Version 1)
     artistic_2      Artistic License, Version 2.0
     bsd             BSD License (three-clause)
     freebsd         FreeBSD License (two-clause)
     gfdl_1_2        GNU Free Documentation License, Version 1.2
     gfdl_1_3        GNU Free Documentation License, Version 1.3
     gpl_1           GNU General Public License, Version 1
     gpl_2           GNU General Public License, Version 2
     gpl_3           GNU General Public License, Version 3
     lgpl_2_1        GNU Lesser General Public License, Version 2.1
     lgpl_3_0        GNU Lesser General Public License, Version 3.0
     mit             MIT (aka X11) License
     mozilla_1_0     Mozilla Public License, Version 1.0
     mozilla_1_1     Mozilla Public License, Version 1.1
     openssl         OpenSSL License
     perl_5          The Perl 5 License (Artistic 1 & GPL 1 or later)
     qpl_1_0         Q Public License, Version 1.0
     ssleay          Original SSLeay License
     sun             Sun Internet Standards Source License (SISSL)
     zlib            zlib License
    
    The following license strings are also valid and indicate other
    licensing not described above:
    
     string          description
     -------------   -----------------------------------------------
     open_source     Other Open Source Initiative (OSI) approved license
     restricted      Requires special permission from copyright holder
     unrestricted    Not an OSI approved license, but not restricted
     unknown         License not provided in metadata
    
    All other strings are invalid in the license field.
    
    =head3 meta-spec
    
    Example:
    
      'meta-spec' => {
        version => '2',
        url     => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
      }
    
    (Spec 1.2) [required] {Map}
    
    This field indicates the version of the CPAN Meta Spec that should be
    used to interpret the metadata.  Consumers must check this key as soon
    as possible and abort further metadata processing if the meta-spec
    version is not supported by the consumer.
    
    The following keys are valid, but only C<version> is required.
    
    =over
    
    =item version
    
    This subkey gives the integer I<Version> of the CPAN Meta Spec against
    which the document was generated.
    
    =item url
    
    This is a I<URL> of the metadata specification document corresponding to
    the given version.  This is strictly for human-consumption and should
    not impact the interpretation of the document.
    
    =back
    
    =head3 name
    
    Example:
    
      name => 'Module-Build'
    
    (Spec 1.0) [required] {String}
    
    This field is the name of the distribution.  This is often created by
    taking the "main package" in the distribution and changing C<::> to
    C<->, but the name may be completely unrelated to the packages within
    the distribution.  C.f. L<http://search.cpan.org/dist/libwww-perl/>.
    
    =head3 release_status
    
    Example:
    
      release_status => 'stable'
    
    (Spec 2) [required] {String}
    
    This field provides the  release status of this distribution.  If the
    C<version> field contains an underscore character, then
    C<release_status> B<must not> be "stable."
    
    The C<release_status> field B<must> have one of the following values:
    
    =over
    
    =item stable
    
    This indicates an ordinary, "final" release that should be indexed by PAUSE
    or other indexers.
    
    =item testing
    
    This indicates a "beta" release that is substantially complete, but has an
    elevated risk of bugs and requires additional testing.  The distribution
    should not be installed over a stable release without an explicit request
    or other confirmation from a user.  This release status may also be used
    for "release candidate" versions of a distribution.
    
    =item unstable
    
    This indicates an "alpha" release that is under active development, but has
    been released for early feedback or testing and may be missing features or
    may have serious bugs.  The distribution should not be installed over a
    stable release without an explicit request or other confirmation from a
    user.
    
    =back
    
    Consumers B<may> use this field to determine how to index the
    distribution for CPAN or other repositories in addition to or in
    replacement of heuristics based on version number or file name.
    
    =head3 version
    
    Example:
    
      version => '0.36'
    
    (Spec 1.0) [required] {Version}
    
    This field gives the version of the distribution to which the metadata
    structure refers.
    
    =head2 OPTIONAL FIELDS
    
    =head3 description
    
    Example:
    
        description =>  "Module::Build is a system for "
          . "building, testing, and installing Perl modules. "
          . "It is meant to ... blah blah blah ...",
    
    (Spec 2) [optional] {String}
    
    A longer, more complete description of the purpose or intended use of
    the distribution than the one provided by the C<abstract> key.
    
    =head3 keywords
    
    Example:
    
      keywords => [ qw/ toolchain cpan dual-life / ]
    
    (Spec 1.1) [optional] {List of zero or more Strings}
    
    A List of keywords that describe this distribution.  Keywords
    B<must not> include whitespace.
    
    =head3 no_index
    
    Example:
    
      no_index => {
        file      => [ 'My/Module.pm' ],
        directory => [ 'My/Private' ],
        package   => [ 'My::Module::Secret' ],
        namespace => [ 'My::Module::Sample' ],
      }
    
    (Spec 1.2) [optional] {Map}
    
    This Map describes any files, directories, packages, and namespaces that
    are private to the packaging or implementation of the distribution and
    should be ignored by indexing or search tools.
    
    Valid subkeys are as follows:
    
    =over
    
    =item file
    
    A I<List> of relative paths to files.  Paths B<must be> specified with
    unix conventions.
    
    =item directory
    
    A I<List> of relative paths to directories.  Paths B<must be> specified
    with unix conventions.
    
    [ Note: previous editions of the spec had C<dir> instead of C<directory> ]
    
    =item package
    
    A I<List> of package names.
    
    =item namespace
    
    A I<List> of package namespaces, where anything below the namespace
    must be ignored, but I<not> the namespace itself.
    
    In the example above for C<no_index>, C<My::Module::Sample::Foo> would
    be ignored, but C<My::Module::Sample> would not.
    
    =back
    
    =head3 optional_features
    
    Example:
    
      optional_features => {
        sqlite => {
          description => 'Provides SQLite support',
          prereqs => {
            runtime => {
              requires => {
                'DBD::SQLite' => '1.25'
              }
            }
          }
        }
      }
    
    (Spec 2) [optional] {Map}
    
    This Map describes optional features with incremental prerequisites.
    Each key of the C<optional_features> Map is a String used to identify
    the feature and each value is a Map with additional information about
    the feature.  Valid subkeys include:
    
    =over
    
    =item description
    
    This is a String describing the feature.  Every optional feature
    should provide a description
    
    =item prereqs
    
    This entry is required and has the same structure as that of the
    C<L</prereqs>> key.  It provides a list of package requirements
    that must be satisfied for the feature to be supported or enabled.
    
    There is one crucial restriction:  the prereqs of an optional feature
    B<must not> include C<configure> phase prereqs.
    
    =back
    
    Consumers B<must not> include optional features as prerequisites without
    explicit instruction from users (whether via interactive prompting,
    a function parameter or a configuration value, etc. ).
    
    If an optional feature is used by a consumer to add additional
    prerequisites, the consumer should merge the optional feature
    prerequisites into those given by the C<prereqs> key using the same
    semantics.  See L</Merging and Resolving Prerequisites> for details on
    merging prerequisites.
    
    I<Suggestion for disuse:> Because there is currently no way for a
    distribution to specify a dependency on an optional feature of another
    dependency, the use of C<optional_feature> is discouraged.  Instead,
    create a separate, installable distribution that ensures the desired
    feature is available.  For example, if C<Foo::Bar> has a C<Baz> feature,
    release a separate C<Foo-Bar-Baz> distribution that satisfies
    requirements for the feature.
    
    =head3 prereqs
    
    Example:
    
      prereqs => {
        runtime => {
          requires => {
            'perl'          => '5.006',
            'File::Spec'    => '0.86',
            'JSON'          => '2.16',
          },
          recommends => {
            'JSON::XS'      => '2.26',
          },
          suggests => {
            'Archive::Tar'  => '0',
          },
        },
        build => {
          requires => {
            'Alien::SDL'    => '1.00',
          },
        },
        test => {
          recommends => {
            'Test::Deep'    => '0.10',
          },
        }
      }
    
    (Spec 2) [optional] {Map}
    
    This is a Map that describes all the prerequisites of the distribution.
    The keys are phases of activity, such as C<configure>, C<build>, C<test>
    or C<runtime>.  Values are Maps in which the keys name the type of
    prerequisite relationship such as C<requires>, C<recommends>, or
    C<suggests> and the value provides a set of prerequisite relations.  The
    set of relations B<must> be specified as a Map of package names to
    version ranges.
    
    The full definition for this field is given in the L</Prereq Spec>
    section.
    
    =head3 provides
    
    Example:
    
      provides => {
        'Foo::Bar' => {
          file    => 'lib/Foo/Bar.pm',
          version => '0.27_02',
        },
        'Foo::Bar::Blah' => {
          file    => 'lib/Foo/Bar/Blah.pm',
        },
        'Foo::Bar::Baz' => {
          file    => 'lib/Foo/Bar/Baz.pm',
          version => '0.3',
        },
      }
    
    (Spec 1.2) [optional] {Map}
    
    This describes all packages provided by this distribution.  This
    information is used by distribution and automation mechanisms like
    PAUSE, CPAN, and search.cpan.org to build indexes saying in which
    distribution various packages can be found.
    
    The keys of C<provides> are package names that can be found within
    the distribution.  If a package name key is provided, it must
    have a Map with the following valid subkeys:
    
    =over
    
    =item file
    
    This field is required.  It must contain a Unix-style relative file path
    from the root of the distribution directory to a file that contains or
    generates the package.
    
    =item version
    
    If it exists, this field must contains a I<Version> String for the
    package.  If the package does not have a C<$VERSION>, this field must
    be omitted.
    
    =back
    
    =head3 resources
    
    Example:
    
      resources => {
        license     => [ 'http://dev.perl.org/licenses/' ],
        homepage    => 'http://sourceforge.net/projects/module-build',
        bugtracker  => {
          web    => 'http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta',
          mailto => 'meta-bugs@example.com',
        },
        repository  => {
          url  => 'git://github.com/dagolden/cpan-meta.git',
          web  => 'http://github.com/dagolden/cpan-meta',
          type => 'git',
        },
        x_twitter   => 'http://twitter.com/cpan_linked/',
      }
    
    (Spec 2) [optional] {Map}
    
    This field describes resources related to this distribution.
    
    Valid subkeys include:
    
    =over
    
    =item homepage
    
    The official home of this project on the web.
    
    =item license
    
    A List of I<URL>'s that relate to this distribution's license.  As with the
    top-level C<license> field, distribution documentation should be consulted
    to clarify the interpretation of multiple licenses provided here.
    
    =item bugtracker
    
    This entry describes the bug tracking system for this distribution.  It
    is a Map with the following valid keys:
    
      web    - a URL pointing to a web front-end for the bug tracker
      mailto - an email address to which bugs can be sent
    
    =item repository
    
    This entry describes the source control repository for this distribution.  It
    is a Map with the following valid keys:
    
      url  - a URL pointing to the repository itself
      web  - a URL pointing to a web front-end for the repository
      type - a lowercase string indicating the VCS used
    
    Because a url like C<http://myrepo.example.com/> is ambiguous as to
    type, producers should provide a C<type> whenever a C<url> key is given.
    The C<type> field should be the name of the most common program used
    to work with the repository, e.g. C<git>, C<svn>, C<cvs>, C<darcs>,
    C<bzr> or C<hg>.
    
    =back
    
    =head2 DEPRECATED FIELDS
    
    =head3 build_requires
    
    I<(Deprecated in Spec 2)> [optional] {String}
    
    Replaced by C<prereqs>
    
    =head3 configure_requires
    
    I<(Deprecated in Spec 2)> [optional] {String}
    
    Replaced by C<prereqs>
    
    =head3 conflicts
    
    I<(Deprecated in Spec 2)> [optional] {String}
    
    Replaced by C<prereqs>
    
    =head3 distribution_type
    
    I<(Deprecated in Spec 2)> [optional] {String}
    
    This field indicated 'module' or 'script' but was considered
    meaningless, since many distributions are hybrids of several kinds of
    things.
    
    =head3 license_uri
    
    I<(Deprecated in Spec 1.2)> [optional] {URL}
    
    Replaced by C<license> in C<resources>
    
    =head3 private
    
    I<(Deprecated in Spec 1.2)> [optional] {Map}
    
    This field has been renamed to L</"no_index">.
    
    =head3 recommends
    
    I<(Deprecated in Spec 2)> [optional] {String}
    
    Replaced by C<prereqs>
    
    =head3 requires
    
    I<(Deprecated in Spec 2)> [optional] {String}
    
    Replaced by C<prereqs>
    
    =head1 VERSION NUMBERS
    
    =head2 Version Formats
    
    This section defines the Version type, used by several fields in the
    CPAN Meta Spec.
    
    Version numbers must be treated as strings, not numbers.  For
    example, C<1.200> B<must not> be serialized as C<1.2>.  Version
    comparison should be delegated to the Perl L<version> module, version
    0.80 or newer.
    
    Unless otherwise specified, version numbers B<must> appear in one of two
    formats:
    
    =over
    
    =item Decimal versions
    
    Decimal versions are regular "decimal numbers", with some limitations.
    They B<must> be non-negative and B<must> begin and end with a digit.  A
    single underscore B<may> be included, but B<must> be between two digits.
    They B<must not> use exponential notation ("1.23e-2").
    
       version => '1.234'       # OK
       version => '1.23_04'     # OK
    
       version => '1.23_04_05'  # Illegal
       version => '1.'          # Illegal
       version => '.1'          # Illegal
    
    =item Dotted-integer versions
    
    Dotted-integer (also known as dotted-decimal) versions consist of
    positive integers separated by full stop characters (i.e. "dots",
    "periods" or "decimal points").  This are equivalent in format to Perl
    "v-strings", with some additional restrictions on form.  They must be
    given in "normal" form, which has a leading "v" character and at least
    three integer components.  To retain a one-to-one mapping with decimal
    versions, all components after the first B<should> be restricted to the
    range 0 to 999.  The final component B<may> be separated by an
    underscore character instead of a period.
    
       version => 'v1.2.3'      # OK
       version => 'v1.2_3'      # OK
       version => 'v1.2.3.4'    # OK
       version => 'v1.2.3_4'    # OK
       version => 'v2009.10.31' # OK
    
       version => 'v1.2'          # Illegal
       version => '1.2.3'         # Illegal
       version => 'v1.2_3_4'      # Illegal
       version => 'v1.2009.10.31' # Not recommended
    
    =back
    
    =head2 Version Ranges
    
    Some fields (prereq, optional_features) indicate the particular
    version(s) of some other module that may be required as a prerequisite.
    This section details the Version Range type used to provide this
    information.
    
    The simplest format for a Version Range is just the version
    number itself, e.g. C<2.4>.  This means that B<at least> version 2.4
    must be present.  To indicate that B<any> version of a prerequisite is
    okay, even if the prerequisite doesn't define a version at all, use
    the version C<0>.
    
    Alternatively, a version range B<may> use the operators E<lt> (less than),
    E<lt>= (less than or equal), E<gt> (greater than), E<gt>= (greater than
    or equal), == (equal), and != (not equal).  For example, the
    specification C<E<lt> 2.0> means that any version of the prerequisite
    less than 2.0 is suitable.
    
    For more complicated situations, version specifications B<may> be AND-ed
    together using commas.  The specification C<E<gt>= 1.2, != 1.5, E<lt>
    2.0> indicates a version that must be B<at least> 1.2, B<less than> 2.0,
    and B<not equal to> 1.5.
    
    =head1 PREREQUISITES
    
    =head2 Prereq Spec
    
    The C<prereqs> key in the top-level metadata and within
    C<optional_features> define the relationship between a distribution and
    other packages.  The prereq spec structure is a hierarchical data
    structure which divides prerequisites into I<Phases> of activity in the
    installation process and I<Relationships> that indicate how
    prerequisites should be resolved.
    
    For example, to specify that C<Data::Dumper> is C<required> during the
    C<test> phase, this entry would appear in the distribution metadata:
    
      prereqs => {
        test => {
          requires => {
            'Data::Dumper' => '2.00'
          }
        }
      }
    
    =head3 Phases
    
    Requirements for regular use must be listed in the C<runtime> phase.
    Other requirements should be listed in the earliest stage in which they
    are required and consumers must accumulate and satisfy requirements
    across phases before executing the activity. For example, C<build>
    requirements must also be available during the C<test> phase.
    
      before action       requirements that must be met
      ----------------    --------------------------------
      perl Build.PL       configure
      perl Makefile.PL
    
      make                configure, runtime, build
      Build
    
      make test           configure, runtime, build, test
      Build test
    
    Consumers that install the distribution must ensure that
    I<runtime> requirements are also installed and may install
    dependencies from other phases.
    
      after action        requirements that must be met
      ----------------    --------------------------------
      make install        runtime
      Build install
    
    =over
    
    =item configure
    
    The configure phase occurs before any dynamic configuration has been
    attempted.  Libraries required by the configure phase B<must> be
    available for use before the distribution building tool has been
    executed.
    
    =item build
    
    The build phase is when the distribution's source code is compiled (if
    necessary) and otherwise made ready for installation.
    
    =item test
    
    The test phase is when the distribution's automated test suite is run.
    Any library that is needed only for testing and not for subsequent use
    should be listed here.
    
    =item runtime
    
    The runtime phase refers not only to when the distribution's contents
    are installed, but also to its continued use.  Any library that is a
    prerequisite for regular use of this distribution should be indicated
    here.
    
    =item develop
    
    The develop phase's prereqs are libraries needed to work on the
    distribution's source code as its author does.  These tools might be
    needed to build a release tarball, to run author-only tests, or to
    perform other tasks related to developing new versions of the
    distribution.
    
    =back
    
    =head3 Relationships
    
    =over
    
    =item requires
    
    These dependencies B<must> be installed for proper completion of the
    phase.
    
    =item recommends
    
    Recommended dependencies are I<strongly> encouraged and should be
    satisfied except in resource constrained environments.
    
    =item suggests
    
    These dependencies are optional, but are suggested for enhanced operation
    of the described distribution.
    
    =item conflicts
    
    These libraries cannot be installed when the phase is in operation.
    This is a very rare situation, and the C<conflicts> relationship should
    be used with great caution, or not at all.
    
    =back
    
    =head2 Merging and Resolving Prerequisites
    
    Whenever metadata consumers merge prerequisites, either from different
    phases or from C<optional_features>, they should merged in a way which
    preserves the intended semantics of the prerequisite structure.  Generally,
    this means concatenating the version specifications using commas, as
    described in the L<Version Ranges> section.
    
    Another subtle error that can occur in resolving prerequisites comes from
    the way that modules in prerequisites are indexed to distribution files on
    CPAN.  When a module is deleted from a distribution, prerequisites calling
    for that module could indicate an older distribution should be installed,
    potentially overwriting files from a newer distribution.
    
    For example, as of Oct 31, 2009, the CPAN index file contained these
    module-distribution mappings:
    
      Class::MOP                   0.94  D/DR/DROLSKY/Class-MOP-0.94.tar.gz
      Class::MOP::Class            0.94  D/DR/DROLSKY/Class-MOP-0.94.tar.gz
      Class::MOP::Class::Immutable 0.04  S/ST/STEVAN/Class-MOP-0.36.tar.gz
    
    Consider the case where "Class::MOP" 0.94 is installed.  If a
    distribution specified "Class::MOP::Class::Immutable" as a prerequisite,
    it could result in Class-MOP-0.36.tar.gz being installed, overwriting
    any files from Class-MOP-0.94.tar.gz.
    
    Consumers of metadata B<should> test whether prerequisites would result
    in installed module files being "downgraded" to an older version and
    B<may> warn users or ignore the prerequisite that would cause such a
    result.
    
    =head1 SERIALIZATION
    
    Distribution metadata should be serialized (as a hashref) as
    JSON-encoded data and packaged with distributions as the file
    F<META.json>.
    
    In the past, the distribution metadata structure had been packed with
    distributions as F<META.yml>, a file in the YAML Tiny format (for which,
    see L<YAML::Tiny>).  Tools that consume distribution metadata from disk
    should be capable of loading F<META.yml>, but should prefer F<META.json>
    if both are found.
    
    =head1 NOTES FOR IMPLEMENTORS
    
    =head2 Extracting Version Numbers from Perl Modules
    
    To get the version number from a Perl module, consumers should use the
    C<< MM->parse_version($file) >> method provided by
    L<ExtUtils::MakeMaker> or L<Module::Metadata>.  For example, for the
    module given by C<$mod>, the version may be retrieved in one of the
    following ways:
    
      # via ExtUtils::MakeMaker
      my $file = MM->_installed_file_for_module($mod);
      my $version = MM->parse_version($file)
    
    The private C<_installed_file_for_module> method may be replaced with
    other methods for locating a module in C<@INC>.
    
      # via Module::Metadata
      my $info = Module::Metadata->new_from_module($mod);
      my $version = $info->version;
    
    If only a filename is available, the following approach may be used:
    
      # via Module::Build
      my $info = Module::Metadata->new_from_file($file);
      my $version = $info->version;
    
    =head2 Comparing Version Numbers
    
    The L<version> module provides the most reliable way to compare version
    numbers in all the various ways they might be provided or might exist
    within modules.  Given two strings containing version numbers, C<$v1> and
    C<$v2>, they should be converted to C<version> objects before using
    ordinary comparison operators.  For example:
    
      use version;
      if ( version->new($v1) <=> version->new($v2) ) {
        print "Versions are not equal\n";
      }
    
    If the only comparison needed is whether an installed module is of a
    sufficiently high version, a direct test may be done using the string
    form of C<eval> and the C<use> function.  For example, for module C<$mod>
    and version prerequisite C<$prereq>:
    
      if ( eval "use $mod $prereq (); 1" ) {
        print "Module $mod version is OK.\n";
      }
    
    If the values of C<$mod> and C<$prereq> have not been scrubbed, however,
    this presents security implications.
    
    =head1 SEE ALSO
    
    CPAN, L<http://www.cpan.org/>
    
    CPAN.pm, L<http://search.cpan.org/dist/CPAN/>
    
    CPANPLUS, L<http://search.cpan.org/dist/CPANPLUS/>
    
    ExtUtils::MakeMaker, L<http://search.cpan.org/dist/ExtUtils-MakeMaker/>
    
    Module::Build, L<http://search.cpan.org/dist/Module-Build/>
    
    Module::Install, L<http://search.cpan.org/dist/Module-Install/>
    
    JSON, L<http://json.org/>
    
    YAML, L<http://www.yaml.org/>
    
    =head1 HISTORY
    
    Ken Williams wrote the original CPAN Meta Spec (also known as the
    "META.yml spec") in 2003 and maintained it through several revisions
    with input from various members of the community.  In 2005, Randy
    Sims redrafted it from HTML to POD for the version 1.2 release.  Ken
    continued to maintain the spec through version 1.4.
    
    In late 2009, David Golden organized the version 2 proposal review
    process.  David and Ricardo Signes drafted the final version 2 spec
    in April 2010 based on the version 1.4 spec and patches contributed
    during the proposal process.
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META_SPEC
  
  $fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
    use 5.006;
    use strict;
    use warnings;
    package CPAN::Meta::Validator;
    our $VERSION = '2.132510'; # VERSION
    
    
    #--------------------------------------------------------------------------#
    # 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.php',
        '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;
    
    # ABSTRACT: validate CPAN distribution metadata structures
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    CPAN::Meta::Validator - validate CPAN distribution metadata structures
    
    =head1 VERSION
    
    version 2.132510
    
    =head1 SYNOPSIS
    
      my $struct = decode_json_file('META.json');
    
      my $cmv = CPAN::Meta::Validator->new( $struct );
    
      unless ( $cmv->is_valid ) {
        my $msg = "Invalid META structure.  Errors found:\n";
        $msg .= join( "\n", $cmv->errors );
        die $msg;
      }
    
    =head1 DESCRIPTION
    
    This module validates a CPAN Meta structure against the version of the
    the specification claimed in the C<meta-spec> field of the structure.
    
    =head1 METHODS
    
    =head2 new
    
      my $cmv = CPAN::Meta::Validator->new( $struct )
    
    The constructor must be passed a metadata structure.
    
    =head2 is_valid
    
      if ( $cmv->is_valid ) {
        ...
      }
    
    Returns a boolean value indicating whether the metadata provided
    is valid.
    
    =head2 errors
    
      warn( join "\n", $cmv->errors );
    
    Returns a list of errors seen during validation.
    
    =begin :internals
    
    =head2 Check Methods
    
    =over
    
    =item *
    
    check_map($spec,$data)
    
    Checks whether a map (or hash) part of the data structure conforms to the
    appropriate specification definition.
    
    =item *
    
    check_list($spec,$data)
    
    Checks whether a list (or array) part of the data structure conforms to
    the appropriate specification definition.
    
    =item *
    
    check_lazylist($spec,$data)
    
    Checks whether a list conforms, but converts strings to a single-element list
    
    =back
    
    =head2 Validator Methods
    
    =over
    
    =item *
    
    header($self,$key,$value)
    
    Validates that the header is valid.
    
    Note: No longer used as we now read the data structure, not the file.
    
    =item *
    
    url($self,$key,$value)
    
    Validates that a given value is in an acceptable URL format
    
    =item *
    
    urlspec($self,$key,$value)
    
    Validates that the URL to a META specification is a known one.
    
    =item *
    
    string_or_undef($self,$key,$value)
    
    Validates that the value is either a string or an undef value. Bit of a
    catchall function for parts of the data structure that are completely user
    defined.
    
    =item *
    
    string($self,$key,$value)
    
    Validates that a string exists for the given key.
    
    =item *
    
    file($self,$key,$value)
    
    Validate that a file is passed for the given key. This may be made more
    thorough in the future. For now it acts like \&string.
    
    =item *
    
    exversion($self,$key,$value)
    
    Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
    
    =item *
    
    version($self,$key,$value)
    
    Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
    are both valid. A leading 'v' like 'v1.2.3' is also valid.
    
    =item *
    
    boolean($self,$key,$value)
    
    Validates for a boolean value. Currently these values are '1', '0', 'true',
    'false', however the latter 2 may be removed.
    
    =item *
    
    license($self,$key,$value)
    
    Validates that a value is given for the license. Returns 1 if an known license
    type, or 2 if a value is given but the license type is not a recommended one.
    
    =item *
    
    custom_1($self,$key,$value)
    
    Validates that the given key is in CamelCase, to indicate a user defined
    keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
    of the spec, this was only explicitly stated for 'resources'.
    
    =item *
    
    custom_2($self,$key,$value)
    
    Validates that the given key begins with 'x_' or 'X_', to indicate a user
    defined keyword and only has characters in the class [-_a-zA-Z]
    
    =item *
    
    identifier($self,$key,$value)
    
    Validates that key is in an acceptable format for the META specification,
    for an identifier, i.e. any that matches the regular expression
    qr/[a-z][a-z_]/i.
    
    =item *
    
    module($self,$key,$value)
    
    Validates that a given key is in an acceptable module name format, e.g.
    'Test::CPAN::Meta::Version'.
    
    =back
    
    =end :internals
    
    =for Pod::Coverage anything boolean check_lazylist check_list custom_1 custom_2 exversion file
    identifier license module phase relation release_status string string_or_undef
    url urlspec version header check_map
    
    =head1 BUGS
    
    Please report any bugs or feature using the CPAN Request Tracker.
    Bugs can be submitted through the web interface at
    L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
    
    When submitting a bug or request, please include a test-file or a patch to an
    existing test-file that illustrates the bug or desired feature.
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =item *
    
    Ricardo Signes <rjbs@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by David Golden and Ricardo Signes.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  CPAN_META_VALIDATOR
  
  $fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
    package CPAN::Meta::YAML;
    {
      $CPAN::Meta::YAML::VERSION = '0.008';
    }
    
    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|:\z)/ 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 {
    	local $@;
    	eval {
    		require Scalar::Util;
    	};
    	my $v = eval("$Scalar::Util::VERSION") || 0;
    	if ( $@ or $v < 1.18 ) {
    		eval <<'END_PERL';
    # Scalar::Util failed to load or too old
    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
    	} else {
    		*refaddr = *Scalar::Util::refaddr;
    	}
    }
    
    1;
    
    
    
    =pod
    
    =head1 NAME
    
    CPAN::Meta::YAML - Read and write a subset of YAML for CPAN Meta files
    
    =head1 VERSION
    
    version 0.008
    
    =head1 SYNOPSIS
    
        use CPAN::Meta::YAML;
    
        # reading a META file
        open $fh, "<:utf8", "META.yml";
        $yaml_text = do { local $/; <$fh> };
        $yaml = CPAN::Meta::YAML->read_string($yaml_text)
          or die CPAN::Meta::YAML->errstr;
    
        # finding the metadata
        $meta = $yaml->[0];
    
        # writing a META file
        $yaml_text = $yaml->write_string
          or die CPAN::Meta::YAML->errstr;
        open $fh, ">:utf8", "META.yml";
        print $fh $yaml_text;
    
    =head1 DESCRIPTION
    
    This module implements a subset of the YAML specification for use in reading
    and writing CPAN metadata files like F<META.yml> and F<MYMETA.yml>.  It should
    not be used for any other general YAML parsing or generation task.
    
    NOTE: F<META.yml> (and F<MYMETA.yml>) files should be UTF-8 encoded.  Users are
    responsible for proper encoding and decoding.  In particular, the C<read> and
    C<write> methods do B<not> support UTF-8 and should not be used.
    
    =head1 SUPPORT
    
    This module is currently derived from L<YAML::Tiny> by Adam Kennedy.  If
    there are bugs in how it parses a particular META.yml file, please file
    a bug report in the YAML::Tiny bugtracker:
    L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=YAML-Tiny>
    
    =head1 SEE ALSO
    
    L<YAML::Tiny>, L<YAML>, L<YAML::XS>
    
    =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
    
    =head1 SUPPORT
    
    =head2 Bugs / Feature Requests
    
    Please report any bugs or feature requests through the issue tracker
    at L<http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta-YAML>.
    You will be notified automatically of any progress on your issue.
    
    =head2 Source Code
    
    This is open source software.  The code repository is available for
    public review and contribution under the terms of the license.
    
    L<https://github.com/dagolden/cpan-meta-yaml>
    
      git clone https://github.com/dagolden/cpan-meta-yaml.git
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    Adam Kennedy <adamk@cpan.org>
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2010 by Adam Kennedy.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
    
    
    __END__
    
    
    # ABSTRACT: Read and write a subset of YAML for CPAN Meta files
    
    
  CPAN_META_YAML
  
  $fatpacked{"Exporter.pm"} = <<'EXPORTER';
    package Exporter;
    
    require 5.006;
    
    # Be lean.
    #use strict;
    #no strict 'refs';
    
    our $Debug = 0;
    our $ExportLevel = 0;
    our $Verbose ||= 0;
    our $VERSION = '5.68';
    our (%Cache);
    
    sub as_heavy {
      require Exporter::Heavy;
      # Unfortunately, this does not work if the caller is aliased as *name = \&foo
      # Thus the need to create a lot of identical subroutines
      my $c = (caller(1))[3];
      $c =~ s/.*:://;
      \&{"Exporter::Heavy::heavy_$c"};
    }
    
    sub export {
      goto &{as_heavy()};
    }
    
    sub import {
      my $pkg = shift;
      my $callpkg = caller($ExportLevel);
    
      if ($pkg eq "Exporter" and @_ and $_[0] eq "import") {
        *{$callpkg."::import"} = \&import;
        return;
      }
    
      # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
      my $exports = \@{"$pkg\::EXPORT"};
      # But, avoid creating things if they don't exist, which saves a couple of
      # hundred bytes per package processed.
      my $fail = ${$pkg . '::'}{EXPORT_FAIL} && \@{"$pkg\::EXPORT_FAIL"};
      return export $pkg, $callpkg, @_
        if $Verbose or $Debug or $fail && @$fail > 1;
      my $export_cache = ($Cache{$pkg} ||= {});
      my $args = @_ or @_ = @$exports;
    
      if ($args and not %$export_cache) {
        s/^&//, $export_cache->{$_} = 1
          foreach (@$exports, @{"$pkg\::EXPORT_OK"});
      }
      my $heavy;
      # Try very hard not to use {} and hence have to  enter scope on the foreach
      # We bomb out of the loop with last as soon as heavy is set.
      if ($args or $fail) {
        ($heavy = (/\W/ or $args and not exists $export_cache->{$_}
                   or $fail and @$fail and $_ eq $fail->[0])) and last
                     foreach (@_);
      } else {
        ($heavy = /\W/) and last
          foreach (@_);
      }
      return export $pkg, $callpkg, ($args ? @_ : ()) if $heavy;
      local $SIG{__WARN__} = 
    	sub {require Carp; &Carp::carp} if not $SIG{__WARN__};
      # shortcut for the common case of no type character
      *{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_;
    }
    
    # Default methods
    
    sub export_fail {
        my $self = shift;
        @_;
    }
    
    # Unfortunately, caller(1)[3] "does not work" if the caller is aliased as
    # *name = \&foo.  Thus the need to create a lot of identical subroutines
    # Otherwise we could have aliased them to export().
    
    sub export_to_level {
      goto &{as_heavy()};
    }
    
    sub export_tags {
      goto &{as_heavy()};
    }
    
    sub export_ok_tags {
      goto &{as_heavy()};
    }
    
    sub require_version {
      goto &{as_heavy()};
    }
    
    1;
    __END__
    
    =head1 NAME
    
    Exporter - Implements default import method for modules
    
    =head1 SYNOPSIS
    
    In module F<YourModule.pm>:
    
      package YourModule;
      require Exporter;
      @ISA = qw(Exporter);
      @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
    
    or
    
      package YourModule;
      use Exporter 'import'; # gives you Exporter's import() method directly
      @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
    
    In other files which wish to use C<YourModule>:
    
      use YourModule qw(frobnicate);      # import listed symbols
      frobnicate ($left, $right)          # calls YourModule::frobnicate
    
    Take a look at L</Good Practices> for some variants
    you will like to use in modern Perl code.
    
    =head1 DESCRIPTION
    
    The Exporter module implements an C<import> method which allows a module
    to export functions and variables to its users' namespaces.  Many modules
    use Exporter rather than implementing their own C<import> method because
    Exporter provides a highly flexible interface, with an implementation optimised
    for the common case.
    
    Perl automatically calls the C<import> method when processing a
    C<use> statement for a module.  Modules and C<use> are documented
    in L<perlfunc> and L<perlmod>.  Understanding the concept of
    modules and how the C<use> statement operates is important to
    understanding the Exporter.
    
    =head2 How to Export
    
    The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of
    symbols that are going to be exported into the users name space by
    default, or which they can request to be exported, respectively.  The
    symbols can represent functions, scalars, arrays, hashes, or typeglobs.
    The symbols must be given by full name with the exception that the
    ampersand in front of a function is optional, e.g.
    
        @EXPORT    = qw(afunc $scalar @array);   # afunc is a function
        @EXPORT_OK = qw(&bfunc %hash *typeglob); # explicit prefix on &bfunc
    
    If you are only exporting function names it is recommended to omit the
    ampersand, as the implementation is faster this way.
    
    =head2 Selecting What to Export
    
    Do B<not> export method names!
    
    Do B<not> export anything else by default without a good reason!
    
    Exports pollute the namespace of the module user.  If you must export
    try to use C<@EXPORT_OK> in preference to C<@EXPORT> and avoid short or
    common symbol names to reduce the risk of name clashes.
    
    Generally anything not exported is still accessible from outside the
    module using the C<YourModule::item_name> (or C<< $blessed_ref->method >>)
    syntax.  By convention you can use a leading underscore on names to
    informally indicate that they are 'internal' and not for public use.
    
    (It is actually possible to get private functions by saying:
    
      my $subref = sub { ... };
      $subref->(@args);            # Call it as a function
      $obj->$subref(@args);        # Use it as a method
    
    However if you use them for methods it is up to you to figure out
    how to make inheritance work.)
    
    As a general rule, if the module is trying to be object oriented
    then export nothing.  If it's just a collection of functions then
    C<@EXPORT_OK> anything but use C<@EXPORT> with caution.  For function and
    method names use barewords in preference to names prefixed with
    ampersands for the export lists.
    
    Other module design guidelines can be found in L<perlmod>.
    
    =head2 How to Import
    
    In other files which wish to use your module there are three basic ways for
    them to load your module and import its symbols:
    
    =over 4
    
    =item C<use YourModule;>
    
    This imports all the symbols from YourModule's C<@EXPORT> into the namespace
    of the C<use> statement.
    
    =item C<use YourModule ();>
    
    This causes perl to load your module but does not import any symbols.
    
    =item C<use YourModule qw(...);>
    
    This imports only the symbols listed by the caller into their namespace.
    All listed symbols must be in your C<@EXPORT> or C<@EXPORT_OK>, else an error
    occurs.  The advanced export features of Exporter are accessed like this,
    but with list entries that are syntactically distinct from symbol names.
    
    =back
    
    Unless you want to use its advanced features, this is probably all you
    need to know to use Exporter.
    
    =head1 Advanced Features
    
    =head2 Specialised Import Lists
    
    If any of the entries in an import list begins with !, : or / then
    the list is treated as a series of specifications which either add to
    or delete from the list of names to import.  They are processed left to
    right. Specifications are in the form:
    
        [!]name         This name only
        [!]:DEFAULT     All names in @EXPORT
        [!]:tag         All names in $EXPORT_TAGS{tag} anonymous list
        [!]/pattern/    All names in @EXPORT and @EXPORT_OK which match
    
    A leading ! indicates that matching names should be deleted from the
    list of names to import.  If the first specification is a deletion it
    is treated as though preceded by :DEFAULT.  If you just want to import
    extra names in addition to the default set you will still need to
    include :DEFAULT explicitly.
    
    e.g., F<Module.pm> defines:
    
        @EXPORT      = qw(A1 A2 A3 A4 A5);
        @EXPORT_OK   = qw(B1 B2 B3 B4 B5);
        %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
    
    Note that you cannot use tags in @EXPORT or @EXPORT_OK.
    
    Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
    
    An application using Module can say something like:
    
        use Module qw(:DEFAULT :T2 !B3 A3);
    
    Other examples include:
    
        use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
        use POSIX  qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
    
    Remember that most patterns (using //) will need to be anchored
    with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
    
    You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
    specifications are being processed and what is actually being imported
    into modules.
    
    =head2 Exporting Without Using Exporter's import Method
    
    Exporter has a special method, 'export_to_level' which is used in situations
    where you can't directly call Exporter's
    import method.  The export_to_level
    method looks like:
    
        MyPackage->export_to_level(
    	$where_to_export, $package, @what_to_export
        );
    
    where C<$where_to_export> is an integer telling how far up the calling stack
    to export your symbols, and C<@what_to_export> is an array telling what
    symbols *to* export (usually this is C<@_>).  The C<$package> argument is
    currently unused.
    
    For example, suppose that you have a module, A, which already has an
    import function:
    
        package A;
    
        @ISA = qw(Exporter);
        @EXPORT_OK = qw ($b);
    
        sub import
        {
    	$A::b = 1;     # not a very useful import method
        }
    
    and you want to Export symbol C<$A::b> back to the module that called 
    package A.  Since Exporter relies on the import method to work, via 
    inheritance, as it stands Exporter::import() will never get called. 
    Instead, say the following:
    
        package A;
        @ISA = qw(Exporter);
        @EXPORT_OK = qw ($b);
    
        sub import
        {
    	$A::b = 1;
    	A->export_to_level(1, @_);
        }
    
    This will export the symbols one level 'above' the current package - ie: to 
    the program or module that used package A. 
    
    Note: Be careful not to modify C<@_> at all before you call export_to_level
    - or people using your package will get very unexplained results!
    
    =head2 Exporting Without Inheriting from Exporter
    
    By including Exporter in your C<@ISA> you inherit an Exporter's import() method
    but you also inherit several other helper methods which you probably don't
    want.  To avoid this you can do
    
      package YourModule;
      use Exporter qw( import );
    
    which will export Exporter's own import() method into YourModule.
    Everything will work as before but you won't need to include Exporter in
    C<@YourModule::ISA>.
    
    Note: This feature was introduced in version 5.57
    of Exporter, released with perl 5.8.3.
    
    =head2 Module Version Checking
    
    The Exporter module will convert an attempt to import a number from a
    module into a call to C<< $module_name->VERSION($value) >>.  This can
    be used to validate that the version of the module being used is
    greater than or equal to the required version.
    
    For historical reasons, Exporter supplies a C<require_version> method that
    simply delegates to C<VERSION>.  Originally, before C<UNIVERSAL::VERSION>
    existed, Exporter would call C<require_version>.
    
    Since the C<UNIVERSAL::VERSION> method treats the C<$VERSION> number as
    a simple numeric value it will regard version 1.10 as lower than
    1.9.  For this reason it is strongly recommended that you use numbers
    with at least two decimal places, e.g., 1.09.
    
    =head2 Managing Unknown Symbols
    
    In some situations you may want to prevent certain symbols from being
    exported.  Typically this applies to extensions which have functions
    or constants that may not exist on some systems.
    
    The names of any symbols that cannot be exported should be listed
    in the C<@EXPORT_FAIL> array.
    
    If a module attempts to import any of these symbols the Exporter
    will give the module an opportunity to handle the situation before
    generating an error.  The Exporter will call an export_fail method
    with a list of the failed symbols:
    
      @failed_symbols = $module_name->export_fail(@failed_symbols);
    
    If the C<export_fail> method returns an empty list then no error is
    recorded and all the requested symbols are exported.  If the returned
    list is not empty then an error is generated for each symbol and the
    export fails.  The Exporter provides a default C<export_fail> method which
    simply returns the list unchanged.
    
    Uses for the C<export_fail> method include giving better error messages
    for some symbols and performing lazy architectural checks (put more
    symbols into C<@EXPORT_FAIL> by default and then take them out if someone
    actually tries to use them and an expensive check shows that they are
    usable on that platform).
    
    =head2 Tag Handling Utility Functions
    
    Since the symbols listed within C<%EXPORT_TAGS> must also appear in either
    C<@EXPORT> or C<@EXPORT_OK>, two utility functions are provided which allow
    you to easily add tagged sets of symbols to C<@EXPORT> or C<@EXPORT_OK>:
    
      %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
    
      Exporter::export_tags('foo');     # add aa, bb and cc to @EXPORT
      Exporter::export_ok_tags('bar');  # add aa, cc and dd to @EXPORT_OK
    
    Any names which are not tags are added to C<@EXPORT> or C<@EXPORT_OK>
    unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
    names being silently added to C<@EXPORT> or C<@EXPORT_OK>.  Future versions
    may make this a fatal error.
    
    =head2 Generating Combined Tags
    
    If several symbol categories exist in C<%EXPORT_TAGS>, it's usually
    useful to create the utility ":all" to simplify "use" statements.
    
    The simplest way to do this is:
    
      %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
    
      # add all the other ":class" tags to the ":all" class,
      # deleting duplicates
      {
        my %seen;
    
        push @{$EXPORT_TAGS{all}},
          grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
      }
    
    F<CGI.pm> creates an ":all" tag which contains some (but not really
    all) of its categories.  That could be done with one small
    change:
    
      # add some of the other ":class" tags to the ":all" class,
      # deleting duplicates
      {
        my %seen;
    
        push @{$EXPORT_TAGS{all}},
          grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}}
            foreach qw/html2 html3 netscape form cgi internal/;
      }
    
    Note that the tag names in C<%EXPORT_TAGS> don't have the leading ':'.
    
    =head2 C<AUTOLOAD>ed Constants
    
    Many modules make use of C<AUTOLOAD>ing for constant subroutines to
    avoid having to compile and waste memory on rarely used values (see
    L<perlsub> for details on constant subroutines).  Calls to such
    constant subroutines are not optimized away at compile time because
    they can't be checked at compile time for constancy.
    
    Even if a prototype is available at compile time, the body of the
    subroutine is not (it hasn't been C<AUTOLOAD>ed yet).  perl needs to
    examine both the C<()> prototype and the body of a subroutine at
    compile time to detect that it can safely replace calls to that
    subroutine with the constant value.
    
    A workaround for this is to call the constants once in a C<BEGIN> block:
    
       package My ;
    
       use Socket ;
    
       foo( SO_LINGER );  ## SO_LINGER NOT optimized away; called at runtime
       BEGIN { SO_LINGER }
       foo( SO_LINGER );  ## SO_LINGER optimized away at compile time.
    
    This forces the C<AUTOLOAD> for C<SO_LINGER> to take place before
    SO_LINGER is encountered later in C<My> package.
    
    If you are writing a package that C<AUTOLOAD>s, consider forcing
    an C<AUTOLOAD> for any constants explicitly imported by other packages
    or which are usually used when your package is C<use>d.
    
    =head1 Good Practices
    
    =head2 Declaring C<@EXPORT_OK> and Friends
    
    When using C<Exporter> with the standard C<strict> and C<warnings>
    pragmas, the C<our> keyword is needed to declare the package
    variables C<@EXPORT_OK>, C<@EXPORT>, C<@ISA>, etc.
    
      our @ISA = qw(Exporter);
      our @EXPORT_OK = qw(munge frobnicate);
    
    If backward compatibility for Perls under 5.6 is important,
    one must write instead a C<use vars> statement.
    
      use vars qw(@ISA @EXPORT_OK);
      @ISA = qw(Exporter);
      @EXPORT_OK = qw(munge frobnicate);
    
    =head2 Playing Safe
    
    There are some caveats with the use of runtime statements
    like C<require Exporter> and the assignment to package
    variables, which can very subtle for the unaware programmer.
    This may happen for instance with mutually recursive
    modules, which are affected by the time the relevant
    constructions are executed.
    
    The ideal (but a bit ugly) way to never have to think
    about that is to use C<BEGIN> blocks.  So the first part
    of the L</SYNOPSIS> code could be rewritten as:
    
      package YourModule;
    
      use strict;
      use warnings;
    
      our (@ISA, @EXPORT_OK);
      BEGIN {
         require Exporter;
         @ISA = qw(Exporter);
         @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
      }
    
    The C<BEGIN> will assure that the loading of F<Exporter.pm>
    and the assignments to C<@ISA> and C<@EXPORT_OK> happen
    immediately, leaving no room for something to get awry
    or just plain wrong.
    
    With respect to loading C<Exporter> and inheriting, there
    are alternatives with the use of modules like C<base> and C<parent>.
    
      use base qw( Exporter );
      # or
      use parent qw( Exporter );
    
    Any of these statements are nice replacements for
    C<BEGIN { require Exporter; @ISA = qw(Exporter); }>
    with the same compile-time effect.  The basic difference
    is that C<base> code interacts with declared C<fields>
    while C<parent> is a streamlined version of the older
    C<base> code to just establish the IS-A relationship.
    
    For more details, see the documentation and code of
    L<base> and L<parent>.
    
    Another thorough remedy to that runtime
    vs. compile-time trap is to use L<Exporter::Easy>,
    which is a wrapper of Exporter that allows all
    boilerplate code at a single gulp in the
    use statement.
    
       use Exporter::Easy (
           OK => [ qw(munge frobnicate) ],
       );
       # @ISA setup is automatic
       # all assignments happen at compile time
    
    =head2 What Not to Export
    
    You have been warned already in L</Selecting What to Export>
    to not export:
    
    =over 4
    
    =item *
    
    method names (because you don't need to
    and that's likely to not do what you want),
    
    =item *
    
    anything by default (because you don't want to surprise your users...
    badly)
    
    =item *
    
    anything you don't need to (because less is more)
    
    =back
    
    There's one more item to add to this list.  Do B<not>
    export variable names.  Just because C<Exporter> lets you
    do that, it does not mean you should.
    
      @EXPORT_OK = qw( $svar @avar %hvar ); # DON'T!
    
    Exporting variables is not a good idea.  They can
    change under the hood, provoking horrible
    effects at-a-distance, that are too hard to track
    and to fix.  Trust me: they are not worth it.
    
    To provide the capability to set/get class-wide
    settings, it is best instead to provide accessors
    as subroutines or class methods instead.
    
    =head1 SEE ALSO
    
    C<Exporter> is definitely not the only module with
    symbol exporter capabilities.  At CPAN, you may find
    a bunch of them.  Some are lighter.  Some
    provide improved APIs and features.  Peek the one
    that fits your needs.  The following is
    a sample list of such modules.
    
        Exporter::Easy
        Exporter::Lite
        Exporter::Renaming
        Exporter::Tidy
        Sub::Exporter / Sub::Installer
        Perl6::Export / Perl6::Export::Attrs
    
    =head1 LICENSE
    
    This library is free software.  You can redistribute it
    and/or modify it under the same terms as Perl itself.
    
    =cut
    
    
    
  EXPORTER
  
  $fatpacked{"Exporter/Heavy.pm"} = <<'EXPORTER_HEAVY';
    package Exporter::Heavy;
    
    use strict;
    no strict 'refs';
    
    # On one line so MakeMaker will see it.
    require Exporter;  our $VERSION = $Exporter::VERSION;
    
    =head1 NAME
    
    Exporter::Heavy - Exporter guts
    
    =head1 SYNOPSIS
    
    (internal use only)
    
    =head1 DESCRIPTION
    
    No user-serviceable parts inside.
    
    =cut
    
    #
    # We go to a lot of trouble not to 'require Carp' at file scope,
    #  because Carp requires Exporter, and something has to give.
    #
    
    sub _rebuild_cache {
        my ($pkg, $exports, $cache) = @_;
        s/^&// foreach @$exports;
        @{$cache}{@$exports} = (1) x @$exports;
        my $ok = \@{"${pkg}::EXPORT_OK"};
        if (@$ok) {
    	s/^&// foreach @$ok;
    	@{$cache}{@$ok} = (1) x @$ok;
        }
    }
    
    sub heavy_export {
    
        # First make import warnings look like they're coming from the "use".
        local $SIG{__WARN__} = sub {
    	my $text = shift;
    	if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//) {
    	    require Carp;
    	    local $Carp::CarpLevel = 1;	# ignore package calling us too.
    	    Carp::carp($text);
    	}
    	else {
    	    warn $text;
    	}
        };
        local $SIG{__DIE__} = sub {
    	require Carp;
    	local $Carp::CarpLevel = 1;	# ignore package calling us too.
    	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
    	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
        };
    
        my($pkg, $callpkg, @imports) = @_;
        my($type, $sym, $cache_is_current, $oops);
        my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
                                       $Exporter::Cache{$pkg} ||= {});
    
        if (@imports) {
    	if (!%$export_cache) {
    	    _rebuild_cache ($pkg, $exports, $export_cache);
    	    $cache_is_current = 1;
    	}
    
    	if (grep m{^[/!:]}, @imports) {
    	    my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
    	    my $tagdata;
    	    my %imports;
    	    my($remove, $spec, @names, @allexports);
    	    # negated first item implies starting with default set:
    	    unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
    	    foreach $spec (@imports){
    		$remove = $spec =~ s/^!//;
    
    		if ($spec =~ s/^://){
    		    if ($spec eq 'DEFAULT'){
    			@names = @$exports;
    		    }
    		    elsif ($tagdata = $tagsref->{$spec}) {
    			@names = @$tagdata;
    		    }
    		    else {
    			warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
    			++$oops;
    			next;
    		    }
    		}
    		elsif ($spec =~ m:^/(.*)/$:){
    		    my $patn = $1;
    		    @allexports = keys %$export_cache unless @allexports; # only do keys once
    		    @names = grep(/$patn/, @allexports); # not anchored by default
    		}
    		else {
    		    @names = ($spec); # is a normal symbol name
    		}
    
    		warn "Import ".($remove ? "del":"add").": @names "
    		    if $Exporter::Verbose;
    
    		if ($remove) {
    		   foreach $sym (@names) { delete $imports{$sym} } 
    		}
    		else {
    		    @imports{@names} = (1) x @names;
    		}
    	    }
    	    @imports = keys %imports;
    	}
    
            my @carp;
    	foreach $sym (@imports) {
    	    if (!$export_cache->{$sym}) {
    		if ($sym =~ m/^\d/) {
    		    $pkg->VERSION($sym); # inherit from UNIVERSAL
    		    # If the version number was the only thing specified
    		    # then we should act as if nothing was specified:
    		    if (@imports == 1) {
    			@imports = @$exports;
    			last;
    		    }
    		    # We need a way to emulate 'use Foo ()' but still
    		    # allow an easy version check: "use Foo 1.23, ''";
    		    if (@imports == 2 and !$imports[1]) {
    			@imports = ();
    			last;
    		    }
    		} elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
    		    # Last chance - see if they've updated EXPORT_OK since we
    		    # cached it.
    
    		    unless ($cache_is_current) {
    			%$export_cache = ();
    			_rebuild_cache ($pkg, $exports, $export_cache);
    			$cache_is_current = 1;
    		    }
    
    		    if (!$export_cache->{$sym}) {
    			# accumulate the non-exports
    			push @carp,
    			  qq["$sym" is not exported by the $pkg module\n];
    			$oops++;
    		    }
    		}
    	    }
    	}
    	if ($oops) {
    	    require Carp;
    	    Carp::croak("@{carp}Can't continue after import errors");
    	}
        }
        else {
    	@imports = @$exports;
        }
    
        my($fail, $fail_cache) = (\@{"${pkg}::EXPORT_FAIL"},
                                  $Exporter::FailCache{$pkg} ||= {});
    
        if (@$fail) {
    	if (!%$fail_cache) {
    	    # Build cache of symbols. Optimise the lookup by adding
    	    # barewords twice... both with and without a leading &.
    	    # (Technique could be applied to $export_cache at cost of memory)
    	    my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @$fail;
    	    warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter::Verbose;
    	    @{$fail_cache}{@expanded} = (1) x @expanded;
    	}
    	my @failed;
    	foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->{$sym} }
    	if (@failed) {
    	    @failed = $pkg->export_fail(@failed);
    	    foreach $sym (@failed) {
                    require Carp;
    		Carp::carp(qq["$sym" is not implemented by the $pkg module ],
    			"on this architecture");
    	    }
    	    if (@failed) {
    		require Carp;
    		Carp::croak("Can't continue after import errors");
    	    }
    	}
        }
    
        warn "Importing into $callpkg from $pkg: ",
    		join(", ",sort @imports) if $Exporter::Verbose;
    
        foreach $sym (@imports) {
    	# shortcut for the common case of no type character
    	(*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
    	    unless $sym =~ s/^(\W)//;
    	$type = $1;
    	no warnings 'once';
    	*{"${callpkg}::$sym"} =
    	    $type eq '&' ? \&{"${pkg}::$sym"} :
    	    $type eq '$' ? \${"${pkg}::$sym"} :
    	    $type eq '@' ? \@{"${pkg}::$sym"} :
    	    $type eq '%' ? \%{"${pkg}::$sym"} :
    	    $type eq '*' ?  *{"${pkg}::$sym"} :
    	    do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
        }
    }
    
    sub heavy_export_to_level
    {
          my $pkg = shift;
          my $level = shift;
          (undef) = shift;			# XXX redundant arg
          my $callpkg = caller($level);
          $pkg->export($callpkg, @_);
    }
    
    # Utility functions
    
    sub _push_tags {
        my($pkg, $var, $syms) = @_;
        my @nontag = ();
        my $export_tags = \%{"${pkg}::EXPORT_TAGS"};
        push(@{"${pkg}::$var"},
    	map { $export_tags->{$_} ? @{$export_tags->{$_}} 
                                     : scalar(push(@nontag,$_),$_) }
    		(@$syms) ? @$syms : keys %$export_tags);
        if (@nontag and $^W) {
    	# This may change to a die one day
    	require Carp;
    	Carp::carp(join(", ", @nontag)." are not tags of $pkg");
        }
    }
    
    sub heavy_require_version {
        my($self, $wanted) = @_;
        my $pkg = ref $self || $self;
        return ${pkg}->VERSION($wanted);
    }
    
    sub heavy_export_tags {
      _push_tags((caller)[0], "EXPORT",    \@_);
    }
    
    sub heavy_export_ok_tags {
      _push_tags((caller)[0], "EXPORT_OK", \@_);
    }
    
    1;
  EXPORTER_HEAVY
  
  $fatpacked{"File/pushd.pm"} = <<'FILE_PUSHD';
    use strict;
    use warnings;
    package File::pushd;
    # ABSTRACT: change directory temporarily for a limited scope
    our $VERSION = '1.005'; # VERSION
    
    our @EXPORT  = qw( pushd tempd );
    our @ISA     = qw( Exporter );
    
    use Exporter;
    use Carp;
    use Cwd         qw( getcwd abs_path );
    use File::Path  qw( rmtree );
    use File::Temp  qw();
    use File::Spec;
    
    use overload
        q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) },
        fallback => 1;
    
    #--------------------------------------------------------------------------#
    # pushd()
    #--------------------------------------------------------------------------#
    
    sub pushd {
        my ($target_dir, $options) = @_;
        $options->{untaint_pattern} ||= qr{^([-+@\w./]+)$};
    
        $target_dir = "." unless defined $target_dir;
        croak "Can't locate directory $target_dir" unless -d $target_dir;
    
        my $tainted_orig = getcwd;
        my $orig;
        if ( $tainted_orig =~ $options->{untaint_pattern} ) {
          $orig = $1;
        }
        else {
          $orig = $tainted_orig;
        }
    
        my $tainted_dest;
        eval { $tainted_dest   = $target_dir ? abs_path( $target_dir ) : $orig };
        croak "Can't locate absolute path for $target_dir: $@" if $@;
    
        my $dest;
        if ( $tainted_dest =~ $options->{untaint_pattern} ) {
          $dest = $1;
        }
        else {
          $dest = $tainted_dest;
        }
    
        if ($dest ne $orig) {
            chdir $dest or croak "Can't chdir to $dest\: $!";
        }
    
        my $self = bless {
            _pushd => $dest,
            _original => $orig
        }, __PACKAGE__;
    
        return $self;
    }
    
    #--------------------------------------------------------------------------#
    # tempd()
    #--------------------------------------------------------------------------#
    
    sub tempd {
        my ($options) = @_;
        my $dir;
        eval { $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ), $options ) };
        croak $@ if $@;
        $dir->{_tempd} = 1;
        return $dir;
    }
    
    #--------------------------------------------------------------------------#
    # preserve()
    #--------------------------------------------------------------------------#
    
    sub preserve {
        my $self = shift;
        return 1 if ! $self->{"_tempd"};
        if ( @_ == 0 ) {
            return $self->{_preserve} = 1;
        }
        else {
            return $self->{_preserve} = $_[0] ? 1 : 0;
        }
    }
    
    #--------------------------------------------------------------------------#
    # DESTROY()
    # Revert to original directory as object is destroyed and cleanup
    # if necessary
    #--------------------------------------------------------------------------#
    
    sub DESTROY {
        my ($self) = @_;
        my $orig = $self->{_original};
        chdir $orig if $orig; # should always be so, but just in case...
        if ( $self->{_tempd} &&
            !$self->{_preserve} ) {
            # don't destroy existing $@ if there is no error.
            my $err = do {
                local $@;
                eval { rmtree( $self->{_pushd} ) };
                $@;
            };
            carp $err if $err;
        }
    }
    
    1;
    
    __END__
    
    =pod
    
    =head1 NAME
    
    File::pushd - change directory temporarily for a limited scope
    
    =head1 VERSION
    
    version 1.005
    
    =head1 SYNOPSIS
    
      use File::pushd;
     
      chdir $ENV{HOME};
     
      # change directory again for a limited scope
      {
          my $dir = pushd( '/tmp' );
          # working directory changed to /tmp
      }
      # working directory has reverted to $ENV{HOME}
     
      # tempd() is equivalent to pushd( File::Temp::tempdir )
      {
          my $dir = tempd();
      }
     
      # object stringifies naturally as an absolute path
      {
         my $dir = pushd( '/tmp' );
         my $filename = File::Spec->catfile( $dir, "somefile.txt" );
         # gives /tmp/somefile.txt
      }
    
    =head1 DESCRIPTION
    
    File::pushd does a temporary C<<< chdir >>> that is easily and automatically
    reverted, similar to C<<< pushd >>> in some Unix command shells.  It works by
    creating an object that caches the original working directory.  When the object
    is destroyed, the destructor calls C<<< chdir >>> to revert to the original working
    directory.  By storing the object in a lexical variable with a limited scope,
    this happens automatically at the end of the scope.
    
    This is very handy when working with temporary directories for tasks like
    testing; a function is provided to streamline getting a temporary
    directory from L<File::Temp>.
    
    For convenience, the object stringifies as the canonical form of the absolute
    pathname of the directory entered.
    
    =head1 USAGE
    
      use File::pushd;
    
    Using File::pushd automatically imports the C<<< pushd >>> and C<<< tempd >>> functions.
    
    =head2 pushd
    
      {
          my $dir = pushd( $target_directory );
      }
    
    Caches the current working directory, calls C<<< chdir >>> to change to the target
    directory, and returns a File::pushd object.  When the object is
    destroyed, the working directory reverts to the original directory.
    
    The provided target directory can be a relative or absolute path. If
    called with no arguments, it uses the current directory as its target and
    returns to the current directory when the object is destroyed.
    
    If the target directory does not exist or if the directory change fails
    for some reason, C<<< pushd >>> will die with an error message.
    
    Can be given a hashref as an optional second argument.  The only supported
    option is C<<< untaint_pattern >>>, which is used to untaint file paths involved.
    It defaults to C<<< qr{^([-+@\w./]+)$} >>>, which is reasonably restrictive (e.g.
    it does not even allow spaces in the path).  Change this to suit your
    circumstances and security needs if running under taint mode. B<Note>: you
    must include the parentheses in the pattern to capture the untainted
    portion of the path.
    
    =head2 tempd
    
      {
          my $dir = tempd();
      }
    
    This function is like C<<< pushd >>> but automatically creates and calls C<<< chdir >>> to
    a temporary directory created by L<File::Temp>. Unlike normal L<File::Temp>
    cleanup which happens at the end of the program, this temporary directory is
    removed when the object is destroyed. (But also see C<<< preserve >>>.)  A warning
    will be issued if the directory cannot be removed.
    
    As with C<<< pushd >>>, C<<< tempd >>> will die if C<<< chdir >>> fails.
    
    It may be given a single options hash that will be passed internally
    to CE<lt>pushdE<gt>.
    
    =head2 preserve
    
      {
          my $dir = tempd();
          $dir->preserve;      # mark to preserve at end of scope
          $dir->preserve(0);   # mark to delete at end of scope
      }
    
    Controls whether a temporary directory will be cleaned up when the object is
    destroyed.  With no arguments, C<<< preserve >>> sets the directory to be preserved.
    With an argument, the directory will be preserved if the argument is true, or
    marked for cleanup if the argument is false.  Only C<<< tempd >>> objects may be
    marked for cleanup.  (Target directories to C<<< pushd >>> are always preserved.)
    C<<< preserve >>> returns true if the directory will be preserved, and false
    otherwise.
    
    =head1 SEE ALSO
    
    =over
    
    =item *
    
    L<File::chdir>
    
    =back
    
    =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
    
    =head1 SUPPORT
    
    =head2 Bugs / Feature Requests
    
    Please report any bugs or feature requests through the issue tracker
    at L<https://github.com/dagolden/file-pushd/issues>.
    You will be notified automatically of any progress on your issue.
    
    =head2 Source Code
    
    This is open source software.  The code repository is available for
    public review and contribution under the terms of the license.
    
    L<https://github.com/dagolden/file-pushd>
    
      git clone git://github.com/dagolden/file-pushd.git
    
    =head1 AUTHOR
    
    David Golden <dagolden@cpan.org>
    
    =head1 CONTRIBUTOR
    
    Diab Jerius <djerius@cfa.harvard.edu>
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is Copyright (c) 2013 by David A Golden.
    
    This is free software, licensed under:
    
      The Apache License, Version 2.0, January 2004
    
    =cut
  FILE_PUSHD
  
  $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
    # vim: ts=4 sts=4 sw=4 et:
    package HTTP::Tiny;
    use strict;
    use warnings;
    # ABSTRACT: A small, simple, correct HTTP/1.1 client
    our $VERSION = '0.034'; # VERSION
    
    use Carp ();
    
    
    my @attributes;
    BEGIN {
        @attributes = qw(cookie_jar default_headers local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);
        no strict 'refs';
        for my $accessor ( @attributes ) {
            *{$accessor} = sub {
                @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
            };
        }
    }
    
    sub agent {
        my($self, $agent) = @_;
        if( @_ > 1 ){
            $self->{agent} =
                (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
        }
        return $self->{agent};
    }
    
    sub new {
        my($class, %args) = @_;
    
        my $self = {
            max_redirect => 5,
            timeout      => 60,
            verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
            no_proxy     => $ENV{no_proxy},
        };
    
        bless $self, $class;
    
        $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
    
        for my $key ( @attributes ) {
            $self->{$key} = $args{$key} if exists $args{$key}
        }
    
        $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
    
        # Never override proxy argument as this breaks backwards compat.
        if (!exists $self->{proxy} && (my $http_proxy = $ENV{http_proxy})) {
            if ($http_proxy =~ m{\Ahttp://[^/?#:@]+:\d+/?\z}) {
                $self->{proxy} = $http_proxy;
            }
            else {
                Carp::croak(qq{Environment 'http_proxy' must be in format http://<host>:<port>/\n});
            }
        }
    
        # Split no_proxy to array reference if not provided as such
        unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
            $self->{no_proxy} =
                (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
        }
    
        return $self;
    }
    
    
    for my $sub_name ( qw/get head put post delete/ ) {
        my $req_method = uc $sub_name;
        no strict 'refs';
        eval <<"HERE"; ## no critic
        sub $sub_name {
            my (\$self, \$url, \$args) = \@_;
            \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
            or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
            return \$self->request('$req_method', \$url, \$args || {});
        }
    HERE
    }
    
    
    sub post_form {
        my ($self, $url, $data, $args) = @_;
        (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
            or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
    
        my $headers = {};
        while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
            $headers->{lc $key} = $value;
        }
        delete $args->{headers};
    
        return $self->request('POST', $url, {
                %$args,
                content => $self->www_form_urlencode($data),
                headers => {
                    %$headers,
                    'content-type' => 'application/x-www-form-urlencoded'
                },
            }
        );
    }
    
    
    sub mirror {
        my ($self, $url, $file, $args) = @_;
        @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
          or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
        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: $!\n/);
        binmode $fh;
        $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: $!\n/);
        if ( $response->{success} ) {
            rename $tempfile, $file
                or Carp::croak(qq/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])/ . "\n");
        $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 = {
                url     => $url,
                success => q{},
                status  => 599,
                reason  => 'Internal Exception',
                content => $e,
                headers => {
                    'content-type'   => 'text/plain',
                    'content-length' => length $e,
                }
            };
        }
        return $response;
    }
    
    
    sub www_form_urlencode {
        my ($self, $data) = @_;
        (@_ == 2 && ref $data)
            or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
        (ref $data eq 'HASH' || ref $data eq 'ARRAY')
            or Carp::croak("form data must be a hash or array reference\n");
    
        my @params = ref $data eq 'HASH' ? %$data : @$data;
        @params % 2 == 0
            or Carp::croak("form data reference must have an even number of terms\n");
    
        my @terms;
        while( @params ) {
            my ($key, $value) = splice(@params, 0, 2);
            if ( ref $value eq 'ARRAY' ) {
                unshift @params, map { $key => $_ } @$value;
            }
            else {
                push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
            }
        }
    
        return join("&", sort @terms);
    }
    
    #--------------------------------------------------------------------------#
    # private methods
    #--------------------------------------------------------------------------#
    
    my %DefaultPort = (
        http => 80,
        https => 443,
    );
    
    sub _agent {
        my $class = ref($_[0]) || $_[0];
        (my $default_agent = $class) =~ s{::}{-}g;
        return $default_agent . "/" . ($class->VERSION || 0);
    }
    
    sub _request {
        my ($self, $method, $url, $args) = @_;
    
        my ($scheme, $host, $port, $path_query, $auth) = $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},
            SSL_options     => $self->{SSL_options},
            verify_SSL      => $self->{verify_SSL},
            local_address   => $self->{local_address},
        );
    
        if ($self->{proxy} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
            $request->{uri} = "$scheme://$request->{host_port}$path_query";
            die(qq/HTTPS via proxy is not supported\n/)
                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, $url, $auth);
        $handle->write_request($request);
    
        my $response;
        do { $response = $handle->read_response_header }
            until (substr($response->{status},0,1) ne '1');
    
        $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
    
        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';
        $response->{url} = $url;
        return $response;
    }
    
    sub _prepare_headers_and_cb {
        my ($self, $request, $args, $url, $auth) = @_;
    
        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} ) {
            if (ref $args->{content} eq 'CODE') {
                $request->{headers}{'content-type'} ||= "application/octet-stream";
                $request->{headers}{'transfer-encoding'} = 'chunked'
                  unless $request->{headers}{'content-length'}
                      || $request->{headers}{'transfer-encoding'};
                $request->{cb} = $args->{content};
            }
            elsif ( length $args->{content} ) {
                my $content = $args->{content};
                if ( $] ge '5.008' ) {
                    utf8::downgrade($content, 1)
                        or die(qq/Wide character in request message body\n/);
                }
                $request->{headers}{'content-type'} ||= "application/octet-stream";
                $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';
        }
    
        ### If we have a cookie jar, then maybe add relevant cookies
        if ( $self->{cookie_jar} ) {
            my $cookies = $self->cookie_jar->cookie_header( $url );
            $request->{headers}{cookie} = $cookies if length $cookies;
        }
    
        # if we have Basic auth parameters, add them
        if ( length $auth && ! defined $request->{headers}{authentication} ) {
            require MIME::Base64;
            $request->{headers}{authorization} =
                "Basic " . MIME::Base64::encode_base64($auth, "");
        }
    
        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 _update_cookie_jar {
        my ($self, $url, $response) = @_;
    
        my $cookies = $response->{headers}->{'set-cookie'};
        return unless defined $cookies;
    
        my @cookies = ref $cookies ? @$cookies : $cookies;
    
        $self->cookie_jar->add( $url, $_ ) for @cookies;
    
        return;
    }
    
    sub _validate_cookie_jar {
        my ($class, $jar) = @_;
    
        # duck typing
        for my $method ( qw/add cookie_header/ ) {
            Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
                unless ref($jar) && ref($jar)->can($method);
        }
    
        return;
    }
    
    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 die(qq/Cannot parse URL: '$url'\n/);
    
        $scheme     = lc $scheme;
        $path_query = "/$path_query" unless $path_query =~ m<\A/>;
    
        my ($auth,$host);
        $authority = (length($authority)) ? $authority : 'localhost';
        if ( $authority =~ /@/ ) {
            ($auth,$host) = $authority =~ m/\A([^@]*)@(.*)\z/;   # user:pass@host
        }
        else {
            $host = $authority;
            $auth = '';
        }
        $host = lc $host;
        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, $auth);
    }
    
    # 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;
        };
    }
    
    # URI escaping adapted from URI::Escape
    # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
    # perl 5.6 ready UTF-8 encoding adapted from JSON::PP
    my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
    $escapes{' '}="+";
    my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
    
    sub _uri_escape {
        my ($self, $str) = @_;
        if ( $] ge '5.008' ) {
            utf8::encode($str);
        }
        else {
            $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
                if ( length $str == do { use bytes; length $str } );
            $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
        }
        $str =~ s/($unsafe_char)/$escapes{$1}/ge;
        return $str;
    }
    
    package
        HTTP::Tiny::Handle; # hide from PAUSE/indexers
    use strict;
    use warnings;
    
    use Errno      qw[EINTR EPIPE];
    use IO::Socket qw[SOCK_STREAM];
    
    sub BUFSIZE () { 32768 } ## no critic
    
    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,
            verify_SSL       => 0,
            SSL_options      => {},
            %args
        }, $class;
    }
    
    sub connect {
        @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
        my ($self, $scheme, $host, $port) = @_;
    
        if ( $scheme eq 'https' ) {
            # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
            die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
                unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
            # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
            die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
                unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
        }
        elsif ( $scheme ne 'http' ) {
          die(qq/Unsupported URL scheme '$scheme'\n/);
        }
        $self->{fh} = 'IO::Socket::INET'->new(
            PeerHost  => $host,
            PeerPort  => $port,
            $self->{local_address} ?
                ( LocalAddr => $self->{local_address} ) : (),
            Proto     => 'tcp',
            Type      => SOCK_STREAM,
            Timeout   => $self->{timeout}
        ) or die(qq/Could not connect to '$host:$port': $@\n/);
    
        binmode($self->{fh})
          or die(qq/Could not binmode() socket: '$!'\n/);
    
        if ( $scheme eq 'https') {
            my $ssl_args = $self->_ssl_args($host);
            IO::Socket::SSL->start_SSL(
                $self->{fh},
                %$ssl_args,
                SSL_create_ctx_callback => sub {
                    my $ctx = shift;
                    Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
                },
            );
    
            unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
                my $ssl_err = IO::Socket::SSL->errstr;
                die(qq/SSL connection failed for $host: $ssl_err\n/);
            }
        }
    
        $self->{host} = $host;
        $self->{port} = $port;
    
        return $self;
    }
    
    sub close {
        @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
        my ($self) = @_;
        CORE::close($self->{fh})
          or die(qq/Could not close socket: '$!'\n/);
    }
    
    sub write {
        @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
        my ($self, $buf) = @_;
    
        if ( $] ge '5.008' ) {
            utf8::downgrade($buf, 1)
                or die(qq/Wide character in write()\n/);
        }
    
        my $len = length $buf;
        my $off = 0;
    
        local $SIG{PIPE} = 'IGNORE';
    
        while () {
            $self->can_write
              or die(qq/Timed out while waiting for socket to become ready for writing\n/);
            my $r = syswrite($self->{fh}, $buf, $len, $off);
            if (defined $r) {
                $len -= $r;
                $off += $r;
                last unless $len > 0;
            }
            elsif ($! == EPIPE) {
                die(qq/Socket closed by remote server: $!\n/);
            }
            elsif ($! != EINTR) {
                if ($self->{fh}->can('errstr')){
                    my $err = $self->{fh}->errstr();
                    die (qq/Could not write to SSL socket: '$err'\n /);
                }
                else {
                    die(qq/Could not write to socket: '$!'\n/);
                }
    
            }
        }
        return $off;
    }
    
    sub read {
        @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
        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 die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
            my $r = sysread($self->{fh}, $buf, $len, length $buf);
            if (defined $r) {
                last unless $r;
                $len -= $r;
            }
            elsif ($! != EINTR) {
                if ($self->{fh}->can('errstr')){
                    my $err = $self->{fh}->errstr();
                    die (qq/Could not read from SSL socket: '$err'\n /);
                }
                else {
                    die(qq/Could not read from socket: '$!'\n/);
                }
            }
        }
        if ($len && !$allow_partial) {
            die(qq/Unexpected end of stream\n/);
        }
        return $buf;
    }
    
    sub readline {
        @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
        my ($self) = @_;
    
        while () {
            if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
                return $1;
            }
            if (length $self->{rbuf} >= $self->{max_line_size}) {
                die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
            }
            $self->can_read
              or die(qq/Timed out while waiting for socket to become ready for reading\n/);
            my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
            if (defined $r) {
                last unless $r;
            }
            elsif ($! != EINTR) {
                if ($self->{fh}->can('errstr')){
                    my $err = $self->{fh}->errstr();
                    die (qq/Could not read from SSL socket: '$err'\n /);
                }
                else {
                    die(qq/Could not read from socket: '$!'\n/);
                }
            }
        }
        die(qq/Unexpected end of stream while looking for line\n/);
    }
    
    sub read_header_lines {
        @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
        my ($self, $headers) = @_;
        $headers ||= {};
        my $lines   = 0;
        my $val;
    
        while () {
             my $line = $self->readline;
    
             if (++$lines >= $self->{max_header_lines}) {
                 die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
             }
             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 die(qq/Unexpected header continuation line\n/);
                 next unless length $1;
                 $$val .= ' ' if length $$val;
                 $$val .= $1;
             }
             elsif ($line =~ /\A \x0D?\x0A \z/x) {
                last;
             }
             else {
                die(q/Malformed header line: / . $Printable->($line) . "\n");
             }
        }
        return $headers;
    }
    
    sub write_request {
        @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
        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') || die(q/Usage: $handle->write_header_lines(headers)/ . "\n");
        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 die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
                $field_name =~ s/\b(\w)/\u$1/g;
                $HeaderCase{lc $field_name} = $field_name;
            }
            for (ref $v eq 'ARRAY' ? @$v : $v) {
                /[^\x0D\x0A]/
                  or die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n");
                $buf .= "$field_name: $_\x0D\x0A";
            }
        }
        $buf .= "\x0D\x0A";
        return $self->write($buf);
    }
    
    sub read_body {
        @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
        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 || die(q/Usage: $handle->write_body(request)/ . "\n");
        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 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
        my ($self, $cb, $response, $content_length) = @_;
        $content_length ||= $response->{headers}{'content-length'};
    
        if ( defined $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 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
        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 die(qq/Wide character in write_content()\n/);
            }
    
            $len += $self->write($data);
        }
    
        $len == $content_length
          or die(qq/Content-Length missmatch (got: $len expected: $content_length)\n/);
    
        return $len;
    }
    
    sub read_chunked_body {
        @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
        my ($self, $cb, $response) = @_;
    
        while () {
            my $head = $self->readline;
    
            $head =~ /\A ([A-Fa-f0-9]+)/x
              or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
    
            my $len = hex($1)
              or last;
    
            $self->read_content_body($cb, $response, $len);
    
            $self->read(2) eq "\x0D\x0A"
              or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
        }
        $self->read_header_lines($response->{headers});
        return;
    }
    
    sub write_chunked_body {
        @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
        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 die(qq/Wide character in write_chunked_body()\n/);
            }
    
            $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 || die(q/Usage: $handle->read_response_header()/ . "\n");
        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 die(q/Malformed Status-Line: / . $Printable->($line). "\n");
    
        my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
    
        die (qq/Unsupported HTTP protocol: $protocol\n/)
            unless $version =~ /0*1\.0*[01]/;
    
        return {
            status   => $status,
            reason   => $reason,
            headers  => $self->read_header_lines,
            protocol => $protocol,
        };
    }
    
    sub write_request_header {
        @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
        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 die(qq/select(2): 'Bad file descriptor'\n/);
    
        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 die(qq/select(2): '$!'\n/);
                redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
                $nfound = 0;
            }
            last;
        }
        $! = 0;
        return $nfound;
    }
    
    sub can_read {
        @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
        my $self = shift;
        return $self->_do_timeout('read', @_)
    }
    
    sub can_write {
        @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
        my $self = shift;
        return $self->_do_timeout('write', @_)
    }
    
    # Try to find a CA bundle to validate the SSL cert,
    # prefer Mozilla::CA or fallback to a system file
    sub _find_CA_file {
        my $self = shift();
    
        return $self->{SSL_options}->{SSL_ca_file}
            if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file};
    
        return Mozilla::CA::SSL_ca_file()
            if eval { require Mozilla::CA };
    
        foreach my $ca_bundle (qw{
            /etc/ssl/certs/ca-certificates.crt
            /etc/pki/tls/certs/ca-bundle.crt
            /etc/ssl/ca-bundle.pem
            }
        ) {
            return $ca_bundle if -e $ca_bundle;
        }
    
        die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
          . qq/Try installing Mozilla::CA from CPAN\n/;
    }
    
    sub _ssl_args {
        my ($self, $host) = @_;
    
        my %ssl_args;
        
        # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
        # added until IO::Socket::SSL 1.84
        if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
            $ssl_args{SSL_hostname} = $host,          # Sane SNI support
        }
    
        if ($self->{verify_SSL}) {
            $ssl_args{SSL_verifycn_scheme}  = 'http'; # enable CN validation
            $ssl_args{SSL_verifycn_name}    = $host;  # set validation hostname
            $ssl_args{SSL_verify_mode}      = 0x01;   # enable cert validation
            $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
        }
        else {
            $ssl_args{SSL_verifycn_scheme}  = 'none'; # disable CN validation
            $ssl_args{SSL_verify_mode}      = 0x00;   # disable cert validation
        }
    
        # user options override settings from verify_SSL
        for my $k ( keys %{$self->{SSL_options}} ) {
            $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
        }
    
        return \%ssl_args;
    }
    
    1;
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    HTTP::Tiny - A small, simple, correct HTTP/1.1 client
    
    =head1 VERSION
    
    version 0.034
    
    =head1 SYNOPSIS
    
        use HTTP::Tiny;
    
        my $response = HTTP::Tiny->new->get('http://example.com/');
    
        die "Failed!\n" unless $response->{success};
    
        print "$response->{status} $response->{reason}\n";
    
        while (my ($k, $v) = each %{$response->{headers}}) {
            for (ref $v eq 'ARRAY' ? @$v : $v) {
                print "$k: $_\n";
            }
        }
    
        print $response->{content} if length $response->{content};
    
    =head1 DESCRIPTION
    
    This is a very simple HTTP/1.1 client, designed for doing simple GET
    requests without the overhead of a large framework like L<LWP::UserAgent>.
    
    It is more correct and more complete than L<HTTP::Lite>.  It supports
    proxies (currently only non-authenticating ones) and redirection.  It
    also correctly resumes after EINTR.
    
    =head1 METHODS
    
    =head2 new
    
        $http = HTTP::Tiny->new( %attributes );
    
    This constructor returns a new HTTP::Tiny object.  Valid attributes include:
    
    =over 4
    
    =item *
    
    C<agent>
    
    A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended.
    
    =item *
    
    C<cookie_jar>
    
    An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods
    
    =item *
    
    C<default_headers>
    
    A hashref of default headers to apply to requests
    
    =item *
    
    C<local_address>
    
    The local IP address to bind to
    
    =item *
    
    C<max_redirect>
    
    Maximum number of redirects allowed (defaults to 5)
    
    =item *
    
    C<max_size>
    
    Maximum response size (only when not using a data callback).  If defined,
    responses larger than this will return an exception.
    
    =item *
    
    C<proxy>
    
    URL of a proxy server to use (default is C<$ENV{http_proxy}> if set)
    
    =item *
    
    C<no_proxy>
    
    List of domain suffixes that should not be proxied.  Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}>)
    
    =item *
    
    C<timeout>
    
    Request timeout in seconds (default is 60)
    
    =item *
    
    C<verify_SSL>
    
    A boolean that indicates whether to validate the SSL certificate of an C<https>
    connection (default is false)
    
    =item *
    
    C<SSL_options>
    
    A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
    
    =back
    
    Exceptions from C<max_size>, C<timeout> or other errors will result in a
    pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
    content field in the response will contain the text of the exception.
    
    See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
    
    =head2 get|head|put|post|delete
    
        $response = $http->get($url);
        $response = $http->get($url, \%options);
        $response = $http->head($url);
    
    These methods are shorthand for calling C<request()> for the given method.  The
    URL must have unsafe characters escaped and international domain names encoded.
    See C<request()> for valid options and a description of the response.
    
    The C<success> field of the response will be true if the status code is 2XX.
    
    =head2 post_form
    
        $response = $http->post_form($url, $form_data);
        $response = $http->post_form($url, $form_data, \%options);
    
    This method executes a C<POST> request and sends the key/value pairs from a
    form data hash or array reference to the given URL with a C<content-type> of
    C<application/x-www-form-urlencoded>.  See documentation for the
    C<www_form_urlencode> method for details on the encoding.
    
    The URL must have unsafe characters escaped and international domain names
    encoded.  See C<request()> for valid options and a description of the response.
    Any C<content-type> header or content in the options hashref will be ignored.
    
    The C<success> field of the response will be true if the status code is 2XX.
    
    =head2 mirror
    
        $response = $http->mirror($url, $file, \%options)
        if ( $response->{success} ) {
            print "$file is up to date\n";
        }
    
    Executes a C<GET> request for the URL and saves the response body to the file
    name provided.  The URL must have unsafe characters escaped and international
    domain names encoded.  If the file already exists, the request will include an
    C<If-Modified-Since> header with the modification timestamp of the file.  You
    may specify a different C<If-Modified-Since> header yourself in the C<<
    $options->{headers} >> hash.
    
    The C<success> field of the response will be true if the status code is 2XX
    or if the status code is 304 (unmodified).
    
    If the file was modified and the server response includes a properly
    formatted C<Last-Modified> header, the file modification time will
    be updated accordingly.
    
    =head2 request
    
        $response = $http->request($method, $url);
        $response = $http->request($method, $url, \%options);
    
    Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
    'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
    international domain names encoded.
    
    If the URL includes a "user:password" stanza, they will be used for Basic-style
    authorization headers.  (Authorization headers will not be included in a
    redirected request.) For example:
    
        $http->request('GET', 'http://Aladdin:open sesame@example.com/');
    
    A hashref of options may be appended to modify the request.
    
    Valid options are:
    
    =over 4
    
    =item *
    
    C<headers>
    
    A hashref containing headers to include with the request.  If the value for
    a header is an array reference, the header will be output multiple times with
    each value in the array.  These headers over-write any default headers.
    
    =item *
    
    C<content>
    
    A scalar to include as the body of the request OR a code reference
    that will be called iteratively to produce the body of the request
    
    =item *
    
    C<trailer_callback>
    
    A code reference that will be called if it exists to provide a hashref
    of trailing headers (only used with chunked transfer-encoding)
    
    =item *
    
    C<data_callback>
    
    A code reference that will be called for each chunks of the response
    body received.
    
    =back
    
    If the C<content> option is a code reference, it will be called iteratively
    to provide the content body of the request.  It should return the empty
    string or undef when the iterator is exhausted.
    
    If the C<content> option is the empty string, no C<content-type> or
    C<content-length> headers will be generated.
    
    If the C<data_callback> option is provided, it will be called iteratively until
    the entire response body is received.  The first argument will be a string
    containing a chunk of the response body, the second argument will be the
    in-progress response hash reference, as described below.  (This allows
    customizing the action of the callback based on the C<status> or C<headers>
    received prior to the content body.)
    
    The C<request> method returns a hashref containing the response.  The hashref
    will have the following keys:
    
    =over 4
    
    =item *
    
    C<success>
    
    Boolean indicating whether the operation returned a 2XX status code
    
    =item *
    
    C<url>
    
    URL that provided the response. This is the URL of the request unless
    there were redirections, in which case it is the last URL queried
    in a redirection chain
    
    =item *
    
    C<status>
    
    The HTTP status code of the response
    
    =item *
    
    C<reason>
    
    The response phrase returned by the server
    
    =item *
    
    C<content>
    
    The body of the response.  If the response does not have any content
    or if a data callback is provided to consume the response body,
    this will be the empty string
    
    =item *
    
    C<headers>
    
    A hashref of header fields.  All header field names will be normalized
    to be lower case. If a header is repeated, the value will be an arrayref;
    it will otherwise be a scalar string containing the value
    
    =back
    
    On an exception during the execution of the request, the C<status> field will
    contain 599, and the C<content> field will contain the text of the exception.
    
    =head2 www_form_urlencode
    
        $params = $http->www_form_urlencode( $data );
        $response = $http->get("http://example.com/query?$params");
    
    This method converts the key/value pairs from a data hash or array reference
    into a C<x-www-form-urlencoded> string.  The keys and values from the data
    reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
    array reference, the key will be repeated with each of the values of the array
    reference.  The key/value pairs in the resulting string will be sorted by key
    and value.
    
    =for Pod::Coverage agent
    cookie_jar
    default_headers
    local_address
    max_redirect
    max_size
    proxy
    no_proxy
    timeout
    verify_SSL
    SSL_options
    
    =head1 SSL SUPPORT
    
    Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
    greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
    thrown if a new enough versions of these modules not installed or if the SSL
    encryption fails. There is no support for C<https> connections via proxy (i.e.
    RFC 2817).
    
    SSL provides two distinct capabilities:
    
    =over 4
    
    =item *
    
    Encrypted communication channel
    
    =item *
    
    Verification of server identity
    
    =back
    
    B<By default, HTTP::Tiny does not verify server identity>.
    
    Server identity verification is controversial and potentially tricky because it
    depends on a (usually paid) third-party Certificate Authority (CA) trust model
    to validate a certificate as legitimate.  This discriminates against servers
    with self-signed certificates or certificates signed by free, community-driven
    CA's such as L<CAcert.org|http://cacert.org>.
    
    By default, HTTP::Tiny does not make any assumptions about your trust model,
    threat level or risk tolerance.  It just aims to give you an encrypted channel
    when you need one.
    
    Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
    that an SSL connection has a valid SSL certificate corresponding to the host
    name of the connection and that the SSL certificate has been verified by a CA.
    Assuming you trust the CA, this will protect against a L<man-in-the-middle
    attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
    concerned about security, you should enable this option.
    
    Certificate verification requires a file containing trusted CA certificates.
    If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
    included with it as a source of trusted CA's.  (This means you trust Mozilla,
    the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
    toolchain used to install it, and your operating system security, right?)
    
    If that module is not available, then HTTP::Tiny will search several
    system-specific default locations for a CA certificate file:
    
    =over 4
    
    =item *
    
    /etc/ssl/certs/ca-certificates.crt
    
    =item *
    
    /etc/pki/tls/certs/ca-bundle.crt
    
    =item *
    
    /etc/ssl/ca-bundle.pem
    
    =back
    
    An exception will be raised if C<verify_SSL> is true and no CA certificate file
    is available.
    
    If you desire complete control over SSL connections, the C<SSL_options> attribute
    lets you provide a hash reference that will be passed through to
    C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
    example, to provide your own trusted CA file:
    
        SSL_options => {
            SSL_ca_file => $file_path,
        }
    
    The C<SSL_options> attribute could also be used for such things as providing a
    client certificate for authentication to a server or controlling the choice of
    cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
    details.
    
    =head1 LIMITATIONS
    
    HTTP::Tiny is I<conditionally compliant> with the
    L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>.
    It attempts to meet all "MUST" requirements of the specification, but does not
    implement all "SHOULD" requirements.
    
    Some particular limitations of note include:
    
    =over
    
    =item *
    
    HTTP::Tiny focuses on correct transport.  Users are responsible for ensuring
    that user-defined headers and content are compliant with the HTTP/1.1
    specification.
    
    =item *
    
    Users must ensure that URLs are properly escaped for unsafe characters and that
    international domain names are properly encoded to ASCII. See L<URI::Escape>,
    L<URI::_punycode> and L<Net::IDN::Encode>.
    
    =item *
    
    Redirection is very strict against the specification.  Redirection is only
    automatic for response codes 301, 302 and 307 if the request method is 'GET' or
    'HEAD'.  Response code 303 is always converted into a 'GET' redirection, as
    mandated by the specification.  There is no automatic support for status 305
    ("Use proxy") redirections.
    
    =item *
    
    Persistent connections are not supported.  The C<Connection> header will
    always be set to C<close>.
    
    =item *
    
    Cookie support requires L<HTTP::CookieJar> or an equivalent class.
    
    =item *
    
    Only the C<http_proxy> environment variable is supported in the format
    C<http://HOST:PORT/>.  If a C<proxy> argument is passed to C<new> (including
    undef), then the C<http_proxy> environment variable is ignored.
    
    =item *
    
    C<no_proxy> environment variable is supported in the format comma-separated
    list of domain extensions proxy should not be used for.  If a C<no_proxy>
    argument is passed to C<new>, then the C<no_proxy> environment variable is
    ignored.
    
    =item *
    
    There is no provision for delaying a request body using an C<Expect> header.
    Unexpected C<1XX> responses are silently ignored as per the specification.
    
    =item *
    
    Only 'chunked' C<Transfer-Encoding> is supported.
    
    =item *
    
    There is no support for a Request-URI of '*' for the 'OPTIONS' request.
    
    =item *
    
    There is no support for IPv6 of any kind.
    
    =back
    
    =head1 SEE ALSO
    
    =over 4
    
    =item *
    
    L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility
    
    =item *
    
    L<HTTP::Tiny::Mech> - Wrap L<WWW::Mechanize> instance in HTTP::Tiny compatible interface
    
    =item *
    
    L<IO::Socket::SSL> - Required for SSL support
    
    =item *
    
    L<LWP::UserAgent> - If HTTP::Tiny isn't enough for you, this is the "standard" way to do things
    
    =item *
    
    L<Mozilla::CA> - Required if you want to validate SSL certificates
    
    =item *
    
    L<Net::SSLeay> - Required for SSL support
    
    =back
    
    =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
    
    =head1 SUPPORT
    
    =head2 Bugs / Feature Requests
    
    Please report any bugs or feature requests through the issue tracker
    at L<https://github.com/chansen/p5-http-tiny/issues>.
    You will be notified automatically of any progress on your issue.
    
    =head2 Source Code
    
    This is open source software.  The code repository is available for
    public review and contribution under the terms of the license.
    
    L<https://github.com/chansen/p5-http-tiny>
    
      git clone git://github.com/chansen/p5-http-tiny.git
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    Christian Hansen <chansen@cpan.org>
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =back
    
    =head1 CONTRIBUTORS
    
    =over 4
    
    =item *
    
    Alan Gardner <gardner@pythian.com>
    
    =item *
    
    Alessandro Ghedini <al3xbio@gmail.com>
    
    =item *
    
    Brad Gilbert <bgills@cpan.org>
    
    =item *
    
    Chris Nehren <apeiron@cpan.org>
    
    =item *
    
    Chris Weyl <cweyl@alumni.drew.edu>
    
    =item *
    
    Claes Jakobsson <claes@surfar.nu>
    
    =item *
    
    Craig Berry <cberry@cpan.org>
    
    =item *
    
    David Mitchell <davem@iabyn.com>
    
    =item *
    
    Edward Zborowski <ed@rubensteintech.com>
    
    =item *
    
    Jess Robinson <castaway@desert-island.me.uk>
    
    =item *
    
    Lukas Eklund <leklund@gmail.com>
    
    =item *
    
    Martin-Louis Bright <mlbright@gmail.com>
    
    =item *
    
    Mike Doherty <doherty@cpan.org>
    
    =item *
    
    Serguei Trouchelle <stro@cpan.org>
    
    =item *
    
    Syohei YOSHIDA <syohex@gmail.com>
    
    =item *
    
    Tony Cook <tony@develop-help.com>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2013 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.
    
    =cut
  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.27202';
    
    @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
    
    =head1 NAME
    
    JSON::PP - JSON::XS compatible pure-Perl module.
    
    =head1 SYNOPSIS
    
     use JSON::PP;
    
     # exported functions, they croak on error
     # and expect/generate UTF-8
    
     $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
     $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
    
     # OO-interface
    
     $coder = JSON::PP->new->ascii->pretty->allow_nonref;
     
     $json_text   = $json->encode( $perl_scalar );
     $perl_scalar = $json->decode( $json_text );
     
     $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
     
     # Note that JSON version 2.0 and above will automatically use
     # JSON::XS or JSON::PP, so you should be able to just:
     
     use JSON;
    
    
    =head1 VERSION
    
        2.27202
    
    L<JSON::XS> 2.27 (~2.30) compatible.
    
    =head1 NOTE
    
    JSON::PP had been inculded in JSON distribution (CPAN module).
    It was a perl core module in Perl 5.14.
    
    =head1 DESCRIPTION
    
    This module is L<JSON::XS> compatible pure Perl module.
    (Perl 5.8 or later is recommended)
    
    JSON::XS is the fastest and most proper JSON module on CPAN.
    It is written by Marc Lehmann in C, so must be compiled and
    installed in the used environment.
    
    JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
    
    
    =head2 FEATURES
    
    =over
    
    =item * correct unicode handling
    
    This module knows how to handle Unicode (depending on Perl version).
    
    See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and L<UNICODE HANDLING ON PERLS>.
    
    
    =item * round-trip integrity
    
    When you serialise a perl data structure using only data types supported
    by JSON and Perl, the deserialised data structure is identical on the Perl
    level. (e.g. the string "2.0" doesn't suddenly become "2" just because
    it looks like a number). There I<are> minor exceptions to this, read the
    MAPPING section below to learn about those.
    
    
    =item * strict checking of JSON correctness
    
    There is no guessing, no generating of illegal JSON texts by default,
    and only JSON is accepted as input by default (the latter is a security feature).
    But when some options are set, loose chcking features are available.
    
    =back
    
    =head1 FUNCTIONAL INTERFACE
    
    Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
    
    =head2 encode_json
    
        $json_text = encode_json $perl_scalar
    
    Converts the given Perl data structure to a UTF-8 encoded, binary string.
    
    This function call is functionally identical to:
    
        $json_text = JSON::PP->new->utf8->encode($perl_scalar)
    
    =head2 decode_json
    
        $perl_scalar = decode_json $json_text
    
    The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
    to parse that as an UTF-8 encoded JSON text, returning the resulting
    reference.
    
    This function call is functionally identical to:
    
        $perl_scalar = JSON::PP->new->utf8->decode($json_text)
    
    =head2 JSON::PP::is_bool
    
        $is_boolean = JSON::PP::is_bool($scalar)
    
    Returns true if the passed scalar represents either JSON::PP::true or
    JSON::PP::false, two constants that act like C<1> and C<0> respectively
    and are also used to represent JSON C<true> and C<false> in Perl strings.
    
    =head2 JSON::PP::true
    
    Returns JSON true value which is blessed object.
    It C<isa> JSON::PP::Boolean object.
    
    =head2 JSON::PP::false
    
    Returns JSON false value which is blessed object.
    It C<isa> JSON::PP::Boolean object.
    
    =head2 JSON::PP::null
    
    Returns C<undef>.
    
    See L<MAPPING>, below, for more information on how JSON values are mapped to
    Perl.
    
    
    =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
    
    This section supposes that your perl vresion is 5.8 or later.
    
    If you know a JSON text from an outer world - a network, a file content, and so on,
    is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
    with C<utf8> enable. And the decoded result will contain UNICODE characters.
    
      # from network
      my $json        = JSON::PP->new->utf8;
      my $json_text   = CGI->new->param( 'json_data' );
      my $perl_scalar = $json->decode( $json_text );
      
      # from file content
      local $/;
      open( my $fh, '<', 'json.data' );
      $json_text   = <$fh>;
      $perl_scalar = decode_json( $json_text );
    
    If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
    
      use Encode;
      local $/;
      open( my $fh, '<', 'json.data' );
      my $encoding = 'cp932';
      my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
      
      # or you can write the below code.
      #
      # open( my $fh, "<:encoding($encoding)", 'json.data' );
      # $unicode_json_text = <$fh>;
    
    In this case, C<$unicode_json_text> is of course UNICODE string.
    So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
    Instead of them, you use C<JSON> module object with C<utf8> disable.
    
      $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
    
    Or C<encode 'utf8'> and C<decode_json>:
    
      $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
      # this way is not efficient.
    
    And now, you want to convert your C<$perl_scalar> into JSON data and
    send it to an outer world - a network or a file content, and so on.
    
    Your data usually contains UNICODE strings and you want the converted data to be encoded
    in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
    
      print encode_json( $perl_scalar ); # to a network? file? or display?
      # or
      print $json->utf8->encode( $perl_scalar );
    
    If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
    for some reason, then its characters are regarded as B<latin1> for perl
    (because it does not concern with your $encoding).
    You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
    Instead of them, you use C<JSON> module object with C<utf8> disable.
    Note that the resulted text is a UNICODE string but no problem to print it.
    
      # $perl_scalar contains $encoding encoded string values
      $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
      # $unicode_json_text consists of characters less than 0x100
      print $unicode_json_text;
    
    Or C<decode $encoding> all string values and C<encode_json>:
    
      $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
      # ... do it to each string values, then encode_json
      $json_text = encode_json( $perl_scalar );
    
    This method is a proper way but probably not efficient.
    
    See to L<Encode>, L<perluniintro>.
    
    
    =head1 METHODS
    
    Basically, check to L<JSON> or L<JSON::XS>.
    
    =head2 new
    
        $json = JSON::PP->new
    
    Rturns a new JSON::PP object that can be used to de/encode JSON
    strings.
    
    All boolean flags described below are by default I<disabled>.
    
    The mutators for flags all return the JSON object again and thus calls can
    be chained:
    
       my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
       => {"a": [1, 2]}
    
    =head2 ascii
    
        $json = $json->ascii([$enable])
        
        $enabled = $json->get_ascii
    
    If $enable is true (or missing), then the encode method will not generate characters outside
    the code range 0..127. Any Unicode characters outside that range will be escaped using either
    a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
    (See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>).
    
    In Perl 5.005, there is no character having high value (more than 255).
    See to L<UNICODE HANDLING ON PERLS>.
    
    If $enable is false, then the encode method will not escape Unicode characters unless
    required by the JSON syntax or other flags. This results in a faster and more compact format.
    
      JSON::PP->new->ascii(1)->encode([chr 0x10401])
      => ["\ud801\udc01"]
    
    =head2 latin1
    
        $json = $json->latin1([$enable])
        
        $enabled = $json->get_latin1
    
    If $enable is true (or missing), then the encode method will encode the resulting JSON
    text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
    
    If $enable is false, then the encode method will not escape Unicode characters
    unless required by the JSON syntax or other flags.
    
      JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
      => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
    
    See to L<UNICODE HANDLING ON PERLS>.
    
    =head2 utf8
    
        $json = $json->utf8([$enable])
        
        $enabled = $json->get_utf8
    
    If $enable is true (or missing), then the encode method will encode the JSON result
    into UTF-8, as required by many protocols, while the decode method expects to be handled
    an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
    characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
    
    (In Perl 5.005, any character outside the range 0..255 does not exist.
    See to L<UNICODE HANDLING ON PERLS>.)
    
    In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
    encoding families, as described in RFC4627.
    
    If $enable is false, then the encode method will return the JSON string as a (non-encoded)
    Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
    (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
    
    Example, output UTF-16BE-encoded JSON:
    
      use Encode;
      $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);
    
    Example, decode UTF-32LE-encoded JSON:
    
      use Encode;
      $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);
    
    
    =head2 pretty
    
        $json = $json->pretty([$enable])
    
    This enables (or disables) all of the C<indent>, C<space_before> and
    C<space_after> flags in one call to generate the most readable
    (or most compact) form possible.
    
    Equivalent to:
    
       $json->indent->space_before->space_after
    
    =head2 indent
    
        $json = $json->indent([$enable])
        
        $enabled = $json->get_indent
    
    The default indent space length is three.
    You can use C<indent_length> to change the length.
    
    =head2 space_before
    
        $json = $json->space_before([$enable])
        
        $enabled = $json->get_space_before
    
    If C<$enable> is true (or missing), then the C<encode> method will add an extra
    optional space before the C<:> separating keys from values in JSON objects.
    
    If C<$enable> is false, then the C<encode> method will not add any extra
    space at those places.
    
    This setting has no effect when decoding JSON texts.
    
    Example, space_before enabled, space_after and indent disabled:
    
       {"key" :"value"}
    
    =head2 space_after
    
        $json = $json->space_after([$enable])
        
        $enabled = $json->get_space_after
    
    If C<$enable> is true (or missing), then the C<encode> method will add an extra
    optional space after the C<:> separating keys from values in JSON objects
    and extra whitespace after the C<,> separating key-value pairs and array
    members.
    
    If C<$enable> is false, then the C<encode> method will not add any extra
    space at those places.
    
    This setting has no effect when decoding JSON texts.
    
    Example, space_before and indent disabled, space_after enabled:
    
       {"key": "value"}
    
    =head2 relaxed
    
        $json = $json->relaxed([$enable])
        
        $enabled = $json->get_relaxed
    
    If C<$enable> is true (or missing), then C<decode> will accept some
    extensions to normal JSON syntax (see below). C<encode> will not be
    affected in anyway. I<Be aware that this option makes you accept invalid
    JSON texts as if they were valid!>. I suggest only to use this option to
    parse application-specific files written by humans (configuration files,
    resource files etc.)
    
    If C<$enable> is false (the default), then C<decode> will only accept
    valid JSON texts.
    
    Currently accepted extensions are:
    
    =over 4
    
    =item * list items can have an end-comma
    
    JSON I<separates> array elements and key-value pairs with commas. This
    can be annoying if you write JSON texts manually and want to be able to
    quickly append elements, so this extension accepts comma at the end of
    such items not just between them:
    
       [
          1,
          2, <- this comma not normally allowed
       ]
       {
          "k1": "v1",
          "k2": "v2", <- this comma not normally allowed
       }
    
    =item * shell-style '#'-comments
    
    Whenever JSON allows whitespace, shell-style comments are additionally
    allowed. They are terminated by the first carriage-return or line-feed
    character, after which more white-space and comments are allowed.
    
      [
         1, # this comment not allowed in JSON
            # neither this one...
      ]
    
    =back
    
    =head2 canonical
    
        $json = $json->canonical([$enable])
        
        $enabled = $json->get_canonical
    
    If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
    by sorting their keys. This is adding a comparatively high overhead.
    
    If C<$enable> is false, then the C<encode> method will output key-value
    pairs in the order Perl stores them (which will likely change between runs
    of the same script).
    
    This option is useful if you want the same data structure to be encoded as
    the same JSON text (given the same overall settings). If it is disabled,
    the same hash might be encoded differently even if contains the same data,
    as key-value pairs have no inherent ordering in Perl.
    
    This setting has no effect when decoding JSON texts.
    
    If you want your own sorting routine, you can give a code referece
    or a subroutine name to C<sort_by>. See to C<JSON::PP OWN METHODS>.
    
    =head2 allow_nonref
    
        $json = $json->allow_nonref([$enable])
        
        $enabled = $json->get_allow_nonref
    
    If C<$enable> is true (or missing), then the C<encode> method can convert a
    non-reference into its corresponding string, number or null JSON value,
    which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
    values instead of croaking.
    
    If C<$enable> is false, then the C<encode> method will croak if it isn't
    passed an arrayref or hashref, as JSON texts must either be an object
    or array. Likewise, C<decode> will croak if given something that is not a
    JSON object or array.
    
       JSON::PP->new->allow_nonref->encode ("Hello, World!")
       => "Hello, World!"
    
    =head2 allow_unknown
    
        $json = $json->allow_unknown ([$enable])
        
        $enabled = $json->get_allow_unknown
    
    If $enable is true (or missing), then "encode" will *not* throw an
    exception when it encounters values it cannot represent in JSON (for
    example, filehandles) but instead will encode a JSON "null" value.
    Note that blessed objects are not included here and are handled
    separately by c<allow_nonref>.
    
    If $enable is false (the default), then "encode" will throw an
    exception when it encounters anything it cannot encode as JSON.
    
    This option does not affect "decode" in any way, and it is
    recommended to leave it off unless you know your communications
    partner.
    
    =head2 allow_blessed
    
        $json = $json->allow_blessed([$enable])
        
        $enabled = $json->get_allow_blessed
    
    If C<$enable> is true (or missing), then the C<encode> method will not
    barf when it encounters a blessed reference. Instead, the value of the
    B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
    disabled or no C<TO_JSON> method found) or a representation of the
    object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
    encoded. Has no effect on C<decode>.
    
    If C<$enable> is false (the default), then C<encode> will throw an
    exception when it encounters a blessed object.
    
    =head2 convert_blessed
    
        $json = $json->convert_blessed([$enable])
        
        $enabled = $json->get_convert_blessed
    
    If C<$enable> is true (or missing), then C<encode>, upon encountering a
    blessed object, will check for the availability of the C<TO_JSON> method
    on the object's class. If found, it will be called in scalar context
    and the resulting scalar will be encoded instead of the object. If no
    C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
    to do.
    
    The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
    returns other blessed objects, those will be handled in the same
    way. C<TO_JSON> must take care of not causing an endless recursion cycle
    (== crash) in this case. The name of C<TO_JSON> was chosen because other
    methods called by the Perl core (== not by the user of the object) are
    usually in upper case letters and to avoid collisions with the C<to_json>
    function or method.
    
    This setting does not yet influence C<decode> in any way.
    
    If C<$enable> is false, then the C<allow_blessed> setting will decide what
    to do when a blessed object is found.
    
    =head2 filter_json_object
    
        $json = $json->filter_json_object([$coderef])
    
    When C<$coderef> is specified, it will be called from C<decode> each
    time it decodes a JSON object. The only argument passed to the coderef
    is a reference to the newly-created hash. If the code references returns
    a single scalar (which need not be a reference), this value
    (i.e. a copy of that scalar to avoid aliasing) is inserted into the
    deserialised data structure. If it returns an empty list
    (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
    hash will be inserted. This setting can slow down decoding considerably.
    
    When C<$coderef> is omitted or undefined, any existing callback will
    be removed and C<decode> will not change the deserialised hash in any
    way.
    
    Example, convert all JSON objects into the integer 5:
    
       my $js = JSON::PP->new->filter_json_object (sub { 5 });
       # returns [5]
       $js->decode ('[{}]'); # the given subroutine takes a hash reference.
       # throw an exception because allow_nonref is not enabled
       # so a lone 5 is not allowed.
       $js->decode ('{"a":1, "b":2}');
    
    =head2 filter_json_single_key_object
    
        $json = $json->filter_json_single_key_object($key [=> $coderef])
    
    Works remotely similar to C<filter_json_object>, but is only called for
    JSON objects having a single key named C<$key>.
    
    This C<$coderef> is called before the one specified via
    C<filter_json_object>, if any. It gets passed the single value in the JSON
    object. If it returns a single value, it will be inserted into the data
    structure. If it returns nothing (not even C<undef> but the empty list),
    the callback from C<filter_json_object> will be called next, as if no
    single-key callback were specified.
    
    If C<$coderef> is omitted or undefined, the corresponding callback will be
    disabled. There can only ever be one callback for a given key.
    
    As this callback gets called less often then the C<filter_json_object>
    one, decoding speed will not usually suffer as much. Therefore, single-key
    objects make excellent targets to serialise Perl objects into, especially
    as single-key JSON objects are as close to the type-tagged value concept
    as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
    support this in any way, so you need to make sure your data never looks
    like a serialised Perl hash.
    
    Typical names for the single object key are C<__class_whatever__>, or
    C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
    things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
    with real hashes.
    
    Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
    into the corresponding C<< $WIDGET{<id>} >> object:
    
       # return whatever is in $WIDGET{5}:
       JSON::PP
          ->new
          ->filter_json_single_key_object (__widget__ => sub {
                $WIDGET{ $_[0] }
             })
          ->decode ('{"__widget__": 5')
    
       # this can be used with a TO_JSON method in some "widget" class
       # for serialisation to json:
       sub WidgetBase::TO_JSON {
          my ($self) = @_;
    
          unless ($self->{id}) {
             $self->{id} = ..get..some..id..;
             $WIDGET{$self->{id}} = $self;
          }
    
          { __widget__ => $self->{id} }
       }
    
    =head2 shrink
    
        $json = $json->shrink([$enable])
        
        $enabled = $json->get_shrink
    
    In JSON::XS, this flag resizes strings generated by either
    C<encode> or C<decode> to their minimum size possible.
    It will also try to downgrade any strings to octet-form if possible.
    
    In JSON::PP, it is noop about resizing strings but tries
    C<utf8::downgrade> to the returned string by C<encode>.
    See to L<utf8>.
    
    See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
    
    =head2 max_depth
    
        $json = $json->max_depth([$maximum_nesting_depth])
        
        $max_depth = $json->get_max_depth
    
    Sets the maximum nesting level (default C<512>) accepted while encoding
    or decoding. If a higher nesting level is detected in JSON text or a Perl
    data structure, then the encoder and decoder will stop and croak at that
    point.
    
    Nesting level is defined by number of hash- or arrayrefs that the encoder
    needs to traverse to reach a given point or the number of C<{> or C<[>
    characters without their matching closing parenthesis crossed to reach a
    given character in a string.
    
    If no argument is given, the highest possible setting will be used, which
    is rarely useful.
    
    See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
    
    When a large value (100 or more) was set and it de/encodes a deep nested object/text,
    it may raise a warning 'Deep recursion on subroutin' at the perl runtime phase.
    
    =head2 max_size
    
        $json = $json->max_size([$maximum_string_size])
        
        $max_size = $json->get_max_size
    
    Set the maximum length a JSON text may have (in bytes) where decoding is
    being attempted. The default is C<0>, meaning no limit. When C<decode>
    is called on a string that is longer then this many bytes, it will not
    attempt to decode the string but throw an exception. This setting has no
    effect on C<encode> (yet).
    
    If no argument is given, the limit check will be deactivated (same as when
    C<0> is specified).
    
    See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
    
    =head2 encode
    
        $json_text = $json->encode($perl_scalar)
    
    Converts the given Perl data structure (a simple scalar or a reference
    to a hash or array) to its JSON representation. Simple scalars will be
    converted into JSON string or number sequences, while references to arrays
    become JSON arrays and references to hashes become JSON objects. Undefined
    Perl values (e.g. C<undef>) become JSON C<null> values.
    References to the integers C<0> and C<1> are converted into C<true> and C<false>.
    
    =head2 decode
    
        $perl_scalar = $json->decode($json_text)
    
    The opposite of C<encode>: expects a JSON text and tries to parse it,
    returning the resulting simple scalar or reference. Croaks on error.
    
    JSON numbers and strings become simple Perl scalars. JSON arrays become
    Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
    C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
    C<null> becomes C<undef>.
    
    =head2 decode_prefix
    
        ($perl_scalar, $characters) = $json->decode_prefix($json_text)
    
    This works like the C<decode> method, but instead of raising an exception
    when there is trailing garbage after the first JSON object, it will
    silently stop parsing there and return the number of characters consumed
    so far.
    
       JSON->new->decode_prefix ("[1] the tail")
       => ([], 3)
    
    =head1 INCREMENTAL PARSING
    
    Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
    
    In some cases, there is the need for incremental parsing of JSON texts.
    This module does allow you to parse a JSON stream incrementally.
    It does so by accumulating text until it has a full JSON object, which
    it then can decode. This process is similar to using C<decode_prefix>
    to see if a full JSON object is available, but is much more efficient
    (and can be implemented with a minimum of method calls).
    
    This module will only attempt to parse the JSON text once it is sure it
    has enough text to get a decisive result, using a very simple but
    truly incremental parser. This means that it sometimes won't stop as
    early as the full parser, for example, it doesn't detect parenthese
    mismatches. The only thing it guarantees is that it starts decoding as
    soon as a syntactically valid JSON text has been seen. This means you need
    to set resource limits (e.g. C<max_size>) to ensure the parser will stop
    parsing in the presence if syntax errors.
    
    The following methods implement this incremental parser.
    
    =head2 incr_parse
    
        $json->incr_parse( [$string] ) # void context
        
        $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
        
        @obj_or_empty = $json->incr_parse( [$string] ) # list context
    
    This is the central parsing function. It can both append new text and
    extract objects from the stream accumulated so far (both of these
    functions are optional).
    
    If C<$string> is given, then this string is appended to the already
    existing JSON fragment stored in the C<$json> object.
    
    After that, if the function is called in void context, it will simply
    return without doing anything further. This can be used to add more text
    in as many chunks as you want.
    
    If the method is called in scalar context, then it will try to extract
    exactly I<one> JSON object. If that is successful, it will return this
    object, otherwise it will return C<undef>. If there is a parse error,
    this method will croak just as C<decode> would do (one can then use
    C<incr_skip> to skip the errornous part). This is the most common way of
    using the method.
    
    And finally, in list context, it will try to extract as many objects
    from the stream as it can find and return them, or the empty list
    otherwise. For this to work, there must be no separators between the JSON
    objects or arrays, instead they must be concatenated back-to-back. If
    an error occurs, an exception will be raised as in the scalar context
    case. Note that in this case, any previously-parsed JSON texts will be
    lost.
    
    Example: Parse some JSON arrays/objects in a given string and return them.
    
        my @objs = JSON->new->incr_parse ("[5][7][1,2]");
    
    =head2 incr_text
    
        $lvalue_string = $json->incr_text
    
    This method returns the currently stored JSON fragment as an lvalue, that
    is, you can manipulate it. This I<only> works when a preceding call to
    C<incr_parse> in I<scalar context> successfully returned an object. Under
    all other circumstances you must not call this function (I mean it.
    although in simple tests it might actually work, it I<will> fail under
    real world conditions). As a special exception, you can also call this
    method before having parsed anything.
    
    This function is useful in two cases: a) finding the trailing text after a
    JSON object or b) parsing multiple JSON objects separated by non-JSON text
    (such as commas).
    
        $json->incr_text =~ s/\s*,\s*//;
    
    In Perl 5.005, C<lvalue> attribute is not available.
    You must write codes like the below:
    
        $string = $json->incr_text;
        $string =~ s/\s*,\s*//;
        $json->incr_text( $string );
    
    =head2 incr_skip
    
        $json->incr_skip
    
    This will reset the state of the incremental parser and will remove the
    parsed text from the input buffer. This is useful after C<incr_parse>
    died, in which case the input buffer and incremental parser state is left
    unchanged, to skip the text parsed so far and to reset the parse state.
    
    =head2 incr_reset
    
        $json->incr_reset
    
    This completely resets the incremental parser, that is, after this call,
    it will be as if the parser had never parsed anything.
    
    This is useful if you want ot repeatedly parse JSON objects and want to
    ignore any trailing data, which means you have to reset the parser after
    each successful decode.
    
    See to L<JSON::XS/INCREMENTAL PARSING> for examples.
    
    
    =head1 JSON::PP OWN METHODS
    
    =head2 allow_singlequote
    
        $json = $json->allow_singlequote([$enable])
    
    If C<$enable> is true (or missing), then C<decode> will accept
    JSON strings quoted by single quotations that are invalid JSON
    format.
    
        $json->allow_singlequote->decode({"foo":'bar'});
        $json->allow_singlequote->decode({'foo':"bar"});
        $json->allow_singlequote->decode({'foo':'bar'});
    
    As same as the C<relaxed> option, this option may be used to parse
    application-specific files written by humans.
    
    
    =head2 allow_barekey
    
        $json = $json->allow_barekey([$enable])
    
    If C<$enable> is true (or missing), then C<decode> will accept
    bare keys of JSON object that are invalid JSON format.
    
    As same as the C<relaxed> option, this option may be used to parse
    application-specific files written by humans.
    
        $json->allow_barekey->decode('{foo:"bar"}');
    
    =head2 allow_bignum
    
        $json = $json->allow_bignum([$enable])
    
    If C<$enable> is true (or missing), then C<decode> will convert
    the big integer Perl cannot handle as integer into a L<Math::BigInt>
    object and convert a floating number (any) into a L<Math::BigFloat>.
    
    On the contary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
    objects into JSON numbers with C<allow_blessed> enable.
    
       $json->allow_nonref->allow_blessed->allow_bignum;
       $bigfloat = $json->decode('2.000000000000000000000000001');
       print $json->encode($bigfloat);
       # => 2.000000000000000000000000001
    
    See to L<JSON::XS/MAPPING> aboout the normal conversion of JSON number.
    
    =head2 loose
    
        $json = $json->loose([$enable])
    
    The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
    and the module doesn't allow to C<decode> to these (except for \x2f).
    If C<$enable> is true (or missing), then C<decode>  will accept these
    unescaped strings.
    
        $json->loose->decode(qq|["abc
                                       def"]|);
    
    See L<JSON::XS/SSECURITY CONSIDERATIONS>.
    
    =head2 escape_slash
    
        $json = $json->escape_slash([$enable])
    
    According to JSON Grammar, I<slash> (U+002F) is escaped. But default
    JSON::PP (as same as JSON::XS) encodes strings without escaping slash.
    
    If C<$enable> is true (or missing), then C<encode> will escape slashes.
    
    =head2 indent_length
    
        $json = $json->indent_length($length)
    
    JSON::XS indent space length is 3 and cannot be changed.
    JSON::PP set the indent space length with the given $length.
    The default is 3. The acceptable range is 0 to 15.
    
    =head2 sort_by
    
        $json = $json->sort_by($function_name)
        $json = $json->sort_by($subroutine_ref)
    
    If $function_name or $subroutine_ref are set, its sort routine are used
    in encoding JSON objects.
    
       $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
       # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
    
       $js = $pc->sort_by('own_sort')->encode($obj);
       # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
    
       sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
    
    As the sorting routine runs in the JSON::PP scope, the given
    subroutine name and the special variables C<$a>, C<$b> will begin
    'JSON::PP::'.
    
    If $integer is set, then the effect is same as C<canonical> on.
    
    =head1 INTERNAL
    
    For developers.
    
    =over
    
    =item PP_encode_box
    
    Returns
    
            {
                depth        => $depth,
                indent_count => $indent_count,
            }
    
    
    =item PP_decode_box
    
    Returns
    
            {
                text    => $text,
                at      => $at,
                ch      => $ch,
                len     => $len,
                depth   => $depth,
                encoding      => $encoding,
                is_valid_utf8 => $is_valid_utf8,
            };
    
    =back
    
    =head1 MAPPING
    
    This section is copied from JSON::XS and modified to C<JSON::PP>.
    JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
    
    See to L<JSON::XS/MAPPING>.
    
    =head2 JSON -> PERL
    
    =over 4
    
    =item object
    
    A JSON object becomes a reference to a hash in Perl. No ordering of object
    keys is preserved (JSON does not preserver object key ordering itself).
    
    =item array
    
    A JSON array becomes a reference to an array in Perl.
    
    =item string
    
    A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
    are represented by the same codepoints in the Perl string, so no manual
    decoding is necessary.
    
    =item number
    
    A JSON number becomes either an integer, numeric (floating point) or
    string scalar in perl, depending on its range and any fractional parts. On
    the Perl level, there is no difference between those as Perl handles all
    the conversion details, but an integer may take slightly less memory and
    might represent more values exactly than floating point numbers.
    
    If the number consists of digits only, C<JSON> will try to represent
    it as an integer value. If that fails, it will try to represent it as
    a numeric (floating point) value if that is possible without loss of
    precision. Otherwise it will preserve the number as a string value (in
    which case you lose roundtripping ability, as the JSON number will be
    re-encoded toa JSON string).
    
    Numbers containing a fractional or exponential part will always be
    represented as numeric (floating point) values, possibly at a loss of
    precision (in which case you might lose perfect roundtripping ability, but
    the JSON number will still be re-encoded as a JSON number).
    
    Note that precision is not accuracy - binary floating point values cannot
    represent most decimal fractions exactly, and when converting from and to
    floating point, C<JSON> only guarantees precision up to but not including
    the leats significant bit.
    
    When C<allow_bignum> is enable, the big integers 
    and the numeric can be optionally converted into L<Math::BigInt> and
    L<Math::BigFloat> objects.
    
    =item true, false
    
    These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
    respectively. They are overloaded to act almost exactly like the numbers
    C<1> and C<0>. You can check wether a scalar is a JSON boolean by using
    the C<JSON::is_bool> function.
    
       print JSON::PP::true . "\n";
        => true
       print JSON::PP::true + 1;
        => 1
    
       ok(JSON::true eq  '1');
       ok(JSON::true == 1);
    
    C<JSON> will install these missing overloading features to the backend modules.
    
    
    =item null
    
    A JSON null atom becomes C<undef> in Perl.
    
    C<JSON::PP::null> returns C<unddef>.
    
    =back
    
    
    =head2 PERL -> JSON
    
    The mapping from Perl to JSON is slightly more difficult, as Perl is a
    truly typeless language, so we can only guess which JSON type is meant by
    a Perl value.
    
    =over 4
    
    =item hash references
    
    Perl hash references become JSON objects. As there is no inherent ordering
    in hash keys (or JSON objects), they will usually be encoded in a
    pseudo-random order that can change between runs of the same program but
    stays generally the same within a single run of a program. C<JSON>
    optionally sort the hash keys (determined by the I<canonical> flag), so
    the same datastructure will serialise to the same JSON text (given same
    settings and version of JSON::XS), but this incurs a runtime overhead
    and is only rarely useful, e.g. when you want to compare some JSON text
    against another for equality.
    
    
    =item array references
    
    Perl array references become JSON arrays.
    
    =item other references
    
    Other unblessed references are generally not allowed and will cause an
    exception to be thrown, except for references to the integers C<0> and
    C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
    also use C<JSON::false> and C<JSON::true> to improve readability.
    
       to_json [\0,JSON::PP::true]      # yields [false,true]
    
    =item JSON::PP::true, JSON::PP::false, JSON::PP::null
    
    These special values become JSON true and JSON false values,
    respectively. You can also use C<\1> and C<\0> directly if you want.
    
    JSON::PP::null returns C<undef>.
    
    =item blessed objects
    
    Blessed objects are not directly representable in JSON. See the
    C<allow_blessed> and C<convert_blessed> methods on various options on
    how to deal with this: basically, you can choose between throwing an
    exception, encoding the reference as if it weren't blessed, or provide
    your own serialiser method.
    
    See to L<convert_blessed>.
    
    =item simple scalars
    
    Simple Perl scalars (any scalar that is not a reference) are the most
    difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
    JSON C<null> values, scalars that have last been used in a string context
    before encoding as JSON strings, and anything else as number value:
    
       # dump as number
       encode_json [2]                      # yields [2]
       encode_json [-3.0e17]                # yields [-3e+17]
       my $value = 5; encode_json [$value]  # yields [5]
    
       # used as string, so dump as string
       print $value;
       encode_json [$value]                 # yields ["5"]
    
       # undef becomes null
       encode_json [undef]                  # yields [null]
    
    You can force the type to be a string by stringifying it:
    
       my $x = 3.1; # some variable containing a number
       "$x";        # stringified
       $x .= "";    # another, more awkward way to stringify
       print $x;    # perl does it for you, too, quite often
    
    You can force the type to be a number by numifying it:
    
       my $x = "3"; # some variable containing a string
       $x += 0;     # numify it, ensuring it will be dumped as a number
       $x *= 1;     # same thing, the choise is yours.
    
    You can not currently force the type in other, less obscure, ways.
    
    Note that numerical precision has the same meaning as under Perl (so
    binary to decimal conversion follows the same rules as in Perl, which
    can differ to other languages). Also, your perl interpreter might expose
    extensions to the floating point numbers of your platform, such as
    infinities or NaN's - these cannot be represented in JSON, and it is an
    error to pass those in.
    
    =item Big Number
    
    When C<allow_bignum> is enable, 
    C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
    objects into JSON numbers.
    
    
    =back
    
    =head1 UNICODE HANDLING ON PERLS
    
    If you do not know about Unicode on Perl well,
    please check L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
    
    =head2 Perl 5.8 and later
    
    Perl can handle Unicode and the JSON::PP de/encode methods also work properly.
    
        $json->allow_nonref->encode(chr hex 3042);
        $json->allow_nonref->encode(chr hex 12345);
    
    Reuturns C<"\u3042"> and C<"\ud808\udf45"> respectively.
    
        $json->allow_nonref->decode('"\u3042"');
        $json->allow_nonref->decode('"\ud808\udf45"');
    
    Returns UTF-8 encoded strings with UTF8 flag, regarded as C<U+3042> and C<U+12345>.
    
    Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C<join> was broken,
    so JSON::PP wraps the C<join> with a subroutine. Thus JSON::PP works slow in the versions.
    
    
    =head2 Perl 5.6
    
    Perl can handle Unicode and the JSON::PP de/encode methods also work.
    
    =head2 Perl 5.005
    
    Perl 5.005 is a byte sementics world -- all strings are sequences of bytes.
    That means the unicode handling is not available.
    
    In encoding,
    
        $json->allow_nonref->encode(chr hex 3042);  # hex 3042 is 12354.
        $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565.
    
    Returns C<B> and C<E>, as C<chr> takes a value more than 255, it treats
    as C<$value % 256>, so the above codes are equivalent to :
    
        $json->allow_nonref->encode(chr 66);
        $json->allow_nonref->encode(chr 69);
    
    In decoding,
    
        $json->decode('"\u00e3\u0081\u0082"');
    
    The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded
    japanese character (C<HIRAGANA LETTER A>).
    And if it is represented in Unicode code point, C<U+3042>.
    
    Next, 
    
        $json->decode('"\u3042"');
    
    We ordinary expect the returned value is a Unicode character C<U+3042>.
    But here is 5.005 world. This is C<0xE3 0x81 0x82>.
    
        $json->decode('"\ud808\udf45"');
    
    This is not a character C<U+12345> but bytes - C<0xf0 0x92 0x8d 0x85>.
    
    
    =head1 TODO
    
    =over
    
    =item speed
    
    =item memory saving
    
    =back
    
    
    =head1 SEE ALSO
    
    Most of the document are copied and modified from JSON::XS doc.
    
    L<JSON::XS>
    
    RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
    
    =head1 AUTHOR
    
    Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
    
    
    =head1 COPYRIGHT AND LICENSE
    
    Copyright 2007-2013 by Makamaka Hannyaharamitu
    
    This library is free software; you can redistribute it and/or modify
    it under the same terms as Perl itself. 
    
    =cut
  JSON_PP
  
  $fatpacked{"JSON/PP/Boolean.pm"} = <<'JSON_PP_BOOLEAN';
    =head1 NAME
    
    JSON::PP::Boolean - dummy module providing JSON::PP::Boolean
    
    =head1 SYNOPSIS
    
     # do not "use" yourself
    
    =head1 DESCRIPTION
    
    This module exists only to provide overload resolution for Storable and similar modules. See
    L<JSON::PP> for more info about this class.
    
    =cut
    
    use JSON::PP ();
    use strict;
    
    1;
    
    =head1 AUTHOR
    
    This idea is from L<JSON::XS::Boolean> written by Marc Lehmann <schmorp[at]schmorp.de>
    
    =cut
    
  JSON_PP_BOOLEAN
  
  $fatpacked{"Module/CPANfile.pm"} = <<'MODULE_CPANFILE';
    package Module::CPANfile;
    use strict;
    use warnings;
    use Cwd;
    use Carp ();
    use Module::CPANfile::Environment;
    use Module::CPANfile::Result;
    
    our $VERSION = '1.0002';
    
    sub new {
        my($class, $file) = @_;
        bless {}, $class;
    }
    
    sub load {
        my($proto, $file) = @_;
    
        my $self = ref $proto ? $proto : $proto->new;
        $self->parse($file || Cwd::abs_path('cpanfile'));
        $self;
    }
    
    sub save {
        my($self, $path) = @_;
    
        open my $out, ">", $path or die "$path: $!";
        print {$out} $self->to_string;
    }
    
    sub parse {
        my($self, $file) = @_;
    
        my $code = do {
            open my $fh, "<", $file or die "$file: $!";
            join '', <$fh>;
        };
    
        my $env = Module::CPANfile::Environment->new($file);
        $self->{result} = $env->parse($code) or die $@;
    }
    
    sub from_prereqs {
        my($proto, $prereqs) = @_;
    
        my $self = $proto->new;
        $self->{result} = Module::CPANfile::Result->from_prereqs($prereqs);
    
        $self;
    }
    
    sub features {
        my $self = shift;
        map $self->feature($_), keys %{$self->{result}{features}};
    }
    
    sub feature {
        my($self, $identifier) = @_;
    
        my $data = $self->{result}{features}{$identifier}
          or Carp::croak("Unknown feature '$identifier'");
    
        require CPAN::Meta::Feature;
        CPAN::Meta::Feature->new($data->{identifier}, {
            description => $data->{description},
            prereqs => $data->{spec},
        });
    }
    
    sub prereq { shift->prereqs }
    
    sub prereqs {
        my $self = shift;
        require CPAN::Meta::Prereqs;
        CPAN::Meta::Prereqs->new($self->prereq_specs);
    }
    
    sub effective_prereqs {
        my($self, $features) = @_;
        $self->prereqs_with(@{$features || []});
    }
    
    sub prereqs_with {
        my($self, @feature_identifiers) = @_;
    
        my $prereqs = $self->prereqs;
        my @others = map { $self->feature($_)->prereqs } @feature_identifiers;
    
        $prereqs->with_merged_prereqs(\@others);
    }
    
    sub prereq_specs {
        my $self = shift;
        $self->{result}{spec};
    }
    
    sub merge_meta {
        my($self, $file, $version) = @_;
    
        require CPAN::Meta;
    
        $version ||= $file =~ /\.yml$/ ? '1.4' : '2';
    
        my $prereq = $self->prereqs;
    
        my $meta = CPAN::Meta->load_file($file);
        my $prereqs_hash = $prereq->with_merged_prereqs($meta->effective_prereqs)->as_string_hash;
        my $struct = { %{$meta->as_struct}, prereqs => $prereqs_hash };
    
        CPAN::Meta->new($struct)->save($file, { version => $version });
    }
    
    sub _dump {
        my $str = shift;
        require Data::Dumper;
        chomp(my $value = Data::Dumper->new([$str])->Terse(1)->Dump);
        $value;
    }
    
    sub to_string {
        my($self, $include_empty) = @_;
    
        my $prereqs = $self->{result}{spec};
    
        my $code = '';
        $code .= $self->_dump_prereqs($self->{result}{spec}, $include_empty);
    
        for my $feature (values %{$self->{result}{features}}) {
            $code .= sprintf "feature %s, %s => sub {\n", _dump($feature->{identifier}), _dump($feature->{description});
            $code .= $self->_dump_prereqs($feature->{spec}, $include_empty, 4);
            $code .= "}\n\n";
        }
    
        $code =~ s/\n+$/\n/s;
        $code;
    }
    
    sub _dump_prereqs {
        my($self, $prereqs, $include_empty, $base_indent) = @_;
    
        my $code = '';
        for my $phase (qw(runtime configure build test develop)) {
            my $indent = $phase eq 'runtime' ? '' : '    ';
            $indent = (' ' x ($base_indent || 0)) . $indent;
    
            my($phase_code, $requirements);
            $phase_code .= "on $phase => sub {\n" unless $phase eq 'runtime';
    
            for my $type (qw(requires recommends suggests conflicts)) {
                for my $mod (sort keys %{$prereqs->{$phase}{$type}}) {
                    my $ver = $prereqs->{$phase}{$type}{$mod};
                    $phase_code .= $ver eq '0'
                                 ? "${indent}$type '$mod';\n"
                                 : "${indent}$type '$mod', '$ver';\n";
                    $requirements++;
                }
            }
    
            $phase_code .= "\n" unless $requirements;
            $phase_code .= "};\n" unless $phase eq 'runtime';
    
            $code .= $phase_code . "\n" if $requirements or $include_empty;
        }
    
        $code =~ s/\n+$/\n/s;
        $code;
    }
    
    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
    
      my @features = $file->features; # CPAN::Meta::Feature objects
      my $merged_prereqs = $file->prereqs_with(@identifiers); # CPAN::Meta::Prereqs
    
      $file->merge_meta('MYMETA.json');
    
    =head1 DESCRIPTION
    
    Module::CPANfile is a tool to handle L<cpanfile> format to load application
    specific dependencies, not just for CPAN distributions.
    
    =head1 METHODS
    
    =over 4
    
    =item load
    
      $file = Module::CPANfile->load;
      $file = Module::CPANfile->load('cpanfile');
    
    Load and parse a cpanfile. By default it tries to load C<cpanfile> in
    the current directory, unless you pass the path to its argument.
    
    =item from_prereqs
    
      $file = Module::CPANfile->from_prereqs({
        runtime => { requires => { DBI => '1.000' } },
      });
    
    Creates a new Module::CPANfile object from prereqs hash you can get
    via L<CPAN::Meta>'s C<prereqs>, or L<CPAN::Meta::Prereqs>'
    C<as_string_hash>.
    
      # read MYMETA, then feed the prereqs to create Module::CPANfile
      my $meta = CPAN::Meta->load_file('MYMETA.json');
      my $file = Module::CPANfile->from_prereqs($meta->prereqs);
    
      # load cpanfile, then recreate it with round-trip
      my $file = Module::CPANfile->load('cpanfile');
      $file = Module::CPANfile->from_prereqs($file->prereq_specs);
                                        # or $file->prereqs->as_string_hash
    
    =item prereqs
    
    Returns L<CPAN::Meta::Prereqs> object out of the parsed cpanfile.
    
    =item prereq_specs
    
    Returns a hash reference that should be passed to C<< CPAN::Meta::Prereqs->new >>.
    
    =item features
    
    Returns a list of features available in the cpanfile as L<CPAN::Meta::Feature>.
    
    =item prereqs_with(@identifiers), effective_prereqs(\@identifiers)
    
    Returns L<CPAN::Meta::Prereqs> object, with merged prereqs for
    features identified with the C<@identifiers>.
    
    =item to_string($include_empty)
    
      $file->to_string;
      $file->to_string(1);
    
    Returns a canonical string (code) representation for cpanfile. Useful
    if you want to convert L<CPAN::Meta::Prereqs> to a new cpanfile.
    
      # read MYMETA's prereqs and print cpanfile representation of it
      my $meta = CPAN::Meta->load_file('MYMETA.json');
      my $file = Module::CPANfile->from_prereqs($meta->prereqs);
      print $file->to_sring;
    
    By default, it omits the phase where there're no modules
    registered. If you pass the argument of a true value, it will print
    them as well.
    
    =item save
    
      $file->save('cpanfile');
    
    Saves the currently loaded prereqs as a new C<cpanfile> by calling
    C<to_string>. Beware B<this method will overwrite the existing
    cpanfile without any warning or backup>. Taking a backup or giving
    warnings to users is a caller's responsibility.
    
      # Read MYMETA.json and creates a new cpanfile
      my $meta = CPAN::Meta->load_file('MYMETA.json');
      my $file = Module::CPANfile->from_prereqs($meta->prereqs);
      $file->save('cpanfile');
    
    =item merge_meta
    
      $file->merge_meta('META.yml');
      $file->merge_meta('MYMETA.json', '2.0');
    
    Merge the effective prereqs with Meta specification loaded from the
    given META file, using CPAN::Meta. You can specify the META spec
    version in the second argument, which defaults to 1.4 in case the
    given file is YAML, and 2 if it is JSON.
    
    =back
    
    =head1 AUTHOR
    
    Tatsuhiko Miyagawa
    
    =head1 SEE ALSO
    
    L<cpanfile>, L<CPAN::Meta>, L<CPAN::Meta::Spec>
    
    =cut
  MODULE_CPANFILE
  
  $fatpacked{"Module/CPANfile/Environment.pm"} = <<'MODULE_CPANFILE_ENVIRONMENT';
    package Module::CPANfile::Environment;
    use strict;
    use warnings;
    use Module::CPANfile::Result;
    use Carp ();
    
    my @bindings = qw(
        on requires recommends suggests conflicts
        feature
        osname
        configure_requires build_requires test_requires author_requires
    );
    
    my $file_id = 1;
    
    sub new {
        my($class, $file) = @_;
        bless {
            file => $file,
        }, $class;
    }
    
    sub bind {
        my $class = shift;
        my $pkg = caller;
    
        my $result = Module::CPANfile::Result->new;
        for my $binding (@bindings) {
            no strict 'refs';
            *{"$pkg\::$binding"} = sub { $result->$binding(@_) };
        }
    
        return $result;
    }
    
    sub parse {
        my($self, $code) = @_;
    
        my($res, $err);
    
        {
            local $@;
            $file_id++;
            $res = eval <<EVAL;
    package Module::CPANfile::Sandbox$file_id;
    no warnings;
    my \$_result;
    BEGIN { \$_result = Module::CPANfile::Environment->bind }
    
    # line 1 "$self->{file}"
    $code;
    
    \$_result;
    EVAL
            $err = $@;
        }
    
        if ($err) { die "Parsing $self->{file} failed: $err" };
    
        return $res;
    }
    
    1;
    
  MODULE_CPANFILE_ENVIRONMENT
  
  $fatpacked{"Module/CPANfile/Result.pm"} = <<'MODULE_CPANFILE_RESULT';
    package Module::CPANfile::Result;
    use strict;
    
    sub from_prereqs {
        my($class, $spec) = @_;
        bless {
            phase => 'runtime',
            spec => $spec,
        }, $class;
    }
    
    sub new {
        bless {
            phase => 'runtime', # default phase
            features => {},
            feature => undef,
            spec  => {},
        }, shift;
    }
    
    sub on {
        my($self, $phase, $code) = @_;
        local $self->{phase} = $phase;
        $code->()
    }
    
    sub feature {
        my($self, $identifier, $description, $code) = @_;
    
        # shortcut: feature identifier => sub { ... }
        if (@_ == 3 && ref($description) eq 'CODE') {
            $code = $description;
            $description = $identifier;
        }
    
        unless (ref $description eq '' && ref $code eq 'CODE') {
            Carp::croak("Usage: feature 'identifier', 'Description' => sub { ... }");
        }
    
        local $self->{feature} = $self->{features}{$identifier}
          = { identifier => $identifier, description => $description, spec => {} };
        $code->();
    }
    
    sub osname { die "TODO" }
    
    sub requires {
        my($self, $module, $requirement) = @_;
        ($self->{feature} ? $self->{feature}{spec} : $self->{spec})
          ->{$self->{phase}}{requires}{$module} = $requirement || 0;
    }
    
    sub recommends {
        my($self, $module, $requirement) = @_;
        ($self->{feature} ? $self->{feature}{spec} : $self->{spec})
          ->{$self->{phase}}{recommends}{$module} = $requirement || 0;
    }
    
    sub suggests {
        my($self, $module, $requirement) = @_;
        ($self->{feature} ? $self->{feature}{spec} : $self->{spec})
          ->{$self->{phase}}{suggests}{$module} = $requirement || 0;
    }
    
    sub conflicts {
        my($self, $module, $requirement) = @_;
        ($self->{feature} ? $self->{feature}{spec} : $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) });
    }
    
    1;
  MODULE_CPANFILE_RESULT
  
  $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.000016';
    $VERSION = eval $VERSION;
    
    use Carp qw/croak/;
    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_FIRST_WORD_REGEXP = qr{ # the FIRST word in a package name
      [a-zA-Z_]                     # the first word CANNOT start with a digit
        (?:
          [\w']?                    # can contain letters, digits, _, or ticks
          \w                        # But, NO multi-ticks or trailing ticks
        )*
    }x;
    
    my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name
      \w                           # the 2nd+ word CAN start with digits
        (?:
          [\w']?                   # and can contain letters or ticks
          \w                       # But, NO multi-ticks or trailing ticks
        )*
    }x;
    
    my $PKG_NAME_REGEXP = qr{ # match a package name
      (?: :: )?               # a pkg name can start with aristotle
      $PKG_FIRST_WORD_REGEXP  # a package word
      (?:
        (?: :: )+             ### aristotle (allow one or many times)
        $PKG_ADDL_WORD_REGEXP ### a package word
      )*                      # ^ zero, one or many times
      (?:
        ::                    # allow trailing aristotle
      )?
    }x;
    
    my $PKG_REGEXP  = qr{   # match a package declaration
      ^[\s\{;]*             # intro chars on a line
      package               # the word 'package'
      \s+                   # whitespace
      ($PKG_NAME_REGEXP)    # 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 provides {
        my $class = shift;
    
        croak "provides() requires key/value pairs \n" if @_ % 2;
        my %args = @_;
    
        croak "provides() takes only one of 'dir' or 'files'\n"
          if $args{dir} && $args{files};
    
        croak "provides() requires a 'version' argument"
          unless defined $args{version};
    
        croak "provides() does not support version '$args{version}' metadata"
            unless grep { $args{version} eq $_ } qw/1.4 2/;
    
        $args{prefix} = 'lib' unless defined $args{prefix};
    
        my $p;
        if ( $args{dir} ) {
          $p = $class->package_versions_from_directory($args{dir});
        }
        else {
          croak "provides() requires 'files' to be an array reference\n"
            unless ref $args{files} eq 'ARRAY';
          $p = $class->package_versions_from_directory($args{files});
        }
    
        # Now, fix up files with prefix
        if ( length $args{prefix} ) { # check in case disabled with q{}
          $args{prefix} =~ s{/$}{};
          for my $v ( values %$p ) {
            $v->{file} = "$args{prefix}/$v->{file}";
          }
        }
    
        return $p
      }
    
      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::Unix->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 );
    
            $prime_package = $package if lc($prime_package) eq lc($package);
            if ( $package eq $prime_package ) {
              if ( exists( $prime{$package} ) ) {
                croak "Unexpected conflict in '$package'; multiple versions found.\n";
              } else {
                $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename);
                $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 irrelevant -- 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 || croak '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/o ) {
        ( $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 croak( "Can't open '$filename': $!" );
    
      $self->_handle_bom($fh, $filename);
    
      $self->_parse_fh($fh);
    }
    
    # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
    # If there's one, then skip it and set the :encoding layer appropriately.
    sub _handle_bom {
      my ($self, $fh, $filename) = @_;
    
      my $pos = $fh->getpos;
      return unless defined $pos;
    
      my $buf = ' ' x 2;
      my $count = $fh->read( $buf, length $buf );
      return unless defined $count and $count >= 2;
    
      my $encoding;
      if ( $buf eq "\x{FE}\x{FF}" ) {
        $encoding = 'UTF-16BE';
      } elsif ( $buf eq "\x{FF}\x{FE}" ) {
        $encoding = 'UTF-16LE';
      } elsif ( $buf eq "\x{EF}\x{BB}" ) {
        $buf = ' ';
        $count = $fh->read( $buf, length $buf );
        if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
          $encoding = 'UTF-8';
        }
      }
    
      if ( defined $encoding ) {
        if ( "$]" >= 5.008 ) {
          # $fh->binmode requires perl 5.10
          binmode( $fh, ":encoding($encoding)" );
        }
      } else {
        $fh->setpos($pos)
          or croak( sprintf "Can't reset position to the top of '$filename'" );
      }
    
      return $encoding;
    }
    
    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 = '';
      my $in_end = 0;
    
      while (defined( my $line = <$fh> )) {
        my $line_num = $.;
    
        chomp( $line );
    
        # From toke.c : any line that begins by "=X", where X is an alphabetic
        # character, introduces a POD segment.
        my $is_cut;
        if ( $line =~ /^=([a-zA-Z].*)/ ) {
          my $cmd = $1;
          # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
          # character (which includes the newline, but here we chomped it away).
          $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
          $in_pod = !$is_cut;
        }
    
        if ( $in_pod ) {
    
          if ( $line =~ /^=head[1-4]\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";
    
          }
    
        } elsif ( $is_cut ) {
    
          if ( $self->{collect_pod} && length( $pod_data ) ) {
            $pod{$pod_sect} = $pod_data;
            $pod_data = '';
          }
          $pod_sect = '';
    
        } else {
    
          # Skip after __END__
          next if $in_end;
    
          # Skip comments in code
          next if $line =~ /^\s*#/;
    
          # Would be nice if we could also check $in_string or something too
          if ($line eq '__END__') {
            $in_end++;
            next;
          }
          last if $line eq '__DATA__';
    
          # parse $line to see if it's a $VERSION declaration
          my( $vers_sig, $vers_fullname, $vers_pkg ) =
              ($line =~ /VERSION/)
                  ? $self->_parse_version_expression( $line )
                  : ();
    
          if ( $line =~ /$PKG_REGEXP/o ) {
            $pkg = $1;
            push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
            $vers{$pkg} = $2 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 );
    	}
    
          # 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;
    	}
    
          }
    
        }
    
      }
    
      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
        croak "failed to build version sub for $self->{filename}";
      my $result = eval { $vsub->() };
      croak "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) };
    
      croak "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;
        }
    
        croak $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+@{$_[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;
    
    =head1 NAME
    
    Module::Metadata - Gather package and POD information from perl module files
    
    =head1 SYNOPSIS
    
      use Module::Metadata;
    
      # information about a .pm file
      my $info = Module::Metadata->new_from_file( $file );
      my $version = $info->version;
    
      # CPAN META 'provides' field for .pm files in a directory
      my $provides = Module::Metadata->provides(
        dir => 'lib', version => 2
      );
    
    =head1 DESCRIPTION
    
    This module provides a standard way to gather metadata about a .pm file through
    (mostly) static analysis and (some) code execution.  When determining the
    version of a module, the C<$VERSION> assignment is C<eval>ed, as is traditional
    in the CPAN toolchain.
    
    =head1 USAGE
    
    =head2 Class methods
    
    =over 4
    
    =item C<< new_from_file($filename, collect_pod => 1) >>
    
    Constructs a C<Module::Metadata> object given the path to a file.  Returns
    undef if the filename does not exist.
    
    C<collect_pod> is a optional boolean argument that determines whether POD
    data is collected and stored for reference.  POD data is not collected by
    default.  POD headings are always collected.
    
    If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then
    it is skipped before processing, and the content of the file is also decoded
    appropriately starting from perl 5.8.
    
    =item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
    
    This works just like C<new_from_file>, except that a handle can be provided
    as the first argument.
    
    Note that there is no validation to confirm that the handle is a handle or
    something that can act like one.  Passing something that isn't a handle will
    cause a exception when trying to read from it.  The C<filename> argument is
    mandatory or undef will be returned.
    
    You are responsible for setting the decoding layers on C<$handle> if
    required.
    
    =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
    
    Constructs a C<Module::Metadata> object given a module or package name.
    Returns undef if the module cannot be found.
    
    In addition to accepting the C<collect_pod> argument as described above,
    this method accepts a C<inc> argument which is a reference to an array of
    directories to search for the module.  If none are given, the default is
    @INC.
    
    If the file that contains the module begins by an UTF-8, UTF-16BE or
    UTF-16LE byte-order mark, then it is skipped before processing, and the
    content of the file is also decoded appropriately starting from perl 5.8.
    
    =item C<< find_module_by_name($module, \@dirs) >>
    
    Returns the path to a module given the module or package name. A list
    of directories can be passed in as an optional parameter, otherwise
    @INC is searched.
    
    Can be called as either an object or a class method.
    
    =item C<< find_module_dir_by_name($module, \@dirs) >>
    
    Returns the entry in C<@dirs> (or C<@INC> by default) that contains
    the module C<$module>. A list of directories can be passed in as an
    optional parameter, otherwise @INC is searched.
    
    Can be called as either an object or a class method.
    
    =item C<< provides( %options ) >>
    
    This is a convenience wrapper around C<package_versions_from_directory>
    to generate a CPAN META C<provides> data structure.  It takes key/value
    pairs.  Valid option keys include:
    
    =over
    
    =item version B<(required)>
    
    Specifies which version of the L<CPAN::Meta::Spec> should be used as
    the format of the C<provides> output.  Currently only '1.4' and '2'
    are supported (and their format is identical).  This may change in
    the future as the definition of C<provides> changes.
    
    The C<version> option is required.  If it is omitted or if
    an unsupported version is given, then C<provides> will throw an error.
    
    =item dir
    
    Directory to search recursively for F<.pm> files.  May not be specified with
    C<files>.
    
    =item files
    
    Array reference of files to examine.  May not be specified with C<dir>.
    
    =item prefix
    
    String to prepend to the C<file> field of the resulting output. This defaults
    to F<lib>, which is the common case for most CPAN distributions with their
    F<.pm> files in F<lib>.  This option ensures the META information has the
    correct relative path even when the C<dir> or C<files> arguments are
    absolute or have relative paths from a location other than the distribution
    root.
    
    =back
    
    For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
    is a hashref of the form:
    
      {
        'Package::Name' => {
          version => '0.123',
          file => 'lib/Package/Name.pm'
        },
        'OtherPackage::Name' => ...
      }
    
    =item C<< package_versions_from_directory($dir, \@files?) >>
    
    Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
    for those files in C<$dir> - and reads each file for packages and versions,
    returning a hashref of the form:
    
      {
        'Package::Name' => {
          version => '0.123',
          file => 'Package/Name.pm'
        },
        'OtherPackage::Name' => ...
      }
    
    The C<DB> and C<main> packages are always omitted, as are any "private"
    packages that have leading underscores in the namespace (e.g.
    C<Foo::_private>)
    
    Note that the file path is relative to C<$dir> if that is specified.
    This B<must not> be used directly for CPAN META C<provides>.  See
    the C<provides> method instead.
    
    =item C<< log_info (internal) >>
    
    Used internally to perform logging; imported from Log::Contextual if
    Log::Contextual has already been loaded, otherwise simply calls warn.
    
    =back
    
    =head2 Object methods
    
    =over 4
    
    =item C<< name() >>
    
    Returns the name of the package represented by this module. If there
    are more than one packages, it makes a best guess based on the
    filename. If it's a script (i.e. not a *.pm) the package name is
    'main'.
    
    =item C<< version($package) >>
    
    Returns the version as defined by the $VERSION variable for the
    package as returned by the C<name> method if no arguments are
    given. If given the name of a package it will attempt to return the
    version of that package if it is specified in the file.
    
    =item C<< filename() >>
    
    Returns the absolute path to the file.
    
    =item C<< packages_inside() >>
    
    Returns a list of packages. Note: this is a raw list of packages
    discovered (or assumed, in the case of C<main>).  It is not
    filtered for C<DB>, C<main> or private packages the way the
    C<provides> method does.  Invalid package names are not returned,
    for example "Foo:Bar".  Strange but valid package names are
    returned, for example "Foo::Bar::", and are left up to the caller
    on how to handle.
    
    =item C<< pod_inside() >>
    
    Returns a list of POD sections.
    
    =item C<< contains_pod() >>
    
    Returns true if there is any POD in the file.
    
    =item C<< pod($section) >>
    
    Returns the POD data in the given section.
    
    =back
    
    =head1 AUTHOR
    
    Original code from Module::Build::ModuleInfo by Ken Williams
    <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
    
    Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
    assistance from David Golden (xdg) <dagolden@cpan.org>.
    
    =head1 COPYRIGHT & LICENSE
    
    Original code Copyright (c) 2001-2011 Ken Williams.
    Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
    All rights reserved.
    
    This library is free software; you can redistribute it and/or
    modify it under the same terms as Perl itself.
    
    =cut
    
  MODULE_METADATA
  
  $fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
    use strict;
    package Parse::CPAN::Meta;
    # ABSTRACT: Parse META.yml and META.json CPAN metadata files
    our $VERSION = '1.4407'; # VERSION
    
    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::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;
      my $object = CPAN::Meta::YAML::LoadFile(shift)
        or die CPAN::Meta::YAML->errstr;
      return $object;
    }
    
    # Parse a document from a string.
    sub Load ($) {
      require CPAN::Meta::YAML;
      my $object = CPAN::Meta::YAML::Load(shift)
        or die CPAN::Meta::YAML->errstr;
      return $object;
    }
    
    1;
    
    __END__
    
    =pod
    
    =encoding utf-8
    
    =head1 NAME
    
    Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
    
    =head1 VERSION
    
    version 1.4407
    
    =head1 SYNOPSIS
    
        #############################################
        # In your file
        
        ---
        name: My-Distribution
        version: 1.23
        resources:
          homepage: "http://example.com/dist/My-Distribution"
        
        
        #############################################
        # In your program
        
        use Parse::CPAN::Meta;
        
        my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
        
        # Reading properties
        my $name     = $distmeta->{name};
        my $version  = $distmeta->{version};
        my $homepage = $distmeta->{resources}{homepage};
    
    =head1 DESCRIPTION
    
    B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
    L<JSON::PP> and/or L<CPAN::Meta::YAML>.
    
    B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
    and C<load_yaml_string>.  These will read and deserialize CPAN metafiles, and
    are described below in detail.
    
    B<Parse::CPAN::Meta> provides a legacy API of only two functions,
    based on the YAML functions of the same name. Wherever possible,
    identical calling semantics are used.  These may only be used with YAML sources.
    
    All error reporting is done with exceptions (die'ing).
    
    Note that META files are expected to be in UTF-8 encoding, only.  When
    converted string data, it must first be decoded from UTF-8.
    
    =for Pod::Coverage HAVE_UTF8 IO_LAYER
    
    =head1 METHODS
    
    =head2 load_file
    
      my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
    
      my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
    
    This method will read the named file and deserialize it to a data structure,
    determining whether it should be JSON or YAML based on the filename.  On
    Perl 5.8.1 or later, the file will be read using the ":utf8" IO layer.
    
    =head2 load_yaml_string
    
      my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
    
    This method deserializes the given string of YAML and returns the first
    document in it.  (CPAN metadata files should always have only one document.)
    If the source was UTF-8 encoded, the string must be decoded before calling
    C<load_yaml_string>.
    
    =head2 load_json_string
    
      my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
    
    This method deserializes the given string of JSON and the result.  
    If the source was UTF-8 encoded, the string must be decoded before calling
    C<load_json_string>.
    
    =head2 yaml_backend
    
      my $backend = Parse::CPAN::Meta->yaml_backend;
    
    Returns the module name of the YAML serializer. See L</ENVIRONMENT>
    for details.
    
    =head2 json_backend
    
      my $backend = Parse::CPAN::Meta->json_backend;
    
    Returns the module name of the JSON serializer.  This will either
    be L<JSON::PP> or L<JSON>.  Even if C<PERL_JSON_BACKEND> is set,
    this will return L<JSON> as further delegation is handled by
    the L<JSON> module.  See L</ENVIRONMENT> for details.
    
    =head1 FUNCTIONS
    
    For maintenance clarity, no functions are exported.  These functions are
    available for backwards compatibility only and are best avoided in favor of
    C<load_file>.
    
    =head2 Load
    
      my @yaml = Parse::CPAN::Meta::Load( $string );
    
    Parses a string containing a valid YAML stream into a list of Perl data
    structures.
    
    =head2 LoadFile
    
      my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
    
    Reads the YAML stream from a file instead of a string.
    
    =head1 ENVIRONMENT
    
    =head2 PERL_JSON_BACKEND
    
    By default, L<JSON::PP> will be used for deserializing JSON data. If the
    C<PERL_JSON_BACKEND> environment variable exists, is true and is not
    "JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
    used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
    old, an exception will be thrown.
    
    =head2 PERL_YAML_BACKEND
    
    By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
    the C<PERL_YAML_BACKEND> environment variable is defined, then it is interpreted
    as a module to use for deserialization.  The given module must be installed,
    must load correctly and must implement the C<Load()> function or an exception
    will be thrown.
    
    =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
    
    =head1 SUPPORT
    
    =head2 Bugs / Feature Requests
    
    Please report any bugs or feature requests through the issue tracker
    at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Parse-CPAN-Meta>.
    You will be notified automatically of any progress on your issue.
    
    =head2 Source Code
    
    This is open source software.  The code repository is available for
    public review and contribution under the terms of the license.
    
    L<https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta>
    
      git clone https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta.git
    
    =head1 AUTHORS
    
    =over 4
    
    =item *
    
    Adam Kennedy <adamk@cpan.org>
    
    =item *
    
    David Golden <dagolden@cpan.org>
    
    =back
    
    =head1 CONTRIBUTORS
    
    =over 4
    
    =item *
    
    Joshua ben Jore <jjore@cpan.org>
    
    =item *
    
    Neil Bowers <neil@bowers.com>
    
    =item *
    
    Ricardo SIGNES <rjbs@cpan.org>
    
    =item *
    
    Steffen Mller <smueller@cpan.org>
    
    =back
    
    =head1 COPYRIGHT AND LICENSE
    
    This software is copyright (c) 2013 by Adam Kennedy and Contributors.
    
    This is free software; you can redistribute it and/or modify it under
    the same terms as the Perl 5 programming language system itself.
    
    =cut
  PARSE_CPAN_META
  
  $fatpacked{"String/ShellQuote.pm"} = <<'STRING_SHELLQUOTE';
    # $Id: ShellQuote.pm,v 1.11 2010-06-11 20:08:57 roderick Exp $
    #
    # Copyright (c) 1997 Roderick Schertler.  All rights reserved.  This
    # program is free software; you can redistribute it and/or modify it
    # under the same terms as Perl itself.
    
    =head1 NAME
    
    String::ShellQuote - quote strings for passing through the shell
    
    =head1 SYNOPSIS
    
        $string = shell_quote @list;
        $string = shell_quote_best_effort @list;
        $string = shell_comment_quote $string;
    
    =head1 DESCRIPTION
    
    This module contains some functions which are useful for quoting strings
    which are going to pass through the shell or a shell-like object.
    
    =over
    
    =cut
    
    package String::ShellQuote;
    
    use strict;
    use vars qw($VERSION @ISA @EXPORT);
    
    require Exporter;
    
    $VERSION	= '1.04';
    @ISA		= qw(Exporter);
    @EXPORT		= qw(shell_quote shell_quote_best_effort shell_comment_quote);
    
    sub croak {
        require Carp;
        goto &Carp::croak;
    }
    
    sub _shell_quote_backend {
        my @in = @_;
        my @err = ();
    
        if (0) {
    	require RS::Handy;
    	print RS::Handy::data_dump(\@in);
        }
    
        return \@err, '' unless @in;
    
        my $ret = '';
        my $saw_non_equal = 0;
        foreach (@in) {
    	if (!defined $_ or $_ eq '') {
    	    $_ = "''";
    	    next;
    	}
    
    	if (s/\x00//g) {
    	    push @err, "No way to quote string containing null (\\000) bytes";
    	}
    
        	my $escape = 0;
    
    	# = needs quoting when it's the first element (or part of a
    	# series of such elements), as in command position it's a
    	# program-local environment setting
    
    	if (/=/) {
    	    if (!$saw_non_equal) {
    	    	$escape = 1;
    	    }
    	}
    	else {
    	    $saw_non_equal = 1;
    	}
    
    	if (m|[^\w!%+,\-./:=@^]|) {
    	    $escape = 1;
    	}
    
    	if ($escape
    		|| (!$saw_non_equal && /=/)) {
    
    	    # ' -> '\''
        	    s/'/'\\''/g;
    
    	    # make multiple ' in a row look simpler
    	    # '\'''\'''\'' -> '"'''"'
        	    s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;
    
    	    $_ = "'$_'";
    	    s/^''//;
    	    s/''$//;
    	}
        }
        continue {
    	$ret .= "$_ ";
        }
    
        chop $ret;
        return \@err, $ret;
    }
    
    =item B<shell_quote> [I<string>]...
    
    B<shell_quote> quotes strings so they can be passed through the shell.
    Each I<string> is quoted so that the shell will pass it along as a
    single argument and without further interpretation.  If no I<string>s
    are given an empty string is returned.
    
    If any I<string> can't be safely quoted B<shell_quote> will B<croak>.
    
    =cut
    
    sub shell_quote {
        my ($rerr, $s) = _shell_quote_backend @_;
    
        if (@$rerr) {
        	my %seen;
        	@$rerr = grep { !$seen{$_}++ } @$rerr;
    	my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
    	chomp $s;
    	croak $s;
        }
        return $s;
    }
    
    =item B<shell_quote_best_effort> [I<string>]...
    
    This is like B<shell_quote>, excpet if the string can't be safely quoted
    it does the best it can and returns the result, instead of dying.
    
    =cut
    
    sub shell_quote_best_effort {
        my ($rerr, $s) = _shell_quote_backend @_;
    
        return $s;
    }
    
    =item B<shell_comment_quote> [I<string>]
    
    B<shell_comment_quote> quotes the I<string> so that it can safely be
    included in a shell-style comment (the current algorithm is that a sharp
    character is placed after any newlines in the string).
    
    This routine might be changed to accept multiple I<string> arguments
    in the future.  I haven't done this yet because I'm not sure if the
    I<string>s should be joined with blanks ($") or nothing ($,).  Cast
    your vote today!  Be sure to justify your answer.
    
    =cut
    
    sub shell_comment_quote {
        return '' unless @_;
        unless (@_ == 1) {
    	croak "Too many arguments to shell_comment_quote "
    	    	    . "(got " . @_ . " expected 1)";
        }
        local $_ = shift;
        s/\n/\n#/g;
        return $_;
    }
    
    1;
    
    __END__
    
    =back
    
    =head1 EXAMPLES
    
        $cmd = 'fuser 2>/dev/null ' . shell_quote @files;
        @pids = split ' ', `$cmd`;
    
        print CFG "# Configured by: ",
    		shell_comment_quote($ENV{LOGNAME}), "\n";
    
    =head1 BUGS
    
    Only Bourne shell quoting is supported.  I'd like to add other shells
    (particularly cmd.exe), but I'm not familiar with them.  It would be a
    big help if somebody supplied the details.
    
    =head1 AUTHOR
    
    Roderick Schertler <F<roderick@argon.org>>
    
    =head1 SEE ALSO
    
    perl(1).
    
    =cut
  STRING_SHELLQUOTE
  
  $fatpacked{"aliased.pm"} = <<'ALIASED';
    package aliased;
    
    our $VERSION = '0.31';
    $VERSION = eval $VERSION;
    
    require Exporter;
    @ISA    = qw(Exporter);
    @EXPORT = qw(alias prefix);
    
    use strict;
    
    sub _croak {
        require Carp;
        Carp::croak(@_);
    }
    
    sub import {
        my ( $class, $package, $alias, @import ) = @_;
    
        if ( @_ <= 1 ) {
            $class->export_to_level(1);
            return;
        }
    
        my $callpack = caller(0);
        _load_alias( $package, $callpack, @import );
        _make_alias( $package, $callpack, $alias );
    }
    
    sub _get_alias {
        my $package = shift;
        $package =~ s/.*(?:::|')//;
        return $package;
    }
    
    sub _make_alias {
        my ( $package, $callpack, $alias ) = @_;
    
        $alias ||= _get_alias($package);
    
        my $destination = $alias =~ /::/
          ? $alias
          : "$callpack\::$alias";
    
        no strict 'refs';
        *{ $destination } = sub () { $package };
    }
    
    sub _load_alias {
        my ( $package, $callpack, @import ) = @_;
    
        # We don't localize $SIG{__DIE__} here because we need to be careful about
        # restoring its value if there is a failure.  Very, very tricky.
        my $sigdie = $SIG{__DIE__};
        {
            my $code =
              @import == 0
              ? "package $callpack; use $package;"
              : "package $callpack; use $package (\@import)";
            eval $code;
            if ( my $error = $@ ) {
                $SIG{__DIE__} = $sigdie;
                _croak($error);
            }
            $sigdie = $SIG{__DIE__}
              if defined $SIG{__DIE__};
        }
    
        # Make sure a global $SIG{__DIE__} makes it out of the localization.
        $SIG{__DIE__} = $sigdie if defined $sigdie;
        return $package;
    }
    
    sub alias {
        my ( $package, @import ) = @_;
    
        my $callpack = scalar caller(0);
        return _load_alias( $package, $callpack, @import );
    }
    
    sub prefix {
        my ($class) = @_;
        return sub {
            my ($name) = @_;
            my $callpack = caller(0);
            if ( not @_ ) {
                return _load_alias( $class, $callpack );
            }
            elsif ( @_ == 1 && defined $name ) {
                return _load_alias( "${class}::$name", $callpack );
            }
            else {
                _croak("Too many arguments to prefix('$class')");
            }
        };
    }
    
    1;
    __END__
    
    =head1 NAME
    
    aliased - Use shorter versions of class names.
    
    =head1 VERSION
    
    0.31
    
    =head1 SYNOPSIS
    
      # Class name interface
      use aliased 'My::Company::Namespace::Customer';
      my $cust = Customer->new;
    
      use aliased 'My::Company::Namespace::Preferred::Customer' => 'Preferred';
      my $pref = Preferred->new;
    
    
      # Variable interface
      use aliased;
      my $Customer  = alias "My::Other::Namespace::Customer";
      my $cust      = $Customer->new;
    
      my $Preferred = alias "My::Other::Namespace::Preferred::Customer";
      my $pref      = $Preferred->new;  
    
    
    =head1 DESCRIPTION
    
    C<aliased> is simple in concept but is a rather handy module.  It loads the
    class you specify and exports into your namespace a subroutine that returns
    the class name.  You can explicitly alias the class to another name or, if you
    prefer, you can do so implicitly.  In the latter case, the name of the
    subroutine is the last part of the class name.  Thus, it does something
    similar to the following:
    
      #use aliased 'Some::Annoyingly::Long::Module::Name::Customer';
    
      use Some::Annoyingly::Long::Module::Name::Customer;
      sub Customer {
        return 'Some::Annoyingly::Long::Module::Name::Customer';
      }
      my $cust = Customer->new;
    
    This module is useful if you prefer a shorter name for a class.  It's also
    handy if a class has been renamed.
    
    (Some may object to the term "aliasing" because we're not aliasing one
    namespace to another, but it's a handy term.  Just keep in mind that this is
    done with a subroutine and not with typeglobs and weird namespace munging.)
    
    Note that this is B<only> for C<use>ing OO modules.  You cannot use this to
    load procedural modules.  See the L<Why OO Only?|Why OO Only?> section.  Also,
    don't let the version number fool you.  This code is ridiculously simple and
    is just fine for most use.
    
    =head2 Implicit Aliasing
    
    The most common use of this module is:
    
      use aliased 'Some::Module::name';
    
    C<aliased> will  allow you to reference the class by the last part of the
    class name.  Thus, C<Really::Long::Name> becomes C<Name>.  It does this by
    exporting a subroutine into your namespace with the same name as the aliased
    name.  This subroutine returns the original class name.
    
    For example:
    
      use aliased "Acme::Company::Customer";
      my $cust = Customer->find($id);
    
    Note that any class method can be called on the shorter version of the class
    name, not just the constructor.
    
    =head2 Explicit Aliasing
    
    Sometimes two class names can cause a conflict (they both end with C<Customer>
    for example), or you already have a subroutine with the same name as the
    aliased name.  In that case, you can make an explicit alias by stating the
    name you wish to alias to:
    
      use aliased 'Original::Module::Name' => 'NewName';
    
    Here's how we use C<aliased> to avoid conflicts:
    
      use aliased "Really::Long::Name";
      use aliased "Another::Really::Long::Name" => "Aname";
      my $name  = Name->new;
      my $aname = Aname->new;
    
    You can even alias to a different package:
    
      use aliased "Another::Really::Long::Name" => "Another::Name";
      my $aname = Another::Name->new;
    
    Messing around with different namespaces is a really bad idea and you probably
    don't want to do this.  However, it might prove handy if the module you are
    using has been renamed.  If the interface has not changed, this allows you to
    use the new module by only changing one line of code.
    
      use aliased "New::Module::Name" => "Old::Module::Name";
      my $thing = Old::Module::Name->new;
    
    =head2 Import Lists
    
    Sometimes, even with an OO module, you need to specify extra arguments when
    using the module.  When this happens, simply use L<Explicit Aliasing> followed
    by the import list:
    
    Snippet 1:
    
      use Some::Module::Name qw/foo bar/;
      my $o = Some::Module::Name->some_class_method; 
    
    Snippet 2 (equivalent to snippet 1):
    
      use aliased 'Some::Module::Name' => 'Name', qw/foo bar/;
      my $o = Name->some_class_method;
    
    B<Note>:  remember, you cannot use import lists with L<Implicit Aliasing>.  As
    a result, you may simply prefer to only use L<Explicit Aliasing> as a matter
    of style.
    
    =head2 alias()
    
    This function is only exported if you specify C<use aliased> with no import
    list.
    
        use aliased;
        my $alias = alias($class);
        my $alias = alias($class, @imports);
    
    alias() is an alternative to C<use aliased ...> which uses less magic and
    avoids some of the ambiguities.
    
    Like C<use aliased> it C<use>s the $class (pass in @imports, if given) but
    instead of providing an C<Alias> constant it simply returns a scalar set to
    the $class name.
    
        my $thing = alias("Some::Thing::With::A::Long::Name");
    
        # Just like Some::Thing::With::A::Long::Name->method
        $thing->method;
    
    The use of a scalar instead of a constant avoids any possible ambiguity
    when aliasing two similar names:
    
        # No ambiguity despite the fact that they both end with "Name"
        my $thing = alias("Some::Thing::With::A::Long::Name");
        my $other = alias("Some::Other::Thing::With::A::Long::Name");
    
    and there is no magic constant exported into your namespace.
    
    The only caveat is loading of the $class happens at run time.  If $class
    exports anything you might want to ensure it is loaded at compile time with:
    
        my $thing;
        BEGIN { $thing = alias("Some::Thing"); }
    
    However, since OO classes rarely export this should not be necessary.
    
    =head2 prefix() (experimental)
    
    This function is only exported if you specify C<use aliased> with no import
    list.
    
        use aliased;
    
    Sometimes you find you have a ton of packages in the same top-level namespace
    and you want to alias them, but only use them on demand.  For example:
    
        # instead of:
        MailVerwaltung::Client::Exception::REST::Response->throw()
    
        my $error = prefix('MailVerwaltung::Client::Exception');
        $error->('REST::Response')->throw();   # same as above
        $error->()->throw; # same as MailVerwaltung::Client::Exception->throw
    
    =head2 Why OO Only?
    
    Some people have asked why this code only support object-oriented modules
    (OO).  If I were to support normal subroutines, I would have to allow the
    following syntax:
    
      use aliased 'Some::Really::Long::Module::Name';
      my $data = Name::data();
    
    That causes a serious problem.  The only (reasonable) way it can be done is to
    handle the aliasing via typeglobs.  Thus, instead of a subroutine that
    provides the class name, we alias one package to another (as the
    L<namespace|namespace> module does.)  However, we really don't want to simply
    alias one package to another and wipe out namespaces willy-nilly.  By merely
    exporting a single subroutine to a namespace, we minimize the issue. 
    
    Fortunately, this doesn't seem to be that much of a problem.  Non-OO modules
    generally support exporting of the functions you need and this eliminates the
    need for a module such as this.
    
    =head1 EXPORT
    
    This modules exports a subroutine with the same name as the "aliased" name.
    
    =head1 BUGS
    
    There are no known bugs in this module, but feel free to email me reports.
    
    =head1 SEE ALSO
    
    The L<namespace> module.
    
    =head1 THANKS
    
    Many thanks to Rentrak, Inc. (http://www.rentrak.com/) for graciously allowing
    me to replicate the functionality of some of their internal code.
    
    =head1 AUTHOR
    
    Curtis Poe, C<< ovid [at] cpan [dot] org >>
    
    =head1 COPYRIGHT AND LICENSE
    
    Copyright (C) 2005 by Curtis "Ovid" Poe
    
    This library is free software; you can redistribute it and/or modify
    it under the same terms as Perl itself, either Perl version 5.8.5 or,
    at your option, any later version of Perl 5 you may have available.
    
    =cut
  ALIASED
  
  $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
    }
    
    =head1 NAME
    
    lib::core::only - Remove all non-core paths from @INC to avoid site/vendor dirs
    
    =head1 SYNOPSIS
    
      use lib::core::only; # now @INC contains only the two core directories
    
    To get only the core directories plus the ones for the local::lib in scope:
    
      $ perl -Mlib::core::only -Mlocal::lib=~/perl5 myscript.pl
    
    To attempt to do a self-contained build (but note this will not reliably
    propagate into subprocesses, see the CAVEATS below):
    
      $ PERL5OPT='-Mlib::core::only -Mlocal::lib=~/perl5' cpan
    
    =head1 DESCRIPTION
    
    lib::core::only is simply a shortcut to say "please reduce my @INC to only
    the core lib and archlib (architecture-specific lib) directories of this perl".
    
    You might want to do this to ensure a local::lib contains only the code you
    need, or to test an L<App::FatPacker|App::FatPacker> tree, or to avoid known
    bad vendor packages.
    
    You might want to use this to try and install a self-contained tree of perl
    modules. Be warned that that probably won't work (see L</CAVEATS>).
    
    This module was extracted from L<local::lib|local::lib>'s --self-contained
    feature, and contains the only part that ever worked. I apologise to anybody
    who thought anything else did.
    
    =head1 CAVEATS
    
    This does B<not> propagate properly across perl invocations like local::lib's
    stuff does. It can't. It's only a module import, so it B<only affects the
    specific perl VM instance in which you load and import() it>.
    
    If you want to cascade it across invocations, you can set the PERL5OPT
    environment variable to '-Mlib::core::only' and it'll sort of work. But be
    aware that taint mode ignores this, so some modules' build and test code
    probably will as well.
    
    You also need to be aware that perl's command line options are not processed
    in order - -I options take effect before -M options, so
    
      perl -Mlib::core::only -Ilib
    
    is unlike to do what you want - it's exactly equivalent to:
    
      perl -Mlib::core::only
    
    If you want to combine a core-only @INC with additional paths, you need to
    add the additional paths using -M options and the L<lib|lib> module:
    
      perl -Mlib::core::only -Mlib=lib
    
      # or if you're trying to test compiled code:
    
      perl -Mlib::core::only -Mblib
    
    For more information on the impossibility of sanely propagating this across
    module builds without help from the build program, see
    L<http://www.shadowcat.co.uk/blog/matt-s-trout/tainted-love> - and for ways
    to achieve the old --self-contained feature's results, look at
    L<App::FatPacker|App::FatPacker>'s tree function, and at
    L<App::cpanminus|cpanm>'s --local-lib-contained feature.
    
    =head1 AUTHOR
    
    Matt S. Trout <mst@shadowcat.co.uk>
    
    =head1 LICENSE
    
    This library is free software under the same terms as perl itself.
    
    =head1 COPYRIGHT
    
    (c) 2010 the lib::core::only L</AUTHOR> as specified above.
    
    =cut
    
    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 Config;
    
    our $VERSION = '1.008011'; # 1.8.11
    
    our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all);
    
    sub DEACTIVATE_ONE () { 1 }
    sub DEACTIVATE_ALL () { 2 }
    
    sub INTERPOLATE_ENV () { 1 }
    sub LITERAL_ENV     () { 0 }
    
    sub import {
      my ($class, @args) = @_;
    
      # Remember what PERL5LIB was when we started
      my $perl5lib = $ENV{PERL5LIB} || '';
    
      my %arg_store;
      for my $arg (@args) {
        # check for lethal dash first to stop processing before causing problems
        if ($arg =~ /−/) {
          die <<'DEATH';
    WHOA THERE! It looks like you've got some fancy dashes in your commandline!
    These are *not* the traditional -- dashes that software recognizes. You
    probably got these by copy-pasting from the perldoc for this module as
    rendered by a UTF8-capable formatter. This most typically happens on an OS X
    terminal, but can happen elsewhere too. Please try again after replacing the
    dashes with normal minus signs.
    DEATH
        }
        elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
          (my $flag = $arg) =~ s/--//;
          $arg_store{$flag} = 1;
        }
        elsif($arg =~ /^--/) {
          die "Unknown import argument: $arg";
        }
        else {
          # assume that what's left is a path
          $arg_store{path} = $arg;
        }
      }
    
      if($arg_store{'self-contained'}) {
        die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise).\n";
      }
    
      my $deactivating = 0;
      if ($arg_store{deactivate}) {
        $deactivating = DEACTIVATE_ONE;
      }
      if ($arg_store{'deactivate-all'}) {
        $deactivating = DEACTIVATE_ALL;
      }
    
      $arg_store{path} = $class->resolve_path($arg_store{path});
      $class->setup_local_lib_for($arg_store{path}, $deactivating);
    
      for (@INC) { # Untaint @INC
        next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
        m/(.*)/ and $_ = $1;
      }
    }
    
    sub pipeline;
    
    sub pipeline {
      my @methods = @_;
      my $last = pop(@methods);
      if (@methods) {
        \sub {
          my ($obj, @args) = @_;
          $obj->${pipeline @methods}(
            $obj->$last(@args)
          );
        };
      } else {
        \sub {
          shift->$last(@_);
        };
      }
    }
    
    =begin testing
    
    #:: test pipeline
    
    package local::lib;
    
    { package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
    my $foo = bless({}, 'Foo');                                                 
    Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
    
    =end testing
    
    =cut
    
    sub _uniq {
        my %seen;
        grep { ! $seen{$_}++ } @_;
    }
    
    sub resolve_path {
      my ($class, $path) = @_;
      $class->${pipeline qw(
        resolve_relative_path
        resolve_home_path
        resolve_empty_path
      )}($path);
    }
    
    sub resolve_empty_path {
      my ($class, $path) = @_;
      if (defined $path) {
        $path;
      } else {
        '~/perl5';
      }
    }
    
    =begin testing
    
    #:: test classmethod setup
    
    my $c = 'local::lib';
    
    =end testing
    
    =begin testing
    
    #:: test classmethod
    
    is($c->resolve_empty_path, '~/perl5');
    is($c->resolve_empty_path('foo'), 'foo');
    
    =end testing
    
    =cut
    
    sub resolve_home_path {
      my ($class, $path) = @_;
      return $path unless ($path =~ /^~/);
      my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
      my $tried_file_homedir;
      my $homedir = do {
        if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
          $tried_file_homedir = 1;
          if (defined $user) {
            File::HomeDir->users_home($user);
          } else {
            File::HomeDir->my_home;
          }
        } else {
          if (defined $user) {
            (getpwnam $user)[7];
          } else {
            if (defined $ENV{HOME}) {
              $ENV{HOME};
            } else {
              (getpwuid $<)[7];
            }
          }
        }
      };
      unless (defined $homedir) {
        require Carp;
        Carp::croak(
          "Couldn't resolve homedir for "
          .(defined $user ? $user : 'current user')
          .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
        );
      }
      $path =~ s/^~[^\/]*/$homedir/;
      $path;
    }
    
    sub resolve_relative_path {
      my ($class, $path) = @_;
      $path = File::Spec->rel2abs($path);
    }
    
    =begin testing
    
    #:: test classmethod
    
    local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; };
    is($c->resolve_relative_path('bar'),'FOObar');
    
    =end testing
    
    =cut
    
    sub setup_local_lib_for {
      my ($class, $path, $deactivating) = @_;
    
      my $interpolate = LITERAL_ENV;
      my @active_lls = $class->active_paths;
    
      $class->ensure_dir_structure_for($path);
    
      # On Win32 directories often contain spaces. But some parts of the CPAN
      # toolchain don't like that. To avoid this, GetShortPathName() gives us
      # an alternate representation that has none.
      # This only works if the directory already exists.
      $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
    
      if (! $deactivating) {
        if (@active_lls && $active_lls[-1] eq $path) {
          exit 0 if $0 eq '-';
          return; # Asked to add what's already at the top of the stack
        } elsif (grep { $_ eq $path} @active_lls) {
          # Asked to add a dir that's lower in the stack -- so we remove it from
          # where it is, and then add it back at the top.
          $class->setup_env_hash_for($path, DEACTIVATE_ONE);
          # Which means we can no longer output "PERL5LIB=...:$PERL5LIB" stuff
          # anymore because we're taking something *out*.
          $interpolate = INTERPOLATE_ENV;
        }
      }
    
      if ($0 eq '-') {
        $class->print_environment_vars_for($path, $deactivating, $interpolate);
        exit 0;
      } else {
        $class->setup_env_hash_for($path, $deactivating);
        my $arch_dir = $Config{archname};
        @INC = _uniq(
      (
          # Inject $path/$archname for each path in PERL5LIB
          map { ( File::Spec->catdir($_, $arch_dir), $_ ) }
          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);
      return
    }
    
    sub guess_shelltype {
      my $shellbin = 'sh';
      if(defined $ENV{'SHELL'}) {
          my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
          $shellbin = $shell_bin_path_parts[-1];
      }
      my $shelltype = do {
          local $_ = $shellbin;
          if(/csh/) {
              'csh'
          } else {
              'bourne'
          }
      };
    
      # Both Win32 and Cygwin have $ENV{COMSPEC} set.
      if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
          my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
          $shellbin = $shell_bin_path_parts[-1];
             $shelltype = do {
                     local $_ = $shellbin;
                     if(/command\.com/) {
                             'win32'
                     } elsif(/cmd\.exe/) {
                             'win32'
                     } elsif(/4nt\.exe/) {
                             'win32'
                     } else {
                             $shelltype
                     }
             };
      }
      return $shelltype;
    }
    
    sub print_environment_vars_for {
      my ($class, $path, $deactivating, $interpolate) = @_;
      print $class->environment_vars_string_for($path, $deactivating, $interpolate);
    }
    
    sub environment_vars_string_for {
      my ($class, $path, $deactivating, $interpolate) = @_;
      my @envs = $class->build_environment_vars_for($path, $deactivating, $interpolate);
      my $out = '';
    
      # rather basic csh detection, goes on the assumption that something won't
      # call itself csh unless it really is. also, default to bourne in the
      # pathological situation where a user doesn't have $ENV{SHELL} defined.
      # note also that shells with funny names, like zoid, are assumed to be
      # bourne.
    
      my $shelltype = $class->guess_shelltype;
    
      while (@envs) {
        my ($name, $value) = (shift(@envs), shift(@envs));
        $value =~ s/(\\")/\\$1/g if defined $value;
        $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
      }
      return $out;
    }
    
    # simple routines that take two arguments: an %ENV key and a value. return
    # strings that are suitable for passing directly to the relevant shell to set
    # said key to said value.
    sub build_bourne_env_declaration {
      my $class = shift;
      my($name, $value) = @_;
      return defined($value) ? qq{export ${name}="${value}";\n} : qq{unset ${name};\n};
    }
    
    sub build_csh_env_declaration {
      my $class = shift;
      my($name, $value) = @_;
      return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n};
    }
    
    sub build_win32_env_declaration {
      my $class = shift;
      my($name, $value) = @_;
      return defined($value) ? qq{set ${name}=${value}\n} : qq{set ${name}=\n};
    }
    
    sub setup_env_hash_for {
      my ($class, $path, $deactivating) = @_;
      my %envs = $class->build_environment_vars_for($path, $deactivating, INTERPOLATE_ENV);
      @ENV{keys %envs} = values %envs;
    }
    
    sub build_environment_vars_for {
      my ($class, $path, $deactivating, $interpolate) = @_;
    
      if ($deactivating == DEACTIVATE_ONE) {
        return $class->build_deactivate_environment_vars_for($path, $interpolate);
      } elsif ($deactivating == DEACTIVATE_ALL) {
        return $class->build_deact_all_environment_vars_for($path, $interpolate);
      } else {
        return $class->build_activate_environment_vars_for($path, $interpolate);
      }
    }
    
    # Build an environment value for a variable like PATH from a list of paths.
    # References to existing variables are given as references to the variable name.
    # Duplicates are removed.
    #
    # options:
    # - interpolate: INTERPOLATE_ENV/LITERAL_ENV
    # - exists: paths are included only if they exist (default: interpolate == INTERPOLATE_ENV)
    # - filter: function to apply to each path do decide if it must be included
    # - empty: the value to return in the case of empty value
    my %ENV_LIST_VALUE_DEFAULTS = (
        interpolate => INTERPOLATE_ENV,
        exists => undef,
        filter => sub { 1 },
        empty => undef,
    );
    sub _env_list_value {
      my $options = shift;
      die(sprintf "unknown option '$_' at %s line %u\n", (caller)[1..2])
        for grep { !exists $ENV_LIST_VALUE_DEFAULTS{$_} } keys %$options;
      my %options = (%ENV_LIST_VALUE_DEFAULTS, %{ $options });
      $options{exists} = $options{interpolate} == INTERPOLATE_ENV
        unless defined $options{exists};
    
      my %seen;
    
      my $value = join($Config{path_sep}, map {
          ref $_ ? ($^O eq 'MSWin32' ? "%${$_}%" : "\$${$_}") : $_
        } grep {
          ref $_ || (defined $_
                     && length($_) > 0
                     && !$seen{$_}++
                     && $options{filter}->($_)
                     && (!$options{exists} || -e $_))
        } map {
          if (ref $_ eq 'SCALAR' && $options{interpolate} == INTERPOLATE_ENV) {
            defined $ENV{${$_}} ? (split /\Q$Config{path_sep}/, $ENV{${$_}}) : ()
          } else {
            $_
          }
        } @_);
      return length($value) ? $value : $options{empty};
    }
    
    sub build_activate_environment_vars_for {
      my ($class, $path, $interpolate) = @_;
      return (
        PERL_LOCAL_LIB_ROOT =>
                _env_list_value(
                  { interpolate => $interpolate, exists => 0, empty => '' },
                  \'PERL_LOCAL_LIB_ROOT',
                  $path,
                ),
        PERL_MB_OPT => "--install_base ${path}",
        PERL_MM_OPT => "INSTALL_BASE=${path}",
        PERL5LIB =>
                _env_list_value(
                  { interpolate => $interpolate, exists => 0, empty => '' },
                  $class->install_base_perl_path($path),
                  \'PERL5LIB',
                ),
        PATH => _env_list_value(
                  { interpolate => $interpolate, exists => 0, empty => '' },
            $class->install_base_bin_path($path),
                  \'PATH',
                ),
      )
    }
    
    sub active_paths {
      my ($class) = @_;
    
      return () unless defined $ENV{PERL_LOCAL_LIB_ROOT};
      return grep { $_ ne '' } split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT};
    }
    
    sub build_deactivate_environment_vars_for {
      my ($class, $path, $interpolate) = @_;
    
      my @active_lls = $class->active_paths;
    
      if (!grep { $_ eq $path } @active_lls) {
        warn "Tried to deactivate inactive local::lib '$path'\n";
        return ();
      }
    
      my $perl_path = $class->install_base_perl_path($path);
      my $arch_path = $class->install_base_arch_path($path);
      my $bin_path = $class->install_base_bin_path($path);
    
    
      my %env = (
        PERL_LOCAL_LIB_ROOT => _env_list_value(
          {
            exists => 0,
          },
          grep { $_ ne $path } @active_lls
        ),
        PERL5LIB => _env_list_value(
          {
            exists => 0,
            filter => sub {
              $_ ne $perl_path && $_ ne $arch_path
            },
          },
          \'PERL5LIB',
        ),
        PATH => _env_list_value(
          {
            exists => 0,
            filter => sub { $_ ne $bin_path },
          },
          \'PATH',
        ),
      );
    
      # If removing ourselves from the "top of the stack", set install paths to
      # correspond with the new top of stack.
      if ($active_lls[-1] eq $path) {
        my $new_top = $active_lls[-2];
        $env{PERL_MB_OPT} = defined($new_top) ? "--install_base ${new_top}" : undef;
        $env{PERL_MM_OPT} = defined($new_top) ? "INSTALL_BASE=${new_top}" : undef;
      }
    
      return %env;
    }
    
    sub build_deact_all_environment_vars_for {
      my ($class, $path, $interpolate) = @_;
    
      my @active_lls = $class->active_paths;
    
      my %perl_paths = map { (
          $class->install_base_perl_path($_) => 1,
          $class->install_base_arch_path($_) => 1
        ) } @active_lls;
      my %bin_paths = map { (
          $class->install_base_bin_path($_) => 1,
        ) } @active_lls;
    
      my %env = (
        PERL_LOCAL_LIB_ROOT => undef,
        PERL_MM_OPT => undef,
        PERL_MB_OPT => undef,
        PERL5LIB => _env_list_value(
          {
            exists => 0,
            filter => sub {
              ! scalar grep { exists $perl_paths{$_} } $_[0]
            },
          },
          \'PERL5LIB'
        ),
        PATH => _env_list_value(
          {
            exists => 0,
            filter => sub {
              ! scalar grep { exists $bin_paths{$_} } $_[0]
            },
          },
          \'PATH'
        ),
      );
    
      return %env;
    }
    
    =begin testing
    
    #:: test classmethod
    
    File::Path::rmtree('t/var/splat');
    
    $c->ensure_dir_structure_for('t/var/splat');
    
    ok(-d 't/var/splat');
    
    =end testing
    
    =encoding utf8
    
    =head1 NAME
    
    local::lib - create and use a local lib/ for perl modules with PERL5LIB
    
    =head1 SYNOPSIS
    
    In code -
    
      use local::lib; # sets up a local lib at ~/perl5
    
      use local::lib '~/foo'; # same, but ~/foo
    
      # Or...
      use FindBin;
      use local::lib "$FindBin::Bin/../support";  # app-local support library
    
    From the shell -
    
      # Install LWP and its missing dependencies to the '~/perl5' directory
      perl -MCPAN -Mlocal::lib -e 'CPAN::install(LWP)'
    
      # Just print out useful shell commands
      $ perl -Mlocal::lib
      export PERL_MB_OPT='--install_base /home/username/perl5'
      export PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'
      export PERL5LIB='/home/username/perl5/lib/perl5/i386-linux:/home/username/perl5/lib/perl5'
      export PATH="/home/username/perl5/bin:$PATH"
    
    =head2 The bootstrapping technique
    
    A typical way to install local::lib is using what is known as the
    "bootstrapping" technique.  You would do this if your system administrator
    hasn't already installed local::lib.  In this case, you'll need to install
    local::lib in your home directory. 
    
    If you do have administrative privileges, you will still want to set up your 
    environment variables, as discussed in step 4. Without this, you would still
    install the modules into the system CPAN installation and also your Perl scripts
    will not use the lib/ path you bootstrapped with local::lib.
    
    By default local::lib installs itself and the CPAN modules into ~/perl5.
    
    Windows users must also see L</Differences when using this module under Win32>.
    
    1. Download and unpack the local::lib tarball from CPAN (search for "Download"
    on the CPAN page about local::lib).  Do this as an ordinary user, not as root
    or administrator.  Unpack the file in your home directory or in any other
    convenient location.
    
    2. Run this:
    
      perl Makefile.PL --bootstrap
    
    If the system asks you whether it should automatically configure as much
    as possible, you would typically answer yes.
    
    In order to install local::lib into a directory other than the default, you need
    to specify the name of the directory when you call bootstrap, as follows:
    
      perl Makefile.PL --bootstrap=~/foo
    
    3. Run this: (local::lib assumes you have make installed on your system)
    
      make test && make install
    
    4. Now we need to setup the appropriate environment variables, so that Perl 
    starts using our newly generated lib/ directory. If you are using bash or
    any other Bourne shells, you can add this to your shell startup script this
    way:
    
      echo 'eval $(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)' >>~/.bashrc
    
    If you are using C shell, you can do this as follows:
    
      /bin/csh
      echo $SHELL
      /bin/csh
      perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc
    
    If you passed to bootstrap a directory other than default, you also need to give that as 
    import parameter to the call of the local::lib module like this way:
    
      echo 'eval $(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)' >>~/.bashrc
    
    After writing your shell configuration file, be sure to re-read it to get the
    changed settings into your current shell's environment. Bourne shells use 
    C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>.
    
    If you're on a slower machine, or are operating under draconian disk space
    limitations, you can disable the automatic generation of manpages from POD when
    installing modules by using the C<--no-manpages> argument when bootstrapping:
    
      perl Makefile.PL --bootstrap --no-manpages
    
    To avoid doing several bootstrap for several Perl module environments on the 
    same account, for example if you use it for several different deployed 
    applications independently, you can use one bootstrapped local::lib 
    installation to install modules in different directories directly this way:
    
      cd ~/mydir1
      perl -Mlocal::lib=./
      eval $(perl -Mlocal::lib=./)  ### To set the environment for this shell alone
      printenv                      ### You will see that ~/mydir1 is in the PERL5LIB
      perl -MCPAN -e install ...    ### whatever modules you want
      cd ../mydir2
      ... REPEAT ...
    
    If you are working with several C<local::lib> environments, you may want to
    remove some of them from the current environment without disturbing the others.
    You can deactivate one environment like this (using bourne sh):
    
      eval $(perl -Mlocal::lib=--deactivate,~/path)
    
    which will generate and run the commands needed to remove C<~/path> from your
    various search paths. Whichever environment was B<activated most recently> will
    remain the target for module installations. That is, if you activate
    C<~/path_A> and then you activate C<~/path_B>, new modules you install will go
    in C<~/path_B>. If you deactivate C<~/path_B> then modules will be installed
    into C<~/pathA> -- but if you deactivate C<~/path_A> then they will still be
    installed in C<~/pathB> because pathB was activated later.
    
    You can also ask C<local::lib> to clean itself completely out of the current
    shell's environment with the C<--deactivate-all> option.
    For multiple environments for multiple apps you may need to include a modified
    version of the C<< use FindBin >> instructions in the "In code" sample above.
    If you did something like the above, you have a set of Perl modules at C<<
    ~/mydir1/lib >>. If you have a script at C<< ~/mydir1/scripts/myscript.pl >>,
    you need to tell it where to find the modules you installed for it at C<<
    ~/mydir1/lib >>.
    
    In C<< ~/mydir1/scripts/myscript.pl >>:
    
      use strict;
      use warnings;
      use local::lib "$FindBin::Bin/..";  ### points to ~/mydir1 and local::lib finds lib
      use lib "$FindBin::Bin/../lib";     ### points to ~/mydir1/lib
    
    Put this before any BEGIN { ... } blocks that require the modules you installed.
    
    =head2 Differences when using this module under Win32
    
    To set up the proper environment variables for your current session of
    C<CMD.exe>, you can use this:
    
      C:\>perl -Mlocal::lib
      set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5
      set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5
      set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5;C:\DOCUME~1\ADMINI~1\perl5\lib\perl5\MSWin32-x86-multi-thread
      set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH%
      
      ### To set the environment for this shell alone
      C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\tmp.bat
      ### instead of $(perl -Mlocal::lib=./)
    
    If you want the environment entries to persist, you'll need to add then to the
    Control Panel's System applet yourself or use L<App::local::lib::Win32Helper>.
    
    The "~" is translated to the user's profile directory (the directory named for
    the user under "Documents and Settings" (Windows XP or earlier) or "Users"
    (Windows Vista or later)) unless $ENV{HOME} exists. After that, the home
    directory is translated to a short name (which means the directory must exist)
    and the subdirectories are created.
    
    =head1 RATIONALE
    
    The version of a Perl package on your machine is not always the version you
    need.  Obviously, the best thing to do would be to update to the version you
    need.  However, you might be in a situation where you're prevented from doing
    this.  Perhaps you don't have system administrator privileges; or perhaps you
    are using a package management system such as Debian, and nobody has yet gotten
    around to packaging up the version you need.
    
    local::lib solves this problem by allowing you to create your own directory of
    Perl packages downloaded from CPAN (in a multi-user system, this would typically
    be within your own home directory).  The existing system Perl installation is
    not affected; you simply invoke Perl with special options so that Perl uses the
    packages in your own local package directory rather than the system packages.
    local::lib arranges things so that your locally installed version of the Perl
    packages takes precedence over the system installation.
    
    If you are using a package management system (such as Debian), you don't need to
    worry about Debian and CPAN stepping on each other's toes.  Your local version
    of the packages will be written to an entirely separate directory from those
    installed by Debian.  
    
    =head1 DESCRIPTION
    
    This module provides a quick, convenient way of bootstrapping a user-local Perl
    module library located within the user's home directory. It also constructs and
    prints out for the user the list of environment variables using the syntax
    appropriate for the user's current shell (as specified by the C<SHELL>
    environment variable), suitable for directly adding to one's shell
    configuration file.
    
    More generally, local::lib allows for the bootstrapping and usage of a
    directory containing Perl modules outside of Perl's C<@INC>. This makes it
    easier to ship an application with an app-specific copy of a Perl module, or
    collection of modules. Useful in cases like when an upstream maintainer hasn't
    applied a patch to a module of theirs that you need for your application.
    
    On import, local::lib sets the following environment variables to appropriate
    values:
    
    =over 4
    
    =item PERL_MB_OPT
    
    =item PERL_MM_OPT
    
    =item PERL5LIB
    
    =item PATH
    
    PATH is appended to, rather than clobbered.
    
    =back
    
    These values are then available for reference by any code after import.
    
    =head1 CREATING A SELF-CONTAINED SET OF MODULES
    
    See L<lib::core::only> for one way to do this - but note that
    there are a number of caveats, and the best approach is always to perform a
    build against a clean perl (i.e. site and vendor as close to empty as possible).
    
    =head1 OPTIONS
    
    Options are values that can be passed to the C<local::lib> import besides the
    directory to use. They are specified as C<use local::lib '--option'[, path];>
    or C<perl -Mlocal::lib=--option[,path]>.
    
    =head2 --deactivate
    
    Remove the chosen path (or the default path) from the module search paths if it
    was added by C<local::lib>, instead of adding it.
    
    =head2 --deactivate-all
    
    Remove all directories that were added to search paths by C<local::lib> from the
    search paths.
    
    =head1 METHODS
    
    =head2 ensure_dir_structure_for
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: None
    
    =back
    
    Attempts to create the given path, and all required parent directories. Throws
    an exception on failure.
    
    =head2 print_environment_vars_for
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: None
    
    =back
    
    Prints to standard output the variables listed above, properly set to use the
    given path as the base directory.
    
    =head2 build_environment_vars_for
    
    =over 4
    
    =item Arguments: $path, $interpolate
    
    =item Return value: \%environment_vars
    
    =back
    
    Returns a hash with the variables listed above, properly set to use the
    given path as the base directory.
    
    =head2 setup_env_hash_for
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: None
    
    =back
    
    Constructs the C<%ENV> keys for the given path, by calling
    L</build_environment_vars_for>.
    
    =head2 active_paths
    
    =over 4
    
    =item Arguments: None
    
    =item Return value: @paths
    
    =back
    
    Returns a list of active C<local::lib> paths, according to the
    C<PERL_LOCAL_LIB_ROOT> environment variable.
    
    =head2 install_base_perl_path
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: $install_base_perl_path
    
    =back
    
    Returns a path describing where to install the Perl modules for this local
    library installation. Appends the directories C<lib> and C<perl5> to the given
    path.
    
    =head2 install_base_arch_path
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: $install_base_arch_path
    
    =back
    
    Returns a path describing where to install the architecture-specific Perl
    modules for this local library installation. Based on the
    L</install_base_perl_path> method's return value, and appends the value of
    C<$Config{archname}>.
    
    =head2 install_base_bin_path
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: $install_base_bin_path
    
    =back
    
    Returns a path describing where to install the executable programs for this
    local library installation. Based on the L</install_base_perl_path> method's
    return value, and appends the directory C<bin>.
    
    =head2 resolve_empty_path
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: $base_path
    
    =back
    
    Builds and returns the base path into which to set up the local module
    installation. Defaults to C<~/perl5>.
    
    =head2 resolve_home_path
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: $home_path
    
    =back
    
    Attempts to find the user's home directory. If installed, uses C<File::HomeDir>
    for this purpose. If no definite answer is available, throws an exception.
    
    =head2 resolve_relative_path
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: $absolute_path
    
    =back
    
    Translates the given path into an absolute path.
    
    =head2 resolve_path
    
    =over 4
    
    =item Arguments: $path
    
    =item Return value: $absolute_path
    
    =back
    
    Calls the following in a pipeline, passing the result from the previous to the
    next, in an attempt to find where to configure the environment for a local
    library installation: L</resolve_empty_path>, L</resolve_home_path>,
    L</resolve_relative_path>. Passes the given path argument to
    L</resolve_empty_path> which then returns a result that is passed to
    L</resolve_home_path>, which then has its result passed to
    L</resolve_relative_path>. The result of this final call is returned from
    L</resolve_path>.
    
    =head1 A WARNING ABOUT UNINST=1
    
    Be careful about using local::lib in combination with "make install UNINST=1".
    The idea of this feature is that will uninstall an old version of a module
    before installing a new one. However it lacks a safety check that the old
    version and the new version will go in the same directory. Used in combination
    with local::lib, you can potentially delete a globally accessible version of a
    module while installing the new version in a local place. Only combine "make
    install UNINST=1" and local::lib if you understand these possible consequences.
    
    =head1 LIMITATIONS
    
    The perl toolchain is unable to handle directory names with spaces in it,
    so you cant put your local::lib bootstrap into a directory with spaces. What
    you can do is moving your local::lib to a directory with spaces B<after> you
    installed all modules inside your local::lib bootstrap. But be aware that you
    cant update or install CPAN modules after the move.
    
    Rather basic shell detection. Right now anything with csh in its name is
    assumed to be a C shell or something compatible, and everything else is assumed
    to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is
    not set, a Bourne-compatible shell is assumed.
    
    Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you
    have CPANPLUS installed.
    
    Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT.
    
    Should probably auto-fixup CPAN config if not already done.
    
    Patches very much welcome for any of the above.
    
    On Win32 systems, does not have a way to write the created environment variables
    to the registry, so that they can persist through a reboot.
    
    =head1 TROUBLESHOOTING
    
    If you've configured local::lib to install CPAN modules somewhere in to your
    home directory, and at some point later you try to install a module with C<cpan
    -i Foo::Bar>, but it fails with an error like: C<Warning: You do not have
    permissions to install into /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux at
    /usr/lib64/perl5/5.8.8/Foo/Bar.pm> and buried within the install log is an
    error saying C<'INSTALL_BASE' is not a known MakeMaker parameter name>, then
    you've somehow lost your updated ExtUtils::MakeMaker module.
    
    To remedy this situation, rerun the bootstrapping procedure documented above.
    
    Then, run C<rm -r ~/.cpan/build/Foo-Bar*>
    
    Finally, re-run C<cpan -i Foo::Bar> and it should install without problems.
    
    =head1 ENVIRONMENT
    
    =over 4
    
    =item SHELL
    
    =item COMSPEC
    
    local::lib looks at the user's C<SHELL> environment variable when printing out
    commands to add to the shell configuration file.
    
    On Win32 systems, C<COMSPEC> is also examined.
    
    =back
    
    =head1 SEE ALSO
    
    =over 4
    
    =item * L<Perl Advent article, 2011|http://perladvent.org/2011/2011-12-01.html>
    
    =back
    
    =head1 SUPPORT
    
    IRC:
    
        Join #local-lib on irc.perl.org.
    
    =head1 AUTHOR
    
    Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/
    
    auto_install fixes kindly sponsored by http://www.takkle.com/
    
    =head1 CONTRIBUTORS
    
    Patches to correctly output commands for csh style shells, as well as some
    documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
    
    Doc patches for a custom local::lib directory, more cleanups in the english
    documentation and a L<german documentation|POD2::DE::local::lib> contributed by Torsten Raudssus
    <torsten@raudssus.de>.
    
    Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring
    things will install properly, submitted a fix for the bug causing problems with
    writing Makefiles during bootstrapping, contributed an example program, and
    submitted yet another fix to ensure that local::lib can install and bootstrap
    properly. Many, many thanks!
    
    pattern of Freenode IRC contributed the beginnings of the Troubleshooting
    section. Many thanks!
    
    Patch to add Win32 support contributed by Curtis Jewell <csjewell@cpan.org>.
    
    Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced
    by a patch from Marco Emilio Poleggi.
    
    Mark Stosberg <mark@summersault.com> provided the code for the now deleted
    '--self-contained' option.
    
    Documentation patches to make win32 usage clearer by
    David Mertens <dcmertens.perl@gmail.com> (run4flat).
    
    Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc patches contributed by Breno
    G. de Oliveira <garu@cpan.org>.
    
    Improvements to stacking multiple local::lib dirs and removing them from the
    environment later on contributed by Andrew Rodland <arodland@cpan.org>.
    
    Patch for Carp version mismatch contributed by Hakim Cassimally <osfameron@cpan.org>.
    
    =head1 COPYRIGHT
    
    Copyright (c) 2007 - 2010 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as
    listed above.
    
    =head1 LICENSE
    
    This library is free software and may be distributed under the same terms
    as perl itself.
    
    =cut
    
    1;
  LOCAL_LIB
  
  $fatpacked{"version.pm"} = <<'VERSION';
    #!perl -w
    package version;
    
    use 5.005_04;
    use strict;
    
    use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
    
    $VERSION = 0.9902;
    
    $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;
    
    #--------------------------------------------------------------------------#
    
    {
        local $SIG{'__DIE__'};
        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;
    	*version::vcmp = \&version::vpp::vcmp;
    	*version::new = \&version::vpp::new;
    	if ($] >= 5.009000) {
    	    no strict 'refs';
    	    *version::stringify = \&version::vpp::stringify;
    	    *{'version::(""'} = \&version::vpp::stringify;
    	    *{'version::(<=>'} = \&version::vpp::vcmp;
    	    *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;
    	*version::new = \&version::vxs::new;
    	if ($] >= 5.009000) {
    	    no strict 'refs';
    	    *version::stringify = \&version::vxs::stringify;
    	    *{'version::(""'} = \&version::vxs::stringify;
    	    *{'version::(<=>'} = \&version::vxs::VCMP;
    	    *version::parse = \&version::vxs::parse;
    	}
    
        }
    }
    
    # Preloaded methods go here.
    sub import {
        no strict 'refs';
        my ($class) = shift;
    
        # Set up any derived class
        unless ($class eq 'version') {
    	local $^W;
    	*{$class.'::declare'} =  \&version::declare;
    	*{$class.'::qv'} = \&version::qv;
        }
    
        my %args;
        if (@_) { # any remaining terms are arguments
    	map { $args{$_} = 1 } @_
        }
        else { # no parameters at all on use line
        	%args = 
    	(
    	    qv => 1,
    	    'UNIVERSAL::VERSION' => 1,
    	);
        }
    
        my $callpkg = caller();
        
        if (exists($args{declare})) {
    	*{$callpkg.'::declare'} = 
    	    sub {return $class->declare(shift) }
    	  unless defined(&{$callpkg.'::declare'});
        }
    
        if (exists($args{qv})) {
    	*{$callpkg.'::qv'} =
    	    sub {return $class->qv(shift) }
    	  unless defined(&{$callpkg.'::qv'});
        }
    
        if (exists($args{'UNIVERSAL::VERSION'})) {
    	local $^W;
    	*UNIVERSAL::VERSION 
    		= \&version::_VERSION;
        }
    
        if (exists($args{'VERSION'})) {
    	*{$callpkg.'::VERSION'} = \&version::_VERSION;
        }
    
        if (exists($args{'is_strict'})) {
    	*{$callpkg.'::is_strict'} = \&version::is_strict
    	  unless defined(&{$callpkg.'::is_strict'});
        }
    
        if (exists($args{'is_lax'})) {
    	*{$callpkg.'::is_lax'} = \&version::is_lax
    	  unless defined(&{$callpkg.'::is_lax'});
        }
    }
    
    sub is_strict	{ defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
    sub is_lax	{ defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
    
    1;
  VERSION
  
  $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
    package charstar;
    # a little helper class to emulate C char* semantics in Perl
    # so that prescan_version can use the same code as in C
    
    use overload (
        '""'	=> \&thischar,
        '0+'	=> \&thischar,
        '++'	=> \&increment,
        '--'	=> \&decrement,
        '+'		=> \&plus,
        '-'		=> \&minus,
        '*'		=> \&multiply,
        'cmp'	=> \&cmp,
        '<=>'	=> \&spaceship,
        'bool'	=> \&thischar,
        '='		=> \&clone,
    );
    
    sub new {
        my ($self, $string) = @_;
        my $class = ref($self) || $self;
    
        my $obj = {
    	string  => [split(//,$string)],
    	current => 0,
        };
        return bless $obj, $class;
    }
    
    sub thischar {
        my ($self) = @_;
        my $last = $#{$self->{string}};
        my $curr = $self->{current};
        if ($curr >= 0 && $curr <= $last) {
    	return $self->{string}->[$curr];
        }
        else {
    	return '';
        }
    }
    
    sub increment {
        my ($self) = @_;
        $self->{current}++;
    }
    
    sub decrement {
        my ($self) = @_;
        $self->{current}--;
    }
    
    sub plus {
        my ($self, $offset) = @_;
        my $rself = $self->clone;
        $rself->{current} += $offset;
        return $rself;
    }
    
    sub minus {
        my ($self, $offset) = @_;
        my $rself = $self->clone;
        $rself->{current} -= $offset;
        return $rself;
    }
    
    sub multiply {
        my ($left, $right, $swapped) = @_;
        my $char = $left->thischar();
        return $char * $right;
    }
    
    sub spaceship {
        my ($left, $right, $swapped) = @_;
        unless (ref($right)) { # not an object already
    	$right = $left->new($right);
        }
        return $left->{current} <=> $right->{current};
    }
    
    sub cmp {
        my ($left, $right, $swapped) = @_;
        unless (ref($right)) { # not an object already
    	if (length($right) == 1) { # comparing single character only
    	    return $left->thischar cmp $right;
    	}
    	$right = $left->new($right);
        }
        return $left->currstr cmp $right->currstr;
    }
    
    sub bool {
        my ($self) = @_;
        my $char = $self->thischar;
        return ($char ne '');
    }
    
    sub clone {
        my ($left, $right, $swapped) = @_;
        $right = {
    	string  => [@{$left->{string}}],
    	current => $left->{current},
        };
        return bless $right, ref($left);
    }
    
    sub currstr {
        my ($self, $s) = @_;
        my $curr = $self->{current};
        my $last = $#{$self->{string}};
        if (defined($s) && $s->{current} < $last) {
    	$last = $s->{current};
        }
    
        my $string = join('', @{$self->{string}}[$curr..$last]);
        return $string;
    }
    
    package version::vpp;
    use strict;
    
    use POSIX qw/locale_h/;
    use locale;
    use vars qw ($VERSION @ISA @REGEXS);
    $VERSION = 0.9902;
    
    use overload (
        '""'       => \&stringify,
        '0+'       => \&numify,
        'cmp'      => \&vcmp,
        '<=>'      => \&vcmp,
        'bool'     => \&vbool,
        '+'        => \&vnoop,
        '-'        => \&vnoop,
        '*'        => \&vnoop,
        '/'        => \&vnoop,
        '+='        => \&vnoop,
        '-='        => \&vnoop,
        '*='        => \&vnoop,
        '/='        => \&vnoop,
        'abs'      => \&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
    	my $j = 0;
    	# 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)");
    	    }
    	}
    
    	# and we never support negative version numbers
    	if ($d eq '-') {
    	    return BADVERSION($s,$errstr,"Invalid version format (negative version number)");
    	}
    
    	# 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++; $j++;
    	    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)");
    		}
    		$width = $j;
    		$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) = @_;
    	unless (defined $class) {
    	    require Carp;
    	    Carp::croak('Usage: version::new(class, version)');
    	}
    	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 format");
        }
        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 $obj = version->new($value);
        return bless $obj, $class;
    }
    
    *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::cpanminus::script;
  
  
  unless (caller) {
      my $app = App::cpanminus::script->new;
      $app->parse_options(@ARGV);
      exit $app->doit;
  }
  
  __END__
  
  =head1 NAME
  
  cpanm - get, unpack build and install modules from CPAN
  
  =head1 SYNOPSIS
  
    cpanm Test::More                                 # install Test::More
    cpanm MIYAGAWA/Plack-0.99_05.tar.gz              # full distribution path
    cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz  # install from URL
    cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz   # install from a local file
    cpanm --interactive Task::Kensho                 # Configure interactively
    cpanm .                                          # install from local directory
    cpanm --installdeps .                            # install all the deps for the current directory
    cpanm -L extlib Plack                            # install Plack and all non-core deps into extlib
    cpanm --mirror http://cpan.cpantesters.org/ DBI  # use the fast-syncing mirror
  
  =head1 COMMANDS
  
  =over 4
  
  =item (arguments)
  
  Command line arguments can be either a module name, distribution file,
  local file path, HTTP URL or git repository URL. Following commands
  will all work as you expect.
  
      cpanm Plack
      cpanm Plack/Request.pm
      cpanm MIYAGAWA/Plack-1.0000.tar.gz
      cpanm /path/to/Plack-1.0000.tar.gz
      cpanm http://cpan.metacpan.org/authors/id/M/MI/MIYAGAWA/Plack-0.9990.tar.gz
      cpanm git://github.com/plack/Plack.git
  
  Additionally, you can use the notation using C<~> and C<@> to specify
  version for a given module. C<~> specifies the version requirement in
  the L<CPAN::Meta::Spec> format, while C<@> pins the exact version, and
  is a shortcut for C<~"== VERSION">.
  
      cpanm Plack~1.0000                 # 1.0000 or later
      cpanm Plack~">= 1.0000, < 2.0000"  # latest of 1.xxxx
      cpanm Plack@0.9990                 # specific version. same as Plack~"== 0.9990"
  
  The version query including specific version or range will be sent to
  L<MetaCPAN> to search for previous releases. The query will search for
  BackPAN archives by default, unless you specify C<--dev> option, in
  which case, archived versions will be filtered out.
  
  For a git repository, you can specify a branch, tag, or commit SHA to
  build. The default is C<master>
  
      cpanm git://github.com/plack/Plack.git@1.0000        # tag
      cpanm git://github.com/plack/Plack.git@devel         # branch
  
  =item -i, --install
  
  Installs the modules. This is a default behavior and this is just a
  compatibility option to make it work like L<cpan> or L<cpanp>.
  
  =item --self-upgrade
  
  Upgrades itself. It's just an alias for:
  
    cpanm App::cpanminus
  
  =item --info
  
  Displays the distribution information in
  C<AUTHOR/Dist-Name-ver.tar.gz> format in the standard out.
  
  =item --installdeps
  
  Installs the dependencies of the target distribution but won't build
  itself. Handy if you want to try the application from a version
  controlled repository such as git.
  
    cpanm --installdeps .
  
  =item --look
  
  Download and unpack the distribution and then open the directory with
  your shell. Handy to poke around the source code or do manual
  testing.
  
  =item -U, --uninstall
  
  B<EXPERIMENTAL>: Uninstalls the modules. Will remove the distribution
  files from your library path using the C<.packlist> file.
  
  When used with C<-l> or C<-L>, only the files under the local::lib
  directory will be removed.
  
  B<NOTE>: If you have the "dual-life" module in multiple locations
  (i.e. C<site_perl> and C<perl> library path, with perl 5.12 or later),
  only the files in C<site_perl> will be deleted.
  
  If the distribution has bin scripts and man, they will be kept in case
  the core installation still references that, although there's no
  guarantee that the script will continue working as expected with the
  older version of .pm files.
  
  =item -h, --help
  
  Displays the help message.
  
  =item -V, --version
  
  Displays the version number.
  
  =back
  
  =head1 OPTIONS
  
  You can specify the default options in C<PERL_CPANM_OPT> environment variable.
  
  =over 4
  
  =item -f, --force
  
  Force install modules even when testing failed.
  
  =item -n, --notest
  
  Skip the testing of modules. Use this only when you just want to save
  time for installing hundreds of distributions to the same perl and
  architecture you've already tested to make sure it builds fine.
  
  Defaults to false, and you can say C<--no-notest> to override when it
  is set in the default options in C<PERL_CPANM_OPT>.
  
  =item --test-only
  
  Run the tests only, and do not install the specified module or
  distributions. Handy if you want to verify the new (or even old)
  releases pass its unit tests without installing the module.
  
  Note that if you specify this option with a module or distribution
  that has dependencies, these dependencies will be installed if you
  don't currently have them.
  
  =item -S, --sudo
  
  Switch to the root user with C<sudo> when installing modules. Use this
  if you want to install modules to the system perl include path.
  
  Defaults to false, and you can say C<--no-sudo> to override when it is
  set in the default options in C<PERL_CPANM_OPT>.
  
  =item -v, --verbose
  
  Makes the output verbose. It also enables the interactive
  configuration. (See --interactive)
  
  =item -q, --quiet
  
  Makes the output even more quiet than the default. It only shows the
  successful/failed dependencies to the output.
  
  =item -l, --local-lib
  
  Sets the L<local::lib> compatible path to install modules to. You
  don't need to set this if you already configure the shell environment
  variables using L<local::lib>, but this can be used to override that
  as well.
  
  =item -L, --local-lib-contained
  
  Same with C<--local-lib> but with L<--self-contained> set.  All
  non-core dependencies will be installed even if they're already
  installed.
  
  For instance,
  
    cpanm -L extlib Plack
  
  would install Plack and all of its non-core dependencies into the
  directory C<extlib>, which can be loaded from your application with:
  
    use local::lib '/path/to/extlib';
  
  =item --self-contained
  
  When examining the dependencies, assume no non-core modules are
  installed on the system. Handy if you want to bundle application
  dependencies in one directory so you can distribute to other machines.
  
  =item --mirror
  
  Specifies the base URL for the CPAN mirror to use, such as
  C<http://cpan.cpantesters.org/> (you can omit the trailing slash). You
  can specify multiple mirror URLs by repeating the command line option.
  
  You can use a local directory that has a CPAN mirror structure
  (created by tools such as L<OrePAN> or L<Pinto>) by using a special
  URL scheme C<file://>. If the given URL begins with `/` (without any
  scheme), it is considered as a file scheme as well.
  
    cpanm --mirror file:///path/to/mirror
    cpanm --mirror ~/minicpan      # Because shell expands ~ to /home/user
  
  Defaults to C<http://www.cpan.org/>.
  
  =item --mirror-only
  
  Download the mirror's 02packages.details.txt.gz index file instead of
  querying the CPAN Meta DB. This will also effectively opt out sending
  your local perl versions to backend database servers such as CPAN Meta
  DB and MetaCPAN.
  
  Select this option if you are using a local mirror of CPAN, such as
  minicpan when you're offline, or your own CPAN index (a.k.a darkpan).
  
  B<Tip:> It might be useful if you name these mirror options with your
  shell aliases, like:
  
    alias minicpanm='cpanm --mirror ~/minicpan --mirror-only'
    alias darkpan='cpanm --mirror http://mycompany.example.com/DPAN --mirror-only'
  
  =item --mirror-index
  
  B<EXPERIMENTAL>: Specifies the file path to C<02packages.details.txt>
  for module search index.
  
  =item --cpanmetadb
  
  B<EXPERIMENTAL>: Specifies an alternate URI for CPAN MetaDB index lookups.
  
  =item --cpanfile
  
  B<EXPERIMENTAL>: Specified an alternate path for cpanfile to search for,
  when C<--installdeps> command is in use. Defaults to C<cpanfile>.
  
  =item --prompt
  
  Prompts when a test fails so that you can skip, force install, retry
  or look in the shell to see what's going wrong. It also prompts when
  one of the dependency failed if you want to proceed the installation.
  
  Defaults to false, and you can say C<--no-prompt> to override if it's
  set in the default options in C<PERL_CPANM_OPT>.
  
  =item --dev
  
  B<EXPERIMENTAL>: search for a newer developer release as well. Defaults to false.
  
  =item --reinstall
  
  cpanm, when given a module name in the command line (i.e. C<cpanm
  Plack>), checks the locally installed version first and skips if it is
  already installed. This option makes it skip the check, so:
  
    cpanm --reinstall Plack
  
  would reinstall L<Plack> even if your locally installed version is
  latest, or even newer (which would happen if you install a developer
  release from version control repositories).
  
  Defaults to false.
  
  =item --interactive
  
  Makes the configuration (such as C<Makefile.PL> and C<Build.PL>)
  interactive, so you can answer questions in the distribution that
  requires custom configuration or Task:: distributions.
  
  Defaults to false, and you can say C<--no-interactive> to override
  when it's set in the default options in C<PERL_CPANM_OPT>.
  
  =item --pp, --pureperl
  
  Prefer Pure perl build of modules by setting C<PUREPERL_ONLY=1> for
  MakeMaker and C<--pureperl-only> for Build.PL based
  distributions. Note that not all of the CPAN modules support this
  convention yet.
  
  =item --with-recommends, --with-suggests
  
  B<EXPERIMENTAL>: Installs dependencies declared as C<recommends> and
  C<suggests> respectively, per META spec. When these dependencies fail
  to install, cpanm continues the installation, since they're just
  recommendation/suggestion.
  
  Enabling this could potentially make a circular dependency for a few
  modules on CPAN, when C<recommends> adds a module that C<recommends>
  back the module in return.
  
  There's also C<--without-recommend> and C<--without-suggests> to
  override the default decision made earlier in C<PERL_CPANM_OPT>.
  
  Defaults to false for both.
  
  =item --with-develop
  
  B<EXPERIMENTAL>: Installs develop phase dependencies in META files or
  C<cpanfile> when used with C<--installdeps>. Defaults to false.
  
  =item --with-feature, --without-feature, --with-all-features
  
  B<EXPERIMENTAL>: Specifies the feature to enable, if a module supports
  optional features per META spec 2.0.
  
      cpanm --with-feature=opt_csv Spreadsheet::Read
  
  the features can also be interactively chosen when C<--interactive>
  option is enabled.
  
  C<--with-all-features> enables all the optional features, and
  C<--without-feature> can select a feature to disable.
  
  =item --configure-timeout, --build-timeout, --test-timeout
  
  Specify the timeout length (in seconds) to wait for the configure,
  build and test process. Current default values are: 60 for configure,
  3600 for build and 1800 for test.
  
  =item --configure-args, --build-args, --test-args, --install-args
  
  B<EXPERIMENTAL>: Pass arguments for configure/build/test/install
  commands respectively, for a given module to install.
  
      cpanm DBD::mysql --configure-args="--cflags=... --libs=..."
  
  The argument is only enabled for the module passed as a command line
  argument, not dependencies.
  
  =item --scandeps
  
  B<DEPRECATED>: Scans the depencencies of given modules and output the
  tree in a text format. (See C<--format> below for more options)
  
  Because this command doesn't actually install any distributions, it
  will be useful that by typing:
  
    cpanm --scandeps Catalyst::Runtime
  
  you can make sure what modules will be installed.
  
  This command takes into account which modules you already have
  installed in your system. If you want to see what modules will be
  installed against a vanilla perl installation, you might want to
  combine it with C<-L> option.
  
  =item --format
  
  B<DEPRECATED>: Determines what format to display the scanned
  dependency tree. Available options are C<tree>, C<json>, C<yaml> and
  C<dists>.
  
  =over 8
  
  =item tree
  
  Displays the tree in a plain text format. This is the default value.
  
  =item json, yaml
  
  Outputs the tree in a JSON or YAML format. L<JSON> and L<YAML> modules
  need to be installed respectively. The output tree is represented as a
  recursive tuple of:
  
    [ distribution, dependencies ]
  
  and the container is an array containing the root elements. Note that
  there may be multiple root nodes, since you can give multiple modules
  to the C<--scandeps> command.
  
  =item dists
  
  C<dists> is a special output format, where it prints the distribution
  filename in the I<depth first order> after the dependency resolution,
  like:
  
    GAAS/MIME-Base64-3.13.tar.gz
    GAAS/URI-1.58.tar.gz
    PETDANCE/HTML-Tagset-3.20.tar.gz
    GAAS/HTML-Parser-3.68.tar.gz
    GAAS/libwww-perl-5.837.tar.gz
  
  which means you can install these distributions in this order without
  extra dependencies. When combined with C<-L> option, it will be useful
  to replay installations on other machines.
  
  =back
  
  =item --save-dists
  
  Specifies the optional directory path to copy downloaded tarballs in
  the CPAN mirror compatible directory structure
  i.e. I<authors/id/A/AU/AUTHORS/Foo-Bar-version.tar.gz>
  
  If the distro tarball did not come from CPAN, for example from a local
  file or from GitHub, then it will be saved under
  I<vendor/Foo-Bar-version.tar.gz>.
  
  =item --uninst-shadows
  
  Uninstalls the shadow files of the distribution that you're
  installing. This eliminates the confusion if you're trying to install
  core (dual-life) modules from CPAN against perl 5.10 or older, or
  modules that used to be XS-based but switched to pure perl at some
  version.
  
  If you run cpanm as root and use C<INSTALL_BASE> or equivalent to
  specify custom installation path, you SHOULD disable this option so
  you won't accidentally uninstall dual-life modules from the core
  include path.
  
  Defaults to true if your perl version is smaller than 5.12, and you
  can disable that with C<--no-uninst-shadows>.
  
  B<NOTE>: Since version 1.3000 this flag is turned off by default for
  perl newer than 5.12, since with 5.12 @INC contains site_perl directory
  I<before> the perl core library path, and uninstalling shadows is not
  necessary anymore and does more harm by deleting files from the core
  library path.
  
  =item --uninstall, -U
  
  Uninstalls a module from the library path. It finds a packlist for
  given modules, and removes all the files included in the same
  distribution.
  
  If you enable local::lib, it only removes files from the local::lib
  directory.
  
  If you try to uninstall a module in C<perl> directory (i.e. core
  module), an error will be thrown.
  
  A dialog wil be prompted to confirm the files to be deleted. If you pass
  C<-f> option as well, the dialog will be skipped and uninstallation
  will be forced.
  
  =item --cascade-search
  
  B<EXPERIMENTAL>: Specifies whether to cascade search when you specify
  multiple mirrors and a mirror doesn't have a module or has a lower
  version of the module than requested. Defaults to false.
  
  =item --skip-installed
  
  Specifies whether a module given in the command line is skipped if its latest
  version is already installed. Defaults to true.
  
  B<NOTE>: The C<PERL5LIB> environment variable have to be correctly set
  for this to work with modules installed using L<local::lib>, unless
  you always use the C<-l> option.
  
  =item --skip-satisfied
  
  B<EXPERIMENTAL>: Specifies whether a module (and version) given in the
  command line is skipped if it's already installed.
  
  If you run:
  
    cpanm --skip-satisfied CGI DBI~1.2
  
  cpanm won't install them if you already have CGI (for whatever
  versions) or have DBI with version higher than 1.2. It is similar to
  C<--skip-installed> but while C<--skip-installed> checks if the
  I<latest> version of CPAN is installed, C<--skip-satisfied> checks if
  a requested version (or not, which means any version) is installed.
  
  Defaults to false.
  
  =item --verify
  
  Verify the integrity of distribution files retrieved from PAUSE using
  CHECKSUMS and SIGNATURES (if found). Defaults to false.
  
  =item --report-perl-version
  
  Whether it report the locally installed perl version to the various
  web server as part of User-Agent. Defaults to true, and you can disable
  it by using C<--no-report-perl-version>.
  
  =item --auto-cleanup
  
  Specifies the number of days in which cpanm's work directories
  expire. Defaults to 7, which means old work directories will be
  cleaned up in one week.
  
  You can set the value to C<0> to make cpan never cleanup those
  directories.
  
  =item --man-pages
  
  Generates man pages for executables (man1) and libraries (man3).
  
  Defaults to true (man pages generated) unless C<-L|--local-lib-contained>
  option is supplied in which case it's set to false. You can disable
  it with C<--no-man-pages>.
  
  =item --lwp
  
  Uses L<LWP> module to download stuff over HTTP. Defaults to true, and
  you can say C<--no-lwp> to disable using LWP, when you want to upgrade
  LWP from CPAN on some broken perl systems.
  
  =item --wget
  
  Uses GNU Wget (if available) to download stuff. Defaults to true, and
  you can say C<--no-wget> to disable using Wget (versions of Wget older
  than 1.9 don't support the C<--retry-connrefused> option used by cpanm).
  
  =item --curl
  
  Uses cURL (if available) to download stuff. Defaults to true, and
  you can say C<--no-curl> to disable using cURL.
  
  Normally with C<--lwp>, C<--wget> and C<--curl> options set to true
  (which is the default) cpanm tries L<LWP>, Wget, cURL and L<HTTP::Tiny>
  (in that order) and uses the first one available.
  
  =back
  
  =head1 SEE ALSO
  
  L<App::cpanminus>
  
  =head1 COPYRIGHT
  
  Copyright 2010 Tatsuhiko Miyagawa.
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa
  
  =cut
APP_CPANMINUS_FATSCRIPT

$fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta;
  our $VERSION = '2.131560'; # VERSION
  
  
  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.4403 ();
  
  BEGIN { *_dclone = \&CPAN::Meta::Converter::_dclone }
  
  
  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;
  
  # ABSTRACT: the distribution metadata for a CPAN dist
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  CPAN::Meta - the distribution metadata for a CPAN dist
  
  =head1 VERSION
  
  version 2.131560
  
  =head1 SYNOPSIS
  
      use v5.10;
      use strict;
      use warnings;
      use CPAN::Meta;
      use Module::Load;
  
      my $meta = CPAN::Meta->load_file('META.json');
  
      printf "testing requirements for %s version %s\n",
      $meta->name,
      $meta->version;
  
      my $prereqs = $meta->effective_prereqs;
  
      for my $phase ( qw/configure runtime build test/ ) {
          say "Requirements for $phase:";
          my $reqs = $prereqs->requirements_for($phase, "requires");
          for my $module ( sort $reqs->required_modules ) {
              my $status;
              if ( eval { load $module unless $module eq 'perl'; 1 } ) {
                  my $version = $module eq 'perl' ? $] : $module->VERSION;
                  $status = $reqs->accepts_module($module, $version)
                          ? "$version ok" : "$version not ok";
              } else {
                  $status = "missing"
              };
              say "  $module ($status)";
          }
      }
  
  =head1 DESCRIPTION
  
  Software distributions released to the CPAN include a F<META.json> or, for
  older distributions, F<META.yml>, which describes the distribution, its
  contents, and the requirements for building and installing the distribution.
  The data structure stored in the F<META.json> file is described in
  L<CPAN::Meta::Spec>.
  
  CPAN::Meta provides a simple class to represent this distribution metadata (or
  I<distmeta>), along with some helpful methods for interrogating that data.
  
  The documentation below is only for the methods of the CPAN::Meta object.  For
  information on the meaning of individual fields, consult the spec.
  
  =head1 METHODS
  
  =head2 new
  
    my $meta = CPAN::Meta->new($distmeta_struct, \%options);
  
  Returns a valid CPAN::Meta object or dies if the supplied metadata hash
  reference fails to validate.  Older-format metadata will be up-converted to
  version 2 if they validate against the original stated specification.
  
  It takes an optional hashref of options. Valid options include:
  
  =over
  
  =item *
  
  lazy_validation -- if true, new will attempt to convert the given metadata
  to version 2 before attempting to validate it.  This means than any
  fixable errors will be handled by CPAN::Meta::Converter before validation.
  (Note that this might result in invalid optional data being silently
  dropped.)  The default is false.
  
  =back
  
  =head2 create
  
    my $meta = CPAN::Meta->create($distmeta_struct, \%options);
  
  This is same as C<new()>, except that C<generated_by> and C<meta-spec> fields
  will be generated if not provided.  This means the metadata structure is
  assumed to otherwise follow the latest L<CPAN::Meta::Spec>.
  
  =head2 load_file
  
    my $meta = CPAN::Meta->load_file($distmeta_file, \%options);
  
  Given a pathname to a file containing metadata, this deserializes the file
  according to its file suffix and constructs a new C<CPAN::Meta> object, just
  like C<new()>.  It will die if the deserialized version fails to validate
  against its stated specification version.
  
  It takes the same options as C<new()> but C<lazy_validation> defaults to
  true.
  
  =head2 load_yaml_string
  
    my $meta = CPAN::Meta->load_yaml_string($yaml, \%options);
  
  This method returns a new CPAN::Meta object using the first document in the
  given YAML string.  In other respects it is identical to C<load_file()>.
  
  =head2 load_json_string
  
    my $meta = CPAN::Meta->load_json_string($json, \%options);
  
  This method returns a new CPAN::Meta object using the structure represented by
  the given JSON string.  In other respects it is identical to C<load_file()>.
  
  =head2 save
  
    $meta->save($distmeta_file, \%options);
  
  Serializes the object as JSON and writes it to the given file.  The only valid
  option is C<version>, which defaults to '2'. On Perl 5.8.1 or later, the file
  is saved with UTF-8 encoding.
  
  For C<version> 2 (or higher), the filename should end in '.json'.  L<JSON::PP>
  is the default JSON backend. Using another JSON backend requires L<JSON> 2.5 or
  later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate
  backend like L<JSON::XS>.
  
  For C<version> less than 2, the filename should end in '.yml'.
  L<CPAN::Meta::Converter> is used to generate an older metadata structure, which
  is serialized to YAML.  CPAN::Meta::YAML is the default YAML backend.  You may
  set the C<$ENV{PERL_YAML_BACKEND}> to a supported alternative backend, though
  this is not recommended due to subtle incompatibilities between YAML parsers on
  CPAN.
  
  =head2 meta_spec_version
  
  This method returns the version part of the C<meta_spec> entry in the distmeta
  structure.  It is equivalent to:
  
    $meta->meta_spec->{version};
  
  =head2 effective_prereqs
  
    my $prereqs = $meta->effective_prereqs;
  
    my $prereqs = $meta->effective_prereqs( \@feature_identifiers );
  
  This method returns a L<CPAN::Meta::Prereqs> object describing all the
  prereqs for the distribution.  If an arrayref of feature identifiers is given,
  the prereqs for the identified features are merged together with the
  distribution's core prereqs before the CPAN::Meta::Prereqs object is returned.
  
  =head2 should_index_file
  
    ... if $meta->should_index_file( $filename );
  
  This method returns true if the given file should be indexed.  It decides this
  by checking the C<file> and C<directory> keys in the C<no_index> property of
  the distmeta structure.
  
  C<$filename> should be given in unix format.
  
  =head2 should_index_package
  
    ... if $meta->should_index_package( $package );
  
  This method returns true if the given package should be indexed.  It decides
  this by checking the C<package> and C<namespace> keys in the C<no_index>
  property of the distmeta structure.
  
  =head2 features
  
    my @feature_objects = $meta->features;
  
  This method returns a list of L<CPAN::Meta::Feature> objects, one for each
  optional feature described by the distribution's metadata.
  
  =head2 feature
  
    my $feature_object = $meta->feature( $identifier );
  
  This method returns a L<CPAN::Meta::Feature> object for the optional feature
  with the given identifier.  If no feature with that identifier exists, an
  exception will be raised.
  
  =head2 as_struct
  
    my $copy = $meta->as_struct( \%options );
  
  This method returns a deep copy of the object's metadata as an unblessed has
  reference.  It takes an optional hashref of options.  If the hashref contains
  a C<version> argument, the copied metadata will be converted to the version
  of the specification and returned.  For example:
  
    my $old_spec = $meta->as_struct( {version => "1.4"} );
  
  =head2 as_string
  
    my $string = $meta->as_string( \%options );
  
  This method returns a serialized copy of the object's metadata as a character
  string.  (The strings are B<not> UTF-8 encoded.)  It takes an optional hashref
  of options.  If the hashref contains a C<version> argument, the copied metadata
  will be converted to the version of the specification and returned.  For
  example:
  
    my $string = $meta->as_struct( {version => "1.4"} );
  
  For C<version> greater than or equal to 2, the string will be serialized as
  JSON.  For C<version> less than 2, the string will be serialized as YAML.  In
  both cases, the same rules are followed as in the C<save()> method for choosing
  a serialization backend.
  
  =head1 STRING DATA
  
  The following methods return a single value, which is the value for the
  corresponding entry in the distmeta structure.  Values should be either undef
  or strings.
  
  =over 4
  
  =item *
  
  abstract
  
  =item *
  
  description
  
  =item *
  
  dynamic_config
  
  =item *
  
  generated_by
  
  =item *
  
  name
  
  =item *
  
  release_status
  
  =item *
  
  version
  
  =back
  
  =head1 LIST DATA
  
  These methods return lists of string values, which might be represented in the
  distmeta structure as arrayrefs or scalars:
  
  =over 4
  
  =item *
  
  authors
  
  =item *
  
  keywords
  
  =item *
  
  licenses
  
  =back
  
  The C<authors> and C<licenses> methods may also be called as C<author> and
  C<license>, respectively, to match the field name in the distmeta structure.
  
  =head1 MAP DATA
  
  These readers return hashrefs of arbitrary unblessed data structures, each
  described more fully in the specification:
  
  =over 4
  
  =item *
  
  meta_spec
  
  =item *
  
  resources
  
  =item *
  
  provides
  
  =item *
  
  no_index
  
  =item *
  
  prereqs
  
  =item *
  
  optional_features
  
  =back
  
  =head1 CUSTOM DATA
  
  A list of custom keys are available from the C<custom_keys> method and
  particular keys may be retrieved with the C<custom> method.
  
    say $meta->custom($_) for $meta->custom_keys;
  
  If a custom key refers to a data structure, a deep clone is returned.
  
  =for Pod::Coverage TO_JSON abstract author authors custom custom_keys description dynamic_config
  generated_by keywords license licenses meta_spec name no_index
  optional_features prereqs provides release_status resources version
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 SEE ALSO
  
  =over 4
  
  =item *
  
  L<CPAN::Meta::Converter>
  
  =item *
  
  L<CPAN::Meta::Validator>
  
  =back
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<http://github.com/dagolden/cpan-meta>
  
    git clone git://github.com/dagolden/cpan-meta.git
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Ansgar Burchardt <ansgar@cpan.org>
  
  =item *
  
  Avar Arnfjord Bjarmason <avar@cpan.org>
  
  =item *
  
  Christopher J. Madsen <cjm@cpan.org>
  
  =item *
  
  Cory G Watson <gphat@cpan.org>
  
  =item *
  
  Damyan Ivanov <dam@cpan.org>
  
  =item *
  
  Eric Wilhelm <ewilhelm@cpan.org>
  
  =item *
  
  Gregor Hermann <gregoa@debian.org>
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Lars Dieckow <daxim@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =item *
  
  Mark Fowler <markf@cpan.org>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Randy Sims <randys@thepierianspring.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META

$fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Converter;
  our $VERSION = '2.131560'; # VERSION
  
  
  use CPAN::Meta::Validator;
  use CPAN::Meta::Requirements;
  use version 0.88 ();
  use Parse::CPAN::Meta 1.4400 ();
  
  sub _dclone {
    my $ref = shift;
  
    # if an object is in the data structure and doesn't specify how to
    # turn itself into JSON, we just stringify the object.  That does the
    # right thing for typical things that might be there, like version objects,
    # Path::Class objects, etc.
    no warnings 'once';
    local *UNIVERSAL::TO_JSON = sub { return "$_[0]" };
  
    my $backend = Parse::CPAN::Meta->json_backend();
    return $backend->new->utf8->decode(
      $backend->new->utf8->allow_blessed->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 _no_prefix_ucfirst_custom {
    my $key = shift;
    $key =~ s/^x_//;
    return _ucfirst_custom($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) = @_;
    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>' );
  
    my $v = eval { version->new($element) };
    # XXX check defined $v and not just $v because version objects leak memory
    # in boolean context -- dagolden, 2012-02-03
    if ( defined $v ) {
      return $v->is_qv ? $v->normal : $element;
    }
    else {
      return 0;
    }
  }
  
  sub _bad_version_hook {
    my ($v) = @_;
    $v =~ s{[a-z]+$}{}; # strip trailing alphabetics
    my $vobj = eval { version->parse($v) };
    return defined($vobj) ? $vobj : version->parse(0); # or give up
  }
  
  sub _version_map {
    my ($element) = @_;
    return unless defined $element;
    if ( ref $element eq 'HASH' ) {
      # XXX turn this into CPAN::Meta::Requirements with bad version hook
      # and then turn it back into a hash
      my $new_map = CPAN::Meta::Requirements->new(
        { bad_version_hook => sub { version->new(0) } } # punt
      );
      while ( my ($k,$v) = each %$element ) {
        next unless _is_module_name($k);
        if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>'  ) {
          $v = 0;
        }
        # some weird, old META have bad yml with module => module
        # so check if value is like a module name and not like a version
        if ( _is_module_name($v) && ! version::is_lax($v) ) {
          $new_map->add_minimum($k => 0);
          $new_map->add_minimum($v => 0);
        }
        $new_map->add_string_requirement($k => $v);
      }
      return $new_map->as_string_hash;
    }
    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)) || {};
  
    my $test_req  = CPAN::Meta::Requirements->from_string_hash($test_h);
    my $build_req = CPAN::Meta::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 scalar _version_map($prereqs->{$phase}{$type});
  }
  
  sub _downgrade_optional_features {
    my (undef, undef, $meta) = @_;
    return 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 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 }
    },
    repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
    ':custom'  => \&_prefix_custom,
  };
  
  sub _upgrade_resources_2 {
    my (undef, undef, $meta, $version) = @_;
    return 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 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 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 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'  => \&_no_prefix_ucfirst_custom,
  };
  
  sub _downgrade_resources {
    my (undef, undef, $meta, $version) = @_;
    return 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 => \&_keep,
  };
  
  my $provides_spec_2 = {
    file => \&_keep,
    version => \&_keep,
    ':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);
      $new_data->{$k}{version} = _clean_version($element->{$k}{version})
        if exists $element->{$k}{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;
  
  # ABSTRACT: Convert CPAN distribution metadata structures
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  CPAN::Meta::Converter - Convert CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.131560
  
  =head1 SYNOPSIS
  
    my $struct = decode_json_file('META.json');
  
    my $cmc = CPAN::Meta::Converter->new( $struct );
  
    my $new_struct = $cmc->convert( version => "2" );
  
  =head1 DESCRIPTION
  
  This module converts CPAN Meta structures from one form to another.  The
  primary use is to convert older structures to the most modern version of
  the specification, but other transformations may be implemented in the
  future as needed.  (E.g. stripping all custom fields or stripping all
  optional fields.)
  
  =head1 METHODS
  
  =head2 new
  
    my $cmc = CPAN::Meta::Converter->new( $struct );
  
  The constructor should be passed a valid metadata structure but invalid
  structures are accepted.  If no meta-spec version is provided, version 1.0 will
  be assumed.
  
  =head2 convert
  
    my $new_struct = $cmc->convert( version => "2" );
  
  Returns a new hash reference with the metadata converted to a different form.
  C<convert> will die if any conversion/standardization still results in an
  invalid structure.
  
  Valid parameters include:
  
  =over
  
  =item *
  
  C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
  Defaults to the latest version of the CPAN Meta Spec.
  
  =back
  
  Conversion proceeds through each version in turn.  For example, a version 1.2
  structure might be converted to 1.3 then 1.4 then finally to version 2. The
  conversion process attempts to clean-up simple errors and standardize data.
  For example, if C<author> is given as a scalar, it will converted to an array
  reference containing the item. (Converting a structure to its own version will
  also clean-up and standardize.)
  
  When data are cleaned and standardized, missing or invalid fields will be
  replaced with sensible defaults when possible.  This may be lossy or imprecise.
  For example, some badly structured META.yml files on CPAN have prerequisite
  modules listed as both keys and values:
  
    requires => { 'Foo::Bar' => 'Bam::Baz' }
  
  These would be split and each converted to a prerequisite with a minimum
  version of zero.
  
  When some mandatory fields are missing or invalid, the conversion will attempt
  to provide a sensible default or will fill them with a value of 'unknown'.  For
  example a missing or unrecognized C<license> field will result in a C<license>
  field of 'unknown'.  Fields that may get an 'unknown' include:
  
  =over 4
  
  =item *
  
  abstract
  
  =item *
  
  author
  
  =item *
  
  license
  
  =back
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Ansgar Burchardt <ansgar@cpan.org>
  
  =item *
  
  Avar Arnfjord Bjarmason <avar@cpan.org>
  
  =item *
  
  Christopher J. Madsen <cjm@cpan.org>
  
  =item *
  
  Cory G Watson <gphat@cpan.org>
  
  =item *
  
  Damyan Ivanov <dam@cpan.org>
  
  =item *
  
  Eric Wilhelm <ewilhelm@cpan.org>
  
  =item *
  
  Gregor Hermann <gregoa@debian.org>
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Lars Dieckow <daxim@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =item *
  
  Mark Fowler <markf@cpan.org>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Randy Sims <randys@thepierianspring.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_CONVERTER

$fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Feature;
  our $VERSION = '2.131560'; # VERSION
  
  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;
  
  # ABSTRACT: an optional feature provided by a CPAN distribution
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
  
  =head1 VERSION
  
  version 2.131560
  
  =head1 DESCRIPTION
  
  A CPAN::Meta::Feature object describes an optional feature offered by a CPAN
  distribution and specified in the distribution's F<META.json> (or F<META.yml>)
  file.
  
  For the most part, this class will only be used when operating on the result of
  the C<feature> or C<features> methods on a L<CPAN::Meta> object.
  
  =head1 METHODS
  
  =head2 new
  
    my $feature = CPAN::Meta::Feature->new( $identifier => \%spec );
  
  This returns a new Feature object.  The C<%spec> argument to the constructor
  should be the same as the value of the C<optional_feature> entry in the
  distmeta.  It must contain entries for C<description> and C<prereqs>.
  
  =head2 identifier
  
  This method returns the feature's identifier.
  
  =head2 description
  
  This method returns the feature's long description.
  
  =head2 prereqs
  
  This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs>
  object.
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Ansgar Burchardt <ansgar@cpan.org>
  
  =item *
  
  Avar Arnfjord Bjarmason <avar@cpan.org>
  
  =item *
  
  Christopher J. Madsen <cjm@cpan.org>
  
  =item *
  
  Cory G Watson <gphat@cpan.org>
  
  =item *
  
  Damyan Ivanov <dam@cpan.org>
  
  =item *
  
  Eric Wilhelm <ewilhelm@cpan.org>
  
  =item *
  
  Gregor Hermann <gregoa@debian.org>
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Lars Dieckow <daxim@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =item *
  
  Mark Fowler <markf@cpan.org>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Randy Sims <randys@thepierianspring.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
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;
  our $VERSION = '2.131560'; # VERSION
  
  1;
  
  # ABSTRACT: history of CPAN Meta Spec changes
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  CPAN::Meta::History - history of CPAN Meta Spec changes
  
  =head1 VERSION
  
  version 2.131560
  
  =head1 DESCRIPTION
  
  The CPAN Meta Spec has gone through several iterations.  It was
  originally written in HTML and later revised into POD (though published
  in HTML generated from the POD).  Fields were added, removed or changed,
  sometimes by design and sometimes to reflect real-world usage after the
  fact.
  
  This document reconstructs the history of the CPAN Meta Spec based on
  change logs, repository commit messages and the published HTML files.
  In some cases, particularly prior to version 1.2, the exact version
  when certain fields were introduced or changed is inconsistent between
  sources.  When in doubt, the published HTML files for versions 1.0 to
  1.4 as they existed when version 2 was developed are used as the
  definitive source.
  
  Starting with version 2, the specification document is part of the
  CPAN-Meta distribution and will be published on CPAN as
  L<CPAN::Meta::Spec>.
  
  Going forward, specification version numbers will be integers and
  decimal portions will correspond to a release date for the CPAN::Meta
  library.
  
  =head1 HISTORY
  
  =head2 Version 2
  
  April 2010
  
  =over
  
  =item *
  
  Revised spec examples as perl data structures rather than YAML
  
  =item *
  
  Switched to JSON serialization from YAML
  
  =item *
  
  Specified allowed version number formats
  
  =item *
  
  Replaced 'requires', 'build_requires', 'configure_requires',
  'recommends' and 'conflicts' with new 'prereqs' data structure divided
  by I<phase> (configure, build, test, runtime, etc.) and I<relationship>
  (requires, recommends, suggests, conflicts)
  
  =item *
  
  Added support for 'develop' phase for requirements for maintaining
  a list of authoring tools
  
  =item *
  
  Changed 'license' to a list and revised the set of valid licenses
  
  =item *
  
  Made 'dynamic_config' mandatory to reduce confusion
  
  =item *
  
  Changed 'resources' subkey 'repository' to a hash that clarifies
  repository type, url for browsing and url for checkout
  
  =item *
  
  Changed 'resources' subkey 'bugtracker' to a hash for either web
  or mailto resource
  
  =item *
  
  Changed specification of 'optional_features':
  
  =over
  
  =item *
  
  Added formal specification and usage guide instead of just example
  
  =item *
  
  Changed to use new prereqs data structure instead of individual keys
  
  =back
  
  =item *
  
  Clarified intended use of 'author' as generalized contact list
  
  =item *
  
  Added 'release_status' field to indicate stable, testing or unstable
  status to provide hints to indexers
  
  =item *
  
  Added 'description' field for a longer description of the distribution
  
  =item *
  
  Formalized use of "x_" or "X_" for all custom keys not listed in the
  official spec
  
  =back
  
  =head2 Version 1.4
  
  June 2008
  
  =over
  
  =item *
  
  Noted explicit support for 'perl' in prerequisites
  
  =item *
  
  Added 'configure_requires' prerequisite type
  
  =item *
  
  Changed 'optional_features'
  
  =over
  
  =item *
  
  Example corrected to show map of maps instead of list of maps
  (though descriptive text said 'map' even in v1.3)
  
  =item *
  
  Removed 'requires_packages', 'requires_os' and 'excluded_os'
  as valid subkeys
  
  =back
  
  =back
  
  =head2 Version 1.3
  
  November 2006
  
  =over
  
  =item *
  
  Added 'no_index' subkey 'directory' and removed 'dir' to match actual
  usage in the wild
  
  =item *
  
  Added a 'repository' subkey to 'resources'
  
  =back
  
  =head2 Version 1.2
  
  August 2005
  
  =over
  
  =item *
  
  Re-wrote and restructured spec in POD syntax
  
  =item *
  
  Changed 'name' to be mandatory
  
  =item *
  
  Changed 'generated_by' to be mandatory
  
  =item *
  
  Changed 'license' to be mandatory
  
  =item *
  
  Added version range specifications for prerequisites
  
  =item *
  
  Added required 'abstract' field
  
  =item *
  
  Added required 'author' field
  
  =item *
  
  Added required 'meta-spec' field to define 'version' (and 'url') of the
  CPAN Meta Spec used for metadata
  
  =item *
  
  Added 'provides' field
  
  =item *
  
  Added 'no_index' field and deprecated 'private' field.  'no_index'
  subkeys include 'file', 'dir', 'package' and 'namespace'
  
  =item *
  
  Added 'keywords' field
  
  =item *
  
  Added 'resources' field with subkeys 'homepage', 'license', and
  'bugtracker'
  
  =item *
  
  Added 'optional_features' field as an alternate under 'recommends'.
  Includes 'description', 'requires', 'build_requires', 'conflicts',
  'requires_packages', 'requires_os' and 'excluded_os' as valid subkeys
  
  =item *
  
  Removed 'license_uri' field
  
  =back
  
  =head2 Version 1.1
  
  May 2003
  
  =over
  
  =item *
  
  Changed 'version' to be mandatory
  
  =item *
  
  Added 'private' field
  
  =item *
  
  Added 'license_uri' field
  
  =back
  
  =head2 Version 1.0
  
  March 2003
  
  =over
  
  =item *
  
  Original release (in HTML format only)
  
  =item *
  
  Included 'name', 'version', 'license', 'distribution_type', 'requires',
  'recommends', 'build_requires', 'conflicts', 'dynamic_config',
  'generated_by'
  
  =back
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Ansgar Burchardt <ansgar@cpan.org>
  
  =item *
  
  Avar Arnfjord Bjarmason <avar@cpan.org>
  
  =item *
  
  Christopher J. Madsen <cjm@cpan.org>
  
  =item *
  
  Cory G Watson <gphat@cpan.org>
  
  =item *
  
  Damyan Ivanov <dam@cpan.org>
  
  =item *
  
  Eric Wilhelm <ewilhelm@cpan.org>
  
  =item *
  
  Gregor Hermann <gregoa@debian.org>
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Lars Dieckow <daxim@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =item *
  
  Mark Fowler <markf@cpan.org>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Randy Sims <randys@thepierianspring.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_HISTORY

$fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Prereqs;
  our $VERSION = '2.131560'; # VERSION
  
  
  use Carp qw(confess);
  use Scalar::Util qw(blessed);
  use CPAN::Meta::Requirements 2.121;
  
  
  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} = CPAN::Meta::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} ||= CPAN::Meta::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 = CPAN::Meta::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;
  
  # ABSTRACT: a set of distribution prerequisites by phase and type
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
  
  =head1 VERSION
  
  version 2.131560
  
  =head1 DESCRIPTION
  
  A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN
  distribution or one of its optional features.  Each set of prereqs is
  organized by phase and type, as described in L<CPAN::Meta::Prereqs>.
  
  =head1 METHODS
  
  =head2 new
  
    my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec );
  
  This method returns a new set of Prereqs.  The input should look like the
  contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning
  something more or less like this:
  
    my $prereq = CPAN::Meta::Prereqs->new({
      runtime => {
        requires => {
          'Some::Module' => '1.234',
          ...,
        },
        ...,
      },
      ...,
    });
  
  You can also construct an empty set of prereqs with:
  
    my $prereqs = CPAN::Meta::Prereqs->new;
  
  This empty set of prereqs is useful for accumulating new prereqs before finally
  dumping the whole set into a structure or string.
  
  =head2 requirements_for
  
    my $requirements = $prereqs->requirements_for( $phase, $type );
  
  This method returns a L<CPAN::Meta::Requirements> object for the given
  phase/type combination.  If no prerequisites are registered for that
  combination, a new CPAN::Meta::Requirements object will be returned, and it may
  be added to as needed.
  
  If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
  be raised.
  
  =head2 with_merged_prereqs
  
    my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
  
    my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs );
  
  This method returns a new CPAN::Meta::Prereqs objects in which all the
  other prerequisites given are merged into the current set.  This is primarily
  provided for combining a distribution's core prereqs with the prereqs of one of
  its optional features.
  
  The new prereqs object has no ties to the originals, and altering it further
  will not alter them.
  
  =head2 as_string_hash
  
  This method returns a hashref containing structures suitable for dumping into a
  distmeta data structure.  It is made up of hashes and strings, only; there will
  be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it.
  
  =head2 is_finalized
  
  This method returns true if the set of prereqs has been marked "finalized," and
  cannot be altered.
  
  =head2 finalize
  
  Calling C<finalize> on a Prereqs object will close it for further modification.
  Attempting to make any changes that would actually alter the prereqs will
  result in an exception being thrown.
  
  =head2 clone
  
    my $cloned_prereqs = $prereqs->clone;
  
  This method returns a Prereqs object that is identical to the original object,
  but can be altered without affecting the original object.  Finalization does
  not survive cloning, meaning that you may clone a finalized set of prereqs and
  then modify the clone.
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Ansgar Burchardt <ansgar@cpan.org>
  
  =item *
  
  Avar Arnfjord Bjarmason <avar@cpan.org>
  
  =item *
  
  Christopher J. Madsen <cjm@cpan.org>
  
  =item *
  
  Cory G Watson <gphat@cpan.org>
  
  =item *
  
  Damyan Ivanov <dam@cpan.org>
  
  =item *
  
  Eric Wilhelm <ewilhelm@cpan.org>
  
  =item *
  
  Gregor Hermann <gregoa@debian.org>
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Lars Dieckow <daxim@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =item *
  
  Mark Fowler <markf@cpan.org>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Randy Sims <randys@thepierianspring.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_PREREQS

$fatpacked{"CPAN/Meta/Requirements.pm"} = <<'CPAN_META_REQUIREMENTS';
  use strict;
  use warnings;
  package CPAN::Meta::Requirements;
  our $VERSION = '2.122'; # VERSION
  # ABSTRACT: a set of version requirements for a CPAN dist
  
  
  use Carp ();
  use Scalar::Util ();
  use version 0.77 (); # the ->parse method
  
  
  my @valid_options = qw( bad_version_hook );
  
  sub new {
    my ($class, $options) = @_;
    $options ||= {};
    Carp::croak "Argument to $class\->new() must be a hash reference"
      unless ref $options eq 'HASH';
    my %self = map {; $_ => $options->{$_}} @valid_options;
  
    return bless \%self => $class;
  }
  
  sub _version_object {
    my ($self, $version) = @_;
  
    my $vobj;
  
    eval {
      $vobj  = (! defined $version)                ? version->parse(0)
             : (! Scalar::Util::blessed($version)) ? version->parse($version)
             :                                       $version;
    };
  
    if ( my $err = $@ ) {
      my $hook = $self->{bad_version_hook};
      $vobj = eval { $hook->($version) }
        if ref $hook eq 'CODE';
      unless (Scalar::Util::blessed($vobj) && $vobj->isa("version")) {
        $err =~ s{ at .* line \d+.*$}{};
        die "Can't convert '$version': $err";
      }
    }
  
    # ensure no leading '.'
    if ( $vobj =~ m{\A\.} ) {
      $vobj = version->parse("0$vobj");
    }
  
    # ensure normal v-string form
    if ( $vobj->is_qv ) {
      $vobj = version->parse($vobj->normal);
    }
  
    return $vobj;
  }
  
  
  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 requirements_for_module {
    my ($self, $module) = @_;
    my $entry = $self->__entry_for($module);
    return unless $entry;
    return $entry->as_string;
  }
  
  
  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 || 'CPAN::Meta::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 add_string_requirement {
    my ($self, $module, $req) = @_;
  
    Carp::confess("No requirement string provided for $module")
      unless defined $req && length $req;
  
    my @parts = split qr{\s*,\s*}, $req;
  
  
    for my $part (@parts) {
      my ($op, $ver) = $part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z};
  
      if (! defined $op) {
        $self->add_minimum($module => $part);
      } else {
        Carp::confess("illegal requirement string: $req")
          unless my $methods = $methods_for_op{ $op };
  
        $self->$_($module => $ver) for @$methods;
      }
    }
  }
  
  
  sub from_string_hash {
    my ($class, $hash) = @_;
  
    my $self = $class->new;
  
    for my $module (keys %$hash) {
      my $req = $hash->{$module};
      unless ( defined $req && length $req ) {
        $req = 0;
        Carp::carp("Undefined requirement for $module treated as '0'");
      }
      $self->add_string_requirement($module, $req);
    }
  
    return $self;
  }
  
  ##############################################################
  
  {
    package
      CPAN::Meta::Requirements::_Range::Exact;
    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
      CPAN::Meta::Requirements::_Range::Range;
  
    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 CPAN::Meta::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 CPAN::Meta::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;
  # vim: ts=2 sts=2 sw=2 et:
  
  __END__
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Requirements - a set of version requirements for a CPAN dist
  
  =head1 VERSION
  
  version 2.122
  
  =head1 SYNOPSIS
  
    use CPAN::Meta::Requirements;
  
    my $build_requires = CPAN::Meta::Requirements->new;
  
    $build_requires->add_minimum('Library::Foo' => 1.208);
  
    $build_requires->add_minimum('Library::Foo' => 2.602);
  
    $build_requires->add_minimum('Module::Bar'  => 'v1.2.3');
  
    $METAyml->{build_requires} = $build_requires->as_string_hash;
  
  =head1 DESCRIPTION
  
  A CPAN::Meta::Requirements object models a set of version constraints like
  those specified in the F<META.yml> or F<META.json> files in CPAN distributions.
  It can be built up by adding more and more constraints, and it will reduce them
  to the simplest representation.
  
  Logically impossible constraints will be identified immediately by thrown
  exceptions.
  
  =head1 METHODS
  
  =head2 new
  
    my $req = CPAN::Meta::Requirements->new;
  
  This returns a new CPAN::Meta::Requirements object.  It takes an optional
  hash reference argument.  The following keys are supported:
  
  =over 4
  
  =item *
  
  <bad_version_hook> -- if provided, when a version cannot be parsed into
  
  a version object, this code reference will be called with the invalid version
  string as an argument.  It must return a valid version object.
  
  =back
  
  All other keys are ignored.
  
  =head2 add_minimum
  
    $req->add_minimum( $module => $version );
  
  This adds a new minimum version requirement.  If the new requirement is
  redundant to the existing specification, this has no effect.
  
  Minimum requirements are inclusive.  C<$version> is required, along with any
  greater version number.
  
  This method returns the requirements object.
  
  =head2 add_maximum
  
    $req->add_maximum( $module => $version );
  
  This adds a new maximum version requirement.  If the new requirement is
  redundant to the existing specification, this has no effect.
  
  Maximum requirements are inclusive.  No version strictly greater than the given
  version is allowed.
  
  This method returns the requirements object.
  
  =head2 add_exclusion
  
    $req->add_exclusion( $module => $version );
  
  This adds a new excluded version.  For example, you might use these three
  method calls:
  
    $req->add_minimum( $module => '1.00' );
    $req->add_maximum( $module => '1.82' );
  
    $req->add_exclusion( $module => '1.75' );
  
  Any version between 1.00 and 1.82 inclusive would be acceptable, except for
  1.75.
  
  This method returns the requirements object.
  
  =head2 exact_version
  
    $req->exact_version( $module => $version );
  
  This sets the version required for the given module to I<exactly> the given
  version.  No other version would be considered acceptable.
  
  This method returns the requirements object.
  
  =head2 add_requirements
  
    $req->add_requirements( $another_req_object );
  
  This method adds all the requirements in the given CPAN::Meta::Requirements object
  to the requirements object on which it was called.  If there are any conflicts,
  an exception is thrown.
  
  This method returns the requirements object.
  
  =head2 accepts_module
  
    my $bool = $req->accepts_modules($module => $version);
  
  Given an module and version, this method returns true if the version
  specification for the module accepts the provided version.  In other words,
  given:
  
    Module => '>= 1.00, < 2.00'
  
  We will accept 1.00 and 1.75 but not 0.50 or 2.00.
  
  For modules that do not appear in the requirements, this method will return
  true.
  
  =head2 clear_requirement
  
    $req->clear_requirement( $module );
  
  This removes the requirement for a given module from the object.
  
  This method returns the requirements object.
  
  =head2 requirements_for_module
  
    $req->requirements_for_module( $module );
  
  This returns a string containing the version requirements for a given module in
  the format described in L<CPAN::Meta::Spec> or undef if the given module has no
  requirements. This should only be used for informational purposes such as error
  messages and should not be interpreted or used for comparison (see
  L</accepts_module> instead.)
  
  =head2 required_modules
  
  This method returns a list of all the modules for which requirements have been
  specified.
  
  =head2 clone
  
    $req->clone;
  
  This method returns a clone of the invocant.  The clone and the original object
  can then be changed independent of one another.
  
  =head2 is_simple
  
  This method returns true if and only if all requirements are inclusive minimums
  -- that is, if their string expression is just the version number.
  
  =head2 is_finalized
  
  This method returns true if the requirements have been finalized by having the
  C<finalize> method called on them.
  
  =head2 finalize
  
  This method marks the requirements finalized.  Subsequent attempts to change
  the requirements will be fatal, I<if> they would result in a change.  If they
  would not alter the requirements, they have no effect.
  
  If a finalized set of requirements is cloned, the cloned requirements are not
  also finalized.
  
  =head2 as_string_hash
  
  This returns a reference to a hash describing the requirements using the
  strings in the F<META.yml> specification.
  
  For example after the following program:
  
    my $req = CPAN::Meta::Requirements->new;
  
    $req->add_minimum('CPAN::Meta::Requirements' => 0.102);
  
    $req->add_minimum('Library::Foo' => 1.208);
  
    $req->add_maximum('Library::Foo' => 2.602);
  
    $req->add_minimum('Module::Bar'  => 'v1.2.3');
  
    $req->add_exclusion('Module::Bar'  => 'v1.2.8');
  
    $req->exact_version('Xyzzy'  => '6.01');
  
    my $hashref = $req->as_string_hash;
  
  C<$hashref> would contain:
  
    {
      'CPAN::Meta::Requirements' => '0.102',
      'Library::Foo' => '>= 1.208, <= 2.206',
      'Module::Bar'  => '>= v1.2.3, != v1.2.8',
      'Xyzzy'        => '== 6.01',
    }
  
  =head2 add_string_requirement
  
    $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206');
  
  This method parses the passed in string and adds the appropriate requirement
  for the given module.  It understands version ranges as described in the
  L<CPAN::Meta::Spec/Version Ranges>. For example:
  
  =over 4
  
  =item 1.3
  
  =item >= 1.3
  
  =item <= 1.3
  
  =item == 1.3
  
  =item != 1.3
  
  =item > 1.3
  
  =item < 1.3
  
  =item >= 1.3, != 1.5, <= 2.0
  
  A version number without an operator is equivalent to specifying a minimum
  (C<E<gt>=>).  Extra whitespace is allowed.
  
  =back
  
  =head2 from_string_hash
  
    my $req = CPAN::Meta::Requirements->from_string_hash( \%hash );
  
  This is an alternate constructor for a CPAN::Meta::Requirements object.  It takes
  a hash of module names and version requirement strings and returns a new
  CPAN::Meta::Requirements object.
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta-Requirements>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/dagolden/cpan-meta-requirements>
  
    git clone https://github.com/dagolden/cpan-meta-requirements.git
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
  
CPAN_META_REQUIREMENTS

$fatpacked{"CPAN/Meta/Spec.pm"} = <<'CPAN_META_SPEC';
  # vi:tw=72
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Spec;
  our $VERSION = '2.131560'; # VERSION
  
  1;
  
  # ABSTRACT: specification for CPAN distribution metadata
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  CPAN::Meta::Spec - specification for CPAN distribution metadata
  
  =head1 VERSION
  
  version 2.131560
  
  =head1 SYNOPSIS
  
    my $distmeta = {
      name => 'Module-Build',
      abstract => 'Build and install Perl modules',
      description =>  "Module::Build is a system for "
        . "building, testing, and installing Perl modules. "
        . "It is meant to ... blah blah blah ...",
      version  => '0.36',
      release_status => 'stable',
      author   => [
        'Ken Williams <kwilliams@cpan.org>',
        'Module-Build List <module-build@perl.org>', # additional contact
      ],
      license  => [ 'perl_5' ],
      prereqs => {
        runtime => {
          requires => {
            'perl'   => '5.006',
            'ExtUtils::Install' => '0',
            'File::Basename' => '0',
            'File::Compare'  => '0',
            'IO::File'   => '0',
          },
          recommends => {
            'Archive::Tar' => '1.00',
            'ExtUtils::Install' => '0.3',
            'ExtUtils::ParseXS' => '2.02',
          },
        },
        build => {
          requires => {
            'Test::More' => '0',
          },
        }
      },
      resources => {
        license => ['http://dev.perl.org/licenses/'],
      },
      optional_features => {
        domination => {
          description => 'Take over the world',
          prereqs     => {
            develop => { requires => { 'Genius::Evil'     => '1.234' } },
            runtime => { requires => { 'Machine::Weather' => '2.0'   } },
          },
        },
      },
      dynamic_config => 1,
      keywords => [ qw/ toolchain cpan dual-life / ],
      'meta-spec' => {
        version => '2',
        url     => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
      },
      generated_by => 'Module::Build version 0.36',
    };
  
  =head1 DESCRIPTION
  
  This document describes version 2 of the CPAN distribution metadata
  specification, also known as the "CPAN Meta Spec".
  
  Revisions of this specification for typo corrections and prose
  clarifications may be issued as CPAN::Meta::Spec 2.I<x>.  These
  revisions will never change semantics or add or remove specified
  behavior.
  
  Distribution metadata describe important properties of Perl
  distributions. Distribution building tools like Module::Build,
  Module::Install, ExtUtils::MakeMaker or Dist::Zilla should create a
  metadata file in accordance with this specification and include it with
  the distribution for use by automated tools that index, examine, package
  or install Perl distributions.
  
  =head1 TERMINOLOGY
  
  =over 4
  
  =item distribution
  
  This is the primary object described by the metadata. In the context of
  this document it usually refers to a collection of modules, scripts,
  and/or documents that are distributed together for other developers to
  use.  Examples of distributions are C<Class-Container>, C<libwww-perl>,
  or C<DBI>.
  
  =item module
  
  This refers to a reusable library of code contained in a single file.
  Modules usually contain one or more packages and are often referred
  to by the name of a primary package that can be mapped to the file
  name. For example, one might refer to C<File::Spec> instead of
  F<File/Spec.pm>
  
  =item package
  
  This refers to a namespace declared with the Perl C<package> statement.
  In Perl, packages often have a version number property given by the
  C<$VERSION> variable in the namespace.
  
  =item consumer
  
  This refers to code that reads a metadata file, deserializes it into a
  data structure in memory, or interprets a data structure of metadata
  elements.
  
  =item producer
  
  This refers to code that constructs a metadata data structure,
  serializes into a bytestream and/or writes it to disk.
  
  =item must, should, may, etc.
  
  These terms are interpreted as described in IETF RFC 2119.
  
  =back
  
  =head1 DATA TYPES
  
  Fields in the L</STRUCTURE> section describe data elements, each of
  which has an associated data type as described herein.  There are four
  primitive types: Boolean, String, List and Map.  Other types are
  subtypes of primitives and define compound data structures or define
  constraints on the values of a data element.
  
  =head2 Boolean
  
  A I<Boolean> is used to provide a true or false value.  It B<must> be
  represented as a defined value.
  
  =head2 String
  
  A I<String> is data element containing a non-zero length sequence of
  Unicode characters, such as an ordinary Perl scalar that is not a
  reference.
  
  =head2 List
  
  A I<List> is an ordered collection of zero or more data elements.
  Elements of a List may be of mixed types.
  
  Producers B<must> represent List elements using a data structure which
  unambiguously indicates that multiple values are possible, such as a
  reference to a Perl array (an "arrayref").
  
  Consumers expecting a List B<must> consider a String as equivalent to a
  List of length 1.
  
  =head2 Map
  
  A I<Map> is an unordered collection of zero or more data elements
  ("values"), indexed by associated String elements ("keys").  The Map's
  value elements may be of mixed types.
  
  =head2 License String
  
  A I<License String> is a subtype of String with a restricted set of
  values.  Valid values are described in detail in the description of
  the L</license> field.
  
  =head2 URL
  
  I<URL> is a subtype of String containing a Uniform Resource Locator or
  Identifier.  [ This type is called URL and not URI for historical reasons. ]
  
  =head2 Version
  
  A I<Version> is a subtype of String containing a value that describes
  the version number of packages or distributions.  Restrictions on format
  are described in detail in the L</Version Formats> section.
  
  =head2 Version Range
  
  The I<Version Range> type is a subtype of String.  It describes a range
  of Versions that may be present or installed to fulfill prerequisites.
  It is specified in detail in the L</Version Ranges> section.
  
  =head1 STRUCTURE
  
  The metadata structure is a data element of type Map.  This section
  describes valid keys within the Map.
  
  Any keys not described in this specification document (whether top-level
  or within compound data structures described herein) are considered
  I<custom keys> and B<must> begin with an "x" or "X" and be followed by an
  underscore; i.e. they must match the pattern: C<< qr{\Ax_}i >>.  If a
  custom key refers to a compound data structure, subkeys within it do not
  need an "x_" or "X_" prefix.
  
  Consumers of metadata may ignore any or all custom keys.  All other keys
  not described herein are invalid and should be ignored by consumers.
  Producers must not generate or output invalid keys.
  
  For each key, an example is provided followed by a description.  The
  description begins with the version of spec in which the key was added
  or in which the definition was modified, whether the key is I<required>
  or I<optional> and the data type of the corresponding data element.
  These items are in parentheses, brackets and braces, respectively.
  
  If a data type is a Map or Map subtype, valid subkeys will be described
  as well.
  
  Some fields are marked I<Deprecated>.  These are shown for historical
  context and must not be produced in or consumed from any metadata structure
  of version 2 or higher.
  
  =head2 REQUIRED FIELDS
  
  =head3 abstract
  
  Example:
  
    abstract => 'Build and install Perl modules'
  
  (Spec 1.2) [required] {String}
  
  This is a short description of the purpose of the distribution.
  
  =head3 author
  
  Example:
  
    author => [ 'Ken Williams <kwilliams@cpan.org>' ]
  
  (Spec 1.2) [required] {List of one or more Strings}
  
  This List indicates the person(s) to contact concerning the
  distribution. The preferred form of the contact string is:
  
    contact-name <email-address>
  
  This field provides a general contact list independent of other
  structured fields provided within the L</resources> field, such as
  C<bugtracker>.  The addressee(s) can be contacted for any purpose
  including but not limited to (security) problems with the distribution,
  questions about the distribution or bugs in the distribution.
  
  A distribution's original author is usually the contact listed within
  this field.  Co-maintainers, successor maintainers or mailing lists
  devoted to the distribution may also be listed in addition to or instead
  of the original author.
  
  =head3 dynamic_config
  
  Example:
  
    dynamic_config => 1
  
  (Spec 2) [required] {Boolean}
  
  A boolean flag indicating whether a F<Build.PL> or F<Makefile.PL> (or
  similar) must be executed to determine prerequisites.
  
  This field should be set to a true value if the distribution performs
  some dynamic configuration (asking questions, sensing the environment,
  etc.) as part of its configuration.  This field should be set to a false
  value to indicate that prerequisites included in metadata may be
  considered final and valid for static analysis.
  
  This field explicitly B<does not> indicate whether installation may be
  safely performed without using a Makefile or Build file, as there may be
  special files to install or custom installation targets (e.g. for
  dual-life modules that exist on CPAN as well as in the Perl core).  This
  field only defines whether prerequisites are complete as given in the
  metadata.
  
  =head3 generated_by
  
  Example:
  
    generated_by => 'Module::Build version 0.36'
  
  (Spec 1.0) [required] {String}
  
  This field indicates the tool that was used to create this metadata.
  There are no defined semantics for this field, but it is traditional to
  use a string in the form "Generating::Package version 1.23" or the
  author's name, if the file was generated by hand.
  
  =head3 license
  
  Example:
  
    license => [ 'perl_5' ]
  
    license => [ 'apache_2', 'mozilla_1_0' ]
  
  (Spec 2) [required] {List of one or more License Strings}
  
  One or more licenses that apply to some or all of the files in the
  distribution.  If multiple licenses are listed, the distribution
  documentation should be consulted to clarify the interpretation of
  multiple licenses.
  
  The following list of license strings are valid:
  
   string          description
   -------------   -----------------------------------------------
   agpl_3          GNU Affero General Public License, Version 3
   apache_1_1      Apache Software License, Version 1.1
   apache_2_0      Apache License, Version 2.0
   artistic_1      Artistic License, (Version 1)
   artistic_2      Artistic License, Version 2.0
   bsd             BSD License (three-clause)
   freebsd         FreeBSD License (two-clause)
   gfdl_1_2        GNU Free Documentation License, Version 1.2
   gfdl_1_3        GNU Free Documentation License, Version 1.3
   gpl_1           GNU General Public License, Version 1
   gpl_2           GNU General Public License, Version 2
   gpl_3           GNU General Public License, Version 3
   lgpl_2_1        GNU Lesser General Public License, Version 2.1
   lgpl_3_0        GNU Lesser General Public License, Version 3.0
   mit             MIT (aka X11) License
   mozilla_1_0     Mozilla Public License, Version 1.0
   mozilla_1_1     Mozilla Public License, Version 1.1
   openssl         OpenSSL License
   perl_5          The Perl 5 License (Artistic 1 & GPL 1 or later)
   qpl_1_0         Q Public License, Version 1.0
   ssleay          Original SSLeay License
   sun             Sun Internet Standards Source License (SISSL)
   zlib            zlib License
  
  The following license strings are also valid and indicate other
  licensing not described above:
  
   string          description
   -------------   -----------------------------------------------
   open_source     Other Open Source Initiative (OSI) approved license
   restricted      Requires special permission from copyright holder
   unrestricted    Not an OSI approved license, but not restricted
   unknown         License not provided in metadata
  
  All other strings are invalid in the license field.
  
  =head3 meta-spec
  
  Example:
  
    'meta-spec' => {
      version => '2',
      url     => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
    }
  
  (Spec 1.2) [required] {Map}
  
  This field indicates the version of the CPAN Meta Spec that should be
  used to interpret the metadata.  Consumers must check this key as soon
  as possible and abort further metadata processing if the meta-spec
  version is not supported by the consumer.
  
  The following keys are valid, but only C<version> is required.
  
  =over
  
  =item version
  
  This subkey gives the integer I<Version> of the CPAN Meta Spec against
  which the document was generated.
  
  =item url
  
  This is a I<URL> of the metadata specification document corresponding to
  the given version.  This is strictly for human-consumption and should
  not impact the interpretation of the document.
  
  =back
  
  =head3 name
  
  Example:
  
    name => 'Module-Build'
  
  (Spec 1.0) [required] {String}
  
  This field is the name of the distribution.  This is often created by
  taking the "main package" in the distribution and changing C<::> to
  C<->, but the name may be completely unrelated to the packages within
  the distribution.  C.f. L<http://search.cpan.org/dist/libwww-perl/>.
  
  =head3 release_status
  
  Example:
  
    release_status => 'stable'
  
  (Spec 2) [required] {String}
  
  This field provides the  release status of this distribution.  If the
  C<version> field contains an underscore character, then
  C<release_status> B<must not> be "stable."
  
  The C<release_status> field B<must> have one of the following values:
  
  =over
  
  =item stable
  
  This indicates an ordinary, "final" release that should be indexed by PAUSE
  or other indexers.
  
  =item testing
  
  This indicates a "beta" release that is substantially complete, but has an
  elevated risk of bugs and requires additional testing.  The distribution
  should not be installed over a stable release without an explicit request
  or other confirmation from a user.  This release status may also be used
  for "release candidate" versions of a distribution.
  
  =item unstable
  
  This indicates an "alpha" release that is under active development, but has
  been released for early feedback or testing and may be missing features or
  may have serious bugs.  The distribution should not be installed over a
  stable release without an explicit request or other confirmation from a
  user.
  
  =back
  
  Consumers B<may> use this field to determine how to index the
  distribution for CPAN or other repositories in addition to or in
  replacement of heuristics based on version number or file name.
  
  =head3 version
  
  Example:
  
    version => '0.36'
  
  (Spec 1.0) [required] {Version}
  
  This field gives the version of the distribution to which the metadata
  structure refers.
  
  =head2 OPTIONAL FIELDS
  
  =head3 description
  
  Example:
  
      description =>  "Module::Build is a system for "
        . "building, testing, and installing Perl modules. "
        . "It is meant to ... blah blah blah ...",
  
  (Spec 2) [optional] {String}
  
  A longer, more complete description of the purpose or intended use of
  the distribution than the one provided by the C<abstract> key.
  
  =head3 keywords
  
  Example:
  
    keywords => [ qw/ toolchain cpan dual-life / ]
  
  (Spec 1.1) [optional] {List of zero or more Strings}
  
  A List of keywords that describe this distribution.  Keywords
  B<must not> include whitespace.
  
  =head3 no_index
  
  Example:
  
    no_index => {
      file      => [ 'My/Module.pm' ],
      directory => [ 'My/Private' ],
      package   => [ 'My::Module::Secret' ],
      namespace => [ 'My::Module::Sample' ],
    }
  
  (Spec 1.2) [optional] {Map}
  
  This Map describes any files, directories, packages, and namespaces that
  are private to the packaging or implementation of the distribution and
  should be ignored by indexing or search tools.
  
  Valid subkeys are as follows:
  
  =over
  
  =item file
  
  A I<List> of relative paths to files.  Paths B<must be> specified with
  unix conventions.
  
  =item directory
  
  A I<List> of relative paths to directories.  Paths B<must be> specified
  with unix conventions.
  
  [ Note: previous editions of the spec had C<dir> instead of C<directory> ]
  
  =item package
  
  A I<List> of package names.
  
  =item namespace
  
  A I<List> of package namespaces, where anything below the namespace
  must be ignored, but I<not> the namespace itself.
  
  In the example above for C<no_index>, C<My::Module::Sample::Foo> would
  be ignored, but C<My::Module::Sample> would not.
  
  =back
  
  =head3 optional_features
  
  Example:
  
    optional_features => {
      sqlite => {
        description => 'Provides SQLite support',
        prereqs => {
          runtime => {
            requires => {
              'DBD::SQLite' => '1.25'
            }
          }
        }
      }
    }
  
  (Spec 2) [optional] {Map}
  
  This Map describes optional features with incremental prerequisites.
  Each key of the C<optional_features> Map is a String used to identify
  the feature and each value is a Map with additional information about
  the feature.  Valid subkeys include:
  
  =over
  
  =item description
  
  This is a String describing the feature.  Every optional feature
  should provide a description
  
  =item prereqs
  
  This entry is required and has the same structure as that of the
  C<L</prereqs>> key.  It provides a list of package requirements
  that must be satisfied for the feature to be supported or enabled.
  
  There is one crucial restriction:  the prereqs of an optional feature
  B<must not> include C<configure> phase prereqs.
  
  =back
  
  Consumers B<must not> include optional features as prerequisites without
  explicit instruction from users (whether via interactive prompting,
  a function parameter or a configuration value, etc. ).
  
  If an optional feature is used by a consumer to add additional
  prerequisites, the consumer should merge the optional feature
  prerequisites into those given by the C<prereqs> key using the same
  semantics.  See L</Merging and Resolving Prerequisites> for details on
  merging prerequisites.
  
  I<Suggestion for disuse:> Because there is currently no way for a
  distribution to specify a dependency on an optional feature of another
  dependency, the use of C<optional_feature> is discouraged.  Instead,
  create a separate, installable distribution that ensures the desired
  feature is available.  For example, if C<Foo::Bar> has a "Baz" feature,
  release a separate C<Foo-Bar-Baz> distribution that satisfies
  requirements for the feature.
  
  =head3 prereqs
  
  Example:
  
    prereqs => {
      runtime => {
        requires => {
          'perl'          => '5.006',
          'File::Spec'    => '0.86',
          'JSON'          => '2.16',
        },
        recommends => {
          'JSON::XS'      => '2.26',
        },
        suggests => {
          'Archive::Tar'  => '0',
        },
      },
      build => {
        requires => {
          'Alien::SDL'    => '1.00',
        },
      },
      test => {
        recommends => {
          'Test::Deep'    => '0.10',
        },
      }
    }
  
  (Spec 2) [optional] {Map}
  
  This is a Map that describes all the prerequisites of the distribution.
  The keys are phases of activity, such as C<configure>, C<build>, C<test>
  or C<runtime>.  Values are Maps in which the keys name the type of
  prerequisite relationship such as C<requires>, C<recommends>, or
  C<suggests> and the value provides a set of prerequisite relations.  The
  set of relations B<must> be specified as a Map of package names to
  version ranges.
  
  The full definition for this field is given in the L</Prereq Spec>
  section.
  
  =head3 provides
  
  Example:
  
    provides => {
      'Foo::Bar' => {
        file    => 'lib/Foo/Bar.pm',
        version => 0.27_02
      },
      'Foo::Bar::Blah' => {
        file    => 'lib/Foo/Bar/Blah.pm',
      },
      'Foo::Bar::Baz' => {
        file    => 'lib/Foo/Bar/Baz.pm',
        version => 0.3,
      },
    }
  
  (Spec 1.2) [optional] {Map}
  
  This describes all packages provided by this distribution.  This
  information is used by distribution and automation mechanisms like
  PAUSE, CPAN, and search.cpan.org to build indexes saying in which
  distribution various packages can be found.
  
  The keys of C<provides> are package names that can be found within
  the distribution.  If a package name key is provided, it must
  have a Map with the following valid subkeys:
  
  =over
  
  =item file
  
  This field is required.  It must contain a Unix-style relative file path
  from the root of the distribution directory to a file that contains or
  generates the package.
  
  =item version
  
  If it exists, this field must contains a I<Version> String for the
  package.  If the package does not have a C<$VERSION>, this field must
  be omitted.
  
  =back
  
  =head3 resources
  
  Example:
  
    resources => {
      license     => [ 'http://dev.perl.org/licenses/' ],
      homepage    => 'http://sourceforge.net/projects/module-build',
      bugtracker  => {
        web    => 'http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta',
        mailto => 'meta-bugs@example.com',
      },
      repository  => {
        url  => 'git://github.com/dagolden/cpan-meta.git',
        web  => 'http://github.com/dagolden/cpan-meta',
        type => 'git',
      },
      x_twitter   => 'http://twitter.com/cpan_linked/',
    }
  
  (Spec 2) [optional] {Map}
  
  This field describes resources related to this distribution.
  
  Valid subkeys include:
  
  =over
  
  =item homepage
  
  The official home of this project on the web.
  
  =item license
  
  A List of I<URL>'s that relate to this distribution's license.  As with the
  top-level C<license> field, distribution documentation should be consulted
  to clarify the interpretation of multiple licenses provided here.
  
  =item bugtracker
  
  This entry describes the bug tracking system for this distribution.  It
  is a Map with the following valid keys:
  
    web    - a URL pointing to a web front-end for the bug tracker
    mailto - an email address to which bugs can be sent
  
  =item repository
  
  This entry describes the source control repository for this distribution.  It
  is a Map with the following valid keys:
  
    url  - a URL pointing to the repository itself
    web  - a URL pointing to a web front-end for the repository
    type - a lowercase string indicating the VCS used
  
  Because a url like C<http://myrepo.example.com/> is ambiguous as to
  type, producers should provide a C<type> whenever a C<url> key is given.
  The C<type> field should be the name of the most common program used
  to work with the repository, e.g. git, svn, cvs, darcs, bzr or hg.
  
  =back
  
  =head2 DEPRECATED FIELDS
  
  =head3 build_requires
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 configure_requires
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 conflicts
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 distribution_type
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  This field indicated 'module' or 'script' but was considered
  meaningless, since many distributions are hybrids of several kinds of
  things.
  
  =head3 license_uri
  
  I<(Deprecated in Spec 1.2)> [optional] {URL}
  
  Replaced by C<license> in C<resources>
  
  =head3 private
  
  I<(Deprecated in Spec 1.2)> [optional] {Map}
  
  This field has been renamed to L</"no_index">.
  
  =head3 recommends
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 requires
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head1 VERSION NUMBERS
  
  =head2 Version Formats
  
  This section defines the Version type, used by several fields in the
  CPAN Meta Spec.
  
  Version numbers must be treated as strings, not numbers.  For
  example, C<1.200> B<must not> be serialized as C<1.2>.  Version
  comparison should be delegated to the Perl L<version> module, version
  0.80 or newer.
  
  Unless otherwise specified, version numbers B<must> appear in one of two
  formats:
  
  =over
  
  =item Decimal versions
  
  Decimal versions are regular "decimal numbers", with some limitations.
  They B<must> be non-negative and B<must> begin and end with a digit.  A
  single underscore B<may> be included, but B<must> be between two digits.
  They B<must not> use exponential notation ("1.23e-2").
  
     version => '1.234'       # OK
     version => '1.23_04'     # OK
  
     version => '1.23_04_05'  # Illegal
     version => '1.'          # Illegal
     version => '.1'          # Illegal
  
  =item Dotted-integer versions
  
  Dotted-integer (also known as dotted-decimal) versions consist of
  positive integers separated by full stop characters (i.e. "dots",
  "periods" or "decimal points").  This are equivalent in format to Perl
  "v-strings", with some additional restrictions on form.  They must be
  given in "normal" form, which has a leading "v" character and at least
  three integer components.  To retain a one-to-one mapping with decimal
  versions, all components after the first B<should> be restricted to the
  range 0 to 999.  The final component B<may> be separated by an
  underscore character instead of a period.
  
     version => 'v1.2.3'      # OK
     version => 'v1.2_3'      # OK
     version => 'v1.2.3.4'    # OK
     version => 'v1.2.3_4'    # OK
     version => 'v2009.10.31' # OK
  
     version => 'v1.2'          # Illegal
     version => '1.2.3'         # Illegal
     version => 'v1.2_3_4'      # Illegal
     version => 'v1.2009.10.31' # Not recommended
  
  =back
  
  =head2 Version Ranges
  
  Some fields (prereq, optional_features) indicate the particular
  version(s) of some other module that may be required as a prerequisite.
  This section details the Version Range type used to provide this
  information.
  
  The simplest format for a Version Range is just the version
  number itself, e.g. C<2.4>.  This means that B<at least> version 2.4
  must be present.  To indicate that B<any> version of a prerequisite is
  okay, even if the prerequisite doesn't define a version at all, use
  the version C<0>.
  
  Alternatively, a version range B<may> use the operators E<lt> (less than),
  E<lt>= (less than or equal), E<gt> (greater than), E<gt>= (greater than
  or equal), == (equal), and != (not equal).  For example, the
  specification C<E<lt> 2.0> means that any version of the prerequisite
  less than 2.0 is suitable.
  
  For more complicated situations, version specifications B<may> be AND-ed
  together using commas.  The specification C<E<gt>= 1.2, != 1.5, E<lt>
  2.0> indicates a version that must be B<at least> 1.2, B<less than> 2.0,
  and B<not equal to> 1.5.
  
  =head1 PREREQUISITES
  
  =head2 Prereq Spec
  
  The C<prereqs> key in the top-level metadata and within
  C<optional_features> define the relationship between a distribution and
  other packages.  The prereq spec structure is a hierarchical data
  structure which divides prerequisites into I<Phases> of activity in the
  installation process and I<Relationships> that indicate how
  prerequisites should be resolved.
  
  For example, to specify that C<Data::Dumper> is C<required> during the
  C<test> phase, this entry would appear in the distribution metadata:
  
    prereqs => {
      test => {
        requires => {
          'Data::Dumper' => '2.00'
        }
      }
    }
  
  =head3 Phases
  
  Requirements for regular use must be listed in the C<runtime> phase.
  Other requirements should be listed in the earliest stage in which they
  are required and consumers must accumulate and satisfy requirements
  across phases before executing the activity. For example, C<build>
  requirements must also be available during the C<test> phase.
  
    before action       requirements that must be met
    ----------------    --------------------------------
    perl Build.PL       configure
    perl Makefile.PL
  
    make                configure, runtime, build
    Build
  
    make test           configure, runtime, build, test
    Build test
  
  Consumers that install the distribution must ensure that
  I<runtime> requirements are also installed and may install
  dependencies from other phases.
  
    after action        requirements that must be met
    ----------------    --------------------------------
    make install        runtime
    Build install
  
  =over
  
  =item configure
  
  The configure phase occurs before any dynamic configuration has been
  attempted.  Libraries required by the configure phase B<must> be
  available for use before the distribution building tool has been
  executed.
  
  =item build
  
  The build phase is when the distribution's source code is compiled (if
  necessary) and otherwise made ready for installation.
  
  =item test
  
  The test phase is when the distribution's automated test suite is run.
  Any library that is needed only for testing and not for subsequent use
  should be listed here.
  
  =item runtime
  
  The runtime phase refers not only to when the distribution's contents
  are installed, but also to its continued use.  Any library that is a
  prerequisite for regular use of this distribution should be indicated
  here.
  
  =item develop
  
  The develop phase's prereqs are libraries needed to work on the
  distribution's source code as its author does.  These tools might be
  needed to build a release tarball, to run author-only tests, or to
  perform other tasks related to developing new versions of the
  distribution.
  
  =back
  
  =head3 Relationships
  
  =over
  
  =item requires
  
  These dependencies B<must> be installed for proper completion of the
  phase.
  
  =item recommends
  
  Recommended dependencies are I<strongly> encouraged and should be
  satisfied except in resource constrained environments.
  
  =item suggests
  
  These dependencies are optional, but are suggested for enhanced operation
  of the described distribution.
  
  =item conflicts
  
  These libraries cannot be installed when the phase is in operation.
  This is a very rare situation, and the C<conflicts> relationship should
  be used with great caution, or not at all.
  
  =back
  
  =head2 Merging and Resolving Prerequisites
  
  Whenever metadata consumers merge prerequisites, either from different
  phases or from C<optional_features>, they should merged in a way which
  preserves the intended semantics of the prerequisite structure.  Generally,
  this means concatenating the version specifications using commas, as
  described in the L<Version Ranges> section.
  
  Another subtle error that can occur in resolving prerequisites comes from
  the way that modules in prerequisites are indexed to distribution files on
  CPAN.  When a module is deleted from a distribution, prerequisites calling
  for that module could indicate an older distribution should installed,
  potentially overwriting files from a newer distribution.
  
  For example, as of Oct 31, 2009, the CPAN index file contained these
  module-distribution mappings:
  
    Class::MOP                   0.94  D/DR/DROLSKY/Class-MOP-0.94.tar.gz
    Class::MOP::Class            0.94  D/DR/DROLSKY/Class-MOP-0.94.tar.gz
    Class::MOP::Class::Immutable 0.04  S/ST/STEVAN/Class-MOP-0.36.tar.gz
  
  Consider the case where "Class::MOP" 0.94 is installed.  If a
  distribution specified "Class::MOP::Class::Immutable" as a prerequisite,
  it could result in Class-MOP-0.36.tar.gz being installed, overwriting
  any files from Class-MOP-0.94.tar.gz.
  
  Consumers of metadata B<should> test whether prerequisites would result
  in installed module files being "downgraded" to an older version and
  B<may> warn users or ignore the prerequisite that would cause such a
  result.
  
  =head1 SERIALIZATION
  
  Distribution metadata should be serialized (as a hashref) as
  JSON-encoded data and packaged with distributions as the file
  F<META.json>.
  
  In the past, the distribution metadata structure had been packed with
  distributions as F<META.yml>, a file in the YAML Tiny format (for which,
  see L<YAML::Tiny>).  Tools that consume distribution metadata from disk
  should be capable of loading F<META.yml>, but should prefer F<META.json>
  if both are found.
  
  =head1 NOTES FOR IMPLEMENTORS
  
  =head2 Extracting Version Numbers from Perl Modules
  
  To get the version number from a Perl module, consumers should use the
  C<< MM->parse_version($file) >> method provided by
  L<ExtUtils::MakeMaker> or L<Module::Metadata>.  For example, for the
  module given by C<$mod>, the version may be retrieved in one of the
  following ways:
  
    # via ExtUtils::MakeMaker
    my $file = MM->_installed_file_for_module($mod);
    my $version = MM->parse_version($file)
  
  The private C<_installed_file_for_module> method may be replaced with
  other methods for locating a module in C<@INC>.
  
    # via Module::Metadata
    my $info = Module::Metadata->new_from_module($mod);
    my $version = $info->version;
  
  If only a filename is available, the following approach may be used:
  
    # via Module::Build
    my $info = Module::Metadata->new_from_file($file);
    my $version = $info->version;
  
  =head2 Comparing Version Numbers
  
  The L<version> module provides the most reliable way to compare version
  numbers in all the various ways they might be provided or might exist
  within modules.  Given two strings containing version numbers, C<$v1> and
  C<$v2>, they should be converted to C<version> objects before using
  ordinary comparison operators.  For example:
  
    use version;
    if ( version->new($v1) <=> version->new($v2) ) {
      print "Versions are not equal\n";
    }
  
  If the only comparison needed is whether an installed module is of a
  sufficiently high version, a direct test may be done using the string
  form of C<eval> and the C<use> function.  For example, for module C<$mod>
  and version prerequisite C<$prereq>:
  
    if ( eval "use $mod $prereq (); 1" ) {
      print "Module $mod version is OK.\n";
    }
  
  If the values of C<$mod> and C<$prereq> have not been scrubbed, however,
  this presents security implications.
  
  =head1 SEE ALSO
  
  CPAN, L<http://www.cpan.org/>
  
  CPAN.pm, L<http://search.cpan.org/dist/CPAN/>
  
  CPANPLUS, L<http://search.cpan.org/dist/CPANPLUS/>
  
  ExtUtils::MakeMaker, L<http://search.cpan.org/dist/ExtUtils-MakeMaker/>
  
  Module::Build, L<http://search.cpan.org/dist/Module-Build/>
  
  Module::Install, L<http://search.cpan.org/dist/Module-Install/>
  
  JSON, L<http://json.org/>
  
  YAML, L<http://www.yaml.org/>
  
  =head1 CONTRIBUTORS
  
  Ken Williams wrote the original CPAN Meta Spec (also known as the
  "META.yml spec") in 2003 and maintained it through several revisions
  with input from various members of the community.  In 2005, Randy
  Sims redrafted it from HTML to POD for the version 1.2 release.  Ken
  continued to maintain the spec through version 1.4.
  
  In late 2009, David Golden organized the version 2 proposal review
  process.  David and Ricardo Signes drafted the final version 2 spec
  in April 2010 based on the version 1.4 spec and patches contributed
  during the proposal process.
  
  Several others have contributed patches over the years.  The full list
  of contributors in the repository history currently includes:
  
    2shortplanks
    Avar Arnfjord Bjarmason
    Christopher J. Madsen
    Damyan Ivanov
    David Golden
    Eric Wilhelm
    Ken Williams
    Lars DIECKOW
    Michael G. Schwern
    Randy Sims
    Ricardo Signes
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Ansgar Burchardt <ansgar@cpan.org>
  
  =item *
  
  Avar Arnfjord Bjarmason <avar@cpan.org>
  
  =item *
  
  Christopher J. Madsen <cjm@cpan.org>
  
  =item *
  
  Cory G Watson <gphat@cpan.org>
  
  =item *
  
  Damyan Ivanov <dam@cpan.org>
  
  =item *
  
  Eric Wilhelm <ewilhelm@cpan.org>
  
  =item *
  
  Gregor Hermann <gregoa@debian.org>
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Lars Dieckow <daxim@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =item *
  
  Mark Fowler <markf@cpan.org>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Randy Sims <randys@thepierianspring.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_SPEC

$fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Validator;
  our $VERSION = '2.131560'; # VERSION
  
  
  #--------------------------------------------------------------------------#
  # 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.php',
      '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;
  
  # ABSTRACT: validate CPAN distribution metadata structures
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  CPAN::Meta::Validator - validate CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.131560
  
  =head1 SYNOPSIS
  
    my $struct = decode_json_file('META.json');
  
    my $cmv = CPAN::Meta::Validator->new( $struct );
  
    unless ( $cmv->is_valid ) {
      my $msg = "Invalid META structure.  Errors found:\n";
      $msg .= join( "\n", $cmv->errors );
      die $msg;
    }
  
  =head1 DESCRIPTION
  
  This module validates a CPAN Meta structure against the version of the
  the specification claimed in the C<meta-spec> field of the structure.
  
  =head1 METHODS
  
  =head2 new
  
    my $cmv = CPAN::Meta::Validator->new( $struct )
  
  The constructor must be passed a metadata structure.
  
  =head2 is_valid
  
    if ( $cmv->is_valid ) {
      ...
    }
  
  Returns a boolean value indicating whether the metadata provided
  is valid.
  
  =head2 errors
  
    warn( join "\n", $cmv->errors );
  
  Returns a list of errors seen during validation.
  
  =begin :internals
  
  =head2 Check Methods
  
  =over
  
  =item *
  
  check_map($spec,$data)
  
  Checks whether a map (or hash) part of the data structure conforms to the
  appropriate specification definition.
  
  =item *
  
  check_list($spec,$data)
  
  Checks whether a list (or array) part of the data structure conforms to
  the appropriate specification definition.
  
  =item *
  
  check_lazylist($spec,$data)
  
  Checks whether a list conforms, but converts strings to a single-element list
  
  =back
  
  =head2 Validator Methods
  
  =over
  
  =item *
  
  header($self,$key,$value)
  
  Validates that the header is valid.
  
  Note: No longer used as we now read the data structure, not the file.
  
  =item *
  
  url($self,$key,$value)
  
  Validates that a given value is in an acceptable URL format
  
  =item *
  
  urlspec($self,$key,$value)
  
  Validates that the URL to a META specification is a known one.
  
  =item *
  
  string_or_undef($self,$key,$value)
  
  Validates that the value is either a string or an undef value. Bit of a
  catchall function for parts of the data structure that are completely user
  defined.
  
  =item *
  
  string($self,$key,$value)
  
  Validates that a string exists for the given key.
  
  =item *
  
  file($self,$key,$value)
  
  Validate that a file is passed for the given key. This may be made more
  thorough in the future. For now it acts like \&string.
  
  =item *
  
  exversion($self,$key,$value)
  
  Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
  
  =item *
  
  version($self,$key,$value)
  
  Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
  are both valid. A leading 'v' like 'v1.2.3' is also valid.
  
  =item *
  
  boolean($self,$key,$value)
  
  Validates for a boolean value. Currently these values are '1', '0', 'true',
  'false', however the latter 2 may be removed.
  
  =item *
  
  license($self,$key,$value)
  
  Validates that a value is given for the license. Returns 1 if an known license
  type, or 2 if a value is given but the license type is not a recommended one.
  
  =item *
  
  custom_1($self,$key,$value)
  
  Validates that the given key is in CamelCase, to indicate a user defined
  keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
  of the spec, this was only explicitly stated for 'resources'.
  
  =item *
  
  custom_2($self,$key,$value)
  
  Validates that the given key begins with 'x_' or 'X_', to indicate a user
  defined keyword and only has characters in the class [-_a-zA-Z]
  
  =item *
  
  identifier($self,$key,$value)
  
  Validates that key is in an acceptable format for the META specification,
  for an identifier, i.e. any that matches the regular expression
  qr/[a-z][a-z_]/i.
  
  =item *
  
  module($self,$key,$value)
  
  Validates that a given key is in an acceptable module name format, e.g.
  'Test::CPAN::Meta::Version'.
  
  =back
  
  =end :internals
  
  =for Pod::Coverage anything boolean check_lazylist check_list custom_1 custom_2 exversion file
  identifier license module phase relation release_status string string_or_undef
  url urlspec version header check_map
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Ansgar Burchardt <ansgar@cpan.org>
  
  =item *
  
  Avar Arnfjord Bjarmason <avar@cpan.org>
  
  =item *
  
  Christopher J. Madsen <cjm@cpan.org>
  
  =item *
  
  Cory G Watson <gphat@cpan.org>
  
  =item *
  
  Damyan Ivanov <dam@cpan.org>
  
  =item *
  
  Eric Wilhelm <ewilhelm@cpan.org>
  
  =item *
  
  Gregor Hermann <gregoa@debian.org>
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Lars Dieckow <daxim@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =item *
  
  Mark Fowler <markf@cpan.org>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Randy Sims <randys@thepierianspring.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_VALIDATOR

$fatpacked{"Carton.pm"} = <<'CARTON';
  package Carton;
  use strict;
  use 5.008_005;
  use version; our $VERSION = version->declare("v1.0.12");
  
  1;
  __END__
  
  =head1 NAME
  
  Carton - Perl module dependency manager (aka Bundler for Perl)
  
  =head1 SYNOPSIS
  
    # On your development environment
    > cat cpanfile
    requires 'Plack', '0.9980';
    requires 'Starman', '0.2000';
  
    > carton install
    > git add cpanfile cpanfile.snapshot
    > git commit -m "add Plack and Starman"
  
    # Other developer's machine, or on a deployment box
    > carton install
    > carton exec starman -p 8080 myapp.psgi
  
  =head1 AVAILABILITY
  
  Carton only works with perl installation with the complete set of core
  modules. If you use perl installed by a vendor package with modules
  stripped from core, Carton is not expected to work correctly.
  
  Also, Carton requires you to run your command/application with
  C<carton exec> command, which means it's difficult or impossible to
  run in an embedded perl use case such as mod_perl.
  
  =head1 DESCRIPTION
  
  carton is a command line tool to track the Perl module dependencies
  for your Perl application. Dependencies are declared using L<cpanfile>
  format, and the managed dependencies are tracked in a
  I<cpanfile.snapshot> file, which is meant to be version controlled,
  and the snapshot file allows other developers of your application will
  have the exact same versions of the modules.
  
  For C<cpanfile> syntax, see L<cpanfile> documentation.
  
  =head1 TUTORIAL
  
  =head2 Initializing the environment
  
  carton will use the I<local> directory to install modules into. You're
  recommended to exclude these directories from the version control
  system.
  
    > echo local/ >> .gitignore
    > git add cpanfile cpanfile.snapshot
    > git commit -m "Start using carton"
  
  =head2 Tracking the dependencies
  
  You can manage the dependencies of your application via C<cpanfile>.
  
    # cpanfile
    requires 'Plack', '0.9980';
    requires 'Starman', '0.2000';
  
  And then you can install these dependencies via:
  
    > carton install
  
  The modules are installed into your I<local> directory, and the
  dependencies tree and version information are analyzed and saved into
  I<cpanfile.snapshot> in your directory.
  
  Make sure you add I<cpanfile> and I<cpanfile.snapshot> to your version
  controlled repository and commit changes as you update
  dependencies. This will ensure that other developers on your app, as
  well as your deployment environment, use exactly the same versions of
  the modules you just installed.
  
    > git add cpanfile cpanfile.snapshot
    > git commit -m "Added Plack and Starman"
  
  =head2 Deploying your application
  
  Once you've done installing all the dependencies, you can push your
  application directory to a remote machine (excluding I<local> and
  I<.carton>) and run the following command:
  
    > carton install --deployment
  
  This will look at the I<cpanfile.snapshot> and install the exact same
  versions of the dependencies into I<local>, and now your application
  is ready to run.
  
  The C<--deployment> flag makes sure that carton will only install
  modules and versions available in your snapshot, and won't fallback to
  query for CPAN Meta DB for missing modules.
  
  =head2 Bundling modules
  
  carton can bundle all the tarballs for your dependencies into a
  directory so that you can even install dependencies that are not
  available on CPAN, such as internal distribution aka DarkPAN.
  
    > carton bundle
  
  will bundle these tarballs into I<vendor/cache> directory, and
  
    > carton install --cached
  
  will install modules using this local cache. Combined with
  C<--deployment> option, you can avoid querying for a database like
  CPAN Meta DB or downloading files from CPAN mirrors upon deployment
  time.
  
  =head1 PERL VERSIONS
  
  When you take a snapshot in one perl version and deploy on another
  (different) version, you might have troubles with core modules.
  
  The simplest solution, which might not work for everybody, is to use
  the same version of perl in the development and deployment.
  
  To enforce that, you're recommended to use L<plenv> and
  C<.perl-version> to lock perl versions in development.
  
  You can also specify the minimum perl required in C<cpanfile>:
  
    requires 'perl', '5.16.3';
  
  and carton (and cpanm) will give you errors when deployed on hosts
  with perl lower than the specified version.
  
  =head1 COMMUNITY
  
  =over 4
  
  =item L<https://github.com/miyagawa/carton>
  
  Code repository, Wiki and Issue Tracker
  
  =item L<irc://irc.perl.org/#carton>
  
  IRC chat room
  
  =back
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa
  
  =head1 COPYRIGHT
  
  Tatsuhiko Miyagawa 2011-
  
  =head1 LICENSE
  
  This software is licensed under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  L<cpanm>
  
  L<cpanfile>
  
  L<Bundler|http://gembundler.com/>
  
  L<pip|http://pypi.python.org/pypi/pip>
  
  L<npm|http://npmjs.org/>
  
  L<perlrocks|https://github.com/gugod/perlrocks>
  
  L<only>
  
  =cut
CARTON

$fatpacked{"Carton/Builder.pm"} = <<'CARTON_BUILDER';
  package Carton::Builder;
  use Moo;
  use warnings NONFATAL => 'all';
  no warnings 'once';
  
  has mirror  => (is => 'rw');
  has index   => (is => 'rw');
  has cascade => (is => 'rw', default => sub { 1 });
  has without => (is => 'rw', default => sub { [] });
  has cpanfile => (is => 'rw');
  has fatscript => (is => 'lazy');
  
  sub effective_mirrors {
      my $self = shift;
  
      # push default CPAN mirror always, as a fallback
      # TODO don't pass fallback if --cached is set?
  
      my @mirrors = ($self->mirror);
      push @mirrors, Carton::Mirror->default if $self->custom_mirror;
      push @mirrors, Carton::Mirror->new('http://backpan.perl.org/');
  
      @mirrors;
  }
  
  sub custom_mirror {
      my $self = shift;
      ! $self->mirror->is_default;
  }
  
  sub bundle {
      my($self, $path, $cache_path, $snapshot) = @_;
  
      for my $dist ($snapshot->distributions) {
          my $source = $path->child("cache/authors/id/" . $dist->pathname);
          my $target = $cache_path->child("authors/id/" . $dist->pathname);
  
          if ($source->exists) {
              warn "Copying ", $dist->pathname, "\n";
              $target->parent->mkpath;
              $source->copy($target) or warn "$target: $!";
          } else {
              warn "Couldn't find @{[ $dist->pathname ]}\n";
          }
      }
  }
  
  sub install {
      my($self, $path) = @_;
  
      $self->run_cpanm(
          "-L", $path,
          (map { ("--mirror", $_->url) } $self->effective_mirrors),
          ( $self->index ? ("--mirror-index", $self->index) : () ),
          ( $self->cascade ? "--cascade-search" : () ),
          ( $self->custom_mirror ? "--mirror-only" : () ),
          "--save-dists", "$path/cache",
          $self->groups,
          "--cpanfile", $self->cpanfile,
          "--installdeps", $self->cpanfile->dirname,
      ) or die "Installing modules failed\n";
  }
  
  sub groups {
      my $self = shift;
  
      # TODO support --without test (don't need test on deployment)
      my @options = ('--with-all-features', '--with-develop');
  
      for my $group (@{$self->without}) {
          push @options, '--without-develop' if $group eq 'develop';
          push @options, "--without-feature=$group";
      }
  
      return @options;
  }
  
  sub update {
      my($self, $path, @modules) = @_;
  
      $self->run_cpanm(
          "-L", $path,
          (map { ("--mirror", $_->url) } $self->effective_mirrors),
          ( $self->custom_mirror ? "--mirror-only" : () ),
          "--save-dists", "$path/cache",
          @modules
      ) or die "Updating modules failed\n";
  }
  
  sub _build_fatscript {
      my $self = shift;
  
      my $fatscript;
      if ($Carton::Fatpacked) {
          require Module::Reader;
          my $content = Module::Reader::module_content('App::cpanminus::fatscript')
              or die "Can't locate App::cpanminus::fatscript";
          $fatscript = Path::Tiny->tempfile;
          $fatscript->spew($content);
      } else {
          require Module::Metadata;
          $fatscript = Module::Metadata->find_module_by_name("App::cpanminus::fatscript")
              or die "Can't locate App::cpanminus::fatscript";
      }
  
      return $fatscript;
  }
  
  sub run_cpanm {
      my($self, @args) = @_;
      local $ENV{PERL_CPANM_OPT};
      !system $^X, $self->fatscript, "--quiet", "--notest", @args;
  }
  
  1;
CARTON_BUILDER

$fatpacked{"Carton/CLI.pm"} = <<'CARTON_CLI';
  package Carton::CLI;
  use Moo;
  use warnings NONFATAL => 'all';
  
  use Config;
  use Getopt::Long;
  use Path::Tiny;
  use Try::Tiny;
  use Module::CoreList;
  use Scalar::Util qw(blessed);
  
  use Carton;
  use Carton::Builder;
  use Carton::Mirror;
  use Carton::Snapshot;
  use Carton::Util;
  use Carton::Environment;
  use Carton::Error;
  
  use constant { SUCCESS => 0, INFO => 1, WARN => 2, ERROR => 3 };
  
  our $UseSystem = 0; # 1 for unit testing
  
  has verbose => (is => 'rw');
  has carton  => (is => 'lazy');
  has mirror  => (is => 'rw', builder => 1,
                  coerce => sub { Carton::Mirror->new($_[0]) });
  
  sub _build_mirror {
      my $self = shift;
      $ENV{PERL_CARTON_MIRROR} || $Carton::Mirror::DefaultMirror;
  }
  
  sub run {
      my($self, @args) = @_;
  
      my @commands;
      my $p = Getopt::Long::Parser->new(
          config => [ "no_ignore_case", "pass_through" ],
      );
      $p->getoptionsfromarray(
          \@args,
          "h|help"    => sub { unshift @commands, 'help' },
          "v|version" => sub { unshift @commands, 'version' },
          "verbose!"  => sub { $self->verbose($_[1]) },
      );
  
      push @commands, @args;
  
      my $cmd = shift @commands || 'install';
  
      my $code = try {
          my $call = $self->can("cmd_$cmd")
              or Carton::Error::CommandNotFound->throw(error => "Could not find command '$cmd'");
          $self->$call(@commands);
          return 0;
      } catch {
          die $_ unless blessed $_ && $_->can('rethrow');
  
          if ($_->isa('Carton::Error::CommandExit')) {
              return $_->code || 255;
          } elsif ($_->isa('Carton::Error::CommandNotFound')) {
              warn $_->error, "\n\n";
              $self->cmd_usage;
              return 255;
          } elsif ($_->isa('Carton::Error')) {
              warn $_->error, "\n";
              return 255;
          }
      };
  
      return $code;
  }
  
  sub commands {
      my $self = shift;
  
      no strict 'refs';
      map { s/^cmd_//; $_ }
          grep { /^cmd_.*/ && $self->can($_) } sort keys %{__PACKAGE__."::"};
  }
  
  sub cmd_usage {
      my $self = shift;
      $self->print(<<HELP);
  Usage: carton <command>
  
  where <command> is one of:
    @{[ join ", ", $self->commands ]}
  
  Run carton -h <command> for help.
  HELP
  }
  
  sub parse_options {
      my($self, $args, @spec) = @_;
      my $p = Getopt::Long::Parser->new(
          config => [ "no_auto_abbrev", "no_ignore_case" ],
      );
      $p->getoptionsfromarray($args, @spec);
  }
  
  sub parse_options_pass_through {
      my($self, $args, @spec) = @_;
  
      my $p = Getopt::Long::Parser->new(
          config => [ "no_auto_abbrev", "no_ignore_case", "pass_through" ],
      );
      $p->getoptionsfromarray($args, @spec);
  
      # with pass_through keeps -- in args
      shift @$args if $args->[0] && $args->[0] eq '--';
  }
  
  sub printf {
      my $self = shift;
      my $type = pop;
      my($temp, @args) = @_;
      $self->print(sprintf($temp, @args), $type);
  }
  
  sub print {
      my($self, $msg, $type) = @_;
      my $fh = $type && $type >= WARN ? *STDERR : *STDOUT;
      print {$fh} $msg;
  }
  
  sub error {
      my($self, $msg) = @_;
      $self->print($msg, ERROR);
      Carton::Error::CommandExit->throw;
  }
  
  sub cmd_help {
      my $self = shift;
      my $module = $_[0] ? ("Carton::Doc::" . ucfirst $_[0]) : "Carton.pm";
      system "perldoc", $module;
  }
  
  sub cmd_version {
      my $self = shift;
      $self->print("carton $Carton::VERSION\n");
  }
  
  sub cmd_bundle {
      my($self, @args) = @_;
  
      my $fatpack = 1;
      $self->parse_options(
          \@args,
          "fatpack!" => \$fatpack,
      );
  
      my $env = Carton::Environment->build;
      $env->snapshot->load;
  
      $self->print("Bundling modules using @{[$env->cpanfile]}\n");
  
      my $builder = Carton::Builder->new(
          mirror => $self->mirror,
          cpanfile => $env->cpanfile,
      );
      $builder->bundle($env->install_path, $env->vendor_cache, $env->snapshot);
  
      if ($fatpack) {
          require Carton::Packer;
          Carton::Packer->new->fatpack_carton($env->vendor_bin);
      }
  
      $self->printf("Complete! Modules were bundled into %s\n", $env->vendor_cache, SUCCESS);
  }
  
  sub cmd_install {
      my($self, @args) = @_;
  
      my($install_path, $cpanfile_path, @without);
  
      $self->parse_options(
          \@args,
          "p|path=s"    => \$install_path,
          "cpanfile=s"  => \$cpanfile_path,
          "without=s"   => sub { push @without, split /,/, $_[1] },
          "deployment!" => \my $deployment,
          "cached!"     => \my $cached,
      );
  
      my $env = Carton::Environment->build($cpanfile_path, $install_path);
      $env->snapshot->load_if_exists;
  
      if ($deployment && !$env->snapshot->loaded) {
          $self->error("--deployment requires cpanfile.snapshot: Run `carton install` and make sure cpanfile.snapshot is checked into your version control.\n");
      }
  
      my $builder = Carton::Builder->new(
          cascade => 1,
          mirror  => $self->mirror,
          without => \@without,
          cpanfile => $env->cpanfile,
      );
  
      # TODO: --without with no .lock won't fetch the groups, resulting in insufficient requirements
  
      if ($deployment) {
          $self->print("Installing modules using @{[$env->cpanfile]} (deployment mode)\n");
          $builder->cascade(0);
      } else {
          $self->print("Installing modules using @{[$env->cpanfile]}\n");
      }
  
      # TODO merge CPANfile git to mirror even if lock doesn't exist
      if ($env->snapshot->loaded) {
          my $index_file = $env->install_path->child("cache/modules/02packages.details.txt");
             $index_file->parent->mkpath;
  
          $env->snapshot->write_index($index_file);
          $builder->index($index_file);
      }
  
      if ($cached) {
          $builder->mirror(Carton::Mirror->new($env->vendor_cache));
      }
  
      $builder->install($env->install_path);
  
      unless ($deployment) {
          $env->cpanfile->load;
          $env->snapshot->find_installs($env->install_path, $env->cpanfile->requirements);
          $env->snapshot->save;
      }
  
      $self->print("Complete! Modules were installed into @{[$env->install_path]}\n", SUCCESS);
  }
  
  sub cmd_show {
      my($self, @args) = @_;
  
      my $env = Carton::Environment->build;
      $env->snapshot->load;
  
      for my $module (@args) {
          my $dist = $env->snapshot->find($module)
              or $self->error("Couldn't locate $module in cpanfile.snapshot\n");
          $self->print( $dist->name . "\n" );
      }
  }
  
  sub cmd_list {
      my($self, @args) = @_;
  
      my $format = 'name';
  
      $self->parse_options(
          \@args,
          "distfile" => sub { $format = 'distfile' },
      );
  
      my $env = Carton::Environment->build;
      $env->snapshot->load;
  
      for my $dist ($env->snapshot->distributions) {
          $self->print($dist->$format . "\n");
      }
  }
  
  sub cmd_tree {
      my($self, @args) = @_;
  
      my $env = Carton::Environment->build;
      $env->snapshot->load;
      $env->cpanfile->load;
  
      my %seen;
      my $dumper = sub {
          my($dependency, $reqs, $level) = @_;
          return if $level == 0;
          return Carton::Tree::STOP if $dependency->dist->is_core;
          return Carton::Tree::STOP if $seen{$dependency->distname}++;
          $self->printf( "%s%s (%s)\n", " " x ($level - 1), $dependency->module, $dependency->distname, INFO );
      };
  
      $env->tree->walk_down($dumper);
  }
  
  sub cmd_check {
      my($self, @args) = @_;
  
      my $cpanfile_path;
      $self->parse_options(
          \@args,
          "cpanfile=s"  => \$cpanfile_path,
      );
  
      my $env = Carton::Environment->build($cpanfile_path);
      $env->snapshot->load;
      $env->cpanfile->load;
  
      # TODO remove snapshot
      # TODO pass git spec to Requirements?
      my $merged_reqs = $env->tree->merged_requirements;
  
      my @missing;
      for my $module ($merged_reqs->required_modules) {
          my $install = $env->snapshot->find_or_core($module);
          if ($install) {
              unless ($merged_reqs->accepts_module($module => $install->version_for($module))) {
                  push @missing, [ $module, 1, $install->version_for($module) ];
              }
          } else {
              push @missing, [ $module, 0 ];
          }
      }
  
      if (@missing) {
          $self->print("Following dependencies are not satisfied.\n", INFO);
          for my $missing (@missing) {
              my($module, $unsatisfied, $version) = @$missing;
              if ($unsatisfied) {
                  $self->printf("  %s has version %s. Needs %s\n",
                                $module, $version, $merged_reqs->requirements_for_module($module), INFO);
              } else {
                  $self->printf("  %s is not installed. Needs %s\n",
                                $module, $merged_reqs->requirements_for_module($module), INFO);
              }
          }
          $self->printf("Run `carton install` to install them.\n", INFO);
          Carton::Error::CommandExit->throw;
      } else {
          $self->print("cpanfile's dependencies are satisfied.\n", INFO);
      }
  }
  
  sub cmd_update {
      my($self, @args) = @_;
  
      my $env = Carton::Environment->build;
      $env->cpanfile->load;
  
  
      my $cpanfile = Module::CPANfile->load($env->cpanfile);
      @args = grep { $_ ne 'perl' } $env->cpanfile->required_modules unless @args;
  
      $env->snapshot->load;
  
      my @modules;
      for my $module (@args) {
          my $dist = $env->snapshot->find_or_core($module)
              or $self->error("Could not find module $module.\n");
          next if $dist->is_core;
          push @modules, "$module~" . $env->cpanfile->requirements_for_module($module);
      }
  
      my $builder = Carton::Builder->new(
          mirror => $self->mirror,
          cpanfile => $env->cpanfile,
      );
      $builder->update($env->install_path, @modules);
  
      $env->snapshot->find_installs($env->install_path, $env->cpanfile->requirements);
      $env->snapshot->save;
  }
  
  sub cmd_exec {
      my($self, @args) = @_;
  
      my $env = Carton::Environment->build;
      $env->snapshot->load;
  
      # allows -Ilib
      @args = map { /^(-[I])(.+)/ ? ($1,$2) : $_ } @args;
  
      while (@args) {
          if ($args[0] eq '-I') {
              warn "exec -Ilib is deprecated. You might want to run: carton exec perl -Ilib ...\n";
              splice(@args, 0, 2);
          } else {
              last;
          }
      }
  
      $self->parse_options_pass_through(\@args); # to handle --
  
      unless (@args) {
          $self->error("carton exec needs a command to run.\n");
      }
  
      # PERL5LIB takes care of arch
      my $path = $env->install_path;
      local $ENV{PERL5LIB} = "$path/lib/perl5";
      local $ENV{PATH} = "$path/bin:$ENV{PATH}";
  
      $UseSystem ? system(@args) : exec(@args);
  }
  
  1;
CARTON_CLI

$fatpacked{"Carton/CPANfile.pm"} = <<'CARTON_CPANFILE';
  package Carton::CPANfile;
  use Moo;
  use warnings NONFATAL => 'all';
  use Path::Tiny ();
  use Module::CPANfile;
  
  use overload q{""} => sub { $_[0]->stringify }, fallback => 1;
  
  has path => (is => 'rw', coerce => sub { Path::Tiny->new($_[0]) }, handles => [ qw(stringify dirname) ]);
  has _cpanfile => (is => 'rw', handles => [ qw(prereqs) ]);
  has requirements => (is => 'rw', lazy => 1, builder => 1, handles => [ qw(required_modules requirements_for_module) ]);
  
  sub load {
      my $self = shift;
      $self->_cpanfile( Module::CPANfile->load($self->path) );
  }
  
  sub _build_requirements {
      my $self = shift;
      my $reqs = CPAN::Meta::Requirements->new;
      $reqs->add_requirements($self->prereqs->requirements_for($_, 'requires'))
          for qw( configure build runtime test develop );
      $reqs->clear_requirement('perl');
      $reqs;
  }
  
  1;
CARTON_CPANFILE

$fatpacked{"Carton/Dependency.pm"} = <<'CARTON_DEPENDENCY';
  package Carton::Dependency;
  use Moo;
  use warnings NONFATAL => 'all';
  
  has module => (is => 'rw');
  has requirement => (is => 'rw');
  has dist => (is => 'rw', handles => [ qw(requirements) ]);
  
  sub distname {
      my $self = shift;
      $self->dist->name;
  }
  
  sub version {
      my $self = shift;
      $self->dist->version_for($self->module);
  }
  
  1;
CARTON_DEPENDENCY

$fatpacked{"Carton/Dist.pm"} = <<'CARTON_DIST';
  package Carton::Dist;
  use Moo;
  use warnings NONFATAL => 'all';
  use CPAN::Meta;
  
  has name     => (is => 'ro');
  has pathname => (is => 'rw');
  has provides => (is => 'rw', default => sub { +{} });
  has requirements => (is => 'rw', lazy => 1, builder => 1,
                       handles => [ qw(add_string_requirement required_modules requirements_for_module) ]);
  
  sub is_core { 0 }
  
  sub distfile {
      my $self = shift;
      $self->pathname;
  }
  
  sub _build_requirements {
      CPAN::Meta::Requirements->new;
  }
  
  sub provides_module {
      my($self, $module) = @_;
      exists $self->provides->{$module};
  }
  
  sub version_for {
      my($self, $module) = @_;
      $self->provides->{$module}{version};
  }
  
  1;
CARTON_DIST

$fatpacked{"Carton/Dist/Core.pm"} = <<'CARTON_DIST_CORE';
  package Carton::Dist::Core;
  use Moo;
  use warnings NONFATAL => 'all';
  extends 'Carton::Dist';
  
  has module_version => (is => 'ro');
  
  sub BUILDARGS {
      my($class, %args) = @_;
  
      # TODO represent dual-life
      $args{name} =~ s/::/-/g;
  
      \%args;
  }
  
  sub is_core { 1 }
  
  sub version_for {
      my($self, $module) = @_;
      $self->module_version;
  }
  
  1;
CARTON_DIST_CORE

$fatpacked{"Carton/Environment.pm"} = <<'CARTON_ENVIRONMENT';
  package Carton::Environment;
  use Moo;
  use warnings NONFATAL => 'all';
  
  use Carton::CPANfile;
  use Carton::Snapshot;
  use Carton::Error;
  use Carton::Tree;
  use Path::Tiny;
  
  has cpanfile => (is => 'rw');
  has snapshot => (is => 'lazy');
  has install_path => (is => 'rw', lazy => 1, builder => 1, coerce => sub { Path::Tiny->new($_[0])->absolute });
  has vendor_cache  => (is => 'lazy');
  has tree => (is => 'rw', lazy => 1, builder => 1);
  
  sub _build_snapshot {
      my $self = shift;
      Carton::Snapshot->new(path => $self->cpanfile->stringify . ".snapshot");
  }
  
  sub _build_install_path {
      my $self = shift;
      if ($ENV{PERL_CARTON_PATH}) {
          return $ENV{PERL_CARTON_PATH};
      } else {
          return $self->cpanfile->dirname . "/local";
      }
  }
  
  sub _build_vendor_cache {
      my $self = shift;
      Path::Tiny->new($self->install_path->dirname . "/vendor/cache");
  }
  
  sub _build_tree {
      my $self = shift;
      Carton::Tree->new(cpanfile => $self->cpanfile, snapshot => $self->snapshot);
  }
  
  sub vendor_bin {
      my $self = shift;
      $self->vendor_cache->parent->child('bin');
  }
  
  sub build_with {
      my($class, $cpanfile) = @_;
  
      $cpanfile = Path::Tiny->new($cpanfile)->absolute;
      if ($cpanfile->is_file) {
          return $class->new(cpanfile => Carton::CPANfile->new(path => $cpanfile));
      } else {
          Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile: $cpanfile");
      }
  }
  
  sub build {
      my($class, $cpanfile_path, $install_path) = @_;
  
      my $self = $class->new;
  
      $cpanfile_path &&= Path::Tiny->new($cpanfile_path)->absolute;
  
      my $cpanfile = $self->locate_cpanfile($cpanfile_path || $ENV{PERL_CARTON_CPANFILE});
      if ($cpanfile && $cpanfile->is_file) {
          $self->cpanfile( Carton::CPANfile->new(path => $cpanfile) );
      } else {
          Carton::Error::CPANfileNotFound->throw(error => "Can't locate cpanfile: (@{[ $cpanfile_path || 'cpanfile' ]})");
      }
  
      $self->install_path($install_path) if $install_path;
  
      $self;
  }
  
  sub locate_cpanfile {
      my($self, $path) = @_;
  
      if ($path) {
          return Path::Tiny->new($path)->absolute;
      }
  
      my $current  = Path::Tiny->cwd;
      my $previous = '';
  
      until ($current eq '/' or $current eq $previous) {
          # TODO support PERL_CARTON_CPANFILE
          my $try = $current->child('cpanfile');
          if ($try->is_file) {
              return $try->absolute;
          }
  
          ($previous, $current) = ($current, $current->parent);
      }
  
      return;
  }
  
  1;
  
CARTON_ENVIRONMENT

$fatpacked{"Carton/Error.pm"} = <<'CARTON_ERROR';
  package Carton::Error;
  use strict;
  use Exception::Class (
      'Carton::Error',
      'Carton::Error::CommandNotFound' => { isa => 'Carton::Error' },
      'Carton::Error::CommandExit' => { isa => 'Carton::Error', fields => [ 'code' ] },
      'Carton::Error::CPANfileNotFound' => { isa => 'Carton::Error' },
      'Carton::Error::SnapshotParseError' => { isa => 'Carton::Error', fields => [ 'path' ] },
      'Carton::Error::SnapshotNotFound' => { isa => 'Carton::Error', fields => [ 'path' ] },
  );
  
  1;
CARTON_ERROR

$fatpacked{"Carton/Index.pm"} = <<'CARTON_INDEX';
  package Carton::Index;
  use Moo;
  use warnings NONFATAL => 'all';
  
  has _packages => (is => 'rw', default => sub { +{} });
  
  sub add_package {
      my($self, $package) = @_;
      $self->_packages->{$package->name} = $package; # XXX ||=
  }
  
  sub count {
      my $self = shift;
      scalar keys %{$self->_packages};
  }
  
  sub packages {
      my $self = shift;
      sort { $a->name cmp $b->name } values %{$self->_packages};
  }
  
  sub write {
      my($self, $fh) = @_;
  
      print $fh <<EOF;
  File:         02packages.details.txt
  URL:          http://www.perl.com/CPAN/modules/02packages.details.txt
  Description:  Package names found in cpanfile.snapshot
  Columns:      package name, version, path
  Intended-For: Automated fetch routines, namespace documentation.
  Written-By:   Carton $Carton::VERSION
  Line-Count:   @{[ $self->count ]}
  Last-Updated: @{[ scalar localtime ]}
  
  EOF
      for my $p ($self->packages) {
          print $fh sprintf "%s %s  %s\n", pad($p->name, 32), pad($p->version || 'undef', 10, 1), $p->pathname;
      }
  }
  
  sub pad {
      my($str, $len, $left) = @_;
  
      my $howmany = $len - length($str);
      return $str if $howmany <= 0;
  
      my $pad = " " x $howmany;
      return $left ? "$pad$str" : "$str$pad";
  }
  
  
  1;
CARTON_INDEX

$fatpacked{"Carton/Mirror.pm"} = <<'CARTON_MIRROR';
  package Carton::Mirror;
  use Moo;
  use warnings NONFATAL => 'all';
  
  our $DefaultMirror = 'http://cpan.metacpan.org/';
  
  has url => (is => 'ro');
  
  sub BUILDARGS {
      my($class, $url) = @_;
      return { url => $url };
  }
  
  sub default {
      my $class = shift;
      $class->new($DefaultMirror);
  }
  
  sub is_default {
      my $self = shift;
      $self->url eq $DefaultMirror;
  }
  
  1;
  
CARTON_MIRROR

$fatpacked{"Carton/Package.pm"} = <<'CARTON_PACKAGE';
  package Carton::Package;
  use Moo;
  use warnings NONFATAL => 'all';
  
  has name     => (is => 'ro');
  has version  => (is => 'ro');
  has pathname => (is => 'ro');
  
  sub BUILDARGS {
      my($class, @args) = @_;
      return { name => $args[0], version => $args[1], pathname => $args[2] };
  }
  
  1;
  
  
CARTON_PACKAGE

$fatpacked{"Carton/Packer.pm"} = <<'CARTON_PACKER';
  package Carton::Packer;
  use Moo;
  use warnings NONFATAL => 'all';
  use App::FatPacker;
  use File::pushd ();
  use Path::Tiny ();
  use CPAN::Meta ();
  use File::Find ();
  
  sub fatpack_carton {
      my($self, $dir) = @_;
  
      my $temp = Path::Tiny->tempdir;
      my $pushd = File::pushd::pushd $temp;
  
      my $file = $temp->child('carton.pre.pl');
  
      $file->spew(<<'EOF');
  #!/usr/bin/env perl
  use strict;
  use 5.008001;
  use Carton::CLI;
  $Carton::Fatpacked = 1;
  exit Carton::CLI->new->run(@ARGV);
  EOF
  
      my $fatpacked = $self->do_fatpack($file);
  
      my $executable = $dir->child('carton');
      warn "Bundling $executable\n";
  
      $dir->mkpath;
      $executable->spew($fatpacked);
      chmod 0755, $executable;
  }
  
  sub do_fatpack {
      my($self, $file) = @_;
  
      my $packer = App::FatPacker->new;
  
      my @modules = split /\r?\n/, $packer->trace(args => [$file], use => $self->required_modules);
      my @packlists = $packer->packlists_containing(\@modules);
      $packer->packlists_to_tree(Path::Tiny->new('fatlib')->absolute, \@packlists);
  
      my $fatpacked = do {
          local $SIG{__WARN__} = sub {};
          $packer->fatpack_file($file);
      };
  
      # HACK: File::Spec bundled into arch in < 5.16, but is loadable as pure-perl
      use Config;
      $fatpacked =~ s/\$fatpacked{"$Config{archname}\/(Cwd|File)/\$fatpacked{"$1/g;
  
      $fatpacked;
  }
  
  sub required_modules {
      my($self, $packer) = @_;
  
      my $meta = $self->installed_meta('Carton')
          or die "Couldn't find install metadata for Carton";
  
      my %excludes = (
          perl => 1,
          'ExtUtils::MakeMaker' => 1,
          'Module::Build' => 1,
      );
  
      my @requirements = grep !$excludes{$_},
          $meta->effective_prereqs->requirements_for('runtime', 'requires')->required_modules;
  
      return \@requirements;
  }
  
  sub installed_meta {
      my($self, $dist) = @_;
  
      my @meta;
      my $finder = sub {
          if (m!\b$dist-.*[\\/]MYMETA.json!) {
              my $meta = CPAN::Meta->load_file($_);
              push @meta, $meta if $meta->name eq $dist;
          }
      };
  
      File::Find::find({ wanted => $finder, no_chdir => 1 }, grep -d, map "$_/.meta", @INC);
  
      # return the latest version
      @meta = sort { version->new($b->version) cmp version->new($a->version) } @meta;
  
      return $meta[0];
  }
  
  1;
CARTON_PACKER

$fatpacked{"Carton/Snapshot.pm"} = <<'CARTON_SNAPSHOT';
  package Carton::Snapshot;
  use Moo;
  use warnings NONFATAL => 'all';
  use Config;
  use Carton::Dist;
  use Carton::Dist::Core;
  use Carton::Error;
  use Carton::Package;
  use Carton::Index;
  use Carton::Util;
  use Carton::Snapshot::Emitter;
  use Carton::Snapshot::Parser;
  use CPAN::Meta;
  use CPAN::Meta::Requirements;
  use File::Find ();
  use Try::Tiny;
  use Path::Tiny ();
  use Module::CoreList;
  
  use constant CARTON_SNAPSHOT_VERSION => '1.0';
  
  has path    => (is => 'rw', coerce => sub { Path::Tiny->new($_[0]) });
  has version => (is => 'rw', default => sub { CARTON_SNAPSHOT_VERSION });
  has loaded  => (is => 'rw');
  has _distributions => (is => 'rw', default => sub { +[] });
  
  sub load_if_exists {
      my $self = shift;
      $self->load if $self->path->is_file;
  }
  
  sub load {
      my $self = shift;
  
      return 1 if $self->loaded;
  
      if ($self->path->is_file) {
          my $parser = Carton::Snapshot::Parser->new;
          $parser->parse($self->path->slurp_utf8, $self);
          $self->loaded(1);
  
          return 1;
      } else {
          Carton::Error::SnapshotNotFound->throw(
              error => "Can't find cpanfile.snapshot: Run `carton install` to build the snapshot file.",
              path => $self->path,
          );
      }
  }
  
  sub save {
      my $self = shift;
      $self->path->spew_utf8( Carton::Snapshot::Emitter->new->emit($self) );
  }
  
  sub find {
      my($self, $module) = @_;
      (grep $_->provides_module($module), $self->distributions)[0];
  }
  
  sub find_or_core {
      my($self, $module) = @_;
      $self->find($module) || $self->find_in_core($module);
  }
  
  sub find_in_core {
      my($self, $module) = @_;
  
      if (exists $Module::CoreList::version{$]}{$module}) {
          my $version = $Module::CoreList::version{$]}{$module}; # maybe undef
          return Carton::Dist::Core->new(name => $module, module_version => $version);
      }
  
      return;
  }
  
  sub index {
      my $self = shift;
  
      my $index = Carton::Index->new;
      for my $package ($self->packages) {
          $index->add_package($package);
      }
  
      return $index;
  }
  
  sub distributions {
      @{$_[0]->_distributions};
  }
  
  sub add_distribution {
      my($self, $dist) = @_;
      push @{$self->_distributions}, $dist;
  }
  
  sub packages {
      my $self = shift;
  
      my @packages;
      for my $dist ($self->distributions) {
          while (my($package, $provides) = each %{$dist->provides}) {
              # TODO what if duplicates?
              push @packages, Carton::Package->new($package, $provides->{version}, $dist->pathname);
          }
      }
  
      return @packages;
  }
  
  sub write_index {
      my($self, $file) = @_;
  
      open my $fh, ">", $file or die $!;
      $self->index->write($fh);
  }
  
  sub find_installs {
      my($self, $path, $reqs) = @_;
  
      my $libdir = "$path/lib/perl5/$Config{archname}/.meta";
      return {} unless -e $libdir;
  
      my @installs;
      my $wanted = sub {
          if ($_ eq 'install.json') {
              push @installs, [ $File::Find::name, "$File::Find::dir/MYMETA.json" ];
          }
      };
      File::Find::find($wanted, $libdir);
  
      my %installs;
  
      my $accepts = sub {
          my $module = shift;
  
          return 0 unless $reqs->accepts_module($module->{name}, $module->{provides}{$module->{name}}{version});
  
          if (my $exist = $installs{$module->{name}}) {
              my $old_ver = version->new($exist->{provides}{$module->{name}}{version});
              my $new_ver = version->new($module->{provides}{$module->{name}}{version});
              return $new_ver >= $old_ver;
          } else {
              return 1;
          }
      };
  
      for my $file (@installs) {
          my $module = Carton::Util::load_json($file->[0]);
          my $prereqs = -f $file->[1] ? CPAN::Meta->load_file($file->[1])->effective_prereqs : CPAN::Meta::Prereqs->new;
  
          my $reqs = CPAN::Meta::Requirements->new;
          $reqs->add_requirements($prereqs->requirements_for($_, 'requires'))
            for qw( configure build runtime );
  
          if ($accepts->($module)) {
              $installs{$module->{name}} = Carton::Dist->new(
                  name => $module->{dist},
                  pathname => $module->{pathname},
                  provides => $module->{provides},
                  version => $module->{version},
                  requirements => $reqs,
              );
          }
      }
  
      my @new_dists;
      for my $module (sort keys %installs) {
          push @new_dists, $installs{$module};
      }
  
      $self->_distributions(\@new_dists);
  }
  
  1;
CARTON_SNAPSHOT

$fatpacked{"Carton/Snapshot/Emitter.pm"} = <<'CARTON_SNAPSHOT_EMITTER';
  package Carton::Snapshot::Emitter;
  use Moo;
  use warnings NONFATAL => 'all';
  
  sub emit {
      my($self, $snapshot) = @_;
  
      my $data = '';
      $data .= "# carton snapshot format: version @{[$snapshot->version]}\n";
      $data .= "DISTRIBUTIONS\n";
  
      for my $dist (sort { $a->name cmp $b->name } $snapshot->distributions) {
          $data .= "  @{[$dist->name]}\n";
          $data .= "    pathname: @{[$dist->pathname]}\n";
  
          $data .= "    provides:\n";
          for my $package (sort keys %{$dist->provides}) {
              $data .= "      $package @{[$dist->provides->{$package}{version} || 'undef' ]}\n";
          }
  
          $data .= "    requirements:\n";
          for my $module (sort $dist->required_modules) {
              $data .= "      $module @{[ $dist->requirements_for_module($module) || '0' ]}\n";
          }
      }
  
      $data;
  }
  
  1;
CARTON_SNAPSHOT_EMITTER

$fatpacked{"Carton/Snapshot/Parser.pm"} = <<'CARTON_SNAPSHOT_PARSER';
  package Carton::Snapshot::Parser;
  use Moo;
  use warnings NONFATAL => 'all';
  use Carton::Dist;
  use Carton::Error;
  
  my $machine = {
      init => [
          {
              re => qr/^\# carton snapshot format: version (1\.0)/,
              code => sub {
                  my($stash, $snapshot, $ver) = @_;
                  $snapshot->version($ver);
              },
              goto => 'section',
          },
          # TODO support pasing error and version mismatch etc.
      ],
      section => [
          {
              re => qr/^DISTRIBUTIONS$/,
              goto => 'dists',
          },
          {
              re => qr/^__EOF__$/,
              done => 1,
          },
      ],
      dists => [
          {
              re => qr/^  (\S+)$/,
              code => sub { $_[0]->{dist} = Carton::Dist->new(name => $1) },
              goto => 'distmeta',
          },
          {
              re => qr/^\S/,
              goto => 'section',
              redo => 1,
          },
      ],
      distmeta => [
          {
              re => qr/^    pathname: (.*)$/,
              code => sub { $_[0]->{dist}->pathname($1) },
          },
          {
              re => qr/^\s{4}provides:$/,
              code => sub { $_[0]->{property} = 'provides' },
              goto => 'properties',
          },
          {
              re => qr/^\s{4}requirements:$/,
              code => sub {
                  $_[0]->{property} = 'requirements';
              },
              goto => 'properties',
          },
          {
              re => qr/^\s{0,2}\S/,
              code => sub {
                  my($stash, $snapshot) = @_;
                  $snapshot->add_distribution($stash->{dist});
                  %$stash = (); # clear
              },
              goto => 'dists',
              redo => 1,
          },
      ],
      properties => [
          {
              re => qr/^\s{6}([0-9A-Za-z_:]+) ([v0-9\._,=\!<>\s]+|undef)/,
              code => sub {
                  my($stash, $snapshot, $module, $version) = @_;
  
                  if ($stash->{property} eq 'provides') {
                      $stash->{dist}->provides->{$module} = { version => $version };
                  } else {
                      $stash->{dist}->add_string_requirement($module, $version);
                  }
              },
          },
          {
              re => qr/^\s{0,4}\S/,
              goto => 'distmeta',
              redo => 1,
          },
      ],
  };
  
  sub parse {
      my($self, $data, $snapshot) = @_;
  
      my @lines = split /\r?\n/, $data;
  
      my $state = $machine->{init};
      my $stash = {};
  
      LINE:
      for my $line (@lines, '__EOF__') {
          last LINE unless @$state;
  
      STATE: {
              for my $trans (@{$state}) {
                  if (my @match = $line =~ $trans->{re}) {
                      if (my $code = $trans->{code}) {
                          $code->($stash, $snapshot, @match);
                      }
                      if (my $goto = $trans->{goto}) {
                          $state = $machine->{$goto};
                          if ($trans->{redo}) {
                              redo STATE;
                          } else {
                              next LINE;
                          }
                      }
  
                      last STATE;
                  }
              }
  
              Carton::Error::SnapshotParseError->throw(error => "Could not parse snapshot file.");
          }
      }
  }
  
  1;
CARTON_SNAPSHOT_PARSER

$fatpacked{"Carton/Tree.pm"} = <<'CARTON_TREE';
  package Carton::Tree;
  use Moo;
  use warnings NONFATAL => 'all';
  use Carton::Dependency;
  
  has cpanfile => (is => 'ro');
  has snapshot => (is => 'ro');
  
  use constant STOP => -1;
  
  sub walk_down {
      my($self, $cb) = @_;
  
      my $dumper; $dumper = sub {
          my($dependency, $reqs, $level, $parent) = @_;
  
          my $ret = $cb->($dependency, $reqs, $level);
          return if $ret && $ret == STOP;
  
          local $parent->{$dependency->distname} = 1 if $dependency;
  
          for my $module (sort $reqs->required_modules) {
              my $dependency = $self->dependency_for($module, $reqs);
              if ($dependency->dist) {
                  next if $parent->{$dependency->distname};
                  $dumper->($dependency, $dependency->requirements, $level + 1, $parent);
              } else {
                  # no dist found in lock
              }
          }
      };
  
      $dumper->(undef, $self->cpanfile->requirements, 0, {});
      undef $dumper;
  }
  
  sub dependency_for {
      my($self, $module, $reqs) = @_;
  
      my $requirement = $reqs->requirements_for_module($module);
  
      my $dep = Carton::Dependency->new;
      $dep->module($module);
      $dep->requirement($requirement);
  
      if (my $dist = $self->snapshot->find_or_core($module)) {
          $dep->dist($dist);
      }
  
      return $dep;
  }
  
  sub merged_requirements {
      my $self = shift;
  
      my $merged_reqs = CPAN::Meta::Requirements->new;
  
      my %seen;
      $self->walk_down(sub {
          my($dependency, $reqs, $level) = @_;
          return Carton::Tree::STOP if $dependency && $seen{$dependency->distname}++;
          $merged_reqs->add_requirements($reqs);
      });
  
      $merged_reqs->clear_requirement('perl');
      $merged_reqs->finalize;
  
      $merged_reqs;
  }
  
  1;
CARTON_TREE

$fatpacked{"Carton/Util.pm"} = <<'CARTON_UTIL';
  package Carton::Util;
  use strict;
  use warnings;
  
  sub load_json {
      my $file = shift;
  
      open my $fh, "<", $file or die "$file: $!";
      from_json(join '', <$fh>);
  }
  
  sub dump_json {
      my($data, $file) = @_;
  
      open my $fh, ">", $file or die "$file: $!";
      binmode $fh;
      print $fh to_json($data);
  }
  
  sub from_json {
      require JSON;
      JSON::decode_json(@_);
  }
  
  sub to_json {
      my($data) = @_;
      require JSON;
      JSON->new->utf8->pretty->canonical->encode($data);
  }
  
  1;
CARTON_UTIL

$fatpacked{"Class/Data/Inheritable.pm"} = <<'CLASS_DATA_INHERITABLE';
  package Class::Data::Inheritable;
  
  use strict qw(vars subs);
  use vars qw($VERSION);
  $VERSION = '0.08';
  
  sub mk_classdata {
      my ($declaredclass, $attribute, $data) = @_;
  
      if( ref $declaredclass ) {
          require Carp;
          Carp::croak("mk_classdata() is a class method, not an object method");
      }
  
      my $accessor = sub {
          my $wantclass = ref($_[0]) || $_[0];
  
          return $wantclass->mk_classdata($attribute)->(@_)
            if @_>1 && $wantclass ne $declaredclass;
  
          $data = $_[1] if @_>1;
          return $data;
      };
  
      my $alias = "_${attribute}_accessor";
      *{$declaredclass.'::'.$attribute} = $accessor;
      *{$declaredclass.'::'.$alias}     = $accessor;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Class::Data::Inheritable - Inheritable, overridable class data
  
  =head1 SYNOPSIS
  
    package Stuff;
    use base qw(Class::Data::Inheritable);
  
    # Set up DataFile as inheritable class data.
    Stuff->mk_classdata('DataFile');
  
    # Declare the location of the data file for this class.
    Stuff->DataFile('/etc/stuff/data');
  
    # Or, all in one shot:
    Stuff->mk_classdata(DataFile => '/etc/stuff/data');
  
  =head1 DESCRIPTION
  
  Class::Data::Inheritable is for creating accessor/mutators to class
  data.  That is, if you want to store something about your class as a
  whole (instead of about a single object).  This data is then inherited
  by your subclasses and can be overriden.
  
  For example:
  
    Pere::Ubu->mk_classdata('Suitcase');
  
  will generate the method Suitcase() in the class Pere::Ubu.
  
  This new method can be used to get and set a piece of class data.
  
    Pere::Ubu->Suitcase('Red');
    $suitcase = Pere::Ubu->Suitcase;
  
  The interesting part happens when a class inherits from Pere::Ubu:
  
    package Raygun;
    use base qw(Pere::Ubu);
    
    # Raygun's suitcase is Red.
    $suitcase = Raygun->Suitcase;
  
  Raygun inherits its Suitcase class data from Pere::Ubu.
  
  Inheritance of class data works analogous to method inheritance.  As
  long as Raygun does not "override" its inherited class data (by using
  Suitcase() to set a new value) it will continue to use whatever is set
  in Pere::Ubu and inherit further changes:
  
    # Both Raygun's and Pere::Ubu's suitcases are now Blue
    Pere::Ubu->Suitcase('Blue');
  
  However, should Raygun decide to set its own Suitcase() it has now
  "overridden" Pere::Ubu and is on its own, just like if it had
  overriden a method:
  
    # Raygun has an orange suitcase, Pere::Ubu's is still Blue.
    Raygun->Suitcase('Orange');
  
  Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu
  no longer effect Raygun.
  
    # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
    Pere::Ubu->Suitcase('Samsonite');
  
  =head1 Methods
  
  =head2 mk_classdata
  
    Class->mk_classdata($data_accessor_name);
    Class->mk_classdata($data_accessor_name => $value);
  
  This is a class method used to declare new class data accessors.
  A new accessor will be created in the Class using the name from
  $data_accessor_name, and optionally initially setting it to the given
  value.
  
  To facilitate overriding, mk_classdata creates an alias to the
  accessor, _field_accessor().  So Suitcase() would have an alias
  _Suitcase_accessor() that does the exact same thing as Suitcase().
  This is useful if you want to alter the behavior of a single accessor
  yet still get the benefits of inheritable class data.  For example.
  
    sub Suitcase {
        my($self) = shift;
        warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
  
        $self->_Suitcase_accessor(@_);
    }
  
  =head1 AUTHOR
  
  Original code by Damian Conway.
  
  Maintained by Michael G Schwern until September 2005.
  
  Now maintained by Tony Bowden.
  
  =head1 BUGS and QUERIES
  
  Please direct all correspondence regarding this module to:
    bug-Class-Data-Inheritable@rt.cpan.org
  
  =head1 COPYRIGHT and LICENSE
  
  Copyright (c) 2000-2005, Damian Conway and Michael G Schwern. 
  All Rights Reserved.  
  
  This module is free software. It may be used, redistributed and/or
  modified under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  L<perltooc> has a very elaborate discussion of class data in Perl.
  
CLASS_DATA_INHERITABLE

$fatpacked{"Devel/GlobalDestruction.pm"} = <<'DEVEL_GLOBALDESTRUCTION';
  package Devel::GlobalDestruction;
  
  use strict;
  use warnings;
  
  our $VERSION = '0.11';
  
  use Sub::Exporter::Progressive -setup => {
    exports => [ qw(in_global_destruction) ],
    groups  => { default => [ -all ] },
  };
  
  # we run 5.14+ - everything is in core
  #
  if (defined ${^GLOBAL_PHASE}) {
    eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1'
      or die $@;
  }
  # try to load the xs version if it was compiled
  #
  elsif (eval {
    require Devel::GlobalDestruction::XS;
    no warnings 'once';
    *in_global_destruction = \&Devel::GlobalDestruction::XS::in_global_destruction;
    1;
  }) {
    # the eval already installed everything, nothing to do
  }
  else {
    # internally, PL_main_start is nulled immediately before entering global destruction
    # and we can use B to detect that.  It will also be null before the main runloop starts,
    # so we check install a CHECK if needed to detect that.
    require B;
    my $started = !B::main_start()->isa(q[B::NULL]);
    unless ($started) {
      # work around 5.6 eval bug
      eval '0 && $started; CHECK { $started = 1 }; 1'
        or die $@;
    }
    eval '0 && $started; sub in_global_destruction () { $started && B::main_start()->isa(q[B::NULL]) }; 1'
      or die $@;
  }
  
  1;  # keep require happy
  
  
  __END__
  
  =head1 NAME
  
  Devel::GlobalDestruction - Provides function returning the equivalent of
  C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls.
  
  =head1 SYNOPSIS
  
      package Foo;
      use Devel::GlobalDestruction;
  
      use namespace::clean; # to avoid having an "in_global_destruction" method
  
      sub DESTROY {
          return if in_global_destruction;
  
          do_something_a_little_tricky();
      }
  
  =head1 DESCRIPTION
  
  Perl's global destruction is a little tricky to deal with WRT finalizers
  because it's not ordered and objects can sometimes disappear.
  
  Writing defensive destructors is hard and annoying, and usually if global
  destruction is happenning you only need the destructors that free up non
  process local resources to actually execute.
  
  For these constructors you can avoid the mess by simply bailing out if global
  destruction is in effect.
  
  =head1 EXPORTS
  
  This module uses L<Sub::Exporter::Progressive> so the exports may be renamed,
  aliased, etc. if L<Sub::Exporter> is present.
  
  =over 4
  
  =item in_global_destruction
  
  Returns true if the interpreter is in global destruction. In perl 5.14+, this
  returns C<${^GLOBAL_PHASE} eq 'DESTRUCT'>, and on earlier perls, detects it using
  the value of C<PL_main_start> or C<PL_dirty>.
  
  =back
  
  =head1 AUTHORS
  
  Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
  
  Florian Ragwitz E<lt>rafl@debian.orgE<gt>
  
  Jesse Luehrs E<lt>doy@tozt.netE<gt>
  
  Peter Rabbitson E<lt>ribasushi@cpan.orgE<gt>
  
  Arthur Axel 'fREW' Schmidt E<lt>frioux@gmail.comE<gt>
  
  Elizabeth Mattijsen E<lt>liz@dijkmat.nlE<gt>
  
  Greham Knop E<lt>haarg@haarg.orgE<gt>
  
  =head1 COPYRIGHT
  
      Copyright (c) 2008 Yuval Kogman. All rights reserved
      This program is free software; you can redistribute
      it and/or modify it under the same terms as Perl itself.
  
  =cut
DEVEL_GLOBALDESTRUCTION

$fatpacked{"Devel/StackTrace.pm"} = <<'DEVEL_STACKTRACE';
  package Devel::StackTrace;
  {
    $Devel::StackTrace::VERSION = '1.30';
  }
  
  use 5.006;
  
  use strict;
  use warnings;
  
  use Devel::StackTrace::Frame;
  use File::Spec;
  use Scalar::Util qw( blessed );
  
  use overload
      '""'     => \&as_string,
      fallback => 1;
  
  sub new {
      my $class = shift;
      my %p     = @_;
  
      # Backwards compatibility - this parameter was renamed to no_refs
      # ages ago.
      $p{no_refs} = delete $p{no_object_refs}
          if exists $p{no_object_refs};
  
      my $self = bless {
          index  => undef,
          frames => [],
          raw    => [],
          %p,
      }, $class;
  
      $self->_record_caller_data();
  
      return $self;
  }
  
  sub _record_caller_data {
      my $self = shift;
  
      # We exclude this method by starting one frame back.
      my $x = 1;
      while (
          my @c
          = $self->{no_args}
          ? caller( $x++ )
          : do {
              package    # the newline keeps dzil from adding a version here
                  DB;
              @DB::args = ();
              caller( $x++ );
          }
          ) {
  
          my @args;
  
          unless ( $self->{no_args} ) {
              @args = @DB::args;
  
              if ( $self->{no_refs} ) {
                  @args = map { ref $_ ? $self->_ref_to_string($_) : $_ } @args;
              }
          }
  
          push @{ $self->{raw} },
              {
              caller => \@c,
              args   => \@args,
              };
      }
  }
  
  sub _ref_to_string {
      my $self = shift;
      my $ref  = shift;
  
      return overload::AddrRef($ref)
          if blessed $ref && $ref->isa('Exception::Class::Base');
  
      return overload::AddrRef($ref) unless $self->{respect_overload};
  
      local $@;
      local $SIG{__DIE__};
  
      my $str = eval { $ref . '' };
  
      return $@ ? overload::AddrRef($ref) : $str;
  }
  
  sub _make_frames {
      my $self = shift;
  
      my $filter = $self->_make_frame_filter;
  
      my $raw = delete $self->{raw};
      for my $r ( @{$raw} ) {
          next unless $filter->($r);
  
          $self->_add_frame( $r->{caller}, $r->{args} );
      }
  }
  
  my $default_filter = sub { 1 };
  
  sub _make_frame_filter {
      my $self = shift;
  
      my ( @i_pack_re, %i_class );
      if ( $self->{ignore_package} ) {
          local $@;
          local $SIG{__DIE__};
  
          $self->{ignore_package} = [ $self->{ignore_package} ]
              unless eval { @{ $self->{ignore_package} } };
  
          @i_pack_re
              = map { ref $_ ? $_ : qr/^\Q$_\E$/ } @{ $self->{ignore_package} };
      }
  
      my $p = __PACKAGE__;
      push @i_pack_re, qr/^\Q$p\E$/;
  
      if ( $self->{ignore_class} ) {
          $self->{ignore_class} = [ $self->{ignore_class} ]
              unless ref $self->{ignore_class};
          %i_class = map { $_ => 1 } @{ $self->{ignore_class} };
      }
  
      my $user_filter = $self->{frame_filter};
  
      return sub {
          return 0 if grep { $_[0]{caller}[0] =~ /$_/ } @i_pack_re;
          return 0 if grep { $_[0]{caller}[0]->isa($_) } keys %i_class;
  
          if ($user_filter) {
              return $user_filter->( $_[0] );
          }
  
          return 1;
      };
  }
  
  sub _add_frame {
      my $self = shift;
      my $c    = shift;
      my $p    = shift;
  
      # eval and is_require are only returned when applicable under 5.00503.
      push @$c, ( undef, undef ) if scalar @$c == 6;
  
      push @{ $self->{frames} },
          Devel::StackTrace::Frame->new(
          $c,
          $p,
          $self->{respect_overload},
          $self->{max_arg_length},
          $self->{message},
          $self->{indent}
          );
  }
  
  sub next_frame {
      my $self = shift;
  
      # reset to top if necessary.
      $self->{index} = -1 unless defined $self->{index};
  
      my @f = $self->frames();
      if ( defined $f[ $self->{index} + 1 ] ) {
          return $f[ ++$self->{index} ];
      }
      else {
          $self->{index} = undef;
          return undef;
      }
  }
  
  sub prev_frame {
      my $self = shift;
  
      my @f = $self->frames();
  
      # reset to top if necessary.
      $self->{index} = scalar @f unless defined $self->{index};
  
      if ( defined $f[ $self->{index} - 1 ] && $self->{index} >= 1 ) {
          return $f[ --$self->{index} ];
      }
      else {
          $self->{index} = undef;
          return undef;
      }
  }
  
  sub reset_pointer {
      my $self = shift;
  
      $self->{index} = undef;
  }
  
  sub frames {
      my $self = shift;
  
      if (@_) {
          die
              "Devel::StackTrace->frames() can only take Devel::StackTrace::Frame args\n"
              if grep { !$_->isa('Devel::StackTrace::Frame') } @_;
  
          $self->{frames} = \@_;
      }
      else {
          $self->_make_frames() if $self->{raw};
      }
  
      return @{ $self->{frames} };
  }
  
  sub frame {
      my $self = shift;
      my $i    = shift;
  
      return unless defined $i;
  
      return ( $self->frames() )[$i];
  }
  
  sub frame_count {
      my $self = shift;
  
      return scalar( $self->frames() );
  }
  
  sub as_string {
      my $self = shift;
      my $p    = shift;
  
      my $st    = '';
      my $first = 1;
      foreach my $f ( $self->frames() ) {
          $st .= $f->as_string( $first, $p ) . "\n";
          $first = 0;
      }
  
      return $st;
  }
  
  {
      package
          Devel::StackTraceFrame;
  
      our @ISA = 'Devel::StackTrace::Frame';
  }
  
  1;
  
  # ABSTRACT: An object representing a stack trace
  
  __END__
  
  =pod
  
  =head1 NAME
  
  Devel::StackTrace - An object representing a stack trace
  
  =head1 VERSION
  
  version 1.30
  
  =head1 SYNOPSIS
  
    use Devel::StackTrace;
  
    my $trace = Devel::StackTrace->new;
  
    print $trace->as_string; # like carp
  
    # from top (most recent) of stack to bottom.
    while (my $frame = $trace->next_frame) {
        print "Has args\n" if $frame->hasargs;
    }
  
    # from bottom (least recent) of stack to top.
    while (my $frame = $trace->prev_frame) {
        print "Sub: ", $frame->subroutine, "\n";
    }
  
  =head1 DESCRIPTION
  
  The Devel::StackTrace module contains two classes, Devel::StackTrace
  and Devel::StackTrace::Frame.  The goal of this object is to encapsulate
  the information that can found through using the caller() function, as
  well as providing a simple interface to this data.
  
  The Devel::StackTrace object contains a set of Devel::StackTrace::Frame
  objects, one for each level of the stack.  The frames contain all the
  data available from C<caller()>.
  
  This code was created to support my L<Exception::Class::Base> class
  (part of Exception::Class) but may be useful in other contexts.
  
  =head1 'TOP' AND 'BOTTOM' OF THE STACK
  
  When describing the methods of the trace object, I use the words 'top'
  and 'bottom'.  In this context, the 'top' frame on the stack is the
  most recent frame and the 'bottom' is the least recent.
  
  Here's an example:
  
    foo();  # bottom frame is here
  
    sub foo {
       bar();
    }
  
    sub bar {
       Devel::StackTrace->new;  # top frame is here.
    }
  
  =head1 Devel::StackTrace METHODS
  
  =over 4
  
  =item * Devel::StackTrace->new(%named_params)
  
  Returns a new Devel::StackTrace object.
  
  Takes the following parameters:
  
  =over 8
  
  =item * frame_filter => $sub
  
  By default, Devel::StackTrace will include all stack frames before the
  call to its its constructor.
  
  However, you may want to filter out some frames with more granularity
  than 'ignore_package' or 'ignore_class' allow.
  
  You can provide a subroutine which is called with the raw frame data
  for each frame. This is a hash reference with two keys, "caller", and
  "args", both of which are array references. The "caller" key is the
  raw data as returned by Perl's C<caller()> function, and the "args"
  key are the subroutine arguments found in C<@DB::args>.
  
  The filter should return true if the frame should be included, or
  false if it should be skipped.
  
  =item * ignore_package => $package_name OR \@package_names
  
  Any frames where the package is one of these packages will not be on
  the stack.
  
  =item * ignore_class => $package_name OR \@package_names
  
  Any frames where the package is a subclass of one of these packages
  (or is the same package) will not be on the stack.
  
  Devel::StackTrace internally adds itself to the 'ignore_package'
  parameter, meaning that the Devel::StackTrace package is B<ALWAYS>
  ignored.  However, if you create a subclass of Devel::StackTrace it
  will not be ignored.
  
  =item * no_refs => $boolean
  
  If this parameter is true, then Devel::StackTrace will not store
  references internally when generating stacktrace frames.  This lets
  your objects go out of scope.
  
  Devel::StackTrace replaces any references with their stringified
  representation.
  
  =item * no_args => $boolean
  
  If this parameter is true, then Devel::StackTrace will not store caller
  arguments in stack trace frames at all.
  
  =item * respect_overload => $boolean
  
  By default, Devel::StackTrace will call C<overload::AddrRef()> to get
  the underlying string representation of an object, instead of
  respecting the object's stringification overloading.  If you would
  prefer to see the overloaded representation of objects in stack
  traces, then set this parameter to true.
  
  =item * max_arg_length => $integer
  
  By default, Devel::StackTrace will display the entire argument for each
  subroutine call. Setting this parameter causes truncates each subroutine
  argument's string representation if it is longer than this number of
  characters.
  
  =item * message => $string
  
  By default, Devel::StackTrace will use 'Trace begun' as the message for the
  first stack frame when you call C<as_string>. You can supply an alternative
  message using this option.
  
  =item * indent => $boolean
  
  If this parameter is true, each stack frame after the first will start with a
  tab character, just like C<Carp::confess()>.
  
  =back
  
  =item * $trace->next_frame
  
  Returns the next Devel::StackTrace::Frame object down on the stack.  If
  it hasn't been called before it returns the first frame.  It returns
  undef when it reaches the bottom of the stack and then resets its
  pointer so the next call to C<next_frame> or C<prev_frame> will work
  properly.
  
  =item * $trace->prev_frame
  
  Returns the next Devel::StackTrace::Frame object up on the stack.  If it
  hasn't been called before it returns the last frame.  It returns undef
  when it reaches the top of the stack and then resets its pointer so
  pointer so the next call to C<next_frame> or C<prev_frame> will work
  properly.
  
  =item * $trace->reset_pointer
  
  Resets the pointer so that the next call C<next_frame> or
  C<prev_frame> will start at the top or bottom of the stack, as
  appropriate.
  
  =item * $trace->frames
  
  When this method is called with no arguments, it returns a list of
  L<Devel::StackTrace::Frame> objects. They are returned in order from top (most
  recent) to bottom.
  
  This method can also be used to set the object's frames if you pass it a list
  of L<Devel::StackTrace::Frame> objects objects.
  
  This is useful if you want to filter the list of frames in ways that are more
  complex than can be handled by C<filter_frames>:
  
    $stacktrace->frames( my_filter( $stacktrace->frames() ) );
  
  =item * $trace->frame ($index)
  
  Given an index, returns the relevant frame or undef if there is not
  frame at that index.  The index is exactly like a Perl array.  The
  first frame is 0 and negative indexes are allowed.
  
  =item * $trace->frame_count
  
  Returns the number of frames in the trace object.
  
  =item * $trace->as_string(\%p)
  
  Calls as_string on each frame from top to bottom, producing output
  quite similar to the Carp module's cluck/confess methods.
  
  The optional C<\%p> parameter only has one useful option. The
  C<max_arg_length> parameter truncates each subroutine argument's string
  representation if it is longer than this number of characters.
  
  =back
  
  =head1 SUPPORT
  
  Please submit bugs to the CPAN RT system at
  http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel%3A%3AStackTrace
  or via email at bug-devel-stacktrace@rt.cpan.org.
  
  =head1 AUTHOR
  
  Dave Rolsky <autarch@urth.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2012 by Dave Rolsky.
  
  This is free software, licensed under:
  
    The Artistic License 2.0 (GPL Compatible)
  
  =cut
DEVEL_STACKTRACE

$fatpacked{"Devel/StackTrace/Frame.pm"} = <<'DEVEL_STACKTRACE_FRAME';
  package Devel::StackTrace::Frame;
  {
    $Devel::StackTrace::Frame::VERSION = '1.30';
  }
  
  use strict;
  use warnings;
  
  # Create accessor routines
  BEGIN {
      no strict 'refs';
      foreach my $f (
          qw( package filename line subroutine hasargs
          wantarray evaltext is_require hints bitmask args )
          ) {
          next if $f eq 'args';
          *{$f} = sub { my $s = shift; return $s->{$f} };
      }
  }
  
  {
      my @fields = (
          qw( package filename line subroutine hasargs wantarray
              evaltext is_require hints bitmask )
      );
  
      sub new {
          my $proto = shift;
          my $class = ref $proto || $proto;
  
          my $self = bless {}, $class;
  
          @{$self}{@fields} = @{ shift() };
  
          # fixup unix-style paths on win32
          $self->{filename} = File::Spec->canonpath( $self->{filename} );
  
          $self->{args} = shift;
  
          $self->{respect_overload} = shift;
  
          $self->{max_arg_length} = shift;
  
          $self->{message} = shift;
  
          $self->{indent} = shift;
  
          return $self;
      }
  }
  
  sub args {
      my $self = shift;
  
      return @{ $self->{args} };
  }
  
  sub as_string {
      my $self  = shift;
      my $first = shift;
      my $p     = shift;
  
      my $sub = $self->subroutine;
  
      # This code stolen straight from Carp.pm and then tweaked.  All
      # errors are probably my fault  -dave
      if ($first) {
          $sub
              = defined $self->{message}
              ? $self->{message}
              : 'Trace begun';
      }
      else {
  
          # Build a string, $sub, which names the sub-routine called.
          # This may also be "require ...", "eval '...' or "eval {...}"
          if ( my $eval = $self->evaltext ) {
              if ( $self->is_require ) {
                  $sub = "require $eval";
              }
              else {
                  $eval =~ s/([\\\'])/\\$1/g;
                  $sub = "eval '$eval'";
              }
          }
          elsif ( $sub eq '(eval)' ) {
              $sub = 'eval {...}';
          }
  
          # if there are any arguments in the sub-routine call, format
          # them according to the format variables defined earlier in
          # this file and join them onto the $sub sub-routine string
          #
          # We copy them because they're going to be modified.
          #
          if ( my @a = $self->args ) {
              for (@a) {
  
                  # set args to the string "undef" if undefined
                  $_ = "undef", next unless defined $_;
  
                  # hack!
                  $_ = $self->Devel::StackTrace::_ref_to_string($_)
                      if ref $_;
  
                  local $SIG{__DIE__};
                  local $@;
  
                  eval {
                      my $max_arg_length
                          = exists $p->{max_arg_length}
                          ? $p->{max_arg_length}
                          : $self->{max_arg_length};
  
                      if ( $max_arg_length
                          && length $_ > $max_arg_length ) {
                          substr( $_, $max_arg_length ) = '...';
                      }
  
                      s/'/\\'/g;
  
                      # 'quote' arg unless it looks like a number
                      $_ = "'$_'" unless /^-?[\d.]+$/;
  
                      # print control/high ASCII chars as 'M-<char>' or '^<char>'
                      s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
                      s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
                  };
  
                  if ( my $e = $@ ) {
                      $_ = $e =~ /malformed utf-8/i ? '(bad utf-8)' : '?';
                  }
              }
  
              # append ('all', 'the', 'arguments') to the $sub string
              $sub .= '(' . join( ', ', @a ) . ')';
              $sub .= ' called';
          }
      }
  
      # If the user opted into indentation (a la Carp::confess), pre-add a tab
      my $tab = $self->{indent} && !$first ? "\t" : q{};
  
      return "${tab}$sub at " . $self->filename . ' line ' . $self->line;
  }
  
  1;
  
  # ABSTRACT: A single frame in a stack trace
  
  __END__
  
  =pod
  
  =head1 NAME
  
  Devel::StackTrace::Frame - A single frame in a stack trace
  
  =head1 VERSION
  
  version 1.30
  
  =head1 DESCRIPTION
  
  See L<Devel::StackTrace> for details.
  
  =head1 METHODS
  
  See the L<caller> documentation for more information on what these
  methods return.
  
  =over 4
  
  =item * $frame->package
  
  =item * $frame->filename
  
  =item * $frame->line
  
  =item * $frame->subroutine
  
  =item * $frame->hasargs
  
  =item * $frame->wantarray
  
  =item * $frame->evaltext
  
  Returns undef if the frame was not part of an eval.
  
  =item * $frame->is_require
  
  Returns undef if the frame was not part of a require.
  
  =item * $frame->args
  
  Returns the arguments passed to the frame.  Note that any arguments
  that are references are returned as references, not copies.
  
  =item * $frame->hints
  
  =item * $frame->bitmask
  
  =back
  
  =head1 AUTHOR
  
  Dave Rolsky <autarch@urth.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2012 by Dave Rolsky.
  
  This is free software, licensed under:
  
    The Artistic License 2.0 (GPL Compatible)
  
  =cut
DEVEL_STACKTRACE_FRAME

$fatpacked{"Exception/Class.pm"} = <<'EXCEPTION_CLASS';
  package Exception::Class;
  {
    $Exception::Class::VERSION = '1.36';
  }
  
  use 5.008001;
  
  use strict;
  
  use Exception::Class::Base;
  use Scalar::Util qw(blessed);
  
  our $BASE_EXC_CLASS;
  BEGIN { $BASE_EXC_CLASS ||= 'Exception::Class::Base'; }
  
  our %CLASSES;
  
  sub import {
      my $class = shift;
  
      local $Exception::Class::Caller = caller();
  
      my %c;
  
      my %needs_parent;
      while ( my $subclass = shift ) {
          my $def = ref $_[0] ? shift : {};
          $def->{isa}
              = $def->{isa}
              ? ( ref $def->{isa} ? $def->{isa} : [ $def->{isa} ] )
              : [];
  
          $c{$subclass} = $def;
      }
  
      # We need to sort by length because if we check for keys in the
      # Foo::Bar:: stash, this creates a "Bar::" key in the Foo:: stash!
  MAKE_CLASSES:
      foreach my $subclass ( sort { length $a <=> length $b } keys %c ) {
          my $def = $c{$subclass};
  
          # We already made this one.
          next if $CLASSES{$subclass};
  
          {
              no strict 'refs';
              foreach my $parent ( @{ $def->{isa} } ) {
                  unless ( keys %{"$parent\::"} ) {
                      $needs_parent{$subclass} = {
                          parents => $def->{isa},
                          def     => $def
                      };
                      next MAKE_CLASSES;
                  }
              }
          }
  
          $class->_make_subclass(
              subclass => $subclass,
              def      => $def || {},
          );
      }
  
      foreach my $subclass ( keys %needs_parent ) {
  
          # This will be used to spot circular references.
          my %seen;
          $class->_make_parents( \%needs_parent, $subclass, \%seen );
      }
  }
  
  sub _make_parents {
      my $class    = shift;
      my $needs    = shift;
      my $subclass = shift;
      my $seen     = shift;
      my $child    = shift;    # Just for error messages.
  
      no strict 'refs';
  
      # What if someone makes a typo in specifying their 'isa' param?
      # This should catch it.  Either it's been made because it didn't
      # have missing parents OR it's in our hash as needing a parent.
      # If neither of these is true then the _only_ place it is
      # mentioned is in the 'isa' param for some other class, which is
      # not a good enough reason to make a new class.
      die
          "Class $subclass appears to be a typo as it is only specified in the 'isa' param for $child\n"
          unless exists $needs->{$subclass}
          || $CLASSES{$subclass}
          || keys %{"$subclass\::"};
  
      foreach my $c ( @{ $needs->{$subclass}{parents} } ) {
  
          # It's been made
          next if $CLASSES{$c} || keys %{"$c\::"};
  
          die "There appears to be some circularity involving $subclass\n"
              if $seen->{$subclass};
  
          $seen->{$subclass} = 1;
  
          $class->_make_parents( $needs, $c, $seen, $subclass );
      }
  
      return if $CLASSES{$subclass} || keys %{"$subclass\::"};
  
      $class->_make_subclass(
          subclass => $subclass,
          def      => $needs->{$subclass}{def}
      );
  }
  
  sub _make_subclass {
      my $class = shift;
      my %p     = @_;
  
      my $subclass = $p{subclass};
      my $def      = $p{def};
  
      my $isa;
      if ( $def->{isa} ) {
          $isa = ref $def->{isa} ? join ' ', @{ $def->{isa} } : $def->{isa};
      }
      $isa ||= $BASE_EXC_CLASS;
  
      my $version_name = 'VERSION';
  
      my $code = <<"EOPERL";
  package $subclass;
  
  use base qw($isa);
  
  our \$$version_name = '1.1';
  
  1;
  
  EOPERL
  
      if ( $def->{description} ) {
          ( my $desc = $def->{description} ) =~ s/([\\\'])/\\$1/g;
          $code .= <<"EOPERL";
  sub description
  {
      return '$desc';
  }
  EOPERL
      }
  
      my @fields;
      if ( my $fields = $def->{fields} ) {
          @fields = UNIVERSAL::isa( $fields, 'ARRAY' ) ? @$fields : $fields;
  
          $code
              .= "sub Fields { return (\$_[0]->SUPER::Fields, "
              . join( ", ", map { "'$_'" } @fields )
              . ") }\n\n";
  
          foreach my $field (@fields) {
              $code .= sprintf( "sub %s { \$_[0]->{%s} }\n", $field, $field );
          }
      }
  
      if ( my $alias = $def->{alias} ) {
          die "Cannot make alias without caller"
              unless defined $Exception::Class::Caller;
  
          no strict 'refs';
          *{"$Exception::Class::Caller\::$alias"}
              = sub { $subclass->throw(@_) };
      }
  
      if ( my $defaults = $def->{defaults} ) {
          $code
              .= "sub _defaults { return shift->SUPER::_defaults, our \%_DEFAULTS }\n";
          no strict 'refs';
          *{"$subclass\::_DEFAULTS"} = {%$defaults};
      }
  
      eval $code;
  
      die $@ if $@;
  
      $CLASSES{$subclass} = 1;
  }
  
  sub caught {
      my $e = $@;
  
      return $e unless $_[1];
  
      return unless blessed($e) && $e->isa( $_[1] );
      return $e;
  }
  
  sub Classes { sort keys %Exception::Class::CLASSES }
  
  1;
  
  # ABSTRACT: A module that allows you to declare real exception classes in Perl
  
  __END__
  
  =pod
  
  =head1 NAME
  
  Exception::Class - A module that allows you to declare real exception classes in Perl
  
  =head1 VERSION
  
  version 1.36
  
  =head1 SYNOPSIS
  
    use Exception::Class (
        'MyException',
  
        'AnotherException' => { isa => 'MyException' },
  
        'YetAnotherException' => {
            isa         => 'AnotherException',
            description => 'These exceptions are related to IPC'
        },
  
        'ExceptionWithFields' => {
            isa    => 'YetAnotherException',
            fields => [ 'grandiosity', 'quixotic' ],
            alias  => 'throw_fields',
        },
    );
  
    # try
    eval { MyException->throw( error => 'I feel funny.' ) };
  
    my $e;
  
    # catch
    if ( $e = Exception::Class->caught('MyException') ) {
        warn $e->error, "\n", $e->trace->as_string, "\n";
        warn join ' ', $e->euid, $e->egid, $e->uid, $e->gid, $e->pid, $e->time;
  
        exit;
    }
    elsif ( $e = Exception::Class->caught('ExceptionWithFields') ) {
        $e->quixotic ? do_something_wacky() : do_something_sane();
    }
    else {
        $e = Exception::Class->caught();
        ref $e ? $e->rethrow : die $e;
    }
  
    # use an alias - without parens subroutine name is checked at
    # compile time
    throw_fields error => "No strawberry", grandiosity => "quite a bit";
  
  =head1 DESCRIPTION
  
  Exception::Class allows you to declare exception hierarchies in your
  modules in a "Java-esque" manner.
  
  It features a simple interface allowing programmers to 'declare'
  exception classes at compile time.  It also has a base exception
  class, L<Exception::Class::Base>, that can be easily extended.
  
  It is designed to make structured exception handling simpler and
  better by encouraging people to use hierarchies of exceptions in their
  applications, as opposed to a single catch-all exception class.
  
  This module does not implement any try/catch syntax.  Please see the
  "OTHER EXCEPTION MODULES (try/catch syntax)" section for more
  information on how to get this syntax.
  
  You will also want to look at the documentation for
  L<Exception::Class::Base>, which is the default base class for all
  exception objects created by this module.
  
  =head1 DECLARING EXCEPTION CLASSES
  
  Importing C<Exception::Class> allows you to automagically create
  L<Exception::Class::Base> subclasses.  You can also create subclasses
  via the traditional means of defining your own subclass with C<@ISA>.
  These two methods may be easily combined, so that you could subclass
  an exception class defined via the automagic import, if you desired
  this.
  
  The syntax for the magic declarations is as follows:
  
  'MANDATORY CLASS NAME' => \%optional_hashref
  
  The hashref may contain the following options:
  
  =over 4
  
  =item * isa
  
  This is the class's parent class.  If this isn't provided then the
  class name in C<$Exception::Class::BASE_EXC_CLASS> is assumed to be
  the parent (see below).
  
  This parameter lets you create arbitrarily deep class hierarchies.
  This can be any other L<Exception::Class::Base> subclass in your
  declaration I<or> a subclass loaded from a module.
  
  To change the default exception class you will need to change the
  value of C<$Exception::Class::BASE_EXC_CLASS> I<before> calling
  C<import()>.  To do this simply do something like this:
  
    BEGIN { $Exception::Class::BASE_EXC_CLASS = 'SomeExceptionClass'; }
  
  If anyone can come up with a more elegant way to do this please let me
  know.
  
  CAVEAT: If you want to automagically subclass an
  L<Exception::Class::Base> subclass loaded from a file, then you
  I<must> compile the class (via use or require or some other magic)
  I<before> you import C<Exception::Class> or you'll get a compile time
  error.
  
  =item * fields
  
  This allows you to define additional attributes for your exception
  class.  Any field you define can be passed to the C<throw()> or
  C<new()> methods as additional parameters for the constructor.  In
  addition, your exception object will have an accessor method for the
  fields you define.
  
  This parameter can be either a scalar (for a single field) or an array
  reference if you need to define multiple fields.
  
  Fields will be inherited by subclasses.
  
  =item * alias
  
  Specifying an alias causes this class to create a subroutine of the
  specified name in the I<caller's> namespace.  Calling this subroutine
  is equivalent to calling C<< <class>->throw(@_) >> for the given
  exception class.
  
  Besides convenience, using aliases also allows for additional compile
  time checking.  If the alias is called I<without parentheses>, as in
  C<throw_fields "an error occurred">, then Perl checks for the
  existence of the C<throw_fields()> subroutine at compile time.  If
  instead you do C<< ExceptionWithFields->throw(...) >>, then Perl
  checks the class name at runtime, meaning that typos may sneak
  through.
  
  =item * description
  
  Each exception class has a description method that returns a fixed
  string.  This should describe the exception I<class> (as opposed to
  any particular exception object).  This may be useful for debugging if
  you start catching exceptions you weren't expecting (particularly if
  someone forgot to document them) and you don't understand the error
  messages.
  
  =back
  
  The C<Exception::Class> magic attempts to detect circular class
  hierarchies and will die if it finds one.  It also detects missing
  links in a chain, for example if you declare Bar to be a subclass of
  Foo and never declare Foo.
  
  =head1 Catching Exceptions
  
  C<Exception::Class> provides some syntactic sugar for catching
  exceptions in a safe manner:
  
    eval {...};
  
    if ( my $e = Exception::Class->caught('My::Error') ) {
        cleanup();
        do_something_with_exception($e);
    }
  
  The C<caught()> method takes a class name and returns an exception
  object if the last thrown exception is of the given class, or a
  subclass of that class.  If it is not given any arguments, it simply
  returns C<$@>.
  
  You should B<always> make a copy of the exception object, rather than
  using C<$@> directly.  This is necessary because if your C<cleanup()>
  function uses C<eval>, or calls something which uses it, then C<$@> is
  overwritten.  Copying the exception preserves it for the call to
  C<do_something_with_exception()>.
  
  Exception objects also provide a caught method so you can write:
  
    if ( my $e = My::Error->caught() ) {
        cleanup();
        do_something_with_exception($e);
    }
  
  =head2 Uncatchable Exceptions
  
  Internally, the C<caught()> method will call C<isa()> on the exception
  object.  You could make an exception "uncatchable" by overriding
  C<isa()> in that class like this:
  
   package Exception::Uncatchable;
  
   sub isa { shift->rethrow }
  
  Of course, this only works if you always call C<< Exception::Class->caught()
  >> after an C<eval>.
  
  =head1 USAGE RECOMMENDATION
  
  If you're creating a complex system that throws lots of different
  types of exceptions, consider putting all the exception declarations
  in one place.  For an app called Foo you might make a
  C<Foo::Exceptions> module and use that in all your code.  This module
  could just contain the code to make C<Exception::Class> do its
  automagic class creation.  Doing this allows you to more easily see
  what exceptions you have, and makes it easier to keep track of them.
  
  This might look something like this:
  
    package Foo::Bar::Exceptions;
  
    use Exception::Class (
        Foo::Bar::Exception::Senses =>
            { description => 'sense-related exception' },
  
        Foo::Bar::Exception::Smell => {
            isa         => 'Foo::Bar::Exception::Senses',
            fields      => 'odor',
            description => 'stinky!'
        },
  
        Foo::Bar::Exception::Taste => {
            isa         => 'Foo::Bar::Exception::Senses',
            fields      => [ 'taste', 'bitterness' ],
            description => 'like, gag me with a spoon!'
        },
  
        ...
    );
  
  You may want to create a real module to subclass
  L<Exception::Class::Base> as well, particularly if you want your
  exceptions to have more methods.
  
  =head2 Subclassing Exception::Class::Base
  
  As part of your usage of C<Exception::Class>, you may want to create
  your own base exception class which subclasses
  L<Exception::Class::Base>.  You should feel free to subclass any of
  the methods documented above.  For example, you may want to subclass
  C<new()> to add additional information to your exception objects.
  
  =head1 Exception::Class FUNCTIONS
  
  The C<Exception::Class> method offers one function, C<Classes()>,
  which is not exported.  This method returns a list of the classes that
  have been created by calling the C<Exception::Class> import() method.
  Note that this is I<all> the subclasses that have been created, so it
  may include subclasses created by things like CPAN modules, etc.  Also
  note that if you simply define a subclass via the normal Perl method
  of setting C<@ISA> or C<use base>, then your subclass will not be
  included.
  
  =head1 Try::Tiny
  
  If you are interested in adding try/catch/finally syntactic sugar to your code
  then I recommend you check out L<Try::Tiny>. This is a great module that helps
  you ignore some of the weirdness with C<eval> and C<$@>.
  
  =head1 SUPPORT
  
  Please submit bugs to the CPAN RT system at
  http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Exception%3A%3AClass or
  via email at bug-exception-class@rt.cpan.org.
  
  =head1 DONATIONS
  
  If you'd like to thank me for the work I've done on this module,
  please consider making a "donation" to me via PayPal. I spend a lot of
  free time creating free software, and would appreciate any support
  you'd care to offer.
  
  Please note that B<I am not suggesting that you must do this> in order
  for me to continue working on this particular software. I will
  continue to do so, inasmuch as I have in the past, for as long as it
  interests me.
  
  Similarly, a donation made in this way will probably not make me work
  on this software much more, unless I get so many donations that I can
  consider working on free software full time, which seems unlikely at
  best.
  
  To donate, log into PayPal and send money to autarch@urth.org or use
  the button on this page:
  L<http://www.urth.org/~autarch/fs-donation.html>
  
  =head1 AUTHOR
  
  Dave Rolsky <autarch@urth.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2010 by Dave Rolsky.
  
  This is free software, licensed under:
  
    The Artistic License 2.0 (GPL Compatible)
  
  =cut
EXCEPTION_CLASS

$fatpacked{"Exception/Class/Base.pm"} = <<'EXCEPTION_CLASS_BASE';
  package Exception::Class::Base;
  {
    $Exception::Class::Base::VERSION = '1.36';
  }
  
  use strict;
  use warnings;
  
  use Class::Data::Inheritable 0.02;
  use Devel::StackTrace 1.20;
  use Scalar::Util qw( blessed );
  
  use base qw(Class::Data::Inheritable);
  
  BEGIN {
      __PACKAGE__->mk_classdata('Trace');
      __PACKAGE__->mk_classdata('NoRefs');
      __PACKAGE__->NoRefs(1);
  
      __PACKAGE__->mk_classdata('NoContextInfo');
      __PACKAGE__->NoContextInfo(0);
  
      __PACKAGE__->mk_classdata('RespectOverload');
      __PACKAGE__->RespectOverload(0);
  
      __PACKAGE__->mk_classdata('MaxArgLength');
      __PACKAGE__->MaxArgLength(0);
  
      sub Fields { () }
  }
  
  use overload
  
      # an exception is always true
      bool => sub { 1 }, '""' => 'as_string', fallback => 1;
  
  # Create accessor routines
  BEGIN {
      my @fields = qw( message pid uid euid gid egid time trace );
  
      foreach my $f (@fields) {
          my $sub = sub { my $s = shift; return $s->{$f}; };
  
          no strict 'refs';
          *{$f} = $sub;
      }
      *error = \&message;
  
      my %trace_fields = (
          package => 'package',
          file    => 'filename',
          line    => 'line',
      );
  
      while ( my ( $f, $m ) = each %trace_fields ) {
          my $sub = sub {
              my $s = shift;
              return $s->{$f} if exists $s->{$f};
  
              my $frame = $s->trace->frame(0);
  
              return $s->{$f} = $frame ? $frame->$m() : undef;
          };
          no strict 'refs';
          *{$f} = $sub;
      }
  }
  
  1;
  
  sub Classes { Exception::Class::Classes() }
  
  sub throw {
      my $proto = shift;
  
      $proto->rethrow if ref $proto;
  
      die $proto->new(@_);
  }
  
  sub rethrow {
      my $self = shift;
  
      die $self;
  }
  
  sub new {
      my $proto = shift;
      my $class = ref $proto || $proto;
  
      my $self = bless {}, $class;
  
      $self->_initialize(@_);
  
      return $self;
  }
  
  sub _initialize {
      my $self = shift;
      my %p = @_ == 1 ? ( error => $_[0] ) : @_;
  
      $self->{message} = $p{message} || $p{error} || '';
  
      $self->{show_trace} = $p{show_trace} if exists $p{show_trace};
  
      if ( $self->NoContextInfo() ) {
          $self->{show_trace} = 0;
          $self->{package} = $self->{file} = $self->{line} = undef;
      }
      else {
          # CORE::time is important to fix an error with some versions of
          # Perl
          $self->{time} = CORE::time();
          $self->{pid}  = $$;
          $self->{uid}  = $<;
          $self->{euid} = $>;
          $self->{gid}  = $(;
          $self->{egid} = $);
  
          my @ignore_class   = (__PACKAGE__);
          my @ignore_package = 'Exception::Class';
  
          if ( my $i = delete $p{ignore_class} ) {
              push @ignore_class, ( ref($i) eq 'ARRAY' ? @$i : $i );
          }
  
          if ( my $i = delete $p{ignore_package} ) {
              push @ignore_package, ( ref($i) eq 'ARRAY' ? @$i : $i );
          }
  
          $self->{trace} = Devel::StackTrace->new(
              ignore_class     => \@ignore_class,
              ignore_package   => \@ignore_package,
              no_refs          => $self->NoRefs,
              respect_overload => $self->RespectOverload,
              max_arg_length   => $self->MaxArgLength,
          );
      }
  
      my %fields = map { $_ => 1 } $self->Fields;
      while ( my ( $key, $value ) = each %p ) {
          next if $key =~ /^(?:error|message|show_trace)$/;
  
          if ( $fields{$key} ) {
              $self->{$key} = $value;
          }
          else {
              Exception::Class::Base->throw(
                  error => "unknown field $key passed to constructor for class "
                      . ref $self );
          }
      }
  }
  
  sub description {
      return 'Generic exception';
  }
  
  sub show_trace {
      my $self = shift;
  
      return 0 unless $self->{trace};
  
      if (@_) {
          $self->{show_trace} = shift;
      }
  
      return exists $self->{show_trace} ? $self->{show_trace} : $self->Trace;
  }
  
  sub as_string {
      my $self = shift;
  
      my $str = $self->full_message;
      $str .= "\n\n" . $self->trace->as_string
          if $self->show_trace;
  
      return $str;
  }
  
  sub full_message { $_[0]->{message} }
  
  #
  # The %seen bit protects against circular inheritance.
  #
  eval <<'EOF' if $] == 5.006;
  sub isa {
      my ( $inheritor, $base ) = @_;
      $inheritor = ref($inheritor) if ref($inheritor);
  
      my %seen;
  
      no strict 'refs';
      my @parents = ( $inheritor, @{"$inheritor\::ISA"} );
      while ( my $class = shift @parents ) {
          return 1 if $class eq $base;
  
          push @parents, grep { !$seen{$_}++ } @{"$class\::ISA"};
      }
      return 0;
  }
  EOF
  
  sub caught {
      my $class = shift;
  
      my $e = $@;
  
      return unless defined $e && blessed($e) && $e->isa($class);
      return $e;
  }
  
  1;
  
  # ABSTRACT: A base class for exception objects
  
  __END__
  
  =pod
  
  =head1 NAME
  
  Exception::Class::Base - A base class for exception objects
  
  =head1 VERSION
  
  version 1.36
  
  =head1 SYNOPSIS
  
    use Exception::Class 'MyException';
  
    eval { MyException->throw( error => 'I feel funny.' ) };
  
    print $@->error();
  
  =head1 DESCRIPTION
  
  This class is the base class for all exceptions created by
  L<Exception::Class>. It provides a number of methods for getting
  information about the exception.
  
  =head1 METHODS
  
  =head2 MyException->Trace($boolean)
  
  Each C<Exception::Class::Base> subclass can be set individually to
  include a stacktrace when the C<as_string> method is called.  The
  default is to not include a stacktrace.  Calling this method with a
  value changes this behavior.  It always returns the current value
  (after any change is applied).
  
  This value is inherited by any subclasses.  However, if this value is
  set for a subclass, it will thereafter be independent of the value in
  C<Exception::Class::Base>.
  
  Do not call this on the C<Exception::Class::Base> class directly or
  you'll change it for all exception classes that use
  L<Exception::Class>, including ones created in modules you don't
  control.
  
  This is a class method, not an object method.
  
  =head2 MyException->NoRefs($boolean)
  
  When a C<Devel::StackTrace> object is created, it walks through the
  stack and stores the arguments which were passed to each subroutine on
  the stack.  If any of these arguments are references, then that means
  that the C<Devel::StackTrace> ends up increasing the refcount of these
  references, delaying their destruction.
  
  Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
  this method provides a way to tell C<Devel::StackTrace> not to store
  these references.  Instead, C<Devel::StackTrace> replaces references
  with their stringified representation.
  
  This method defaults to true.  As with C<Trace()>, it is inherited by
  subclasses but setting it in a subclass makes it independent
  thereafter.
  
  Do not call this on the C<Exception::Class::Base> class directly or
  you'll change it for all exception classes that use
  L<Exception::Class>, including ones created in modules you don't
  control.
  
  =head2 MyException->RespectOverload($boolean)
  
  When a C<Devel::StackTrace> object stringifies, by default it ignores
  stringification overloading on any objects being dealt with.
  
  Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
  this method provides a way to tell C<Devel::StackTrace> to respect
  overloading.
  
  This method defaults to false.  As with C<Trace()>, it is inherited by
  subclasses but setting it in a subclass makes it independent
  thereafter.
  
  Do not call this on the C<Exception::Class::Base> class directly or
  you'll change it for all exception classes that use
  L<Exception::Class>, including ones created in modules you don't
  control.
  
  =head2 MyException->MaxArgLength($boolean)
  
  When a C<Devel::StackTrace> object stringifies, by default it displays
  the full argument for each function. This parameter can be used to
  limit the maximum length of each argument.
  
  Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
  this method provides a way to tell C<Devel::StackTrace> to limit the
  length of arguments.
  
  This method defaults to 0. As with C<Trace()>, it is inherited by
  subclasses but setting it in a subclass makes it independent
  thereafter.
  
  Do not call this on the C<Exception::Class::Base> class directly or
  you'll change it for all exception classes that use
  L<Exception::Class>, including ones created in modules you don't
  control.
  
  =head2 MyException->Fields
  
  This method returns the extra fields defined for the given class, as
  an array.
  
  Do not call this on the C<Exception::Class::Base> class directly or
  you'll change it for all exception classes that use
  L<Exception::Class>, including ones created in modules you don't
  control.
  
  =head2 MyException->throw( $message )
  
  =head2 MyException->throw( message => $message )
  
  =head2 MyException->throw( error => $error )
  
  This method creates a new object with the given error message.  If no
  error message is given, this will be an empty string.  It then dies
  with this object as its argument.
  
  This method also takes a C<show_trace> parameter which indicates
  whether or not the particular exception object being created should
  show a stacktrace when its C<as_string()> method is called.  This
  overrides the value of C<Trace()> for this class if it is given.
  
  The frames included in the trace can be controlled by the C<ignore_class>
  and C<ignore_package> parameters. These are passed directly to
  Devel::Stacktrace's constructor. See C<Devel::Stacktrace> for more details.
  
  If only a single value is given to the constructor it is assumed to be
  the message parameter.
  
  Additional keys corresponding to the fields defined for the particular
  exception subclass will also be accepted.
  
  =head2 MyException->new(...)
  
  This method takes the same parameters as C<throw()>, but instead of
  dying simply returns a new exception object.
  
  This method is always called when constructing a new exception object
  via the C<throw()> method.
  
  =head2 MyException->description()
  
  Returns the description for the given C<Exception::Class::Base>
  subclass.  The C<Exception::Class::Base> class's description is
  "Generic exception" (this may change in the future).  This is also an
  object method.
  
  =head2 $exception->rethrow()
  
  Simply dies with the object as its sole argument.  It's just syntactic
  sugar.  This does not change any of the object's attribute values.
  However, it will cause C<caller()> to report the die as coming from
  within the C<Exception::Class::Base> class rather than where rethrow
  was called.
  
  Of course, you always have access to the original stacktrace for the
  exception object.
  
  =head2 $exception->message()
  
  =head2 $exception->error()
  
  Returns the error/message associated with the exception.
  
  =head2 $exception->pid()
  
  Returns the pid at the time the exception was thrown.
  
  =head2 $exception->uid()
  
  Returns the real user id at the time the exception was thrown.
  
  =head2 $exception->gid()
  
  Returns the real group id at the time the exception was thrown.
  
  =head2 $exception->euid()
  
  Returns the effective user id at the time the exception was thrown.
  
  =head2 $exception->egid()
  
  Returns the effective group id at the time the exception was thrown.
  
  =head2 $exception->time()
  
  Returns the time in seconds since the epoch at the time the exception
  was thrown.
  
  =head2 $exception->package()
  
  Returns the package from which the exception was thrown.
  
  =head2 $exception->file()
  
  Returns the file within which the exception was thrown.
  
  =head2 $exception->line()
  
  Returns the line where the exception was thrown.
  
  =head2 $exception->trace()
  
  Returns the trace object associated with the object.
  
  =head2 $exception->show_trace($boolean)
  
  This method can be used to set whether or not a stack trace is
  included when the as_string method is called or the object is
  stringified.
  
  =head2 $exception->as_string()
  
  Returns a string form of the error message (something like what you'd
  expect from die).  If the class or object is set to show traces then
  then the full trace is also included.  The result looks like
  C<Carp::confess()>.
  
  =head2 $exception->full_message()
  
  Called by the C<as_string()> method to get the message.  By default,
  this is the same as calling the C<message()> method, but may be
  overridden by a subclass.  See below for details.
  
  =head1 LIGHTWEIGHT EXCEPTIONS
  
  A lightweight exception is one which records no information about its context
  when it is created. This can be achieved by setting C<<
  $class->NoContextInfo() >> to a true value.
  
  You can make this the default for a class of exceptions by setting it after
  creating the class:
  
    use Exception::Class (
        'LightWeight',
        'HeavyWeight',
    );
  
    LightWeight->NoContextInfo(1);
  
  A lightweight exception does have a stack trace object, nor does it record the
  time, pid, uid, euid, gid, or egid. It only has a message.
  
  =head1 OVERLOADING
  
  C<Exception::Class::Base> objects are overloaded so that
  stringification produces a normal error message.  This just calls the
  C<< $exception->as_string() >> method described above.  This means
  that you can just C<print $@> after an C<eval> and not worry about
  whether or not its an actual object.  It also means an application or
  module could do this:
  
   $SIG{__DIE__} = sub { Exception::Class::Base->throw( error => join '', @_ ); };
  
  and this would probably not break anything (unless someone was
  expecting a different type of exception object from C<die()>).
  
  =head1 OVERRIDING THE as_string METHOD
  
  By default, the C<as_string()> method simply returns the value
  C<message> or C<error> param plus a stack trace, if the class's
  C<Trace()> method returns a true value or C<show_trace> was set when
  creating the exception.
  
  However, once you add new fields to a subclass, you may want to
  include those fields in the stringified error.
  
  Inside the C<as_string()> method, the message (non-stack trace)
  portion of the error is generated by calling the C<full_message()>
  method.  This can be easily overridden.  For example:
  
    sub full_message {
        my $self = shift;
  
        my $msg = $self->message;
  
        $msg .= " and foo was " . $self->foo;
  
        return $msg;
    }
  
  =head1 AUTHOR
  
  Dave Rolsky <autarch@urth.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2010 by Dave Rolsky.
  
  This is free software, licensed under:
  
    The Artistic License 2.0 (GPL Compatible)
  
  =cut
EXCEPTION_CLASS_BASE

$fatpacked{"File/pushd.pm"} = <<'FILE_PUSHD';
  use strict;
  use warnings;
  package File::pushd;
  # ABSTRACT: change directory temporarily for a limited scope
  our $VERSION = '1.005'; # VERSION
  
  our @EXPORT  = qw( pushd tempd );
  our @ISA     = qw( Exporter );
  
  use Exporter;
  use Carp;
  use Cwd         qw( getcwd abs_path );
  use File::Path  qw( rmtree );
  use File::Temp  qw();
  use File::Spec;
  
  use overload
      q{""} => sub { File::Spec->canonpath( $_[0]->{_pushd} ) },
      fallback => 1;
  
  #--------------------------------------------------------------------------#
  # pushd()
  #--------------------------------------------------------------------------#
  
  sub pushd {
      my ($target_dir, $options) = @_;
      $options->{untaint_pattern} ||= qr{^([-+@\w./]+)$};
  
      $target_dir = "." unless defined $target_dir;
      croak "Can't locate directory $target_dir" unless -d $target_dir;
  
      my $tainted_orig = getcwd;
      my $orig;
      if ( $tainted_orig =~ $options->{untaint_pattern} ) {
        $orig = $1;
      }
      else {
        $orig = $tainted_orig;
      }
  
      my $tainted_dest;
      eval { $tainted_dest   = $target_dir ? abs_path( $target_dir ) : $orig };
      croak "Can't locate absolute path for $target_dir: $@" if $@;
  
      my $dest;
      if ( $tainted_dest =~ $options->{untaint_pattern} ) {
        $dest = $1;
      }
      else {
        $dest = $tainted_dest;
      }
  
      if ($dest ne $orig) {
          chdir $dest or croak "Can't chdir to $dest\: $!";
      }
  
      my $self = bless {
          _pushd => $dest,
          _original => $orig
      }, __PACKAGE__;
  
      return $self;
  }
  
  #--------------------------------------------------------------------------#
  # tempd()
  #--------------------------------------------------------------------------#
  
  sub tempd {
      my ($options) = @_;
      my $dir;
      eval { $dir = pushd( File::Temp::tempdir( CLEANUP => 0 ), $options ) };
      croak $@ if $@;
      $dir->{_tempd} = 1;
      return $dir;
  }
  
  #--------------------------------------------------------------------------#
  # preserve()
  #--------------------------------------------------------------------------#
  
  sub preserve {
      my $self = shift;
      return 1 if ! $self->{"_tempd"};
      if ( @_ == 0 ) {
          return $self->{_preserve} = 1;
      }
      else {
          return $self->{_preserve} = $_[0] ? 1 : 0;
      }
  }
  
  #--------------------------------------------------------------------------#
  # DESTROY()
  # Revert to original directory as object is destroyed and cleanup
  # if necessary
  #--------------------------------------------------------------------------#
  
  sub DESTROY {
      my ($self) = @_;
      my $orig = $self->{_original};
      chdir $orig if $orig; # should always be so, but just in case...
      if ( $self->{_tempd} &&
          !$self->{_preserve} ) {
          # don't destroy existing $@ if there is no error.
          my $err = do {
              local $@;
              eval { rmtree( $self->{_pushd} ) };
              $@;
          };
          carp $err if $err;
      }
  }
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  File::pushd - change directory temporarily for a limited scope
  
  =head1 VERSION
  
  version 1.005
  
  =head1 SYNOPSIS
  
    use File::pushd;
   
    chdir $ENV{HOME};
   
    # change directory again for a limited scope
    {
        my $dir = pushd( '/tmp' );
        # working directory changed to /tmp
    }
    # working directory has reverted to $ENV{HOME}
   
    # tempd() is equivalent to pushd( File::Temp::tempdir )
    {
        my $dir = tempd();
    }
   
    # object stringifies naturally as an absolute path
    {
       my $dir = pushd( '/tmp' );
       my $filename = File::Spec->catfile( $dir, "somefile.txt" );
       # gives /tmp/somefile.txt
    }
  
  =head1 DESCRIPTION
  
  File::pushd does a temporary C<<< chdir >>> that is easily and automatically
  reverted, similar to C<<< pushd >>> in some Unix command shells.  It works by
  creating an object that caches the original working directory.  When the object
  is destroyed, the destructor calls C<<< chdir >>> to revert to the original working
  directory.  By storing the object in a lexical variable with a limited scope,
  this happens automatically at the end of the scope.
  
  This is very handy when working with temporary directories for tasks like
  testing; a function is provided to streamline getting a temporary
  directory from L<File::Temp>.
  
  For convenience, the object stringifies as the canonical form of the absolute
  pathname of the directory entered.
  
  =head1 USAGE
  
    use File::pushd;
  
  Using File::pushd automatically imports the C<<< pushd >>> and C<<< tempd >>> functions.
  
  =head2 pushd
  
    {
        my $dir = pushd( $target_directory );
    }
  
  Caches the current working directory, calls C<<< chdir >>> to change to the target
  directory, and returns a File::pushd object.  When the object is
  destroyed, the working directory reverts to the original directory.
  
  The provided target directory can be a relative or absolute path. If
  called with no arguments, it uses the current directory as its target and
  returns to the current directory when the object is destroyed.
  
  If the target directory does not exist or if the directory change fails
  for some reason, C<<< pushd >>> will die with an error message.
  
  Can be given a hashref as an optional second argument.  The only supported
  option is C<<< untaint_pattern >>>, which is used to untaint file paths involved.
  It defaults to C<<< qr{^([-+@\w./]+)$} >>>, which is reasonably restrictive (e.g.
  it does not even allow spaces in the path).  Change this to suit your
  circumstances and security needs if running under taint mode. B<Note>: you
  must include the parentheses in the pattern to capture the untainted
  portion of the path.
  
  =head2 tempd
  
    {
        my $dir = tempd();
    }
  
  This function is like C<<< pushd >>> but automatically creates and calls C<<< chdir >>> to
  a temporary directory created by L<File::Temp>. Unlike normal L<File::Temp>
  cleanup which happens at the end of the program, this temporary directory is
  removed when the object is destroyed. (But also see C<<< preserve >>>.)  A warning
  will be issued if the directory cannot be removed.
  
  As with C<<< pushd >>>, C<<< tempd >>> will die if C<<< chdir >>> fails.
  
  It may be given a single options hash that will be passed internally
  to CE<lt>pushdE<gt>.
  
  =head2 preserve
  
    {
        my $dir = tempd();
        $dir->preserve;      # mark to preserve at end of scope
        $dir->preserve(0);   # mark to delete at end of scope
    }
  
  Controls whether a temporary directory will be cleaned up when the object is
  destroyed.  With no arguments, C<<< preserve >>> sets the directory to be preserved.
  With an argument, the directory will be preserved if the argument is true, or
  marked for cleanup if the argument is false.  Only C<<< tempd >>> objects may be
  marked for cleanup.  (Target directories to C<<< pushd >>> are always preserved.)
  C<<< preserve >>> returns true if the directory will be preserved, and false
  otherwise.
  
  =head1 SEE ALSO
  
  =over
  
  =item *
  
  L<File::chdir>
  
  =back
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<https://github.com/dagolden/file-pushd/issues>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/dagolden/file-pushd>
  
    git clone git://github.com/dagolden/file-pushd.git
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 CONTRIBUTOR
  
  Diab Jerius <djerius@cfa.harvard.edu>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David A Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
FILE_PUSHD

$fatpacked{"Getopt/Long.pm"} = <<'GETOPT_LONG';
  #! perl
  
  # Getopt::Long.pm -- Universal options parsing
  # Author          : Johan Vromans
  # Created On      : Tue Sep 11 15:00:12 1990
  # Last Modified By: Johan Vromans
  # Last Modified On: Mon Jul  8 08:22:51 2013
  # Update Count    : 1644
  # Status          : Released
  
  ################ Module Preamble ################
  
  package Getopt::Long;
  
  use 5.004;
  
  use strict;
  
  use vars qw($VERSION);
  $VERSION        =  2.41;
  # For testing versions only.
  use vars qw($VERSION_STRING);
  $VERSION_STRING = "2.41";
  
  use Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK);
  @ISA = qw(Exporter);
  
  # Exported subroutines.
  sub GetOptions(@);		# always
  sub GetOptionsFromArray(@);	# on demand
  sub GetOptionsFromString(@);	# on demand
  sub Configure(@);		# on demand
  sub HelpMessage(@);		# on demand
  sub VersionMessage(@);		# in demand
  
  BEGIN {
      # Init immediately so their contents can be used in the 'use vars' below.
      @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
      @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
  		    &GetOptionsFromArray &GetOptionsFromString);
  }
  
  # User visible variables.
  use vars @EXPORT, @EXPORT_OK;
  use vars qw($error $debug $major_version $minor_version);
  # Deprecated visible variables.
  use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
  	    $passthrough);
  # Official invisible variables.
  use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
  
  # Public subroutines.
  sub config(@);			# deprecated name
  
  # Private subroutines.
  sub ConfigDefaults();
  sub ParseOptionSpec($$);
  sub OptCtl($);
  sub FindOption($$$$$);
  sub ValidValue ($$$$$);
  
  ################ Local Variables ################
  
  # $requested_version holds the version that was mentioned in the 'use'
  # or 'require', if any. It can be used to enable or disable specific
  # features.
  my $requested_version = 0;
  
  ################ Resident subroutines ################
  
  sub ConfigDefaults() {
      # Handle POSIX compliancy.
      if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  	$genprefix = "(--|-)";
  	$autoabbrev = 0;		# no automatic abbrev of options
  	$bundling = 0;			# no bundling of single letter switches
  	$getopt_compat = 0;		# disallow '+' to start options
  	$order = $REQUIRE_ORDER;
      }
      else {
  	$genprefix = "(--|-|\\+)";
  	$autoabbrev = 1;		# automatic abbrev of options
  	$bundling = 0;			# bundling off by default
  	$getopt_compat = 1;		# allow '+' to start options
  	$order = $PERMUTE;
      }
      # Other configurable settings.
      $debug = 0;			# for debugging
      $error = 0;			# error tally
      $ignorecase = 1;		# ignore case when matching options
      $passthrough = 0;		# leave unrecognized options alone
      $gnu_compat = 0;		# require --opt=val if value is optional
      $longprefix = "(--)";       # what does a long prefix look like
  }
  
  # Override import.
  sub import {
      my $pkg = shift;		# package
      my @syms = ();		# symbols to import
      my @config = ();		# configuration
      my $dest = \@syms;		# symbols first
      for ( @_ ) {
  	if ( $_ eq ':config' ) {
  	    $dest = \@config;	# config next
  	    next;
  	}
  	push(@$dest, $_);	# push
      }
      # Hide one level and call super.
      local $Exporter::ExportLevel = 1;
      push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
      $requested_version = 0;
      $pkg->SUPER::import(@syms);
      # And configure.
      Configure(@config) if @config;
  }
  
  ################ Initialization ################
  
  # Values for $order. See GNU getopt.c for details.
  ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
  # Version major/minor numbers.
  ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
  
  ConfigDefaults();
  
  ################ OO Interface ################
  
  package Getopt::Long::Parser;
  
  # Store a copy of the default configuration. Since ConfigDefaults has
  # just been called, what we get from Configure is the default.
  my $default_config = do {
      Getopt::Long::Configure ()
  };
  
  sub new {
      my $that = shift;
      my $class = ref($that) || $that;
      my %atts = @_;
  
      # Register the callers package.
      my $self = { caller_pkg => (caller)[0] };
  
      bless ($self, $class);
  
      # Process config attributes.
      if ( defined $atts{config} ) {
  	my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
  	$self->{settings} = Getopt::Long::Configure ($save);
  	delete ($atts{config});
      }
      # Else use default config.
      else {
  	$self->{settings} = $default_config;
      }
  
      if ( %atts ) {		# Oops
  	die(__PACKAGE__.": unhandled attributes: ".
  	    join(" ", sort(keys(%atts)))."\n");
      }
  
      $self;
  }
  
  sub configure {
      my ($self) = shift;
  
      # Restore settings, merge new settings in.
      my $save = Getopt::Long::Configure ($self->{settings}, @_);
  
      # Restore orig config and save the new config.
      $self->{settings} = Getopt::Long::Configure ($save);
  }
  
  sub getoptions {
      my ($self) = shift;
  
      return $self->getoptionsfromarray(\@ARGV, @_);
  }
  
  sub getoptionsfromarray {
      my ($self) = shift;
  
      # Restore config settings.
      my $save = Getopt::Long::Configure ($self->{settings});
  
      # Call main routine.
      my $ret = 0;
      $Getopt::Long::caller = $self->{caller_pkg};
  
      eval {
  	# Locally set exception handler to default, otherwise it will
  	# be called implicitly here, and again explicitly when we try
  	# to deliver the messages.
  	local ($SIG{__DIE__}) = 'DEFAULT';
  	$ret = Getopt::Long::GetOptionsFromArray (@_);
      };
  
      # Restore saved settings.
      Getopt::Long::Configure ($save);
  
      # Handle errors and return value.
      die ($@) if $@;
      return $ret;
  }
  
  package Getopt::Long;
  
  ################ Back to Normal ################
  
  # Indices in option control info.
  # Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
  use constant CTL_TYPE    => 0;
  #use constant   CTL_TYPE_FLAG   => '';
  #use constant   CTL_TYPE_NEG    => '!';
  #use constant   CTL_TYPE_INCR   => '+';
  #use constant   CTL_TYPE_INT    => 'i';
  #use constant   CTL_TYPE_INTINC => 'I';
  #use constant   CTL_TYPE_XINT   => 'o';
  #use constant   CTL_TYPE_FLOAT  => 'f';
  #use constant   CTL_TYPE_STRING => 's';
  
  use constant CTL_CNAME   => 1;
  
  use constant CTL_DEFAULT => 2;
  
  use constant CTL_DEST    => 3;
   use constant   CTL_DEST_SCALAR => 0;
   use constant   CTL_DEST_ARRAY  => 1;
   use constant   CTL_DEST_HASH   => 2;
   use constant   CTL_DEST_CODE   => 3;
  
  use constant CTL_AMIN    => 4;
  use constant CTL_AMAX    => 5;
  
  # FFU.
  #use constant CTL_RANGE   => ;
  #use constant CTL_REPEAT  => ;
  
  # Rather liberal patterns to match numbers.
  use constant PAT_INT   => "[-+]?_*[0-9][0-9_]*";
  use constant PAT_XINT  =>
    "(?:".
  	  "[-+]?_*[1-9][0-9_]*".
    "|".
  	  "0x_*[0-9a-f][0-9a-f_]*".
    "|".
  	  "0b_*[01][01_]*".
    "|".
  	  "0[0-7_]*".
    ")";
  use constant PAT_FLOAT => "[-+]?[0-9._]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
  
  sub GetOptions(@) {
      # Shift in default array.
      unshift(@_, \@ARGV);
      # Try to keep caller() and Carp consistent.
      goto &GetOptionsFromArray;
  }
  
  sub GetOptionsFromString(@) {
      my ($string) = shift;
      require Text::ParseWords;
      my $args = [ Text::ParseWords::shellwords($string) ];
      $caller ||= (caller)[0];	# current context
      my $ret = GetOptionsFromArray($args, @_);
      return ( $ret, $args ) if wantarray;
      if ( @$args ) {
  	$ret = 0;
  	warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
      }
      $ret;
  }
  
  sub GetOptionsFromArray(@) {
  
      my ($argv, @optionlist) = @_;	# local copy of the option descriptions
      my $argend = '--';		# option list terminator
      my %opctl = ();		# table of option specs
      my $pkg = $caller || (caller)[0];	# current context
  				# Needed if linkage is omitted.
      my @ret = ();		# accum for non-options
      my %linkage;		# linkage
      my $userlinkage;		# user supplied HASH
      my $opt;			# current option
      my $prefix = $genprefix;	# current prefix
  
      $error = '';
  
      if ( $debug ) {
  	# Avoid some warnings if debugging.
  	local ($^W) = 0;
  	print STDERR
  	  ("Getopt::Long $Getopt::Long::VERSION ",
  	   "called from package \"$pkg\".",
  	   "\n  ",
  	   "argv: (@$argv)",
  	   "\n  ",
  	   "autoabbrev=$autoabbrev,".
  	   "bundling=$bundling,",
  	   "getopt_compat=$getopt_compat,",
  	   "gnu_compat=$gnu_compat,",
  	   "order=$order,",
  	   "\n  ",
  	   "ignorecase=$ignorecase,",
  	   "requested_version=$requested_version,",
  	   "passthrough=$passthrough,",
  	   "genprefix=\"$genprefix\",",
  	   "longprefix=\"$longprefix\".",
  	   "\n");
      }
  
      # Check for ref HASH as first argument.
      # First argument may be an object. It's OK to use this as long
      # as it is really a hash underneath.
      $userlinkage = undef;
      if ( @optionlist && ref($optionlist[0]) and
  	 UNIVERSAL::isa($optionlist[0],'HASH') ) {
  	$userlinkage = shift (@optionlist);
  	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
      }
  
      # See if the first element of the optionlist contains option
      # starter characters.
      # Be careful not to interpret '<>' as option starters.
      if ( @optionlist && $optionlist[0] =~ /^\W+$/
  	 && !($optionlist[0] eq '<>'
  	      && @optionlist > 0
  	      && ref($optionlist[1])) ) {
  	$prefix = shift (@optionlist);
  	# Turn into regexp. Needs to be parenthesized!
  	$prefix =~ s/(\W)/\\$1/g;
  	$prefix = "([" . $prefix . "])";
  	print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
      }
  
      # Verify correctness of optionlist.
      %opctl = ();
      while ( @optionlist ) {
  	my $opt = shift (@optionlist);
  
  	unless ( defined($opt) ) {
  	    $error .= "Undefined argument in option spec\n";
  	    next;
  	}
  
  	# Strip leading prefix so people can specify "--foo=i" if they like.
  	$opt = $+ if $opt =~ /^$prefix+(.*)$/s;
  
  	if ( $opt eq '<>' ) {
  	    if ( (defined $userlinkage)
  		&& !(@optionlist > 0 && ref($optionlist[0]))
  		&& (exists $userlinkage->{$opt})
  		&& ref($userlinkage->{$opt}) ) {
  		unshift (@optionlist, $userlinkage->{$opt});
  	    }
  	    unless ( @optionlist > 0
  		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
  		$error .= "Option spec <> requires a reference to a subroutine\n";
  		# Kill the linkage (to avoid another error).
  		shift (@optionlist)
  		  if @optionlist && ref($optionlist[0]);
  		next;
  	    }
  	    $linkage{'<>'} = shift (@optionlist);
  	    next;
  	}
  
  	# Parse option spec.
  	my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
  	unless ( defined $name ) {
  	    # Failed. $orig contains the error message. Sorry for the abuse.
  	    $error .= $orig;
  	    # Kill the linkage (to avoid another error).
  	    shift (@optionlist)
  	      if @optionlist && ref($optionlist[0]);
  	    next;
  	}
  
  	# If no linkage is supplied in the @optionlist, copy it from
  	# the userlinkage if available.
  	if ( defined $userlinkage ) {
  	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
  		if ( exists $userlinkage->{$orig} &&
  		     ref($userlinkage->{$orig}) ) {
  		    print STDERR ("=> found userlinkage for \"$orig\": ",
  				  "$userlinkage->{$orig}\n")
  			if $debug;
  		    unshift (@optionlist, $userlinkage->{$orig});
  		}
  		else {
  		    # Do nothing. Being undefined will be handled later.
  		    next;
  		}
  	    }
  	}
  
  	# Copy the linkage. If omitted, link to global variable.
  	if ( @optionlist > 0 && ref($optionlist[0]) ) {
  	    print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
  		if $debug;
  	    my $rl = ref($linkage{$orig} = shift (@optionlist));
  
  	    if ( $rl eq "ARRAY" ) {
  		$opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
  	    }
  	    elsif ( $rl eq "HASH" ) {
  		$opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
  	    }
  	    elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
  #		if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
  #		    my $t = $linkage{$orig};
  #		    $$t = $linkage{$orig} = [];
  #		}
  #		elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
  #		}
  #		else {
  		    # Ok.
  #		}
  	    }
  	    elsif ( $rl eq "CODE" ) {
  		# Ok.
  	    }
  	    else {
  		$error .= "Invalid option linkage for \"$opt\"\n";
  	    }
  	}
  	else {
  	    # Link to global $opt_XXX variable.
  	    # Make sure a valid perl identifier results.
  	    my $ov = $orig;
  	    $ov =~ s/\W/_/g;
  	    if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
  		print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
  	    }
  	    elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
  		print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
  	    }
  	    else {
  		print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
  	    }
  	}
  
  	if ( $opctl{$name}[CTL_TYPE] eq 'I'
  	     && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
  		  || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
  	   ) {
  	    $error .= "Invalid option linkage for \"$opt\"\n";
  	}
  
      }
  
      # Bail out if errors found.
      die ($error) if $error;
      $error = 0;
  
      # Supply --version and --help support, if needed and allowed.
      if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
  	if ( !defined($opctl{version}) ) {
  	    $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
  	    $linkage{version} = \&VersionMessage;
  	}
  	$auto_version = 1;
      }
      if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
  	if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
  	    $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
  	    $linkage{help} = \&HelpMessage;
  	}
  	$auto_help = 1;
      }
  
      # Show the options tables if debugging.
      if ( $debug ) {
  	my ($arrow, $k, $v);
  	$arrow = "=> ";
  	while ( ($k,$v) = each(%opctl) ) {
  	    print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
  	    $arrow = "   ";
  	}
      }
  
      # Process argument list
      my $goon = 1;
      while ( $goon && @$argv > 0 ) {
  
  	# Get next argument.
  	$opt = shift (@$argv);
  	print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
  
  	# Double dash is option list terminator.
  	if ( defined($opt) && $opt eq $argend ) {
  	  push (@ret, $argend) if $passthrough;
  	  last;
  	}
  
  	# Look it up.
  	my $tryopt = $opt;
  	my $found;		# success status
  	my $key;		# key (if hash type)
  	my $arg;		# option argument
  	my $ctl;		# the opctl entry
  
  	($found, $opt, $ctl, $arg, $key) =
  	  FindOption ($argv, $prefix, $argend, $opt, \%opctl);
  
  	if ( $found ) {
  
  	    # FindOption undefines $opt in case of errors.
  	    next unless defined $opt;
  
  	    my $argcnt = 0;
  	    while ( defined $arg ) {
  
  		# Get the canonical name.
  		print STDERR ("=> cname for \"$opt\" is ") if $debug;
  		$opt = $ctl->[CTL_CNAME];
  		print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
  
  		if ( defined $linkage{$opt} ) {
  		    print STDERR ("=> ref(\$L{$opt}) -> ",
  				  ref($linkage{$opt}), "\n") if $debug;
  
  		    if ( ref($linkage{$opt}) eq 'SCALAR'
  			 || ref($linkage{$opt}) eq 'REF' ) {
  			if ( $ctl->[CTL_TYPE] eq '+' ) {
  			    print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
  			      if $debug;
  			    if ( defined ${$linkage{$opt}} ) {
  			        ${$linkage{$opt}} += $arg;
  			    }
  		            else {
  			        ${$linkage{$opt}} = $arg;
  			    }
  			}
  			elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
  			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
  					  " to ARRAY\n")
  			      if $debug;
  			    my $t = $linkage{$opt};
  			    $$t = $linkage{$opt} = [];
  			    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
  			      if $debug;
  			    push (@{$linkage{$opt}}, $arg);
  			}
  			elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
  					  " to HASH\n")
  			      if $debug;
  			    my $t = $linkage{$opt};
  			    $$t = $linkage{$opt} = {};
  			    print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
  			      if $debug;
  			    $linkage{$opt}->{$key} = $arg;
  			}
  			else {
  			    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
  			      if $debug;
  			    ${$linkage{$opt}} = $arg;
  		        }
  		    }
  		    elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
  			print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
  			    if $debug;
  			push (@{$linkage{$opt}}, $arg);
  		    }
  		    elsif ( ref($linkage{$opt}) eq 'HASH' ) {
  			print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
  			    if $debug;
  			$linkage{$opt}->{$key} = $arg;
  		    }
  		    elsif ( ref($linkage{$opt}) eq 'CODE' ) {
  			print STDERR ("=> &L{$opt}(\"$opt\"",
  				      $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
  				      ", \"$arg\")\n")
  			    if $debug;
  			my $eval_error = do {
  			    local $@;
  			    local $SIG{__DIE__}  = 'DEFAULT';
  			    eval {
  				&{$linkage{$opt}}
  				  (Getopt::Long::CallBack->new
  				   (name    => $opt,
  				    ctl     => $ctl,
  				    opctl   => \%opctl,
  				    linkage => \%linkage,
  				    prefix  => $prefix,
  				   ),
  				   $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
  				   $arg);
  			    };
  			    $@;
  			};
  			print STDERR ("=> die($eval_error)\n")
  			  if $debug && $eval_error ne '';
  			if ( $eval_error =~ /^!/ ) {
  			    if ( $eval_error =~ /^!FINISH\b/ ) {
  				$goon = 0;
  			    }
  			}
  			elsif ( $eval_error ne '' ) {
  			    warn ($eval_error);
  			    $error++;
  			}
  		    }
  		    else {
  			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
  				      "\" in linkage\n");
  			die("Getopt::Long -- internal error!\n");
  		    }
  		}
  		# No entry in linkage means entry in userlinkage.
  		elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
  		    if ( defined $userlinkage->{$opt} ) {
  			print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
  			    if $debug;
  			push (@{$userlinkage->{$opt}}, $arg);
  		    }
  		    else {
  			print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
  			    if $debug;
  			$userlinkage->{$opt} = [$arg];
  		    }
  		}
  		elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  		    if ( defined $userlinkage->{$opt} ) {
  			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
  			    if $debug;
  			$userlinkage->{$opt}->{$key} = $arg;
  		    }
  		    else {
  			print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
  			    if $debug;
  			$userlinkage->{$opt} = {$key => $arg};
  		    }
  		}
  		else {
  		    if ( $ctl->[CTL_TYPE] eq '+' ) {
  			print STDERR ("=> \$L{$opt} += \"$arg\"\n")
  			  if $debug;
  			if ( defined $userlinkage->{$opt} ) {
  			    $userlinkage->{$opt} += $arg;
  			}
  			else {
  			    $userlinkage->{$opt} = $arg;
  			}
  		    }
  		    else {
  			print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
  			$userlinkage->{$opt} = $arg;
  		    }
  		}
  
  		$argcnt++;
  		last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
  		undef($arg);
  
  		# Need more args?
  		if ( $argcnt < $ctl->[CTL_AMIN] ) {
  		    if ( @$argv ) {
  			if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
  			    $arg = shift(@$argv);
  			    if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
  				$arg =~ tr/_//d;
  				$arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
  				  ? oct($arg)
  				  : 0+$arg
  			    }
  			    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
  			      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
  			    next;
  			}
  			warn("Value \"$$argv[0]\" invalid for option $opt\n");
  			$error++;
  		    }
  		    else {
  			warn("Insufficient arguments for option $opt\n");
  			$error++;
  		    }
  		}
  
  		# Any more args?
  		if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) {
  		    $arg = shift(@$argv);
  		    if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
  			$arg =~ tr/_//d;
  			$arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
  			  ? oct($arg)
  			  : 0+$arg
  		    }
  		    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
  		      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
  		    next;
  		}
  	    }
  	}
  
  	# Not an option. Save it if we $PERMUTE and don't have a <>.
  	elsif ( $order == $PERMUTE ) {
  	    # Try non-options call-back.
  	    my $cb;
  	    if ( (defined ($cb = $linkage{'<>'})) ) {
  		print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
  		  if $debug;
  		my $eval_error = do {
  		    local $@;
  		    local $SIG{__DIE__}  = 'DEFAULT';
  		    eval {
  			# The arg to <> cannot be the CallBack object
  			# since it may be passed to other modules that
  			# get confused (e.g., Archive::Tar). Well,
  			# it's not relevant for this callback anyway.
  			&$cb($tryopt);
  		    };
  		    $@;
  		};
  		print STDERR ("=> die($eval_error)\n")
  		  if $debug && $eval_error ne '';
  		if ( $eval_error =~ /^!/ ) {
  		    if ( $eval_error =~ /^!FINISH\b/ ) {
  			$goon = 0;
  		    }
  		}
  		elsif ( $eval_error ne '' ) {
  		    warn ($eval_error);
  		    $error++;
  		}
  	    }
  	    else {
  		print STDERR ("=> saving \"$tryopt\" ",
  			      "(not an option, may permute)\n") if $debug;
  		push (@ret, $tryopt);
  	    }
  	    next;
  	}
  
  	# ...otherwise, terminate.
  	else {
  	    # Push this one back and exit.
  	    unshift (@$argv, $tryopt);
  	    return ($error == 0);
  	}
  
      }
  
      # Finish.
      if ( @ret && $order == $PERMUTE ) {
  	#  Push back accumulated arguments
  	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
  	    if $debug;
  	unshift (@$argv, @ret);
      }
  
      return ($error == 0);
  }
  
  # A readable representation of what's in an optbl.
  sub OptCtl ($) {
      my ($v) = @_;
      my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
      "[".
        join(",",
  	   "\"$v[CTL_TYPE]\"",
  	   "\"$v[CTL_CNAME]\"",
  	   "\"$v[CTL_DEFAULT]\"",
  	   ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
  	   $v[CTL_AMIN] || '',
  	   $v[CTL_AMAX] || '',
  #	   $v[CTL_RANGE] || '',
  #	   $v[CTL_REPEAT] || '',
  	  ). "]";
  }
  
  # Parse an option specification and fill the tables.
  sub ParseOptionSpec ($$) {
      my ($opt, $opctl) = @_;
  
      # Match option spec.
      if ( $opt !~ m;^
  		   (
  		     # Option name
  		     (?: \w+[-\w]* )
  		     # Alias names, or "?"
  		     (?: \| (?: \? | \w[-\w]* ) )*
  		     # Aliases
  		     (?: \| (?: [^-|!+=:][^|!+=:]* )? )*
  		   )?
  		   (
  		     # Either modifiers ...
  		     [!+]
  		     |
  		     # ... or a value/dest/repeat specification
  		     [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
  		     |
  		     # ... or an optional-with-default spec
  		     : (?: -?\d+ | \+ ) [@%]?
  		   )?
  		   $;x ) {
  	return (undef, "Error in option spec: \"$opt\"\n");
      }
  
      my ($names, $spec) = ($1, $2);
      $spec = '' unless defined $spec;
  
      # $orig keeps track of the primary name the user specified.
      # This name will be used for the internal or external linkage.
      # In other words, if the user specifies "FoO|BaR", it will
      # match any case combinations of 'foo' and 'bar', but if a global
      # variable needs to be set, it will be $opt_FoO in the exact case
      # as specified.
      my $orig;
  
      my @names;
      if ( defined $names ) {
  	@names =  split (/\|/, $names);
  	$orig = $names[0];
      }
      else {
  	@names = ('');
  	$orig = '';
      }
  
      # Construct the opctl entries.
      my $entry;
      if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
  	# Fields are hard-wired here.
  	$entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
      }
      elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
  	my $def = $1;
  	my $dest = $2;
  	my $type = $def eq '+' ? 'I' : 'i';
  	$dest ||= '$';
  	$dest = $dest eq '@' ? CTL_DEST_ARRAY
  	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
  	# Fields are hard-wired here.
  	$entry = [$type,$orig,$def eq '+' ? undef : $def,
  		  $dest,0,1];
      }
      else {
  	my ($mand, $type, $dest) =
  	  $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
  	return (undef, "Cannot repeat while bundling: \"$opt\"\n")
  	  if $bundling && defined($4);
  	my ($mi, $cm, $ma) = ($5, $6, $7);
  	return (undef, "{0} is useless in option spec: \"$opt\"\n")
  	  if defined($mi) && !$mi && !defined($ma) && !defined($cm);
  
  	$type = 'i' if $type eq 'n';
  	$dest ||= '$';
  	$dest = $dest eq '@' ? CTL_DEST_ARRAY
  	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
  	# Default minargs to 1/0 depending on mand status.
  	$mi = $mand eq '=' ? 1 : 0 unless defined $mi;
  	# Adjust mand status according to minargs.
  	$mand = $mi ? '=' : ':';
  	# Adjust maxargs.
  	$ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
  	return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
  	  if defined($ma) && !$ma;
  	return (undef, "Max less than min in option spec: \"$opt\"\n")
  	  if defined($ma) && $ma < $mi;
  
  	# Fields are hard-wired here.
  	$entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
      }
  
      # Process all names. First is canonical, the rest are aliases.
      my $dups = '';
      foreach ( @names ) {
  
  	$_ = lc ($_)
  	  if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
  
  	if ( exists $opctl->{$_} ) {
  	    $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
  	}
  
  	if ( $spec eq '!' ) {
  	    $opctl->{"no$_"} = $entry;
  	    $opctl->{"no-$_"} = $entry;
  	    $opctl->{$_} = [@$entry];
  	    $opctl->{$_}->[CTL_TYPE] = '';
  	}
  	else {
  	    $opctl->{$_} = $entry;
  	}
      }
  
      if ( $dups && $^W ) {
  	foreach ( split(/\n+/, $dups) ) {
  	    warn($_."\n");
  	}
      }
      ($names[0], $orig);
  }
  
  # Option lookup.
  sub FindOption ($$$$$) {
  
      # returns (1, $opt, $ctl, $arg, $key) if okay,
      # returns (1, undef) if option in error,
      # returns (0) otherwise.
  
      my ($argv, $prefix, $argend, $opt, $opctl) = @_;
  
      print STDERR ("=> find \"$opt\"\n") if $debug;
  
      return (0) unless defined($opt);
      return (0) unless $opt =~ /^($prefix)(.*)$/s;
      return (0) if $opt eq "-" && !defined $opctl->{''};
  
      $opt = substr( $opt, length($1) ); # retain taintedness
      my $starter = $1;
  
      print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
  
      my $optarg;			# value supplied with --opt=value
      my $rest;			# remainder from unbundling
  
      # If it is a long option, it may include the value.
      # With getopt_compat, only if not bundling.
      if ( ($starter=~/^$longprefix$/
  	  || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
  	 && (my $oppos = index($opt, '=', 1)) > 0) {
  	my $optorg = $opt;
  	$opt = substr($optorg, 0, $oppos);
  	$optarg = substr($optorg, $oppos + 1); # retain tainedness
  	print STDERR ("=> option \"", $opt,
  		      "\", optarg = \"$optarg\"\n") if $debug;
      }
  
      #### Look it up ###
  
      my $tryopt = $opt;		# option to try
  
      if ( $bundling && $starter eq '-' ) {
  
  	# To try overrides, obey case ignore.
  	$tryopt = $ignorecase ? lc($opt) : $opt;
  
  	# If bundling == 2, long options can override bundles.
  	if ( $bundling == 2 && length($tryopt) > 1
  	     && defined ($opctl->{$tryopt}) ) {
  	    print STDERR ("=> $starter$tryopt overrides unbundling\n")
  	      if $debug;
  	}
  	else {
  	    $tryopt = $opt;
  	    # Unbundle single letter option.
  	    $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
  	    $tryopt = substr ($tryopt, 0, 1);
  	    $tryopt = lc ($tryopt) if $ignorecase > 1;
  	    print STDERR ("=> $starter$tryopt unbundled from ",
  			  "$starter$tryopt$rest\n") if $debug;
  	    $rest = undef unless $rest ne '';
  	}
      }
  
      # Try auto-abbreviation.
      elsif ( $autoabbrev && $opt ne "" ) {
  	# Sort the possible long option names.
  	my @names = sort(keys (%$opctl));
  	# Downcase if allowed.
  	$opt = lc ($opt) if $ignorecase;
  	$tryopt = $opt;
  	# Turn option name into pattern.
  	my $pat = quotemeta ($opt);
  	# Look up in option names.
  	my @hits = grep (/^$pat/, @names);
  	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
  		      "out of ", scalar(@names), "\n") if $debug;
  
  	# Check for ambiguous results.
  	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
  	    # See if all matches are for the same option.
  	    my %hit;
  	    foreach ( @hits ) {
  		my $hit = $opctl->{$_}->[CTL_CNAME]
  		  if defined $opctl->{$_}->[CTL_CNAME];
  		$hit = "no" . $hit if $opctl->{$_}->[CTL_TYPE] eq '!';
  		$hit{$hit} = 1;
  	    }
  	    # Remove auto-supplied options (version, help).
  	    if ( keys(%hit) == 2 ) {
  		if ( $auto_version && exists($hit{version}) ) {
  		    delete $hit{version};
  		}
  		elsif ( $auto_help && exists($hit{help}) ) {
  		    delete $hit{help};
  		}
  	    }
  	    # Now see if it really is ambiguous.
  	    unless ( keys(%hit) == 1 ) {
  		return (0) if $passthrough;
  		warn ("Option ", $opt, " is ambiguous (",
  		      join(", ", @hits), ")\n");
  		$error++;
  		return (1, undef);
  	    }
  	    @hits = keys(%hit);
  	}
  
  	# Complete the option name, if appropriate.
  	if ( @hits == 1 && $hits[0] ne $opt ) {
  	    $tryopt = $hits[0];
  	    $tryopt = lc ($tryopt) if $ignorecase;
  	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
  		if $debug;
  	}
      }
  
      # Map to all lowercase if ignoring case.
      elsif ( $ignorecase ) {
  	$tryopt = lc ($opt);
      }
  
      # Check validity by fetching the info.
      my $ctl = $opctl->{$tryopt};
      unless  ( defined $ctl ) {
  	return (0) if $passthrough;
  	# Pretend one char when bundling.
  	if ( $bundling == 1 && length($starter) == 1 ) {
  	    $opt = substr($opt,0,1);
              unshift (@$argv, $starter.$rest) if defined $rest;
  	}
  	if ( $opt eq "" ) {
  	    warn ("Missing option after ", $starter, "\n");
  	}
  	else {
  	    warn ("Unknown option: ", $opt, "\n");
  	}
  	$error++;
  	return (1, undef);
      }
      # Apparently valid.
      $opt = $tryopt;
      print STDERR ("=> found ", OptCtl($ctl),
  		  " for \"", $opt, "\"\n") if $debug;
  
      #### Determine argument status ####
  
      # If it is an option w/o argument, we're almost finished with it.
      my $type = $ctl->[CTL_TYPE];
      my $arg;
  
      if ( $type eq '' || $type eq '!' || $type eq '+' ) {
  	if ( defined $optarg ) {
  	    return (0) if $passthrough;
  	    warn ("Option ", $opt, " does not take an argument\n");
  	    $error++;
  	    undef $opt;
  	}
  	elsif ( $type eq '' || $type eq '+' ) {
  	    # Supply explicit value.
  	    $arg = 1;
  	}
  	else {
  	    $opt =~ s/^no-?//i;	# strip NO prefix
  	    $arg = 0;		# supply explicit value
  	}
  	unshift (@$argv, $starter.$rest) if defined $rest;
  	return (1, $opt, $ctl, $arg);
      }
  
      # Get mandatory status and type info.
      my $mand = $ctl->[CTL_AMIN];
  
      # Check if there is an option argument available.
      if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
  	return (1, $opt, $ctl, $type eq 's' ? '' : 0) ;#unless $mand;
  	$optarg = 0 unless $type eq 's';
      }
  
      # Check if there is an option argument available.
      if ( defined $optarg
  	 ? ($optarg eq '')
  	 : !(defined $rest || @$argv > 0) ) {
  	# Complain if this option needs an argument.
  #	if ( $mand && !($type eq 's' ? defined($optarg) : 0) ) {
  	if ( $mand ) {
  	    return (0) if $passthrough;
  	    warn ("Option ", $opt, " requires an argument\n");
  	    $error++;
  	    return (1, undef);
  	}
  	if ( $type eq 'I' ) {
  	    # Fake incremental type.
  	    my @c = @$ctl;
  	    $c[CTL_TYPE] = '+';
  	    return (1, $opt, \@c, 1);
  	}
  	return (1, $opt, $ctl,
  		defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
  		$type eq 's' ? '' : 0);
      }
  
      # Get (possibly optional) argument.
      $arg = (defined $rest ? $rest
  	    : (defined $optarg ? $optarg : shift (@$argv)));
  
      # Get key if this is a "name=value" pair for a hash option.
      my $key;
      if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
  	($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
  	  : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
  	     ($mand ? undef : ($type eq 's' ? "" : 1)));
  	if (! defined $arg) {
  	    warn ("Option $opt, key \"$key\", requires a value\n");
  	    $error++;
  	    # Push back.
  	    unshift (@$argv, $starter.$rest) if defined $rest;
  	    return (1, undef);
  	}
      }
  
      #### Check if the argument is valid for this option ####
  
      my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
  
      if ( $type eq 's' ) {	# string
  	# A mandatory string takes anything.
  	return (1, $opt, $ctl, $arg, $key) if $mand;
  
  	# Same for optional string as a hash value
  	return (1, $opt, $ctl, $arg, $key)
  	  if $ctl->[CTL_DEST] == CTL_DEST_HASH;
  
  	# An optional string takes almost anything.
  	return (1, $opt, $ctl, $arg, $key)
  	  if defined $optarg || defined $rest;
  	return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
  
  	# Check for option or option list terminator.
  	if ($arg eq $argend ||
  	    $arg =~ /^$prefix.+/) {
  	    # Push back.
  	    unshift (@$argv, $arg);
  	    # Supply empty value.
  	    $arg = '';
  	}
      }
  
      elsif ( $type eq 'i'	# numeric/integer
              || $type eq 'I'	# numeric/integer w/ incr default
  	    || $type eq 'o' ) { # dec/oct/hex/bin value
  
  	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
  
  	if ( $bundling && defined $rest
  	     && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
  	    ($key, $arg, $rest) = ($1, $2, $+);
  	    chop($key) if $key;
  	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
  	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
  	}
  	elsif ( $arg =~ /^$o_valid$/si ) {
  	    $arg =~ tr/_//d;
  	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
  	}
  	else {
  	    if ( defined $optarg || $mand ) {
  		if ( $passthrough ) {
  		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
  		      unless defined $optarg;
  		    return (0);
  		}
  		warn ("Value \"", $arg, "\" invalid for option ",
  		      $opt, " (",
  		      $type eq 'o' ? "extended " : '',
  		      "number expected)\n");
  		$error++;
  		# Push back.
  		unshift (@$argv, $starter.$rest) if defined $rest;
  		return (1, undef);
  	    }
  	    else {
  		# Push back.
  		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
  		if ( $type eq 'I' ) {
  		    # Fake incremental type.
  		    my @c = @$ctl;
  		    $c[CTL_TYPE] = '+';
  		    return (1, $opt, \@c, 1);
  		}
  		# Supply default value.
  		$arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
  	    }
  	}
      }
  
      elsif ( $type eq 'f' ) { # real number, int is also ok
  	# We require at least one digit before a point or 'e',
  	# and at least one digit following the point and 'e'.
  	# [-]NN[.NN][eNN]
  	my $o_valid = PAT_FLOAT;
  	if ( $bundling && defined $rest &&
  	     $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
  	    $arg =~ tr/_//d;
  	    ($key, $arg, $rest) = ($1, $2, $+);
  	    chop($key) if $key;
  	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
  	}
  	elsif ( $arg =~ /^$o_valid$/ ) {
  	    $arg =~ tr/_//d;
  	}
  	else {
  	    if ( defined $optarg || $mand ) {
  		if ( $passthrough ) {
  		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
  		      unless defined $optarg;
  		    return (0);
  		}
  		warn ("Value \"", $arg, "\" invalid for option ",
  		      $opt, " (real number expected)\n");
  		$error++;
  		# Push back.
  		unshift (@$argv, $starter.$rest) if defined $rest;
  		return (1, undef);
  	    }
  	    else {
  		# Push back.
  		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
  		# Supply default value.
  		$arg = 0.0;
  	    }
  	}
      }
      else {
  	die("Getopt::Long internal error (Can't happen)\n");
      }
      return (1, $opt, $ctl, $arg, $key);
  }
  
  sub ValidValue ($$$$$) {
      my ($ctl, $arg, $mand, $argend, $prefix) = @_;
  
      if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  	return 0 unless $arg =~ /[^=]+=(.*)/;
  	$arg = $1;
      }
  
      my $type = $ctl->[CTL_TYPE];
  
      if ( $type eq 's' ) {	# string
  	# A mandatory string takes anything.
  	return (1) if $mand;
  
  	return (1) if $arg eq "-";
  
  	# Check for option or option list terminator.
  	return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
  	return 1;
      }
  
      elsif ( $type eq 'i'	# numeric/integer
              || $type eq 'I'	# numeric/integer w/ incr default
  	    || $type eq 'o' ) { # dec/oct/hex/bin value
  
  	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
  	return $arg =~ /^$o_valid$/si;
      }
  
      elsif ( $type eq 'f' ) { # real number, int is also ok
  	# We require at least one digit before a point or 'e',
  	# and at least one digit following the point and 'e'.
  	# [-]NN[.NN][eNN]
  	my $o_valid = PAT_FLOAT;
  	return $arg =~ /^$o_valid$/;
      }
      die("ValidValue: Cannot happen\n");
  }
  
  # Getopt::Long Configuration.
  sub Configure (@) {
      my (@options) = @_;
  
      my $prevconfig =
        [ $error, $debug, $major_version, $minor_version,
  	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
  	$longprefix ];
  
      if ( ref($options[0]) eq 'ARRAY' ) {
  	( $error, $debug, $major_version, $minor_version,
  	  $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  	  $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
  	  $longprefix ) = @{shift(@options)};
      }
  
      my $opt;
      foreach $opt ( @options ) {
  	my $try = lc ($opt);
  	my $action = 1;
  	if ( $try =~ /^no_?(.*)$/s ) {
  	    $action = 0;
  	    $try = $+;
  	}
  	if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
  	    ConfigDefaults ();
  	}
  	elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
  	    local $ENV{POSIXLY_CORRECT};
  	    $ENV{POSIXLY_CORRECT} = 1 if $action;
  	    ConfigDefaults ();
  	}
  	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
  	    $autoabbrev = $action;
  	}
  	elsif ( $try eq 'getopt_compat' ) {
  	    $getopt_compat = $action;
              $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
  	}
  	elsif ( $try eq 'gnu_getopt' ) {
  	    if ( $action ) {
  		$gnu_compat = 1;
  		$bundling = 1;
  		$getopt_compat = 0;
                  $genprefix = "(--|-)";
  		$order = $PERMUTE;
  	    }
  	}
  	elsif ( $try eq 'gnu_compat' ) {
  	    $gnu_compat = $action;
  	}
  	elsif ( $try =~ /^(auto_?)?version$/ ) {
  	    $auto_version = $action;
  	}
  	elsif ( $try =~ /^(auto_?)?help$/ ) {
  	    $auto_help = $action;
  	}
  	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
  	    $ignorecase = $action;
  	}
  	elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
  	    $ignorecase = $action ? 2 : 0;
  	}
  	elsif ( $try eq 'bundling' ) {
  	    $bundling = $action;
  	}
  	elsif ( $try eq 'bundling_override' ) {
  	    $bundling = $action ? 2 : 0;
  	}
  	elsif ( $try eq 'require_order' ) {
  	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
  	}
  	elsif ( $try eq 'permute' ) {
  	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
  	}
  	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
  	    $passthrough = $action;
  	}
  	elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
  	    $genprefix = $1;
  	    # Turn into regexp. Needs to be parenthesized!
  	    $genprefix = "(" . quotemeta($genprefix) . ")";
  	    eval { '' =~ /$genprefix/; };
  	    die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
  	}
  	elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
  	    $genprefix = $1;
  	    # Parenthesize if needed.
  	    $genprefix = "(" . $genprefix . ")"
  	      unless $genprefix =~ /^\(.*\)$/;
  	    eval { '' =~ m"$genprefix"; };
  	    die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
  	}
  	elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
  	    $longprefix = $1;
  	    # Parenthesize if needed.
  	    $longprefix = "(" . $longprefix . ")"
  	      unless $longprefix =~ /^\(.*\)$/;
  	    eval { '' =~ m"$longprefix"; };
  	    die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n") if $@;
  	}
  	elsif ( $try eq 'debug' ) {
  	    $debug = $action;
  	}
  	else {
  	    die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")
  	}
      }
      $prevconfig;
  }
  
  # Deprecated name.
  sub config (@) {
      Configure (@_);
  }
  
  # Issue a standard message for --version.
  #
  # The arguments are mostly the same as for Pod::Usage::pod2usage:
  #
  #  - a number (exit value)
  #  - a string (lead in message)
  #  - a hash with options. See Pod::Usage for details.
  #
  sub VersionMessage(@) {
      # Massage args.
      my $pa = setup_pa_args("version", @_);
  
      my $v = $main::VERSION;
      my $fh = $pa->{-output} ||
        ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
  
      print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
  	       $0, defined $v ? " version $v" : (),
  	       "\n",
  	       "(", __PACKAGE__, "::", "GetOptions",
  	       " version ",
  	       defined($Getopt::Long::VERSION_STRING)
  	         ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
  	       " Perl version ",
  	       $] >= 5.006 ? sprintf("%vd", $^V) : $],
  	       ")\n");
      exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
  }
  
  # Issue a standard message for --help.
  #
  # The arguments are the same as for Pod::Usage::pod2usage:
  #
  #  - a number (exit value)
  #  - a string (lead in message)
  #  - a hash with options. See Pod::Usage for details.
  #
  sub HelpMessage(@) {
      eval {
  	require Pod::Usage;
  	import Pod::Usage;
  	1;
      } || die("Cannot provide help: cannot load Pod::Usage\n");
  
      # Note that pod2usage will issue a warning if -exitval => NOEXIT.
      pod2usage(setup_pa_args("help", @_));
  
  }
  
  # Helper routine to set up a normalized hash ref to be used as
  # argument to pod2usage.
  sub setup_pa_args($@) {
      my $tag = shift;		# who's calling
  
      # If called by direct binding to an option, it will get the option
      # name and value as arguments. Remove these, if so.
      @_ = () if @_ == 2 && $_[0] eq $tag;
  
      my $pa;
      if ( @_ > 1 ) {
  	$pa = { @_ };
      }
      else {
  	$pa = shift || {};
      }
  
      # At this point, $pa can be a number (exit value), string
      # (message) or hash with options.
  
      if ( UNIVERSAL::isa($pa, 'HASH') ) {
  	# Get rid of -msg vs. -message ambiguity.
  	$pa->{-message} = $pa->{-msg};
  	delete($pa->{-msg});
      }
      elsif ( $pa =~ /^-?\d+$/ ) {
  	$pa = { -exitval => $pa };
      }
      else {
  	$pa = { -message => $pa };
      }
  
      # These are _our_ defaults.
      $pa->{-verbose} = 0 unless exists($pa->{-verbose});
      $pa->{-exitval} = 0 unless exists($pa->{-exitval});
      $pa;
  }
  
  # Sneak way to know what version the user requested.
  sub VERSION {
      $requested_version = $_[1];
      shift->SUPER::VERSION(@_);
  }
  
  package Getopt::Long::CallBack;
  
  sub new {
      my ($pkg, %atts) = @_;
      bless { %atts }, $pkg;
  }
  
  sub name {
      my $self = shift;
      ''.$self->{name};
  }
  
  use overload
    # Treat this object as an ordinary string for legacy API.
    '""'	   => \&name,
    fallback => 1;
  
  1;
  
  ################ Documentation ################
  
  =head1 NAME
  
  Getopt::Long - Extended processing of command line options
  
  =head1 SYNOPSIS
  
    use Getopt::Long;
    my $data   = "file.dat";
    my $length = 24;
    my $verbose;
    GetOptions ("length=i" => \$length,    # numeric
                "file=s"   => \$data,      # string
                "verbose"  => \$verbose)   # flag
    or die("Error in command line arguments\n");
  
  =head1 DESCRIPTION
  
  The Getopt::Long module implements an extended getopt function called
  GetOptions(). It parses the command line from C<@ARGV>, recognizing
  and removing specified options and their possible values.
  
  This function adheres to the POSIX syntax for command
  line options, with GNU extensions. In general, this means that options
  have long names instead of single letters, and are introduced with a
  double dash "--". Support for bundling of command line options, as was
  the case with the more traditional single-letter approach, is provided
  but not enabled by default.
  
  =head1 Command Line Options, an Introduction
  
  Command line operated programs traditionally take their arguments from
  the command line, for example filenames or other information that the
  program needs to know. Besides arguments, these programs often take
  command line I<options> as well. Options are not necessary for the
  program to work, hence the name 'option', but are used to modify its
  default behaviour. For example, a program could do its job quietly,
  but with a suitable option it could provide verbose information about
  what it did.
  
  Command line options come in several flavours. Historically, they are
  preceded by a single dash C<->, and consist of a single letter.
  
      -l -a -c
  
  Usually, these single-character options can be bundled:
  
      -lac
  
  Options can have values, the value is placed after the option
  character. Sometimes with whitespace in between, sometimes not:
  
      -s 24 -s24
  
  Due to the very cryptic nature of these options, another style was
  developed that used long names. So instead of a cryptic C<-l> one
  could use the more descriptive C<--long>. To distinguish between a
  bundle of single-character options and a long one, two dashes are used
  to precede the option name. Early implementations of long options used
  a plus C<+> instead. Also, option values could be specified either
  like
  
      --size=24
  
  or
  
      --size 24
  
  The C<+> form is now obsolete and strongly deprecated.
  
  =head1 Getting Started with Getopt::Long
  
  Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
  first Perl module that provided support for handling the new style of
  command line options, in particular long option names, hence the Perl5
  name Getopt::Long. This module also supports single-character options
  and bundling.
  
  To use Getopt::Long from a Perl program, you must include the
  following line in your Perl program:
  
      use Getopt::Long;
  
  This will load the core of the Getopt::Long module and prepare your
  program for using it. Most of the actual Getopt::Long code is not
  loaded until you really call one of its functions.
  
  In the default configuration, options names may be abbreviated to
  uniqueness, case does not matter, and a single dash is sufficient,
  even for long option names. Also, options may be placed between
  non-option arguments. See L<Configuring Getopt::Long> for more
  details on how to configure Getopt::Long.
  
  =head2 Simple options
  
  The most simple options are the ones that take no values. Their mere
  presence on the command line enables the option. Popular examples are:
  
      --all --verbose --quiet --debug
  
  Handling simple options is straightforward:
  
      my $verbose = '';	# option variable with default value (false)
      my $all = '';	# option variable with default value (false)
      GetOptions ('verbose' => \$verbose, 'all' => \$all);
  
  The call to GetOptions() parses the command line arguments that are
  present in C<@ARGV> and sets the option variable to the value C<1> if
  the option did occur on the command line. Otherwise, the option
  variable is not touched. Setting the option value to true is often
  called I<enabling> the option.
  
  The option name as specified to the GetOptions() function is called
  the option I<specification>. Later we'll see that this specification
  can contain more than just the option name. The reference to the
  variable is called the option I<destination>.
  
  GetOptions() will return a true value if the command line could be
  processed successfully. Otherwise, it will write error messages using
  die() and warn(), and return a false result.
  
  =head2 A little bit less simple options
  
  Getopt::Long supports two useful variants of simple options:
  I<negatable> options and I<incremental> options.
  
  A negatable option is specified with an exclamation mark C<!> after the
  option name:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose!' => \$verbose);
  
  Now, using C<--verbose> on the command line will enable C<$verbose>,
  as expected. But it is also allowed to use C<--noverbose>, which will
  disable C<$verbose> by setting its value to C<0>. Using a suitable
  default value, the program can find out whether C<$verbose> is false
  by default, or disabled by using C<--noverbose>.
  
  An incremental option is specified with a plus C<+> after the
  option name:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose+' => \$verbose);
  
  Using C<--verbose> on the command line will increment the value of
  C<$verbose>. This way the program can keep track of how many times the
  option occurred on the command line. For example, each occurrence of
  C<--verbose> could increase the verbosity level of the program.
  
  =head2 Mixing command line option with other arguments
  
  Usually programs take command line options as well as other arguments,
  for example, file names. It is good practice to always specify the
  options first, and the other arguments last. Getopt::Long will,
  however, allow the options and arguments to be mixed and 'filter out'
  all the options before passing the rest of the arguments to the
  program. To stop Getopt::Long from processing further arguments,
  insert a double dash C<--> on the command line:
  
      --size 24 -- --all
  
  In this example, C<--all> will I<not> be treated as an option, but
  passed to the program unharmed, in C<@ARGV>.
  
  =head2 Options with values
  
  For options that take values it must be specified whether the option
  value is required or not, and what kind of value the option expects.
  
  Three kinds of values are supported: integer numbers, floating point
  numbers, and strings.
  
  If the option value is required, Getopt::Long will take the
  command line argument that follows the option and assign this to the
  option variable. If, however, the option value is specified as
  optional, this will only be done if that value does not look like a
  valid command line option itself.
  
      my $tag = '';	# option variable with default value
      GetOptions ('tag=s' => \$tag);
  
  In the option specification, the option name is followed by an equals
  sign C<=> and the letter C<s>. The equals sign indicates that this
  option requires a value. The letter C<s> indicates that this value is
  an arbitrary string. Other possible value types are C<i> for integer
  values, and C<f> for floating point values. Using a colon C<:> instead
  of the equals sign indicates that the option value is optional. In
  this case, if no suitable value is supplied, string valued options get
  an empty string C<''> assigned, while numeric options are set to C<0>.
  
  =head2 Options with multiple values
  
  Options sometimes take several values. For example, a program could
  use multiple directories to search for library files:
  
      --library lib/stdlib --library lib/extlib
  
  To accomplish this behaviour, simply specify an array reference as the
  destination for the option:
  
      GetOptions ("library=s" => \@libfiles);
  
  Alternatively, you can specify that the option can have multiple
  values by adding a "@", and pass a scalar reference as the
  destination:
  
      GetOptions ("library=s@" => \$libfiles);
  
  Used with the example above, C<@libfiles> (or C<@$libfiles>) would
  contain two strings upon completion: C<"lib/stdlib"> and
  C<"lib/extlib">, in that order. It is also possible to specify that
  only integer or floating point numbers are acceptable values.
  
  Often it is useful to allow comma-separated lists of values as well as
  multiple occurrences of the options. This is easy using Perl's split()
  and join() operators:
  
      GetOptions ("library=s" => \@libfiles);
      @libfiles = split(/,/,join(',',@libfiles));
  
  Of course, it is important to choose the right separator string for
  each purpose.
  
  Warning: What follows is an experimental feature.
  
  Options can take multiple values at once, for example
  
      --coordinates 52.2 16.4 --rgbcolor 255 255 149
  
  This can be accomplished by adding a repeat specifier to the option
  specification. Repeat specifiers are very similar to the C<{...}>
  repeat specifiers that can be used with regular expression patterns.
  For example, the above command line would be handled as follows:
  
      GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
  
  The destination for the option must be an array or array reference.
  
  It is also possible to specify the minimal and maximal number of
  arguments an option takes. C<foo=s{2,4}> indicates an option that
  takes at least two and at most 4 arguments. C<foo=s{1,}> indicates one
  or more values; C<foo:s{,}> indicates zero or more option values.
  
  =head2 Options with hash values
  
  If the option destination is a reference to a hash, the option will
  take, as value, strings of the form I<key>C<=>I<value>. The value will
  be stored with the specified key in the hash.
  
      GetOptions ("define=s" => \%defines);
  
  Alternatively you can use:
  
      GetOptions ("define=s%" => \$defines);
  
  When used with command line options:
  
      --define os=linux --define vendor=redhat
  
  the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
  with value C<"linux"> and C<"vendor"> with value C<"redhat">. It is
  also possible to specify that only integer or floating point numbers
  are acceptable values. The keys are always taken to be strings.
  
  =head2 User-defined subroutines to handle options
  
  Ultimate control over what should be done when (actually: each time)
  an option is encountered on the command line can be achieved by
  designating a reference to a subroutine (or an anonymous subroutine)
  as the option destination. When GetOptions() encounters the option, it
  will call the subroutine with two or three arguments. The first
  argument is the name of the option. (Actually, it is an object that
  stringifies to the name of the option.) For a scalar or array destination,
  the second argument is the value to be stored. For a hash destination,
  the second argument is the key to the hash, and the third argument
  the value to be stored. It is up to the subroutine to store the value,
  or do whatever it thinks is appropriate.
  
  A trivial application of this mechanism is to implement options that
  are related to each other. For example:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose' => \$verbose,
  	        'quiet'   => sub { $verbose = 0 });
  
  Here C<--verbose> and C<--quiet> control the same variable
  C<$verbose>, but with opposite values.
  
  If the subroutine needs to signal an error, it should call die() with
  the desired error message as its argument. GetOptions() will catch the
  die(), issue the error message, and record that an error result must
  be returned upon completion.
  
  If the text of the error message starts with an exclamation mark C<!>
  it is interpreted specially by GetOptions(). There is currently one
  special command implemented: C<die("!FINISH")> will cause GetOptions()
  to stop processing options, as if it encountered a double dash C<-->.
  
  In version 2.37 the first argument to the callback function was
  changed from string to object. This was done to make room for
  extensions and more detailed control. The object stringifies to the
  option name so this change should not introduce compatibility
  problems.
  
  Here is an example of how to access the option name and value from within
  a subroutine:
  
      GetOptions ('opt=i' => \&handler);
      sub handler {
          my ($opt_name, $opt_value) = @_;
          print("Option name is $opt_name and value is $opt_value\n");
      }
  
  =head2 Options with multiple names
  
  Often it is user friendly to supply alternate mnemonic names for
  options. For example C<--height> could be an alternate name for
  C<--length>. Alternate names can be included in the option
  specification, separated by vertical bar C<|> characters. To implement
  the above example:
  
      GetOptions ('length|height=f' => \$length);
  
  The first name is called the I<primary> name, the other names are
  called I<aliases>. When using a hash to store options, the key will
  always be the primary name.
  
  Multiple alternate names are possible.
  
  =head2 Case and abbreviations
  
  Without additional configuration, GetOptions() will ignore the case of
  option names, and allow the options to be abbreviated to uniqueness.
  
      GetOptions ('length|height=f' => \$length, "head" => \$head);
  
  This call will allow C<--l> and C<--L> for the length option, but
  requires a least C<--hea> and C<--hei> for the head and height options.
  
  =head2 Summary of Option Specifications
  
  Each option specifier consists of two parts: the name specification
  and the argument specification.
  
  The name specification contains the name of the option, optionally
  followed by a list of alternative names separated by vertical bar
  characters.
  
      length	      option name is "length"
      length|size|l     name is "length", aliases are "size" and "l"
  
  The argument specification is optional. If omitted, the option is
  considered boolean, a value of 1 will be assigned when the option is
  used on the command line.
  
  The argument specification can be
  
  =over 4
  
  =item !
  
  The option does not take an argument and may be negated by prefixing
  it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
  1 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
  0 will be assigned). If the option has aliases, this applies to the
  aliases as well.
  
  Using negation on a single letter option when bundling is in effect is
  pointless and will result in a warning.
  
  =item +
  
  The option does not take an argument and will be incremented by 1
  every time it appears on the command line. E.g. C<"more+">, when used
  with C<--more --more --more>, will increment the value three times,
  resulting in a value of 3 (provided it was 0 or undefined at first).
  
  The C<+> specifier is ignored if the option destination is not a scalar.
  
  =item = I<type> [ I<desttype> ] [ I<repeat> ]
  
  The option requires an argument of the given type. Supported types
  are:
  
  =over 4
  
  =item s
  
  String. An arbitrary sequence of characters. It is valid for the
  argument to start with C<-> or C<-->.
  
  =item i
  
  Integer. An optional leading plus or minus sign, followed by a
  sequence of digits.
  
  =item o
  
  Extended integer, Perl style. This can be either an optional leading
  plus or minus sign, followed by a sequence of digits, or an octal
  string (a zero, optionally followed by '0', '1', .. '7'), or a
  hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
  insensitive), or a binary string (C<0b> followed by a series of '0'
  and '1').
  
  =item f
  
  Real number. For example C<3.14>, C<-6.23E24> and so on.
  
  =back
  
  The I<desttype> can be C<@> or C<%> to specify that the option is
  list or a hash valued. This is only needed when the destination for
  the option value is not otherwise specified. It should be omitted when
  not needed.
  
  The I<repeat> specifies the number of values this option takes per
  occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
  
  I<min> denotes the minimal number of arguments. It defaults to 1 for
  options with C<=> and to 0 for options with C<:>, see below. Note that
  I<min> overrules the C<=> / C<:> semantics.
  
  I<max> denotes the maximum number of arguments. It must be at least
  I<min>. If I<max> is omitted, I<but the comma is not>, there is no
  upper bound to the number of argument values taken.
  
  =item : I<type> [ I<desttype> ]
  
  Like C<=>, but designates the argument as optional.
  If omitted, an empty string will be assigned to string values options,
  and the value zero to numeric options.
  
  Note that if a string argument starts with C<-> or C<-->, it will be
  considered an option on itself.
  
  =item : I<number> [ I<desttype> ]
  
  Like C<:i>, but if the value is omitted, the I<number> will be assigned.
  
  =item : + [ I<desttype> ]
  
  Like C<:i>, but if the value is omitted, the current value for the
  option will be incremented.
  
  =back
  
  =head1 Advanced Possibilities
  
  =head2 Object oriented interface
  
  Getopt::Long can be used in an object oriented way as well:
  
      use Getopt::Long;
      $p = Getopt::Long::Parser->new;
      $p->configure(...configuration options...);
      if ($p->getoptions(...options descriptions...)) ...
      if ($p->getoptionsfromarray( \@array, ...options descriptions...)) ...
  
  Configuration options can be passed to the constructor:
  
      $p = new Getopt::Long::Parser
               config => [...configuration options...];
  
  =head2 Thread Safety
  
  Getopt::Long is thread safe when using ithreads as of Perl 5.8.  It is
  I<not> thread safe when using the older (experimental and now
  obsolete) threads implementation that was added to Perl 5.005.
  
  =head2 Documentation and help texts
  
  Getopt::Long encourages the use of Pod::Usage to produce help
  messages. For example:
  
      use Getopt::Long;
      use Pod::Usage;
  
      my $man = 0;
      my $help = 0;
  
      GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
      pod2usage(1) if $help;
      pod2usage(-exitval => 0, -verbose => 2) if $man;
  
      __END__
  
      =head1 NAME
  
      sample - Using Getopt::Long and Pod::Usage
  
      =head1 SYNOPSIS
  
      sample [options] [file ...]
  
       Options:
         -help            brief help message
         -man             full documentation
  
      =head1 OPTIONS
  
      =over 8
  
      =item B<-help>
  
      Print a brief help message and exits.
  
      =item B<-man>
  
      Prints the manual page and exits.
  
      =back
  
      =head1 DESCRIPTION
  
      B<This program> will read the given input file(s) and do something
      useful with the contents thereof.
  
      =cut
  
  See L<Pod::Usage> for details.
  
  =head2 Parsing options from an arbitrary array
  
  By default, GetOptions parses the options that are present in the
  global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
  used to parse options from an arbitrary array.
  
      use Getopt::Long qw(GetOptionsFromArray);
      $ret = GetOptionsFromArray(\@myopts, ...);
  
  When used like this, options and their possible values are removed
  from C<@myopts>, the global C<@ARGV> is not touched at all.
  
  The following two calls behave identically:
  
      $ret = GetOptions( ... );
      $ret = GetOptionsFromArray(\@ARGV, ... );
  
  This also means that a first argument hash reference now becomes the
  second argument:
  
      $ret = GetOptions(\%opts, ... );
      $ret = GetOptionsFromArray(\@ARGV, \%opts, ... );
  
  =head2 Parsing options from an arbitrary string
  
  A special entry C<GetOptionsFromString> can be used to parse options
  from an arbitrary string.
  
      use Getopt::Long qw(GetOptionsFromString);
      $ret = GetOptionsFromString($string, ...);
  
  The contents of the string are split into arguments using a call to
  C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
  global C<@ARGV> is not touched.
  
  It is possible that, upon completion, not all arguments in the string
  have been processed. C<GetOptionsFromString> will, when called in list
  context, return both the return status and an array reference to any
  remaining arguments:
  
      ($ret, $args) = GetOptionsFromString($string, ... );
  
  If any arguments remain, and C<GetOptionsFromString> was not called in
  list context, a message will be given and C<GetOptionsFromString> will
  return failure.
  
  As with GetOptionsFromArray, a first argument hash reference now
  becomes the second argument.
  
  =head2 Storing options values in a hash
  
  Sometimes, for example when there are a lot of options, having a
  separate variable for each of them can be cumbersome. GetOptions()
  supports, as an alternative mechanism, storing options values in a
  hash.
  
  To obtain this, a reference to a hash must be passed I<as the first
  argument> to GetOptions(). For each option that is specified on the
  command line, the option value will be stored in the hash with the
  option name as key. Options that are not actually used on the command
  line will not be put in the hash, on other words,
  C<exists($h{option})> (or defined()) can be used to test if an option
  was used. The drawback is that warnings will be issued if the program
  runs under C<use strict> and uses C<$h{option}> without testing with
  exists() or defined() first.
  
      my %h = ();
      GetOptions (\%h, 'length=i');	# will store in $h{length}
  
  For options that take list or hash values, it is necessary to indicate
  this by appending an C<@> or C<%> sign after the type:
  
      GetOptions (\%h, 'colours=s@');	# will push to @{$h{colours}}
  
  To make things more complicated, the hash may contain references to
  the actual destinations, for example:
  
      my $len = 0;
      my %h = ('length' => \$len);
      GetOptions (\%h, 'length=i');	# will store in $len
  
  This example is fully equivalent with:
  
      my $len = 0;
      GetOptions ('length=i' => \$len);	# will store in $len
  
  Any mixture is possible. For example, the most frequently used options
  could be stored in variables while all other options get stored in the
  hash:
  
      my $verbose = 0;			# frequently referred
      my $debug = 0;			# frequently referred
      my %h = ('verbose' => \$verbose, 'debug' => \$debug);
      GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
      if ( $verbose ) { ... }
      if ( exists $h{filter} ) { ... option 'filter' was specified ... }
  
  =head2 Bundling
  
  With bundling it is possible to set several single-character options
  at once. For example if C<a>, C<v> and C<x> are all valid options,
  
      -vax
  
  would set all three.
  
  Getopt::Long supports two levels of bundling. To enable bundling, a
  call to Getopt::Long::Configure is required.
  
  The first level of bundling can be enabled with:
  
      Getopt::Long::Configure ("bundling");
  
  Configured this way, single-character options can be bundled but long
  options B<must> always start with a double dash C<--> to avoid
  ambiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
  options,
  
      -vax
  
  would set C<a>, C<v> and C<x>, but
  
      --vax
  
  would set C<vax>.
  
  The second level of bundling lifts this restriction. It can be enabled
  with:
  
      Getopt::Long::Configure ("bundling_override");
  
  Now, C<-vax> would set the option C<vax>.
  
  When any level of bundling is enabled, option values may be inserted
  in the bundle. For example:
  
      -h24w80
  
  is equivalent to
  
      -h 24 -w 80
  
  When configured for bundling, single-character options are matched
  case sensitive while long options are matched case insensitive. To
  have the single-character options matched case insensitive as well,
  use:
  
      Getopt::Long::Configure ("bundling", "ignorecase_always");
  
  It goes without saying that bundling can be quite confusing.
  
  =head2 The lonesome dash
  
  Normally, a lone dash C<-> on the command line will not be considered
  an option. Option processing will terminate (unless "permute" is
  configured) and the dash will be left in C<@ARGV>.
  
  It is possible to get special treatment for a lone dash. This can be
  achieved by adding an option specification with an empty name, for
  example:
  
      GetOptions ('' => \$stdio);
  
  A lone dash on the command line will now be a legal option, and using
  it will set variable C<$stdio>.
  
  =head2 Argument callback
  
  A special option 'name' C<< <> >> can be used to designate a subroutine
  to handle non-option arguments. When GetOptions() encounters an
  argument that does not look like an option, it will immediately call this
  subroutine and passes it one parameter: the argument name. Well, actually
  it is an object that stringifies to the argument name.
  
  For example:
  
      my $width = 80;
      sub process { ... }
      GetOptions ('width=i' => \$width, '<>' => \&process);
  
  When applied to the following command line:
  
      arg1 --width=72 arg2 --width=60 arg3
  
  This will call
  C<process("arg1")> while C<$width> is C<80>,
  C<process("arg2")> while C<$width> is C<72>, and
  C<process("arg3")> while C<$width> is C<60>.
  
  This feature requires configuration option B<permute>, see section
  L<Configuring Getopt::Long>.
  
  =head1 Configuring Getopt::Long
  
  Getopt::Long can be configured by calling subroutine
  Getopt::Long::Configure(). This subroutine takes a list of quoted
  strings, each specifying a configuration option to be enabled, e.g.
  C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
  matter. Multiple calls to Configure() are possible.
  
  Alternatively, as of version 2.24, the configuration options may be
  passed together with the C<use> statement:
  
      use Getopt::Long qw(:config no_ignore_case bundling);
  
  The following options are available:
  
  =over 12
  
  =item default
  
  This option causes all configuration options to be reset to their
  default values.
  
  =item posix_default
  
  This option causes all configuration options to be reset to their
  default values as if the environment variable POSIXLY_CORRECT had
  been set.
  
  =item auto_abbrev
  
  Allow option names to be abbreviated to uniqueness.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
  
  =item getopt_compat
  
  Allow C<+> to start options.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
  
  =item gnu_compat
  
  C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
  do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
  C<--opt=> will give option C<opt> and empty value.
  This is the way GNU getopt_long() does it.
  
  =item gnu_getopt
  
  This is a short way of setting C<gnu_compat> C<bundling> C<permute>
  C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
  fully compatible with GNU getopt_long().
  
  =item require_order
  
  Whether command line arguments are allowed to be mixed with options.
  Default is disabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
  
  See also C<permute>, which is the opposite of C<require_order>.
  
  =item permute
  
  Whether command line arguments are allowed to be mixed with options.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
  Note that C<permute> is the opposite of C<require_order>.
  
  If C<permute> is enabled, this means that
  
      --foo arg1 --bar arg2 arg3
  
  is equivalent to
  
      --foo --bar arg1 arg2 arg3
  
  If an argument callback routine is specified, C<@ARGV> will always be
  empty upon successful return of GetOptions() since all options have been
  processed. The only exception is when C<--> is used:
  
      --foo arg1 --bar arg2 -- arg3
  
  This will call the callback routine for arg1 and arg2, and then
  terminate GetOptions() leaving C<"arg3"> in C<@ARGV>.
  
  If C<require_order> is enabled, options processing
  terminates when the first non-option is encountered.
  
      --foo arg1 --bar arg2 arg3
  
  is equivalent to
  
      --foo -- arg1 --bar arg2 arg3
  
  If C<pass_through> is also enabled, options processing will terminate
  at the first unrecognized option, or non-option, whichever comes
  first.
  
  =item bundling (default: disabled)
  
  Enabling this option will allow single-character options to be
  bundled. To distinguish bundles from long option names, long options
  I<must> be introduced with C<--> and bundles with C<->.
  
  Note that, if you have options C<a>, C<l> and C<all>, and
  auto_abbrev enabled, possible arguments and option settings are:
  
      using argument               sets option(s)
      ------------------------------------------
      -a, --a                      a
      -l, --l                      l
      -al, -la, -ala, -all,...     a, l
      --al, --all                  all
  
  The surprising part is that C<--a> sets option C<a> (due to auto
  completion), not C<all>.
  
  Note: disabling C<bundling> also disables C<bundling_override>.
  
  =item bundling_override (default: disabled)
  
  If C<bundling_override> is enabled, bundling is enabled as with
  C<bundling> but now long option names override option bundles.
  
  Note: disabling C<bundling_override> also disables C<bundling>.
  
  B<Note:> Using option bundling can easily lead to unexpected results,
  especially when mixing long options and bundles. Caveat emptor.
  
  =item ignore_case  (default: enabled)
  
  If enabled, case is ignored when matching option names. If, however,
  bundling is enabled as well, single character options will be treated
  case-sensitive.
  
  With C<ignore_case>, option specifications for options that only
  differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
  duplicates.
  
  Note: disabling C<ignore_case> also disables C<ignore_case_always>.
  
  =item ignore_case_always (default: disabled)
  
  When bundling is in effect, case is ignored on single-character
  options also.
  
  Note: disabling C<ignore_case_always> also disables C<ignore_case>.
  
  =item auto_version (default:disabled)
  
  Automatically provide support for the B<--version> option if
  the application did not specify a handler for this option itself.
  
  Getopt::Long will provide a standard version message that includes the
  program name, its version (if $main::VERSION is defined), and the
  versions of Getopt::Long and Perl. The message will be written to
  standard output and processing will terminate.
  
  C<auto_version> will be enabled if the calling program explicitly
  specified a version number higher than 2.32 in the C<use> or
  C<require> statement.
  
  =item auto_help (default:disabled)
  
  Automatically provide support for the B<--help> and B<-?> options if
  the application did not specify a handler for this option itself.
  
  Getopt::Long will provide a help message using module L<Pod::Usage>. The
  message, derived from the SYNOPSIS POD section, will be written to
  standard output and processing will terminate.
  
  C<auto_help> will be enabled if the calling program explicitly
  specified a version number higher than 2.32 in the C<use> or
  C<require> statement.
  
  =item pass_through (default: disabled)
  
  Options that are unknown, ambiguous or supplied with an invalid option
  value are passed through in C<@ARGV> instead of being flagged as
  errors. This makes it possible to write wrapper scripts that process
  only part of the user supplied command line arguments, and pass the
  remaining options to some other program.
  
  If C<require_order> is enabled, options processing will terminate at
  the first unrecognized option, or non-option, whichever comes first.
  However, if C<permute> is enabled instead, results can become confusing.
  
  Note that the options terminator (default C<-->), if present, will
  also be passed through in C<@ARGV>.
  
  =item prefix
  
  The string that starts options. If a constant string is not
  sufficient, see C<prefix_pattern>.
  
  =item prefix_pattern
  
  A Perl pattern that identifies the strings that introduce options.
  Default is C<--|-|\+> unless environment variable
  POSIXLY_CORRECT has been set, in which case it is C<--|->.
  
  =item long_prefix_pattern
  
  A Perl pattern that allows the disambiguation of long and short
  prefixes. Default is C<-->.
  
  Typically you only need to set this if you are using nonstandard
  prefixes and want some or all of them to have the same semantics as
  '--' does under normal circumstances.
  
  For example, setting prefix_pattern to C<--|-|\+|\/> and
  long_prefix_pattern to C<--|\/> would add Win32 style argument
  handling.
  
  =item debug (default: disabled)
  
  Enable debugging output.
  
  =back
  
  =head1 Exportable Methods
  
  =over
  
  =item VersionMessage
  
  This subroutine provides a standard version message. Its argument can be:
  
  =over 4
  
  =item *
  
  A string containing the text of a message to print I<before> printing
  the standard message.
  
  =item *
  
  A numeric value corresponding to the desired exit status.
  
  =item *
  
  A reference to a hash.
  
  =back
  
  If more than one argument is given then the entire argument list is
  assumed to be a hash.  If a hash is supplied (either as a reference or
  as a list) it should contain one or more elements with the following
  keys:
  
  =over 4
  
  =item C<-message>
  
  =item C<-msg>
  
  The text of a message to print immediately prior to printing the
  program's usage message.
  
  =item C<-exitval>
  
  The desired exit status to pass to the B<exit()> function.
  This should be an integer, or else the string "NOEXIT" to
  indicate that control should simply be returned without
  terminating the invoking process.
  
  =item C<-output>
  
  A reference to a filehandle, or the pathname of a file to which the
  usage message should be written. The default is C<\*STDERR> unless the
  exit value is less than 2 (in which case the default is C<\*STDOUT>).
  
  =back
  
  You cannot tie this routine directly to an option, e.g.:
  
      GetOptions("version" => \&VersionMessage);
  
  Use this instead:
  
      GetOptions("version" => sub { VersionMessage() });
  
  =item HelpMessage
  
  This subroutine produces a standard help message, derived from the
  program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
  arguments as VersionMessage(). In particular, you cannot tie it
  directly to an option, e.g.:
  
      GetOptions("help" => \&HelpMessage);
  
  Use this instead:
  
      GetOptions("help" => sub { HelpMessage() });
  
  =back
  
  =head1 Return values and Errors
  
  Configuration errors and errors in the option definitions are
  signalled using die() and will terminate the calling program unless
  the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
  }>, or die() was trapped using C<$SIG{__DIE__}>.
  
  GetOptions returns true to indicate success.
  It returns false when the function detected one or more errors during
  option parsing. These errors are signalled using warn() and can be
  trapped with C<$SIG{__WARN__}>.
  
  =head1 Legacy
  
  The earliest development of C<newgetopt.pl> started in 1990, with Perl
  version 4. As a result, its development, and the development of
  Getopt::Long, has gone through several stages. Since backward
  compatibility has always been extremely important, the current version
  of Getopt::Long still supports a lot of constructs that nowadays are
  no longer necessary or otherwise unwanted. This section describes
  briefly some of these 'features'.
  
  =head2 Default destinations
  
  When no destination is specified for an option, GetOptions will store
  the resultant value in a global variable named C<opt_>I<XXX>, where
  I<XXX> is the primary name of this option. When a program executes
  under C<use strict> (recommended), these variables must be
  pre-declared with our() or C<use vars>.
  
      our $opt_length = 0;
      GetOptions ('length=i');	# will store in $opt_length
  
  To yield a usable Perl variable, characters that are not part of the
  syntax for variables are translated to underscores. For example,
  C<--fpp-struct-return> will set the variable
  C<$opt_fpp_struct_return>. Note that this variable resides in the
  namespace of the calling program, not necessarily C<main>. For
  example:
  
      GetOptions ("size=i", "sizes=i@");
  
  with command line "-size 10 -sizes 24 -sizes 48" will perform the
  equivalent of the assignments
  
      $opt_size = 10;
      @opt_sizes = (24, 48);
  
  =head2 Alternative option starters
  
  A string of alternative option starter characters may be passed as the
  first argument (or the first argument after a leading hash reference
  argument).
  
      my $len = 0;
      GetOptions ('/', 'length=i' => $len);
  
  Now the command line may look like:
  
      /length 24 -- arg
  
  Note that to terminate options processing still requires a double dash
  C<-->.
  
  GetOptions() will not interpret a leading C<< "<>" >> as option starters
  if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
  option starters, use C<< "><" >>. Confusing? Well, B<using a starter
  argument is strongly deprecated> anyway.
  
  =head2 Configuration variables
  
  Previous versions of Getopt::Long used variables for the purpose of
  configuring. Although manipulating these variables still work, it is
  strongly encouraged to use the C<Configure> routine that was introduced
  in version 2.17. Besides, it is much easier.
  
  =head1 Tips and Techniques
  
  =head2 Pushing multiple values in a hash option
  
  Sometimes you want to combine the best of hashes and arrays. For
  example, the command line:
  
    --list add=first --list add=second --list add=third
  
  where each successive 'list add' option will push the value of add
  into array ref $list->{'add'}. The result would be like
  
    $list->{add} = [qw(first second third)];
  
  This can be accomplished with a destination routine:
  
    GetOptions('list=s%' =>
                 sub { push(@{$list{$_[1]}}, $_[2]) });
  
  =head1 Troubleshooting
  
  =head2 GetOptions does not return a false result when an option is not supplied
  
  That's why they're called 'options'.
  
  =head2 GetOptions does not split the command line correctly
  
  The command line is not split by GetOptions, but by the command line
  interpreter (CLI). On Unix, this is the shell. On Windows, it is
  COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
  
  It is important to know that these CLIs may behave different when the
  command line contains special characters, in particular quotes or
  backslashes. For example, with Unix shells you can use single quotes
  (C<'>) and double quotes (C<">) to group words together. The following
  alternatives are equivalent on Unix:
  
      "two words"
      'two words'
      two\ words
  
  In case of doubt, insert the following statement in front of your Perl
  program:
  
      print STDERR (join("|",@ARGV),"\n");
  
  to verify how your CLI passes the arguments to the program.
  
  =head2 Undefined subroutine &main::GetOptions called
  
  Are you running Windows, and did you write
  
      use GetOpt::Long;
  
  (note the capital 'O')?
  
  =head2 How do I put a "-?" option into a Getopt::Long?
  
  You can only obtain this using an alias, and Getopt::Long of at least
  version 2.13.
  
      use Getopt::Long;
      GetOptions ("help|?");    # -help and -? will both set $opt_help
  
  Other characters that can't appear in Perl identifiers are also supported
  as aliases with Getopt::Long of at least version 2.39.
  
  As of version 2.32 Getopt::Long provides auto-help, a quick and easy way
  to add the options --help and -? to your program, and handle them.
  
  See C<auto_help> in section L<Configuring Getopt::Long>.
  
  =head1 AUTHOR
  
  Johan Vromans <jvromans@squirrel.nl>
  
  =head1 COPYRIGHT AND DISCLAIMER
  
  This program is Copyright 1990,2013 by Johan Vromans.
  This program is free software; you can redistribute it and/or
  modify it under the terms of the Perl Artistic License or the
  GNU General Public License as published by the Free Software
  Foundation; either version 2 of the License, or (at your option) any
  later version.
  
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
  
  If you do not have a copy of the GNU General Public License write to
  the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
  MA 02139, USA.
  
  =cut
  
GETOPT_LONG

$fatpacked{"JSON.pm"} = <<'JSON';
  package JSON;
  
  
  use strict;
  use Carp ();
  use base qw(Exporter);
  @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json);
  
  BEGIN {
      $JSON::VERSION = '2.59';
      $JSON::DEBUG   = 0 unless (defined $JSON::DEBUG);
      $JSON::DEBUG   = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG };
  }
  
  my $Module_XS  = 'JSON::XS';
  my $Module_PP  = 'JSON::PP';
  my $Module_bp  = 'JSON::backportPP'; # included in JSON distribution
  my $PP_Version = '2.27200';
  my $XS_Version = '2.34';
  
  
  # XS and PP common methods
  
  my @PublicMethods = qw/
      ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref 
      allow_blessed convert_blessed filter_json_object filter_json_single_key_object 
      shrink max_depth max_size encode decode decode_prefix allow_unknown
  /;
  
  my @Properties = qw/
      ascii latin1 utf8 indent space_before space_after relaxed canonical allow_nonref
      allow_blessed convert_blessed shrink max_depth max_size allow_unknown
  /;
  
  my @XSOnlyMethods = qw//; # Currently nothing
  
  my @PPOnlyMethods = qw/
      indent_length sort_by
      allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed
  /; # JSON::PP specific
  
  
  # used in _load_xs and _load_pp ($INSTALL_ONLY is not used currently)
  my $_INSTALL_DONT_DIE  = 1; # When _load_xs fails to load XS, don't die.
  my $_INSTALL_ONLY      = 2; # Don't call _set_methods()
  my $_ALLOW_UNSUPPORTED = 0;
  my $_UNIV_CONV_BLESSED = 0;
  my $_USSING_bpPP       = 0;
  
  
  # Check the environment variable to decide worker module. 
  
  unless ($JSON::Backend) {
      $JSON::DEBUG and  Carp::carp("Check used worker module...");
  
      my $backend = exists $ENV{PERL_JSON_BACKEND} ? $ENV{PERL_JSON_BACKEND} : 1;
  
      if ($backend eq '1' or $backend =~ /JSON::XS\s*,\s*JSON::PP/) {
          _load_xs($_INSTALL_DONT_DIE) or _load_pp();
      }
      elsif ($backend eq '0' or $backend eq 'JSON::PP') {
          _load_pp();
      }
      elsif ($backend eq '2' or $backend eq 'JSON::XS') {
          _load_xs();
      }
      elsif ($backend eq 'JSON::backportPP') {
          $_USSING_bpPP = 1;
          _load_pp();
      }
      else {
          Carp::croak "The value of environmental variable 'PERL_JSON_BACKEND' is invalid.";
      }
  }
  
  
  sub import {
      my $pkg = shift;
      my @what_to_export;
      my $no_export;
  
      for my $tag (@_) {
          if ($tag eq '-support_by_pp') {
              if (!$_ALLOW_UNSUPPORTED++) {
                  JSON::Backend::XS
                      ->support_by_pp(@PPOnlyMethods) if ($JSON::Backend eq $Module_XS);
              }
              next;
          }
          elsif ($tag eq '-no_export') {
              $no_export++, next;
          }
          elsif ( $tag eq '-convert_blessed_universally' ) {
              eval q|
                  require B;
                  *UNIVERSAL::TO_JSON = sub {
                      my $b_obj = B::svref_2object( $_[0] );
                      return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
                              : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
                              : undef
                              ;
                  }
              | if ( !$_UNIV_CONV_BLESSED++ );
              next;
          }
          push @what_to_export, $tag;
      }
  
      return if ($no_export);
  
      __PACKAGE__->export_to_level(1, $pkg, @what_to_export);
  }
  
  
  # OBSOLETED
  
  sub jsonToObj {
      my $alternative = 'from_json';
      if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
          shift @_; $alternative = 'decode';
      }
      Carp::carp "'jsonToObj' will be obsoleted. Please use '$alternative' instead.";
      return JSON::from_json(@_);
  };
  
  sub objToJson {
      my $alternative = 'to_json';
      if (defined $_[0] and UNIVERSAL::isa($_[0], 'JSON')) {
          shift @_; $alternative = 'encode';
      }
      Carp::carp "'objToJson' will be obsoleted. Please use '$alternative' instead.";
      JSON::to_json(@_);
  };
  
  
  # INTERFACES
  
  sub to_json ($@) {
      if (
          ref($_[0]) eq 'JSON'
          or (@_ > 2 and $_[0] eq 'JSON')
      ) {
          Carp::croak "to_json should not be called as a method.";
      }
      my $json = JSON->new;
  
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
  
      $json->encode($_[0]);
  }
  
  
  sub from_json ($@) {
      if ( ref($_[0]) eq 'JSON' or $_[0] eq 'JSON' ) {
          Carp::croak "from_json should not be called as a method.";
      }
      my $json = JSON->new;
  
      if (@_ == 2 and ref $_[1] eq 'HASH') {
          my $opt  = $_[1];
          for my $method (keys %$opt) {
              $json->$method( $opt->{$method} );
          }
      }
  
      return $json->decode( $_[0] );
  }
  
  
  sub true  { $JSON::true  }
  
  sub false { $JSON::false }
  
  sub null  { undef; }
  
  
  sub require_xs_version { $XS_Version; }
  
  sub backend {
      my $proto = shift;
      $JSON::Backend;
  }
  
  #*module = *backend;
  
  
  sub is_xs {
      return $_[0]->module eq $Module_XS;
  }
  
  
  sub is_pp {
      return not $_[0]->xs;
  }
  
  
  sub pureperl_only_methods { @PPOnlyMethods; }
  
  
  sub property {
      my ($self, $name, $value) = @_;
  
      if (@_ == 1) {
          my %props;
          for $name (@Properties) {
              my $method = 'get_' . $name;
              if ($name eq 'max_size') {
                  my $value = $self->$method();
                  $props{$name} = $value == 1 ? 0 : $value;
                  next;
              }
              $props{$name} = $self->$method();
          }
          return \%props;
      }
      elsif (@_ > 3) {
          Carp::croak('property() can take only the option within 2 arguments.');
      }
      elsif (@_ == 2) {
          if ( my $method = $self->can('get_' . $name) ) {
              if ($name eq 'max_size') {
                  my $value = $self->$method();
                  return $value == 1 ? 0 : $value;
              }
              $self->$method();
          }
      }
      else {
          $self->$name($value);
      }
  
  }
  
  
  
  # INTERNAL
  
  sub _load_xs {
      my $opt = shift;
  
      $JSON::DEBUG and Carp::carp "Load $Module_XS.";
  
      # if called after install module, overload is disable.... why?
      JSON::Boolean::_overrride_overload($Module_XS);
      JSON::Boolean::_overrride_overload($Module_PP);
  
      eval qq|
          use $Module_XS $XS_Version ();
      |;
  
      if ($@) {
          if (defined $opt and $opt & $_INSTALL_DONT_DIE) {
              $JSON::DEBUG and Carp::carp "Can't load $Module_XS...($@)";
              return 0;
          }
          Carp::croak $@;
      }
  
      unless (defined $opt and $opt & $_INSTALL_ONLY) {
          _set_module( $JSON::Backend = $Module_XS );
          my $data = join("", <DATA>); # this code is from Jcode 2.xx.
          close(DATA);
          eval $data;
          JSON::Backend::XS->init;
      }
  
      return 1;
  };
  
  
  sub _load_pp {
      my $opt = shift;
      my $backend = $_USSING_bpPP ? $Module_bp : $Module_PP;
  
      $JSON::DEBUG and Carp::carp "Load $backend.";
  
      # if called after install module, overload is disable.... why?
      JSON::Boolean::_overrride_overload($Module_XS);
      JSON::Boolean::_overrride_overload($backend);
  
      if ( $_USSING_bpPP ) {
          eval qq| require $backend |;
      }
      else {
          eval qq| use $backend $PP_Version () |;
      }
  
      if ($@) {
          if ( $backend eq $Module_PP ) {
              $JSON::DEBUG and Carp::carp "Can't load $Module_PP ($@), so try to load $Module_bp";
              $_USSING_bpPP++;
              $backend = $Module_bp;
              JSON::Boolean::_overrride_overload($backend);
              local $^W; # if PP installed but invalid version, backportPP redefines methods.
              eval qq| require $Module_bp |;
          }
          Carp::croak $@ if $@;
      }
  
      unless (defined $opt and $opt & $_INSTALL_ONLY) {
          _set_module( $JSON::Backend = $Module_PP ); # even if backportPP, set $Backend with 'JSON::PP'
          JSON::Backend::PP->init;
      }
  };
  
  
  sub _set_module {
      return if defined $JSON::true;
  
      my $module = shift;
  
      local $^W;
      no strict qw(refs);
  
      $JSON::true  = ${"$module\::true"};
      $JSON::false = ${"$module\::false"};
  
      push @JSON::ISA, $module;
      push @{"$module\::Boolean::ISA"}, qw(JSON::Boolean);
  
      *{"JSON::is_bool"} = \&{"$module\::is_bool"};
  
      for my $method ($module eq $Module_XS ? @PPOnlyMethods : @XSOnlyMethods) {
          *{"JSON::$method"} = sub {
              Carp::carp("$method is not supported in $module.");
              $_[0];
          };
      }
  
      return 1;
  }
  
  
  
  #
  # JSON Boolean
  #
  
  package JSON::Boolean;
  
  my %Installed;
  
  sub _overrride_overload {
      return if ($Installed{ $_[0] }++);
  
      my $boolean = $_[0] . '::Boolean';
  
      eval sprintf(q|
          package %s;
          use overload (
              '""' => sub { ${$_[0]} == 1 ? 'true' : 'false' },
              'eq' => sub {
                  my ($obj, $op) = ref ($_[0]) ? ($_[0], $_[1]) : ($_[1], $_[0]);
                  if ($op eq 'true' or $op eq 'false') {
                      return "$obj" eq 'true' ? 'true' eq $op : 'false' eq $op;
                  }
                  else {
                      return $obj ? 1 == $op : 0 == $op;
                  }
              },
          );
      |, $boolean);
  
      if ($@) { Carp::croak $@; }
  
      if ( exists $INC{'JSON/XS.pm'} and $boolean eq 'JSON::XS::Boolean' ) {
          local $^W;
          my $true  = do { bless \(my $dummy = 1), $boolean };
          my $false = do { bless \(my $dummy = 0), $boolean };
          *JSON::XS::true  = sub () { $true };
          *JSON::XS::false = sub () { $false };
      }
      elsif ( exists $INC{'JSON/PP.pm'} and $boolean eq 'JSON::PP::Boolean' ) {
          local $^W;
          my $true  = do { bless \(my $dummy = 1), $boolean };
          my $false = do { bless \(my $dummy = 0), $boolean };
          *JSON::PP::true  = sub { $true };
          *JSON::PP::false = sub { $false };
      }
  
      return 1;
  }
  
  
  #
  # Helper classes for Backend Module (PP)
  #
  
  package JSON::Backend::PP;
  
  sub init {
      local $^W;
      no strict qw(refs); # this routine may be called after JSON::Backend::XS init was called.
      *{"JSON::decode_json"} = \&{"JSON::PP::decode_json"};
      *{"JSON::encode_json"} = \&{"JSON::PP::encode_json"};
      *{"JSON::PP::is_xs"}  = sub { 0 };
      *{"JSON::PP::is_pp"}  = sub { 1 };
      return 1;
  }
  
  #
  # To save memory, the below lines are read only when XS backend is used.
  #
  
  package JSON;
  
  1;
  __DATA__
  
  
  #
  # Helper classes for Backend Module (XS)
  #
  
  package JSON::Backend::XS;
  
  use constant INDENT_LENGTH_FLAG => 15 << 12;
  
  use constant UNSUPPORTED_ENCODE_FLAG => {
      ESCAPE_SLASH      => 0x00000010,
      ALLOW_BIGNUM      => 0x00000020,
      AS_NONBLESSED     => 0x00000040,
      EXPANDED          => 0x10000000, # for developer's
  };
  
  use constant UNSUPPORTED_DECODE_FLAG => {
      LOOSE             => 0x00000001,
      ALLOW_BIGNUM      => 0x00000002,
      ALLOW_BAREKEY     => 0x00000004,
      ALLOW_SINGLEQUOTE => 0x00000008,
      EXPANDED          => 0x20000000, # for developer's
  };
  
  
  sub init {
      local $^W;
      no strict qw(refs);
      *{"JSON::decode_json"} = \&{"JSON::XS::decode_json"};
      *{"JSON::encode_json"} = \&{"JSON::XS::encode_json"};
      *{"JSON::XS::is_xs"}  = sub { 1 };
      *{"JSON::XS::is_pp"}  = sub { 0 };
      return 1;
  }
  
  
  sub support_by_pp {
      my ($class, @methods) = @_;
  
      local $^W;
      no strict qw(refs);
  
      my $JSON_XS_encode_orignal     = \&JSON::XS::encode;
      my $JSON_XS_decode_orignal     = \&JSON::XS::decode;
      my $JSON_XS_incr_parse_orignal = \&JSON::XS::incr_parse;
  
      *JSON::XS::decode     = \&JSON::Backend::XS::Supportable::_decode;
      *JSON::XS::encode     = \&JSON::Backend::XS::Supportable::_encode;
      *JSON::XS::incr_parse = \&JSON::Backend::XS::Supportable::_incr_parse;
  
      *{JSON::XS::_original_decode}     = $JSON_XS_decode_orignal;
      *{JSON::XS::_original_encode}     = $JSON_XS_encode_orignal;
      *{JSON::XS::_original_incr_parse} = $JSON_XS_incr_parse_orignal;
  
      push @JSON::Backend::XS::Supportable::ISA, 'JSON';
  
      my $pkg = 'JSON::Backend::XS::Supportable';
  
      *{JSON::new} = sub {
          my $proto = JSON::XS->new; $$proto = 0;
          bless  $proto, $pkg;
      };
  
  
      for my $method (@methods) {
          my $flag = uc($method);
          my $type |= (UNSUPPORTED_ENCODE_FLAG->{$flag} || 0);
             $type |= (UNSUPPORTED_DECODE_FLAG->{$flag} || 0);
  
          next unless($type);
  
          $pkg->_make_unsupported_method($method => $type);
      }
  
      push @{"JSON::XS::Boolean::ISA"}, qw(JSON::PP::Boolean);
      push @{"JSON::PP::Boolean::ISA"}, qw(JSON::Boolean);
  
      $JSON::DEBUG and Carp::carp("set -support_by_pp mode.");
  
      return 1;
  }
  
  
  
  
  #
  # Helper classes for XS
  #
  
  package JSON::Backend::XS::Supportable;
  
  $Carp::Internal{'JSON::Backend::XS::Supportable'} = 1;
  
  sub _make_unsupported_method {
      my ($pkg, $method, $type) = @_;
  
      local $^W;
      no strict qw(refs);
  
      *{"$pkg\::$method"} = sub {
          local $^W;
          if (defined $_[1] ? $_[1] : 1) {
              ${$_[0]} |= $type;
          }
          else {
              ${$_[0]} &= ~$type;
          }
          $_[0];
      };
  
      *{"$pkg\::get_$method"} = sub {
          ${$_[0]} & $type ? 1 : '';
      };
  
  }
  
  
  sub _set_for_pp {
      JSON::_load_pp( $_INSTALL_ONLY );
  
      my $type  = shift;
      my $pp    = JSON::PP->new;
      my $prop = $_[0]->property;
  
      for my $name (keys %$prop) {
          $pp->$name( $prop->{$name} ? $prop->{$name} : 0 );
      }
  
      my $unsupported = $type eq 'encode' ? JSON::Backend::XS::UNSUPPORTED_ENCODE_FLAG
                                          : JSON::Backend::XS::UNSUPPORTED_DECODE_FLAG;
      my $flags       = ${$_[0]} || 0;
  
      for my $name (keys %$unsupported) {
          next if ($name eq 'EXPANDED'); # for developer's
          my $enable = ($flags & $unsupported->{$name}) ? 1 : 0;
          my $method = lc $name;
          $pp->$method($enable);
      }
  
      $pp->indent_length( $_[0]->get_indent_length );
  
      return $pp;
  }
  
  sub _encode { # using with PP encode
      if (${$_[0]}) {
          _set_for_pp('encode' => @_)->encode($_[1]);
      }
      else {
          $_[0]->_original_encode( $_[1] );
      }
  }
  
  
  sub _decode { # if unsupported-flag is set, use PP
      if (${$_[0]}) {
          _set_for_pp('decode' => @_)->decode($_[1]);
      }
      else {
          $_[0]->_original_decode( $_[1] );
      }
  }
  
  
  sub decode_prefix { # if unsupported-flag is set, use PP
      _set_for_pp('decode' => @_)->decode_prefix($_[1]);
  }
  
  
  sub _incr_parse {
      if (${$_[0]}) {
          _set_for_pp('decode' => @_)->incr_parse($_[1]);
      }
      else {
          $_[0]->_original_incr_parse( $_[1] );
      }
  }
  
  
  sub get_indent_length {
      ${$_[0]} << 4 >> 16;
  }
  
  
  sub indent_length {
      my $length = $_[1];
  
      if (!defined $length or $length > 15 or $length < 0) {
          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
      }
      else {
          local $^W;
          $length <<= 12;
          ${$_[0]} &= ~ JSON::Backend::XS::INDENT_LENGTH_FLAG;
          ${$_[0]} |= $length;
          *JSON::XS::encode = \&JSON::Backend::XS::Supportable::_encode;
      }
  
      $_[0];
  }
  
  
  1;
  __END__
  
  =head1 NAME
  
  JSON - JSON (JavaScript Object Notation) encoder/decoder
  
  =head1 SYNOPSIS
  
   use JSON; # imports encode_json, decode_json, to_json and from_json.
   
   # simple and fast interfaces (expect/generate UTF-8)
   
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
   
   # OO-interface
   
   $json = JSON->new->allow_nonref;
   
   $json_text   = $json->encode( $perl_scalar );
   $perl_scalar = $json->decode( $json_text );
   
   $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
   
   # If you want to use PP only support features, call with '-support_by_pp'
   # When XS unsupported feature is enable, using PP (de|en)code instead of XS ones.
   
   use JSON -support_by_pp;
   
   # option-acceptable interfaces (expect/generate UNICODE by default)
   
   $json_text   = to_json( $perl_scalar, { ascii => 1, pretty => 1 } );
   $perl_scalar = from_json( $json_text, { utf8  => 1 } );
   
   # Between (en|de)code_json and (to|from)_json, if you want to write
   # a code which communicates to an outer world (encoded in UTF-8),
   # recommend to use (en|de)code_json.
   
  =head1 VERSION
  
      2.59
  
  This version is compatible with JSON::XS B<2.34> and later.
  
  
  =head1 NOTE
  
  JSON::PP was earlier included in the C<JSON> distribution, but
  has since Perl 5.14 been a core module. For this reason,
  L<JSON::PP> was removed from the JSON distribution and can now
  be found also in the Perl5 repository at
  
  =over
  
  =item * L<http://perl5.git.perl.org/perl.git>
  
  =back
  
  (The newest JSON::PP version still exists in CPAN.)
  
  Instead, the C<JSON> distribution will include JSON::backportPP
  for backwards computability. JSON.pm should thus work as it did
  before.
  
  =head1 DESCRIPTION
  
   ************************** CAUTION ********************************
   * This is 'JSON module version 2' and there are many differences  *
   * to version 1.xx                                                 *
   * Please check your applications using old version.              *
   *   See to 'INCOMPATIBLE CHANGES TO OLD VERSION'                  *
   *******************************************************************
  
  JSON (JavaScript Object Notation) is a simple data format.
  See to L<http://www.json.org/> and C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>).
  
  This module converts Perl data structures to JSON and vice versa using either
  L<JSON::XS> or L<JSON::PP>.
  
  JSON::XS is the fastest and most proper JSON module on CPAN which must be
  compiled and installed in your environment.
  JSON::PP is a pure-Perl module which is bundled in this distribution and
  has a strong compatibility to JSON::XS.
  
  This module try to use JSON::XS by default and fail to it, use JSON::PP instead.
  So its features completely depend on JSON::XS or JSON::PP.
  
  See to L<BACKEND MODULE DECISION>.
  
  To distinguish the module name 'JSON' and the format type JSON,
  the former is quoted by CE<lt>E<gt> (its results vary with your using media),
  and the latter is left just as it is.
  
  Module name : C<JSON>
  
  Format type : JSON
  
  =head2 FEATURES
  
  =over
  
  =item * correct unicode handling
  
  This module (i.e. backend modules) knows how to handle Unicode, documents
  how and when it does so, and even documents what "correct" means.
  
  Even though there are limitations, this feature is available since Perl version 5.6.
  
  JSON::XS requires Perl 5.8.2 (but works correctly in 5.8.8 or later), so in older versions
  C<JSON> should call JSON::PP as the backend which can be used since Perl 5.005.
  
  With Perl 5.8.x JSON::PP works, but from 5.8.0 to 5.8.2, because of a Perl side problem,
  JSON::PP works slower in the versions. And in 5.005, the Unicode handling is not available.
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> for more information.
  
  See also to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>
  and L<JSON::XS/ENCODING/CODESET_FLAG_NOTES>.
  
  
  =item * round-trip integrity
  
  When you serialise a perl data structure using only data types supported
  by JSON and Perl, the deserialised data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  L</MAPPING> section below to learn about those.
  
  
  =item * strict checking of JSON correctness
  
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a security
  feature).
  
  See to L<JSON::XS/FEATURES> and L<JSON::PP/FEATURES>.
  
  =item * fast
  
  This module returns a JSON::XS object itself if available.
  Compared to other JSON modules and other serialisers such as Storable,
  JSON::XS usually compares favorably in terms of speed, too.
  
  If not available, C<JSON> returns a JSON::PP object instead of JSON::XS and
  it is very slow as pure-Perl.
  
  =item * simple to use
  
  This module has both a simple functional interface as well as an
  object oriented interface interface.
  
  =item * reasonably versatile output formats
  
  You can choose between the most compact guaranteed-single-line format possible
  (nice for simple line-based protocols), a pure-ASCII format (for when your transport
  is not 8-bit clean, still supports the whole Unicode range), or a pretty-printed
  format (for when you want to read that stuff). Or you can combine those features
  in whatever way you like.
  
  =back
  
  =head1 FUNCTIONAL INTERFACE
  
  Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
  C<to_json> and C<from_json> are additional functions.
  
  =head2 encode_json
  
      $json_text = encode_json $perl_scalar
  
  Converts the given Perl data structure to a UTF-8 encoded, binary string.
  
  This function call is functionally identical to:
  
      $json_text = JSON->new->utf8->encode($perl_scalar)
  
  =head2 decode_json
  
      $perl_scalar = decode_json $json_text
  
  The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
  to parse that as an UTF-8 encoded JSON text, returning the resulting
  reference.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON->new->utf8->decode($json_text)
  
  
  =head2 to_json
  
     $json_text = to_json($perl_scalar)
  
  Converts the given Perl data structure to a json string.
  
  This function call is functionally identical to:
  
     $json_text = JSON->new->encode($perl_scalar)
  
  Takes a hash reference as the second.
  
     $json_text = to_json($perl_scalar, $flag_hashref)
  
  So,
  
     $json_text = to_json($perl_scalar, {utf8 => 1, pretty => 1})
  
  equivalent to:
  
     $json_text = JSON->new->utf8(1)->pretty(1)->encode($perl_scalar)
  
  If you want to write a modern perl code which communicates to outer world,
  you should use C<encode_json> (supposed that JSON data are encoded in UTF-8).
  
  =head2 from_json
  
     $perl_scalar = from_json($json_text)
  
  The opposite of C<to_json>: expects a json string and tries
  to parse it, returning the resulting reference.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON->decode($json_text)
  
  Takes a hash reference as the second.
  
      $perl_scalar = from_json($json_text, $flag_hashref)
  
  So,
  
      $perl_scalar = from_json($json_text, {utf8 => 1})
  
  equivalent to:
  
      $perl_scalar = JSON->new->utf8(1)->decode($json_text)
  
  If you want to write a modern perl code which communicates to outer world,
  you should use C<decode_json> (supposed that JSON data are encoded in UTF-8).
  
  =head2 JSON::is_bool
  
      $is_boolean = JSON::is_bool($scalar)
  
  Returns true if the passed scalar represents either JSON::true or
  JSON::false, two constants that act like C<1> and C<0> respectively
  and are also used to represent JSON C<true> and C<false> in Perl strings.
  
  =head2 JSON::true
  
  Returns JSON true value which is blessed object.
  It C<isa> JSON::Boolean object.
  
  =head2 JSON::false
  
  Returns JSON false value which is blessed object.
  It C<isa> JSON::Boolean object.
  
  =head2 JSON::null
  
  Returns C<undef>.
  
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
  
  =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
  
  This section supposes that your perl version is 5.8 or later.
  
  If you know a JSON text from an outer world - a network, a file content, and so on,
  is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
  with C<utf8> enable. And the decoded result will contain UNICODE characters.
  
    # from network
    my $json        = JSON->new->utf8;
    my $json_text   = CGI->new->param( 'json_data' );
    my $perl_scalar = $json->decode( $json_text );
    
    # from file content
    local $/;
    open( my $fh, '<', 'json.data' );
    $json_text   = <$fh>;
    $perl_scalar = decode_json( $json_text );
  
  If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
  
    use Encode;
    local $/;
    open( my $fh, '<', 'json.data' );
    my $encoding = 'cp932';
    my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
    
    # or you can write the below code.
    #
    # open( my $fh, "<:encoding($encoding)", 'json.data' );
    # $unicode_json_text = <$fh>;
  
  In this case, C<$unicode_json_text> is of course UNICODE string.
  So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable or C<from_json>.
  
    $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
    # or
    $perl_scalar = from_json( $unicode_json_text );
  
  Or C<encode 'utf8'> and C<decode_json>:
  
    $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
    # this way is not efficient.
  
  And now, you want to convert your C<$perl_scalar> into JSON data and
  send it to an outer world - a network or a file content, and so on.
  
  Your data usually contains UNICODE strings and you want the converted data to be encoded
  in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
  
    print encode_json( $perl_scalar ); # to a network? file? or display?
    # or
    print $json->utf8->encode( $perl_scalar );
  
  If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
  for some reason, then its characters are regarded as B<latin1> for perl
  (because it does not concern with your $encoding).
  You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable or C<to_json>.
  Note that the resulted text is a UNICODE string but no problem to print it.
  
    # $perl_scalar contains $encoding encoded string values
    $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
    # or 
    $unicode_json_text = to_json( $perl_scalar );
    # $unicode_json_text consists of characters less than 0x100
    print $unicode_json_text;
  
  Or C<decode $encoding> all string values and C<encode_json>:
  
    $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
    # ... do it to each string values, then encode_json
    $json_text = encode_json( $perl_scalar );
  
  This method is a proper way but probably not efficient.
  
  See to L<Encode>, L<perluniintro>.
  
  
  =head1 COMMON OBJECT-ORIENTED INTERFACE
  
  =head2 new
  
      $json = JSON->new
  
  Returns a new C<JSON> object inherited from either JSON::XS or JSON::PP
  that can be used to de/encode JSON strings.
  
  All boolean flags described below are by default I<disabled>.
  
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
  
     my $json = JSON->new->utf8->space_after->encode({a => [1,2]})
     => {"a": [1, 2]}
  
  =head2 ascii
  
      $json = $json->ascii([$enable])
      
      $enabled = $json->get_ascii
  
  If $enable is true (or missing), then the encode method will not generate characters outside
  the code range 0..127. Any Unicode characters outside that range will be escaped using either
  a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
  
  If $enable is false, then the encode method will not escape Unicode characters unless
  required by the JSON syntax or other flags. This results in a faster and more compact format.
  
  This feature depends on the used Perl version and environment.
  
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
  
    JSON->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
  
  =head2 latin1
  
      $json = $json->latin1([$enable])
      
      $enabled = $json->get_latin1
  
  If $enable is true (or missing), then the encode method will encode the resulting JSON
  text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
  
  If $enable is false, then the encode method will not escape Unicode characters
  unless required by the JSON syntax or other flags.
  
    JSON->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
  
  =head2 utf8
  
      $json = $json->utf8([$enable])
      
      $enabled = $json->get_utf8
  
  If $enable is true (or missing), then the encode method will encode the JSON result
  into UTF-8, as required by many protocols, while the decode method expects to be handled
  an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
  characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
  
  In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
  encoding families, as described in RFC4627.
  
  If $enable is false, then the encode method will return the JSON string as a (non-encoded)
  Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
  (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
  
  
  Example, output UTF-16BE-encoded JSON:
  
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::XS->new->encode ($object);
  
  Example, decode UTF-32LE-encoded JSON:
  
    use Encode;
    $object = JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
  
  See to L<JSON::PP/UNICODE HANDLING ON PERLS> if the backend is PP.
  
  
  =head2 pretty
  
      $json = $json->pretty([$enable])
  
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> (and in the future possibly more) flags in one call to
  generate the most readable (or most compact) form possible.
  
  Equivalent to:
  
     $json->indent->space_before->space_after
  
  The indent space length is three and JSON::XS cannot change the indent
  space length.
  
  =head2 indent
  
      $json = $json->indent([$enable])
      
      $enabled = $json->get_indent
  
  If C<$enable> is true (or missing), then the C<encode> method will use a multiline
  format as output, putting every array member or object/hash key-value pair
  into its own line, identifying them properly.
  
  If C<$enable> is false, no newlines or indenting will be produced, and the
  resulting JSON text is guaranteed not to contain any C<newlines>.
  
  This setting has no effect when decoding JSON texts.
  
  The indent space length is three.
  With JSON::PP, you can also access C<indent_length> to change indent space length.
  
  
  =head2 space_before
  
      $json = $json->space_before([$enable])
      
      $enabled = $json->get_space_before
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before enabled, space_after and indent disabled:
  
     {"key" :"value"}
  
  
  =head2 space_after
  
      $json = $json->space_after([$enable])
      
      $enabled = $json->get_space_after
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space after the C<:> separating keys from values in JSON objects
  and extra whitespace after the C<,> separating key-value pairs and array
  members.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before and indent disabled, space_after enabled:
  
     {"key": "value"}
  
  
  =head2 relaxed
  
      $json = $json->relaxed([$enable])
      
      $enabled = $json->get_relaxed
  
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
  
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
  
  Currently accepted extensions are:
  
  =over 4
  
  =item * list items can have an end-comma
  
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
  
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
  
  =item * shell-style '#'-comments
  
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
  
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
  
  =back
  
  
  =head2 canonical
  
      $json = $json->canonical([$enable])
      
      $enabled = $json->get_canonical
  
  If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
  by sorting their keys. This is adding a comparatively high overhead.
  
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script).
  
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
  
  This setting has no effect when decoding JSON texts.
  
  =head2 allow_nonref
  
      $json = $json->allow_nonref([$enable])
      
      $enabled = $json->get_allow_nonref
  
  If C<$enable> is true (or missing), then the C<encode> method can convert a
  non-reference into its corresponding string, number or null JSON value,
  which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
  values instead of croaking.
  
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
  
     JSON->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
  
  =head2 allow_unknown
  
      $json = $json->allow_unknown ([$enable])
      
      $enabled = $json->get_allow_unknown
  
  If $enable is true (or missing), then "encode" will *not* throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON "null" value.
  Note that blessed objects are not included here and are handled
  separately by c<allow_nonref>.
  
  If $enable is false (the default), then "encode" will throw an
  exception when it encounters anything it cannot encode as JSON.
  
  This option does not affect "decode" in any way, and it is
  recommended to leave it off unless you know your communications
  partner.
  
  =head2 allow_blessed
  
      $json = $json->allow_blessed([$enable])
      
      $enabled = $json->get_allow_blessed
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
  
  
  =head2 convert_blessed
  
      $json = $json->convert_blessed([$enable])
      
      $enabled = $json->get_convert_blessed
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
  to do.
  
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with the C<to_json>
  function or method.
  
  This setting does not yet influence C<decode> in any way.
  
  If C<$enable> is false, then the C<allow_blessed> setting will decide what
  to do when a blessed object is found.
  
  =over
  
  =item convert_blessed_universally mode
  
  If use C<JSON> with C<-convert_blessed_universally>, the C<UNIVERSAL::TO_JSON>
  subroutine is defined as the below code:
  
     *UNIVERSAL::TO_JSON = sub {
         my $b_obj = B::svref_2object( $_[0] );
         return    $b_obj->isa('B::HV') ? { %{ $_[0] } }
                 : $b_obj->isa('B::AV') ? [ @{ $_[0] } ]
                 : undef
                 ;
     }
  
  This will cause that C<encode> method converts simple blessed objects into
  JSON objects as non-blessed object.
  
     JSON -convert_blessed_universally;
     $json->allow_blessed->convert_blessed->encode( $blessed_object )
  
  This feature is experimental and may be removed in the future.
  
  =back
  
  =head2 filter_json_object
  
      $json = $json->filter_json_object([$coderef])
  
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument passed to the coderef
  is a reference to the newly-created hash. If the code references returns
  a single scalar (which need not be a reference), this value
  (i.e. a copy of that scalar to avoid aliasing) is inserted into the
  deserialised data structure. If it returns an empty list
  (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
  hash will be inserted. This setting can slow down decoding considerably.
  
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialised hash in any
  way.
  
  Example, convert all JSON objects into the integer 5:
  
     my $js = JSON->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]'); # the given subroutine takes a hash reference.
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
  
  
  =head2 filter_json_single_key_object
  
      $json = $json->filter_json_single_key_object($key [=> $coderef])
  
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
  
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
  
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
  
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialise Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialised Perl hash.
  
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
  
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
  
     # return whatever is in $WIDGET{5}:
     JSON
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
  
     # this can be used with a TO_JSON method in some "widget" class
     # for serialisation to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
  
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
  
        { __widget__ => $self->{id} }
     }
  
  
  =head2 shrink
  
      $json = $json->shrink([$enable])
      
      $enabled = $json->get_shrink
  
  With JSON::XS, this flag resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible. This can save
  memory when your JSON texts are either very very long or you have many
  short strings. It will also try to downgrade any strings to octet-form
  if possible: perl stores strings internally either in an encoding called
  UTF-X or in octet-form. The latter cannot store everything but uses less
  space in general (and some buggy Perl or C code might even rely on that
  internal representation being used).
  
  With JSON::PP, it is noop about resizing strings but tries
  C<utf8::downgrade> to the returned string by C<encode>. See to L<utf8>.
  
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE> and L<JSON::PP/METHODS>.
  
  =head2 max_depth
  
      $json = $json->max_depth([$maximum_nesting_depth])
      
      $max_depth = $json->get_max_depth
  
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
  
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
  
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
  
  Note that nesting is implemented by recursion in C. The default value has
  been chosen to be as large as typical operating systems allow without
  crashing. (JSON::XS)
  
  With JSON::PP as the backend, when a large value (100 or more) was set and
  it de/encodes a deep nested object/text, it may raise a warning
  'Deep recursion on subroutine' at the perl runtime phase.
  
  See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
  
  =head2 max_size
  
      $json = $json->max_size([$maximum_string_size])
      
      $max_size = $json->get_max_size
  
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
  
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
  
  See L<JSON::XS/SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
  
  =head2 encode
  
      $json_text = $json->encode($perl_scalar)
  
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to arrays
  become JSON arrays and references to hashes become JSON objects. Undefined
  Perl values (e.g. C<undef>) become JSON C<null> values.
  References to the integers C<0> and C<1> are converted into C<true> and C<false>.
  
  =head2 decode
  
      $perl_scalar = $json->decode($json_text)
  
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
  
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
  C<null> becomes C<undef>.
  
  =head2 decode_prefix
  
      ($perl_scalar, $characters) = $json->decode_prefix($json_text)
  
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
  
     JSON->new->decode_prefix ("[1] the tail")
     => ([], 3)
  
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
  
  =head2 property
  
      $boolean = $json->property($property_name)
  
  Returns a boolean value about above some properties.
  
  The available properties are C<ascii>, C<latin1>, C<utf8>,
  C<indent>,C<space_before>, C<space_after>, C<relaxed>, C<canonical>,
  C<allow_nonref>, C<allow_unknown>, C<allow_blessed>, C<convert_blessed>,
  C<shrink>, C<max_depth> and C<max_size>.
  
     $boolean = $json->property('utf8');
      => 0
     $json->utf8;
     $boolean = $json->property('utf8');
      => 1
  
  Sets the property with a given boolean value.
  
      $json = $json->property($property_name => $boolean);
  
  With no argument, it returns all the above properties as a hash reference.
  
      $flag_hashref = $json->property();
  
  =head1 INCREMENTAL PARSING
  
  Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
  
  In some cases, there is the need for incremental parsing of JSON texts.
  This module does allow you to parse a JSON stream incrementally.
  It does so by accumulating text until it has a full JSON object, which
  it then can decode. This process is similar to using C<decode_prefix>
  to see if a full JSON object is available, but is much more efficient
  (and can be implemented with a minimum of method calls).
  
  The backend module will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect parenthesis
  mismatches. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
  
  The following methods implement this incremental parser.
  
  =head2 incr_parse
  
      $json->incr_parse( [$string] ) # void context
      
      $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
      
      @obj_or_empty = $json->incr_parse( [$string] ) # list context
  
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
  
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
  
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
  
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the erroneous part). This is the most common way of
  using the method.
  
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
  
  Example: Parse some JSON arrays/objects in a given string and return them.
  
      my @objs = JSON->new->incr_parse ("[5][7][1,2]");
  
  =head2 incr_text
  
      $lvalue_string = $json->incr_text
  
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
  
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
  
      $json->incr_text =~ s/\s*,\s*//;
  
  In Perl 5.005, C<lvalue> attribute is not available.
  You must write codes like the below:
  
      $string = $json->incr_text;
      $string =~ s/\s*,\s*//;
      $json->incr_text( $string );
  
  =head2 incr_skip
  
      $json->incr_skip
  
  This will reset the state of the incremental parser and will remove the
  parsed text from the input buffer. This is useful after C<incr_parse>
  died, in which case the input buffer and incremental parser state is left
  unchanged, to skip the text parsed so far and to reset the parse state.
  
  =head2 incr_reset
  
      $json->incr_reset
  
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
  
  This is useful if you want to repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
  
  See to L<JSON::XS/INCREMENTAL PARSING> for examples.
  
  
  =head1 JSON::PP SUPPORT METHODS
  
  The below methods are JSON::PP own methods, so when C<JSON> works
  with JSON::PP (i.e. the created object is a JSON::PP object), available.
  See to L<JSON::PP/JSON::PP OWN METHODS> in detail.
  
  If you use C<JSON> with additional C<-support_by_pp>, some methods
  are available even with JSON::XS. See to L<USE PP FEATURES EVEN THOUGH XS BACKEND>.
  
     BEING { $ENV{PERL_JSON_BACKEND} = 'JSON::XS' }
     
     use JSON -support_by_pp;
     
     my $json = JSON->new;
     $json->allow_nonref->escape_slash->encode("/");
  
     # functional interfaces too.
     print to_json(["/"], {escape_slash => 1});
     print from_json('["foo"]', {utf8 => 1});
  
  If you do not want to all functions but C<-support_by_pp>,
  use C<-no_export>.
  
     use JSON -support_by_pp, -no_export;
     # functional interfaces are not exported.
  
  =head2 allow_singlequote
  
      $json = $json->allow_singlequote([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  any JSON strings quoted by single quotations that are invalid JSON
  format.
  
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
  =head2 allow_barekey
  
      $json = $json->allow_barekey([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
      $json->allow_barekey->decode('{foo:"bar"}');
  
  =head2 allow_bignum
  
      $json = $json->allow_bignum([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
  
  On the contrary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers with C<allow_blessed> enable.
  
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
  
  See to L<MAPPING> about the conversion of JSON number.
  
  =head2 loose
  
      $json = $json->loose([$enable])
  
  The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
  and the module doesn't allow to C<decode> to these (except for \x2f).
  If C<$enable> is true (or missing), then C<decode>  will accept these
  unescaped strings.
  
      $json->loose->decode(qq|["abc
                                     def"]|);
  
  See to L<JSON::PP/JSON::PP OWN METHODS>.
  
  =head2 escape_slash
  
      $json = $json->escape_slash([$enable])
  
  According to JSON Grammar, I<slash> (U+002F) is escaped. But by default
  JSON backend modules encode strings without escaping slash.
  
  If C<$enable> is true (or missing), then C<encode> will escape slashes.
  
  =head2 indent_length
  
      $json = $json->indent_length($length)
  
  With JSON::XS, The indent space length is 3 and cannot be changed.
  With JSON::PP, it sets the indent space length with the given $length.
  The default is 3. The acceptable range is 0 to 15.
  
  =head2 sort_by
  
      $json = $json->sort_by($function_name)
      $json = $json->sort_by($subroutine_ref)
  
  If $function_name or $subroutine_ref are set, its sort routine are used.
  
     $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     $js = $pc->sort_by('own_sort')->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
  
  As the sorting routine runs in the JSON::PP scope, the given
  subroutine name and the special variables C<$a>, C<$b> will begin
  with 'JSON::PP::'.
  
  If $integer is set, then the effect is same as C<canonical> on.
  
  See to L<JSON::PP/JSON::PP OWN METHODS>.
  
  =head1 MAPPING
  
  This section is copied from JSON::XS and modified to C<JSON>.
  JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
  
  See to L<JSON::XS/MAPPING>.
  
  =head2 JSON -> PERL
  
  =over 4
  
  =item object
  
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserver object key ordering itself).
  
  =item array
  
  A JSON array becomes a reference to an array in Perl.
  
  =item string
  
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
  
  =item number
  
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
  
  If the number consists of digits only, C<JSON> will try to represent
  it as an integer value. If that fails, it will try to represent it as
  a numeric (floating point) value if that is possible without loss of
  precision. Otherwise it will preserve the number as a string value (in
  which case you lose roundtripping ability, as the JSON number will be
  re-encoded to a JSON string).
  
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
  
  Note that precision is not accuracy - binary floating point values cannot
  represent most decimal fractions exactly, and when converting from and to
  floating point, C<JSON> only guarantees precision up to but not including
  the least significant bit.
  
  If the backend is JSON::PP and C<allow_bignum> is enable, the big integers 
  and the numeric can be optionally converted into L<Math::BigInt> and
  L<Math::BigFloat> objects.
  
  =item true, false
  
  These JSON atoms become C<JSON::true> and C<JSON::false>,
  respectively. They are overloaded to act almost exactly like the numbers
  C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
  the C<JSON::is_bool> function.
  
  If C<JSON::true> and C<JSON::false> are used as strings or compared as strings,
  they represent as C<true> and C<false> respectively.
  
     print JSON::true . "\n";
      => true
     print JSON::true + 1;
      => 1
  
     ok(JSON::true eq 'true');
     ok(JSON::true eq  '1');
     ok(JSON::true == 1);
  
  C<JSON> will install these missing overloading features to the backend modules.
  
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  C<JSON::null> returns C<undef>.
  
  =back
  
  
  =head2 PERL -> JSON
  
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
  
  =over 4
  
  =item hash references
  
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. C<JSON>
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same data structure will serialise to the same JSON text (given same
  settings and version of JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
  
  In future, the ordered object feature will be added to JSON::PP using C<tie> mechanism.
  
  
  =item array references
  
  Perl array references become JSON arrays.
  
  =item other references
  
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
  also use C<JSON::false> and C<JSON::true> to improve readability.
  
     to_json [\0,JSON::true]      # yields [false,true]
  
  =item JSON::true, JSON::false, JSON::null
  
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> directly if you want.
  
  JSON::null returns C<undef>.
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON. See the
  C<allow_blessed> and C<convert_blessed> methods on various options on
  how to deal with this: basically, you can choose between throwing an
  exception, encoding the reference as if it weren't blessed, or provide
  your own serialiser method.
  
  With C<convert_blessed_universally> mode,  C<encode> converts blessed
  hash references or blessed array references (contains other blessed references)
  into JSON members and arrays.
  
     use JSON -convert_blessed_universally;
     JSON->new->allow_blessed->convert_blessed->encode( $blessed_object );
  
  See to L<convert_blessed>.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
  JSON C<null> values, scalars that have last been used in a string context
  before encoding as JSON strings, and anything else as number value:
  
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
  
     # used as string, so dump as string
     print $value;
     encode_json [$value]                 # yields ["5"]
  
     # undef becomes null
     encode_json [undef]                  # yields [null]
  
  You can force the type to be a string by stringifying it:
  
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
  
  You can force the type to be a number by numifying it:
  
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choice is yours.
  
  You can not currently force the type in other, less obscure, ways.
  
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and it is an
  error to pass those in.
  
  =item Big Number
  
  If the backend is JSON::PP and C<allow_bignum> is enable, 
  C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers.
  
  
  =back
  
  =head1 JSON and ECMAscript
  
  See to L<JSON::XS/JSON and ECMAscript>.
  
  =head1 JSON and YAML
  
  JSON is not a subset of YAML.
  See to L<JSON::XS/JSON and YAML>.
  
  
  =head1 BACKEND MODULE DECISION
  
  When you use C<JSON>, C<JSON> tries to C<use> JSON::XS. If this call failed, it will
  C<uses> JSON::PP. The required JSON::XS version is I<2.2> or later.
  
  The C<JSON> constructor method returns an object inherited from the backend module,
  and JSON::XS object is a blessed scalar reference while JSON::PP is a blessed hash
  reference.
  
  So, your program should not depend on the backend module, especially
  returned objects should not be modified.
  
   my $json = JSON->new; # XS or PP?
   $json->{stash} = 'this is xs object'; # this code may raise an error!
  
  To check the backend module, there are some methods - C<backend>, C<is_pp> and C<is_xs>.
  
    JSON->backend; # 'JSON::XS' or 'JSON::PP'
    
    JSON->backend->is_pp: # 0 or 1
    
    JSON->backend->is_xs: # 1 or 0
    
    $json->is_xs; # 1 or 0
    
    $json->is_pp; # 0 or 1
  
  
  If you set an environment variable C<PERL_JSON_BACKEND>, the calling action will be changed.
  
  =over
  
  =item PERL_JSON_BACKEND = 0 or PERL_JSON_BACKEND = 'JSON::PP'
  
  Always use JSON::PP
  
  =item PERL_JSON_BACKEND == 1 or PERL_JSON_BACKEND = 'JSON::XS,JSON::PP'
  
  (The default) Use compiled JSON::XS if it is properly compiled & installed,
  otherwise use JSON::PP.
  
  =item PERL_JSON_BACKEND == 2 or PERL_JSON_BACKEND = 'JSON::XS'
  
  Always use compiled JSON::XS, die if it isn't properly compiled & installed.
  
  =item PERL_JSON_BACKEND = 'JSON::backportPP'
  
  Always use JSON::backportPP.
  JSON::backportPP is JSON::PP back port module.
  C<JSON> includes JSON::backportPP instead of JSON::PP.
  
  =back
  
  These ideas come from L<DBI::PurePerl> mechanism.
  
  example:
  
   BEGIN { $ENV{PERL_JSON_BACKEND} = 'JSON::PP' }
   use JSON; # always uses JSON::PP
  
  In future, it may be able to specify another module.
  
  =head1 USE PP FEATURES EVEN THOUGH XS BACKEND
  
  Many methods are available with either JSON::XS or JSON::PP and
  when the backend module is JSON::XS, if any JSON::PP specific (i.e. JSON::XS unsupported)
  method is called, it will C<warn> and be noop.
  
  But If you C<use> C<JSON> passing the optional string C<-support_by_pp>,
  it makes a part of those unsupported methods available.
  This feature is achieved by using JSON::PP in C<de/encode>.
  
     BEGIN { $ENV{PERL_JSON_BACKEND} = 2 } # with JSON::XS
     use JSON -support_by_pp;
     my $json = JSON->new;
     $json->allow_nonref->escape_slash->encode("/");
  
  At this time, the returned object is a C<JSON::Backend::XS::Supportable>
  object (re-blessed XS object), and  by checking JSON::XS unsupported flags
  in de/encoding, can support some unsupported methods - C<loose>, C<allow_bignum>,
  C<allow_barekey>, C<allow_singlequote>, C<escape_slash> and C<indent_length>.
  
  When any unsupported methods are not enable, C<XS de/encode> will be
  used as is. The switch is achieved by changing the symbolic tables.
  
  C<-support_by_pp> is effective only when the backend module is JSON::XS
  and it makes the de/encoding speed down a bit.
  
  See to L<JSON::PP SUPPORT METHODS>.
  
  =head1 INCOMPATIBLE CHANGES TO OLD VERSION
  
  There are big incompatibility between new version (2.00) and old (1.xx).
  If you use old C<JSON> 1.xx in your code, please check it.
  
  See to L<Transition ways from 1.xx to 2.xx.>
  
  =over
  
  =item jsonToObj and objToJson are obsoleted.
  
  Non Perl-style name C<jsonToObj> and C<objToJson> are obsoleted
  (but not yet deleted from the source).
  If you use these functions in your code, please replace them
  with C<from_json> and C<to_json>.
  
  
  =item Global variables are no longer available.
  
  C<JSON> class variables - C<$JSON::AUTOCONVERT>, C<$JSON::BareKey>, etc...
  - are not available any longer.
  Instead, various features can be used through object methods.
  
  
  =item Package JSON::Converter and JSON::Parser are deleted.
  
  Now C<JSON> bundles with JSON::PP which can handle JSON more properly than them.
  
  =item Package JSON::NotString is deleted.
  
  There was C<JSON::NotString> class which represents JSON value C<true>, C<false>, C<null>
  and numbers. It was deleted and replaced by C<JSON::Boolean>.
  
  C<JSON::Boolean> represents C<true> and C<false>.
  
  C<JSON::Boolean> does not represent C<null>.
  
  C<JSON::null> returns C<undef>.
  
  C<JSON> makes L<JSON::XS::Boolean> and L<JSON::PP::Boolean> is-a relation
  to L<JSON::Boolean>.
  
  =item function JSON::Number is obsoleted.
  
  C<JSON::Number> is now needless because JSON::XS and JSON::PP have
  round-trip integrity.
  
  =item JSONRPC modules are deleted.
  
  Perl implementation of JSON-RPC protocol - C<JSONRPC >, C<JSONRPC::Transport::HTTP>
  and C<Apache::JSONRPC > are deleted in this distribution.
  Instead of them, there is L<JSON::RPC> which supports JSON-RPC protocol version 1.1.
  
  =back
  
  =head2 Transition ways from 1.xx to 2.xx.
  
  You should set C<suport_by_pp> mode firstly, because
  it is always successful for the below codes even with JSON::XS.
  
      use JSON -support_by_pp;
  
  =over
  
  =item Exported jsonToObj (simple)
  
    from_json($json_text);
  
  =item Exported objToJson (simple)
  
    to_json($perl_scalar);
  
  =item Exported jsonToObj (advanced)
  
    $flags = {allow_barekey => 1, allow_singlequote => 1};
    from_json($json_text, $flags);
  
  equivalent to:
  
    $JSON::BareKey = 1;
    $JSON::QuotApos = 1;
    jsonToObj($json_text);
  
  =item Exported objToJson (advanced)
  
    $flags = {allow_blessed => 1, allow_barekey => 1};
    to_json($perl_scalar, $flags);
  
  equivalent to:
  
    $JSON::BareKey = 1;
    objToJson($perl_scalar);
  
  =item jsonToObj as object method
  
    $json->decode($json_text);
  
  =item objToJson as object method
  
    $json->encode($perl_scalar);
  
  =item new method with parameters
  
  The C<new> method in 2.x takes any parameters no longer.
  You can set parameters instead;
  
     $json = JSON->new->pretty;
  
  =item $JSON::Pretty, $JSON::Indent, $JSON::Delimiter
  
  If C<indent> is enable, that means C<$JSON::Pretty> flag set. And
  C<$JSON::Delimiter> was substituted by C<space_before> and C<space_after>.
  In conclusion:
  
     $json->indent->space_before->space_after;
  
  Equivalent to:
  
    $json->pretty;
  
  To change indent length, use C<indent_length>.
  
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
  
    $json->pretty->indent_length(2)->encode($perl_scalar);
  
  =item $JSON::BareKey
  
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
  
    $json->allow_barekey->decode($json_text)
  
  =item $JSON::ConvBlessed
  
  use C<-convert_blessed_universally>. See to L<convert_blessed>.
  
  =item $JSON::QuotApos
  
  (Only with JSON::PP, if C<-support_by_pp> is not used.)
  
    $json->allow_singlequote->decode($json_text)
  
  =item $JSON::SingleQuote
  
  Disable. C<JSON> does not make such a invalid JSON string any longer.
  
  =item $JSON::KeySort
  
    $json->canonical->encode($perl_scalar)
  
  This is the ascii sort.
  
  If you want to use with your own sort routine, check the C<sort_by> method.
  
  (Only with JSON::PP, even if C<-support_by_pp> is used currently.)
  
    $json->sort_by($sort_routine_ref)->encode($perl_scalar)
   
    $json->sort_by(sub { $JSON::PP::a <=> $JSON::PP::b })->encode($perl_scalar)
  
  Can't access C<$a> and C<$b> but C<$JSON::PP::a> and C<$JSON::PP::b>.
  
  =item $JSON::SkipInvalid
  
    $json->allow_unknown
  
  =item $JSON::AUTOCONVERT
  
  Needless. C<JSON> backend modules have the round-trip integrity.
  
  =item $JSON::UTF8
  
  Needless because C<JSON> (JSON::XS/JSON::PP) sets
  the UTF8 flag on properly.
  
      # With UTF8-flagged strings
  
      $json->allow_nonref;
      $str = chr(1000); # UTF8-flagged
  
      $json_text  = $json->utf8(0)->encode($str);
      utf8::is_utf8($json_text);
      # true
      $json_text  = $json->utf8(1)->encode($str);
      utf8::is_utf8($json_text);
      # false
  
      $str = '"' . chr(1000) . '"'; # UTF8-flagged
  
      $perl_scalar  = $json->utf8(0)->decode($str);
      utf8::is_utf8($perl_scalar);
      # true
      $perl_scalar  = $json->utf8(1)->decode($str);
      # died because of 'Wide character in subroutine'
  
  See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
  
  =item $JSON::UnMapping
  
  Disable. See to L<MAPPING>.
  
  =item $JSON::SelfConvert
  
  This option was deleted.
  Instead of it, if a given blessed object has the C<TO_JSON> method,
  C<TO_JSON> will be executed with C<convert_blessed>.
  
    $json->convert_blessed->encode($blessed_hashref_or_arrayref)
    # if need, call allow_blessed
  
  Note that it was C<toJson> in old version, but now not C<toJson> but C<TO_JSON>.
  
  =back
  
  =head1 TODO
  
  =over
  
  =item example programs
  
  =back
  
  =head1 THREADS
  
  No test with JSON::PP. If with JSON::XS, See to L<JSON::XS/THREADS>.
  
  
  =head1 BUGS
  
  Please report bugs relevant to C<JSON> to E<lt>makamaka[at]cpan.orgE<gt>.
  
  
  =head1 SEE ALSO
  
  Most of the document is copied and modified from JSON::XS doc.
  
  L<JSON::XS>, L<JSON::PP>
  
  C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>)
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  JSON::XS was written by  Marc Lehmann <schmorp[at]schmorp.de>
  
  The release of this new version owes to the courtesy of Marc Lehmann.
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2005-2013 by Makamaka Hannyaharamitu
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
  
JSON

$fatpacked{"JSON/backportPP.pm"} = <<'JSON_BACKPORTPP';
  package # This is JSON::backportPP
      JSON::PP;
  
  # JSON-2.0
  
  use 5.005;
  use strict;
  use base qw(Exporter);
  use overload ();
  
  use Carp ();
  use B ();
  #use Devel::Peek;
  
  use vars qw($VERSION);
  $VERSION = '2.27202';
  
  @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::backportPP::Compat5006' : 'JSON::backportPP::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 number 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 digits 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 # hide from PAUSE
            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 Scalar::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);
          }
      }
  }
  
  
  # shamelessly copied and modified from JSON::XS code.
  
  $JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::backportPP::Boolean" };
  $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::backportPP::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::backportPP::Boolean;
  
  @JSON::backportPP::Boolean::ISA = ('JSON::PP::Boolean');
  use overload (
     "0+"     => sub { ${$_[0]} },
     "++"     => sub { $_[0] = ${$_[0]} + 1 },
     "--"     => sub { $_[0] = ${$_[0]} - 1 },
     fallback => 1,
  );
  
  
  ###############################
  
  package # hide from PAUSE
    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;
  
  use vars qw($VERSION);
  $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
  
  =head1 NAME
  
  JSON::PP - JSON::XS compatible pure-Perl module.
  
  =head1 SYNOPSIS
  
   use JSON::PP;
  
   # exported functions, they croak on error
   # and expect/generate UTF-8
  
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
  
   # OO-interface
  
   $coder = JSON::PP->new->ascii->pretty->allow_nonref;
   
   $json_text   = $json->encode( $perl_scalar );
   $perl_scalar = $json->decode( $json_text );
   
   $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
   
   # Note that JSON version 2.0 and above will automatically use
   # JSON::XS or JSON::PP, so you should be able to just:
   
   use JSON;
  
  
  =head1 VERSION
  
      2.27200
  
  L<JSON::XS> 2.27 (~2.30) compatible.
  
  =head1 DESCRIPTION
  
  This module is L<JSON::XS> compatible pure Perl module.
  (Perl 5.8 or later is recommended)
  
  JSON::XS is the fastest and most proper JSON module on CPAN.
  It is written by Marc Lehmann in C, so must be compiled and
  installed in the used environment.
  
  JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
  
  
  =head2 FEATURES
  
  =over
  
  =item * correct unicode handling
  
  This module knows how to handle Unicode (depending on Perl version).
  
  See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and
  L<UNICODE HANDLING ON PERLS>.
  
  
  =item * round-trip integrity
  
  When you serialise a perl data structure using only data types
  supported by JSON and Perl, the deserialised data structure is
  identical on the Perl level. (e.g. the string "2.0" doesn't suddenly
  become "2" just because it looks like a number). There I<are> minor
  exceptions to this, read the MAPPING section below to learn about
  those.
  
  
  =item * strict checking of JSON correctness
  
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a
  security feature). But when some options are set, loose checking
  features are available.
  
  =back
  
  =head1 FUNCTIONAL INTERFACE
  
  Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
  
  =head2 encode_json
  
      $json_text = encode_json $perl_scalar
  
  Converts the given Perl data structure to a UTF-8 encoded, binary string.
  
  This function call is functionally identical to:
  
      $json_text = JSON::PP->new->utf8->encode($perl_scalar)
  
  =head2 decode_json
  
      $perl_scalar = decode_json $json_text
  
  The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
  to parse that as an UTF-8 encoded JSON text, returning the resulting
  reference.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON::PP->new->utf8->decode($json_text)
  
  =head2 JSON::PP::is_bool
  
      $is_boolean = JSON::PP::is_bool($scalar)
  
  Returns true if the passed scalar represents either JSON::PP::true or
  JSON::PP::false, two constants that act like C<1> and C<0> respectively
  and are also used to represent JSON C<true> and C<false> in Perl strings.
  
  =head2 JSON::PP::true
  
  Returns JSON true value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
  
  =head2 JSON::PP::false
  
  Returns JSON false value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
  
  =head2 JSON::PP::null
  
  Returns C<undef>.
  
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
  
  
  =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
  
  This section supposes that your perl version is 5.8 or later.
  
  If you know a JSON text from an outer world - a network, a file content, and so on,
  is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
  with C<utf8> enable. And the decoded result will contain UNICODE characters.
  
    # from network
    my $json        = JSON::PP->new->utf8;
    my $json_text   = CGI->new->param( 'json_data' );
    my $perl_scalar = $json->decode( $json_text );
    
    # from file content
    local $/;
    open( my $fh, '<', 'json.data' );
    $json_text   = <$fh>;
    $perl_scalar = decode_json( $json_text );
  
  If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
  
    use Encode;
    local $/;
    open( my $fh, '<', 'json.data' );
    my $encoding = 'cp932';
    my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
    
    # or you can write the below code.
    #
    # open( my $fh, "<:encoding($encoding)", 'json.data' );
    # $unicode_json_text = <$fh>;
  
  In this case, C<$unicode_json_text> is of course UNICODE string.
  So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
  
    $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
  
  Or C<encode 'utf8'> and C<decode_json>:
  
    $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
    # this way is not efficient.
  
  And now, you want to convert your C<$perl_scalar> into JSON data and
  send it to an outer world - a network or a file content, and so on.
  
  Your data usually contains UNICODE strings and you want the converted data to be encoded
  in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
  
    print encode_json( $perl_scalar ); # to a network? file? or display?
    # or
    print $json->utf8->encode( $perl_scalar );
  
  If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
  for some reason, then its characters are regarded as B<latin1> for perl
  (because it does not concern with your $encoding).
  You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
  Note that the resulted text is a UNICODE string but no problem to print it.
  
    # $perl_scalar contains $encoding encoded string values
    $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
    # $unicode_json_text consists of characters less than 0x100
    print $unicode_json_text;
  
  Or C<decode $encoding> all string values and C<encode_json>:
  
    $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
    # ... do it to each string values, then encode_json
    $json_text = encode_json( $perl_scalar );
  
  This method is a proper way but probably not efficient.
  
  See to L<Encode>, L<perluniintro>.
  
  
  =head1 METHODS
  
  Basically, check to L<JSON> or L<JSON::XS>.
  
  =head2 new
  
      $json = JSON::PP->new
  
  Returns a new JSON::PP object that can be used to de/encode JSON
  strings.
  
  All boolean flags described below are by default I<disabled>.
  
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
  
     my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
     => {"a": [1, 2]}
  
  =head2 ascii
  
      $json = $json->ascii([$enable])
      
      $enabled = $json->get_ascii
  
  If $enable is true (or missing), then the encode method will not generate characters outside
  the code range 0..127. Any Unicode characters outside that range will be escaped using either
  a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
  (See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>).
  
  In Perl 5.005, there is no character having high value (more than 255).
  See to L<UNICODE HANDLING ON PERLS>.
  
  If $enable is false, then the encode method will not escape Unicode characters unless
  required by the JSON syntax or other flags. This results in a faster and more compact format.
  
    JSON::PP->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
  
  =head2 latin1
  
      $json = $json->latin1([$enable])
      
      $enabled = $json->get_latin1
  
  If $enable is true (or missing), then the encode method will encode the resulting JSON
  text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
  
  If $enable is false, then the encode method will not escape Unicode characters
  unless required by the JSON syntax or other flags.
  
    JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
  
  See to L<UNICODE HANDLING ON PERLS>.
  
  =head2 utf8
  
      $json = $json->utf8([$enable])
      
      $enabled = $json->get_utf8
  
  If $enable is true (or missing), then the encode method will encode the JSON result
  into UTF-8, as required by many protocols, while the decode method expects to be handled
  an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
  characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
  
  (In Perl 5.005, any character outside the range 0..255 does not exist.
  See to L<UNICODE HANDLING ON PERLS>.)
  
  In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
  encoding families, as described in RFC4627.
  
  If $enable is false, then the encode method will return the JSON string as a (non-encoded)
  Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
  (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
  
  Example, output UTF-16BE-encoded JSON:
  
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);
  
  Example, decode UTF-32LE-encoded JSON:
  
    use Encode;
    $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);
  
  
  =head2 pretty
  
      $json = $json->pretty([$enable])
  
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> flags in one call to generate the most readable
  (or most compact) form possible.
  
  Equivalent to:
  
     $json->indent->space_before->space_after
  
  =head2 indent
  
      $json = $json->indent([$enable])
      
      $enabled = $json->get_indent
  
  The default indent space length is three.
  You can use C<indent_length> to change the length.
  
  =head2 space_before
  
      $json = $json->space_before([$enable])
      
      $enabled = $json->get_space_before
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before enabled, space_after and indent disabled:
  
     {"key" :"value"}
  
  =head2 space_after
  
      $json = $json->space_after([$enable])
      
      $enabled = $json->get_space_after
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space after the C<:> separating keys from values in JSON objects
  and extra whitespace after the C<,> separating key-value pairs and array
  members.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before and indent disabled, space_after enabled:
  
     {"key": "value"}
  
  =head2 relaxed
  
      $json = $json->relaxed([$enable])
      
      $enabled = $json->get_relaxed
  
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
  
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
  
  Currently accepted extensions are:
  
  =over 4
  
  =item * list items can have an end-comma
  
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
  
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
  
  =item * shell-style '#'-comments
  
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
  
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
  
  =back
  
  =head2 canonical
  
      $json = $json->canonical([$enable])
      
      $enabled = $json->get_canonical
  
  If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
  by sorting their keys. This is adding a comparatively high overhead.
  
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script).
  
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
  
  This setting has no effect when decoding JSON texts.
  
  If you want your own sorting routine, you can give a code reference
  or a subroutine name to C<sort_by>. See to C<JSON::PP OWN METHODS>.
  
  =head2 allow_nonref
  
      $json = $json->allow_nonref([$enable])
      
      $enabled = $json->get_allow_nonref
  
  If C<$enable> is true (or missing), then the C<encode> method can convert a
  non-reference into its corresponding string, number or null JSON value,
  which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
  values instead of croaking.
  
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
  
     JSON::PP->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
  
  =head2 allow_unknown
  
      $json = $json->allow_unknown ([$enable])
      
      $enabled = $json->get_allow_unknown
  
  If $enable is true (or missing), then "encode" will *not* throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON "null" value.
  Note that blessed objects are not included here and are handled
  separately by c<allow_nonref>.
  
  If $enable is false (the default), then "encode" will throw an
  exception when it encounters anything it cannot encode as JSON.
  
  This option does not affect "decode" in any way, and it is
  recommended to leave it off unless you know your communications
  partner.
  
  =head2 allow_blessed
  
      $json = $json->allow_blessed([$enable])
      
      $enabled = $json->get_allow_blessed
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
  
  =head2 convert_blessed
  
      $json = $json->convert_blessed([$enable])
      
      $enabled = $json->get_convert_blessed
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
  to do.
  
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with the C<to_json>
  function or method.
  
  This setting does not yet influence C<decode> in any way.
  
  If C<$enable> is false, then the C<allow_blessed> setting will decide what
  to do when a blessed object is found.
  
  =head2 filter_json_object
  
      $json = $json->filter_json_object([$coderef])
  
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument passed to the coderef
  is a reference to the newly-created hash. If the code references returns
  a single scalar (which need not be a reference), this value
  (i.e. a copy of that scalar to avoid aliasing) is inserted into the
  deserialised data structure. If it returns an empty list
  (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
  hash will be inserted. This setting can slow down decoding considerably.
  
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialised hash in any
  way.
  
  Example, convert all JSON objects into the integer 5:
  
     my $js = JSON::PP->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]'); # the given subroutine takes a hash reference.
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
  
  =head2 filter_json_single_key_object
  
      $json = $json->filter_json_single_key_object($key [=> $coderef])
  
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
  
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
  
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
  
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialise Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialised Perl hash.
  
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
  
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
  
     # return whatever is in $WIDGET{5}:
     JSON::PP
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
  
     # this can be used with a TO_JSON method in some "widget" class
     # for serialisation to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
  
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
  
        { __widget__ => $self->{id} }
     }
  
  =head2 shrink
  
      $json = $json->shrink([$enable])
      
      $enabled = $json->get_shrink
  
  In JSON::XS, this flag resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible.
  It will also try to downgrade any strings to octet-form if possible.
  
  In JSON::PP, it is noop about resizing strings but tries
  C<utf8::downgrade> to the returned string by C<encode>.
  See to L<utf8>.
  
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
  
  =head2 max_depth
  
      $json = $json->max_depth([$maximum_nesting_depth])
      
      $max_depth = $json->get_max_depth
  
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
  
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
  
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
  
  See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
  
  When a large value (100 or more) was set and it de/encodes a deep nested object/text,
  it may raise a warning 'Deep recursion on subroutine' at the perl runtime phase.
  
  =head2 max_size
  
      $json = $json->max_size([$maximum_string_size])
      
      $max_size = $json->get_max_size
  
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
  
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
  
  See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.
  
  =head2 encode
  
      $json_text = $json->encode($perl_scalar)
  
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to arrays
  become JSON arrays and references to hashes become JSON objects. Undefined
  Perl values (e.g. C<undef>) become JSON C<null> values.
  References to the integers C<0> and C<1> are converted into C<true> and C<false>.
  
  =head2 decode
  
      $perl_scalar = $json->decode($json_text)
  
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
  
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
  C<null> becomes C<undef>.
  
  =head2 decode_prefix
  
      ($perl_scalar, $characters) = $json->decode_prefix($json_text)
  
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
  
     JSON->new->decode_prefix ("[1] the tail")
     => ([], 3)
  
  =head1 INCREMENTAL PARSING
  
  Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
  
  In some cases, there is the need for incremental parsing of JSON texts.
  This module does allow you to parse a JSON stream incrementally.
  It does so by accumulating text until it has a full JSON object, which
  it then can decode. This process is similar to using C<decode_prefix>
  to see if a full JSON object is available, but is much more efficient
  (and can be implemented with a minimum of method calls).
  
  This module will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect parenthesis
  mismatches. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
  
  The following methods implement this incremental parser.
  
  =head2 incr_parse
  
      $json->incr_parse( [$string] ) # void context
      
      $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
      
      @obj_or_empty = $json->incr_parse( [$string] ) # list context
  
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
  
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
  
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
  
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the erroneous part). This is the most common way of
  using the method.
  
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
  
  Example: Parse some JSON arrays/objects in a given string and return them.
  
      my @objs = JSON->new->incr_parse ("[5][7][1,2]");
  
  =head2 incr_text
  
      $lvalue_string = $json->incr_text
  
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
  
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
  
      $json->incr_text =~ s/\s*,\s*//;
  
  In Perl 5.005, C<lvalue> attribute is not available.
  You must write codes like the below:
  
      $string = $json->incr_text;
      $string =~ s/\s*,\s*//;
      $json->incr_text( $string );
  
  =head2 incr_skip
  
      $json->incr_skip
  
  This will reset the state of the incremental parser and will remove the
  parsed text from the input buffer. This is useful after C<incr_parse>
  died, in which case the input buffer and incremental parser state is left
  unchanged, to skip the text parsed so far and to reset the parse state.
  
  =head2 incr_reset
  
      $json->incr_reset
  
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
  
  This is useful if you want to repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
  
  See to L<JSON::XS/INCREMENTAL PARSING> for examples.
  
  
  =head1 JSON::PP OWN METHODS
  
  =head2 allow_singlequote
  
      $json = $json->allow_singlequote([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  JSON strings quoted by single quotations that are invalid JSON
  format.
  
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
  
  =head2 allow_barekey
  
      $json = $json->allow_barekey([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
      $json->allow_barekey->decode('{foo:"bar"}');
  
  =head2 allow_bignum
  
      $json = $json->allow_bignum([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
  
  On the contrary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers with C<allow_blessed> enable.
  
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
  
  See to L<JSON::XS/MAPPING> about the normal conversion of JSON number.
  
  =head2 loose
  
      $json = $json->loose([$enable])
  
  The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
  and the module doesn't allow to C<decode> to these (except for \x2f).
  If C<$enable> is true (or missing), then C<decode>  will accept these
  unescaped strings.
  
      $json->loose->decode(qq|["abc
                                     def"]|);
  
  See L<JSON::XS/SSECURITY CONSIDERATIONS>.
  
  =head2 escape_slash
  
      $json = $json->escape_slash([$enable])
  
  According to JSON Grammar, I<slash> (U+002F) is escaped. But default
  JSON::PP (as same as JSON::XS) encodes strings without escaping slash.
  
  If C<$enable> is true (or missing), then C<encode> will escape slashes.
  
  =head2 indent_length
  
      $json = $json->indent_length($length)
  
  JSON::XS indent space length is 3 and cannot be changed.
  JSON::PP set the indent space length with the given $length.
  The default is 3. The acceptable range is 0 to 15.
  
  =head2 sort_by
  
      $json = $json->sort_by($function_name)
      $json = $json->sort_by($subroutine_ref)
  
  If $function_name or $subroutine_ref are set, its sort routine are used
  in encoding JSON objects.
  
     $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     $js = $pc->sort_by('own_sort')->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
  
  As the sorting routine runs in the JSON::PP scope, the given
  subroutine name and the special variables C<$a>, C<$b> will begin
  'JSON::PP::'.
  
  If $integer is set, then the effect is same as C<canonical> on.
  
  =head1 INTERNAL
  
  For developers.
  
  =over
  
  =item PP_encode_box
  
  Returns
  
          {
              depth        => $depth,
              indent_count => $indent_count,
          }
  
  
  =item PP_decode_box
  
  Returns
  
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
  
  =back
  
  =head1 MAPPING
  
  This section is copied from JSON::XS and modified to C<JSON::PP>.
  JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
  
  See to L<JSON::XS/MAPPING>.
  
  =head2 JSON -> PERL
  
  =over 4
  
  =item object
  
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserver object key ordering itself).
  
  =item array
  
  A JSON array becomes a reference to an array in Perl.
  
  =item string
  
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
  
  =item number
  
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
  
  If the number consists of digits only, C<JSON> will try to represent
  it as an integer value. If that fails, it will try to represent it as
  a numeric (floating point) value if that is possible without loss of
  precision. Otherwise it will preserve the number as a string value (in
  which case you lose roundtripping ability, as the JSON number will be
  re-encoded to a JSON string).
  
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
  
  Note that precision is not accuracy - binary floating point values cannot
  represent most decimal fractions exactly, and when converting from and to
  floating point, C<JSON> only guarantees precision up to but not including
  the least significant bit.
  
  When C<allow_bignum> is enable, the big integers 
  and the numeric can be optionally converted into L<Math::BigInt> and
  L<Math::BigFloat> objects.
  
  =item true, false
  
  These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
  respectively. They are overloaded to act almost exactly like the numbers
  C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
  the C<JSON::is_bool> function.
  
     print JSON::PP::true . "\n";
      => true
     print JSON::PP::true + 1;
      => 1
  
     ok(JSON::true eq  '1');
     ok(JSON::true == 1);
  
  C<JSON> will install these missing overloading features to the backend modules.
  
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  C<JSON::PP::null> returns C<undef>.
  
  =back
  
  
  =head2 PERL -> JSON
  
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
  
  =over 4
  
  =item hash references
  
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. C<JSON>
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same data structure will serialise to the same JSON text (given same
  settings and version of JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
  
  
  =item array references
  
  Perl array references become JSON arrays.
  
  =item other references
  
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
  also use C<JSON::false> and C<JSON::true> to improve readability.
  
     to_json [\0,JSON::PP::true]      # yields [false,true]
  
  =item JSON::PP::true, JSON::PP::false, JSON::PP::null
  
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> directly if you want.
  
  JSON::PP::null returns C<undef>.
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON. See the
  C<allow_blessed> and C<convert_blessed> methods on various options on
  how to deal with this: basically, you can choose between throwing an
  exception, encoding the reference as if it weren't blessed, or provide
  your own serialiser method.
  
  See to L<convert_blessed>.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
  JSON C<null> values, scalars that have last been used in a string context
  before encoding as JSON strings, and anything else as number value:
  
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
  
     # used as string, so dump as string
     print $value;
     encode_json [$value]                 # yields ["5"]
  
     # undef becomes null
     encode_json [undef]                  # yields [null]
  
  You can force the type to be a string by stringifying it:
  
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
  
  You can force the type to be a number by numifying it:
  
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choice is yours.
  
  You can not currently force the type in other, less obscure, ways.
  
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and it is an
  error to pass those in.
  
  =item Big Number
  
  When C<allow_bignum> is enable, 
  C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers.
  
  
  =back
  
  =head1 UNICODE HANDLING ON PERLS
  
  If you do not know about Unicode on Perl well,
  please check L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
  
  =head2 Perl 5.8 and later
  
  Perl can handle Unicode and the JSON::PP de/encode methods also work properly.
  
      $json->allow_nonref->encode(chr hex 3042);
      $json->allow_nonref->encode(chr hex 12345);
  
  Returns C<"\u3042"> and C<"\ud808\udf45"> respectively.
  
      $json->allow_nonref->decode('"\u3042"');
      $json->allow_nonref->decode('"\ud808\udf45"');
  
  Returns UTF-8 encoded strings with UTF8 flag, regarded as C<U+3042> and C<U+12345>.
  
  Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C<join> was broken,
  so JSON::PP wraps the C<join> with a subroutine. Thus JSON::PP works slow in the versions.
  
  
  =head2 Perl 5.6
  
  Perl can handle Unicode and the JSON::PP de/encode methods also work.
  
  =head2 Perl 5.005
  
  Perl 5.005 is a byte semantics world -- all strings are sequences of bytes.
  That means the unicode handling is not available.
  
  In encoding,
  
      $json->allow_nonref->encode(chr hex 3042);  # hex 3042 is 12354.
      $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565.
  
  Returns C<B> and C<E>, as C<chr> takes a value more than 255, it treats
  as C<$value % 256>, so the above codes are equivalent to :
  
      $json->allow_nonref->encode(chr 66);
      $json->allow_nonref->encode(chr 69);
  
  In decoding,
  
      $json->decode('"\u00e3\u0081\u0082"');
  
  The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded
  japanese character (C<HIRAGANA LETTER A>).
  And if it is represented in Unicode code point, C<U+3042>.
  
  Next, 
  
      $json->decode('"\u3042"');
  
  We ordinary expect the returned value is a Unicode character C<U+3042>.
  But here is 5.005 world. This is C<0xE3 0x81 0x82>.
  
      $json->decode('"\ud808\udf45"');
  
  This is not a character C<U+12345> but bytes - C<0xf0 0x92 0x8d 0x85>.
  
  
  =head1 TODO
  
  =over
  
  =item speed
  
  =item memory saving
  
  =back
  
  
  =head1 SEE ALSO
  
  Most of the document are copied and modified from JSON::XS doc.
  
  L<JSON::XS>
  
  RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2007-2012 by Makamaka Hannyaharamitu
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
JSON_BACKPORTPP

$fatpacked{"JSON/backportPP/Boolean.pm"} = <<'JSON_BACKPORTPP_BOOLEAN';
  =head1 NAME
  
  JSON::PP::Boolean - dummy module providing JSON::PP::Boolean
  
  =head1 SYNOPSIS
  
   # do not "use" yourself
  
  =head1 DESCRIPTION
  
  This module exists only to provide overload resolution for Storable
  and similar modules. See L<JSON::PP> for more info about this class.
  
  =cut
  
  use JSON::backportPP ();
  use strict;
  
  1;
  
  =head1 AUTHOR
  
  This idea is from L<JSON::XS::Boolean> written by
  Marc Lehmann <schmorp[at]schmorp.de>
  
  =cut
  
JSON_BACKPORTPP_BOOLEAN

$fatpacked{"JSON/backportPP/Compat5005.pm"} = <<'JSON_BACKPORTPP_COMPAT5005';
  package # This is JSON::backportPP
      JSON::backportPP5005;
  
  use 5.005;
  use strict;
  
  my @properties;
  
  $JSON::PP5005::VERSION = '1.10';
  
  BEGIN {
  
      sub utf8::is_utf8 {
          0; # It is considered that UTF8 flag off for Perl 5.005.
      }
  
      sub utf8::upgrade {
      }
  
      sub utf8::downgrade {
          1; # must always return true.
      }
  
      sub utf8::encode  {
      }
  
      sub utf8::decode {
      }
  
      *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;
  
      # missing in B module.
      sub B::SVp_IOK () { 0x01000000; }
      sub B::SVp_NOK () { 0x02000000; }
      sub B::SVp_POK () { 0x04000000; }
  
      $INC{'bytes.pm'} = 1; # dummy
  }
  
  
  
  sub _encode_ascii {
      join('', map { $_ <= 127 ? chr($_) : sprintf('\u%04x', $_) } unpack('C*', $_[0]) );
  }
  
  
  sub _encode_latin1 {
      join('', map { chr($_) } unpack('C*', $_[0]) );
  }
  
  
  sub _decode_surrogates { # from http://homepage1.nifty.com/nomenclator/unicode/ucs_utf.htm
      my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00); # from perlunicode
      my $bit = unpack('B32', pack('N', $uni));
  
      if ( $bit =~ /^00000000000(...)(......)(......)(......)$/ ) {
          my ($w, $x, $y, $z) = ($1, $2, $3, $4);
          return pack('B*', sprintf('11110%s10%s10%s10%s', $w, $x, $y, $z));
      }
      else {
          Carp::croak("Invalid surrogate pair");
      }
  }
  
  
  sub _decode_unicode {
      my ($u) = @_;
      my ($utf8bit);
  
      if ( $u =~ /^00([89a-f][0-9a-f])$/i ) { # 0x80-0xff
           return pack( 'H2', $1 );
      }
  
      my $bit = unpack("B*", pack("H*", $u));
  
      if ( $bit =~ /^00000(.....)(......)$/ ) {
          $utf8bit = sprintf('110%s10%s', $1, $2);
      }
      elsif ( $bit =~ /^(....)(......)(......)$/ ) {
          $utf8bit = sprintf('1110%s10%s10%s', $1, $2, $3);
      }
      else {
          Carp::croak("Invalid escaped unicode");
      }
  
      return pack('B*', $utf8bit);
  }
  
  
  sub JSON::PP::incr_text {
      $_[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} = $_[1] if ( @_ > 1 );
      $_[0]->{_incr_parser}->{incr_text};
  }
  
  
  1;
  __END__
  
  =pod
  
  =head1 NAME
  
  JSON::PP5005 - Helper module in using JSON::PP in Perl 5.005
  
  =head1 DESCRIPTION
  
  JSON::PP calls internally.
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2007-2012 by Makamaka Hannyaharamitu
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
  
JSON_BACKPORTPP_COMPAT5005

$fatpacked{"JSON/backportPP/Compat5006.pm"} = <<'JSON_BACKPORTPP_COMPAT5006';
  package # This is JSON::backportPP
      JSON::backportPP56;
  
  use 5.006;
  use strict;
  
  my @properties;
  
  $JSON::PP56::VERSION = '1.08';
  
  BEGIN {
  
      sub utf8::is_utf8 {
          my $len =  length $_[0]; # char length
          {
              use bytes; #  byte length;
              return $len != length $_[0]; # if !=, UTF8-flagged on.
          }
      }
  
  
      sub utf8::upgrade {
          ; # noop;
      }
  
  
      sub utf8::downgrade ($;$) {
          return 1 unless ( utf8::is_utf8( $_[0] ) );
  
          if ( _is_valid_utf8( $_[0] ) ) {
              my $downgrade;
              for my $c ( unpack( "U*", $_[0] ) ) {
                  if ( $c < 256 ) {
                      $downgrade .= pack("C", $c);
                  }
                  else {
                      $downgrade .= pack("U", $c);
                  }
              }
              $_[0] = $downgrade;
              return 1;
          }
          else {
              Carp::croak("Wide character in subroutine entry") unless ( $_[1] );
              0;
          }
      }
  
  
      sub utf8::encode ($) { # UTF8 flag off
          if ( utf8::is_utf8( $_[0] ) ) {
              $_[0] = pack( "C*", unpack( "C*", $_[0] ) );
          }
          else {
              $_[0] = pack( "U*", unpack( "C*", $_[0] ) );
              $_[0] = pack( "C*", unpack( "C*", $_[0] ) );
          }
      }
  
  
      sub utf8::decode ($) { # UTF8 flag on
          if ( _is_valid_utf8( $_[0] ) ) {
              utf8::downgrade( $_[0] );
              $_[0] = pack( "U*", unpack( "U*", $_[0] ) );
          }
      }
  
  
      *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
      *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
      *JSON::PP::JSON_PP_decode_surrogates = \&JSON::PP::_decode_surrogates;
      *JSON::PP::JSON_PP_decode_unicode    = \&JSON::PP::_decode_unicode;
  
      unless ( defined &B::SVp_NOK ) { # missing in B module.
          eval q{ sub B::SVp_NOK () { 0x02000000; } };
      }
  
  }
  
  
  
  sub _encode_ascii {
      join('',
          map {
              $_ <= 127 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_));
          } _unpack_emu($_[0])
      );
  }
  
  
  sub _encode_latin1 {
      join('',
          map {
              $_ <= 255 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', JSON::PP::_encode_surrogates($_));
          } _unpack_emu($_[0])
      );
  }
  
  
  sub _unpack_emu { # for Perl 5.6 unpack warnings
      return   !utf8::is_utf8($_[0]) ? unpack('C*', $_[0]) 
             : _is_valid_utf8($_[0]) ? unpack('U*', $_[0])
             : unpack('C*', $_[0]);
  }
  
  
  sub _is_valid_utf8 {
      my $str = $_[0];
      my $is_utf8;
  
      while ($str =~ /(?:
            (
               [\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]
            )
          | (.)
      )/xg)
      {
          if (defined $1) {
              $is_utf8 = 1 if (!defined $is_utf8);
          }
          else {
              $is_utf8 = 0 if (!defined $is_utf8);
              if ($is_utf8) { # eventually, not utf8
                  return;
              }
          }
      }
  
      return $is_utf8;
  }
  
  
  1;
  __END__
  
  =pod
  
  =head1 NAME
  
  JSON::PP56 - Helper module in using JSON::PP in Perl 5.6
  
  =head1 DESCRIPTION
  
  JSON::PP calls internally.
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2007-2012 by Makamaka Hannyaharamitu
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
  
JSON_BACKPORTPP_COMPAT5006

$fatpacked{"Method/Generate/Accessor.pm"} = <<'METHOD_GENERATE_ACCESSOR';
  package Method::Generate::Accessor;
  
  use strictures 1;
  use Moo::_Utils;
  use base qw(Moo::Object);
  use Sub::Quote;
  use B 'perlstring';
  use Scalar::Util 'blessed';
  use overload ();
  use Module::Runtime qw(use_module);
  BEGIN {
    our $CAN_HAZ_XS =
      !$ENV{MOO_XS_DISABLE}
        &&
      _maybe_load_module('Class::XSAccessor')
        &&
      (eval { Class::XSAccessor->VERSION('1.07') })
    ;
  }
  
  sub _die_overwrite
  {
    my ($pkg, $method, $type) = @_;
    die "You cannot overwrite a locally defined method ($method) with @{[ $type || 'an accessor' ]}";
  }
  
  sub generate_method {
    my ($self, $into, $name, $spec, $quote_opts) = @_;
    $spec->{allow_overwrite}++ if $name =~ s/^\+//;
    die "Must have an is" unless my $is = $spec->{is};
    if ($is eq 'ro') {
      $spec->{reader} = $name unless exists $spec->{reader};
    } elsif ($is eq 'rw') {
      $spec->{accessor} = $name unless exists $spec->{accessor}
        or ( $spec->{reader} and $spec->{writer} );
    } elsif ($is eq 'lazy') {
      $spec->{reader} = $name unless exists $spec->{reader};
      $spec->{lazy} = 1;
      $spec->{builder} ||= '_build_'.$name unless $spec->{default};
    } elsif ($is eq 'rwp') {
      $spec->{reader} = $name unless exists $spec->{reader};
      $spec->{writer} = "_set_${name}" unless exists $spec->{writer};
    } elsif ($is ne 'bare') {
      die "Unknown is ${is}";
    }
    if (exists $spec->{builder}) {
      if(ref $spec->{builder}) {
        die "Invalid builder for $into->$name - not a method name, coderef or"
          . " code-convertible object"
          unless ref $spec->{builder} eq 'CODE'
          or (blessed($spec->{builder}) and eval { \&{$spec->{builder}} });
        $spec->{builder_sub} = $spec->{builder};
        $spec->{builder} = 1;
      }
      $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1;
      die "Invalid builder for $into->$name - not a valid method name"
        if $spec->{builder} !~ /\A[A-Za-z_][A-Za-z0-9_]*(?:::[A-Za-z_][A-Za-z0-9_]*)*\z/;
    }
    if (($spec->{predicate}||0) eq 1) {
      $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}";
    }
    if (($spec->{clearer}||0) eq 1) {
      $spec->{clearer} = $name =~ /^_/ ? "_clear${name}" : "clear_${name}";
    }
    if (($spec->{trigger}||0) eq 1) {
      $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
    }
  
    for my $setting (qw( isa coerce )) {
      next if !exists $spec->{$setting};
      $self->_validate_codulatable($setting, $spec->{$setting}, "$into->$name");
    }
  
    if (exists $spec->{default}) {
      if (!defined $spec->{default} || ref $spec->{default}) {
        $self->_validate_codulatable('default', $spec->{default}, "$into->$name", 'or a non-ref');
      }
    }
  
    if (exists $spec->{moosify}) {
      if (ref $spec->{moosify} ne 'ARRAY') {
        $spec->{moosify} = [$spec->{moosify}];
      }
  
      for my $spec (@{$spec->{moosify}}) {
        $self->_validate_codulatable('moosify', $spec, "$into->$name");
      }
    }
  
    my %methods;
    if (my $reader = $spec->{reader}) {
      _die_overwrite($into, $reader, 'a reader')
        if !$spec->{allow_overwrite} && *{_getglob("${into}::${reader}")}{CODE};
      if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) {
        $methods{$reader} = $self->_generate_xs(
          getters => $into, $reader, $name, $spec
        );
      } else {
        $self->{captures} = {};
        $methods{$reader} =
          quote_sub "${into}::${reader}"
            => '    die "'.$reader.' is a read-only accessor" if @_ > 1;'."\n"
               .$self->_generate_get($name, $spec)
            => delete $self->{captures}
          ;
      }
    }
    if (my $accessor = $spec->{accessor}) {
      _die_overwrite($into, $accessor, 'an accessor')
        if !$spec->{allow_overwrite} && *{_getglob("${into}::${accessor}")}{CODE};
      if (
        our $CAN_HAZ_XS
        && $self->is_simple_get($name, $spec)
        && $self->is_simple_set($name, $spec)
      ) {
        $methods{$accessor} = $self->_generate_xs(
          accessors => $into, $accessor, $name, $spec
        );
      } else {
        $self->{captures} = {};
        $methods{$accessor} =
          quote_sub "${into}::${accessor}"
            => $self->_generate_getset($name, $spec)
            => delete $self->{captures}
          ;
      }
    }
    if (my $writer = $spec->{writer}) {
      _die_overwrite($into, $writer, 'a writer')
        if !$spec->{allow_overwrite} && *{_getglob("${into}::${writer}")}{CODE};
      if (
        our $CAN_HAZ_XS
        && $self->is_simple_set($name, $spec)
      ) {
        $methods{$writer} = $self->_generate_xs(
          setters => $into, $writer, $name, $spec
        );
      } else {
        $self->{captures} = {};
        $methods{$writer} =
          quote_sub "${into}::${writer}"
            => $self->_generate_set($name, $spec)
            => delete $self->{captures}
          ;
      }
    }
    if (my $pred = $spec->{predicate}) {
      _die_overwrite($into, $pred, 'a predicate')
        if !$spec->{allow_overwrite} && *{_getglob("${into}::${pred}")}{CODE};
      $methods{$pred} =
        quote_sub "${into}::${pred}" =>
          '    '.$self->_generate_simple_has('$_[0]', $name, $spec)."\n"
        ;
    }
    if (my $pred = $spec->{builder_sub}) {
      _install_coderef( "${into}::$spec->{builder}" => $spec->{builder_sub} );
    }
    if (my $cl = $spec->{clearer}) {
      _die_overwrite($into, $cl, 'a clearer')
        if !$spec->{allow_overwrite} && *{_getglob("${into}::${cl}")}{CODE};
      $methods{$cl} =
        quote_sub "${into}::${cl}" => 
          $self->_generate_simple_clear('$_[0]', $name, $spec)."\n"
        ;
    }
    if (my $hspec = $spec->{handles}) {
      my $asserter = $spec->{asserter} ||= '_assert_'.$name;
      my @specs = do {
        if (ref($hspec) eq 'ARRAY') {
          map [ $_ => $_ ], @$hspec;
        } elsif (ref($hspec) eq 'HASH') {
          map [ $_ => ref($hspec->{$_}) ? @{$hspec->{$_}} : $hspec->{$_} ],
            keys %$hspec;
        } elsif (!ref($hspec)) {
          map [ $_ => $_ ], use_module('Role::Tiny')->methods_provided_by(use_module($hspec))
        } else {
          die "You gave me a handles of ${hspec} and I have no idea why";
        }
      };
      foreach my $delegation_spec (@specs) {
        my ($proxy, $target, @args) = @$delegation_spec;
        _die_overwrite($into, $proxy, 'a delegation')
          if !$spec->{allow_overwrite} && *{_getglob("${into}::${proxy}")}{CODE};
        $self->{captures} = {};
        $methods{$proxy} =
          quote_sub "${into}::${proxy}" =>
            $self->_generate_delegation($asserter, $target, \@args),
            delete $self->{captures}
          ;
      }
    }
    if (my $asserter = $spec->{asserter}) {
      $self->{captures} = {};
  
  
      $methods{$asserter} =
        quote_sub "${into}::${asserter}" => $self->_generate_asserter($name, $spec),
          delete $self->{captures}
        ;
    }
    \%methods;
  }
  
  sub is_simple_attribute {
    my ($self, $name, $spec) = @_;
    # clearer doesn't have to be listed because it doesn't
    # affect whether defined/exists makes a difference
    !grep $spec->{$_},
      qw(lazy default builder coerce isa trigger predicate weak_ref);
  }
  
  sub is_simple_get {
    my ($self, $name, $spec) = @_;
    !($spec->{lazy} and ($spec->{default} or $spec->{builder}));
  }
  
  sub is_simple_set {
    my ($self, $name, $spec) = @_;
    !grep $spec->{$_}, qw(coerce isa trigger weak_ref);
  }
  
  sub has_eager_default {
    my ($self, $name, $spec) = @_;
    (!$spec->{lazy} and (exists $spec->{default} or $spec->{builder}));
  }
  
  sub _generate_get {
    my ($self, $name, $spec) = @_;
    my $simple = $self->_generate_simple_get('$_[0]', $name, $spec);
    if ($self->is_simple_get($name, $spec)) {
      $simple;
    } else {
      $self->_generate_use_default(
        '$_[0]', $name, $spec,
        $self->_generate_simple_has('$_[0]', $name, $spec),
      );
    }
  }
  
  sub _generate_simple_has {
    my ($self, $me, $name) = @_;
    "exists ${me}->{${\perlstring $name}}";
  }
  
  sub _generate_simple_clear {
    my ($self, $me, $name) = @_;
    "    delete ${me}->{${\perlstring $name}}\n"
  }
  
  sub generate_get_default {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_get_default(@_);
    ($code, delete $self->{captures});
  }
  
  sub _generate_use_default {
    my ($self, $me, $name, $spec, $test) = @_;
    my $get_value = $self->_generate_get_default($me, $name, $spec);
    if ($spec->{coerce}) {
      $get_value = $self->_generate_coerce(
        $name, $get_value,
        $spec->{coerce}
      )
    }
    $test." ? \n"
    .$self->_generate_simple_get($me, $name, $spec)."\n:"
    .($spec->{isa}
      ? "    do {\n      my \$value = ".$get_value.";\n"
        ."      ".$self->_generate_isa_check($name, '$value', $spec->{isa}).";\n"
        ."      ".$self->_generate_simple_set($me, $name, $spec, '$value')."\n"
        ."    }\n"
      : '    ('.$self->_generate_simple_set($me, $name, $spec, $get_value).")\n");
  }
  
  sub _generate_get_default {
    my ($self, $me, $name, $spec) = @_;
    if (exists $spec->{default}) {
      ref $spec->{default}
        ? $self->_generate_call_code($name, 'default', $me, $spec->{default})
        : perlstring $spec->{default};
    }
    else {
      "${me}->${\$spec->{builder}}"
    }
  }
  
  sub generate_simple_get {
    my ($self, @args) = @_;
    $self->_generate_simple_get(@args);
  }
  
  sub _generate_simple_get {
    my ($self, $me, $name) = @_;
    my $name_str = perlstring $name;
    "${me}->{${name_str}}";
  }
  
  sub _generate_set {
    my ($self, $name, $spec) = @_;
    if ($self->is_simple_set($name, $spec)) {
      $self->_generate_simple_set('$_[0]', $name, $spec, '$_[1]');
    } else {
      my ($coerce, $trigger, $isa_check) = @{$spec}{qw(coerce trigger isa)};
      my $value_store = '$_[0]';
      my $code;
      if ($coerce) {
        $value_store = '$value';
        $code = "do { my (\$self, \$value) = \@_;\n"
          ."        \$value = "
          .$self->_generate_coerce($name, $value_store, $coerce).";\n";
      }
      else {
        $code = "do { my \$self = shift;\n";
      }
      if ($isa_check) {
        $code .= 
          "        ".$self->_generate_isa_check($name, $value_store, $isa_check).";\n";
      }
      my $simple = $self->_generate_simple_set('$self', $name, $spec, $value_store);
      if ($trigger) {
        my $fire = $self->_generate_trigger($name, '$self', $value_store, $trigger);
        $code .=
          "        ".$simple.";\n        ".$fire.";\n"
          ."        $value_store;\n";
      } else {
        $code .= "        ".$simple.";\n";
      }
      $code .= "      }";
      $code;
    }
  }
  
  sub generate_coerce {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_coerce(@_);
    ($code, delete $self->{captures});
  }
  
  sub _attr_desc {
    my ($name, $init_arg) = @_;
    return perlstring($name) if !defined($init_arg) or $init_arg eq $name;
    return perlstring($name).' (constructor argument: '.perlstring($init_arg).')';
  }
  
  sub _generate_coerce {
    my ($self, $name, $value, $coerce, $init_arg) = @_;
    $self->_generate_die_prefix(
      "coercion for ${\_attr_desc($name, $init_arg)} failed: ",
      $self->_generate_call_code($name, 'coerce', "${value}", $coerce)
    );
  }
   
  sub generate_trigger {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_trigger(@_);
    ($code, delete $self->{captures});
  }
  
  sub _generate_trigger {
    my ($self, $name, $obj, $value, $trigger) = @_;
    $self->_generate_call_code($name, 'trigger', "${obj}, ${value}", $trigger);
  }
  
  sub generate_isa_check {
    my ($self, @args) = @_;
    $self->{captures} = {};
    my $code = $self->_generate_isa_check(@args);
    ($code, delete $self->{captures});
  }
  
  sub _generate_die_prefix {
    my ($self, $prefix, $inside) = @_;
    "do {\n"
    .'  my $sig_die = $SIG{__DIE__} || sub { die $_[0] };'."\n"
    .'  local $SIG{__DIE__} = sub {'."\n"
    .'    $sig_die->(ref($_[0]) ? $_[0] : '.perlstring($prefix).'.$_[0]);'."\n"
    .'  };'."\n"
    .$inside
    ."}\n"
  }
  
  sub _generate_isa_check {
    my ($self, $name, $value, $check, $init_arg) = @_;
    $self->_generate_die_prefix(
      "isa check for ${\_attr_desc($name, $init_arg)} failed: ",
      $self->_generate_call_code($name, 'isa_check', $value, $check)
    );
  }
  
  sub _generate_call_code {
    my ($self, $name, $type, $values, $sub) = @_;
    $sub = \&{$sub} if blessed($sub);  # coderef if blessed
    if (my $quoted = quoted_from_sub($sub)) {
      my $local = 1;
      if ($values eq '@_' || $values eq '$_[0]') {
        $local = 0;
        $values = '@_';
      }
      my $code = $quoted->[1];
      if (my $captures = $quoted->[2]) {
        my $cap_name = qq{\$${type}_captures_for_${name}};
        $self->{captures}->{$cap_name} = \$captures;
        Sub::Quote::inlinify(
          $code, $values, Sub::Quote::capture_unroll($cap_name, $captures, 6), $local
        );
      } else {
        Sub::Quote::inlinify($code, $values, undef, $local);
      }
    } else {
      my $cap_name = qq{\$${type}_for_${name}};
      $self->{captures}->{$cap_name} = \$sub;
      "${cap_name}->(${values})";
    }
  }
  
  sub generate_populate_set {
    my $self = shift;
    $self->{captures} = {};
    my $code = $self->_generate_populate_set(@_);
    ($code, delete $self->{captures});
  }
  
  sub _generate_populate_set {
    my ($self, $me, $name, $spec, $source, $test, $init_arg) = @_;
    if ($self->has_eager_default($name, $spec)) {
      my $get_indent = ' ' x ($spec->{isa} ? 6 : 4);
      my $get_default = $self->_generate_get_default(
                          '$new', $_, $spec
                        );
      my $get_value = 
        defined($spec->{init_arg})
          ? "(\n${get_indent}  ${test}\n${get_indent}   ? ${source}\n${get_indent}   : "
              .$get_default
              ."\n${get_indent})"
          : $get_default;
      if ($spec->{coerce}) {
        $get_value = $self->_generate_coerce(
          $name, $get_value,
          $spec->{coerce}, $init_arg
        )
      }
      ($spec->{isa}
        ? "    {\n      my \$value = ".$get_value.";\n      "
          .$self->_generate_isa_check(
            $name, '$value', $spec->{isa}, $init_arg
          ).";\n"
          .'      '.$self->_generate_simple_set($me, $name, $spec, '$value').";\n"
          ."    }\n"
        : '    '.$self->_generate_simple_set($me, $name, $spec, $get_value).";\n"
      )
      .($spec->{trigger}
        ? '    '
          .$self->_generate_trigger(
            $name, $me, $self->_generate_simple_get($me, $name, $spec),
            $spec->{trigger}
          )." if ${test};\n"
        : ''
      );
    } else {
      "    if (${test}) {\n"
        .($spec->{coerce}
          ? "      $source = "
            .$self->_generate_coerce(
              $name, $source,
              $spec->{coerce}, $init_arg
            ).";\n"
          : ""
        )
        .($spec->{isa}
          ? "      "
            .$self->_generate_isa_check(
              $name, $source, $spec->{isa}, $init_arg
            ).";\n"
          : ""
        )
        ."      ".$self->_generate_simple_set($me, $name, $spec, $source).";\n"
        .($spec->{trigger}
          ? "      "
            .$self->_generate_trigger(
              $name, $me, $self->_generate_simple_get($me, $name, $spec),
              $spec->{trigger}
            ).";\n"
          : ""
        )
        ."    }\n";
    }
  }
  
  sub _generate_core_set {
    my ($self, $me, $name, $spec, $value) = @_;
    my $name_str = perlstring $name;
    "${me}->{${name_str}} = ${value}";
  }
  
  sub _generate_simple_set {
    my ($self, $me, $name, $spec, $value) = @_;
    my $name_str = perlstring $name;
    my $simple = $self->_generate_core_set($me, $name, $spec, $value);
  
    if ($spec->{weak_ref}) {
      require Scalar::Util;
      my $get = $self->_generate_simple_get($me, $name, $spec);
  
      # Perl < 5.8.3 can't weaken refs to readonly vars
      # (e.g. string constants). This *can* be solved by:
      #
      #Internals::SetReadWrite($foo);
      #Scalar::Util::weaken ($foo);
      #Internals::SetReadOnly($foo);
      #
      # but requires XS and is just too damn crazy
      # so simply throw a better exception
      my $weak_simple = "do { Scalar::Util::weaken(${simple}); no warnings 'void'; $get }";
      Moo::_Utils::lt_5_8_3() ? <<"EOC" : $weak_simple;
        eval { Scalar::Util::weaken($simple); 1 }
          ? do { no warnings 'void'; $get }
          : do {
            if( \$@ =~ /Modification of a read-only value attempted/) {
              require Carp;
              Carp::croak( sprintf (
                'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3',
                $name_str,
              ) );
            } else {
              die \$@;
            }
          }
  EOC
    } else {
      $simple;
    }
  }
  
  sub _generate_getset {
    my ($self, $name, $spec) = @_;
    q{(@_ > 1}."\n      ? ".$self->_generate_set($name, $spec)
      ."\n      : ".$self->_generate_get($name, $spec)."\n    )";
  }
  
  sub _generate_asserter {
    my ($self, $name, $spec) = @_;
  
    "do {\n"
     ."  my \$val = ".$self->_generate_get($name, $spec).";\n"
     ."  unless (".$self->_generate_simple_has('$_[0]', $name, $spec).") {\n"
     .qq!    die "Attempted to access '${name}' but it is not set";\n!
     ."  }\n"
     ."  \$val;\n"
     ."}\n";
  }
  sub _generate_delegation {
    my ($self, $asserter, $target, $args) = @_;
    my $arg_string = do {
      if (@$args) {
        # I could, I reckon, linearise out non-refs here using perlstring
        # plus something to check for numbers but I'm unsure if it's worth it
        $self->{captures}{'@curries'} = $args;
        '@curries, @_';
      } else {
        '@_';
      }
    };
    "shift->${asserter}->${target}(${arg_string});";
  }
  
  sub _generate_xs {
    my ($self, $type, $into, $name, $slot) = @_;
    Class::XSAccessor->import(
      class => $into,
      $type => { $name => $slot },
      replace => 1,
    );
    $into->can($name);
  }
  
  sub default_construction_string { '{}' }
  
  sub _validate_codulatable {
    my ($self, $setting, $value, $into, $appended) = @_;
    my $invalid = "Invalid $setting '" . overload::StrVal($value)
      . "' for $into not a coderef";
    $invalid .= " $appended" if $appended;
  
    unless (ref $value and (ref $value eq 'CODE' or blessed($value))) {
      die "$invalid or code-convertible object";
    }
  
    unless (eval { \&$value }) {
      die "$invalid and could not be converted to a coderef: $@";
    }
  
    1;
  }
  
  1;
METHOD_GENERATE_ACCESSOR

$fatpacked{"Method/Generate/BuildAll.pm"} = <<'METHOD_GENERATE_BUILDALL';
  package Method::Generate::BuildAll;
  
  use strictures 1;
  use base qw(Moo::Object);
  use Sub::Quote;
  use Moo::_Utils;
  use B 'perlstring';
  
  sub generate_method {
    my ($self, $into) = @_;
    quote_sub "${into}::BUILDALL", join '',
      $self->_handle_subbuild($into),
      qq{    my \$self = shift;\n},
      $self->buildall_body_for($into, '$self', '@_'),
      qq{    return \$self\n};
  }
  
  sub _handle_subbuild {
    my ($self, $into) = @_;
    '    if (ref($_[0]) ne '.perlstring($into).') {'."\n".
    '      return shift->Moo::Object::BUILDALL(@_)'.";\n".
    '    }'."\n";
  }
  
  sub buildall_body_for {
    my ($self, $into, $me, $args) = @_;
    my @builds =
      grep *{_getglob($_)}{CODE},
      map "${_}::BUILD",
      reverse @{Moo::_Utils::_get_linear_isa($into)};
    join '', map qq{    ${me}->${_}(${args});\n}, @builds;
  }
  
  1;
METHOD_GENERATE_BUILDALL

$fatpacked{"Method/Generate/Constructor.pm"} = <<'METHOD_GENERATE_CONSTRUCTOR';
  package Method::Generate::Constructor;
  
  use strictures 1;
  use Sub::Quote;
  use base qw(Moo::Object);
  use Sub::Defer;
  use B 'perlstring';
  
  sub register_attribute_specs {
    my ($self, @new_specs) = @_;
    my $specs = $self->{attribute_specs}||={};
    while (my ($name, $new_spec) = splice @new_specs, 0, 2) {
      if ($name =~ s/^\+//) {
        die "has '+${name}' given but no ${name} attribute already exists"
          unless my $old_spec = $specs->{$name};
        foreach my $key (keys %$old_spec) {
          if (!exists $new_spec->{$key}) {
            $new_spec->{$key} = $old_spec->{$key}
              unless $key eq 'handles';
          }
          elsif ($key eq 'moosify') {
            $new_spec->{$key} = [
              map { ref $_ eq 'ARRAY' ? @$_ : $_ }
                ($old_spec->{$key}, $new_spec->{$key})
            ];
          }
        }
      }
      $new_spec->{index} = scalar keys %$specs
        unless defined $new_spec->{index};
      $specs->{$name} = $new_spec;
    }
    $self;
  }
  
  sub all_attribute_specs {
    $_[0]->{attribute_specs}
  }
  
  sub accessor_generator {
    $_[0]->{accessor_generator}
  }
  
  sub construction_string {
    my ($self) = @_;
    $self->{construction_string}
      or 'bless('
         .$self->accessor_generator->default_construction_string
         .', $class);'
  }
  
  sub install_delayed {
    my ($self) = @_;
    my $package = $self->{package};
    defer_sub "${package}::new" => sub {
      unquote_sub $self->generate_method(
        $package, 'new', $self->{attribute_specs}, { no_install => 1 }
      )
    };
    $self;
  }
  
  sub generate_method {
    my ($self, $into, $name, $spec, $quote_opts) = @_;
    foreach my $no_init (grep !exists($spec->{$_}{init_arg}), keys %$spec) {
      $spec->{$no_init}{init_arg} = $no_init;
    }
    local $self->{captures} = {};
    my $body = '    my $class = shift;'."\n"
              .'    $class = ref($class) if ref($class);'."\n";
    $body .= $self->_handle_subconstructor($into, $name);
    my $into_buildargs = $into->can('BUILDARGS');
    if ( $into_buildargs && $into_buildargs != \&Moo::Object::BUILDARGS ) {
        $body .= $self->_generate_args_via_buildargs;
    } else {
        $body .= $self->_generate_args;
    }
    $body .= $self->_check_required($spec);
    $body .= '    my $new = '.$self->construction_string.";\n";
    $body .= $self->_assign_new($spec);
    if ($into->can('BUILD')) {
      require Method::Generate::BuildAll;
      $body .= Method::Generate::BuildAll->new->buildall_body_for(
        $into, '$new', '$args'
      );
    }
    $body .= '    return $new;'."\n";
    if ($into->can('DEMOLISH')) {
      require Method::Generate::DemolishAll;
      Method::Generate::DemolishAll->new->generate_method($into);
    }
    quote_sub
      "${into}::${name}" => $body,
      $self->{captures}, $quote_opts||{}
    ;
  }
  
  sub _handle_subconstructor {
    my ($self, $into, $name) = @_;
    if (my $gen = $self->{subconstructor_handler}) {
      '    if ($class ne '.perlstring($into).') {'."\n".
      $gen.
      '    }'."\n";
    } else {
      ''
    }
  }
  
  sub _cap_call {
    my ($self, $code, $captures) = @_;
    @{$self->{captures}}{keys %$captures} = values %$captures if $captures;
    $code;
  }
  
  sub _generate_args_via_buildargs {
    my ($self) = @_;
    q{    my $args = $class->BUILDARGS(@_);}."\n"
    .q{    die "BUILDARGS did not return a hashref" unless ref($args) eq 'HASH';}
    ."\n";
  }
  
  # inlined from Moo::Object - update that first.
  sub _generate_args {
    my ($self) = @_;
    return <<'_EOA';
      my $args;
      if ( scalar @_ == 1 ) {
          unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
              die "Single parameters to new() must be a HASH ref"
                  ." data => ". $_[0] ."\n";
          }
          $args = { %{ $_[0] } };
      }
      elsif ( @_ % 2 ) {
          die "The new() method for $class expects a hash reference or a key/value list."
                  . " You passed an odd number of arguments\n";
      }
      else {
          $args = {@_};
      }
  _EOA
  
  }
  
  sub _assign_new {
    my ($self, $spec) = @_;
    my $ag = $self->accessor_generator;
    my %test;
    NAME: foreach my $name (sort keys %$spec) {
      my $attr_spec = $spec->{$name};
      next NAME unless defined($attr_spec->{init_arg})
                         or $ag->has_eager_default($name, $attr_spec);
      $test{$name} = $attr_spec->{init_arg};
    }
    join '', map {
      my $arg_key = perlstring($test{$_});
      my $test = "exists \$args->{$arg_key}";
      my $source = "\$args->{$arg_key}";
      my $attr_spec = $spec->{$_};
      $self->_cap_call($ag->generate_populate_set(
        '$new', $_, $attr_spec, $source, $test, $test{$_},
      ));
    } sort keys %test;
  }
  
  sub _check_required {
    my ($self, $spec) = @_;
    my @required_init =
      map $spec->{$_}{init_arg},
        grep {
          my %s = %{$spec->{$_}}; # ignore required if default or builder set
          $s{required} and not($s{builder} or $s{default})
        } sort keys %$spec;
    return '' unless @required_init;
    '    if (my @missing = grep !exists $args->{$_}, qw('
      .join(' ',@required_init).')) {'."\n"
      .q{      die "Missing required arguments: ".join(', ', sort @missing);}."\n"
      ."    }\n";
  }
  
  1;
METHOD_GENERATE_CONSTRUCTOR

$fatpacked{"Method/Generate/DemolishAll.pm"} = <<'METHOD_GENERATE_DEMOLISHALL';
  package Method::Generate::DemolishAll;
  
  use strictures 1;
  use base qw(Moo::Object);
  use Sub::Quote;
  use Moo::_Utils;
  use B qw(perlstring);
  
  sub generate_method {
    my ($self, $into) = @_;
    quote_sub "${into}::DEMOLISHALL", join '',
      $self->_handle_subdemolish($into),
      qq{    my \$self = shift;\n},
      $self->demolishall_body_for($into, '$self', '@_'),
      qq{    return \$self\n};
    quote_sub "${into}::DESTROY", join '',
      q!    my $self = shift;
      my $e = do {
        local $?;
        local $@;
        require Moo::_Utils;
        eval {
          $self->DEMOLISHALL(Moo::_Utils::_in_global_destruction);
        };
        $@;
      };
    
      no warnings 'misc';
      die $e if $e; # rethrow
    !;
  }
  
  sub demolishall_body_for {
    my ($self, $into, $me, $args) = @_;
    my @demolishers =
      grep *{_getglob($_)}{CODE},
      map "${_}::DEMOLISH",
      @{Moo::_Utils::_get_linear_isa($into)};
    join '', map qq{    ${me}->${_}(${args});\n}, @demolishers;
  }
  
  sub _handle_subdemolish {
    my ($self, $into) = @_;
    '    if (ref($_[0]) ne '.perlstring($into).') {'."\n".
    '      return shift->Moo::Object::DEMOLISHALL(@_)'.";\n".
    '    }'."\n";
  }
  
  1;
METHOD_GENERATE_DEMOLISHALL

$fatpacked{"Method/Inliner.pm"} = <<'METHOD_INLINER';
  package Method::Inliner;
  
  use strictures 1;
  use Text::Balanced qw(extract_bracketed);
  use Sub::Quote ();
  
  sub slurp { do { local (@ARGV, $/) = $_[0]; <> } }
  sub splat {
    open my $out, '>', $_[1] or die "can't open $_[1]: $!";
    print $out $_[0] or die "couldn't write to $_[1]: $!";
  }
  
  sub inlinify {
    my $file = $_[0];
    my @chunks = split /(^sub.*?^}$)/sm, slurp $file;
    warn join "\n--\n", @chunks;
    my %code;
    foreach my $chunk (@chunks) {
      if (my ($name, $body) =
        $chunk =~ /^sub (\S+) {\n(.*)\n}$/s
      ) {
        $code{$name} = $body;
      }
    }
    foreach my $chunk (@chunks) {
      my ($me) = $chunk =~ /^sub.*{\n  my \((\$\w+).*\) = \@_;\n/ or next;
      my $meq = quotemeta $me;
      #warn $meq, $chunk;
      my $copy = $chunk;
      my ($fixed, $rest);
      while ($copy =~ s/^(.*?)${meq}->(\S+)(?=\()//s) {
        my ($front, $name) = ($1, $2);
        ((my $body), $rest) = extract_bracketed($copy, '()');
        warn "spotted ${name} - ${body}";
        if ($code{$name}) {
        warn "replacing";
          s/^\(//, s/\)$// for $body;
          $body = "${me}, ".$body;
          $fixed .= $front.Sub::Quote::inlinify($code{$name}, $body);
        } else {
  	$fixed .= $front.$me.'->'.$name.$body;
        }
        #warn $fixed; warn $rest;
        $copy = $rest;
      }
      $fixed .= $rest if $fixed;
      warn $fixed if $fixed;
      $chunk = $fixed if $fixed;
    }
    print join '', @chunks;
  }
  
  1;
METHOD_INLINER

$fatpacked{"Module/CPANfile.pm"} = <<'MODULE_CPANFILE';
  package Module::CPANfile;
  use strict;
  use warnings;
  use Cwd;
  use Carp ();
  use Module::CPANfile::Environment ();
  use Module::CPANfile::Result;
  
  our $VERSION = '0.9034';
  
  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 save {
      my($self, $path) = @_;
  
      open my $out, ">", $path or die "$path: $!";
      print {$out} $self->to_string;
  }
  
  sub parse {
      my $self = shift;
  
      my $file = Cwd::abs_path($self->{file});
      $self->{result} = Module::CPANfile::Environment::parse($file) or die $@;
  }
  
  sub from_prereqs {
      my($proto, $prereqs) = @_;
  
      my $self = $proto->new;
      $self->{result} = Module::CPANfile::Result->from_prereqs($prereqs);
  
      $self;
  }
  
  sub features {
      my $self = shift;
      map $self->feature($_), keys %{$self->{result}{features}};
  }
  
  sub feature {
      my($self, $identifier) = @_;
  
      my $data = $self->{result}{features}{$identifier}
        or Carp::croak("Unknown feature '$identifier'");
  
      require CPAN::Meta::Feature;
      CPAN::Meta::Feature->new($data->{identifier}, {
          description => $data->{description},
          prereqs => $data->{spec},
      });
  }
  
  sub prereqs { shift->prereq }
  
  sub prereqs_with {
      my($self, @feature_identifiers) = @_;
  
      my $prereqs = $self->prereqs;
      my @others = map { $self->feature($_)->prereqs } @feature_identifiers;
  
      $prereqs->with_merged_prereqs(\@others);
  }
  
  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};
  }
  
  sub merge_meta {
      my($self, $file, $version) = @_;
  
      require CPAN::Meta;
  
      $version ||= $file =~ /\.yml$/ ? '1.4' : '2';
  
      my $prereq = $self->prereqs;
  
      my $meta = CPAN::Meta->load_file($file);
      my $prereqs_hash = $prereq->with_merged_prereqs($meta->effective_prereqs)->as_string_hash;
      my $struct = { %{$meta->as_struct}, prereqs => $prereqs_hash };
  
      CPAN::Meta->new($struct)->save($file, { version => $version });
  }
  
  sub _dump {
      my $str = shift;
      require Data::Dumper;
      chomp(my $value = Data::Dumper->new([$str])->Terse(1)->Dump);
      $value;
  }
  
  sub to_string {
      my($self, $include_empty) = @_;
  
      my $prereqs = $self->{result}{spec};
  
      my $code = '';
      $code .= $self->_dump_prereqs($self->{result}{spec}, $include_empty);
  
      for my $feature (values %{$self->{result}{features}}) {
          $code .= sprintf "feature %s, %s => sub {\n", _dump($feature->{identifier}), _dump($feature->{description});
          $code .= $self->_dump_prereqs($feature->{spec}, $include_empty, 4);
          $code .= "}\n\n";
      }
  
      $code =~ s/\n+$/\n/s;
      $code;
  }
  
  sub _dump_prereqs {
      my($self, $prereqs, $include_empty, $base_indent) = @_;
  
      my $code = '';
      for my $phase (qw(runtime configure build test develop)) {
          my $indent = $phase eq 'runtime' ? '' : '    ';
          $indent = (' ' x ($base_indent || 0)) . $indent;
  
          my($phase_code, $requirements);
          $phase_code .= "on $phase => sub {\n" unless $phase eq 'runtime';
  
          for my $type (qw(requires recommends suggests conflicts)) {
              for my $mod (sort keys %{$prereqs->{$phase}{$type}}) {
                  my $ver = $prereqs->{$phase}{$type}{$mod};
                  $phase_code .= $ver eq '0'
                               ? "${indent}$type '$mod';\n"
                               : "${indent}$type '$mod', '$ver';\n";
                  $requirements++;
              }
          }
  
          $phase_code .= "\n" unless $requirements;
          $phase_code .= "};\n" unless $phase eq 'runtime';
  
          $code .= $phase_code . "\n" if $requirements or $include_empty;
      }
  
      $code =~ s/\n+$/\n/s;
      $code;
  }
  
  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
  
    my @features = $file->features; # CPAN::Meta::Feature objects
    my $merged_prereqs = $file->prereqs_with(@identifiers); # CPAN::Meta::Prereqs
  
    $file->merge_meta('MYMETA.json');
  
  =head1 DESCRIPTION
  
  Module::CPANfile is a tool to handle L<cpanfile> format to load application
  specific dependencies, not just for CPAN distributions.
  
  =head1 METHODS
  
  =over 4
  
  =item load
  
    $file = Module::CPANfile->load;
    $file = Module::CPANfile->load('cpanfile');
  
  Load and parse a cpanfile. By default it tries to load C<cpanfile> in
  the current directory, unless you pass the path to its argument.
  
  =item from_prereqs
  
    $file = Module::CPANfile->from_prereqs({
      runtime => { requires => { DBI => '1.000' } },
    });
  
  Creates a new Module::CPANfile object from prereqs hash you can get
  via L<CPAN::Meta>'s C<prereqs>, or L<CPAN::Meta::Prereqs>'
  C<as_string_hash>.
  
    # read MYMETA, then feed the prereqs to create Module::CPANfile
    my $meta = CPAN::Meta->load_file('MYMETA.json');
    my $file = Module::CPANfile->from_prereqs($meta->prereqs);
  
    # load cpanfile, then recreate it with round-trip
    my $file = Module::CPANfile->load('cpanfile');
    $file = Module::CPANfile->from_prereqs($file->prereq_specs);
                                      # or $file->prereqs->as_string_hash
  
  =item prereqs
  
  Returns L<CPAN::Meta::Prereqs> object out of the parsed cpanfile.
  
  =item prereq_specs
  
  Returns a hash reference that should be passed to C<< CPAN::Meta::Prereqs->new >>.
  
  =item features
  
  Returns a list of features available in the cpanfile as L<CPAN::Meta::Feature>.
  
  =item prereqs_with(@identifiers)
  
  Retuens L<CPAN::Meta::Prereqs> object, with merged prereqs for
  features identified with the C<@identifiers>.
  
  =item to_string($include_empty)
  
    $file->to_string;
    $file->to_string(1);
  
  Returns a canonical string (code) representation for cpanfile. Useful
  if you want to convert L<CPAN::Meta::Prereqs> to a new cpanfile.
  
    # read MYMETA's prereqs and print cpanfile representation of it
    my $meta = CPAN::Meta->load_file('MYMETA.json');
    my $file = Module::CPANfile->from_prereqs($meta->prereqs);
    print $file->to_sring;
  
  By default, it omits the phase where there're no modules
  registered. If you pass the argument of a true value, it will print
  them as well.
  
  =item save
  
    $file->save('cpanfile');
  
  Saves the currently loaded prereqs as a new C<cpanfile> by calling
  C<to_string>. Beware B<this method will overwrite the existing
  cpanfile without any warning or backup>. Taking a backup or giving
  warnings to users is a caller's responsibility.
  
    # Read MYMETA.json and creates a new cpanfile
    my $meta = CPAN::Meta->load_file('MYMETA.json');
    my $file = Module::CPANfile->from_prereqs($meta->prereqs);
    $file->save('cpanfile');
  
  =item merge_meta
  
    $file->merge_meta('META.yml');
    $file->merge_meta('MYMETA.json', '2.0');
  
  Merge the effective prereqs with Meta specification loaded from the
  given META file, using CPAN::Meta. You can specify the META spec
  version in the second argument, which defaults to 1.4 in case the
  given file is YAML, and 2 if it is JSON.
  
  =back
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa
  
  =head1 SEE ALSO
  
  L<cpanfile>, L<CPAN::Meta>, L<CPAN::Meta::Spec>
  
  =cut
MODULE_CPANFILE

$fatpacked{"Module/CPANfile/Environment.pm"} = <<'MODULE_CPANFILE_ENVIRONMENT';
  package Module::CPANfile::Environment;
  use strict;
  use Module::CPANfile::Result;
  use Carp ();
  
  my @bindings = qw(
      on requires recommends suggests conflicts
      feature
      osname
      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 };
  
  # line 1 "$file"
  $code;
  
  \$_result;
  EVAL
          $err = $@;
      }
  
      if ($err) { die "Parsing $file failed: $err" };
  
      return $res;
  }
  
  1;
  
MODULE_CPANFILE_ENVIRONMENT

$fatpacked{"Module/CPANfile/Result.pm"} = <<'MODULE_CPANFILE_RESULT';
  package Module::CPANfile::Result;
  use strict;
  
  sub from_prereqs {
      my($class, $spec) = @_;
      bless {
          phase => 'runtime',
          spec => $spec,
      }, $class;
  }
  
  sub new {
      bless {
          phase => 'runtime', # default phase
          features => {},
          feature => undef,
          spec  => {},
      }, shift;
  }
  
  sub on {
      my($self, $phase, $code) = @_;
      local $self->{phase} = $phase;
      $code->()
  }
  
  sub feature {
      my($self, $identifier, $description, $code) = @_;
  
      # shortcut: feature identifier => sub { ... }
      if (@_ == 3 && ref($description) eq 'CODE') {
          $code = $description;
          $description = $identifier;
      }
  
      unless (ref $description eq '' && ref $code eq 'CODE') {
          Carp::croak("Usage: feature 'identifier', 'Description' => sub { ... }");
      }
  
      local $self->{feature} = $self->{features}{$identifier}
        = { identifier => $identifier, description => $description, spec => {} };
      $code->();
  }
  
  sub osname { die "TODO" }
  
  sub requires {
      my($self, $module, $requirement) = @_;
      ($self->{feature} ? $self->{feature}{spec} : $self->{spec})
        ->{$self->{phase}}{requires}{$module} = $requirement || 0;
  }
  
  sub recommends {
      my($self, $module, $requirement) = @_;
      ($self->{feature} ? $self->{feature}{spec} : $self->{spec})
        ->{$self->{phase}}{recommends}{$module} = $requirement || 0;
  }
  
  sub suggests {
      my($self, $module, $requirement) = @_;
      ($self->{feature} ? $self->{feature}{spec} : $self->{spec})
        ->{$self->{phase}}{suggests}{$module} = $requirement || 0;
  }
  
  sub conflicts {
      my($self, $module, $requirement) = @_;
      ($self->{feature} ? $self->{feature}{spec} : $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) });
  }
  
  1;
MODULE_CPANFILE_RESULT

$fatpacked{"Module/Reader.pm"} = <<'MODULE_READER';
  package Module::Reader;
  BEGIN { require 5.006 }
  use strict;
  use warnings;
  
  our $VERSION = '0.002000';
  $VERSION = eval $VERSION;
  
  use base 'Exporter';
  our @EXPORT_OK = qw(module_content module_handle);
  our %EXPORT_TAGS = (all => [@EXPORT_OK]);
  
  use File::Spec;
  use Scalar::Util qw(blessed reftype openhandle);
  use Carp;
  use constant _OPEN_STRING => $] >= 5.008;
  BEGIN {
      require IO::String
          if !_OPEN_STRING;
  }
  
  sub module_content {
      my $module = _get_module(@_);
      if (ref $module) {
          local $/;
          return scalar <$module>;
      }
      else {
          return $module;
      }
  }
  
  sub module_handle {
      my $module = _get_module(@_);
      if (ref $module) {
          return $module;
      }
      elsif (_OPEN_STRING) {
          open my $fh, '<', \$module;
          return $fh;
      }
      else {
          return IO::String->new($module);
      }
  }
  
  sub _get_module {
      my ($package, @inc) = @_;
      (my $module = "$package.pm") =~ s{::}{/}g;
      my $opts = ref $_[-1] && ref $_[-1] eq 'HASH' && pop @inc || {};
      if (!@inc) {
          @inc = @INC;
      }
      if (my $found = $opts->{found}) {
          if (my $full_module = $found->{$module}) {
              if (ref $full_module) {
                  @inc = $full_module;
              }
              elsif (-f $full_module) {
                  open my $fh, '<', $full_module
                      or die "Couldn't open ${full_module} for ${module}: $!";
                  return $fh;
              }
          }
      }
      for my $inc (@inc) {
          if (!ref $inc) {
              my $full_module = File::Spec->catfile($inc, $module);
              next unless -f $full_module;
              open my $fh, '<', $full_module
                  or die "Couldn't open ${full_module} for ${module}: $!";
              return $fh;
          }
  
          my @cb = ref $inc eq 'ARRAY'  ? $inc->[0]->($inc, $module)
                 : blessed $inc         ? $inc->INC($module)
                                        : $inc->($inc, $module);
  
          next
              unless ref $cb[0];
          my $fh;
          if (reftype $cb[0] eq 'GLOB' && openhandle $cb[0]) {
              $fh = shift @cb;
          }
  
          if (ref $cb[0] eq 'CODE') {
              my $cb = shift @cb;
              # require docs are wrong, perl sends 0 as the first param
              my @params = (0, @cb ? $cb[0] : ());
  
              my $module = '';
              while (1) {
                  local $_ = $fh ? <$fh> : '';
                  $_ = ''
                      if !defined;
                  last if !$cb->(@params);
                  $module .= $_;
              }
              return $module;
          }
          elsif ($fh) {
              return $fh;
          }
      }
      croak "Can't find module $module";
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Module::Reader - Read the source of a module like perl does
  
  =head1 SYNOPSIS
  
      use Module::Reader qw(:all);
      my $io = module_handle('My::Module');
      my $content = module_content('My::Module');
      
      my $io = module_handle('My::Module', @search_dirs);
      
      my $io = module_handle('My::Module', @search_dirs, { found => \%INC });
  
  =head1 DESCRIPTION
  
  Reads the content of perl modules the same way perl does.  This
  includes reading modules available only by L<@INC hooks|perlfunc/require>, or filtered
  through them.
  
  =head1 EXPORTS
  
  =head2 module_handle( $module_name, @search_dirs, \%options )
  
  Returns an IO handle to the given module.  Searches the directories
  specified, or L<@INC|perlvar/@INC> if none are.
  
  =head3 Options
  
  =over 4
  
  =item found
  
  A hashref like L<%INC|perlvar/%INC> with module file names (in the
  style 'F<My/Module.pm>') as keys and full file paths as values.
  Modules listed in this will be used in preference to searching
  through directories.
  
  =back
  
  =head2 module_content( $module_name, @search_dirs, \%options )
  
  Returns the content of the given module.  Accepts the same options as C<module_handle>.
  
  =head1 AUTHOR
  
  haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
  
  =head2 CONTRIBUTORS
  
  None yet.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2013 the Module::Reader L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
MODULE_READER

$fatpacked{"Module/Runtime.pm"} = <<'MODULE_RUNTIME';
  =head1 NAME
  
  Module::Runtime - runtime module handling
  
  =head1 SYNOPSIS
  
  	use Module::Runtime qw(
  		$module_name_rx is_module_name check_module_name
  		module_notional_filename require_module
  	);
  
  	if($module_name =~ /\A$module_name_rx\z/o) { ...
  	if(is_module_name($module_name)) { ...
  	check_module_name($module_name);
  
  	$notional_filename = module_notional_filename($module_name);
  	require_module($module_name);
  
  	use Module::Runtime qw(use_module use_package_optimistically);
  
  	$bi = use_module("Math::BigInt", 1.31)->new("1_234");
  	$widget = use_package_optimistically("Local::Widget")->new;
  
  	use Module::Runtime qw(
  		$top_module_spec_rx $sub_module_spec_rx
  		is_module_spec check_module_spec
  		compose_module_name
  	);
  
  	if($spec =~ /\A$top_module_spec_rx\z/o) { ...
  	if($spec =~ /\A$sub_module_spec_rx\z/o) { ...
  	if(is_module_spec("Standard::Prefix", $spec)) { ...
  	check_module_spec("Standard::Prefix", $spec);
  
  	$module_name =
  		compose_module_name("Standard::Prefix", $spec);
  
  =head1 DESCRIPTION
  
  The functions exported by this module deal with runtime handling of
  Perl modules, which are normally handled at compile time.  This module
  avoids using any other modules, so that it can be used in low-level
  infrastructure.
  
  The parts of this module that work with module names apply the same
  syntax that is used for barewords in Perl source.  In principle this
  syntax can vary between versions of Perl, and this module applies the
  syntax of the Perl on which it is running.  In practice the usable syntax
  hasn't changed yet, but there's a good chance of it changing in Perl 5.18.
  
  The functions of this module whose purpose is to load modules include
  workarounds for three old Perl core bugs regarding C<require>.  These
  workarounds are applied on any Perl version where the bugs exist, except
  for a case where one of the bugs cannot be adequately worked around in
  pure Perl.
  
  =head2 Module name syntax
  
  The usable module name syntax has not changed from Perl 5.000 up to
  Perl 5.15.7.  The syntax is composed entirely of ASCII characters.
  From Perl 5.6 onwards there has been some attempt to allow the use of
  non-ASCII Unicode characters in Perl source, but it was fundamentally
  broken (like the entirety of Perl 5.6's Unicode handling) and remained
  pretty much entirely unusable until it got some attention in the Perl
  5.15 series.  Although Unicode is now consistently accepted by the
  parser in some places, it remains broken for module names.  Furthermore,
  there has not yet been any work on how to map Unicode module names into
  filenames, so in that respect also Unicode module names are unusable.
  This may finally be addressed in the Perl 5.17 series.
  
  The module name syntax is, precisely: the string must consist of one or
  more segments separated by C<::>; each segment must consist of one or more
  identifier characters (ASCII alphanumerics plus "_"); the first character
  of the string must not be a digit.  Thus "C<IO::File>", "C<warnings>",
  and "C<foo::123::x_0>" are all valid module names, whereas "C<IO::>"
  and "C<1foo::bar>" are not.  C<'> separators are not permitted by this
  module, though they remain usable in Perl source, being translated to
  C<::> in the parser.
  
  =head2 Core bugs worked around
  
  The first bug worked around is core bug [perl #68590], which causes
  lexical state in one file to leak into another that is C<require>d/C<use>d
  from it.  This bug is present from Perl 5.6 up to Perl 5.10, and is
  fixed in Perl 5.11.0.  From Perl 5.9.4 up to Perl 5.10.0 no satisfactory
  workaround is possible in pure Perl.  The workaround means that modules
  loaded via this module don't suffer this pollution of their lexical
  state.  Modules loaded in other ways, or via this module on the Perl
  versions where the pure Perl workaround is impossible, remain vulnerable.
  The module L<Lexical::SealRequireHints> provides a complete workaround
  for this bug.
  
  The second bug worked around causes some kinds of failure in module
  loading, principally compilation errors in the loaded module, to be
  recorded in C<%INC> as if they were successful, so later attempts to load
  the same module immediately indicate success.  This bug is present up
  to Perl 5.8.9, and is fixed in Perl 5.9.0.  The workaround means that a
  compilation error in a module loaded via this module won't be cached as
  a success.  Modules loaded in other ways remain liable to produce bogus
  C<%INC> entries, and if a bogus entry exists then it will mislead this
  module if it is used to re-attempt loading.
  
  The third bug worked around causes the wrong context to be seen at
  file scope of a loaded module, if C<require> is invoked in a location
  that inherits context from a higher scope.  This bug is present up to
  Perl 5.11.2, and is fixed in Perl 5.11.3.  The workaround means that
  a module loaded via this module will always see the correct context.
  Modules loaded in other ways remain vulnerable.
  
  =cut
  
  package Module::Runtime;
  
  # Don't "use 5.006" here, because Perl 5.15.6 will load feature.pm if
  # the version check is done that way.
  BEGIN { require 5.006; }
  # Don't "use warnings" here, to avoid dependencies.  Do standardise the
  # warning status by lexical override; unfortunately the only safe bitset
  # to build in is the empty set, equivalent to "no warnings".
  BEGIN { ${^WARNING_BITS} = ""; }
  # Don't "use strict" here, to avoid dependencies.
  
  our $VERSION = "0.013";
  
  # Don't use Exporter here, to avoid dependencies.
  our @EXPORT_OK = qw(
  	$module_name_rx is_module_name is_valid_module_name check_module_name
  	module_notional_filename require_module
  	use_module use_package_optimistically
  	$top_module_spec_rx $sub_module_spec_rx
  	is_module_spec is_valid_module_spec check_module_spec
  	compose_module_name
  );
  my %export_ok = map { ($_ => undef) } @EXPORT_OK;
  sub import {
  	my $me = shift;
  	my $callpkg = caller(0);
  	my $errs = "";
  	foreach(@_) {
  		if(exists $export_ok{$_}) {
  			# We would need to do "no strict 'refs'" here
  			# if we had enabled strict at file scope.
  			if(/\A\$(.*)\z/s) {
  				*{$callpkg."::".$1} = \$$1;
  			} else {
  				*{$callpkg."::".$_} = \&$_;
  			}
  		} else {
  			$errs .= "\"$_\" is not exported by the $me module\n";
  		}
  	}
  	if($errs ne "") {
  		die "${errs}Can't continue after import errors ".
  			"at @{[(caller(0))[1]]} line @{[(caller(0))[2]]}.\n";
  	}
  }
  
  # Logic duplicated from Params::Classify.  Duplicating it here avoids
  # an extensive and potentially circular dependency graph.
  sub _is_string($) {
  	my($arg) = @_;
  	return defined($arg) && ref(\$arg) eq "SCALAR";
  }
  
  =head1 REGULAR EXPRESSIONS
  
  These regular expressions do not include any anchors, so to check
  whether an entire string matches a syntax item you must supply the
  anchors yourself.
  
  =over
  
  =item $module_name_rx
  
  Matches a valid Perl module name in bareword syntax.
  
  =cut
  
  our $module_name_rx = qr/[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/;
  
  =item $top_module_spec_rx
  
  Matches a module specification for use with L</compose_module_name>,
  where no prefix is being used.
  
  =cut
  
  my $qual_module_spec_rx =
  	qr#(?:/|::)[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#;
  
  my $unqual_top_module_spec_rx =
  	qr#[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#;
  
  our $top_module_spec_rx = qr/$qual_module_spec_rx|$unqual_top_module_spec_rx/o;
  
  =item $sub_module_spec_rx
  
  Matches a module specification for use with L</compose_module_name>,
  where a prefix is being used.
  
  =cut
  
  my $unqual_sub_module_spec_rx = qr#[0-9A-Z_a-z]+(?:(?:/|::)[0-9A-Z_a-z]+)*#;
  
  our $sub_module_spec_rx = qr/$qual_module_spec_rx|$unqual_sub_module_spec_rx/o;
  
  =back
  
  =head1 FUNCTIONS
  
  =head2 Basic module handling
  
  =over
  
  =item is_module_name(ARG)
  
  Returns a truth value indicating whether I<ARG> is a plain string
  satisfying Perl module name syntax as described for L</$module_name_rx>.
  
  =cut
  
  sub is_module_name($) { _is_string($_[0]) && $_[0] =~ /\A$module_name_rx\z/o }
  
  =item is_valid_module_name(ARG)
  
  Deprecated alias for L</is_module_name>.
  
  =cut
  
  *is_valid_module_name = \&is_module_name;
  
  =item check_module_name(ARG)
  
  Check whether I<ARG> is a plain string
  satisfying Perl module name syntax as described for L</$module_name_rx>.
  Return normally if it is, or C<die> if it is not.
  
  =cut
  
  sub check_module_name($) {
  	unless(&is_module_name) {
  		die +(_is_string($_[0]) ? "`$_[0]'" : "argument").
  			" is not a module name\n";
  	}
  }
  
  =item module_notional_filename(NAME)
  
  Generates a notional relative filename for a module, which is used in
  some Perl core interfaces.
  The I<NAME> is a string, which should be a valid module name (one or
  more C<::>-separated segments).  If it is not a valid name, the function
  C<die>s.
  
  The notional filename for the named module is generated and returned.
  This filename is always in Unix style, with C</> directory separators
  and a C<.pm> suffix.  This kind of filename can be used as an argument to
  C<require>, and is the key that appears in C<%INC> to identify a module,
  regardless of actual local filename syntax.
  
  =cut
  
  sub module_notional_filename($) {
  	&check_module_name;
  	my($name) = @_;
  	$name =~ s!::!/!g;
  	return $name.".pm";
  }
  
  =item require_module(NAME)
  
  This is essentially the bareword form of C<require>, in runtime form.
  The I<NAME> is a string, which should be a valid module name (one or
  more C<::>-separated segments).  If it is not a valid name, the function
  C<die>s.
  
  The module specified by I<NAME> is loaded, if it hasn't been already,
  in the manner of the bareword form of C<require>.  That means that a
  search through C<@INC> is performed, and a byte-compiled form of the
  module will be used if available.
  
  The return value is as for C<require>.  That is, it is the value returned
  by the module itself if the module is loaded anew, or C<1> if the module
  was already loaded.
  
  =cut
  
  # Don't "use constant" here, to avoid dependencies.
  BEGIN {
  	*_WORK_AROUND_HINT_LEAKAGE =
  		"$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001)
  			? sub(){1} : sub(){0};
  	*_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0};
  }
  
  BEGIN { if(_WORK_AROUND_BROKEN_MODULE_STATE) { eval q{
  	sub Module::Runtime::__GUARD__::DESTROY {
  		delete $INC{$_[0]->[0]} if @{$_[0]};
  	}
  	1;
  }; die $@ if $@ ne ""; } }
  
  sub require_module($) {
  	# Localise %^H to work around [perl #68590], where the bug exists
  	# and this is a satisfactory workaround.  The bug consists of
  	# %^H state leaking into each required module, polluting the
  	# module's lexical state.
  	local %^H if _WORK_AROUND_HINT_LEAKAGE;
  	if(_WORK_AROUND_BROKEN_MODULE_STATE) {
  		my $notional_filename = &module_notional_filename;
  		my $guard = bless([ $notional_filename ],
  				"Module::Runtime::__GUARD__");
  		my $result = require($notional_filename);
  		pop @$guard;
  		return $result;
  	} else {
  		return scalar(require(&module_notional_filename));
  	}
  }
  
  =back
  
  =head2 Structured module use
  
  =over
  
  =item use_module(NAME[, VERSION])
  
  This is essentially C<use> in runtime form, but without the importing
  feature (which is fundamentally a compile-time thing).  The I<NAME> is
  handled just like in C<require_module> above: it must be a module name,
  and the named module is loaded as if by the bareword form of C<require>.
  
  If a I<VERSION> is specified, the C<VERSION> method of the loaded module is
  called with the specified I<VERSION> as an argument.  This normally serves to
  ensure that the version loaded is at least the version required.  This is
  the same functionality provided by the I<VERSION> parameter of C<use>.
  
  On success, the name of the module is returned.  This is unlike
  L</require_module>, and is done so that the entire call to L</use_module>
  can be used as a class name to call a constructor, as in the example in
  the synopsis.
  
  =cut
  
  sub use_module($;$) {
  	my($name, $version) = @_;
  	require_module($name);
  	if(defined $version) {
  		$name->VERSION($version);
  	}
  	return $name;
  }
  
  =item use_package_optimistically(NAME[, VERSION])
  
  This is an analogue of L</use_module> for the situation where there is
  uncertainty as to whether a package/class is defined in its own module
  or by some other means.  It attempts to arrange for the named package to
  be available, either by loading a module or by doing nothing and hoping.
  
  An attempt is made to load the named module (as if by the bareword form
  of C<require>).  If the module cannot be found then it is assumed that
  the package was actually already loaded by other means, and no error
  is signalled.  That's the optimistic bit.
  
  This is mostly the same operation that is performed by the L<base> pragma
  to ensure that the specified base classes are available.  The behaviour
  of L<base> was simplified in version 2.18, and this function changed
  to match.
  
  If a I<VERSION> is specified, the C<VERSION> method of the loaded package is
  called with the specified I<VERSION> as an argument.  This normally serves
  to ensure that the version loaded is at least the version required.
  On success, the name of the package is returned.  These aspects of the
  function work just like L</use_module>.
  
  =cut
  
  sub use_package_optimistically($;$) {
  	my($name, $version) = @_;
  	check_module_name($name);
  	eval { local $SIG{__DIE__}; require_module($name); };
  	die $@ if $@ ne "" &&
  		$@ !~ /\ACan't locate .+ at \Q@{[__FILE__]}\E line/s;
  	$name->VERSION($version) if defined $version;
  	return $name;
  }
  
  =back
  
  =head2 Module name composition
  
  =over
  
  =item is_module_spec(PREFIX, SPEC)
  
  Returns a truth value indicating
  whether I<SPEC> is valid input for L</compose_module_name>.
  See below for what that entails.  Whether a I<PREFIX> is supplied affects
  the validity of I<SPEC>, but the exact value of the prefix is unimportant,
  so this function treats I<PREFIX> as a truth value.
  
  =cut
  
  sub is_module_spec($$) {
  	my($prefix, $spec) = @_;
  	return _is_string($spec) &&
  		$spec =~ ($prefix ? qr/\A$sub_module_spec_rx\z/o :
  				    qr/\A$top_module_spec_rx\z/o);
  }
  
  =item is_valid_module_spec(PREFIX, SPEC)
  
  Deprecated alias for L</is_module_spec>.
  
  =cut
  
  *is_valid_module_spec = \&is_module_spec;
  
  =item check_module_spec(PREFIX, SPEC)
  
  Check whether I<SPEC> is valid input for L</compose_module_name>.
  Return normally if it is, or C<die> if it is not.
  
  =cut
  
  sub check_module_spec($$) {
  	unless(&is_module_spec) {
  		die +(_is_string($_[1]) ? "`$_[1]'" : "argument").
  			" is not a module specification\n";
  	}
  }
  
  =item compose_module_name(PREFIX, SPEC)
  
  This function is intended to make it more convenient for a user to specify
  a Perl module name at runtime.  Users have greater need for abbreviations
  and context-sensitivity than programmers, and Perl module names get a
  little unwieldy.  I<SPEC> is what the user specifies, and this function
  translates it into a module name in standard form, which it returns.
  
  I<SPEC> has syntax approximately that of a standard module name: it
  should consist of one or more name segments, each of which consists
  of one or more identifier characters.  However, C</> is permitted as a
  separator, in addition to the standard C<::>.  The two separators are
  entirely interchangeable.
  
  Additionally, if I<PREFIX> is not C<undef> then it must be a module
  name in standard form, and it is prefixed to the user-specified name.
  The user can inhibit the prefix addition by starting I<SPEC> with a
  separator (either C</> or C<::>).
  
  =cut
  
  sub compose_module_name($$) {
  	my($prefix, $spec) = @_;
  	check_module_name($prefix) if defined $prefix;
  	&check_module_spec;
  	if($spec =~ s#\A(?:/|::)##) {
  		# OK
  	} else {
  		$spec = $prefix."::".$spec if defined $prefix;
  	}
  	$spec =~ s#/#::#g;
  	return $spec;
  }
  
  =back
  
  =head1 SEE ALSO
  
  L<Lexical::SealRequireHints>,
  L<base>,
  L<perlfunc/require>,
  L<perlfunc/use>
  
  =head1 AUTHOR
  
  Andrew Main (Zefram) <zefram@fysh.org>
  
  =head1 COPYRIGHT
  
  Copyright (C) 2004, 2006, 2007, 2009, 2010, 2011, 2012
  Andrew Main (Zefram) <zefram@fysh.org>
  
  =head1 LICENSE
  
  This module is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
  
  =cut
  
  1;
MODULE_RUNTIME

$fatpacked{"Moo.pm"} = <<'MOO';
  package Moo;
  
  use strictures 1;
  use Moo::_Utils;
  use B 'perlstring';
  use Sub::Defer ();
  
  our $VERSION = '1.002000'; # 1.2.0
  $VERSION = eval $VERSION;
  
  require Moo::sification;
  
  our %MAKERS;
  
  sub _install_tracked {
    my ($target, $name, $code) = @_;
    $MAKERS{$target}{exports}{$name} = $code;
    _install_coderef "${target}::${name}" => "Moo::${name}" => $code;
  }
  
  sub import {
    my $target = caller;
    my $class = shift;
    strictures->import;
    if ($Moo::Role::INFO{$target} and $Moo::Role::INFO{$target}{is_role}) {
      die "Cannot import Moo into a role";
    }
    $MAKERS{$target} ||= {};
    _install_tracked $target => extends => sub {
      $class->_set_superclasses($target, @_);
      $class->_maybe_reset_handlemoose($target);
      return;
    };
    _install_tracked $target => with => sub {
      require Moo::Role;
      Moo::Role->apply_roles_to_package($target, @_);
      $class->_maybe_reset_handlemoose($target);
    };
    _install_tracked $target => has => sub {
      my ($name_proto, %spec) = @_;
      my $name_isref = ref $name_proto eq 'ARRAY';
      foreach my $name ($name_isref ? @$name_proto : $name_proto) {
        # Note that when $name_proto is an arrayref, each attribute
        # needs a separate \%specs hashref
        my $spec_ref = $name_isref ? +{%spec} : \%spec;
        $class->_constructor_maker_for($target)
              ->register_attribute_specs($name, $spec_ref);
        $class->_accessor_maker_for($target)
              ->generate_method($target, $name, $spec_ref);
        $class->_maybe_reset_handlemoose($target);
      }
      return;
    };
    foreach my $type (qw(before after around)) {
      _install_tracked $target => $type => sub {
        require Class::Method::Modifiers;
        _install_modifier($target, $type, @_);
        return;
      };
    }
    return if $MAKERS{$target}{is_class}; # already exported into this package
    $MAKERS{$target}{is_class} = 1;
    {
      no strict 'refs';
      @{"${target}::ISA"} = do {
        require Moo::Object; ('Moo::Object');
      } unless @{"${target}::ISA"};
    }
    if ($INC{'Moo/HandleMoose.pm'}) {
      Moo::HandleMoose::inject_fake_metaclass_for($target);
    }
  }
  
  sub unimport {
    my $target = caller;
    _unimport_coderefs($target, $MAKERS{$target});
  }
  
  sub _set_superclasses {
    my $class = shift;
    my $target = shift;
    foreach my $superclass (@_) {
      _load_module($superclass);
      if ($INC{"Role/Tiny.pm"} && $Role::Tiny::INFO{$superclass}) {
        require Carp;
        Carp::croak("Can't extend role '$superclass'");
      }
    }
    # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA
    @{*{_getglob("${target}::ISA")}{ARRAY}} = @_;
    if (my $old = delete $Moo::MAKERS{$target}{constructor}) {
      delete _getstash($target)->{new};
      Moo->_constructor_maker_for($target)
         ->register_attribute_specs(%{$old->all_attribute_specs});
    }
    no warnings 'once'; # piss off. -- mst
    $Moo::HandleMoose::MOUSE{$target} = [
      grep defined, map Mouse::Util::find_meta($_), @_
    ] if Mouse::Util->can('find_meta');
  }
  
  sub _maybe_reset_handlemoose {
    my ($class, $target) = @_;
    if ($INC{"Moo/HandleMoose.pm"}) {
      Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
    }
  }
  
  sub _accessor_maker_for {
    my ($class, $target) = @_;
    return unless $MAKERS{$target};
    $MAKERS{$target}{accessor} ||= do {
      my $maker_class = do {
        if (my $m = do {
              if (my $defer_target = 
                    (Sub::Defer::defer_info($target->can('new'))||[])->[0]
                ) {
                my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
                $MAKERS{$pkg} && $MAKERS{$pkg}{accessor};
              } else {
                undef;
              }
            }) {
          ref($m);
        } else {
          require Method::Generate::Accessor;
          'Method::Generate::Accessor'
        }
      };
      $maker_class->new;
    }
  }
  
  sub _constructor_maker_for {
    my ($class, $target, $select_super) = @_;
    return unless $MAKERS{$target};
    $MAKERS{$target}{constructor} ||= do {
      require Method::Generate::Constructor;
      require Sub::Defer;
      my ($moo_constructor, $con);
  
      if ($select_super && $MAKERS{$select_super}) {
        $moo_constructor = 1;
        $con = $MAKERS{$select_super}{constructor};
      } else {
        my $t_new = $target->can('new');
        if ($t_new) {
          if ($t_new == Moo::Object->can('new')) {
            $moo_constructor = 1;
          } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) {
            my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
            if ($MAKERS{$pkg}) {
              $moo_constructor = 1;
              $con = $MAKERS{$pkg}{constructor};
            }
          }
        } else {
          $moo_constructor = 1; # no other constructor, make a Moo one
        }
      };
      ($con ? ref($con) : 'Method::Generate::Constructor')
        ->new(
          package => $target,
          accessor_generator => $class->_accessor_maker_for($target),
          construction_string => (
            $moo_constructor
              ? ($con ? $con->construction_string : undef)
              : ('$class->'.$target.'::SUPER::new($class->can(q[FOREIGNBUILDARGS]) ? $class->FOREIGNBUILDARGS(@_) : @_)')
          ),
          subconstructor_handler => (
            '      if ($Moo::MAKERS{$class}) {'."\n"
            .'        '.$class.'->_constructor_maker_for($class,'.perlstring($target).');'."\n"
            .'        return $class->new(@_)'.";\n"
            .'      } elsif ($INC{"Moose.pm"} and my $meta = Class::MOP::get_metaclass_by_name($class)) {'."\n"
            .'        return $meta->new_object($class->BUILDARGS(@_));'."\n"
            .'      }'."\n"
          ),
        )
        ->install_delayed
        ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}})
    }
  }
  
  1;
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  Moo - Minimalist Object Orientation (with Moose compatibility)
  
  =head1 SYNOPSIS
  
   package Cat::Food;
  
   use Moo;
  
   sub feed_lion {
     my $self = shift;
     my $amount = shift || 1;
  
     $self->pounds( $self->pounds - $amount );
   }
  
   has taste => (
     is => 'ro',
   );
  
   has brand => (
     is  => 'ro',
     isa => sub {
       die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ'
     },
   );
  
   has pounds => (
     is  => 'rw',
     isa => sub { die "$_[0] is too much cat food!" unless $_[0] < 15 },
   );
  
   1;
  
  And elsewhere:
  
   my $full = Cat::Food->new(
      taste  => 'DELICIOUS.',
      brand  => 'SWEET-TREATZ',
      pounds => 10,
   );
  
   $full->feed_lion;
  
   say $full->pounds;
  
  =head1 DESCRIPTION
  
  This module is an extremely light-weight subset of L<Moose> optimised for
  rapid startup and "pay only for what you use".
  
  It also avoids depending on any XS modules to allow simple deployments.  The
  name C<Moo> is based on the idea that it provides almost -- but not quite -- two
  thirds of L<Moose>.
  
  Unlike L<Mouse> this module does not aim at full compatibility with
  L<Moose>'s surface syntax, preferring instead of provide full interoperability
  via the metaclass inflation capabilities described in L</MOO AND MOOSE>.
  
  For a full list of the minor differences between L<Moose> and L<Moo>'s surface
  syntax, see L</INCOMPATIBILITIES WITH MOOSE>.
  
  =head1 WHY MOO EXISTS
  
  If you want a full object system with a rich Metaprotocol, L<Moose> is
  already wonderful.
  
  However, sometimes you're writing a command line script or a CGI script
  where fast startup is essential, or code designed to be deployed as a single
  file via L<App::FatPacker>, or you're writing a CPAN module and you want it
  to be usable by people with those constraints.
  
  I've tried several times to use L<Mouse> but it's 3x the size of Moo and
  takes longer to load than most of my Moo based CGI scripts take to run.
  
  If you don't want L<Moose>, you don't want "less metaprotocol" like L<Mouse>,
  you want "as little as possible" -- which means "no metaprotocol", which is
  what Moo provides.
  
  Better still, if you install and load L<Moose>, we set up metaclasses for your
  L<Moo> classes and L<Moo::Role> roles, so you can use them in L<Moose> code
  without ever noticing that some of your codebase is using L<Moo>.
  
  Hence, Moo exists as its name -- Minimal Object Orientation -- with a pledge
  to make it smooth to upgrade to L<Moose> when you need more than minimal
  features.
  
  =head1 MOO AND MOOSE
  
  If L<Moo> detects L<Moose> being loaded, it will automatically register
  metaclasses for your L<Moo> and L<Moo::Role> packages, so you should be able
  to use them in L<Moose> code without anybody ever noticing you aren't using
  L<Moose> everywhere.
  
  L<Moo> will also create L<Moose type constraints|Moose::Manual::Types> for
  classes and roles, so that C<< isa => 'MyClass' >> and C<< isa => 'MyRole' >>
  work the same as for L<Moose> classes and roles.
  
  Extending a L<Moose> class or consuming a L<Moose::Role> will also work.
  
  So will extending a L<Mouse> class or consuming a L<Mouse::Role> - but note
  that we don't provide L<Mouse> metaclasses or metaroles so the other way
  around doesn't work. This feature exists for L<Any::Moose> users porting to
  L<Moo>; enabling L<Mouse> users to use L<Moo> classes is not a priority for us.
  
  This means that there is no need for anything like L<Any::Moose> for Moo
  code - Moo and Moose code should simply interoperate without problem. To
  handle L<Mouse> code, you'll likely need an empty Moo role or class consuming
  or extending the L<Mouse> stuff since it doesn't register true L<Moose>
  metaclasses like L<Moo> does.
  
  If you want types to be upgraded to the L<Moose> types, use
  L<MooX::Types::MooseLike> and install the L<MooseX::Types> library to
  match the L<MooX::Types::MooseLike> library you're using - L<Moo> will
  load the L<MooseX::Types> library and use that type for the newly created
  metaclass.
  
  If you need to disable the metaclass creation, add:
  
    no Moo::sification;
  
  to your code before Moose is loaded, but bear in mind that this switch is
  currently global and turns the mechanism off entirely so don't put this
  in library code.
  
  =head1 MOO VERSUS ANY::MOOSE
  
  L<Any::Moose> will load L<Mouse> normally, and L<Moose> in a program using
  L<Moose> - which theoretically allows you to get the startup time of L<Mouse>
  without disadvantaging L<Moose> users.
  
  Sadly, this doesn't entirely work, since the selection is load order dependent
  - L<Moo>'s metaclass inflation system explained above in L</MOO AND MOOSE> is
  significantly more reliable.
  
  So if you want to write a CPAN module that loads fast or has only pure perl
  dependencies but is also fully usable by L<Moose> users, you should be using
  L<Moo>.
  
  For a full explanation, see the article
  L<http://shadow.cat/blog/matt-s-trout/moo-versus-any-moose> which explains
  the differing strategies in more detail and provides a direct example of
  where L<Moo> succeeds and L<Any::Moose> fails.
  
  =head1 IMPORTED METHODS
  
  =head2 new
  
   Foo::Bar->new( attr1 => 3 );
  
  or
  
   Foo::Bar->new({ attr1 => 3 });
  
  =head2 BUILDARGS
  
   sub BUILDARGS {
     my ( $class, @args ) = @_;
  
     unshift @args, "attr1" if @args % 2 == 1;
  
     return { @args };
   };
  
   Foo::Bar->new( 3 );
  
  The default implementation of this method accepts a hash or hash reference of
  named parameters. If it receives a single argument that isn't a hash reference
  it throws an error.
  
  You can override this method in your class to handle other types of options
  passed to the constructor.
  
  This method should always return a hash reference of named options.
  
  =head2 FOREIGNBUILDARGS
  
  If you are inheriting from a non-Moo class, the arguments passed to the parent
  class constructor can be manipulated by defining a C<FOREIGNBUILDARGS> method.
  It will recieve the same arguments as C<BUILDARGS>, and should return a list
  of arguments to pass to the parent class constructor.
  
  =head2 BUILD
  
  Define a C<BUILD> method on your class and the constructor will automatically
  call the C<BUILD> method from parent down to child after the object has
  been instantiated.  Typically this is used for object validation or possibly
  logging.
  
  =head2 DEMOLISH
  
  If you have a C<DEMOLISH> method anywhere in your inheritance hierarchy,
  a C<DESTROY> method is created on first object construction which will call
  C<< $instance->DEMOLISH($in_global_destruction) >> for each C<DEMOLISH>
  method from child upwards to parents.
  
  Note that the C<DESTROY> method is created on first construction of an object
  of your class in order to not add overhead to classes without C<DEMOLISH>
  methods; this may prove slightly surprising if you try and define your own.
  
  =head2 does
  
   if ($foo->does('Some::Role1')) {
     ...
   }
  
  Returns true if the object composes in the passed role.
  
  =head1 IMPORTED SUBROUTINES
  
  =head2 extends
  
   extends 'Parent::Class';
  
  Declares base class. Multiple superclasses can be passed for multiple
  inheritance (but please use roles instead).
  
  Calling extends more than once will REPLACE your superclasses, not add to
  them like 'use base' would.
  
  =head2 with
  
   with 'Some::Role1';
  
  or
  
   with 'Some::Role1', 'Some::Role2';
  
  Composes one or more L<Moo::Role> (or L<Role::Tiny>) roles into the current
  class.  An error will be raised if these roles have conflicting methods.
  
  =head2 has
  
   has attr => (
     is => 'ro',
   );
  
  Declares an attribute for the class.
  
   package Foo;
   use Moo;
   has 'attr' => (
     is => 'ro'
   );
  
   package Bar;
   use Moo;
   extends 'Foo';
   has '+attr' => (
     default => sub { "blah" },
   );
  
  Using the C<+> notation, it's possible to override an attribute.
  
  The options for C<has> are as follows:
  
  =over 2
  
  =item * is
  
  B<required>, may be C<ro>, C<lazy>, C<rwp> or C<rw>.
  
  C<ro> generates an accessor that dies if you attempt to write to it - i.e.
  a getter only - by defaulting C<reader> to the name of the attribute.
  
  C<lazy> generates a reader like C<ro>, but also sets C<lazy> to 1 and
  C<builder> to C<_build_${attribute_name}> to allow on-demand generated
  attributes.  This feature was my attempt to fix my incompetence when
  originally designing C<lazy_build>, and is also implemented by
  L<MooseX::AttributeShortcuts>. There is, however, nothing to stop you
  using C<lazy> and C<builder> yourself with C<rwp> or C<rw> - it's just that
  this isn't generally a good idea so we don't provide a shortcut for it.
  
  C<rwp> generates a reader like C<ro>, but also sets C<writer> to
  C<_set_${attribute_name}> for attributes that are designed to be written
  from inside of the class, but read-only from outside.
  This feature comes from L<MooseX::AttributeShortcuts>.
  
  C<rw> generates a normal getter/setter by defaulting C<accessor> to the
  name of the attribute.
  
  =item * isa
  
  Takes a coderef which is meant to validate the attribute.  Unlike L<Moose>, Moo
  does not include a basic type system, so instead of doing C<< isa => 'Num' >>,
  one should do
  
   isa => sub {
     die "$_[0] is not a number!" unless looks_like_number $_[0]
   },
  
  Note that the return value is ignored, only whether the sub lives or
  dies matters.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  Since L<Moo> does B<not> run the C<isa> check before C<coerce> if a coercion
  subroutine has been supplied, C<isa> checks are not structural to your code
  and can, if desired, be omitted on non-debug builds (although if this results
  in an uncaught bug causing your program to break, the L<Moo> authors guarantee
  nothing except that you get to keep both halves).
  
  If you want L<MooseX::Types> style named types, look at
  L<MooX::Types::MooseLike>.
  
  To cause your C<isa> entries to be automatically mapped to named
  L<Moose::Meta::TypeConstraint> objects (rather than the default behaviour
  of creating an anonymous type), set:
  
    $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub {
      require MooseX::Types::Something;
      return MooseX::Types::Something::TypeName();
    };
  
  Note that this example is purely illustrative; anything that returns a
  L<Moose::Meta::TypeConstraint> object or something similar enough to it to
  make L<Moose> happy is fine.
  
  =item * coerce
  
  Takes a coderef which is meant to coerce the attribute.  The basic idea is to
  do something like the following:
  
   coerce => sub {
     $_[0] + 1 unless $_[0] % 2
   },
  
  Note that L<Moo> will always fire your coercion: this is to permit
  C<isa> entries to be used purely for bug trapping, whereas coercions are
  always structural to your code. We do, however, apply any supplied C<isa>
  check after the coercion has run to ensure that it returned a valid value.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  =item * handles
  
  Takes a string
  
    handles => 'RobotRole'
  
  Where C<RobotRole> is a role (L<Moo::Role>) that defines an interface which
  becomes the list of methods to handle.
  
  Takes a list of methods
  
   handles => [ qw( one two ) ]
  
  Takes a hashref
  
   handles => {
     un => 'one',
   }
  
  =item * C<trigger>
  
  Takes a coderef which will get called any time the attribute is set. This
  includes the constructor, but not default or built values. Coderef will be
  invoked against the object with the new value as an argument.
  
  If you set this to just C<1>, it generates a trigger which calls the
  C<_trigger_${attr_name}> method on C<$self>. This feature comes from
  L<MooseX::AttributeShortcuts>.
  
  Note that Moose also passes the old value, if any; this feature is not yet
  supported.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  =item * C<default>
  
  Takes a coderef which will get called with $self as its only argument
  to populate an attribute if no value is supplied to the constructor - or
  if the attribute is lazy, when the attribute is first retrieved if no
  value has yet been provided.
  
  If a simple scalar is provided, it will be inlined as a string. Any non-code
  reference (hash, array) will result in an error - for that case instead use
  a code reference that returns the desired value.
  
  Note that if your default is fired during new() there is no guarantee that
  other attributes have been populated yet so you should not rely on their
  existence.
  
  L<Sub::Quote aware|/SUB QUOTE AWARE>
  
  =item * C<predicate>
  
  Takes a method name which will return true if an attribute has a value.
  
  If you set this to just C<1>, the predicate is automatically named
  C<has_${attr_name}> if your attribute's name does not start with an
  underscore, or C<_has_${attr_name_without_the_underscore}> if it does.
  This feature comes from L<MooseX::AttributeShortcuts>.
  
  =item * C<builder>
  
  Takes a method name which will be called to create the attribute - functions
  exactly like default except that instead of calling
  
    $default->($self);
  
  Moo will call
  
    $self->$builder;
  
  The following features come from L<MooseX::AttributeShortcuts>:
  
  If you set this to just C<1>, the builder is automatically named
  C<_build_${attr_name}>.
  
  If you set this to a coderef or code-convertible object, that variable will be
  installed under C<$class::_build_${attr_name}> and the builder set to the same
  name.
  
  =item * C<clearer>
  
  Takes a method name which will clear the attribute.
  
  If you set this to just C<1>, the clearer is automatically named
  C<clear_${attr_name}> if your attribute's name does not start with an
  underscore, or <_clear_${attr_name_without_the_underscore}> if it does.
  This feature comes from L<MooseX::AttributeShortcuts>.
  
  =item * C<lazy>
  
  B<Boolean>.  Set this if you want values for the attribute to be grabbed
  lazily.  This is usually a good idea if you have a L</builder> which requires
  another attribute to be set.
  
  =item * C<required>
  
  B<Boolean>.  Set this if the attribute must be passed on instantiation.
  
  =item * C<reader>
  
  The value of this attribute will be the name of the method to get the value of
  the attribute.  If you like Java style methods, you might set this to
  C<get_foo>
  
  =item * C<writer>
  
  The value of this attribute will be the name of the method to set the value of
  the attribute.  If you like Java style methods, you might set this to
  C<set_foo>.
  
  =item * C<weak_ref>
  
  B<Boolean>.  Set this if you want the reference that the attribute contains to
  be weakened; use this when circular references are possible, which will cause
  leaks.
  
  =item * C<init_arg>
  
  Takes the name of the key to look for at instantiation time of the object.  A
  common use of this is to make an underscored attribute have a non-underscored
  initialization name. C<undef> means that passing the value in on instantiation
  is ignored.
  
  =item * C<moosify>
  
  Takes either a coderef or array of coderefs which is meant to transform the
  given attributes specifications if necessary when upgrading to a Moose role or
  class. You shouldn't need this by default, but is provided as a means of
  possible extensibility.
  
  =back
  
  =head2 before
  
   before foo => sub { ... };
  
  See L<< Class::Method::Modifiers/before method(s) => sub { ... } >> for full
  documentation.
  
  =head2 around
  
   around foo => sub { ... };
  
  See L<< Class::Method::Modifiers/around method(s) => sub { ... } >> for full
  documentation.
  
  =head2 after
  
   after foo => sub { ... };
  
  See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full
  documentation.
  
  =head1 SUB QUOTE AWARE
  
  L<Sub::Quote/quote_sub> allows us to create coderefs that are "inlineable,"
  giving us a handy, XS-free speed boost.  Any option that is L<Sub::Quote>
  aware can take advantage of this.
  
  To do this, you can write
  
    use Moo;
    use Sub::Quote;
  
    has foo => (
      is => 'ro',
      isa => quote_sub(q{ die "Not <3" unless $_[0] < 3 })
    );
  
  which will be inlined as
  
    do {
      local @_ = ($_[0]->{foo});
      die "Not <3" unless $_[0] < 3;
    }
  
  or to avoid localizing @_,
  
    has foo => (
      is => 'ro',
      isa => quote_sub(q{ my ($val) = @_; die "Not <3" unless $val < 3 })
    );
  
  which will be inlined as
  
    do {
      my ($val) = ($_[0]->{foo});
      die "Not <3" unless $val < 3;
    }
  
  See L<Sub::Quote> for more information, including how to pass lexical
  captures that will also be compiled into the subroutine.
  
  =head1 INCOMPATIBILITIES WITH MOOSE
  
  There is no built-in type system.  C<isa> is verified with a coderef; if you
  need complex types, just make a library of coderefs, or better yet, functions
  that return quoted subs. L<MooX::Types::MooseLike> provides a similar API
  to L<MooseX::Types::Moose> so that you can write
  
    has days_to_live => (is => 'ro', isa => Int);
  
  and have it work with both; it is hoped that providing only subrefs as an
  API will encourage the use of other type systems as well, since it's
  probably the weakest part of Moose design-wise.
  
  C<initializer> is not supported in core since the author considers it to be a
  bad idea and Moose best practices recommend avoiding it. Meanwhile C<trigger> or
  C<coerce> are more likely to be able to fulfill your needs.
  
  There is no meta object.  If you need this level of complexity you wanted
  L<Moose> - Moo succeeds at being small because it explicitly does not
  provide a metaprotocol. However, if you load L<Moose>, then
  
    Class::MOP::class_of($moo_class_or_role)
  
  will return an appropriate metaclass pre-populated by L<Moo>.
  
  No support for C<super>, C<override>, C<inner>, or C<augment> - the author
  considers augment to be a bad idea, and override can be translated:
  
    override foo => sub {
      ...
      super();
      ...
    };
  
    around foo => sub {
      my ($orig, $self) = (shift, shift);
      ...
      $self->$orig(@_);
      ...
    };
  
  The C<dump> method is not provided by default. The author suggests loading
  L<Devel::Dwarn> into C<main::> (via C<perl -MDevel::Dwarn ...> for example) and
  using C<$obj-E<gt>$::Dwarn()> instead.
  
  L</default> only supports coderefs and plain scalars, because passing a hash
  or array reference as a default is almost always incorrect since the value is
  then shared between all objects using that default.
  
  C<lazy_build> is not supported; you are instead encouraged to use the
  C<< is => 'lazy' >> option supported by L<Moo> and L<MooseX::AttributeShortcuts>.
  
  C<auto_deref> is not supported since the author considers it a bad idea and
  it has been considered best practice to avoid it for some time.
  
  C<documentation> will show up in a L<Moose> metaclass created from your class
  but is otherwise ignored. Then again, L<Moose> ignores it as well, so this
  is arguably not an incompatibility.
  
  Since C<coerce> does not require C<isa> to be defined but L<Moose> does
  require it, the metaclass inflation for coerce alone is a trifle insane
  and if you attempt to subtype the result will almost certainly break.
  
  Handling of warnings: when you C<use Moo> we enable FATAL warnings.  The nearest
  similar invocation for L<Moose> would be:
  
    use Moose;
    use warnings FATAL => "all";
  
  Additionally, L<Moo> supports a set of attribute option shortcuts intended to
  reduce common boilerplate.  The set of shortcuts is the same as in the L<Moose>
  module L<MooseX::AttributeShortcuts> as of its version 0.009+.  So if you:
  
      package MyClass;
      use Moo;
  
  The nearest L<Moose> invocation would be:
  
      package MyClass;
  
      use Moose;
      use warnings FATAL => "all";
      use MooseX::AttributeShortcuts;
  
  or, if you're inheriting from a non-Moose class,
  
      package MyClass;
  
      use Moose;
      use MooseX::NonMoose;
      use warnings FATAL => "all";
      use MooseX::AttributeShortcuts;
  
  Finally, Moose requires you to call
  
      __PACKAGE__->meta->make_immutable;
  
  at the end of your class to get an inlined (i.e. not horribly slow)
  constructor. Moo does it automatically the first time ->new is called
  on your class. (C<make_immutable> is a no-op in Moo to ease migration.)
  
  An extension L<MooX::late> exists to ease translating Moose packages
  to Moo by providing a more Moose-like interface.
  
  =head1 SUPPORT
  
  Users' IRC: #moose on irc.perl.org
  
  =for html <a href="http://chat.mibbit.com/#moose@irc.perl.org">(click for instant chatroom login)</a>
  
  Development and contribution IRC: #web-simple on irc.perl.org
  
  =for html <a href="http://chat.mibbit.com/#web-simple@irc.perl.org">(click for instant chatroom login)</a>
  
  Bugtracker: L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Moo>
  
  Git repository: L<git://git.shadowcat.co.uk/gitmo/Moo.git>
  
  Git web access: L<http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Moo.git>
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
  
  frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
  
  hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
  
  jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
  
  ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
  
  chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
  
  ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
  
  doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
  
  perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
  
  Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
  
  ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
  
  tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
  
  haarg - Graham Knop (cpan:HAARG) <haarg@cpan.org>
  
  mattp - Matt Phillips (cpan:MATTP) <mattp@cpan.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010-2011 the Moo L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself. See L<http://dev.perl.org/licenses/>.
  
  =cut
MOO

$fatpacked{"Moo/HandleMoose.pm"} = <<'MOO_HANDLEMOOSE';
  package Moo::HandleMoose;
  
  use strictures 1;
  use Moo::_Utils;
  use B qw(perlstring);
  
  our %TYPE_MAP;
  
  our $SETUP_DONE;
  
  sub import { return if $SETUP_DONE; inject_all(); $SETUP_DONE = 1; }
  
  sub inject_all {
    require Class::MOP;
    inject_fake_metaclass_for($_)
      for grep $_ ne 'Moo::Object', do { no warnings 'once'; keys %Moo::MAKERS };
    inject_fake_metaclass_for($_) for keys %Moo::Role::INFO;
    require Moose::Meta::Method::Constructor;
    @Moo::HandleMoose::FakeConstructor::ISA = 'Moose::Meta::Method::Constructor';
  }
  
  sub maybe_reinject_fake_metaclass_for {
    my ($name) = @_;
    our %DID_INJECT;
    if (delete $DID_INJECT{$name}) {
      unless ($Moo::Role::INFO{$name}) {
        Moo->_constructor_maker_for($name)->install_delayed;
      }
      inject_fake_metaclass_for($name);
    }
  }
  
  sub inject_fake_metaclass_for {
    my ($name) = @_;
    require Class::MOP;
    require Moo::HandleMoose::FakeMetaClass;
    Class::MOP::store_metaclass_by_name(
      $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass')
    );
    require Moose::Util::TypeConstraints;
    if ($Moo::Role::INFO{$name}) {
      Moose::Util::TypeConstraints::find_or_create_does_type_constraint($name);
    } else {
      Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($name);
    }
  }
  
  {
    package Moo::HandleMoose::FakeConstructor;
  
    sub _uninlined_body { \&Moose::Object::new }
  }
      
  
  sub inject_real_metaclass_for {
    my ($name) = @_;
    our %DID_INJECT;
    return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name};
    require Moose; require Moo; require Moo::Role; require Scalar::Util;
    Class::MOP::remove_metaclass_by_name($name);
    my ($am_role, $meta, $attr_specs, $attr_order) = do {
      if (my $info = $Moo::Role::INFO{$name}) {
        my @attr_info = @{$info->{attributes}||[]};
        (1, Moose::Meta::Role->initialize($name),
         { @attr_info },
         [ @attr_info[grep !($_ % 2), 0..$#attr_info] ]
        )
      } elsif ( my $cmaker = Moo->_constructor_maker_for($name) ) {
        my $specs = $cmaker->all_attribute_specs;
        (0, Moose::Meta::Class->initialize($name), $specs,
         [ sort { $specs->{$a}{index} <=> $specs->{$b}{index} } keys %$specs ]
        );
      } else {
         # This codepath is used if $name does not exist in $Moo::MAKERS
         (0, Moose::Meta::Class->initialize($name), {}, [] )
      }
    };
  
    for my $spec (values %$attr_specs) {
      if (my $inflators = delete $spec->{moosify}) {
        $_->($spec) for @$inflators;
      }
    }
  
    my %methods = %{Role::Tiny->_concrete_methods_of($name)};
  
    # if stuff gets added afterwards, _maybe_reset_handlemoose should
    # trigger the recreation of the metaclass but we need to ensure the
    # Role::Tiny cache is cleared so we don't confuse Moo itself.
    if (my $info = $Role::Tiny::INFO{$name}) {
      delete $info->{methods};
    }
  
    # needed to ensure the method body is stable and get things named
    Sub::Defer::undefer_sub($_) for grep defined, values %methods;
    my @attrs;
    {
      my %spec_map = (
        map { $_->name => $_->init_arg }
        grep { $_->has_init_arg }
        $meta->attribute_metaclass->meta->get_all_attributes
      );
      # This local is completely not required for roles but harmless
      local @{_getstash($name)}{keys %methods};
      my %seen_name;
      foreach my $name (@$attr_order) {
        $seen_name{$name} = 1;
        my %spec = %{$attr_specs->{$name}};
        $spec{is} = 'ro' if $spec{is} eq 'lazy' or $spec{is} eq 'rwp';
        my $coerce = $spec{coerce};
        if (my $isa = $spec{isa}) {
          my $tc = $spec{isa} = do {
            if (my $mapped = $TYPE_MAP{$isa}) {
              my $type = $mapped->();
              Scalar::Util::blessed($type) && $type->isa("Moose::Meta::TypeConstraint")
                or die "error inflating attribute '$name' for package '$_[0]': \$TYPE_MAP{$isa} did not return a valid type constraint'";
              $coerce ? $type->create_child_type(name => $type->name) : $type;
            } else {
              Moose::Meta::TypeConstraint->new(
                constraint => sub { eval { &$isa; 1 } }
              );
            }
          };
          if ($coerce) {
            $tc->coercion(Moose::Meta::TypeCoercion->new)
               ->_compiled_type_coercion($coerce);
            $spec{coerce} = 1;
          }
        } elsif ($coerce) {
          my $attr = perlstring($name);
          my $tc = Moose::Meta::TypeConstraint->new(
                     constraint => sub { die "This is not going to work" },
                     inlined => sub {
                        'my $r = $_[42]{'.$attr.'}; $_[42]{'.$attr.'} = 1; $r'
                     },
                   );
          $tc->coercion(Moose::Meta::TypeCoercion->new)
             ->_compiled_type_coercion($coerce);
          $spec{isa} = $tc;
          $spec{coerce} = 1;
        }
        %spec =
          map { $spec_map{$_} => $spec{$_} }
          grep { exists $spec_map{$_} }
          keys %spec;
        push @attrs, $meta->add_attribute($name => %spec);
      }
      foreach my $mouse (do { our %MOUSE; @{$MOUSE{$name}||[]} }) {
        foreach my $attr ($mouse->get_all_attributes) {
          my %spec = %{$attr};
          delete @spec{qw(
            associated_class associated_methods __METACLASS__
            provides curries
          )};
          my $name = delete $spec{name};
          next if $seen_name{$name}++;
          push @attrs, $meta->add_attribute($name => %spec);
        }
      }
    }
    for my $meth_name (keys %methods) {
      my $meth_code = $methods{$meth_name};
      $meta->add_method($meth_name, $meth_code) if $meth_code;
    }
  
    if ($am_role) {
      my $info = $Moo::Role::INFO{$name};
      $meta->add_required_methods(@{$info->{requires}});
      foreach my $modifier (@{$info->{modifiers}}) {
        my ($type, @args) = @$modifier;
        $meta->${\"add_${type}_method_modifier"}(@args);
      }
    } else {
      foreach my $attr (@attrs) {
        foreach my $method (@{$attr->associated_methods}) {
          $method->{body} = $name->can($method->name);
        }
      }
      bless(
        $meta->find_method_by_name('new'),
        'Moo::HandleMoose::FakeConstructor',
      );
    }
    $meta->add_role(Class::MOP::class_of($_))
      for grep !/\|/ && $_ ne $name, # reject Foo|Bar and same-role-as-self
        do { no warnings 'once'; keys %{$Role::Tiny::APPLIED_TO{$name}} };
    $DID_INJECT{$name} = 1;
    $meta;
  }
  
  1;
MOO_HANDLEMOOSE

$fatpacked{"Moo/HandleMoose/FakeMetaClass.pm"} = <<'MOO_HANDLEMOOSE_FAKEMETACLASS';
  package Moo::HandleMoose::FakeMetaClass;
  
  sub DESTROY { }
  
  sub AUTOLOAD {
    my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->$meth(@_)
  }
  sub can {
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->can(@_)
  }
  sub isa {
    require Moo::HandleMoose;
    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->isa(@_)
  }
  sub make_immutable { $_[0] }
  
  1;
MOO_HANDLEMOOSE_FAKEMETACLASS

$fatpacked{"Moo/Object.pm"} = <<'MOO_OBJECT';
  package Moo::Object;
  
  use strictures 1;
  
  our %NO_BUILD;
  our %NO_DEMOLISH;
  our $BUILD_MAKER;
  our $DEMOLISH_MAKER;
  
  sub new {
    my $class = shift;
    unless (exists $NO_DEMOLISH{$class}) {
      unless ($NO_DEMOLISH{$class} = !$class->can('DEMOLISH')) {
        ($DEMOLISH_MAKER ||= do {
          require Method::Generate::DemolishAll;
          Method::Generate::DemolishAll->new
        })->generate_method($class);
      }
    }
    $NO_BUILD{$class} and
      return bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class);
    $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class};
    $NO_BUILD{$class}
      ? bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class)
      : do {
          my $proto = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
          bless({ %$proto }, $class)->BUILDALL($proto);
        };
  }
  
  # Inlined into Method::Generate::Constructor::_generate_args() - keep in sync
  sub BUILDARGS {
      my $class = shift;
      if ( scalar @_ == 1 ) {
          unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
              die "Single parameters to new() must be a HASH ref"
                  ." data => ". $_[0] ."\n";
          }
          return { %{ $_[0] } };
      }
      elsif ( @_ % 2 ) {
          die "The new() method for $class expects a hash reference or a key/value list."
                  . " You passed an odd number of arguments\n";
      }
      else {
          return {@_};
      }
  }
  
  sub BUILDALL {
    my $self = shift;
    $self->${\(($BUILD_MAKER ||= do {
      require Method::Generate::BuildAll;
      Method::Generate::BuildAll->new
    })->generate_method(ref($self)))}(@_);
  }
  
  sub DEMOLISHALL {
    my $self = shift;
    $self->${\(($DEMOLISH_MAKER ||= do {
      require Method::Generate::DemolishAll;
      Method::Generate::DemolishAll->new
    })->generate_method(ref($self)))}(@_);
  }
  
  sub does {
    require Role::Tiny;
    { no warnings 'redefine'; *does = \&Role::Tiny::does_role }
    goto &Role::Tiny::does_role;
  }
  
  # duplicated in Moo::Role
  sub meta {
    require Moo::HandleMoose::FakeMetaClass;
    my $class = ref($_[0])||$_[0];
    bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
  }
  
  1;
MOO_OBJECT

$fatpacked{"Moo/Role.pm"} = <<'MOO_ROLE';
  package Moo::Role;
  
  use strictures 1;
  use Moo::_Utils;
  use base qw(Role::Tiny);
  
  require Moo::sification;
  
  BEGIN { *INFO = \%Role::Tiny::INFO }
  
  our %INFO;
  
  sub _install_tracked {
    my ($target, $name, $code) = @_;
    $INFO{$target}{exports}{$name} = $code;
    _install_coderef "${target}::${name}" => "Moo::Role::${name}" => $code;
  }
  
  sub import {
    my $target = caller;
    my ($me) = @_;
    strictures->import;
    if ($Moo::MAKERS{$target} and $Moo::MAKERS{$target}{is_class}) {
      die "Cannot import Moo::Role into a Moo class";
    }
    $INFO{$target} ||= {};
    # get symbol table reference
    my $stash = do { no strict 'refs'; \%{"${target}::"} };
    _install_tracked $target => has => sub {
      my ($name_proto, %spec) = @_;
      my $name_isref = ref $name_proto eq 'ARRAY';
      foreach my $name ($name_isref ? @$name_proto : $name_proto) {
        my $spec_ref = $name_isref ? +{%spec} : \%spec;
        ($INFO{$target}{accessor_maker} ||= do {
          require Method::Generate::Accessor;
          Method::Generate::Accessor->new
        })->generate_method($target, $name, $spec_ref);
        push @{$INFO{$target}{attributes}||=[]}, $name, $spec_ref;
        $me->_maybe_reset_handlemoose($target);
      }
    };
    # install before/after/around subs
    foreach my $type (qw(before after around)) {
      _install_tracked $target => $type => sub {
        require Class::Method::Modifiers;
        push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
        $me->_maybe_reset_handlemoose($target);
      };
    }
    _install_tracked $target => requires => sub {
      push @{$INFO{$target}{requires}||=[]}, @_;
      $me->_maybe_reset_handlemoose($target);
    };
    _install_tracked $target => with => sub {
      $me->apply_roles_to_package($target, @_);
      $me->_maybe_reset_handlemoose($target);
    };
    return if $INFO{$target}{is_role}; # already exported into this package
    $INFO{$target}{is_role} = 1;
    *{_getglob("${target}::meta")} = $me->can('meta');
    # grab all *non-constant* (stash slot is not a scalarref) subs present
    # in the symbol table and store their refaddrs (no need to forcibly
    # inflate constant subs into real subs) - also add '' to here (this
    # is used later) with a map to the coderefs in case of copying or re-use
    my @not_methods = ('', map { *$_{CODE}||() } grep !ref($_), values %$stash);
    @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
    # a role does itself
    $Role::Tiny::APPLIED_TO{$target} = { $target => undef };
  
    if ($INC{'Moo/HandleMoose.pm'}) {
      Moo::HandleMoose::inject_fake_metaclass_for($target);
    }
  }
  
  # duplicate from Moo::Object
  sub meta {
    require Moo::HandleMoose::FakeMetaClass;
    my $class = ref($_[0])||$_[0];
    bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
  }
  
  sub unimport {
    my $target = caller;
    _unimport_coderefs($target, $INFO{$target});
  }
  
  sub _maybe_reset_handlemoose {
    my ($class, $target) = @_;
    if ($INC{"Moo/HandleMoose.pm"}) {
      Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
    }
  }
  
  sub _inhale_if_moose {
    my ($self, $role) = @_;
    _load_module($role);
    my $meta;
    if (!$INFO{$role}
        and (
          $INC{"Moose.pm"}
          and $meta = Class::MOP::class_of($role)
        )
        or (
          Mouse::Util->can('find_meta')
          and $meta = Mouse::Util::find_meta($role)
       )
    ) {
      $INFO{$role}{methods} = {
        map +($_ => $role->can($_)),
          grep !$meta->get_method($_)->isa('Class::MOP::Method::Meta'),
            $meta->get_method_list
      };
      $Role::Tiny::APPLIED_TO{$role} = {
        map +($_->name => 1), $meta->calculate_all_roles
      };
      $INFO{$role}{requires} = [ $meta->get_required_method_list ];
      $INFO{$role}{attributes} = [
        map +($_ => do {
          my $spec = { %{$meta->get_attribute($_)} };
  
          if ($spec->{isa}) {
  
            my $get_constraint = do {
              my $pkg = $meta->isa('Mouse::Meta::Role')
                          ? 'Mouse::Util::TypeConstraints'
                          : 'Moose::Util::TypeConstraints';
              _load_module($pkg);
              $pkg->can('find_or_create_isa_type_constraint');
            };
  
            my $tc = $get_constraint->($spec->{isa});
            my $check = $tc->_compiled_type_constraint;
  
            $spec->{isa} = sub {
              &$check or die "Type constraint failed for $_[0]"
            };
  
            if ($spec->{coerce}) {
  
               # Mouse has _compiled_type_coercion straight on the TC object
               $spec->{coerce} = $tc->${\(
                 $tc->can('coercion')||sub { $_[0] }
               )}->_compiled_type_coercion;
            }
          }
          $spec;
        }), $meta->get_attribute_list
      ];
      my $mods = $INFO{$role}{modifiers} = [];
      foreach my $type (qw(before after around)) {
        # Mouse pokes its own internals so we have to fall back to doing
        # the same thing in the absence of the Moose API method
        my $map = $meta->${\(
          $meta->can("get_${type}_method_modifiers_map")
          or sub { shift->{"${type}_method_modifiers"} }
        )};
        foreach my $method (keys %$map) {
          foreach my $mod (@{$map->{$method}}) {
            push @$mods, [ $type => $method => $mod ];
          }
        }
      }
      require Class::Method::Modifiers if @$mods;
      $INFO{$role}{inhaled_from_moose} = 1;
    }
  }
  
  sub _maybe_make_accessors {
    my ($self, $role, $target) = @_;
    my $m;
    if ($INFO{$role}{inhaled_from_moose}
        or $INC{"Moo.pm"}
        and $m = Moo->_accessor_maker_for($target)
        and ref($m) ne 'Method::Generate::Accessor') {
      $self->_make_accessors($role, $target);
    }
  }
  
  sub _make_accessors_if_moose {
    my ($self, $role, $target) = @_;
    if ($INFO{$role}{inhaled_from_moose}) {
      $self->_make_accessors($role, $target);
    }
  }
  
  sub _make_accessors {
    my ($self, $role, $target) = @_;
    my $acc_gen = ($Moo::MAKERS{$target}{accessor} ||= do {
      require Method::Generate::Accessor;
      Method::Generate::Accessor->new
    });
    my $con_gen = $Moo::MAKERS{$target}{constructor};
    my @attrs = @{$INFO{$role}{attributes}||[]};
    while (my ($name, $spec) = splice @attrs, 0, 2) {
      # needed to ensure we got an index for an arrayref based generator
      if ($con_gen) {
        $spec = $con_gen->all_attribute_specs->{$name};
      }
      $acc_gen->generate_method($target, $name, $spec);
    }
  }
  
  sub apply_roles_to_package {
    my ($me, $to, @roles) = @_;
    foreach my $role (@roles) {
        $me->_inhale_if_moose($role);
    }
    $me->SUPER::apply_roles_to_package($to, @roles);
  }
  
  sub apply_single_role_to_package {
    my ($me, $to, $role) = @_;
    $me->_inhale_if_moose($role);
    $me->_handle_constructor($to, $INFO{$role}{attributes});
    $me->_maybe_make_accessors($role, $to);
    $me->SUPER::apply_single_role_to_package($to, $role);
  }
  
  sub create_class_with_roles {
    my ($me, $superclass, @roles) = @_;
  
    my $new_name = join(
      '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
    );
  
    return $new_name if $Role::Tiny::COMPOSED{class}{$new_name};
  
    foreach my $role (@roles) {
        $me->_inhale_if_moose($role);
    }
  
    my $m;
    if ($INC{"Moo.pm"}
        and $m = Moo->_accessor_maker_for($superclass)
        and ref($m) ne 'Method::Generate::Accessor') {
      # old fashioned way time.
      *{_getglob("${new_name}::ISA")} = [ $superclass ];
      $me->apply_roles_to_package($new_name, @roles);
      return $new_name;
    }
  
    require Sub::Quote;
  
    $me->SUPER::create_class_with_roles($superclass, @roles);
  
    foreach my $role (@roles) {
      die "${role} is not a Role::Tiny" unless my $info = $INFO{$role};
    }
  
    $Moo::MAKERS{$new_name} = {};
  
    $me->_handle_constructor(
      $new_name, [ map @{$INFO{$_}{attributes}||[]}, @roles ], $superclass
    );
  
    return $new_name;
  }
  
  sub _composable_package_for {
    my ($self, $role) = @_;
    my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role;
    return $composed_name if $Role::Tiny::COMPOSED{role}{$composed_name};
    $self->_make_accessors_if_moose($role, $composed_name);
    $self->SUPER::_composable_package_for($role);
  }
  
  sub _install_single_modifier {
    my ($me, @args) = @_;
    _install_modifier(@args);
  }
  
  sub _handle_constructor {
    my ($me, $to, $attr_info, $superclass) = @_;
    return unless $attr_info && @$attr_info;
    if ($INFO{$to}) {
      push @{$INFO{$to}{attributes}||=[]}, @$attr_info;
    } else {
      # only fiddle with the constructor if the target is a Moo class
      if ($INC{"Moo.pm"}
          and my $con = Moo->_constructor_maker_for($to, $superclass)) {
        # shallow copy of the specs since the constructor will assign an index
        $con->register_attribute_specs(map ref() ? { %$_ } : $_, @$attr_info);
      }
    }
  }
  
  1;
  
  =head1 NAME
  
  Moo::Role - Minimal Object Orientation support for Roles
  
  =head1 SYNOPSIS
  
   package My::Role;
  
   use Moo::Role;
  
   sub foo { ... }
  
   sub bar { ... }
  
   has baz => (
     is => 'ro',
   );
  
   1;
  
  And elsewhere:
  
   package Some::Class;
  
   use Moo;
  
   # bar gets imported, but not foo
   with('My::Role');
  
   sub foo { ... }
  
   1;
  
  =head1 DESCRIPTION
  
  C<Moo::Role> builds upon L<Role::Tiny>, so look there for most of the
  documentation on how this works.  The main addition here is extra bits to make
  the roles more "Moosey;" which is to say, it adds L</has>.
  
  =head1 IMPORTED SUBROUTINES
  
  See L<Role::Tiny/IMPORTED SUBROUTINES> for all the other subroutines that are
  imported by this module.
  
  =head2 has
  
   has attr => (
     is => 'ro',
   );
  
  Declares an attribute for the class to be composed into.  See
  L<Moo/has> for all options.
  
  =head1 SUPPORT
  
  See L<Moo> for support and contact informations.
  
  =head1 AUTHORS
  
  See L<Moo> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Moo> for the copyright and license.
MOO_ROLE

$fatpacked{"Moo/_Utils.pm"} = <<'MOO__UTILS';
  package Moo::_Utils;
  
  no warnings 'once'; # guard against -w
  
  sub _getglob { \*{$_[0]} }
  sub _getstash { \%{"$_[0]::"} }
  
  use constant lt_5_8_3 => ( $] < 5.008003 or $ENV{MOO_TEST_PRE_583} ) ? 1 : 0;
  use constant can_haz_subname => eval { require Sub::Name };
  
  use strictures 1;
  use Module::Runtime qw(require_module);
  use Devel::GlobalDestruction ();
  use base qw(Exporter);
  use Moo::_mro;
  
  our @EXPORT = qw(
      _getglob _install_modifier _load_module _maybe_load_module
      _get_linear_isa _getstash _install_coderef _name_coderef
      _unimport_coderefs _in_global_destruction
  );
  
  sub _in_global_destruction ();
  *_in_global_destruction = \&Devel::GlobalDestruction::in_global_destruction;
  
  sub _install_modifier {
    my ($into, $type, $name, $code) = @_;
  
    if (my $to_modify = $into->can($name)) { # CMM will throw for us if not
      require Sub::Defer;
      Sub::Defer::undefer_sub($to_modify);
    }
  
    Class::Method::Modifiers::install_modifier(@_);
  }
  
  our %MAYBE_LOADED;
  
  sub _load_module {
    (my $proto = $_[0]) =~ s/::/\//g;
    return 1 if $INC{"${proto}.pm"};
    # can't just ->can('can') because a sub-package Foo::Bar::Baz
    # creates a 'Baz::' key in Foo::Bar's symbol table
    my $stash = _getstash($_[0])||{};
    return 1 if grep +(!ref($_) and *$_{CODE}), values %$stash;
    require_module($_[0]);
    return 1;
  }
  
  sub _maybe_load_module {
    return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]};
    (my $proto = $_[0]) =~ s/::/\//g;
    local $@;
    if (eval { require "${proto}.pm"; 1 }) {
      $MAYBE_LOADED{$_[0]} = 1;
    } else {
      if (exists $INC{"${proto}.pm"}) {
        warn "$_[0] exists but failed to load with error: $@";
      }
      $MAYBE_LOADED{$_[0]} = 0;
    }
    return $MAYBE_LOADED{$_[0]};
  }
  
  sub _get_linear_isa {
    return mro::get_linear_isa($_[0]);
  }
  
  sub _install_coderef {
    no warnings 'redefine';
    *{_getglob($_[0])} = _name_coderef(@_);
  }
  
  sub _name_coderef {
    shift if @_ > 2; # three args is (target, name, sub)
    can_haz_subname ? Sub::Name::subname(@_) : $_[1];
  }
  
  sub _unimport_coderefs {
    my ($target, $info) = @_;
    return unless $info and my $exports = $info->{exports};
    my %rev = reverse %$exports;
    my $stash = _getstash($target);
    foreach my $name (keys %$exports) {
      if ($stash->{$name} and defined(&{$stash->{$name}})) {
        if ($rev{$target->can($name)}) {
          my $old = delete $stash->{$name};
          my $full_name = join('::',$target,$name);
          # Copy everything except the code slot back into place (e.g. $has)
          foreach my $type (qw(SCALAR HASH ARRAY IO)) {
            next unless defined(*{$old}{$type});
            no strict 'refs';
            *$full_name = *{$old}{$type};
          }
        }
      }
    }
  }
  
  sub STANDARD_DESTROY {
    my $self = shift;
  
    my $e = do {
      local $?;
      local $@;
      eval {
        $self->DEMOLISHALL(_in_global_destruction);
      };
      $@;
    };
  
    no warnings 'misc';
    die $e if $e; # rethrow
  }
  
  1;
MOO__UTILS

$fatpacked{"Moo/_mro.pm"} = <<'MOO__MRO';
  package Moo::_mro;
  
  if ($] >= 5.010) {
    require mro;
  } else {
    require MRO::Compat;
  }
  
  1;
MOO__MRO

$fatpacked{"Moo/sification.pm"} = <<'MOO_SIFICATION';
  package Moo::sification;
  
  use strictures 1;
  use Moo::_Utils ();
  
  sub unimport { our $disarmed = 1 }
  
  sub Moo::HandleMoose::AuthorityHack::DESTROY {
    unless (our $disarmed or Moo::_Utils::_in_global_destruction) {
      require Moo::HandleMoose;
      Moo::HandleMoose->import;
    }
  }
  
  if ($INC{"Moose.pm"}) {
    require Moo::HandleMoose;
    Moo::HandleMoose->import;
  } else {
    $Moose::AUTHORITY = bless({}, 'Moo::HandleMoose::AuthorityHack');
  }
  
  1;
MOO_SIFICATION

$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.4404';
  	@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__
  
  =pod
  
  =head1 NAME
  
  Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
  
  =head1 SYNOPSIS
  
      #############################################
      # In your file
      
      ---
      name: My-Distribution
      version: 1.23
      resources:
        homepage: "http://example.com/dist/My-Distribution"
      
      
      #############################################
      # In your program
      
      use Parse::CPAN::Meta;
      
      my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
      
      # Reading properties
      my $name     = $distmeta->{name};
      my $version  = $distmeta->{version};
      my $homepage = $distmeta->{resources}{homepage};
  
  =head1 DESCRIPTION
  
  B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
  L<JSON::PP> and/or L<CPAN::Meta::YAML>.
  
  B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
  and C<load_yaml_string>.  These will read and deserialize CPAN metafiles, and
  are described below in detail.
  
  B<Parse::CPAN::Meta> provides a legacy API of only two functions,
  based on the YAML functions of the same name. Wherever possible,
  identical calling semantics are used.  These may only be used with YAML sources.
  
  All error reporting is done with exceptions (die'ing).
  
  Note that META files are expected to be in UTF-8 encoding, only.  When
  converted string data, it must first be decoded from UTF-8.
  
  =head1 METHODS
  
  =head2 load_file
  
    my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
  
    my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
  
  This method will read the named file and deserialize it to a data structure,
  determining whether it should be JSON or YAML based on the filename.  On
  Perl 5.8.1 or later, the file will be read using the ":utf8" IO layer.
  
  =head2 load_yaml_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
  
  This method deserializes the given string of YAML and returns the first
  document in it.  (CPAN metadata files should always have only one document.)
  If the source was UTF-8 encoded, the string must be decoded before calling
  C<load_yaml_string>.
  
  =head2 load_json_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
  
  This method deserializes the given string of JSON and the result.  
  If the source was UTF-8 encoded, the string must be decoded before calling
  C<load_json_string>.
  
  =head2 yaml_backend
  
    my $backend = Parse::CPAN::Meta->yaml_backend;
  
  Returns the module name of the YAML serializer. See L</ENVIRONMENT>
  for details.
  
  =head2 json_backend
  
    my $backend = Parse::CPAN::Meta->json_backend;
  
  Returns the module name of the JSON serializer.  This will either
  be L<JSON::PP> or L<JSON>.  Even if C<PERL_JSON_BACKEND> is set,
  this will return L<JSON> as further delegation is handled by
  the L<JSON> module.  See L</ENVIRONMENT> for details.
  
  =head1 FUNCTIONS
  
  For maintenance clarity, no functions are exported.  These functions are
  available for backwards compatibility only and are best avoided in favor of
  C<load_file>.
  
  =head2 Load
  
    my @yaml = Parse::CPAN::Meta::Load( $string );
  
  Parses a string containing a valid YAML stream into a list of Perl data
  structures.
  
  =head2 LoadFile
  
    my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
  
  Reads the YAML stream from a file instead of a string.
  
  =head1 ENVIRONMENT
  
  =head2 PERL_JSON_BACKEND
  
  By default, L<JSON::PP> will be used for deserializing JSON data. If the
  C<PERL_JSON_BACKEND> environment variable exists, is true and is not
  "JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
  used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
  old, an exception will be thrown.
  
  =head2 PERL_YAML_BACKEND
  
  By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
  the C<PERL_YAML_BACKEND> environment variable is defined, then it is intepreted
  as a module to use for deserialization.  The given module must be installed,
  must load correctly and must implement the C<Load()> function or an exception
  will be thrown.
  
  =head1 SUPPORT
  
  Bugs should be reported via the CPAN bug tracker at
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 - 2010 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PARSE_CPAN_META

$fatpacked{"Path/Tiny.pm"} = <<'PATH_TINY';
  use 5.008001;
  use strict;
  use warnings;
  
  package Path::Tiny;
  # ABSTRACT: File path utility
  our $VERSION = '0.035'; # VERSION
  
  # Dependencies
  use Exporter 5.57   (qw/import/);
  use File::Spec 3.40 ();
  use Carp ();
  
  our @EXPORT    = qw/path/;
  our @EXPORT_OK = qw/cwd rootdir tempfile tempdir/;
  
  use constant {
      PATH  => 0,
      CANON => 1,
      VOL   => 2,
      DIR   => 3,
      FILE  => 4,
      TEMP  => 5,
  };
  
  use overload (
      q{""}    => sub    { $_[0]->[PATH] },
      bool     => sub () { 1 },
      fallback => 1,
  );
  
  my $IS_BSD;
  
  BEGIN { $IS_BSD = $^O =~ /bsd$/ }
  
  # if cloning, threads should already be loaded, but Win32 pseudoforks
  # don't do that so we have to be sure it's loaded anyway
  my $TID = 0; # for thread safe atomic writes
  
  sub CLONE { require threads; $TID = threads->tid }
  
  my $HAS_UU;  # has Unicode::UTF8; lazily populated
  
  sub _check_UU {
      eval { require Unicode::UTF8; Unicode::UTF8->VERSION(0.58); 1 };
  }
  
  # notions of "root" directories differ on Win32: \\server\dir\ or C:\ or \
  my $SLASH      = qr{[\\/]};
  my $NOTSLASH   = qr{[^\\/]+};
  my $DRV_VOL    = qr{[a-z]:}i;
  my $UNC_VOL    = qr{$SLASH $SLASH $NOTSLASH $SLASH $NOTSLASH}x;
  my $WIN32_ROOT = qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;
  
  sub _normalize_win32_path {
      my ($path) = @_;
      if ( $path =~ /^$DRV_VOL$/ ) {
          require Cwd;
          my $fullpath = Cwd::getdcwd($path); # C: -> C:\some\cwd
          # getdcwd on non-existent drive returns empty string
          $path = length $fullpath ? $fullpath : $path . "/";
      }
      elsif ( $path =~ /^$UNC_VOL$/ ) {
          $path .= "/";                       # canonpath currently strips it and we want it
      }
      # hack to make splitpath give us a basename; might not be necessary
      # since canonpath should do this for non-root paths, but I don't trust it
      $path =~ s{/$}{} if $path !~ /^$WIN32_ROOT$/;
      return $path;
  }
  
  # flock doesn't work on NFS on BSD.  Since program authors often can't control
  # or detect that, we warn once instead of being fatal if we can detect it and
  # people who need it strict can fatalize the 'flock' category
  
  #<<< No perltidy
  { package flock; use if $IS_BSD, 'warnings::register' }
  #>>>
  
  my $WARNED_BSD_NFS = 0;
  
  sub _throw {
      my ( $self, $function, $file ) = @_;
      if (   $IS_BSD
          && $function =~ /^flock/
          && $! =~ /operation not supported/i
          && !warnings::fatal_enabled('flock') )
      {
          if ( !$WARNED_BSD_NFS ) {
              warnings::warn( flock => "No flock for NFS on BSD: continuing in unsafe mode" );
              $WARNED_BSD_NFS++;
          }
      }
      else {
          Path::Tiny::Error->throw( $function, ( defined $file ? $file : $self->[PATH] ), $! );
      }
      return;
  }
  
  # cheapo option validation
  sub _get_args {
      my ( $raw, @valid ) = @_;
      if ( defined($raw) && ref($raw) ne 'HASH' ) {
          my ( undef, undef, undef, $called_as ) = caller(1);
          $called_as =~ s{^.*::}{};
          Carp::croak("Options for $called_as must be a hash reference");
      }
      my $cooked = {};
      for my $k (@valid) {
          $cooked->{$k} = delete $raw->{$k} if exists $raw->{$k};
      }
      if ( keys %$raw ) {
          my ( undef, undef, undef, $called_as ) = caller(1);
          $called_as =~ s{^.*::}{};
          Carp::croak( "Invalid option(s) for $called_as: " . join( ", ", keys %$raw ) );
      }
      return $cooked;
  }
  
  #--------------------------------------------------------------------------#
  # Constructors
  #--------------------------------------------------------------------------#
  
  
  sub path {
      my $path = shift;
      Carp::croak("path() requires a defined, positive-length argument")
        unless defined $path && length $path;
      # join stringifies any objects, too, which is handy :-)
      $path = join( "/", ( $path eq '/' ? "" : $path ), @_ ) if @_;
      my $cpath = $path = File::Spec->canonpath($path); # ugh, but probably worth it
      if ( $^O eq 'MSWin32' ) {
          $path = _normalize_win32_path($path);
      }
      else {
          # hack to make splitpath give us a basename; might not be necessary
          # since canonpath should do this for non-root paths, but I don't trust it
          $path =~ s{/$}{} if $path ne '/';
      }
      $path =~ tr[\\][/]; # unix convention enforced
      if ( $path =~ m{^(~[^/]*).*} ) { # expand a tilde
          my ($homedir) = glob($1);    # glob without list context == heisenbug!
          $path =~ s{^(~[^/]*)}{$homedir};
      }
      bless [ $path, $cpath ], __PACKAGE__;
  }
  
  
  sub new { shift; path(@_) }
  
  
  sub cwd {
      require Cwd;
      return path( Cwd::getcwd() );
  }
  
  
  sub rootdir { path( File::Spec->rootdir ) }
  
  
  sub tempfile {
      shift if $_[0] eq 'Path::Tiny'; # called as method
      my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
      # File::Temp->new demands TEMPLATE
      $args->{TEMPLATE} = $maybe_template->[0] if @$maybe_template;
  
      require File::Temp;
      my $temp = File::Temp->new( TMPDIR => 1, %$args );
      close $temp;
      my $self = path($temp)->absolute;
      $self->[TEMP] = $temp;          # keep object alive while we are
      return $self;
  }
  
  sub tempdir {
      shift if $_[0] eq 'Path::Tiny'; # called as method
      my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
  
      # File::Temp->newdir demands leading template
      require File::Temp;
      my $temp = File::Temp->newdir( @$maybe_template, TMPDIR => 1, %$args );
      my $self = path($temp)->absolute;
      $self->[TEMP] = $temp;          # keep object alive while we are
      return $self;
  }
  
  # normalize the various ways File::Temp does templates
  sub _parse_file_temp_args {
      my $leading_template = ( scalar(@_) % 2 == 1 ? shift(@_) : '' );
      my %args = @_;
      %args = map { uc($_), $args{$_} } keys %args;
      my @template = (
            exists $args{TEMPLATE} ? delete $args{TEMPLATE}
          : $leading_template      ? $leading_template
          :                          ()
      );
      return ( \@template, \%args );
  }
  
  #--------------------------------------------------------------------------#
  # Private methods
  #--------------------------------------------------------------------------#
  
  sub _splitpath {
      my ($self) = @_;
      @{$self}[ VOL, DIR, FILE ] = File::Spec->splitpath( $self->[PATH] );
  }
  
  #--------------------------------------------------------------------------#
  # Public methods
  #--------------------------------------------------------------------------#
  
  
  sub absolute {
      my ( $self, $base ) = @_;
      return $self if $self->is_absolute;
  
      require Cwd;
      return path( join "/", ( defined($base) ? $base : Cwd::getcwd() ), $_[0]->[PATH] );
  }
  
  
  sub append {
      my ( $self, @data ) = @_;
      my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
      $args = _get_args( $args, qw/binmode/ );
      my $binmode = $args->{binmode};
      $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
      my $fh = $self->filehandle( ">>", $binmode );
  
      require Fcntl;
      flock( $fh, Fcntl::LOCK_EX() ) or $self->_throw('flock (LOCK_EX)');
  
      # Ensure we're at the end after the lock
      seek( $fh, 0, Fcntl::SEEK_END() ) or $self->_throw('seek');
  
      print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
  
      # For immediate flush
      close $fh or $self->_throw('close');
  }
  
  sub append_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &append }
  
  sub append_utf8 {
      if ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() ) {
          my $self = shift;
          append( $self, { binmode => ":unix" }, map { Unicode::UTF8::encode_utf8($_) } @_ );
      }
      else {
          splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" };
          goto &append;
      }
  }
  
  
  sub basename {
      my ($self) = @_;
      $self->_splitpath unless defined $self->[FILE];
      return $self->[FILE];
  }
  
  
  sub canonpath { $_[0]->[CANON] }
  
  
  sub child {
      my ( $self, @parts ) = @_;
      my $path = $self->[PATH];
      return path( join( "/", ( $path eq '/' ? "" : $path ), @parts ) );
  }
  
  
  sub children {
      my ( $self, $filter ) = @_;
      my $dh;
      opendir $dh, $self->[PATH] or $self->_throw('opendir');
      my @children = readdir $dh;
      closedir $dh or $self->_throw('closedir');
  
      if ( not defined $filter ) {
          @children = grep { $_ ne '.' && $_ ne '..' } @children;
      }
      elsif ( $filter && ref($filter) eq 'Regexp' ) {
          @children = grep { $_ ne '.' && $_ ne '..' && $_ =~ $filter } @children;
      }
      else {
          Carp::croak("Invalid argument '$filter' for children()");
      }
  
      return map { path( $self->[PATH] . "/$_" ) } @children;
  }
  
  
  # XXX do recursively for directories?
  sub copy {
      my ( $self, $dest ) = @_;
      require File::Copy;
      File::Copy::copy( $self->[PATH], $dest )
        or Carp::croak("copy failed for $self to $dest: $!");
  }
  
  
  sub digest {
      my ( $self, $alg, @args ) = @_;
      $alg = 'SHA-256' unless defined $alg;
      require Digest;
      return Digest->new( $alg, @args )->add( $self->slurp_raw )->hexdigest;
  }
  
  
  sub dirname {
      my ($self) = @_;
      $self->_splitpath unless defined $self->[DIR];
      return length $self->[DIR] ? $self->[DIR] : ".";
  }
  
  
  sub exists { -e $_[0]->[PATH] }
  
  sub is_file { -f $_[0]->[PATH] }
  
  sub is_dir { -d $_[0]->[PATH] }
  
  
  # Note: must put binmode on open line, not subsequent binmode() call, so things
  # like ":unix" actually stop perlio/crlf from being added
  
  sub filehandle {
      my ( $self, $opentype, $binmode ) = @_;
      $opentype = "<" unless defined $opentype;
      $binmode  = ""  unless defined $binmode;
  
      my $mode = $opentype . $binmode;
      my $fh;
      open $fh, $mode, $self->[PATH] or $self->_throw('open ($mode)');
  
      return $fh;
  }
  
  
  sub is_absolute { substr( $_[0]->dirname, 0, 1 ) eq '/' }
  
  sub is_relative { substr( $_[0]->dirname, 0, 1 ) ne '/' }
  
  
  sub iterator {
      my $self = shift;
      my $args = _get_args( shift, qw/recurse follow_symlinks/ );
      my @dirs = $self;
      my $current;
      return sub {
          my $next;
          while (@dirs) {
              if ( ref $dirs[0] eq 'Path::Tiny' ) {
                  $current = $dirs[0];
                  my $dh;
                  opendir( $dh, $current->[PATH] )
                    or $self->_throw( 'opendir', $current->[PATH] );
                  $dirs[0] = $dh;
                  if ( -l $current->[PATH] && !$args->{follow_symlinks} ) {
                      # Symlink attack! It was a real dir, but is now a symlink!
                      # N.B. we check *after* opendir so the attacker has to win
                      # two races: replace dir with symlink before opendir and
                      # replace symlink with dir before -l check above
                      shift @dirs and next;
                  }
              }
              while ( defined( $next = readdir $dirs[0] ) ) {
                  next if $next eq '.' || $next eq '..';
                  my $path = $current->child($next);
                  push @dirs, $path
                    if $args->{recurse} && -d $path && !( !$args->{follow_symlinks} && -l $path );
                  return $path;
              }
              shift @dirs;
          }
          return;
      };
  }
  
  
  sub lines {
      my $self    = shift;
      my $args    = _get_args( shift, qw/binmode chomp count/ );
      my $binmode = $args->{binmode};
      $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
      my $fh = $self->filehandle( "<", $binmode );
      require Fcntl;
      flock( $fh, Fcntl::LOCK_SH() ) or $self->_throw('flock (LOCK_SH)');
      my $chomp = $args->{chomp};
      # XXX more efficient to read @lines then chomp(@lines) vs map?
      if ( $args->{count} ) {
          my ( @result, $counter );
          while ( my $line = <$fh> ) {
              chomp $line if $chomp;
              push @result, $line;
              last if ++$counter == $args->{count};
          }
          return @result;
      }
      elsif ($chomp) {
          return map { chomp; $_ } <$fh>;
      }
      else {
          return wantarray ? <$fh> : ( my $count =()= <$fh> );
      }
  }
  
  sub lines_raw {
      my $self = shift;
      my $args = _get_args( shift, qw/binmode chomp count/ );
      if ( $args->{chomp} && !$args->{count} ) {
          return split /\n/, slurp_raw($self); ## no critic
      }
      else {
          $args->{binmode} = ":raw";
          return lines( $self, $args );
      }
  }
  
  sub lines_utf8 {
      my $self = shift;
      my $args = _get_args( shift, qw/binmode chomp count/ );
      if (   ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() )
          && $args->{chomp}
          && !$args->{count} )
      {
          return split /\n/, slurp_utf8($self); ## no critic
      }
      else {
          $args->{binmode} = ":raw:encoding(UTF-8)";
          return lines( $self, $args );
      }
  }
  
  
  sub mkpath {
      my ( $self, $args ) = @_;
      $args = {} unless ref $args eq 'HASH';
      my $err;
      $args->{err} = \$err unless defined $args->{err};
      require File::Path;
      my @dirs = File::Path::make_path( $self->[PATH], $args );
      if ( $err && @$err ) {
          my ( $file, $message ) = %{ $err->[0] };
          Carp::croak("mkpath failed for $file: $message");
      }
      return @dirs;
  }
  
  
  sub move {
      my ( $self, $dst ) = @_;
  
      return rename( $self->[PATH], $dst )
        || $self->_throw( 'rename', $self->[PATH] . "' -> '$dst'" );
  }
  
  
  my %opens = (
      opena  => ">>",
      openr  => "<",
      openw  => ">",
      openrw => "+<"
  );
  
  while ( my ( $k, $v ) = each %opens ) {
      no strict 'refs';
      # must check for lexical IO mode hint
      *{$k} = sub {
          my ( $self, $binmode ) = @_;
          $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $v, -1, 1 ) }
            unless defined $binmode;
          $self->filehandle( $v, $binmode );
      };
      *{ $k . "_raw" }  = sub { $_[0]->filehandle( $v, ":raw" ) };
      *{ $k . "_utf8" } = sub { $_[0]->filehandle( $v, ":raw:encoding(UTF-8)" ) };
  }
  
  
  # XXX this is ugly and coverage is incomplete.  I think it's there for windows
  # so need to check coverage there and compare
  sub parent {
      my ( $self, $level ) = @_;
      $level = 1 unless defined $level && $level > 0;
      $self->_splitpath unless defined $self->[FILE];
      my $parent;
      if ( length $self->[FILE] ) {
          if ( $self->[FILE] eq '.' || $self->[FILE] eq ".." ) {
              $parent = path( $self->[PATH] . "/.." );
          }
          else {
              $parent = path( _non_empty( $self->[VOL] . $self->[DIR] ) );
          }
      }
      elsif ( length $self->[DIR] ) {
          # because of symlinks, any internal updir requires us to
          # just add more updirs at the end
          if ( $self->[DIR] =~ m{(?:^\.\./|/\.\./|/\.\.$)} ) {
              $parent = path( $self->[VOL] . $self->[DIR] . "/.." );
          }
          else {
              ( my $dir = $self->[DIR] ) =~ s{/[^\/]+/$}{/};
              $parent = path( $self->[VOL] . $dir );
          }
      }
      else {
          $parent = path( _non_empty( $self->[VOL] ) );
      }
      return $level == 1 ? $parent : $parent->parent( $level - 1 );
  }
  
  sub _non_empty {
      my ($string) = shift;
      return ( ( defined($string) && length($string) ) ? $string : "." );
  }
  
  
  sub realpath {
      require Cwd;
      return path( Cwd::realpath( $_[0]->[PATH] ) );
  }
  
  
  # Easy to get wrong, so wash it through File::Spec (sigh)
  sub relative { path( File::Spec->abs2rel( $_[0]->[PATH], $_[1] ) ) }
  
  
  sub remove {
      my $self = shift;
  
      return 0 if !-e $self->[PATH] && !-l $self->[PATH];
  
      return unlink $self->[PATH] || $self->_throw('unlink');
  }
  
  
  sub remove_tree {
      my ( $self, $args ) = @_;
      return 0 if !-e $self->[PATH] && !-l $self->[PATH];
      $args = {} unless ref $args eq 'HASH';
      my $err;
      $args->{err}  = \$err unless defined $args->{err};
      $args->{safe} = 1     unless defined $args->{safe};
      require File::Path;
      my $count = File::Path::remove_tree( $self->[PATH], $args );
  
      if ( $err && @$err ) {
          my ( $file, $message ) = %{ $err->[0] };
          Carp::croak("remove_tree failed for $file: $message");
      }
      return $count;
  }
  
  
  sub slurp {
      my $self    = shift;
      my $args    = _get_args( shift, qw/binmode/ );
      my $binmode = $args->{binmode};
      $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
      my $fh = $self->filehandle( "<", $binmode );
      require Fcntl;
      flock( $fh, Fcntl::LOCK_SH() ) or $self->_throw('flock (LOCK_SH)');
      if ( ( defined($binmode) ? $binmode : "" ) eq ":unix"
          and my $size = -s $fh )
      {
          my $buf;
          read $fh, $buf, $size; # File::Slurp in a nutshell
          return $buf;
      }
      else {
          local $/;
          return scalar <$fh>;
      }
  }
  
  sub slurp_raw { $_[1] = { binmode => ":unix" }; goto &slurp }
  
  sub slurp_utf8 {
      if ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() ) {
          return Unicode::UTF8::decode_utf8( slurp( $_[0], { binmode => ":unix" } ) );
      }
      else {
          $_[1] = { binmode => ":raw:encoding(UTF-8)" };
          goto &slurp;
      }
  }
  
  
  # XXX add "unsafe" option to disable flocking and atomic?  Check benchmarks on append() first.
  sub spew {
      my ( $self, @data ) = @_;
      my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
      $args = _get_args( $args, qw/binmode/ );
      my $binmode = $args->{binmode};
      $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
      my $temp = path( $self->[PATH] . $TID . $$ );
      my $fh = $temp->filehandle( ">", $binmode );
      require Fcntl;
      flock( $fh, Fcntl::LOCK_EX() ) or $self->_throw( 'flock (LOCK_EX)', $temp->[PATH] );
      seek( $fh, 0, Fcntl::SEEK_SET() ) or $self->_throw( 'seek', $temp->[PATH] );
      truncate( $fh, 0 ) or $self->_throw( 'truncate', $temp->[PATH] );
      print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
      flock( $fh, Fcntl::LOCK_UN() ) or $self->_throw( 'flock (LOCK_UN)', $temp->[PATH] );
      close $fh or $self->_throw( 'close', $temp->[PATH] );
  
      # spewing need to follow the link
      # and replace the destination instead
      my $resolved_path = $self->[PATH];
      $resolved_path = readlink $resolved_path while -l $resolved_path;
      return $temp->move($resolved_path);
  }
  
  sub spew_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &spew }
  
  sub spew_utf8 {
      if ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() ) {
          my $self = shift;
          spew( $self, { binmode => ":unix" }, map { Unicode::UTF8::encode_utf8($_) } @_ );
      }
      else {
          splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" };
          goto &spew;
      }
  }
  
  
  # XXX break out individual stat() components as subs?
  sub stat {
      my $self = shift;
      require File::stat;
      return File::stat::stat( $self->[PATH] ) || $self->_throw('stat');
  }
  
  sub lstat {
      my $self = shift;
      require File::stat;
      return File::stat::lstat( $self->[PATH] ) || $self->_throw('lstat');
  }
  
  
  sub stringify { $_[0]->[PATH] }
  
  
  sub touch {
      my ( $self, $epoch ) = @_;
      if ( !-e $self->[PATH] ) {
          my $fh = $self->openw;
          close $fh or $self->_throw('close');
      }
      $epoch = defined($epoch) ? $epoch : time();
      utime $epoch, $epoch, $self->[PATH]
        or $self->_throw("utime ($epoch)");
      return $self;
  }
  
  
  sub touchpath {
      my ($self) = @_;
      my $parent = $self->parent;
      $parent->mkpath unless $parent->exists;
      $self->touch;
  }
  
  
  sub volume {
      my ($self) = @_;
      $self->_splitpath unless defined $self->[VOL];
      return $self->[VOL];
  }
  
  package Path::Tiny::Error;
  
  our @CARP_NOT = qw/Path::Tiny/;
  
  use overload ( q{""} => sub { (shift)->{msg} }, fallback => 1 );
  
  sub throw {
      my ( $class, $op, $file, $err ) = @_;
      chomp( my $trace = Carp::shortmess );
      my $msg = "Error $op on '$file': $err$trace\n";
      die bless { op => $op, file => $file, err => $err, msg => $msg }, $class;
  }
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  Path::Tiny - File path utility
  
  =head1 VERSION
  
  version 0.035
  
  =head1 SYNOPSIS
  
    use Path::Tiny;
  
    # creating Path::Tiny objects
  
    $dir = path("/tmp");
    $foo = path("foo.txt");
  
    $subdir = $dir->child("foo");
    $bar = $subdir->child("bar.txt");
  
    # stringifies as cleaned up path
  
    $file = path("./foo.txt");
    print $file; # "foo.txt"
  
    # reading files
  
    $guts = $file->slurp;
    $guts = $file->slurp_utf8;
  
    @lines = $file->lines;
    @lines = $file->lines_utf8;
  
    $head = $file->lines( {count => 1} );
  
    # writing files
  
    $bar->spew( @data );
    $bar->spew_utf8( @data );
  
    # reading directories
  
    for ( $dir->children ) { ... }
  
    $iter = $dir->iterator;
    while ( my $next = $iter->() ) { ... }
  
  =head1 DESCRIPTION
  
  This module attempts to provide a small, fast utility for working with
  file paths.  It is friendlier to use than L<File::Spec> and provides
  easy access to functions from several other core file handling modules.
  
  It doesn't attempt to be as full-featured as L<IO::All> or L<Path::Class>,
  nor does it try to work for anything except Unix-like and Win32 platforms.
  Even then, it might break if you try something particularly obscure or
  tortuous.  (Quick!  What does this mean: C<< ///../../..//./././a//b/.././c/././ >>?
  And how does it differ on Win32?)
  
  All paths are forced to have Unix-style forward slashes.  Stringifying
  the object gives you back the path (after some clean up).
  
  File input/output methods C<flock> handles before reading or writing,
  as appropriate.
  
  The C<*_utf8> methods (C<slurp_utf8>, C<lines_utf8>, etc.) operate in raw
  mode without CRLF translation.  Installing L<Unicode::UTF8> 0.58 or later
  will speed up several of them and is highly recommended.
  
  =head1 CONSTRUCTORS
  
  =head2 path
  
      $path = path("foo/bar");
      $path = path("/tmp", "file.txt"); # list
      $path = path(".");                # cwd
      $path = path("~user/file.txt");   # tilde processing
  
  Constructs a C<Path::Tiny> object.  It doesn't matter if you give a file or
  directory path.  It's still up to you to call directory-like methods only on
  directories and file-like methods only on files.  This function is exported
  automatically by default.
  
  The first argument must be defined and have non-zero length or an exception
  will be thrown.  This prevents subtle, dangerous errors with code like
  C<< path( maybe_undef() )->remove_tree >>.
  
  If the first component of the path is a tilde ('~') then the component will be
  replaced with the output of C<glob('~')>.  If the first component of the path
  is a tilde followed by a user name then the component will be replaced with
  output of C<glob('~username')>.  Behaviour for non-existent users depends on
  the output of C<glob> on the system.
  
  On Windows, if the path consists of a drive identifier without a path component
  (C<C:> or C<D:>), it will be expanded to the absolute path of the current
  directory on that volume using C<Cwd::getdcwd()>.
  
  =head2 new
  
      $path = Path::Tiny->new("foo/bar");
  
  This is just like C<path>, but with method call overhead.  (Why would you
  do that?)
  
  =head2 cwd
  
      $path = Path::Tiny->cwd; # path( Cwd::getcwd )
      $path = cwd; # optional export
  
  Gives you the absolute path to the current directory as a C<Path::Tiny> object.
  This is slightly faster than C<< path(".")->absolute >>.
  
  C<cwd> may be exported on request and used as a function instead of as a
  method.
  
  =head2 rootdir
  
      $path = Path::Tiny->rootdir; # /
      $path = rootdir;             # optional export 
  
  Gives you C<< File::Spec->rootdir >> as a C<Path::Tiny> object if you're too
  picky for C<path("/")>.
  
  C<rootdir> may be exported on request and used as a function instead of as a
  method.
  
  =head2 tempfile, tempdir
  
      $temp = Path::Tiny->tempfile( @options );
      $temp = Path::Tiny->tempdir( @options );
      $temp = tempfile( @options ); # optional export
      $temp = tempdir( @options );  # optional export
  
  C<tempfile> passes the options to C<< File::Temp->new >> and returns a C<Path::Tiny>
  object with the file name.  The C<TMPDIR> option is enabled by default.
  
  The resulting C<File::Temp> object is cached. When the C<Path::Tiny> object is
  destroyed, the C<File::Temp> object will be as well.
  
  C<File::Temp> annoyingly requires you to specify a custom template in slightly
  different ways depending on which function or method you call, but
  C<Path::Tiny> lets you ignore that and can take either a leading template or a
  C<TEMPLATE> option and does the right thing.
  
      $temp = Path::Tiny->tempfile( "customXXXXXXXX" );             # ok
      $temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok
  
  The tempfile path object will normalized to have an absolute path, even if
  created in a relative directory using C<DIR>.
  
  C<tempdir> is just like C<tempfile>, except it calls
  C<< File::Temp->newdir >> instead.
  
  Both C<tempfile> and C<tempdir> may be exported on request and used as
  functions instead of as methods.
  
  =head1 METHODS
  
  =head2 absolute
  
      $abs = path("foo/bar")->absolute;
      $abs = path("foo/bar")->absolute("/tmp");
  
  Returns a new C<Path::Tiny> object with an absolute path.  Unless
  an argument is given, the current directory is used as the absolute base path.
  The argument must be absolute or you won't get an absolute result.
  
  This will not resolve upward directories ("foo/../bar") unless C<canonpath>
  in L<File::Spec> would normally do so on your platform.  If you need them
  resolved, you must call the more expensive C<realpath> method instead.
  
  =head2 append, append_raw, append_utf8
  
      path("foo.txt")->append(@data);
      path("foo.txt")->append(\@data);
      path("foo.txt")->append({binmode => ":raw"}, @data);
      path("foo.txt")->append_raw(@data);
      path("foo.txt")->append_utf8(@data);
  
  Appends data to a file.  The file is locked with C<flock> prior to writing.  An
  optional hash reference may be used to pass options.  The only option is
  C<binmode>, which is passed to C<binmode()> on the handle used for writing.
  
  C<append_raw> is like C<append> with a C<binmode> of C<:unix> for fast,
  unbuffered, raw write.
  
  C<append_utf8> is like C<append> with a C<binmode> of
  C<:unix:encoding(UTF-8)>.  If L<Unicode::UTF8> 0.58+ is installed, a raw
  append will be done instead on the data encoded with C<Unicode::UTF8>.
  
  =head2 basename
  
      $name = path("foo/bar.txt")->basename; # bar.txt
  
  Returns the file portion or last directory portion of a path.
  
  =head2 canonpath
  
      $canonical = path("foo/bar")->canonpath; # foo\bar on Windows
  
  Returns a string with the canonical format of the path name for
  the platform.  In particular, this means directory separators
  will be C<\> on Windows.
  
  =head2 child
  
      $file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt"
      $file = path("/tmp")->child(@parts);
  
  Returns a new C<Path::Tiny> object relative to the original.  Works
  like C<catfile> or C<catdir> from File::Spec, but without caring about
  file or directories.
  
  =head2 children
  
      @paths = path("/tmp")->children;
      @paths = path("/tmp")->children( qr/\.txt$/ );
  
  Returns a list of C<Path::Tiny> objects for all files and directories
  within a directory.  Excludes "." and ".." automatically.
  
  If an optional C<qr//> argument is provided, it only returns objects for child
  names that match the given regular expression.  Only the base name is used
  for matching:
  
      @paths = path("/tmp")->children( qr/^foo/ );
      # matches children like the glob foo*
  
  =head2 copy
  
      path("/tmp/foo.txt")->copy("/tmp/bar.txt");
  
  Copies a file using L<File::Copy>'s C<copy> function.
  
  =head2 digest
  
      $obj = path("/tmp/foo.txt")->digest;        # SHA-256
      $obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected
  
  Returns a hexadecimal digest for a file.  Any arguments are passed to the
  constructor for L<Digest> to select an algorithm.  If no arguments are given,
  the default is SHA-256.
  
  =head2 dirname
  
      $name = path("/tmp/foo.txt")->dirname; # "/tmp/"
  
  Returns the directory name portion of the path.  This is roughly
  equivalent to what L<File::Spec> would give from C<splitpath> and thus
  usually has the trailing slash. If that's not desired, stringify directories
  or call C<parent> on files.
  
  =head2 exists, is_file, is_dir
  
      if ( path("/tmp")->exists ) { ... }
      if ( path("/tmp")->is_file ) { ... }
      if ( path("/tmp")->is_dir ) { ... }
  
  Just like C<-e>, C<-f> or C<-d>.  This means the file or directory actually has to
  exist on the filesystem.  Until then, it's just a path.
  
  =head2 filehandle
  
      $fh = path("/tmp/foo.txt")->filehandle($mode, $binmode);
  
  Returns an open file handle.  The C<$mode> argument must be a Perl-style
  read/write mode string ("<" ,">", "<<", etc.).  If a C<$binmode>
  is given, it is set during the C<open> call.
  
  See C<openr>, C<openw>, C<openrw>, and C<opena> for sugar.
  
  =head2 is_absolute, is_relative
  
      if ( path("/tmp")->is_absolute ) { ... }
      if ( path("/tmp")->is_relative ) { ... }
  
  Booleans for whether the path appears absolute or relative.
  
  =head2 iterator
  
      $iter = path("/tmp")->iterator( \%options );
  
  Returns a code reference that walks a directory lazily.  Each invocation
  returns a C<Path::Tiny> object or undef when the iterator is exhausted.
  
      $iter = path("/tmp")->iterator;
      while ( $path = $iter->() ) {
          ...
      }
  
  The current and parent directory entries ("." and "..") will not
  be included.
  
  If the C<recurse> option is true, the iterator will walk the directory
  recursively, breadth-first.  If the C<follow_symlinks> option is also true,
  directory links will be followed recursively.  There is no protection against
  loops when following links.
  
  The default is the same as:
  
      $iter = path("/tmp")->iterator( {
          recurse         => 0,
          follow_symlinks => 0,
      } );
  
  For a more powerful, recursive iterator with built-in loop avoidance, see
  L<Path::Iterator::Rule>.
  
  =head2 lines, lines_raw, lines_utf8
  
      @contents = path("/tmp/foo.txt")->lines;
      @contents = path("/tmp/foo.txt")->lines(\%options);
      @contents = path("/tmp/foo.txt")->lines_raw;
      @contents = path("/tmp/foo.txt")->lines_utf8;
  
      @contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } );
  
  Returns a list of lines from a file.  Optionally takes a hash-reference of
  options.  Valid options are C<binmode>, C<count> and C<chomp>.  If C<binmode>
  is provided, it will be set on the handle prior to reading.  If C<count> is
  provided, up to that many lines will be returned. If C<chomp> is set, lines
  will be chomped before being returned.
  
  Because the return is a list, C<lines> in scalar context will return the number
  of lines (and throw away the data).
  
      $number_of_lines = path("/tmp/foo.txt")->lines;
  
  C<lines_raw> is like C<lines> with a C<binmode> of C<:raw>.  We use C<:raw>
  instead of C<:unix> so PerlIO buffering can manage reading by line.
  
  C<lines_utf8> is like C<lines> with a C<binmode> of
  C<:raw:encoding(UTF-8)>.  If L<Unicode::UTF8> 0.58+ is installed, a raw
  UTF-8 slurp will be done and then the lines will be split.  This is
  actually faster than relying on C<:encoding(UTF-8)>, though a bit memory
  intensive.  If memory use is a concern, consider C<openr_utf8> and
  iterating directly on the handle.
  
  =head2 mkpath
  
      path("foo/bar/baz")->mkpath;
      path("foo/bar/baz")->mkpath( \%options );
  
  Like calling C<make_path> from L<File::Path>.  An optional hash reference
  is passed through to C<make_path>.  Errors will be trapped and an exception
  thrown.  Returns the list of directories created or an empty list if
  the directories already exist, just like C<make_path>.
  
  =head2 move
  
      path("foo.txt")->move("bar.txt");
  
  Just like C<rename>.
  
  =head2 openr, openw, openrw, opena
  
      $fh = path("foo.txt")->openr($binmode);  # read
      $fh = path("foo.txt")->openr_raw;
      $fh = path("foo.txt")->openr_utf8;
  
      $fh = path("foo.txt")->openw($binmode);  # write
      $fh = path("foo.txt")->openw_raw;
      $fh = path("foo.txt")->openw_utf8;
  
      $fh = path("foo.txt")->opena($binmode);  # append
      $fh = path("foo.txt")->opena_raw;
      $fh = path("foo.txt")->opena_utf8;
  
      $fh = path("foo.txt")->openrw($binmode); # read/write
      $fh = path("foo.txt")->openrw_raw;
      $fh = path("foo.txt")->openrw_utf8;
  
  Returns a file handle opened in the specified mode.  The C<openr> style methods
  take a single C<binmode> argument.  All of the C<open*> methods have
  C<open*_raw> and C<open*_utf8> equivalents that use C<:raw> and
  C<:raw:encoding(UTF-8)>, respectively.
  
  =head2 parent
  
      $parent = path("foo/bar/baz")->parent; # foo/bar
      $parent = path("foo/wibble.txt")->parent; # foo
  
      $parent = path("foo/bar/baz")->parent(2); # foo
  
  Returns a C<Path::Tiny> object corresponding to the parent directory of the
  original directory or file. An optional positive integer argument is the number
  of parent directories upwards to return.  C<parent> by itself is equivalent to
  C<parent(1)>.
  
  =head2 realpath
  
      $real = path("/baz/foo/../bar")->realpath;
      $real = path("foo/../bar")->realpath;
  
  Returns a new C<Path::Tiny> object with all symbolic links and upward directory
  parts resolved using L<Cwd>'s C<realpath>.  Compared to C<absolute>, this is
  more expensive as it must actually consult the filesystem.
  
  =head2 relative
  
      $rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar
  
  Returns a C<Path::Tiny> object with a relative path name.
  Given the trickiness of this, it's a thin wrapper around
  C<< File::Spec->abs2rel() >>.
  
  =head2 remove
  
      path("foo.txt")->remove;
  
  B<Note: as of 0.012, remove only works on files>.
  
  This is just like C<unlink>, except if the path does not exist, it returns
  false rather than throwing an exception.
  
  =head2 remove_tree
  
      # directory
      path("foo/bar/baz")->remove_tree;
      path("foo/bar/baz")->remove_tree( \%options );
      path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove
  
  Like calling C<remove_tree> from L<File::Path>, but defaults to C<safe> mode.
  An optional hash reference is passed through to C<remove_tree>.  Errors will be
  trapped and an exception thrown.  Returns the number of directories deleted,
  just like C<remove_tree>.
  
  If you want to remove a directory only if it is empty, use the built-in
  C<rmdir> function instead.
  
      rmdir path("foo/bar/baz/");
  
  =head2 slurp, slurp_raw, slurp_utf8
  
      $data = path("foo.txt")->slurp;
      $data = path("foo.txt")->slurp( {binmode => ":raw"} );
      $data = path("foo.txt")->slurp_raw;
      $data = path("foo.txt")->slurp_utf8;
  
  Reads file contents into a scalar.  Takes an optional hash reference may be
  used to pass options.  The only option is C<binmode>, which is passed to
  C<binmode()> on the handle used for reading.
  
  C<slurp_raw> is like C<slurp> with a C<binmode> of C<:unix> for
  a fast, unbuffered, raw read.
  
  C<slurp_utf8> is like C<slurp> with a C<binmode> of
  C<:unix:encoding(UTF-8)>.  If L<Unicode::UTF8> 0.58+ is installed, a raw
  slurp will be done instead and the result decoded with C<Unicode::UTF8>.
  This is just as strict and is roughly an order of magnitude faster than
  using C<:encoding(UTF-8)>.
  
  =head2 spew, spew_raw, spew_utf8
  
      path("foo.txt")->spew(@data);
      path("foo.txt")->spew(\@data);
      path("foo.txt")->spew({binmode => ":raw"}, @data);
      path("foo.txt")->spew_raw(@data);
      path("foo.txt")->spew_utf8(@data);
  
  Writes data to a file atomically.  The file is written to a temporary file in
  the same directory, then renamed over the original.  An optional hash reference
  may be used to pass options.  The only option is C<binmode>, which is passed to
  C<binmode()> on the handle used for writing.
  
  C<spew_raw> is like C<spew> with a C<binmode> of C<:unix> for a fast,
  unbuffered, raw write.
  
  C<spew_utf8> is like C<spew> with a C<binmode> of C<:unix:encoding(UTF-8)>.
  If L<Unicode::UTF8> 0.58+ is installed, a raw spew will be done instead on
  the data encoded with C<Unicode::UTF8>.
  
  =head2 stat, lstat
  
      $stat = path("foo.txt")->stat;
      $stat = path("/some/symlink")->lstat;
  
  Like calling C<stat> or C<lstat> from L<File::stat>.
  
  =head2 stringify
  
      $path = path("foo.txt");
      say $path->stringify; # same as "$path"
  
  Returns a string representation of the path.  Unlike C<canonpath>, this method
  returns the path standardized with Unix-style C</> directory separators.
  
  =head2 touch
  
      path("foo.txt")->touch;
      path("foo.txt")->touch($epoch_secs);
  
  Like the Unix C<touch> utility.  Creates the file if it doesn't exist, or else
  changes the modification and access times to the current time.  If the first
  argument is the epoch seconds then it will be used.
  
  Returns the path object so it can be easily chained with spew:
  
      path("foo.txt")->touch->spew( $content );
  
  =head2 touchpath
  
      path("bar/baz/foo.txt")->touchpath;
  
  Combines C<mkpath> and C<touch>.  Creates the parent directory if it doesn't exist,
  before touching the file.  Returns the path object like C<touch> does.
  
  =head2 volume
  
      $vol = path("/tmp/foo.txt")->volume;
  
  Returns the volume portion of the path.  This is equivalent
  equivalent to what L<File::Spec> would give from C<splitpath> and thus
  usually is the empty string on Unix-like operating systems.
  
  =for Pod::Coverage openr_utf8 opena_utf8 openw_utf8 openrw_utf8
  openr_raw opena_raw openw_raw openrw_raw
  DOES
  
  =head1 EXCEPTION HANDLING
  
  Failures will be thrown as exceptions in the class C<Path::Tiny::Error>.
  
  The object will be a hash reference with the following fields:
  
  =over 4
  
  =item *
  
  C<op> — a description of the operation, usually function call and any extra info
  
  =item *
  
  C<file> — the file or directory relating to the error
  
  =item *
  
  C<err> — hold C<$!> at the time the error was thrown
  
  =item *
  
  C<msg> — a string combining the above data and a Carp-like short stack trace
  
  =back
  
  Exception objects will stringify as the C<msg> field.
  
  =head1 CAVEATS
  
  =head2 NFS and BSD
  
  On BSD, Perl's flock implementation may not work to lock files on an
  NFS filesystem.  Path::Tiny has some heuristics to detect this
  and will warn once and let you continue in an unsafe mode.  If you
  want this failure to be fatal, you can fatalize the 'flock' warnings
  category:
  
      use warnings FATAL => 'flock';
  
  =head2 utf8 vs UTF-8
  
  All the C<*_utf8> methods use C<:encoding(UTF-8)> -- either as
  C<:unix:encoding(UTF-8)> (unbuffered) or C<:raw:encoding(UTF-8)> (buffered) --
  which is strict against the Unicode spec and disallows illegal Unicode
  codepoints or UTF-8 sequences.
  
  Unfortunately, C<:encoding(UTF-8)> is very, very slow.  If you install
  L<Unicode::UTF8> 0.58 or later, that module will be used by some C<*_utf8>
  methods to encode or decode data after a raw, binary input/output operation,
  which is much faster.
  
  If you need the performance and can accept the security risk,
  C<< slurp({binmode => ":unix:utf8"}) >> will be faster than C<:unix:encoding(UTF-8)>
  (but not as fast as C<Unicode::UTF8>).
  
  Note that the C<*_utf8> methods read in B<raw> mode.  There is no CRLF
  translation on Windows.  If you must have CRLF translation, use the regular
  input/output methods with an appropriate binmode:
  
    $path->spew_utf8($data);                            # raw
    $path->spew({binmode => ":encoding(UTF-8)"}, $data; # LF -> CRLF
  
  Consider L<PerlIO::utf8_strict> for a faster L<PerlIO> layer alternative to
  C<:encoding(UTF-8)>, though it does not appear to be as fast as the
  C<Unicode::UTF8> approach.
  
  =head2 Default IO layers and the open pragma
  
  If you have Perl 5.10 or later, file input/output methods (C<slurp>, C<spew>,
  etc.) and high-level handle opening methods ( C<openr>, C<openw>, etc. but not
  C<filehandle>) respect default encodings set by the C<-C> switch or lexical
  L<open> settings of the caller.  For UTF-8, this is almost certainly slower
  than using the dedicated C<_utf8> methods if you have L<Unicode::UTF8>.
  
  =head1 TYPE CONSTRAINTS AND COERCION
  
  A standard L<MooseX::Types> library is available at
  L<MooseX::Types::Path::Tiny>.
  
  =head1 SEE ALSO
  
  These are other file/path utilities, which may offer a different feature
  set than C<Path::Tiny>.
  
  =over 4
  
  =item *
  
  L<File::Fu>
  
  =item *
  
  L<IO::All>
  
  =item *
  
  L<Path::Class>
  
  =back
  
  These iterators may be slightly faster than the recursive iterator in
  C<Path::Tiny>:
  
  =over 4
  
  =item *
  
  L<Path::Iterator::Rule>
  
  =item *
  
  L<File::Next>
  
  =back
  
  There are probably comparable, non-Tiny tools.  Let me know if you want me to
  add a module to the list.
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<https://github.com/dagolden/Path-Tiny/issues>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/dagolden/Path-Tiny>
  
    git clone https://github.com/dagolden/Path-Tiny.git
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Chris Williams <bingos@cpan.org>
  
  =item *
  
  David Steinbrunner <dsteinbrunner@pobox.com>
  
  =item *
  
  Gabor Szabo <szabgab@cpan.org>
  
  =item *
  
  Gabriel Andrade <gabiruh@gmail.com>
  
  =item *
  
  George Hartzell <hartzell@cpan.org>
  
  =item *
  
  Goro Fuji <gfuji@cpan.org>
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  Keedi Kim <keedi@cpan.org>
  
  =item *
  
  Martin Kjeldsen <mk@bluepipe.dk>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Toby Inkster <tobyink@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
PATH_TINY

$fatpacked{"Sub/Defer.pm"} = <<'SUB_DEFER';
  package Sub::Defer;
  
  use strictures 1;
  use base qw(Exporter);
  use Moo::_Utils;
  
  our @EXPORT = qw(defer_sub undefer_sub);
  
  our %DEFERRED;
  
  sub undefer_sub {
    my ($deferred) = @_;
    my ($target, $maker, $undeferred_ref) = @{
      $DEFERRED{$deferred}||return $deferred
    };
    ${$undeferred_ref} = my $made = $maker->();
  
    # make sure the method slot has not changed since deferral time
    if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') {
      no warnings 'redefine';
  
      # I believe $maker already evals with the right package/name, so that
      # _install_coderef calls are not necessary --ribasushi
      *{_getglob($target)} = $made;
    }
    push @{$DEFERRED{$made} = $DEFERRED{$deferred}}, $made;
  
    return $made;
  }
  
  sub defer_info {
    my ($deferred) = @_;
    $DEFERRED{$deferred||''};
  }
  
  sub defer_sub {
    my ($target, $maker) = @_;
    my $undeferred;
    my $deferred_string;
    my $deferred = sub {
      goto &{$undeferred ||= undefer_sub($deferred_string)};
    };
    $deferred_string = "$deferred";
    $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ];
    _install_coderef($target => $deferred) if defined $target;
    return $deferred;
  }
  
  1;
  
  =head1 NAME
  
  Sub::Defer - defer generation of subroutines until they are first called
  
  =head1 SYNOPSIS
  
   use Sub::Defer;
  
   my $deferred = defer_sub 'Logger::time_since_first_log' => sub {
      my $t = time;
      sub { time - $t };
   };
  
    Logger->time_since_first_log; # returns 0 and replaces itself
    Logger->time_since_first_log; # returns time - $t
  
  =head1 DESCRIPTION
  
  These subroutines provide the user with a convenient way to defer creation of
  subroutines and methods until they are first called.
  
  =head1 SUBROUTINES
  
  =head2 defer_sub
  
   my $coderef = defer_sub $name => sub { ... };
  
  This subroutine returns a coderef that encapsulates the provided sub - when
  it is first called, the provided sub is called and is -itself- expected to
  return a subroutine which will be goto'ed to on subsequent calls.
  
  If a name is provided, this also installs the sub as that name - and when
  the subroutine is undeferred will re-install the final version for speed.
  
  =head2 undefer_sub
  
   my $coderef = undefer_sub \&Foo::name;
  
  If the passed coderef has been L<deferred|/defer_sub> this will "undefer" it.
  If the passed coderef has not been deferred, this will just return it.
  
  If this is confusing, take a look at the example in the L</SYNOPSIS>.
  
  =head1 SUPPORT
  
  See L<Moo> for support and contact informations.
  
  =head1 AUTHORS
  
  See L<Moo> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Moo> for the copyright and license.
SUB_DEFER

$fatpacked{"Sub/Exporter/Progressive.pm"} = <<'SUB_EXPORTER_PROGRESSIVE';
  package Sub::Exporter::Progressive;
  
  use strict;
  use warnings;
  
  our $VERSION = '0.001010';
  
  use Carp 'croak';
  use List::Util 'first';
  
  sub import {
     my ($self, @args) = @_;
  
     my $inner_target = caller;
     my $export_data = sub_export_options($inner_target, @args);
  
     my $full_exporter;
     no strict 'refs';
     @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
     @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
     %{"${inner_target}::EXPORT_TAGS"} = %{$export_data->{tags}};
     *{"${inner_target}::import"} = sub {
        use strict;
        my ($self, @args) = @_;
  
        if (first { ref || !m/ \A [:-]? \w+ \z /xm } @args) {
           croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed'
              unless eval { require Sub::Exporter };
           $full_exporter ||= Sub::Exporter::build_exporter($export_data->{original});
  
           goto $full_exporter;
        } elsif (defined(my $num = first { !ref and m/^\d/ } @args)) {
           die "cannot export symbols with a leading digit: '$num'";
        } else {
           require Exporter;
           s/ \A - /:/xm for @args;
           @_ = ($self, @args);
           goto \&Exporter::import;
        }
     };
     return;
  }
  
  my $too_complicated = <<'DEATH';
  You are using Sub::Exporter::Progressive, but the features your program uses from
  Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well
  just use vanilla Sub::Exporter
  DEATH
  
  sub sub_export_options {
     my ($inner_target, $setup, $options) = @_;
  
     my @exports;
     my @defaults;
     my %tags;
  
     if ($setup eq '-setup') {
        my %options = %$options;
  
        OPTIONS:
        for my $opt (keys %options) {
           if ($opt eq 'exports') {
  
              croak $too_complicated if ref $options{exports} ne 'ARRAY';
              @exports = @{$options{exports}};
              croak $too_complicated if first { ref } @exports;
  
           } elsif ($opt eq 'groups') {
              %tags = %{$options{groups}};
              for my $tagset (values %tags) {
                 croak $too_complicated if first { / \A - (?! all \b ) /x || ref } @{$tagset};
              }
              @defaults = @{$tags{default} || [] };
           } else {
              croak $too_complicated;
           }
        }
        @{$_} = map { / \A  [:-] all \z /x ? @exports : $_ } @{$_} for \@defaults, values %tags;
        $tags{all} ||= [ @exports ];
        my %exports = map { $_ => 1 } @exports;
        my @errors = grep { not $exports{$_} } @defaults;
        croak join(', ', @errors) . " is not exported by the $inner_target module\n" if @errors;
     }
  
     return {
        exports => \@exports,
        defaults => \@defaults,
        original => $options,
        tags => \%tags,
     };
  }
  
  1;
  
  =encoding utf8
  
  =head1 NAME
  
  Sub::Exporter::Progressive - Only use Sub::Exporter if you need it
  
  =head1 SYNOPSIS
  
   package Syntax::Keyword::Gather;
  
   use Sub::Exporter::Progressive -setup => {
     exports => [qw( break gather gathered take )],
     groups => {
       defaults => [qw( break gather gathered take )],
     },
   };
  
   # elsewhere
  
   # uses Exporter for speed
   use Syntax::Keyword::Gather;
  
   # somewhere else
  
   # uses Sub::Exporter for features
   use Syntax::Keyword::Gather 'gather', take => { -as => 'grab' };
  
  =head1 DESCRIPTION
  
  L<Sub::Exporter> is an incredibly powerful module, but with that power comes
  great responsibility, er- as well as some runtime penalties.  This module
  is a C<Sub::Exporter> wrapper that will let your users just use L<Exporter>
  if all they are doing is picking exports, but use C<Sub::Exporter> if your
  users try to use C<Sub::Exporter>'s more advanced features features, like
  renaming exports, if they try to use them.
  
  Note that this module will export C<@EXPORT>, C<@EXPORT_OK> and
  C<%EXPORT_TAGS> package variables for C<Exporter> to work.  Additionally, if
  your package uses advanced C<Sub::Exporter> features like currying, this module
  will only ever use C<Sub::Exporter>, so you might as well use it directly.
  
  =head1 AUTHOR
  
  frew - Arthur Axel Schmidt (cpan:FREW) <frioux+cpan@gmail.com>
  
  =head1 CONTRIBUTORS
  
  ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  leont - Leon Timmermans (cpan:LEONT) <leont@cpan.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2012 the Sub::Exporter::Progressive L</AUTHOR> and
  L</CONTRIBUTORS> as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
SUB_EXPORTER_PROGRESSIVE

$fatpacked{"Sub/Quote.pm"} = <<'SUB_QUOTE';
  package Sub::Quote;
  
  use strictures 1;
  
  sub _clean_eval { eval $_[0] }
  
  use Sub::Defer;
  use B 'perlstring';
  use Scalar::Util qw(weaken);
  use base qw(Exporter);
  
  our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub);
  
  our %QUOTED;
  
  our %WEAK_REFS;
  
  sub capture_unroll {
    my ($from, $captures, $indent) = @_;
    join(
      '',
      map {
        /^([\@\%\$])/
          or die "capture key should start with \@, \% or \$: $_";
        (' ' x $indent).qq{my ${_} = ${1}{${from}->{${\perlstring $_}}};\n};
      } keys %$captures
    );
  }
  
  sub inlinify {
    my ($code, $args, $extra, $local) = @_;
    my $do = 'do { '.($extra||'');
    if (my ($code_args, $body) = $code =~ / +my \(([^)]+)\) = \@_;(.*)$/s) {
      if ($code_args eq $args) {
        $do.$body.' }'
      } else {
        $do.'my ('.$code_args.') = ('.$args.'); '.$body.' }';
      }
    } else {
      my $assign = '';
      if ($local || $args ne '@_') {
        $assign = ($local ? 'local ' : '').'@_ = ('.$args.'); ';
      }
      $do.$assign.$code.' }';
    }
  }
  
  sub quote_sub {
    # HOLY DWIMMERY, BATMAN!
    # $name => $code => \%captures => \%options
    # $name => $code => \%captures
    # $name => $code
    # $code => \%captures => \%options
    # $code
    my $options =
      (ref($_[-1]) eq 'HASH' and ref($_[-2]) eq 'HASH')
        ? pop
        : {};
    my $captures = pop if ref($_[-1]) eq 'HASH';
    undef($captures) if $captures && !keys %$captures;
    my $code = pop;
    my $name = $_[0];
    my $outstanding;
    my $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub {
      unquote_sub($outstanding);
    };
    $outstanding = "$deferred";
    $QUOTED{$outstanding} = [ $name, $code, $captures ];
    weaken($WEAK_REFS{$outstanding} = $deferred);
    return $deferred;
  }
  
  sub quoted_from_sub {
    my ($sub) = @_;
    $WEAK_REFS{$sub||''} and $QUOTED{$sub||''};
  }
  
  sub unquote_sub {
    my ($sub) = @_;
    unless ($QUOTED{$sub}[3]) {
      my ($name, $code, $captures) = @{$QUOTED{$sub}};
  
      my $make_sub = "{\n";
  
      if (keys %$captures) {
        $make_sub .= capture_unroll("\$_[1]", $captures, 2);
      }
  
      my $o_quoted = perlstring $sub;
      $make_sub .= (
        $name
            # disable the 'variable $x will not stay shared' warning since
            # we're not letting it escape from this scope anyway so there's
            # nothing trying to share it
          ? "  no warnings 'closure';\n  sub ${name} {\n"
          : "  \$Sub::Quote::QUOTED{${o_quoted}}[3] = sub {\n"
      );
      $make_sub .= $code;
      $make_sub .= "  }".($name ? '' : ';')."\n";
      if ($name) {
        $make_sub .= "  \$Sub::Quote::QUOTED{${o_quoted}}[3] = \\&${name}\n";
      }
      $make_sub .= "}\n1;\n";
      $ENV{SUB_QUOTE_DEBUG} && warn $make_sub;
      {
        local $@;
        no strict 'refs';
        local *{$name} if $name;
        unless (_clean_eval $make_sub, $captures) {
          die "Eval went very, very wrong:\n\n${make_sub}\n\n$@";
        }
      }
    }
    $QUOTED{$sub}[3];
  }
  
  1;
  
  =head1 NAME
  
  Sub::Quote - efficient generation of subroutines via string eval
  
  =head1 SYNOPSIS
  
   package Silly;
  
   use Sub::Quote qw(quote_sub unquote_sub quoted_from_sub);
  
   quote_sub 'Silly::kitty', q{ print "meow" };
  
   quote_sub 'Silly::doggy', q{ print "woof" };
  
   my $sound = 0;
  
   quote_sub 'Silly::dagron',
     q{ print ++$sound % 2 ? 'burninate' : 'roar' },
     { '$sound' => \$sound };
  
  And elsewhere:
  
   Silly->kitty;  # meow
   Silly->doggy;  # woof
   Silly->dagron; # burninate
   Silly->dagron; # roar
   Silly->dagron; # burninate
  
  =head1 DESCRIPTION
  
  This package provides performant ways to generate subroutines from strings.
  
  =head1 SUBROUTINES
  
  =head2 quote_sub
  
   my $coderef = quote_sub 'Foo::bar', q{ print $x++ . "\n" }, { '$x' => \0 };
  
  Arguments: ?$name, $code, ?\%captures, ?\%options
  
  C<$name> is the subroutine where the coderef will be installed.
  
  C<$code> is a string that will be turned into code.
  
  C<\%captures> is a hashref of variables that will be made available to the
  code.  See the L</SYNOPSIS>'s C<Silly::dagron> for an example using captures.
  
  =head3 options
  
  =over 2
  
  =item * no_install
  
  B<Boolean>.  Set this option to not install the generated coderef into the
  passed subroutine name on undefer.
  
  =back
  
  =head2 unquote_sub
  
   my $coderef = unquote_sub $sub;
  
  Forcibly replace subroutine with actual code.  Note that for performance
  reasons all quoted subs declared so far will be globally unquoted/parsed in
  a single eval. This means that if you have a syntax error in one of your
  quoted subs you may find out when some other sub is unquoted.
  
  If $sub is not a quoted sub, this is a no-op.
  
  =head2 quoted_from_sub
  
   my $data = quoted_from_sub $sub;
  
   my ($name, $code, $captures, $compiled_sub) = @$data;
  
  Returns original arguments to quote_sub, plus the compiled version if this
  sub has already been unquoted.
  
  Note that $sub can be either the original quoted version or the compiled
  version for convenience.
  
  =head2 inlinify
  
   my $prelude = capture_unroll {
     '$x' => 1,
     '$y' => 2,
   };
  
   my $inlined_code = inlinify q{
     my ($x, $y) = @_;
  
     print $x + $y . "\n";
   }, '$x, $y', $prelude;
  
  Takes a string of code, a string of arguments, a string of code which acts as a
  "prelude", and a B<Boolean> representing whether or not to localize the
  arguments.
  
  =head2 capture_unroll
  
   my $prelude = capture_unroll {
     '$x' => 1,
     '$y' => 2,
   };
  
  Generates a snippet of code which is suitable to be used as a prelude for
  L</inlinify>.  The keys are the names of the variables and the values are (duh)
  the values.  Note that references work as values.
  
  =head1 CAVEATS
  
  Much of this is just string-based code-generation, and as a result, a few caveats
  apply.
  
  =head2 return
  
  Calling C<return> from a quote_sub'ed sub will not likely do what you intend.
  Instead of returning from the code you defined in C<quote_sub>, it will return
  from the overall function it is composited into.
  
  So when you pass in:
  
     quote_sub q{  return 1 if $condition; $morecode }
  
  It might turn up in the intended context as follows:
  
    sub foo {
  
      <important code a>
      do {
        return 1 if $condition;
        $morecode
      };
      <important code b>
  
    }
  
  Which will obviously return from foo, when all you meant to do was return from
  the code context in quote_sub and proceed with running important code b.
  
  =head1 SUPPORT
  
  See L<Moo> for support and contact informations.
  
  =head1 AUTHORS
  
  See L<Moo> for authors.
  
  =head1 COPYRIGHT AND LICENSE
  
  See L<Moo> for the copyright and license.
SUB_QUOTE

$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.12";
  
  $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__
  
  =pod
  
  =head1 NAME
  
  Try::Tiny - minimal try/catch with proper localization of $@
  
  =head1 SYNOPSIS
  
  You can use Try::Tiny's C<try> and C<catch> to expect and handle exceptional
  conditions, avoiding quirks in Perl and common mistakes:
  
  	# handle errors with a catch handler
  	try {
  		die "foo";
  	} catch {
  		warn "caught error: $_"; # not $@
  	};
  
  You can also use it like a standalone C<eval> to catch and ignore any error
  conditions.  Obviously, this is an extreme measure not to be undertaken
  lightly:
  
  	# just silence errors
  	try {
  		die "foo";
  	};
  
  =head1 DESCRIPTION
  
  This module provides bare bones C<try>/C<catch>/C<finally> statements that are designed to
  minimize common mistakes with eval blocks, and NOTHING else.
  
  This is unlike L<TryCatch> which provides a nice syntax and avoids adding
  another call stack layer, and supports calling C<return> from the C<try> block to
  return from the parent subroutine. These extra features come at a cost of a few
  dependencies, namely L<Devel::Declare> and L<Scope::Upper> which are
  occasionally problematic, and the additional catch filtering uses L<Moose>
  type constraints which may not be desirable either.
  
  The main focus of this module is to provide simple and reliable error handling
  for those having a hard time installing L<TryCatch>, but who still want to
  write correct C<eval> blocks without 5 lines of boilerplate each time.
  
  It's designed to work as correctly as possible in light of the various
  pathological edge cases (see L</BACKGROUND>) and to be compatible with any style
  of error values (simple strings, references, objects, overloaded objects, etc).
  
  If the C<try> block dies, it returns the value of the last statement executed in
  the C<catch> block, if there is one. Otherwise, it returns C<undef> in scalar
  context or the empty list in list context. The following examples all
  assign C<"bar"> to C<$x>:
  
  	my $x = try { die "foo" } catch { "bar" };
  	my $x = try { die "foo" } || { "bar" };
  	my $x = (try { die "foo" }) // { "bar" };
  
  	my $x = eval { die "foo" } || "bar";
  
  You can add C<finally> blocks, yielding the following:
  
  	my $x;
  	try { die 'foo' } finally { $x = 'bar' };
  	try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' };
  
  C<finally> blocks are always executed making them suitable for cleanup code
  which cannot be handled using local.  You can add as many C<finally> blocks to a
  given C<try> block as you like.
  
  =head1 EXPORTS
  
  All functions are exported by default using L<Exporter>.
  
  If you need to rename the C<try>, C<catch> or C<finally> keyword consider using
  L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
  
  =over 4
  
  =item try (&;@)
  
  Takes one mandatory C<try> subroutine, an optional C<catch> subroutine and C<finally>
  subroutine.
  
  The mandatory subroutine is evaluated in the context of an C<eval> block.
  
  If no error occurred the value from the first block is returned, preserving
  list/scalar context.
  
  If there was an error and the second subroutine was given it will be invoked
  with the error in C<$_> (localized) and as that block's first and only
  argument.
  
  C<$@> does B<not> contain the error. Inside the C<catch> block it has the same
  value it had before the C<try> block was executed.
  
  Note that the error may be false, but if that happens the C<catch> block will
  still be invoked.
  
  Once all execution is finished then the C<finally> block, if given, will execute.
  
  =item catch (&;$)
  
  Intended to be used in the second argument position of C<try>.
  
  Returns a reference to the subroutine it was given but blessed as
  C<Try::Tiny::Catch> which allows try to decode correctly what to do
  with this code reference.
  
  	catch { ... }
  
  Inside the C<catch> block the caught error is stored in C<$_>, while previous
  value of C<$@> is still available for use.  This value may or may not be
  meaningful depending on what happened before the C<try>, but it might be a good
  idea to preserve it in an error stack.
  
  For code that captures C<$@> when throwing new errors (i.e.
  L<Class::Throwable>), you'll need to do:
  
  	local $@ = $_;
  
  =item finally (&;$)
  
    try     { ... }
    catch   { ... }
    finally { ... };
  
  Or
  
    try     { ... }
    finally { ... };
  
  Or even
  
    try     { ... }
    finally { ... }
    catch   { ... };
  
  Intended to be the second or third element of C<try>. C<finally> blocks are always
  executed in the event of a successful C<try> or if C<catch> is run. This allows
  you to locate cleanup code which cannot be done via C<local()> e.g. closing a file
  handle.
  
  When invoked, the C<finally> block is passed the error that was caught.  If no
  error was caught, it is passed nothing.  (Note that the C<finally> block does not
  localize C<$_> with the error, since unlike in a C<catch> block, there is no way
  to know if C<$_ == undef> implies that there were no errors.) In other words,
  the following code does just what you would expect:
  
    try {
      die_sometimes();
    } catch {
      # ...code run in case of error
    } finally {
      if (@_) {
        print "The try block died with: @_\n";
      } else {
        print "The try block ran without error.\n";
      }
    };
  
  B<You must always do your own error handling in the C<finally> block>. C<Try::Tiny> will
  not do anything about handling possible errors coming from code located in these
  blocks.
  
  In the same way C<catch()> blesses the code reference this subroutine does the same
  except it bless them as C<Try::Tiny::Finally>.
  
  =back
  
  =head1 BACKGROUND
  
  There are a number of issues with C<eval>.
  
  =head2 Clobbering $@
  
  When you run an C<eval> block and it succeeds, C<$@> will be cleared, potentially
  clobbering an error that is currently being caught.
  
  This causes action at a distance, clearing previous errors your caller may have
  not yet handled.
  
  C<$@> must be properly localized before invoking C<eval> in order to avoid this
  issue.
  
  More specifically, C<$@> is clobbered at the beginning of the C<eval>, which
  also makes it impossible to capture the previous error before you die (for
  instance when making exception objects with error stacks).
  
  For this reason C<try> will actually set C<$@> to its previous value (before
  the localization) in the beginning of the C<eval> block.
  
  =head2 Localizing $@ silently masks errors
  
  Inside an C<eval> block, C<die> behaves sort of like:
  
  	sub die {
  		$@ = $_[0];
  		return_undef_from_eval();
  	}
  
  This means that if you were polite and localized C<$@> you can't die in that
  scope, or your error will be discarded (printing "Something's wrong" instead).
  
  The workaround is very ugly:
  
  	my $error = do {
  		local $@;
  		eval { ... };
  		$@;
  	};
  
  	...
  	die $error;
  
  =head2 $@ might not be a true value
  
  This code is wrong:
  
  	if ( $@ ) {
  		...
  	}
  
  because due to the previous caveats it may have been unset.
  
  C<$@> could also be an overloaded error object that evaluates to false, but
  that's asking for trouble anyway.
  
  The classic failure mode is:
  
  	sub Object::DESTROY {
  		eval { ... }
  	}
  
  	eval {
  		my $obj = Object->new;
  
  		die "foo";
  	};
  
  	if ( $@ ) {
  
  	}
  
  In this case since C<Object::DESTROY> is not localizing C<$@> but still uses
  C<eval>, it will set C<$@> to C<"">.
  
  The destructor is called when the stack is unwound, after C<die> sets C<$@> to
  C<"foo at Foo.pm line 42\n">, so by the time C<if ( $@ )> is evaluated it has
  been cleared by C<eval> in the destructor.
  
  The workaround for this is even uglier than the previous ones. Even though we
  can't save the value of C<$@> from code that doesn't localize, we can at least
  be sure the C<eval> was aborted due to an error:
  
  	my $failed = not eval {
  		...
  
  		return 1;
  	};
  
  This is because an C<eval> that caught a C<die> will always return a false
  value.
  
  =head1 SHINY SYNTAX
  
  Using Perl 5.10 you can use L<perlsyn/"Switch statements">.
  
  The C<catch> block is invoked in a topicalizer context (like a C<given> block),
  but note that you can't return a useful value from C<catch> using the C<when>
  blocks without an explicit C<return>.
  
  This is somewhat similar to Perl 6's C<CATCH> blocks. You can use it to
  concisely match errors:
  
  	try {
  		require Foo;
  	} catch {
  		when (/^Can't locate .*?\.pm in \@INC/) { } # ignore
  		default { die $_ }
  	};
  
  =head1 CAVEATS
  
  =over 4
  
  =item *
  
  C<@_> is not available within the C<try> block, so you need to copy your
  arglist. In case you want to work with argument values directly via C<@_>
  aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference:
  
  	sub foo {
  		my ( $self, @args ) = @_;
  		try { $self->bar(@args) }
  	}
  
  or
  
  	sub bar_in_place {
  		my $self = shift;
  		my $args = \@_;
  		try { $_ = $self->bar($_) for @$args }
  	}
  
  =item *
  
  C<return> returns from the C<try> block, not from the parent sub (note that
  this is also how C<eval> works, but not how L<TryCatch> works):
  
    sub parent_sub {
        try {
            die;
        }
        catch {
            return;
        };
  
        say "this text WILL be displayed, even though an exception is thrown";
    }
  
  Instead, you should capture the return value:
  
    sub parent_sub {
        my $success = try {
            die;
            1;
        }
        return unless $success;
  
        say "This text WILL NEVER appear!";
    }
  
  Note that if you have a C<catch> block, it must return C<undef> for this to work,
  since if a C<catch> block exists, its return value is returned in place of C<undef>
  when an exception is thrown.
  
  =item *
  
  C<try> introduces another caller stack frame. L<Sub::Uplevel> is not used. L<Carp>
  will not report this when using full stack traces, though, because
  C<%Carp::Internal> is used. This lack of magic is considered a feature.
  
  =item *
  
  The value of C<$_> in the C<catch> block is not guaranteed to be the value of
  the exception thrown (C<$@>) in the C<try> block.  There is no safe way to
  ensure this, since C<eval> may be used unhygenically in destructors.  The only
  guarantee is that the C<catch> will be called if an exception is thrown.
  
  =item *
  
  The return value of the C<catch> block is not ignored, so if testing the result
  of the expression for truth on success, be sure to return a false value from
  the C<catch> block:
  
  	my $obj = try {
  		MightFail->new;
  	} catch {
  		...
  
  		return; # avoid returning a true value;
  	};
  
  	return unless $obj;
  
  =item *
  
  C<$SIG{__DIE__}> is still in effect.
  
  Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of
  C<eval> blocks, since it isn't people have grown to rely on it. Therefore in
  the interests of compatibility, C<try> does not disable C<$SIG{__DIE__}> for
  the scope of the error throwing code.
  
  =item *
  
  Lexical C<$_> may override the one set by C<catch>.
  
  For example Perl 5.10's C<given> form uses a lexical C<$_>, creating some
  confusing behavior:
  
  	given ($foo) {
  		when (...) {
  			try {
  				...
  			} catch {
  				warn $_; # will print $foo, not the error
  				warn $_[0]; # instead, get the error like this
  			}
  		}
  	}
  
  =back
  
  =head1 SEE ALSO
  
  =over 4
  
  =item L<TryCatch>
  
  Much more feature complete, more convenient semantics, but at the cost of
  implementation complexity.
  
  =item L<autodie>
  
  Automatic error throwing for builtin functions and more. Also designed to
  work well with C<given>/C<when>.
  
  =item L<Throwable>
  
  A lightweight role for rolling your own exception classes.
  
  =item L<Error>
  
  Exception object implementation with a C<try> statement. Does not localize
  C<$@>.
  
  =item L<Exception::Class::TryCatch>
  
  Provides a C<catch> statement, but properly calling C<eval> is your
  responsibility.
  
  The C<try> keyword pushes C<$@> onto an error stack, avoiding some of the
  issues with C<$@>, but you still need to localize to prevent clobbering.
  
  =back
  
  =head1 LIGHTNING TALK
  
  I gave a lightning talk about this module, you can see the slides (Firefox
  only):
  
  L<http://nothingmuch.woobling.org/talks/takahashi.xul?data=yapc_asia_2009/try_tiny.txt>
  
  Or read the source:
  
  L<http://nothingmuch.woobling.org/talks/yapc_asia_2009/try_tiny.yml>
  
  =head1 VERSION CONTROL
  
  L<http://github.com/nothingmuch/try-tiny/>
  
  =head1 AUTHOR
  
  Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
  
  =head1 COPYRIGHT
  
  	Copyright (c) 2009 Yuval Kogman. All rights reserved.
  	This program is free software; you can redistribute
  	it and/or modify it under the terms of the MIT license.
  
  =cut
  
TRY_TINY

$fatpacked{"common/sense.pm"} = <<'COMMON_SENSE';
  
  =head1 NAME
  
  common::sense - save a tree AND a kitten, use common::sense!
  
  =head1 SYNOPSIS
  
     use common::sense;
  
     # Supposed to be mostly the same, with much lower memory usage, as:
    
     # use utf8;
     # use strict qw(vars subs);
     # use feature qw(say state switch);
     # use feature qw(unicode_strings unicode_eval current_sub fc evalbytes);
     # no feature qw(array_base);
     # no warnings;
     # use warnings qw(FATAL closed threads internal debugging pack
     #                 portable prototype inplace io pipe unpack malloc
     #                 deprecated glob digit printf layer
     #                 reserved taint closure semicolon);
     # no warnings qw(exec newline unopened);
  
  =head1 DESCRIPTION
  
     “Nothing is more fairly distributed than common sense: no one thinks
     he needs more of it than he already has.”
  
     – René Descartes
  
  This module implements some sane defaults for Perl programs, as defined by
  two typical (or not so typical - use your common sense) specimens of Perl
  coders. In fact, after working out details on which warnings and strict
  modes to enable and make fatal, we found that we (and our code written so
  far, and others) fully agree on every option, even though we never used
  warnings before, so it seems this module indeed reflects a "common" sense
  among some long-time Perl coders.
  
  The basic philosophy behind the choices made in common::sense can be
  summarised as: "enforcing strict policies to catch as many bugs as
  possible, while at the same time, not limiting the expressive power
  available to the programmer".
  
  Two typical examples of how this philosophy is applied in practise is the
  handling of uninitialised and malloc warnings:
  
  =over 4
  
  =item I<uninitialised>
  
  C<undef> is a well-defined feature of perl, and enabling warnings for
  using it rarely catches any bugs, but considerably limits you in what you
  can do, so uninitialised warnings are disabled.
  
  =item I<malloc>
  
  Freeing something twice on the C level is a serious bug, usually causing
  memory corruption. It often leads to side effects much later in the
  program and there are no advantages to not reporting this, so malloc
  warnings are fatal by default.
  
  =back
  
  Unfortunately, there is no fine-grained warning control in perl, so often
  whole groups of useful warnings had to be excluded because of a single
  useless warning (for example, perl puts an arbitrary limit on the length
  of text you can match with some regexes before emitting a warning, making
  the whole C<regexp> category useless).
  
  What follows is a more thorough discussion of what this module does,
  and why it does it, and what the advantages (and disadvantages) of this
  approach are.
  
  =head1 RATIONALE
  
  =over 4
  
  =item use utf8
  
  While it's not common sense to write your programs in UTF-8, it's quickly
  becoming the most common encoding, is the designated future default
  encoding for perl sources, and the most convenient encoding available
  (you can do really nice quoting tricks...). Experience has shown that our
  programs were either all pure ascii or utf-8, both of which will stay the
  same.
  
  There are few drawbacks to enabling UTF-8 source code by default (mainly
  some speed hits due to bugs in older versions of perl), so this module
  enables UTF-8 source code encoding by default.
  
  
  =item use strict qw(subs vars)
  
  Using C<use strict> is definitely common sense, but C<use strict
  'refs'> definitely overshoots its usefulness. After almost two
  decades of Perl hacking, we decided that it does more harm than being
  useful. Specifically, constructs like these:
  
     @{ $var->[0] }
  
  Must be written like this (or similarly), when C<use strict 'refs'> is in
  scope, and C<$var> can legally be C<undef>:
  
     @{ $var->[0] || [] }
  
  This is annoying, and doesn't shield against obvious mistakes such as
  using C<"">, so one would even have to write (at least for the time
  being):
  
     @{ defined $var->[0] ? $var->[0] : [] }
  
  ... which nobody with a bit of common sense would consider
  writing: clear code is clearly something else.
  
  Curiously enough, sometimes perl is not so strict, as this works even with
  C<use strict> in scope:
  
     for (@{ $var->[0] }) { ...
  
  If that isn't hypocrisy! And all that from a mere program!
  
  
  =item use feature qw(say state given ...)
  
  We found it annoying that we always have to enable extra features. If
  something breaks because it didn't anticipate future changes, so be
  it. 5.10 broke almost all our XS modules and nobody cared either (or at
  least I know of nobody who really complained about gratuitous changes -
  as opposed to bugs).
  
  Few modules that are not actively maintained work with newer versions of
  Perl, regardless of use feature or not, so a new major perl release means
  changes to many modules - new keywords are just the tip of the iceberg.
  
  If your code isn't alive, it's dead, Jim - be an active maintainer.
  
  But nobody forces you to use those extra features in modules meant for
  older versions of perl - common::sense of course works there as well.
  There is also an important other mode where having additional features by
  default is useful: commandline hacks and internal use scripts: See "much
  reduced typing", below.
  
  There is one notable exception: C<unicode_eval> is not enabled by
  default. In our opinion, C<use feature> had one main effect - newer perl
  versions don't value backwards compatibility and the ability to write
  modules for multiple perl versions much, after all, you can use feature.
  
  C<unicode_eval> doesn't add a new feature, it breaks an existing function.
  
  =item no warnings, but a lot of new errors
  
  Ah, the dreaded warnings. Even worse, the horribly dreaded C<-w>
  switch: Even though we don't care if other people use warnings (and
  certainly there are useful ones), a lot of warnings simply go against the
  spirit of Perl.
  
  Most prominently, the warnings related to C<undef>. There is nothing wrong
  with C<undef>: it has well-defined semantics, it is useful, and spitting
  out warnings you never asked for is just evil.
  
  The result was that every one of our modules did C<no warnings> in the
  past, to avoid somebody accidentally using and forcing his bad standards
  on our code. Of course, this switched off all warnings, even the useful
  ones. Not a good situation. Really, the C<-w> switch should only enable
  warnings for the main program only.
  
  Funnily enough, L<perllexwarn> explicitly mentions C<-w> (and not in a
  favourable way, calling it outright "wrong"), but standard utilities, such
  as L<prove>, or MakeMaker when running C<make test>, still enable them
  blindly.
  
  For version 2 of common::sense, we finally sat down a few hours and went
  through I<every single warning message>, identifiying - according to
  common sense - all the useful ones.
  
  This resulted in the rather impressive list in the SYNOPSIS. When we
  weren't sure, we didn't include the warning, so the list might grow in
  the future (we might have made a mistake, too, so the list might shrink
  as well).
  
  Note the presence of C<FATAL> in the list: we do not think that the
  conditions caught by these warnings are worthy of a warning, we I<insist>
  that they are worthy of I<stopping> your program, I<instantly>. They are
  I<bugs>!
  
  Therefore we consider C<common::sense> to be much stricter than C<use
  warnings>, which is good if you are into strict things (we are not,
  actually, but these things tend to be subjective).
  
  After deciding on the list, we ran the module against all of our code that
  uses C<common::sense> (that is almost all of our code), and found only one
  occurence where one of them caused a problem: one of elmex's (unreleased)
  modules contained:
  
     $fmt =~ s/([^\s\[]*)\[( [^\]]* )\]/\x0$1\x1$2\x0/xgo;
  
  We quickly agreed that indeed the code should be changed, even though it
  happened to do the right thing when the warning was switched off.
  
  
  =item much reduced typing
  
  Especially with version 2.0 of common::sense, the amount of boilerplate
  code you need to add to gte I<this> policy is daunting. Nobody would write
  this out in throwaway scripts, commandline hacks or in quick internal-use
  scripts.
  
  By using common::sense you get a defined set of policies (ours, but maybe
  yours, too, if you accept them), and they are easy to apply to your
  scripts: typing C<use common::sense;> is even shorter than C<use warnings;
  use strict; use feature ...>.
  
  And you can immediately use the features of your installed perl, which
  is more difficult in code you release, but not usually an issue for
  internal-use code (downgrades of your production perl should be rare,
  right?).
  
  
  =item mucho reduced memory usage
  
  Just using all those pragmas mentioned in the SYNOPSIS together wastes
  <blink>I<< B<776> kilobytes >></blink> of precious memory in my perl, for
  I<every single perl process using our code>, which on our machines, is a
  lot. In comparison, this module only uses I<< B<four> >> kilobytes (I even
  had to write it out so it looks like more) of memory on the same platform.
  
  The money/time/effort/electricity invested in these gigabytes (probably
  petabytes globally!) of wasted memory could easily save 42 trees, and a
  kitten!
  
  Unfortunately, until everybods applies more common sense, there will still
  often be modules that pull in the monster pragmas. But one can hope...
  
  =cut
  
  package common::sense;
  
  our $VERSION = '3.6';
  
  # overload should be included
  
  sub import {
     local $^W; # work around perl 5.16 spewing out warnings for next statement
     # use warnings
     ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "";
     # use strict, use utf8; use feature;
     $^H |= 0x1c820ec0;
     @^H{qw(feature___SUB__ feature_fc feature_unicode feature_evalbytes feature_say feature_state feature_switch)} = (1) x 7;
  }
  
  1;
  
  =back
  
  =head1 THERE IS NO 'no common::sense'!!!! !!!! !!
  
  This module doesn't offer an unimport. First of all, it wastes even more
  memory, second, and more importantly, who with even a bit of common sense
  would want no common sense?
  
  =head1 STABILITY AND FUTURE VERSIONS
  
  Future versions might change just about everything in this module. We
  might test our modules and upload new ones working with newer versions of
  this module, and leave you standing in the rain because we didn't tell
  you. In fact, we did so when switching from 1.0 to 2.0, which enabled gobs
  of warnings, and made them FATAL on top.
  
  Maybe we will load some nifty modules that try to emulate C<say> or so
  with perls older than 5.10 (this module, of course, should work with older
  perl versions - supporting 5.8 for example is just common sense at this
  time. Maybe not in the future, but of course you can trust our common
  sense to be consistent with, uhm, our opinion).
  
  =head1 WHAT OTHER PEOPLE HAD TO SAY ABOUT THIS MODULE
  
  apeiron
  
     "... wow"
     "I hope common::sense is a joke."
  
  crab
  
     "i wonder how it would be if joerg schilling wrote perl modules."
  
  Adam Kennedy
  
     "Very interesting, efficient, and potentially something I'd use all the time."
     [...]
     "So no common::sense for me, alas."
  
  H.Merijn Brand
  
     "Just one more reason to drop JSON::XS from my distribution list"
  
  Pista Palo
  
     "Something in short supply these days..."
  
  Steffen Schwigon
  
     "This module is quite for sure *not* just a repetition of all the other
     'use strict, use warnings'-approaches, and it's also not the opposite.
     [...] And for its chosen middle-way it's also not the worst name ever.
     And everything is documented."
  
  BKB
  
     "[Deleted - thanks to Steffen Schwigon for pointing out this review was
     in error.]"
  
  Somni
  
     "the arrogance of the guy"
     "I swear he tacked somenoe else's name onto the module
     just so he could use the royal 'we' in the documentation"
  
  Anonymous Monk
  
     "You just gotta love this thing, its got META.json!!!"
  
  dngor
  
     "Heh.  '"<elmex at ta-sa.org>"'  The quotes are semantic
     distancing from that e-mail address."
  
  Jerad Pierce
  
     "Awful name (not a proper pragma), and the SYNOPSIS doesn't tell you
     anything either. Nor is it clear what features have to do with "common
     sense" or discipline."
  
  acme
  
     "THERE IS NO 'no common::sense'!!!! !!!! !!"
  
  apeiron (meta-comment about us commenting^Wquoting his comment)
  
     "How about quoting this: get a clue, you fucktarded amoeba."
  
  quanth
  
     "common sense is beautiful, json::xs is fast, Anyevent, EV are fast and
     furious. I love mlehmannware ;)"
  
  apeiron
  
     "... it's mlehmann's view of what common sense is. His view of common
     sense is certainly uncommon, insofar as anyone with a clue disagrees
     with him."
  
  apeiron (another meta-comment)
  
     "apeiron wonders if his little informant is here to steal more quotes"
  
  ew73
  
     "... I never got past the SYNOPSIS before calling it shit."
     [...]
     How come no one ever quotes me. :("
  
  chip (not willing to explain his cryptic questions about links in Changes files)
  
     "I'm willing to ask the question I've asked. I'm not willing to go
     through the whole dance you apparently have choreographed. Either
     answer the completely obvious question, or tell me to fuck off again."
  
  =head1 FREQUENTLY ASKED QUESTIONS
  
  Or frequently-come-up confusions.
  
  =over 4
  
  =item Is this module meant to be serious?
  
  Yes, we would have put it under the C<Acme::> namespace otherwise.
  
  =item But the manpage is written in a funny/stupid/... way?
  
  This was meant to make it clear that our common sense is a subjective
  thing and other people can use their own notions, taking the steam out
  of anybody who might be offended (as some people are always offended no
  matter what you do).
  
  This was a failure.
  
  But we hope the manpage still is somewhat entertaining even though it
  explains boring rationale.
  
  =item Why do you impose your conventions on my code?
  
  For some reason people keep thinking that C<common::sense> imposes
  process-wide limits, even though the SYNOPSIS makes it clear that it works
  like other similar modules - i.e. only within the scope that C<use>s them.
  
  So, no, we don't - nobody is forced to use this module, and using a module
  that relies on common::sense does not impose anything on you.
  
  =item Why do you think only your notion of common::sense is valid?
  
  Well, we don't, and have clearly written this in the documentation to
  every single release. We were just faster than anybody else w.r.t. to
  grabbing the namespace.
  
  =item But everybody knows that you have to use strict and use warnings,
  why do you disable them?
  
  Well, we don't do this either - we selectively disagree with the
  usefulness of some warnings over others. This module is aimed at
  experienced Perl programmers, not people migrating from other languages
  who might be surprised about stuff such as C<undef>. On the other hand,
  this does not exclude the usefulness of this module for total newbies, due
  to its strictness in enforcing policy, while at the same time not limiting
  the expressive power of perl.
  
  This module is considerably I<more> strict than the canonical C<use
  strict; use warnings>, as it makes all its warnings fatal in nature, so
  you can not get away with as many things as with the canonical approach.
  
  This was not implemented in version 1.0 because of the daunting number
  of warning categories and the difficulty in getting exactly the set of
  warnings you wish (i.e. look at the SYNOPSIS in how complicated it is to
  get a specific set of warnings - it is not reasonable to put this into
  every module, the maintenance effort would be enourmous).
  
  =item But many modules C<use strict> or C<use warnings>, so the memory
  savings do not apply?
  
  I suddenly feel sad...
  
  But yes, that's true. Fortunately C<common::sense> still uses only a
  miniscule amount of RAM.
  
  =item But it adds another dependency to your modules!
  
  It's a fact, yeah. But it's trivial to install, most popular modules have
  many more dependencies and we consider dependencies a good thing - it
  leads to better APIs, more thought about interworking of modules and so
  on.
  
  =item Why do you use JSON and not YAML for your META.yml?
  
  This is not true - YAML supports a large subset of JSON, and this subset
  is what META.yml is written in, so it would be correct to say "the
  META.yml is written in a common subset of YAML and JSON".
  
  The META.yml follows the YAML, JSON and META.yml specifications, and is
  correctly parsed by CPAN, so if you have trouble with it, the problem is
  likely on your side.
  
  =item But! But!
  
  Yeah, we know.
  
  =back
  
  =head1 AUTHOR
  
   Marc Lehmann <schmorp@schmorp.de>
   http://home.schmorp.de/
  
   Robin Redeker, "<elmex at ta-sa.org>".
  
  =cut
  
COMMON_SENSE

$fatpacked{"darwin-2level/Class/XSAccessor.pm"} = <<'DARWIN-2LEVEL_CLASS_XSACCESSOR';
  package Class::XSAccessor;
  use 5.008;
  use strict;
  use warnings;
  use Carp qw/croak/;
  use Class::XSAccessor::Heavy;
  use XSLoader;
  
  our $VERSION = '1.18';
  
  XSLoader::load('Class::XSAccessor', $VERSION);
  
  sub _make_hash {
    my $ref = shift;
  
    if (ref ($ref)) {
      if (ref($ref) eq 'ARRAY') {
        $ref = { map { $_ => $_ } @$ref }
      } 
    } else {
      $ref = { $ref, $ref };
    }
  
    return $ref;
  }
  
  sub import {
    my $own_class = shift;
    my ($caller_pkg) = caller();
  
    # Support both { getters => ... } and plain getters => ...
    my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_;
  
    $caller_pkg = $opts{class} if defined $opts{class};
  
    # TODO: Refactor. Move more duplicated code to ::Heavy
    my $read_subs      = _make_hash($opts{getters} || {});
    my $set_subs       = _make_hash($opts{setters} || {});
    my $acc_subs       = _make_hash($opts{accessors} || {});
    my $lvacc_subs     = _make_hash($opts{lvalue_accessors} || {});
    my $pred_subs      = _make_hash($opts{predicates} || {});
    my $ex_pred_subs   = _make_hash($opts{exists_predicates} || {});
    my $def_pred_subs  = _make_hash($opts{defined_predicates} || {});
    my $test_subs      = _make_hash($opts{__tests__} || {});
    my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()];
    my $true_subs      = $opts{true} || [];
    my $false_subs     = $opts{false} || [];
  
    foreach my $subtype ( ["getter", $read_subs],
                          ["setter", $set_subs],
                          ["accessor", $acc_subs],
                          ["lvalue_accessor", $lvacc_subs],
                          ["test", $test_subs],
                          ["ex_predicate", $ex_pred_subs],
                          ["def_predicate", $def_pred_subs],
                          ["def_predicate", $pred_subs] )
    {
      my $subs = $subtype->[1];
      foreach my $subname (keys %$subs) {
        my $hashkey = $subs->{$subname};
        _generate_method($caller_pkg, $subname, $hashkey, \%opts, $subtype->[0]);
      }
    }
  
    foreach my $subtype ( ["constructor", $construct_subs],
                          ["true", $true_subs],
                          ["false", $false_subs] )
    {
      foreach my $subname (@{$subtype->[1]}) {
        _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]);
      }
    }
  }
  
  sub _generate_method {
    my ($caller_pkg, $subname, $hashkey, $opts, $type) = @_;
  
    croak("Cannot use undef as a hash key for generating an XS $type accessor. (Sub: $subname)")
      if not defined $hashkey;
  
    $subname = "${caller_pkg}::$subname" if $subname !~ /::/;
  
    Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace};
    no warnings 'redefine'; # don't warn about an explicitly requested redefine
  
    if ($type eq 'getter') {
      newxs_getter($subname, $hashkey);
    }
    elsif ($type eq 'lvalue_accessor') {
      newxs_lvalue_accessor($subname, $hashkey);
    }
    elsif ($type eq 'setter') {
      newxs_setter($subname, $hashkey, $opts->{chained}||0);
    }
    elsif ($type eq 'def_predicate') {
      newxs_defined_predicate($subname, $hashkey);
    }
    elsif ($type eq 'ex_predicate') {
      newxs_exists_predicate($subname, $hashkey);
    }
    elsif ($type eq 'constructor') {
      newxs_constructor($subname);
    }
    elsif ($type eq 'true') {
      newxs_boolean($subname, 1);
    }
    elsif ($type eq 'false') {
      newxs_boolean($subname, 0);
    }
    elsif ($type eq 'test') {
      newxs_test($subname, $hashkey);
    }
    else {
      newxs_accessor($subname, $hashkey, $opts->{chained}||0);
    }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Class::XSAccessor - Generate fast XS accessors without runtime compilation
  
  =head1 SYNOPSIS
  
    package MyClass;
    use Class::XSAccessor
      replace     => 1,   # Replace existing methods (if any)
      constructor => 'new',
      getters     => {
        get_foo => 'foo', # 'foo' is the hash key to access
        get_bar => 'bar',
      },
      setters => {
        set_foo => 'foo',
        set_bar => 'bar',
      },
      accessors => {
        foo => 'foo',
        bar => 'bar',
      },
      # "predicates" is an alias for "defined_predicates"
      defined_predicates => {
        defined_foo => 'foo',
        defined_bar => 'bar',
      },
      exists_predicates => {
        has_foo => 'foo',
        has_bar => 'bar',
      },
      lvalue_accessors => { # see below
        baz => 'baz', # ...
      },
      true  => [ 'is_token', 'is_whitespace' ],
      false => [ 'significant' ];
    
    # The imported methods are implemented in fast XS.
    
    # normal class code here.
  
  As of version 1.05, some alternative syntax forms are available:
  
    package MyClass;
    
    # Options can be passed as a HASH reference, if preferred,
    # which can also help Perl::Tidy to format the statement correctly.
    use Class::XSAccessor {
       # If the name => key values are always identical,
       # the following shorthand can be used.
       accessors => [ 'foo', 'bar' ],
    };
  
  =head1 DESCRIPTION
  
  Class::XSAccessor implements fast read, write and read/write accessors in XS.
  Additionally, it can provide predicates such as C<has_foo()> for testing
  whether the attribute C<foo> exists in the object (which is different from
  "is defined within the object").
  It only works with objects that are implemented as ordinary hashes.
  L<Class::XSAccessor::Array> implements the same interface for objects
  that use arrays for their internal representation.
  
  Since version 0.10, the module can also generate simple constructors
  (implemented in XS). Simply supply the
  C<constructor =E<gt> 'constructor_name'> option or the
  C<constructors =E<gt> ['new', 'create', 'spawn']> option.
  These constructors do the equivalent of the following Perl code:
  
    sub new {
      my $class = shift;
      return bless { @_ }, ref($class)||$class;
    }
  
  That means they can be called on objects and classes but will not
  clone objects entirely. Parameters to C<new()> are added to the
  object.
  
  The XS accessor methods are between 3 and 4 times faster than typical
  pure-Perl accessors in some simple benchmarking.
  The lower factor applies to the potentially slightly obscure
  C<sub set_foo_pp {$_[0]-E<gt>{foo} = $_[1]}>, so if you usually
  write clear code, a factor of 3.5 speed-up is a good estimate.
  If in doubt, do your own benchmarking!
  
  The method names may be fully qualified. The example in the synopsis could
  have been written as C<MyClass::get_foo> instead
  of C<get_foo>. This way, methods can be installed in classes other
  than the current class. See also: the C<class> option below.
  
  By default, the setters return the new value that was set,
  and the accessors (mutators) do the same. This behaviour can be changed
  with the C<chained> option - see below. The predicates return a boolean.
  
  Since version 1.01, C<Class::XSAccessor> can generate extremely simple methods which
  just return true or false (and always do so). If that seems like a
  really superfluous thing to you, then consider a large class hierarchy
  with interfaces such as L<PPI>. These methods are provided by the C<true>
  and C<false> options - see the synopsis.
  
  C<defined_predicates> check whether a given object attribute is defined.
  C<predicates> is an alias for C<defined_predicates> for compatibility with
  older versions of C<Class::XSAccessor>. C<exists_predicates> checks
  whether the given attribute exists in the object using C<exists>.
  
  =head1 OPTIONS
  
  In addition to specifying the types and names of accessors, additional options
  can be supplied which modify behaviour. The options are specified as key/value pairs
  in the same manner as the accessor declaration. For example:
  
    use Class::XSAccessor
      getters => {
        get_foo => 'foo',
      },
      replace => 1;
  
  The list of available options is:
  
  =head2 replace
  
  Set this to a true value to prevent C<Class::XSAccessor> from
  complaining about replacing existing subroutines.
  
  =head2 chained
  
  Set this to a true value to change the return value of setters
  and mutators (when called with an argument).
  If C<chained> is enabled, the setters and accessors/mutators will
  return the object. Mutators called without an argument still
  return the value of the associated attribute.
  
  As with the other options, C<chained> affects all methods generated
  in the same C<use Class::XSAccessor ...> statement.
  
  =head2 class
  
  By default, the accessors are generated in the calling class. The
  the C<class> option allows the target class to be specified.
  
  =head1 LVALUES
  
  Support for lvalue accessors via the keyword C<lvalue_accessors>
  was added in version 1.08. At this point, B<THEY ARE CONSIDERED HIGHLY
  EXPERIMENTAL>. Furthermore, their performance hasn't been benchmarked
  yet.
  
  The following example demonstrates an lvalue accessor:
  
    package Address;
    use Class::XSAccessor
      constructor => 'new',
      lvalue_accessors => { zip_code => 'zip' };
    
    package main;
    my $address = Address->new(zip => 2);
    print $address->zip_code, "\n"; # prints 2
    $address->zip_code = 76135; # <--- This is it!
    print $address->zip_code, "\n"; # prints 76135
  
  =head1 CAVEATS
  
  Probably won't work for objects based on I<tied> hashes. But that's a strange thing to do anyway.
  
  Scary code exploiting strange XS features.
  
  If you think writing an accessor in XS should be a laughably simple exercise, then
  please contemplate how you could instantiate a new XS accessor for a new hash key
  that's only known at run-time. Note that compiling C code at run-time a la L<Inline::C|Inline::C>
  is a no go.
  
  Threading. With version 1.00, a memory leak has been B<fixed>. Previously, a small amount of
  memory would leak if C<Class::XSAccessor>-based classes were loaded in a subthread without having
  been loaded in the "main" thread. If the subthread then terminated, a hash key and an int per
  associated method used to be lost. Note that this mattered only if classes were B<only> loaded
  in a sort of throw-away thread.
  
  In the new implementation, as of 1.00, the memory will still not be released, in the same situation,
  but it will be recycled when the same class, or a similar class, is loaded again in B<any> thread.
  
  =head1 SEE ALSO
  
  =over
  
  =item * L<Class::XSAccessor::Array>
  
  =item * L<AutoXS>
  
  =back
  
  =head1 AUTHOR
  
  Steffen Mueller E<lt>smueller@cpan.orgE<gt>
  
  chocolateboy E<lt>chocolate@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself, either Perl version 5.8 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
DARWIN-2LEVEL_CLASS_XSACCESSOR

$fatpacked{"darwin-2level/Class/XSAccessor/Array.pm"} = <<'DARWIN-2LEVEL_CLASS_XSACCESSOR_ARRAY';
  package Class::XSAccessor::Array;
  use 5.008;
  use strict;
  use warnings;
  use Carp qw/croak/;
  use Class::XSAccessor;
  use Class::XSAccessor::Heavy;
  
  our $VERSION = '1.18';
  
  sub import {
    my $own_class = shift;
    my ($caller_pkg) = caller();
  
    # Support both { getters => ... } and plain getters => ...
    my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_;
  
    $caller_pkg = $opts{class} if defined $opts{class};
  
    my $read_subs      = $opts{getters} || {};
    my $set_subs       = $opts{setters} || {};
    my $acc_subs       = $opts{accessors} || {};
    my $lvacc_subs     = $opts{lvalue_accessors} || {};
    my $pred_subs      = $opts{predicates} || {};
    my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()];  
    my $true_subs      = $opts{true} || [];
    my $false_subs     = $opts{false} || [];
  
  
    foreach my $subtype ( ["getter", $read_subs],
                          ["setter", $set_subs],
                          ["accessor", $acc_subs],
                          ["lvalue_accessor", $lvacc_subs],
                          ["pred_subs", $pred_subs] )
    {
      my $subs = $subtype->[1];
      foreach my $subname (keys %$subs) {
        my $array_index = $subs->{$subname};
        _generate_method($caller_pkg, $subname, $array_index, \%opts, $subtype->[0]);
      }
    }
     
    foreach my $subtype ( ["constructor", $construct_subs],
                          ["true", $true_subs],
                          ["false", $false_subs] )
    {
      foreach my $subname (@{$subtype->[1]}) {
        _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]);
      }
    }
  }
  
  sub _generate_method {
    my ($caller_pkg, $subname, $array_index, $opts, $type) = @_;
  
    croak("Cannot use undef as a array index for generating an XS $type accessor. (Sub: $subname)")
      if not defined $array_index;
  
    $subname = "${caller_pkg}::$subname" if $subname !~ /::/;
  
    Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace};
    no warnings 'redefine'; # don't warn about an explicitly requested redefine
  
    if ($type eq 'getter') {
      newxs_getter($subname, $array_index);
    }
    if ($type eq 'lvalue_accessor') {
      newxs_lvalue_accessor($subname, $array_index);
    }
    elsif ($type eq 'setter') {
      newxs_setter($subname, $array_index, $opts->{chained}||0);
    }
    elsif ($type eq 'predicate') {
      newxs_predicate($subname, $array_index);
    }
    elsif ($type eq 'constructor') {
      newxs_constructor($subname);
    }
    elsif ($type eq 'true') {
      Class::XSAccessor::newxs_boolean($subname, 1);
    }
    elsif ($type eq 'false') {
      Class::XSAccessor::newxs_boolean($subname, 0);
    }
    else {
      newxs_accessor($subname, $array_index, $opts->{chained}||0);
    }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Class::XSAccessor::Array - Generate fast XS accessors without runtime compilation
  
  =head1 SYNOPSIS
    
    package MyClassUsingArraysAsInternalStorage;
    use Class::XSAccessor::Array
      constructor => 'new',
      getters => {
        get_foo => 0, # 0 is the array index to access
        get_bar => 1,
      },
      setters => {
        set_foo => 0,
        set_bar => 1,
      },
      accessors => { # a mutator
        buz => 2,
      },
      predicates => { # test for definedness
        has_buz => 2,
      },
      lvalue_accessors => { # see below
        baz => 3,
      },
      true => [ 'is_token', 'is_whitespace' ],
      false => [ 'significant' ];
    
    # The imported methods are implemented in fast XS.
    
    # normal class code here.
  
  As of version 1.05, some alternative syntax forms are available:
  
    package MyClass;
    
    # Options can be passed as a HASH reference if you prefer it,
    # which can also help PerlTidy to flow the statement correctly.
    use Class::XSAccessor {
      getters => {
        get_foo => 0,
        get_bar => 1,
      },
    };
  
  =head1 DESCRIPTION
  
  The module implements fast XS accessors both for getting at and
  setting an object attribute. Additionally, the module supports
  mutators and simple predicates (C<has_foo()> like tests for definedness
  of an attributes).
  The module works only with objects
  that are implemented as B<arrays>. Using it on hash-based objects is
  bound to make your life miserable. Refer to L<Class::XSAccessor> for
  an implementation that works with hash-based objects.
  
  A simple benchmark showed a significant performance
  advantage over writing accessors in Perl.
  
  Since version 0.10, the module can also generate simple constructors
  (implemented in XS) for you. Simply supply the
  C<constructor =E<gt> 'constructor_name'> option or the
  C<constructors =E<gt> ['new', 'create', 'spawn']> option.
  These constructors do the equivalent of the following Perl code:
  
    sub new {
      my $class = shift;
      return bless [], ref($class)||$class;
    }
  
  That means they can be called on objects and classes but will not
  clone objects entirely. Note that any parameters to new() will be
  discarded! If there is a better idiom for array-based objects, let
  me know.
  
  While generally more obscure than hash-based objects,
  objects using blessed arrays as internal representation
  are a bit faster as its somewhat faster to access arrays than hashes.
  Accordingly, this module is slightly faster (~10-15%) than
  L<Class::XSAccessor>, which works on hash-based objects.
  
  The method names may be fully qualified. In the example of the
  synopsis, you could have written C<MyClass::get_foo> instead
  of C<get_foo>. This way, you can install methods in classes other
  than the current class. See also: The C<class> option below.
  
  Since version 1.01, you can generate extremely simple methods which
  just return true or false (and always do so). If that seems like a
  really superfluous thing to you, then think of a large class hierarchy
  with interfaces such as PPI. This is implemented as the C<true>
  and C<false> options, see synopsis.
  
  =head1 OPTIONS
  
  In addition to specifying the types and names of accessors, you can add options
  which modify behaviour. The options are specified as key/value pairs just as the
  accessor declaration. Example:
  
    use Class::XSAccessor::Array
      getters => {
        get_foo => 0,
      },
      replace => 1;
  
  The list of available options is:
  
  =head2 replace
  
  Set this to a true value to prevent C<Class::XSAccessor::Array> from
  complaining about replacing existing subroutines.
  
  =head2 chained
  
  Set this to a true value to change the return value of setters
  and mutators (when called with an argument).
  If C<chained> is enabled, the setters and accessors/mutators will
  return the object. Mutators called without an argument still
  return the value of the associated attribute.
  
  As with the other options, C<chained> affects all methods generated
  in the same C<use Class::XSAccessor::Array ...> statement.
  
  =head2 class
  
  By default, the accessors are generated in the calling class. Using
  the C<class> option, you can explicitly specify where the methods
  are to be generated.
  
  =head1 LVALUES
  
  Support for lvalue accessors via the keyword C<lvalue_accessors>
  was added in version 1.08. At this point, B<THEY ARE CONSIDERED HIGHLY
  EXPERIMENTAL>. Furthermore, their performance hasn't been benchmarked
  yet.
  
  The following example demonstrates an lvalue accessor:
  
    package Address;
    use Class::XSAccessor
      constructor => 'new',
      lvalue_accessors => { zip_code => 0 };
    
    package main;
    my $address = Address->new(2);
    print $address->zip_code, "\n"; # prints 2
    $address->zip_code = 76135; # <--- This is it!
    print $address->zip_code, "\n"; # prints 76135
  
  =head1 CAVEATS
  
  Probably wouldn't work if your objects are I<tied>. But that's a strange thing to do anyway.
  
  Scary code exploiting strange XS features.
  
  If you think writing an accessor in XS should be a laughably simple exercise, then
  please contemplate how you could instantiate a new XS accessor for a new hash key
  or array index that's only known at run-time. Note that compiling C code at run-time
  a la Inline::C is a no go.
  
  Threading. With version 1.00, a memory leak has been B<fixed> that would leak a small amount of
  memory if you loaded C<Class::XSAccessor>-based classes in a subthread that hadn't been loaded
  in the "main" thread before. If the subthread then terminated, a hash key and an int per
  associated method used ot be lost. Note that this mattered only if classes were B<only> loaded
  in a sort of throw-away thread.
  
  In the new implementation as of 1.00, the memory will not be released again either in the above
  situation. But it will be recycled when the same class or a similar class is loaded
  again in B<any> thread.
  
  =head1 SEE ALSO
  
  L<Class::XSAccessor>
  
  L<AutoXS>
  
  =head1 AUTHOR
  
  Steffen Mueller E<lt>smueller@cpan.orgE<gt>
  
  chocolateboy E<lt>chocolate@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself, either Perl version 5.8 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
DARWIN-2LEVEL_CLASS_XSACCESSOR_ARRAY

$fatpacked{"darwin-2level/Class/XSAccessor/Heavy.pm"} = <<'DARWIN-2LEVEL_CLASS_XSACCESSOR_HEAVY';
  package # hide from PAUSE
      Class::XSAccessor::Heavy;
  
  use 5.008;
  use strict;
  use warnings;
  use Carp;
  
  our $VERSION  = '1.18';
  our @CARP_NOT = qw(
          Class::XSAccessor
          Class::XSAccessor::Array
  );
  
  # TODO Move more duplicated code from XSA and XSA::Array here
  
  
  sub check_sub_existence {
    my $subname = shift;
  
    my $sub_package = $subname;
    $sub_package =~ s/([^:]+)$// or die;
    my $bare_subname = $1;
      
    my $sym;
    {
      no strict 'refs';
      $sym = \%{"$sub_package"};
    }
    no warnings;
    local *s = $sym->{$bare_subname};
    my $coderef = *s{CODE};
    if ($coderef) {
      $sub_package =~ s/::$//;
      Carp::croak("Cannot replace existing subroutine '$bare_subname' in package '$sub_package' with an XS implementation. If you wish to force a replacement, add the 'replace => 1' parameter to the arguments of 'use ".(caller())[0]."'.");
    }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Class::XSAccessor::Heavy - Guts you don't care about
  
  =head1 SYNOPSIS
    
    use Class::XSAccessor!
  
  =head1 DESCRIPTION
  
  Common guts for Class::XSAccessor and Class::XSAccessor::Array.
  No user-serviceable parts inside!
  
  =head1 SEE ALSO
  
  L<Class::XSAccessor>
  L<Class::XSAccessor::Array>
  
  =head1 AUTHOR
  
  Steffen Mueller, E<lt>smueller@cpan.orgE<gt>
  
  chocolateboy, E<lt>chocolate@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself, either Perl version 5.8 or,
  at your option, any later version of Perl 5 you may have available.
  
  =cut
  
DARWIN-2LEVEL_CLASS_XSACCESSOR_HEAVY

$fatpacked{"Cwd.pm"} = <<'DARWIN-2LEVEL_CWD';
  package Cwd;
  
  =head1 NAME
  
  Cwd - get pathname of current working directory
  
  =head1 SYNOPSIS
  
      use Cwd;
      my $dir = getcwd;
  
      use Cwd 'abs_path';
      my $abs_path = abs_path($file);
  
  =head1 DESCRIPTION
  
  This module provides functions for determining the pathname of the
  current working directory.  It is recommended that getcwd (or another
  *cwd() function) be used in I<all> code to ensure portability.
  
  By default, it exports the functions cwd(), getcwd(), fastcwd(), and
  fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
  
  
  =head2 getcwd and friends
  
  Each of these functions are called without arguments and return the
  absolute path of the current working directory.
  
  =over 4
  
  =item getcwd
  
      my $cwd = getcwd();
  
  Returns the current working directory.
  
  Exposes the POSIX function getcwd(3) or re-implements it if it's not
  available.
  
  =item cwd
  
      my $cwd = cwd();
  
  The cwd() is the most natural form for the current architecture.  For
  most systems it is identical to `pwd` (but without the trailing line
  terminator).
  
  =item fastcwd
  
      my $cwd = fastcwd();
  
  A more dangerous version of getcwd(), but potentially faster.
  
  It might conceivably chdir() you out of a directory that it can't
  chdir() you back into.  If fastcwd encounters a problem it will return
  undef but will probably leave you in a different directory.  For a
  measure of extra security, if everything appears to have worked, the
  fastcwd() function will check that it leaves you in the same directory
  that it started in.  If it has changed it will C<die> with the message
  "Unstable directory path, current directory changed
  unexpectedly".  That should never happen.
  
  =item fastgetcwd
  
    my $cwd = fastgetcwd();
  
  The fastgetcwd() function is provided as a synonym for cwd().
  
  =item getdcwd
  
      my $cwd = getdcwd();
      my $cwd = getdcwd('C:');
  
  The getdcwd() function is also provided on Win32 to get the current working
  directory on the specified drive, since Windows maintains a separate current
  working directory for each drive.  If no drive is specified then the current
  drive is assumed.
  
  This function simply calls the Microsoft C library _getdcwd() function.
  
  =back
  
  
  =head2 abs_path and friends
  
  These functions are exported only on request.  They each take a single
  argument and return the absolute pathname for it.  If no argument is
  given they'll use the current working directory.
  
  =over 4
  
  =item abs_path
  
    my $abs_path = abs_path($file);
  
  Uses the same algorithm as getcwd().  Symbolic links and relative-path
  components ("." and "..") are resolved to return the canonical
  pathname, just like realpath(3).
  
  =item realpath
  
    my $abs_path = realpath($file);
  
  A synonym for abs_path().
  
  =item fast_abs_path
  
    my $abs_path = fast_abs_path($file);
  
  A more dangerous, but potentially faster version of abs_path.
  
  =back
  
  =head2 $ENV{PWD}
  
  If you ask to override your chdir() built-in function, 
  
    use Cwd qw(chdir);
  
  then your PWD environment variable will be kept up to date.  Note that
  it will only be kept up to date if all packages which use chdir import
  it from Cwd.
  
  
  =head1 NOTES
  
  =over 4
  
  =item *
  
  Since the path separators are different on some operating systems ('/'
  on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
  modules wherever portability is a concern.
  
  =item *
  
  Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
  functions are all aliases for the C<cwd()> function, which, on Mac OS,
  calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
  C<fast_abs_path()>.
  
  =back
  
  =head1 AUTHOR
  
  Originally by the perl5-porters.
  
  Maintained by Ken Williams <KWILLIAMS@cpan.org>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  Portions of the C code in this library are copyright (c) 1994 by the
  Regents of the University of California.  All rights reserved.  The
  license on this code is compatible with the licensing of the rest of
  the distribution - please see the source code in F<Cwd.xs> for the
  details.
  
  =head1 SEE ALSO
  
  L<File::chdir>
  
  =cut
  
  use strict;
  use Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  
  $VERSION = '3.40';
  my $xs_version = $VERSION;
  $VERSION =~ tr/_//;
  
  @ISA = qw/ Exporter /;
  @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
  push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
  @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
  
  # sys_cwd may keep the builtin command
  
  # All the functionality of this module may provided by builtins,
  # there is no sense to process the rest of the file.
  # The best choice may be to have this in BEGIN, but how to return from BEGIN?
  
  if ($^O eq 'os2') {
      local $^W = 0;
  
      *cwd                = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
      *getcwd             = \&cwd;
      *fastgetcwd         = \&cwd;
      *fastcwd            = \&cwd;
  
      *fast_abs_path      = \&sys_abspath if defined &sys_abspath;
      *abs_path           = \&fast_abs_path;
      *realpath           = \&fast_abs_path;
      *fast_realpath      = \&fast_abs_path;
  
      return 1;
  }
  
  # Need to look up the feature settings on VMS.  The preferred way is to use the
  # VMS::Feature module, but that may not be available to dual life modules.
  
  my $use_vms_feature;
  BEGIN {
      if ($^O eq 'VMS') {
          if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
              $use_vms_feature = 1;
          }
      }
  }
  
  # Need to look up the UNIX report mode.  This may become a dynamic mode
  # in the future.
  sub _vms_unix_rpt {
      my $unix_rpt;
      if ($use_vms_feature) {
          $unix_rpt = VMS::Feature::current("filename_unix_report");
      } else {
          my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
          $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
      }
      return $unix_rpt;
  }
  
  # Need to look up the EFS character set mode.  This may become a dynamic
  # mode in the future.
  sub _vms_efs {
      my $efs;
      if ($use_vms_feature) {
          $efs = VMS::Feature::current("efs_charset");
      } else {
          my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
          $efs = $env_efs =~ /^[ET1]/i; 
      }
      return $efs;
  }
  
  
  # If loading the XS stuff doesn't work, we can fall back to pure perl
  eval {
    if ( $] >= 5.006 ) {
      require XSLoader;
      XSLoader::load( __PACKAGE__, $xs_version);
    } else {
      require DynaLoader;
      push @ISA, 'DynaLoader';
      __PACKAGE__->bootstrap( $xs_version );
    }
  };
  
  # Big nasty table of function aliases
  my %METHOD_MAP =
    (
     VMS =>
     {
      cwd			=> '_vms_cwd',
      getcwd		=> '_vms_cwd',
      fastcwd		=> '_vms_cwd',
      fastgetcwd		=> '_vms_cwd',
      abs_path		=> '_vms_abs_path',
      fast_abs_path	=> '_vms_abs_path',
     },
  
     MSWin32 =>
     {
      # We assume that &_NT_cwd is defined as an XSUB or in the core.
      cwd			=> '_NT_cwd',
      getcwd		=> '_NT_cwd',
      fastcwd		=> '_NT_cwd',
      fastgetcwd		=> '_NT_cwd',
      abs_path		=> 'fast_abs_path',
      realpath		=> 'fast_abs_path',
     },
  
     dos => 
     {
      cwd			=> '_dos_cwd',
      getcwd		=> '_dos_cwd',
      fastgetcwd		=> '_dos_cwd',
      fastcwd		=> '_dos_cwd',
      abs_path		=> 'fast_abs_path',
     },
  
     # QNX4.  QNX6 has a $os of 'nto'.
     qnx =>
     {
      cwd			=> '_qnx_cwd',
      getcwd		=> '_qnx_cwd',
      fastgetcwd		=> '_qnx_cwd',
      fastcwd		=> '_qnx_cwd',
      abs_path		=> '_qnx_abs_path',
      fast_abs_path	=> '_qnx_abs_path',
     },
  
     cygwin =>
     {
      getcwd		=> 'cwd',
      fastgetcwd		=> 'cwd',
      fastcwd		=> 'cwd',
      abs_path		=> 'fast_abs_path',
      realpath		=> 'fast_abs_path',
     },
  
     epoc =>
     {
      cwd			=> '_epoc_cwd',
      getcwd	        => '_epoc_cwd',
      fastgetcwd		=> '_epoc_cwd',
      fastcwd		=> '_epoc_cwd',
      abs_path		=> 'fast_abs_path',
     },
  
     MacOS =>
     {
      getcwd		=> 'cwd',
      fastgetcwd		=> 'cwd',
      fastcwd		=> 'cwd',
      abs_path		=> 'fast_abs_path',
     },
    );
  
  $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
  
  
  # Find the pwd command in the expected locations.  We assume these
  # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
  # so everything works under taint mode.
  my $pwd_cmd;
  foreach my $try ('/bin/pwd',
  		 '/usr/bin/pwd',
  		 '/QOpenSys/bin/pwd', # OS/400 PASE.
  		) {
  
      if( -x $try ) {
          $pwd_cmd = $try;
          last;
      }
  }
  my $found_pwd_cmd = defined($pwd_cmd);
  unless ($pwd_cmd) {
      # Isn't this wrong?  _backtick_pwd() will fail if somenone has
      # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
      # See [perl #16774]. --jhi
      $pwd_cmd = 'pwd';
  }
  
  # Lazy-load Carp
  sub _carp  { require Carp; Carp::carp(@_)  }
  sub _croak { require Carp; Carp::croak(@_) }
  
  # The 'natural and safe form' for UNIX (pwd may be setuid root)
  sub _backtick_pwd {
      # Localize %ENV entries in a way that won't create new hash keys
      my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
      local @ENV{@localize};
      
      my $cwd = `$pwd_cmd`;
      # Belt-and-suspenders in case someone said "undef $/".
      local $/ = "\n";
      # `pwd` may fail e.g. if the disk is full
      chomp($cwd) if defined $cwd;
      $cwd;
  }
  
  # Since some ports may predefine cwd internally (e.g., NT)
  # we take care not to override an existing definition for cwd().
  
  unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
      # The pwd command is not available in some chroot(2)'ed environments
      my $sep = $Config::Config{path_sep} || ':';
      my $os = $^O;  # Protect $^O from tainting
  
  
      # Try again to find a pwd, this time searching the whole PATH.
      if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
  	my @candidates = split($sep, $ENV{PATH});
  	while (!$found_pwd_cmd and @candidates) {
  	    my $candidate = shift @candidates;
  	    $found_pwd_cmd = 1 if -x "$candidate/pwd";
  	}
      }
  
      # MacOS has some special magic to make `pwd` work.
      if( $os eq 'MacOS' || $found_pwd_cmd )
      {
  	*cwd = \&_backtick_pwd;
      }
      else {
  	*cwd = \&getcwd;
      }
  }
  
  if ($^O eq 'cygwin') {
    # We need to make sure cwd() is called with no args, because it's
    # got an arg-less prototype and will die if args are present.
    local $^W = 0;
    my $orig_cwd = \&cwd;
    *cwd = sub { &$orig_cwd() }
  }
  
  
  # set a reasonable (and very safe) default for fastgetcwd, in case it
  # isn't redefined later (20001212 rspier)
  *fastgetcwd = \&cwd;
  
  # A non-XS version of getcwd() - also used to bootstrap the perl build
  # process, when miniperl is running and no XS loading happens.
  sub _perl_getcwd
  {
      abs_path('.');
  }
  
  # By John Bazik
  #
  # Usage: $cwd = &fastcwd;
  #
  # This is a faster version of getcwd.  It's also more dangerous because
  # you might chdir out of a directory that you can't chdir back into.
      
  sub fastcwd_ {
      my($odev, $oino, $cdev, $cino, $tdev, $tino);
      my(@path, $path);
      local(*DIR);
  
      my($orig_cdev, $orig_cino) = stat('.');
      ($cdev, $cino) = ($orig_cdev, $orig_cino);
      for (;;) {
  	my $direntry;
  	($odev, $oino) = ($cdev, $cino);
  	CORE::chdir('..') || return undef;
  	($cdev, $cino) = stat('.');
  	last if $odev == $cdev && $oino == $cino;
  	opendir(DIR, '.') || return undef;
  	for (;;) {
  	    $direntry = readdir(DIR);
  	    last unless defined $direntry;
  	    next if $direntry eq '.';
  	    next if $direntry eq '..';
  
  	    ($tdev, $tino) = lstat($direntry);
  	    last unless $tdev != $odev || $tino != $oino;
  	}
  	closedir(DIR);
  	return undef unless defined $direntry; # should never happen
  	unshift(@path, $direntry);
      }
      $path = '/' . join('/', @path);
      if ($^O eq 'apollo') { $path = "/".$path; }
      # At this point $path may be tainted (if tainting) and chdir would fail.
      # Untaint it then check that we landed where we started.
      $path =~ /^(.*)\z/s		# untaint
  	&& CORE::chdir($1) or return undef;
      ($cdev, $cino) = stat('.');
      die "Unstable directory path, current directory changed unexpectedly"
  	if $cdev != $orig_cdev || $cino != $orig_cino;
      $path;
  }
  if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
  
  
  # Keeps track of current working directory in PWD environment var
  # Usage:
  #	use Cwd 'chdir';
  #	chdir $newdir;
  
  my $chdir_init = 0;
  
  sub chdir_init {
      if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
  	my($dd,$di) = stat('.');
  	my($pd,$pi) = stat($ENV{'PWD'});
  	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
  	    $ENV{'PWD'} = cwd();
  	}
      }
      else {
  	my $wd = cwd();
  	$wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
  	$ENV{'PWD'} = $wd;
      }
      # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
      if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
  	my($pd,$pi) = stat($2);
  	my($dd,$di) = stat($1);
  	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
  	    $ENV{'PWD'}="$2$3";
  	}
      }
      $chdir_init = 1;
  }
  
  sub chdir {
      my $newdir = @_ ? shift : '';	# allow for no arg (chdir to HOME dir)
      $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
      chdir_init() unless $chdir_init;
      my $newpwd;
      if ($^O eq 'MSWin32') {
  	# get the full path name *before* the chdir()
  	$newpwd = Win32::GetFullPathName($newdir);
      }
  
      return 0 unless CORE::chdir $newdir;
  
      if ($^O eq 'VMS') {
  	return $ENV{'PWD'} = $ENV{'DEFAULT'}
      }
      elsif ($^O eq 'MacOS') {
  	return $ENV{'PWD'} = cwd();
      }
      elsif ($^O eq 'MSWin32') {
  	$ENV{'PWD'} = $newpwd;
  	return 1;
      }
  
      if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
  	$ENV{'PWD'} = cwd();
      } elsif ($newdir =~ m#^/#s) {
  	$ENV{'PWD'} = $newdir;
      } else {
  	my @curdir = split(m#/#,$ENV{'PWD'});
  	@curdir = ('') unless @curdir;
  	my $component;
  	foreach $component (split(m#/#, $newdir)) {
  	    next if $component eq '.';
  	    pop(@curdir),next if $component eq '..';
  	    push(@curdir,$component);
  	}
  	$ENV{'PWD'} = join('/',@curdir) || '/';
      }
      1;
  }
  
  
  sub _perl_abs_path
  {
      my $start = @_ ? shift : '.';
      my($dotdots, $cwd, @pst, @cst, $dir, @tst);
  
      unless (@cst = stat( $start ))
      {
  	_carp("stat($start): $!");
  	return '';
      }
  
      unless (-d _) {
          # Make sure we can be invoked on plain files, not just directories.
          # NOTE that this routine assumes that '/' is the only directory separator.
  	
          my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
  	    or return cwd() . '/' . $start;
  	
  	# Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
  	if (-l $start) {
  	    my $link_target = readlink($start);
  	    die "Can't resolve link $start: $!" unless defined $link_target;
  	    
  	    require File::Spec;
              $link_target = $dir . '/' . $link_target
                  unless File::Spec->file_name_is_absolute($link_target);
  	    
  	    return abs_path($link_target);
  	}
  	
  	return $dir ? abs_path($dir) . "/$file" : "/$file";
      }
  
      $cwd = '';
      $dotdots = $start;
      do
      {
  	$dotdots .= '/..';
  	@pst = @cst;
  	local *PARENT;
  	unless (opendir(PARENT, $dotdots))
  	{
  	    # probably a permissions issue.  Try the native command.
  	    require File::Spec;
  	    return File::Spec->rel2abs( $start, _backtick_pwd() );
  	}
  	unless (@cst = stat($dotdots))
  	{
  	    _carp("stat($dotdots): $!");
  	    closedir(PARENT);
  	    return '';
  	}
  	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
  	{
  	    $dir = undef;
  	}
  	else
  	{
  	    do
  	    {
  		unless (defined ($dir = readdir(PARENT)))
  	        {
  		    _carp("readdir($dotdots): $!");
  		    closedir(PARENT);
  		    return '';
  		}
  		$tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
  	    }
  	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
  		   $tst[1] != $pst[1]);
  	}
  	$cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
  	closedir(PARENT);
      } while (defined $dir);
      chop($cwd) unless $cwd eq '/'; # drop the trailing /
      $cwd;
  }
  
  
  my $Curdir;
  sub fast_abs_path {
      local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
      my $cwd = getcwd();
      require File::Spec;
      my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
  
      # Detaint else we'll explode in taint mode.  This is safe because
      # we're not doing anything dangerous with it.
      ($path) = $path =~ /(.*)/s;
      ($cwd)  = $cwd  =~ /(.*)/s;
  
      unless (-e $path) {
   	_croak("$path: No such file or directory");
      }
  
      unless (-d _) {
          # Make sure we can be invoked on plain files, not just directories.
  	
  	my ($vol, $dir, $file) = File::Spec->splitpath($path);
  	return File::Spec->catfile($cwd, $path) unless length $dir;
  
  	if (-l $path) {
  	    my $link_target = readlink($path);
  	    die "Can't resolve link $path: $!" unless defined $link_target;
  	    
  	    $link_target = File::Spec->catpath($vol, $dir, $link_target)
                  unless File::Spec->file_name_is_absolute($link_target);
  	    
  	    return fast_abs_path($link_target);
  	}
  	
  	return $dir eq File::Spec->rootdir
  	  ? File::Spec->catpath($vol, $dir, $file)
  	  : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
      }
  
      if (!CORE::chdir($path)) {
   	_croak("Cannot chdir to $path: $!");
      }
      my $realpath = getcwd();
      if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
   	_croak("Cannot chdir back to $cwd: $!");
      }
      $realpath;
  }
  
  # added function alias to follow principle of least surprise
  # based on previous aliasing.  --tchrist 27-Jan-00
  *fast_realpath = \&fast_abs_path;
  
  
  # --- PORTING SECTION ---
  
  # VMS: $ENV{'DEFAULT'} points to default directory at all times
  # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
  # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
  #   in the process logical name table as the default device and directory
  #   seen by Perl. This may not be the same as the default device
  #   and directory seen by DCL after Perl exits, since the effects
  #   the CRTL chdir() function persist only until Perl exits.
  
  sub _vms_cwd {
      return $ENV{'DEFAULT'};
  }
  
  sub _vms_abs_path {
      return $ENV{'DEFAULT'} unless @_;
      my $path = shift;
  
      my $efs = _vms_efs;
      my $unix_rpt = _vms_unix_rpt;
  
      if (defined &VMS::Filespec::vmsrealpath) {
          my $path_unix = 0;
          my $path_vms = 0;
  
          $path_unix = 1 if ($path =~ m#(?<=\^)/#);
          $path_unix = 1 if ($path =~ /^\.\.?$/);
          $path_vms = 1 if ($path =~ m#[\[<\]]#);
          $path_vms = 1 if ($path =~ /^--?$/);
  
          my $unix_mode = $path_unix;
          if ($efs) {
              # In case of a tie, the Unix report mode decides.
              if ($path_vms == $path_unix) {
                  $unix_mode = $unix_rpt;
              } else {
                  $unix_mode = 0 if $path_vms;
              }
          }
  
          if ($unix_mode) {
              # Unix format
              return VMS::Filespec::unixrealpath($path);
          }
  
  	# VMS format
  
  	my $new_path = VMS::Filespec::vmsrealpath($path);
  
  	# Perl expects directories to be in directory format
  	$new_path = VMS::Filespec::pathify($new_path) if -d $path;
  	return $new_path;
      }
  
      # Fallback to older algorithm if correct ones are not
      # available.
  
      if (-l $path) {
          my $link_target = readlink($path);
          die "Can't resolve link $path: $!" unless defined $link_target;
  
          return _vms_abs_path($link_target);
      }
  
      # may need to turn foo.dir into [.foo]
      my $pathified = VMS::Filespec::pathify($path);
      $path = $pathified if defined $pathified;
  	
      return VMS::Filespec::rmsexpand($path);
  }
  
  sub _os2_cwd {
      $ENV{'PWD'} = `cmd /c cd`;
      chomp $ENV{'PWD'};
      $ENV{'PWD'} =~ s:\\:/:g ;
      return $ENV{'PWD'};
  }
  
  sub _win32_cwd_simple {
      $ENV{'PWD'} = `cd`;
      chomp $ENV{'PWD'};
      $ENV{'PWD'} =~ s:\\:/:g ;
      return $ENV{'PWD'};
  }
  
  sub _win32_cwd {
      # Need to avoid taking any sort of reference to the typeglob or the code in
      # the optree, so that this tests the runtime state of things, as the
      # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
      # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
      # lookup avoids needing a string eval, which has been reported to cause
      # problems (for reasons that we haven't been able to get to the bottom of -
      # rt.cpan.org #56225)
      if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
  	$ENV{'PWD'} = Win32::GetCwd();
      }
      else { # miniperl
  	chomp($ENV{'PWD'} = `cd`);
      }
      $ENV{'PWD'} =~ s:\\:/:g ;
      return $ENV{'PWD'};
  }
  
  *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
  
  sub _dos_cwd {
      if (!defined &Dos::GetCwd) {
          $ENV{'PWD'} = `command /c cd`;
          chomp $ENV{'PWD'};
          $ENV{'PWD'} =~ s:\\:/:g ;
      } else {
          $ENV{'PWD'} = Dos::GetCwd();
      }
      return $ENV{'PWD'};
  }
  
  sub _qnx_cwd {
  	local $ENV{PATH} = '';
  	local $ENV{CDPATH} = '';
  	local $ENV{ENV} = '';
      $ENV{'PWD'} = `/usr/bin/fullpath -t`;
      chomp $ENV{'PWD'};
      return $ENV{'PWD'};
  }
  
  sub _qnx_abs_path {
  	local $ENV{PATH} = '';
  	local $ENV{CDPATH} = '';
  	local $ENV{ENV} = '';
      my $path = @_ ? shift : '.';
      local *REALPATH;
  
      defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
        die "Can't open /usr/bin/fullpath: $!";
      my $realpath = <REALPATH>;
      close REALPATH;
      chomp $realpath;
      return $realpath;
  }
  
  sub _epoc_cwd {
      $ENV{'PWD'} = EPOC::getcwd();
      return $ENV{'PWD'};
  }
  
  
  # Now that all the base-level functions are set up, alias the
  # user-level functions to the right places
  
  if (exists $METHOD_MAP{$^O}) {
    my $map = $METHOD_MAP{$^O};
    foreach my $name (keys %$map) {
      local $^W = 0;  # assignments trigger 'subroutine redefined' warning
      no strict 'refs';
      *{$name} = \&{$map->{$name}};
    }
  }
  
  # In case the XS version doesn't load.
  *abs_path = \&_perl_abs_path unless defined &abs_path;
  *getcwd = \&_perl_getcwd unless defined &getcwd;
  
  # added function alias for those of us more
  # used to the libc function.  --tchrist 27-Jan-00
  *realpath = \&abs_path;
  
  1;
DARWIN-2LEVEL_CWD

$fatpacked{"File/Spec.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC';
  package File::Spec;
  
  use strict;
  use vars qw(@ISA $VERSION);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  my %module = (MacOS   => 'Mac',
  	      MSWin32 => 'Win32',
  	      os2     => 'OS2',
  	      VMS     => 'VMS',
  	      epoc    => 'Epoc',
  	      NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
  	      symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
  	      dos     => 'OS2',   # Yes, File::Spec::OS2 works on DJGPP.
  	      cygwin  => 'Cygwin');
  
  
  my $module = $module{$^O} || 'Unix';
  
  require "File/Spec/$module.pm";
  @ISA = ("File::Spec::$module");
  
  1;
  
  __END__
  
  =head1 NAME
  
  File::Spec - portably perform operations on file names
  
  =head1 SYNOPSIS
  
  	use File::Spec;
  
  	$x=File::Spec->catfile('a', 'b', 'c');
  
  which returns 'a/b/c' under Unix. Or:
  
  	use File::Spec::Functions;
  
  	$x = catfile('a', 'b', 'c');
  
  =head1 DESCRIPTION
  
  This module is designed to support operations commonly performed on file
  specifications (usually called "file names", but not to be confused with the
  contents of a file, or Perl's file handles), such as concatenating several
  directory and file names into a single path, or determining whether a path
  is rooted. It is based on code directly taken from MakeMaker 5.17, code
  written by Andreas KE<ouml>nig, Andy Dougherty, Charles Bailey, Ilya
  Zakharevich, Paul Schinder, and others.
  
  Since these functions are different for most operating systems, each set of
  OS specific routines is available in a separate module, including:
  
  	File::Spec::Unix
  	File::Spec::Mac
  	File::Spec::OS2
  	File::Spec::Win32
  	File::Spec::VMS
  
  The module appropriate for the current OS is automatically loaded by
  File::Spec. Since some modules (like VMS) make use of facilities available
  only under that OS, it may not be possible to load all modules under all
  operating systems.
  
  Since File::Spec is object oriented, subroutines should not be called directly,
  as in:
  
  	File::Spec::catfile('a','b');
  
  but rather as class methods:
  
  	File::Spec->catfile('a','b');
  
  For simple uses, L<File::Spec::Functions> provides convenient functional
  forms of these methods.
  
  =head1 METHODS
  
  =over 2
  
  =item canonpath
  X<canonpath>
  
  No physical check on the filesystem, but a logical cleanup of a
  path.
  
      $cpath = File::Spec->canonpath( $path ) ;
  
  Note that this does *not* collapse F<x/../y> sections into F<y>.  This
  is by design.  If F</foo> on your system is a symlink to F</bar/baz>,
  then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
  F<../>-removal would give you.  If you want to do this kind of
  processing, you probably want C<Cwd>'s C<realpath()> function to
  actually traverse the filesystem cleaning up paths like this.
  
  =item catdir
  X<catdir>
  
  Concatenate two or more directory names to form a complete path ending
  with a directory. But remove the trailing slash from the resulting
  string, because it doesn't look good, isn't necessary and confuses
  OS/2. Of course, if this is the root directory, don't cut off the
  trailing slash :-)
  
      $path = File::Spec->catdir( @directories );
  
  =item catfile
  X<catfile>
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename
  
      $path = File::Spec->catfile( @directories, $filename );
  
  =item curdir
  X<curdir>
  
  Returns a string representation of the current directory.
  
      $curdir = File::Spec->curdir();
  
  =item devnull
  X<devnull>
  
  Returns a string representation of the null device.
  
      $devnull = File::Spec->devnull();
  
  =item rootdir
  X<rootdir>
  
  Returns a string representation of the root directory.
  
      $rootdir = File::Spec->rootdir();
  
  =item tmpdir
  X<tmpdir>
  
  Returns a string representation of the first writable directory from a
  list of possible temporary directories.  Returns the current directory
  if no writable temporary directories are found.  The list of directories
  checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}>
  (unless taint is on) and F</tmp>.
  
      $tmpdir = File::Spec->tmpdir();
  
  =item updir
  X<updir>
  
  Returns a string representation of the parent directory.
  
      $updir = File::Spec->updir();
  
  =item no_upwards
  
  Given a list of file names, strip out those that refer to a parent
  directory. (Does not strip symlinks, only '.', '..', and equivalents.)
  
      @paths = File::Spec->no_upwards( @paths );
  
  =item case_tolerant
  
  Returns a true or false value indicating, respectively, that alphabetic
  case is not or is significant when comparing file specifications.
  Cygwin and Win32 accept an optional drive argument.
  
      $is_case_tolerant = File::Spec->case_tolerant();
  
  =item file_name_is_absolute
  
  Takes as its argument a path, and returns true if it is an absolute path.
  
      $is_absolute = File::Spec->file_name_is_absolute( $path );
  
  This does not consult the local filesystem on Unix, Win32, OS/2, or
  Mac OS (Classic).  It does consult the working environment for VMS
  (see L<File::Spec::VMS/file_name_is_absolute>).
  
  =item path
  X<path>
  
  Takes no argument.  Returns the environment variable C<PATH> (or the local
  platform's equivalent) as a list.
  
      @PATH = File::Spec->path();
  
  =item join
  X<join, path>
  
  join is the same as catfile.
  
  =item splitpath
  X<splitpath> X<split, path>
  
  Splits a path in to volume, directory, and filename portions. On systems
  with no concept of volume, returns '' for volume. 
  
      ($volume,$directories,$file) =
                         File::Spec->splitpath( $path );
      ($volume,$directories,$file) =
                         File::Spec->splitpath( $path, $no_file );
  
  For systems with no syntax differentiating filenames from directories, 
  assumes that the last file is a path unless C<$no_file> is true or a
  trailing separator or F</.> or F</..> is present. On Unix, this means that C<$no_file>
  true makes this return ( '', $path, '' ).
  
  The directory portion may or may not be returned with a trailing '/'.
  
  The results can be passed to L</catpath()> to get back a path equivalent to
  (usually identical to) the original path.
  
  =item splitdir
  X<splitdir> X<split, dir>
  
  The opposite of L</catdir>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  C<$directories> must be only the directory portion of the path on systems 
  that have the concept of a volume or that have path syntax that differentiates
  files from directories.
  
  Unlike just splitting the directories on the separator, empty
  directory names (C<''>) can be returned, because these are significant
  on some OSes.
  
  =item catpath()
  
  Takes volume, directory and file portions and returns an entire path. Under
  Unix, C<$volume> is ignored, and directory and file are concatenated.  A '/' is
  inserted if need be.  On other OSes, C<$volume> is significant.
  
      $full_path = File::Spec->catpath( $volume, $directory, $file );
  
  =item abs2rel
  X<abs2rel> X<absolute, path> X<relative, path>
  
  Takes a destination path and an optional base path returns a relative path
  from the base path to the destination path:
  
      $rel_path = File::Spec->abs2rel( $path ) ;
      $rel_path = File::Spec->abs2rel( $path, $base ) ;
  
  If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is
  relative, then it is converted to absolute form using
  L</rel2abs()>. This means that it is taken to be relative to
  L<Cwd::cwd()|Cwd>.
  
  On systems with the concept of volume, if C<$path> and C<$base> appear to be
  on two different volumes, we will not attempt to resolve the two
  paths, and we will instead simply return C<$path>.  Note that previous
  versions of this module ignored the volume of C<$base>, which resulted in
  garbage results part of the time.
  
  On systems that have a grammar that indicates filenames, this ignores the 
  C<$base> filename as well. Otherwise all path components are assumed to be
  directories.
  
  If C<$path> is relative, it is converted to absolute form using L</rel2abs()>.
  This means that it is taken to be relative to L<Cwd::cwd()|Cwd>.
  
  No checks against the filesystem are made.  On VMS, there is
  interaction with the working environment, as logicals and
  macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =item rel2abs()
  X<rel2abs> X<absolute, path> X<relative, path>
  
  Converts a relative path to an absolute path. 
  
      $abs_path = File::Spec->rel2abs( $path ) ;
      $abs_path = File::Spec->rel2abs( $path, $base ) ;
  
  If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is relative,
  then it is converted to absolute form using L</rel2abs()>. This means that it
  is taken to be relative to L<Cwd::cwd()|Cwd>.
  
  On systems with the concept of volume, if C<$path> and C<$base> appear to be
  on two different volumes, we will not attempt to resolve the two
  paths, and we will instead simply return C<$path>.  Note that previous
  versions of this module ignored the volume of C<$base>, which resulted in
  garbage results part of the time.
  
  On systems that have a grammar that indicates filenames, this ignores the 
  C<$base> filename as well. Otherwise all path components are assumed to be
  directories.
  
  If C<$path> is absolute, it is cleaned up and returned using L</canonpath>.
  
  No checks against the filesystem are made.  On VMS, there is
  interaction with the working environment, as logicals and
  macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =back
  
  For further information, please see L<File::Spec::Unix>,
  L<File::Spec::Mac>, L<File::Spec::OS2>, L<File::Spec::Win32>, or
  L<File::Spec::VMS>.
  
  =head1 SEE ALSO
  
  L<File::Spec::Unix>, L<File::Spec::Mac>, L<File::Spec::OS2>,
  L<File::Spec::Win32>, L<File::Spec::VMS>, L<File::Spec::Functions>,
  L<ExtUtils::MakeMaker>
  
  =head1 AUTHOR
  
  Currently maintained by Ken Williams C<< <KWILLIAMS@cpan.org> >>.
  
  The vast majority of the code was written by
  Kenneth Albanowski C<< <kjahds@kjahds.com> >>,
  Andy Dougherty C<< <doughera@lafayette.edu> >>,
  Andreas KE<ouml>nig C<< <A.Koenig@franz.ww.TU-Berlin.DE> >>,
  Tim Bunce C<< <Tim.Bunce@ig.co.uk> >>.
  VMS support by Charles Bailey C<< <bailey@newman.upenn.edu> >>.
  OS/2 support by Ilya Zakharevich C<< <ilya@math.ohio-state.edu> >>.
  Mac support by Paul Schinder C<< <schinder@pobox.com> >>, and
  Thomas Wegner C<< <wegner_thomas@yahoo.com> >>.
  abs2rel() and rel2abs() written by Shigio Yamaguchi C<< <shigio@tamacom.com> >>,
  modified by Barrie Slaymaker C<< <barries@slaysys.com> >>.
  splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004-2013 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
DARWIN-2LEVEL_FILE_SPEC

$fatpacked{"File/Spec/Cygwin.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_CYGWIN';
  package File::Spec::Cygwin;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  =head1 NAME
  
  File::Spec::Cygwin - methods for Cygwin file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::Cygwin; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  This module is still in beta.  Cygwin-knowledgeable folks are invited
  to offer patches and suggestions.
  
  =cut
  
  =pod
  
  =over 4
  
  =item canonpath
  
  Any C<\> (backslashes) are converted to C</> (forward slashes),
  and then File::Spec::Unix canonpath() is called on the result.
  
  =cut
  
  sub canonpath {
      my($self,$path) = @_;
      return unless defined $path;
  
      $path =~ s|\\|/|g;
  
      # Handle network path names beginning with double slash
      my $node = '';
      if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) {
          $node = $1;
      }
      return $node . $self->SUPER::canonpath($path);
  }
  
  sub catdir {
      my $self = shift;
      return unless @_;
  
      # Don't create something that looks like a //network/path
      if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
          shift;
          return $self->SUPER::catdir('', @_);
      }
  
      $self->SUPER::catdir(@_);
  }
  
  =pod
  
  =item file_name_is_absolute
  
  True is returned if the file name begins with C<drive_letter:>,
  and if not, File::Spec::Unix file_name_is_absolute() is called.
  
  =cut
  
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
      return $self->SUPER::file_name_is_absolute($file);
  }
  
  =item tmpdir (override)
  
  Returns a string representation of the first existing directory
  from the following list:
  
      $ENV{TMPDIR}
      /tmp
      $ENV{'TMP'}
      $ENV{'TEMP'}
      C:/temp
  
  Since Perl 5.8.0, if running under taint mode, and if the environment
  variables are tainted, they are not used.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' );
  }
  
  =item case_tolerant
  
  Override Unix. Cygwin case-tolerance depends on managed mount settings and
  as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
  indicating the case significance when comparing file specifications.
  Default: 1
  
  =cut
  
  sub case_tolerant {
    return 1 unless $^O eq 'cygwin'
      and defined &Cygwin::mount_flags;
  
    my $drive = shift;
    if (! $drive) {
        my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
        my $prefix = pop(@flags);
        if (! $prefix || $prefix eq 'cygdrive') {
            $drive = '/cygdrive/c';
        } elsif ($prefix eq '/') {
            $drive = '/c';
        } else {
            $drive = "$prefix/c";
        }
    }
    my $mntopts = Cygwin::mount_flags($drive);
    if ($mntopts and ($mntopts =~ /,managed/)) {
      return 0;
    }
    eval { require Win32API::File; } or return 1;
    my $osFsType = "\0"x256;
    my $osVolName = "\0"x256;
    my $ouFsFlags = 0;
    Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
    if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
    else { return 1; }
  }
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
  
  1;
DARWIN-2LEVEL_FILE_SPEC_CYGWIN

$fatpacked{"File/Spec/Epoc.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_EPOC';
  package File::Spec::Epoc;
  
  use strict;
  use vars qw($VERSION @ISA);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  require File::Spec::Unix;
  @ISA = qw(File::Spec::Unix);
  
  =head1 NAME
  
  File::Spec::Epoc - methods for Epoc file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::Epoc; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See File::Spec::Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  This package is still work in progress ;-)
  
  =cut
  
  sub case_tolerant {
      return 1;
  }
  
  =pod
  
  =over 4
  
  =item canonpath()
  
  No physical check on the filesystem, but a logical cleanup of a
  path. On UNIX eliminated successive slashes and successive "/.".
  
  =back
  
  =cut
  
  sub canonpath {
      my ($self,$path) = @_;
      return unless defined $path;
  
      $path =~ s|/+|/|g;                             # xx////xx  -> xx/xx
      $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
      $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
      $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
      $path =~  s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
      return $path;
  }
  
  =pod
  
  =head1 AUTHOR
  
  o.flebbe@gmx.de
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  =cut
  
  1;
DARWIN-2LEVEL_FILE_SPEC_EPOC

$fatpacked{"File/Spec/Functions.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_FUNCTIONS';
  package File::Spec::Functions;
  
  use File::Spec;
  use strict;
  
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  require Exporter;
  
  @ISA = qw(Exporter);
  
  @EXPORT = qw(
  	canonpath
  	catdir
  	catfile
  	curdir
  	rootdir
  	updir
  	no_upwards
  	file_name_is_absolute
  	path
  );
  
  @EXPORT_OK = qw(
  	devnull
  	tmpdir
  	splitpath
  	splitdir
  	catpath
  	abs2rel
  	rel2abs
  	case_tolerant
  );
  
  %EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );
  
  foreach my $meth (@EXPORT, @EXPORT_OK) {
      my $sub = File::Spec->can($meth);
      no strict 'refs';
      *{$meth} = sub {&$sub('File::Spec', @_)};
  }
  
  
  1;
  __END__
  
  =head1 NAME
  
  File::Spec::Functions - portably perform operations on file names
  
  =head1 SYNOPSIS
  
  	use File::Spec::Functions;
  	$x = catfile('a','b');
  
  =head1 DESCRIPTION
  
  This module exports convenience functions for all of the class methods
  provided by File::Spec.
  
  For a reference of available functions, please consult L<File::Spec::Unix>,
  which contains the entire set, and which is inherited by the modules for
  other platforms. For further information, please see L<File::Spec::Mac>,
  L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
  
  =head2 Exports
  
  The following functions are exported by default.
  
  	canonpath
  	catdir
  	catfile
  	curdir
  	rootdir
  	updir
  	no_upwards
  	file_name_is_absolute
  	path
  
  
  The following functions are exported only by request.
  
  	devnull
  	tmpdir
  	splitpath
  	splitdir
  	catpath
  	abs2rel
  	rel2abs
  	case_tolerant
  
  All the functions may be imported using the C<:ALL> tag.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2,
  File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker
  
  =cut
  
DARWIN-2LEVEL_FILE_SPEC_FUNCTIONS

$fatpacked{"File/Spec/Mac.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_MAC';
  package File::Spec::Mac;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  my $macfiles;
  if ($^O eq 'MacOS') {
  	$macfiles = eval { require Mac::Files };
  }
  
  sub case_tolerant { 1 }
  
  
  =head1 NAME
  
  File::Spec::Mac - File::Spec for Mac OS (Classic)
  
  =head1 SYNOPSIS
  
   require File::Spec::Mac; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  Methods for manipulating file specifications.
  
  =head1 METHODS
  
  =over 2
  
  =item canonpath
  
  On Mac OS, there's nothing to be done. Returns what it's given.
  
  =cut
  
  sub canonpath {
      my ($self,$path) = @_;
      return $path;
  }
  
  =item catdir()
  
  Concatenate two or more directory names to form a path separated by colons
  (":") ending with a directory. Resulting paths are B<relative> by default,
  but can be forced to be absolute (but avoid this, see below). Automatically
  puts a trailing ":" on the end of the complete path, because that's what's
  done in MacPerl's environment and helps to distinguish a file path from a
  directory path.
  
  B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
  path is relative by default and I<not> absolute. This decision was made due
  to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
  on all other operating systems, it will now also follow this convention on Mac
  OS. Note that this may break some existing scripts.
  
  The intended purpose of this routine is to concatenate I<directory names>.
  But because of the nature of Macintosh paths, some additional possibilities
  are allowed to make using this routine give reasonable results for some
  common situations. In other words, you are also allowed to concatenate
  I<paths> instead of directory names (strictly speaking, a string like ":a"
  is a path, but not a name, since it contains a punctuation character ":").
  
  So, beside calls like
  
      catdir("a") = ":a:"
      catdir("a","b") = ":a:b:"
      catdir() = ""                    (special case)
  
  calls like the following
  
      catdir(":a:") = ":a:"
      catdir(":a","b") = ":a:b:"
      catdir(":a:","b") = ":a:b:"
      catdir(":a:",":b:") = ":a:b:"
      catdir(":") = ":"
  
  are allowed.
  
  Here are the rules that are used in C<catdir()>; note that we try to be as
  compatible as possible to Unix:
  
  =over 2
  
  =item 1.
  
  The resulting path is relative by default, i.e. the resulting path will have a
  leading colon.
  
  =item 2.
  
  A trailing colon is added automatically to the resulting path, to denote a
  directory.
  
  =item 3.
  
  Generally, each argument has one leading ":" and one trailing ":"
  removed (if any). They are then joined together by a ":". Special
  treatment applies for arguments denoting updir paths like "::lib:",
  see (4), or arguments consisting solely of colons ("colon paths"),
  see (5).
  
  =item 4.
  
  When an updir path like ":::lib::" is passed as argument, the number
  of directories to climb up is handled correctly, not removing leading
  or trailing colons when necessary. E.g.
  
      catdir(":::a","::b","c")    = ":::a::b:c:"
      catdir(":::a::","::b","c")  = ":::a:::b:c:"
  
  =item 5.
  
  Adding a colon ":" or empty string "" to a path at I<any> position
  doesn't alter the path, i.e. these arguments are ignored. (When a ""
  is passed as the first argument, it has a special meaning, see
  (6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
  while an empty string "" is generally ignored (see
  C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
  (updir), and a ":::" is handled like a "../.." etc.  E.g.
  
      catdir("a",":",":","b")   = ":a:b:"
      catdir("a",":","::",":b") = ":a::b:"
  
  =item 6.
  
  If the first argument is an empty string "" or is a volume name, i.e. matches
  the pattern /^[^:]+:/, the resulting path is B<absolute>.
  
  =item 7.
  
  Passing an empty string "" as the first argument to C<catdir()> is
  like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e.
  
      catdir("","a","b")          is the same as
  
      catdir(rootdir(),"a","b").
  
  This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
  C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
  volume, which is the closest in concept to Unix' "/". This should help
  to run existing scripts originally written for Unix.
  
  =item 8.
  
  For absolute paths, some cleanup is done, to ensure that the volume
  name isn't immediately followed by updirs. This is invalid, because
  this would go beyond "root". Generally, these cases are handled like
  their Unix counterparts:
  
   Unix:
      Unix->catdir("","")                 =  "/"
      Unix->catdir("",".")                =  "/"
      Unix->catdir("","..")               =  "/"        # can't go
                                                        # beyond root
      Unix->catdir("",".","..","..","a")  =  "/a"
   Mac:
      Mac->catdir("","")                  =  rootdir()  # (e.g. "HD:")
      Mac->catdir("",":")                 =  rootdir()
      Mac->catdir("","::")                =  rootdir()  # can't go
                                                        # beyond root
      Mac->catdir("",":","::","::","a")   =  rootdir() . "a:"
                                                      # (e.g. "HD:a:")
  
  However, this approach is limited to the first arguments following
  "root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
  arguments that move up the directory tree, an invalid path going
  beyond root can be created.
  
  =back
  
  As you've seen, you can force C<catdir()> to create an absolute path
  by passing either an empty string or a path that begins with a volume
  name as the first argument. However, you are strongly encouraged not
  to do so, since this is done only for backward compatibility. Newer
  versions of File::Spec come with a method called C<catpath()> (see
  below), that is designed to offer a portable solution for the creation
  of absolute paths.  It takes volume, directory and file portions and
  returns an entire path. While C<catdir()> is still suitable for the
  concatenation of I<directory names>, you are encouraged to use
  C<catpath()> to concatenate I<volume names> and I<directory
  paths>. E.g.
  
      $dir      = File::Spec->catdir("tmp","sources");
      $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
  
  yields
  
      "MacintoshHD:tmp:sources:" .
  
  =cut
  
  sub catdir {
  	my $self = shift;
  	return '' unless @_;
  	my @args = @_;
  	my $first_arg;
  	my $relative;
  
  	# take care of the first argument
  
  	if ($args[0] eq '')  { # absolute path, rootdir
  		shift @args;
  		$relative = 0;
  		$first_arg = $self->rootdir;
  
  	} elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
  		$relative = 0;
  		$first_arg = shift @args;
  		# add a trailing ':' if need be (may be it's a path like HD:dir)
  		$first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
  
  	} else { # relative path
  		$relative = 1;
  		if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
  			# updir colon path ('::', ':::' etc.), don't shift
  			$first_arg = ':';
  		} elsif ($args[0] eq ':') {
  			$first_arg = shift @args;
  		} else {
  			# add a trailing ':' if need be
  			$first_arg = shift @args;
  			$first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
  		}
  	}
  
  	# For all other arguments,
  	# (a) ignore arguments that equal ':' or '',
  	# (b) handle updir paths specially:
  	#     '::' 			-> concatenate '::'
  	#     '::' . '::' 	-> concatenate ':::' etc.
  	# (c) add a trailing ':' if need be
  
  	my $result = $first_arg;
  	while (@args) {
  		my $arg = shift @args;
  		unless (($arg eq '') || ($arg eq ':')) {
  			if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
  				my $updir_count = length($arg) - 1;
  				while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
  					$arg = shift @args;
  					$updir_count += (length($arg) - 1);
  				}
  				$arg = (':' x $updir_count);
  			} else {
  				$arg =~ s/^://s; # remove a leading ':' if any
  				$arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
  			}
  			$result .= $arg;
  		}#unless
  	}
  
  	if ( ($relative) && ($result !~ /^:/) ) {
  		# add a leading colon if need be
  		$result = ":$result";
  	}
  
  	unless ($relative) {
  		# remove updirs immediately following the volume name
  		$result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
  	}
  
  	return $result;
  }
  
  =item catfile
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename. Resulting paths are B<relative>
  by default, but can be forced to be absolute (but avoid this).
  
  B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
  resulting path is relative by default and I<not> absolute. This
  decision was made due to portability reasons. Since
  C<File::Spec-E<gt>catfile()> returns relative paths on all other
  operating systems, it will now also follow this convention on Mac OS.
  Note that this may break some existing scripts.
  
  The last argument is always considered to be the file portion. Since
  C<catfile()> uses C<catdir()> (see above) for the concatenation of the
  directory portions (if any), the following with regard to relative and
  absolute paths is true:
  
      catfile("")     = ""
      catfile("file") = "file"
  
  but
  
      catfile("","")        = rootdir()         # (e.g. "HD:")
      catfile("","file")    = rootdir() . file  # (e.g. "HD:file")
      catfile("HD:","file") = "HD:file"
  
  This means that C<catdir()> is called only when there are two or more
  arguments, as one might expect.
  
  Note that the leading ":" is removed from the filename, so that
  
      catfile("a","b","file")  = ":a:b:file"    and
  
      catfile("a","b",":file") = ":a:b:file"
  
  give the same answer.
  
  To concatenate I<volume names>, I<directory paths> and I<filenames>,
  you are encouraged to use C<catpath()> (see below).
  
  =cut
  
  sub catfile {
      my $self = shift;
      return '' unless @_;
      my $file = pop @_;
      return $file unless @_;
      my $dir = $self->catdir(@_);
      $file =~ s/^://s;
      return $dir.$file;
  }
  
  =item curdir
  
  Returns a string representing the current directory. On Mac OS, this is ":".
  
  =cut
  
  sub curdir {
      return ":";
  }
  
  =item devnull
  
  Returns a string representing the null device. On Mac OS, this is "Dev:Null".
  
  =cut
  
  sub devnull {
      return "Dev:Null";
  }
  
  =item rootdir
  
  Returns a string representing the root directory.  Under MacPerl,
  returns the name of the startup volume, since that's the closest in
  concept, although other volumes aren't rooted there. The name has a
  trailing ":", because that's the correct specification for a volume
  name on Mac OS.
  
  If Mac::Files could not be loaded, the empty string is returned.
  
  =cut
  
  sub rootdir {
  #
  #  There's no real root directory on Mac OS. The name of the startup
  #  volume is returned, since that's the closest in concept.
  #
      return '' unless $macfiles;
      my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
  	&Mac::Files::kSystemFolderType);
      $system =~ s/:.*\Z(?!\n)/:/s;
      return $system;
  }
  
  =item tmpdir
  
  Returns the contents of $ENV{TMPDIR}, if that directory exits or the
  current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
  contain a path like "MacintoshHD:Temporary Items:", which is a hidden
  directory on your startup volume.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} );
  }
  
  =item updir
  
  Returns a string representing the parent directory. On Mac OS, this is "::".
  
  =cut
  
  sub updir {
      return "::";
  }
  
  =item file_name_is_absolute
  
  Takes as argument a path and returns true, if it is an absolute path.
  If the path has a leading ":", it's a relative path. Otherwise, it's an
  absolute path, unless the path doesn't contain any colons, i.e. it's a name
  like "a". In this particular case, the path is considered to be relative
  (i.e. it is considered to be a filename). Use ":" in the appropriate place
  in the path if you want to distinguish unambiguously. As a special case,
  the filename '' is always considered to be absolute. Note that with version
  1.2 of File::Spec::Mac, this does no longer consult the local filesystem.
  
  E.g.
  
      File::Spec->file_name_is_absolute("a");         # false (relative)
      File::Spec->file_name_is_absolute(":a:b:");     # false (relative)
      File::Spec->file_name_is_absolute("MacintoshHD:");
                                                      # true (absolute)
      File::Spec->file_name_is_absolute("");          # true (absolute)
  
  
  =cut
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      if ($file =~ /:/) {
  	return (! ($file =~ m/^:/s) );
      } elsif ( $file eq '' ) {
          return 1 ;
      } else {
  	return 0; # i.e. a file like "a"
      }
  }
  
  =item path
  
  Returns the null list for the MacPerl application, since the concept is
  usually meaningless under Mac OS. But if you're using the MacPerl tool under
  MPW, it gives back $ENV{Commands} suitably split, as is done in
  :lib:ExtUtils:MM_Mac.pm.
  
  =cut
  
  sub path {
  #
  #  The concept is meaningless under the MacPerl application.
  #  Under MPW, it has a meaning.
  #
      return unless exists $ENV{Commands};
      return split(/,/, $ENV{Commands});
  }
  
  =item splitpath
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Splits a path into volume, directory, and filename portions.
  
  On Mac OS, assumes that the last part of the path is a filename unless
  $no_file is true or a trailing separator ":" is present.
  
  The volume portion is always returned with a trailing ":". The directory portion
  is always returned with a leading (to denote a relative path) and a trailing ":"
  (to denote a directory). The file portion is always returned I<without> a leading ":".
  Empty portions are returned as empty string ''.
  
  The results can be passed to C<catpath()> to get back a path equivalent to
  (usually identical to) the original path.
  
  
  =cut
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
      my ($volume,$directory,$file);
  
      if ( $nofile ) {
          ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
      }
      else {
          $path =~
              m|^( (?: [^:]+: )? )
                 ( (?: .*: )? )
                 ( .* )
               |xs;
          $volume    = $1;
          $directory = $2;
          $file      = $3;
      }
  
      $volume = '' unless defined($volume);
  	$directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
      if ($directory) {
          # Make sure non-empty directories begin and end in ':'
          $directory .= ':' unless (substr($directory,-1) eq ':');
          $directory = ":$directory" unless (substr($directory,0,1) eq ':');
      } else {
  	$directory = '';
      }
      $file = '' unless defined($file);
  
      return ($volume,$directory,$file);
  }
  
  
  =item splitdir
  
  The opposite of C<catdir()>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  $directories should be only the directory portion of the path on systems
  that have the concept of a volume or that have path syntax that differentiates
  files from directories. Consider using C<splitpath()> otherwise.
  
  Unlike just splitting the directories on the separator, empty directory names
  (C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
  colon to distinguish a directory path from a file path, a single trailing colon
  will be ignored, i.e. there's no empty directory name after it.
  
  Hence, on Mac OS, both
  
      File::Spec->splitdir( ":a:b::c:" );    and
      File::Spec->splitdir( ":a:b::c" );
  
  yield:
  
      ( "a", "b", "::", "c")
  
  while
  
      File::Spec->splitdir( ":a:b::c::" );
  
  yields:
  
      ( "a", "b", "::", "c", "::")
  
  
  =cut
  
  sub splitdir {
  	my ($self, $path) = @_;
  	my @result = ();
  	my ($head, $sep, $tail, $volume, $directories);
  
  	return @result if ( (!defined($path)) || ($path eq '') );
  	return (':') if ($path eq ':');
  
  	( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
  
  	# deprecated, but handle it correctly
  	if ($volume) {
  		push (@result, $volume);
  		$sep .= ':';
  	}
  
  	while ($sep || $directories) {
  		if (length($sep) > 1) {
  			my $updir_count = length($sep) - 1;
  			for (my $i=0; $i<$updir_count; $i++) {
  				# push '::' updir_count times;
  				# simulate Unix '..' updirs
  				push (@result, '::');
  			}
  		}
  		$sep = '';
  		if ($directories) {
  			( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
  			push (@result, $head);
  			$directories = $tail;
  		}
  	}
  	return @result;
  }
  
  
  =item catpath
  
      $path = File::Spec->catpath($volume,$directory,$file);
  
  Takes volume, directory and file portions and returns an entire path. On Mac OS,
  $volume, $directory and $file are concatenated.  A ':' is inserted if need be. You
  may pass an empty string for each portion. If all portions are empty, the empty
  string is returned. If $volume is empty, the result will be a relative path,
  beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
  is removed form $file and the remainder is returned. If $file is empty, the
  resulting path will have a trailing ':'.
  
  
  =cut
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      if ( (! $volume) && (! $directory) ) {
  	$file =~ s/^:// if $file;
  	return $file ;
      }
  
      # We look for a volume in $volume, then in $directory, but not both
  
      my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
  
      $volume = $dir_volume unless length $volume;
      my $path = $volume; # may be ''
      $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
  
      if ($directory) {
  	$directory = $dir_dirs if $volume;
  	$directory =~ s/^://; # remove leading ':' if any
  	$path .= $directory;
  	$path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
      }
  
      if ($file) {
  	$file =~ s/^://; # remove leading ':' if any
  	$path .= $file;
      }
  
      return $path;
  }
  
  =item abs2rel
  
  Takes a destination path and an optional base path and returns a relative path
  from the base path to the destination path:
  
      $rel_path = File::Spec->abs2rel( $path ) ;
      $rel_path = File::Spec->abs2rel( $path, $base ) ;
  
  Note that both paths are assumed to have a notation that distinguishes a
  directory path (with trailing ':') from a file path (without trailing ':').
  
  If $base is not present or '', then the current working directory is used.
  If $base is relative, then it is converted to absolute form using C<rel2abs()>.
  This means that it is taken to be relative to the current working directory.
  
  If $path and $base appear to be on two different volumes, we will not
  attempt to resolve the two paths, and we will instead simply return
  $path.  Note that previous versions of this module ignored the volume
  of $base, which resulted in garbage results part of the time.
  
  If $base doesn't have a trailing colon, the last element of $base is
  assumed to be a filename.  This filename is ignored.  Otherwise all path
  components are assumed to be directories.
  
  If $path is relative, it is converted to absolute form using C<rel2abs()>.
  This means that it is taken to be relative to the current working directory.
  
  Based on code written by Shigio Yamaguchi.
  
  
  =cut
  
  # maybe this should be done in canonpath() ?
  sub _resolve_updirs {
  	my $path = shift @_;
  	my $proceed;
  
  	# resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
  	do {
  		$proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
  	} while ($proceed);
  
  	return $path;
  }
  
  
  sub abs2rel {
      my($self,$path,$base) = @_;
  
      # Clean up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          $path = $self->rel2abs( $path ) ;
      }
  
      # Figure out the effective $base and clean it up.
      if ( !defined( $base ) || $base eq '' ) {
  	$base = $self->_cwd();
      }
      elsif ( ! $self->file_name_is_absolute( $base ) ) {
          $base = $self->rel2abs( $base ) ;
  	$base = _resolve_updirs( $base ); # resolve updirs in $base
      }
      else {
  	$base = _resolve_updirs( $base );
      }
  
      # Split up paths - ignore $base's file
      my ( $path_vol, $path_dirs, $path_file ) =  $self->splitpath( $path );
      my ( $base_vol, $base_dirs )             =  $self->splitpath( $base );
  
      return $path unless lc( $path_vol ) eq lc( $base_vol );
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_dirs );
      my @basechunks = $self->splitdir( $base_dirs );
  	
      while ( @pathchunks &&
  	    @basechunks &&
  	    lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
          shift @pathchunks ;
          shift @basechunks ;
      }
  
      # @pathchunks now has the directories to descend in to.
      # ensure relative path, even if @pathchunks is empty
      $path_dirs = $self->catdir( ':', @pathchunks );
  
      # @basechunks now contains the number of directories to climb out of.
      $base_dirs = (':' x @basechunks) . ':' ;
  
      return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
  }
  
  =item rel2abs
  
  Converts a relative path to an absolute path:
  
      $abs_path = File::Spec->rel2abs( $path ) ;
      $abs_path = File::Spec->rel2abs( $path, $base ) ;
  
  Note that both paths are assumed to have a notation that distinguishes a
  directory path (with trailing ':') from a file path (without trailing ':').
  
  If $base is not present or '', then $base is set to the current working
  directory. If $base is relative, then it is converted to absolute form
  using C<rel2abs()>. This means that it is taken to be relative to the
  current working directory.
  
  If $base doesn't have a trailing colon, the last element of $base is
  assumed to be a filename.  This filename is ignored.  Otherwise all path
  components are assumed to be directories.
  
  If $path is already absolute, it is returned and $base is ignored.
  
  Based on code written by Shigio Yamaguchi.
  
  =cut
  
  sub rel2abs {
      my ($self,$path,$base) = @_;
  
      if ( ! $self->file_name_is_absolute($path) ) {
          # Figure out the effective $base and clean it up.
          if ( !defined( $base ) || $base eq '' ) {
  	    $base = $self->_cwd();
          }
          elsif ( ! $self->file_name_is_absolute($base) ) {
              $base = $self->rel2abs($base) ;
          }
  
  	# Split up paths
  
  	# ignore $path's volume
          my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
  
          # ignore $base's file part
  	my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
  
  	# Glom them together
  	$path_dirs = ':' if ($path_dirs eq '');
  	$base_dirs =~ s/:$//; # remove trailing ':', if any
  	$base_dirs = $base_dirs . $path_dirs;
  
          $path = $self->catpath( $base_vol, $base_dirs, $path_file );
      }
      return $path;
  }
  
  
  =back
  
  =head1 AUTHORS
  
  See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
  <schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  =cut
  
  1;
DARWIN-2LEVEL_FILE_SPEC_MAC

$fatpacked{"File/Spec/OS2.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_OS2';
  package File::Spec::OS2;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  sub devnull {
      return "/dev/nul";
  }
  
  sub case_tolerant {
      return 1;
  }
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      return scalar($file =~ m{^([a-z]:)?[\\/]}is);
  }
  
  sub path {
      my $path = $ENV{PATH};
      $path =~ s:\\:/:g;
      my @path = split(';',$path);
      foreach (@path) { $_ = '.' if $_ eq '' }
      return @path;
  }
  
  sub _cwd {
      # In OS/2 the "require Cwd" is unnecessary bloat.
      return Cwd::sys_cwd();
  }
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      my @d = @ENV{qw(TMPDIR TEMP TMP)};	# function call could autovivivy
      $tmpdir = $_[0]->_tmpdir( @d, '/tmp', '/'  );
  }
  
  sub catdir {
      my $self = shift;
      my @args = @_;
      foreach (@args) {
  	tr[\\][/];
          # append a backslash to each argument unless it has one there
          $_ .= "/" unless m{/$};
      }
      return $self->canonpath(join('', @args));
  }
  
  sub canonpath {
      my ($self,$path) = @_;
      return unless defined $path;
  
      $path =~ s/^([a-z]:)/\l$1/s;
      $path =~ s|\\|/|g;
      $path =~ s|([^/])/+|$1/|g;                  # xx////xx  -> xx/xx
      $path =~ s|(/\.)+/|/|g;                     # xx/././xx -> xx/xx
      $path =~ s|^(\./)+(?=[^/])||s;		# ./xx      -> xx
      $path =~ s|/\Z(?!\n)||
               unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/       -> xx
      $path =~ s{^/\.\.$}{/};                     # /..    -> /
      1 while $path =~ s{^/\.\.}{};               # /../xx -> /xx
      return $path;
  }
  
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
      my ($volume,$directory,$file) = ('','','');
      if ( $nofile ) {
          $path =~ 
              m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
                   (.*)
               }xs;
          $volume    = $1;
          $directory = $2;
      }
      else {
          $path =~ 
              m{^ ( (?: [a-zA-Z]: |
                        (?:\\\\|//)[^\\/]+[\\/][^\\/]+
                    )?
                  )
                  ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
                  (.*)
               }xs;
          $volume    = $1;
          $directory = $2;
          $file      = $3;
      }
  
      return ($volume,$directory,$file);
  }
  
  
  sub splitdir {
      my ($self,$directories) = @_ ;
      split m|[\\/]|, $directories, -1;
  }
  
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      # If it's UNC, make sure the glue separator is there, reusing
      # whatever separator is first in the $volume
      $volume .= $1
          if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
               $directory =~ m@^[^\\/]@s
             ) ;
  
      $volume .= $directory ;
  
      # If the volume is not just A:, make sure the glue separator is 
      # there, reusing whatever separator is first in the $volume if possible.
      if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
           $volume =~ m@[^\\/]\Z(?!\n)@      &&
           $file   =~ m@[^\\/]@
         ) {
          $volume =~ m@([\\/])@ ;
          my $sep = $1 ? $1 : '/' ;
          $volume .= $sep ;
      }
  
      $volume .= $file ;
  
      return $volume ;
  }
  
  
  sub abs2rel {
      my($self,$path,$base) = @_;
  
      # Clean up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          $path = $self->rel2abs( $path ) ;
      } else {
          $path = $self->canonpath( $path ) ;
      }
  
      # Figure out the effective $base and clean it up.
      if ( !defined( $base ) || $base eq '' ) {
  	$base = $self->_cwd();
      } elsif ( ! $self->file_name_is_absolute( $base ) ) {
          $base = $self->rel2abs( $base ) ;
      } else {
          $base = $self->canonpath( $base ) ;
      }
  
      # Split up paths
      my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ;
      my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ;
      return $path unless $path_volume eq $base_volume;
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_directories );
      my @basechunks = $self->splitdir( $base_directories );
  
      while ( @pathchunks && 
              @basechunks && 
              lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
            ) {
          shift @pathchunks ;
          shift @basechunks ;
      }
  
      # No need to catdir, we know these are well formed.
      $path_directories = CORE::join( '/', @pathchunks );
      $base_directories = CORE::join( '/', @basechunks );
  
      # $base_directories now contains the directories the resulting relative
      # path must ascend out of before it can descend to $path_directory.  So, 
      # replace all names with $parentDir
  
      #FA Need to replace between backslashes...
      $base_directories =~ s|[^\\/]+|..|g ;
  
      # Glue the two together, using a separator if necessary, and preventing an
      # empty result.
  
      #FA Must check that new directories are not empty.
      if ( $path_directories ne '' && $base_directories ne '' ) {
          $path_directories = "$base_directories/$path_directories" ;
      } else {
          $path_directories = "$base_directories$path_directories" ;
      }
  
      return $self->canonpath( 
          $self->catpath( "", $path_directories, $path_file ) 
      ) ;
  }
  
  
  sub rel2abs {
      my ($self,$path,$base ) = @_;
  
      if ( ! $self->file_name_is_absolute( $path ) ) {
  
          if ( !defined( $base ) || $base eq '' ) {
  	    $base = $self->_cwd();
          }
          elsif ( ! $self->file_name_is_absolute( $base ) ) {
              $base = $self->rel2abs( $base ) ;
          }
          else {
              $base = $self->canonpath( $base ) ;
          }
  
          my ( $path_directories, $path_file ) =
              ($self->splitpath( $path, 1 ))[1,2] ;
  
          my ( $base_volume, $base_directories ) =
              $self->splitpath( $base, 1 ) ;
  
          $path = $self->catpath( 
              $base_volume, 
              $self->catdir( $base_directories, $path_directories ), 
              $path_file
          ) ;
      }
  
      return $self->canonpath( $path ) ;
  }
  
  1;
  __END__
  
  =head1 NAME
  
  File::Spec::OS2 - methods for OS/2 file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::OS2; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  Amongst the changes made for OS/2 are...
  
  =over 4
  
  =item tmpdir
  
  Modifies the list of places temp directory information is looked for.
  
      $ENV{TMPDIR}
      $ENV{TEMP}
      $ENV{TMP}
      /tmp
      /
  
  =item splitpath
  
  Volumes can be drive letters or UNC sharenames (\\server\share).
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
DARWIN-2LEVEL_FILE_SPEC_OS2

$fatpacked{"File/Spec/Unix.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_UNIX';
  package File::Spec::Unix;
  
  use strict;
  use vars qw($VERSION);
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  =head1 NAME
  
  File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
  
  =head1 SYNOPSIS
  
   require File::Spec::Unix; # Done automatically by File::Spec
  
  =head1 DESCRIPTION
  
  Methods for manipulating file specifications.  Other File::Spec
  modules, such as File::Spec::Mac, inherit from File::Spec::Unix and
  override specific methods.
  
  =head1 METHODS
  
  =over 2
  
  =item canonpath()
  
  No physical check on the filesystem, but a logical cleanup of a
  path. On UNIX eliminates successive slashes and successive "/.".
  
      $cpath = File::Spec->canonpath( $path ) ;
  
  Note that this does *not* collapse F<x/../y> sections into F<y>.  This
  is by design.  If F</foo> on your system is a symlink to F</bar/baz>,
  then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
  F<../>-removal would give you.  If you want to do this kind of
  processing, you probably want C<Cwd>'s C<realpath()> function to
  actually traverse the filesystem cleaning up paths like this.
  
  =cut
  
  sub canonpath {
      my ($self,$path) = @_;
      return unless defined $path;
      
      # Handle POSIX-style node names beginning with double slash (qnx, nto)
      # (POSIX says: "a pathname that begins with two successive slashes
      # may be interpreted in an implementation-defined manner, although
      # more than two leading slashes shall be treated as a single slash.")
      my $node = '';
      my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
  
  
      if ( $double_slashes_special
           && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) ) {
        $node = $1;
      }
      # This used to be
      # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
      # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
      # (Mainly because trailing "" directories didn't get stripped).
      # Why would cygwin avoid collapsing multiple slashes into one? --jhi
      $path =~ s|/{2,}|/|g;                            # xx////xx  -> xx/xx
      $path =~ s{(?:/\.)+(?:/|\z)}{/}g;                # xx/././xx -> xx/xx
      $path =~ s|^(?:\./)+||s unless $path eq "./";    # ./xx      -> xx
      $path =~ s|^/(?:\.\./)+|/|;                      # /../../xx -> xx
      $path =~ s|^/\.\.$|/|;                         # /..       -> /
      $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
      return "$node$path";
  }
  
  =item catdir()
  
  Concatenate two or more directory names to form a complete path ending
  with a directory. But remove the trailing slash from the resulting
  string, because it doesn't look good, isn't necessary and confuses
  OS2. Of course, if this is the root directory, don't cut off the
  trailing slash :-)
  
  =cut
  
  sub catdir {
      my $self = shift;
  
      $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
  }
  
  =item catfile
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename
  
  =cut
  
  sub catfile {
      my $self = shift;
      my $file = $self->canonpath(pop @_);
      return $file unless @_;
      my $dir = $self->catdir(@_);
      $dir .= "/" unless substr($dir,-1) eq "/";
      return $dir.$file;
  }
  
  =item curdir
  
  Returns a string representation of the current directory.  "." on UNIX.
  
  =cut
  
  sub curdir { '.' }
  
  =item devnull
  
  Returns a string representation of the null device. "/dev/null" on UNIX.
  
  =cut
  
  sub devnull { '/dev/null' }
  
  =item rootdir
  
  Returns a string representation of the root directory.  "/" on UNIX.
  
  =cut
  
  sub rootdir { '/' }
  
  =item tmpdir
  
  Returns a string representation of the first writable directory from
  the following list or the current directory if none from the list are
  writable:
  
      $ENV{TMPDIR}
      /tmp
  
  If running under taint mode, and if $ENV{TMPDIR}
  is tainted, it is not used.
  
  =cut
  
  my $tmpdir;
  sub _tmpdir {
      return $tmpdir if defined $tmpdir;
      my $self = shift;
      my @dirlist = @_;
      {
  	no strict 'refs';
  	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
              require Scalar::Util;
  	    @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
  	}
  	elsif ($] < 5.007) { # No ${^TAINT} before 5.8
  	    @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist;
  	}
      }
      foreach (@dirlist) {
  	next unless defined && -d && -w _;
  	$tmpdir = $_;
  	last;
      }
      $tmpdir = $self->curdir unless defined $tmpdir;
      $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
      return $tmpdir;
  }
  
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
  }
  
  =item updir
  
  Returns a string representation of the parent directory.  ".." on UNIX.
  
  =cut
  
  sub updir { '..' }
  
  =item no_upwards
  
  Given a list of file names, strip out those that refer to a parent
  directory. (Does not strip symlinks, only '.', '..', and equivalents.)
  
  =cut
  
  sub no_upwards {
      my $self = shift;
      return grep(!/^\.{1,2}\z/s, @_);
  }
  
  =item case_tolerant
  
  Returns a true or false value indicating, respectively, that alphabetic
  is not or is significant when comparing file specifications.
  
  =cut
  
  sub case_tolerant { 0 }
  
  =item file_name_is_absolute
  
  Takes as argument a path and returns true if it is an absolute path.
  
  This does not consult the local filesystem on Unix, Win32, OS/2 or Mac 
  OS (Classic).  It does consult the working environment for VMS (see
  L<File::Spec::VMS/file_name_is_absolute>).
  
  =cut
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      return scalar($file =~ m:^/:s);
  }
  
  =item path
  
  Takes no argument, returns the environment variable PATH as an array.
  
  =cut
  
  sub path {
      return () unless exists $ENV{PATH};
      my @path = split(':', $ENV{PATH});
      foreach (@path) { $_ = '.' if $_ eq '' }
      return @path;
  }
  
  =item join
  
  join is the same as catfile.
  
  =cut
  
  sub join {
      my $self = shift;
      return $self->catfile(@_);
  }
  
  =item splitpath
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Splits a path into volume, directory, and filename portions. On systems
  with no concept of volume, returns '' for volume. 
  
  For systems with no syntax differentiating filenames from directories, 
  assumes that the last file is a path unless $no_file is true or a 
  trailing separator or /. or /.. is present. On Unix this means that $no_file
  true makes this return ( '', $path, '' ).
  
  The directory portion may or may not be returned with a trailing '/'.
  
  The results can be passed to L</catpath()> to get back a path equivalent to
  (usually identical to) the original path.
  
  =cut
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
  
      my ($volume,$directory,$file) = ('','','');
  
      if ( $nofile ) {
          $directory = $path;
      }
      else {
          $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
          $directory = $1;
          $file      = $2;
      }
  
      return ($volume,$directory,$file);
  }
  
  
  =item splitdir
  
  The opposite of L</catdir()>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  $directories must be only the directory portion of the path on systems 
  that have the concept of a volume or that have path syntax that differentiates
  files from directories.
  
  Unlike just splitting the directories on the separator, empty
  directory names (C<''>) can be returned, because these are significant
  on some OSs.
  
  On Unix,
  
      File::Spec->splitdir( "/a/b//c/" );
  
  Yields:
  
      ( '', 'a', 'b', '', 'c', '' )
  
  =cut
  
  sub splitdir {
      return split m|/|, $_[1], -1;  # Preserve trailing fields
  }
  
  
  =item catpath()
  
  Takes volume, directory and file portions and returns an entire path. Under
  Unix, $volume is ignored, and directory and file are concatenated.  A '/' is
  inserted if needed (though if the directory portion doesn't start with
  '/' it is not added).  On other OSs, $volume is significant.
  
  =cut
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      if ( $directory ne ''                && 
           $file ne ''                     && 
           substr( $directory, -1 ) ne '/' && 
           substr( $file, 0, 1 ) ne '/' 
      ) {
          $directory .= "/$file" ;
      }
      else {
          $directory .= $file ;
      }
  
      return $directory ;
  }
  
  =item abs2rel
  
  Takes a destination path and an optional base path returns a relative path
  from the base path to the destination path:
  
      $rel_path = File::Spec->abs2rel( $path ) ;
      $rel_path = File::Spec->abs2rel( $path, $base ) ;
  
  If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
  relative, then it is converted to absolute form using
  L</rel2abs()>. This means that it is taken to be relative to
  L<cwd()|Cwd>.
  
  On systems that have a grammar that indicates filenames, this ignores the 
  $base filename. Otherwise all path components are assumed to be
  directories.
  
  If $path is relative, it is converted to absolute form using L</rel2abs()>.
  This means that it is taken to be relative to L<cwd()|Cwd>.
  
  No checks against the filesystem are made, so the result may not be correct if
  C<$base> contains symbolic links.  (Apply
  L<Cwd::abs_path()|Cwd/abs_path> beforehand if that
  is a concern.)  On VMS, there is interaction with the working environment, as
  logicals and macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =cut
  
  sub abs2rel {
      my($self,$path,$base) = @_;
      $base = $self->_cwd() unless defined $base and length $base;
  
      ($path, $base) = map $self->canonpath($_), $path, $base;
  
      my $path_directories;
      my $base_directories;
  
      if (grep $self->file_name_is_absolute($_), $path, $base) {
  	($path, $base) = map $self->rel2abs($_), $path, $base;
  
      my ($path_volume) = $self->splitpath($path, 1);
      my ($base_volume) = $self->splitpath($base, 1);
  
      # Can't relativize across volumes
      return $path unless $path_volume eq $base_volume;
  
  	$path_directories = ($self->splitpath($path, 1))[1];
  	$base_directories = ($self->splitpath($base, 1))[1];
  
      # For UNC paths, the user might give a volume like //foo/bar that
      # strictly speaking has no directory portion.  Treat it as if it
      # had the root directory for that volume.
      if (!length($base_directories) and $self->file_name_is_absolute($base)) {
        $base_directories = $self->rootdir;
      }
      }
      else {
  	my $wd= ($self->splitpath($self->_cwd(), 1))[1];
  	$path_directories = $self->catdir($wd, $path);
  	$base_directories = $self->catdir($wd, $base);
      }
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_directories );
      my @basechunks = $self->splitdir( $base_directories );
  
      if ($base_directories eq $self->rootdir) {
        return $self->curdir if $path_directories eq $self->rootdir;
        shift @pathchunks;
        return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
      }
  
      my @common;
      while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
          push @common, shift @pathchunks ;
          shift @basechunks ;
      }
      return $self->curdir unless @pathchunks || @basechunks;
  
      # @basechunks now contains the directories the resulting relative path 
      # must ascend out of before it can descend to $path_directory.  If there
      # are updir components, we must descend into the corresponding directories
      # (this only works if they are no symlinks).
      my @reverse_base;
      while( defined(my $dir= shift @basechunks) ) {
  	if( $dir ne $self->updir ) {
  	    unshift @reverse_base, $self->updir;
  	    push @common, $dir;
  	}
  	elsif( @common ) {
  	    if( @reverse_base && $reverse_base[0] eq $self->updir ) {
  		shift @reverse_base;
  		pop @common;
  	    }
  	    else {
  		unshift @reverse_base, pop @common;
  	    }
  	}
      }
      my $result_dirs = $self->catdir( @reverse_base, @pathchunks );
      return $self->canonpath( $self->catpath('', $result_dirs, '') );
  }
  
  sub _same {
    $_[1] eq $_[2];
  }
  
  =item rel2abs()
  
  Converts a relative path to an absolute path. 
  
      $abs_path = File::Spec->rel2abs( $path ) ;
      $abs_path = File::Spec->rel2abs( $path, $base ) ;
  
  If $base is not present or '', then L<cwd()|Cwd> is used. If $base is
  relative, then it is converted to absolute form using
  L</rel2abs()>. This means that it is taken to be relative to
  L<cwd()|Cwd>.
  
  On systems that have a grammar that indicates filenames, this ignores
  the $base filename. Otherwise all path components are assumed to be
  directories.
  
  If $path is absolute, it is cleaned up and returned using L</canonpath()>.
  
  No checks against the filesystem are made.  On VMS, there is
  interaction with the working environment, as logicals and
  macros are expanded.
  
  Based on code written by Shigio Yamaguchi.
  
  =cut
  
  sub rel2abs {
      my ($self,$path,$base ) = @_;
  
      # Clean up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          # Figure out the effective $base and clean it up.
          if ( !defined( $base ) || $base eq '' ) {
  	    $base = $self->_cwd();
          }
          elsif ( ! $self->file_name_is_absolute( $base ) ) {
              $base = $self->rel2abs( $base ) ;
          }
          else {
              $base = $self->canonpath( $base ) ;
          }
  
          # Glom them together
          $path = $self->catdir( $base, $path ) ;
      }
  
      return $self->canonpath( $path ) ;
  }
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  Please submit bug reports and patches to perlbug@perl.org.
  
  =head1 SEE ALSO
  
  L<File::Spec>
  
  =cut
  
  # Internal routine to File::Spec, no point in making this public since
  # it is the standard Cwd interface.  Most of the platform-specific
  # File::Spec subclasses use this.
  sub _cwd {
      require Cwd;
      Cwd::getcwd();
  }
  
  
  # Internal method to reduce xx\..\yy -> yy
  sub _collapse {
      my($fs, $path) = @_;
  
      my $updir  = $fs->updir;
      my $curdir = $fs->curdir;
  
      my($vol, $dirs, $file) = $fs->splitpath($path);
      my @dirs = $fs->splitdir($dirs);
      pop @dirs if @dirs && $dirs[-1] eq '';
  
      my @collapsed;
      foreach my $dir (@dirs) {
          if( $dir eq $updir              and   # if we have an updir
              @collapsed                  and   # and something to collapse
              length $collapsed[-1]       and   # and its not the rootdir
              $collapsed[-1] ne $updir    and   # nor another updir
              $collapsed[-1] ne $curdir         # nor the curdir
            ) 
          {                                     # then
              pop @collapsed;                   # collapse
          }
          else {                                # else
              push @collapsed, $dir;            # just hang onto it
          }
      }
  
      return $fs->catpath($vol,
                          $fs->catdir(@collapsed),
                          $file
                         );
  }
  
  
  1;
DARWIN-2LEVEL_FILE_SPEC_UNIX

$fatpacked{"File/Spec/VMS.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_VMS';
  package File::Spec::VMS;
  
  use strict;
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  use File::Basename;
  use VMS::Filespec;
  
  =head1 NAME
  
  File::Spec::VMS - methods for VMS file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::VMS; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See File::Spec::Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  The default behavior is to allow either VMS or Unix syntax on input and to 
  return VMS syntax on output unless Unix syntax has been explicity requested
  via the C<DECC$FILENAME_UNIX_REPORT> CRTL feature.
  
  =over 4
  
  =cut
  
  # Need to look up the feature settings.  The preferred way is to use the
  # VMS::Feature module, but that may not be available to dual life modules.
  
  my $use_feature;
  BEGIN {
      if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
          $use_feature = 1;
      }
  }
  
  # Need to look up the UNIX report mode.  This may become a dynamic mode
  # in the future.
  sub _unix_rpt {
      my $unix_rpt;
      if ($use_feature) {
          $unix_rpt = VMS::Feature::current("filename_unix_report");
      } else {
          my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
          $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
      }
      return $unix_rpt;
  }
  
  =item canonpath (override)
  
  Removes redundant portions of file specifications and returns results
  in native syntax unless Unix filename reporting has been enabled.
  
  =cut
  
  
  sub canonpath {
      my($self,$path) = @_;
  
      return undef unless defined $path;
  
      my $unix_rpt = $self->_unix_rpt;
  
      if ($path =~ m|/|) {
        my $pathify = $path =~ m|/\Z(?!\n)|;
        $path = $self->SUPER::canonpath($path);
  
        return $path if $unix_rpt;
        $path = $pathify ? vmspath($path) : vmsify($path);
      }
  
      $path =~ s/(?<!\^)</[/;			# < and >       ==> [ and ]
      $path =~ s/(?<!\^)>/]/;
      $path =~ s/(?<!\^)\]\[\./\.\]\[/g;		# ][.		==> .][
      $path =~ s/(?<!\^)\[000000\.\]\[/\[/g;	# [000000.][	==> [
      $path =~ s/(?<!\^)\[000000\./\[/g;		# [000000.	==> [
      $path =~ s/(?<!\^)\.\]\[000000\]/\]/g;	# .][000000]	==> ]
      $path =~ s/(?<!\^)\.\]\[/\./g;		# foo.][bar     ==> foo.bar
      1 while ($path =~ s/(?<!\^)([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/);
  						# That loop does the following
  						# with any amount of dashes:
  						# .-.-.		==> .--.
  						# [-.-.		==> [--.
  						# .-.-]		==> .--]
  						# [-.-]		==> [--]
      1 while ($path =~ s/(?<!\^)([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
  						# That loop does the following
  						# with any amount (minimum 2)
  						# of dashes:
  						# .foo.--.	==> .-.
  						# .foo.--]	==> .-]
  						# [foo.--.	==> [-.
  						# [foo.--]	==> [-]
  						#
  						# And then, the remaining cases
      $path =~ s/(?<!\^)\[\.-/[-/;		# [.-		==> [-
      $path =~ s/(?<!\^)\.[^\]\.]+\.-\./\./g;	# .foo.-.	==> .
      $path =~ s/(?<!\^)\[[^\]\.]+\.-\./\[/g;	# [foo.-.	==> [
      $path =~ s/(?<!\^)\.[^\]\.]+\.-\]/\]/g;	# .foo.-]	==> ]
  						# [foo.-]       ==> [000000]
      $path =~ s/(?<!\^)\[[^\]\.]+\.-\]/\[000000\]/g;
  						# []		==>
      $path =~ s/(?<!\^)\[\]// unless $path eq '[]';
      return $unix_rpt ? unixify($path) : $path;
  }
  
  =item catdir (override)
  
  Concatenates a list of file specifications, and returns the result as a
  native directory specification unless the Unix filename reporting feature
  has been enabled.  No check is made for "impossible" cases (e.g. elements
  other than the first being absolute filespecs).
  
  =cut
  
  sub catdir {
      my $self = shift;
      my $dir = pop;
  
      my $unix_rpt = $self->_unix_rpt;
  
      my @dirs = grep {defined() && length()} @_;
  
      my $rslt;
      if (@dirs) {
  	my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
  	my ($spath,$sdir) = ($path,$dir);
  	$spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i; 
  
  	if ($unix_rpt) {
  	    $spath = unixify($spath) unless $spath =~ m#/#;
  	    $sdir= unixify($sdir) unless $sdir =~ m#/#;
              return $self->SUPER::catdir($spath, $sdir)
              }
  
  	$sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s;
  	    $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
  
  	    # Special case for VMS absolute directory specs: these will have
  	    # had device prepended during trip through Unix syntax in
  	    # eliminate_macros(), since Unix syntax has no way to express
  	    # "absolute from the top of this device's directory tree".
  	    if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
  
                  } else {
  	# Single directory. Return an empty string on null input; otherwise
  	# just return a canonical path.
  
  	if    (not defined $dir or not length $dir) {
  	    $rslt = '';
              } else {
  	    $rslt = $unix_rpt ? $dir : vmspath($dir);
  	}
      }
      return $self->canonpath($rslt);
  }
  
  =item catfile (override)
  
  Concatenates a list of directory specifications with a filename specification
  to build a path.
  
  =cut
  
  sub catfile {
      my $self = shift;
      my $tfile = pop();
      my $file = $self->canonpath($tfile);
      my @files = grep {defined() && length()} @_;
  
      my $unix_rpt = $self->_unix_rpt;
  
      my $rslt;
      if (@files) {
  	my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
  	my $spath = $path;
  
          # Something building a VMS path in pieces may try to pass a
          # directory name in filename format, so normalize it.
  	$spath =~ s/\.dir\Z(?!\n)//i;
  
          # If the spath ends with a directory delimiter and the file is bare,
          # then just concatenate them.
  	if ($spath =~ /^(?<!\^)[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) {
  	    $rslt = "$spath$file";
  	} else {
  		$rslt = $self->eliminate_macros($spath);
             $rslt .= (defined($rslt) && length($rslt) ? '/' : '') . unixify($file);
             $rslt = vmsify($rslt) unless $unix_rpt;
  	}
      }
      else {
          # Only passed a single file?
          my $xfile = (defined($file) && length($file)) ? $file : '';
  
          $rslt = $unix_rpt ? $file : vmsify($file);
      }
      return $self->canonpath($rslt) unless $unix_rpt;
  
      # In Unix report mode, do not strip off redundant path information.
      return $rslt;
  }
  
  
  =item curdir (override)
  
  Returns a string representation of the current directory: '[]' or '.'
  
  =cut
  
  sub curdir {
      my $self = shift @_;
      return '.' if ($self->_unix_rpt);
      return '[]';
  }
  
  =item devnull (override)
  
  Returns a string representation of the null device: '_NLA0:' or '/dev/null'
  
  =cut
  
  sub devnull {
      my $self = shift @_;
      return '/dev/null' if ($self->_unix_rpt);
      return "_NLA0:";
  }
  
  =item rootdir (override)
  
  Returns a string representation of the root directory: 'SYS$DISK:[000000]'
  or '/'
  
  =cut
  
  sub rootdir {
      my $self = shift @_;
      if ($self->_unix_rpt) {
         # Root may exist, try it first.
         my $try = '/';
         my ($dev1, $ino1) = stat('/');
         my ($dev2, $ino2) = stat('.');
  
         # Perl falls back to '.' if it can not determine '/'
         if (($dev1 != $dev2) || ($ino1 != $ino2)) {
             return $try;
         }
         # Fall back to UNIX format sys$disk.
         return '/sys$disk/';
      }
      return 'SYS$DISK:[000000]';
  }
  
  =item tmpdir (override)
  
  Returns a string representation of the first writable directory
  from the following list or '' if none are writable:
  
      /tmp if C<DECC$FILENAME_UNIX_REPORT> is enabled.
      sys$scratch:
      $ENV{TMPDIR}
  
  Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
  is tainted, it is not used.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      my $self = shift @_;
      return $tmpdir if defined $tmpdir;
      if ($self->_unix_rpt) {
          $tmpdir = $self->_tmpdir('/tmp', '/sys$scratch', $ENV{TMPDIR});
          return $tmpdir;
      }
  
      $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
  }
  
  =item updir (override)
  
  Returns a string representation of the parent directory: '[-]' or '..'
  
  =cut
  
  sub updir {
      my $self = shift @_;
      return '..' if ($self->_unix_rpt);
      return '[-]';
  }
  
  =item case_tolerant (override)
  
  VMS file specification syntax is case-tolerant.
  
  =cut
  
  sub case_tolerant {
      return 1;
  }
  
  =item path (override)
  
  Translate logical name DCL$PATH as a searchlist, rather than trying
  to C<split> string value of C<$ENV{'PATH'}>.
  
  =cut
  
  sub path {
      my (@dirs,$dir,$i);
      while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
      return @dirs;
  }
  
  =item file_name_is_absolute (override)
  
  Checks for VMS directory spec as well as Unix separators.
  
  =cut
  
  sub file_name_is_absolute {
      my ($self,$file) = @_;
      # If it's a logical name, expand it.
      $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
      return scalar($file =~ m!^/!s             ||
  		  $file =~ m![<\[][^.\-\]>]!  ||
  		  $file =~ /:[^<\[]/);
  }
  
  =item splitpath (override)
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Passing a true value for C<$no_file> indicates that the path being
  split only contains directory components, even on systems where you
  can usually (when not supporting a foreign syntax) tell the difference
  between directories and files at a glance.
  
  =cut
  
  sub splitpath {
      my($self,$path, $nofile) = @_;
      my($dev,$dir,$file)      = ('','','');
      my $vmsify_path = vmsify($path);
  
      if ( $nofile ) {
          #vmsify('d1/d2/d3') returns '[.d1.d2]d3'
          #vmsify('/d1/d2/d3') returns 'd1:[d2]d3'
          if( $vmsify_path =~ /(.*)\](.+)/ ){
              $vmsify_path = $1.'.'.$2.']';
          }
          $vmsify_path =~ /(.+:)?(.*)/s;
          $dir = defined $2 ? $2 : ''; # dir can be '0'
          return ($1 || '',$dir,$file);
      }
      else {
          $vmsify_path =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
          return ($1 || '',$2 || '',$3);
      }
  }
  
  =item splitdir (override)
  
  Split a directory specification into the components.
  
  =cut
  
  sub splitdir {
      my($self,$dirspec) = @_;
      my @dirs = ();
      return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) );
  
      $dirspec =~ s/(?<!\^)</[/;                  # < and >	==> [ and ]
      $dirspec =~ s/(?<!\^)>/]/;
      $dirspec =~ s/(?<!\^)\]\[\./\.\]\[/g;	# ][.		==> .][
      $dirspec =~ s/(?<!\^)\[000000\.\]\[/\[/g;	# [000000.][	==> [
      $dirspec =~ s/(?<!\^)\[000000\./\[/g;	# [000000.	==> [
      $dirspec =~ s/(?<!\^)\.\]\[000000\]/\]/g;	# .][000000]	==> ]
      $dirspec =~ s/(?<!\^)\.\]\[/\./g;		# foo.][bar	==> foo.bar
      while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {}
  						# That loop does the following
  						# with any amount of dashes:
  						# .--.		==> .-.-.
  						# [--.		==> [-.-.
  						# .--]		==> .-.-]
  						# [--]		==> [-.-]
      $dirspec = "[$dirspec]" unless $dirspec =~ /(?<!\^)[\[<]/; # make legal
      $dirspec =~ s/^(\[|<)\./$1/;
      @dirs = split /(?<!\^)\./, vmspath($dirspec);
      $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
      @dirs;
  }
  
  
  =item catpath (override)
  
  Construct a complete filespec.
  
  =cut
  
  sub catpath {
      my($self,$dev,$dir,$file) = @_;
      
      # We look for a volume in $dev, then in $dir, but not both
          my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir);
          $dev = $dir_volume unless length $dev;
      $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir;
      
      if ($dev =~ m|^(?<!\^)/+([^/]+)|) { $dev = "$1:"; }
      else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
      if (length($dev) or length($dir)) {
          $dir = "[$dir]" unless $dir =~ /(?<!\^)[\[<\/]/;
            $dir = vmspath($dir);
        }
      $dir = '' if length($dev) && ($dir eq '[]' || $dir eq '<>');
      "$dev$dir$file";
  }
  
  =item abs2rel (override)
  
  Attempt to convert an absolute file specification to a relative specification.
  
  =cut
  
  sub abs2rel {
      my $self = shift;
      return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
          if grep m{/}, @_;
  
      my($path,$base) = @_;
      $base = $self->_cwd() unless defined $base and length $base;
  
      for ($path, $base) { $_ = $self->canonpath($_) }
  
      # Are we even starting $path on the same (node::)device as $base?  Note that
      # logical paths or nodename differences may be on the "same device" 
      # but the comparison that ignores device differences so as to concatenate 
      # [---] up directory specs is not even a good idea in cases where there is 
      # a logical path difference between $path and $base nodename and/or device.
      # Hence we fall back to returning the absolute $path spec
      # if there is a case blind device (or node) difference of any sort
      # and we do not even try to call $parse() or consult %ENV for $trnlnm()
      # (this module needs to run on non VMS platforms after all).
      
      my ($path_volume, $path_directories, $path_file) = $self->splitpath($path);
      my ($base_volume, $base_directories, $base_file) = $self->splitpath($base);
      return $path unless lc($path_volume) eq lc($base_volume);
  
      for ($path, $base) { $_ = $self->rel2abs($_) }
  
      # Now, remove all leading components that are the same
      my @pathchunks = $self->splitdir( $path_directories );
      my $pathchunks = @pathchunks;
      unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
      my @basechunks = $self->splitdir( $base_directories );
      my $basechunks = @basechunks;
      unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
  
      while ( @pathchunks && 
              @basechunks && 
              lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
            ) {
          shift @pathchunks ;
          shift @basechunks ;
      }
  
      # @basechunks now contains the directories to climb out of,
      # @pathchunks now has the directories to descend in to.
      if ((@basechunks > 0) || ($basechunks != $pathchunks)) {
        $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
      }
      else {
        $path_directories = join '.', @pathchunks;
      }
      $path_directories = '['.$path_directories.']';
      return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
  }
  
  
  =item rel2abs (override)
  
  Return an absolute file specification from a relative one.
  
  =cut
  
  sub rel2abs {
      my $self = shift ;
      my ($path,$base ) = @_;
      return undef unless defined $path;
          if ($path =~ m/\//) {
  	    $path = ( -d $path || $path =~ m/\/\z/  # educated guessing about
  		       ? vmspath($path)             # whether it's a directory
  		       : vmsify($path) );
          }
      $base = vmspath($base) if defined $base && $base =~ m/\//;
  
      # Clean up and split up $path
      if ( ! $self->file_name_is_absolute( $path ) ) {
          # Figure out the effective $base and clean it up.
          if ( !defined( $base ) || $base eq '' ) {
              $base = $self->_cwd;
          }
          elsif ( ! $self->file_name_is_absolute( $base ) ) {
              $base = $self->rel2abs( $base ) ;
          }
          else {
              $base = $self->canonpath( $base ) ;
          }
  
          # Split up paths
          my ( $path_directories, $path_file ) =
              ($self->splitpath( $path ))[1,2] ;
  
          my ( $base_volume, $base_directories ) =
              $self->splitpath( $base ) ;
  
          $path_directories = '' if $path_directories eq '[]' ||
                                    $path_directories eq '<>';
          my $sep = '' ;
              $sep = '.'
                  if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
                       $path_directories =~ m{^[^.\[<]}s
                  ) ;
              $base_directories = "$base_directories$sep$path_directories";
              $base_directories =~ s{\.?[\]>][\[<]\.?}{.};
  
          $path = $self->catpath( $base_volume, $base_directories, $path_file );
     }
  
      return $self->canonpath( $path ) ;
  }
  
  
  # eliminate_macros() and fixpath() are MakeMaker-specific methods
  # which are used inside catfile() and catdir().  MakeMaker has its own
  # copies as of 6.06_03 which are the canonical ones.  We leave these
  # here, in peace, so that File::Spec continues to work with MakeMakers
  # prior to 6.06_03.
  # 
  # Please consider these two methods deprecated.  Do not patch them,
  # patch the ones in ExtUtils::MM_VMS instead.
  #
  # Update:  MakeMaker 6.48 is still using these routines on VMS.
  # so they need to be kept up to date with ExtUtils::MM_VMS.
  
  sub eliminate_macros {
      my($self,$path) = @_;
      return '' unless (defined $path) && ($path ne '');
      $self = {} unless ref $self;
  
      if ($path =~ /\s/) {
        return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
      }
  
      my $npath = unixify($path);
      # sometimes unixify will return a string with an off-by-one trailing null
      $npath =~ s{\0$}{};
  
      my($complex) = 0;
      my($head,$macro,$tail);
  
      # perform m##g in scalar context so it acts as an iterator
      while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
          if (defined $self->{$2}) {
              ($head,$macro,$tail) = ($1,$2,$3);
              if (ref $self->{$macro}) {
                  if (ref $self->{$macro} eq 'ARRAY') {
                      $macro = join ' ', @{$self->{$macro}};
                  }
                  else {
                      print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
                            "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
                      $macro = "\cB$macro\cB";
                      $complex = 1;
                  }
              }
              else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
              $npath = "$head$macro$tail";
          }
      }
      if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
      $npath;
  }
  
  # Deprecated.  See the note above for eliminate_macros().
  
  # Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
  # in any directory specification, in order to avoid juxtaposing two
  # VMS-syntax directories when MM[SK] is run.  Also expands expressions which
  # are all macro, so that we can tell how long the expansion is, and avoid
  # overrunning DCL's command buffer when MM[KS] is running.
  
  # fixpath() checks to see whether the result matches the name of a
  # directory in the current default directory and returns a directory or
  # file specification accordingly.  C<$is_dir> can be set to true to
  # force fixpath() to consider the path to be a directory or false to force
  # it to be a file.
  
  sub fixpath {
      my($self,$path,$force_path) = @_;
      return '' unless $path;
      $self = bless {}, $self unless ref $self;
      my($fixedpath,$prefix,$name);
  
      if ($path =~ /\s/) {
        return join ' ',
               map { $self->fixpath($_,$force_path) }
  	     split /\s+/, $path;
      }
  
      if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
          if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
              $fixedpath = vmspath($self->eliminate_macros($path));
          }
          else {
              $fixedpath = vmsify($self->eliminate_macros($path));
          }
      }
      elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
          my($vmspre) = $self->eliminate_macros("\$($prefix)");
          # is it a dir or just a name?
          $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
          $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
          $fixedpath = vmspath($fixedpath) if $force_path;
      }
      else {
          $fixedpath = $path;
          $fixedpath = vmspath($fixedpath) if $force_path;
      }
      # No hints, so we try to guess
      if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
          $fixedpath = vmspath($fixedpath) if -d $fixedpath;
      }
  
      # Trim off root dirname if it's had other dirs inserted in front of it.
      $fixedpath =~ s/\.000000([\]>])/$1/;
      # Special case for VMS absolute directory specs: these will have had device
      # prepended during trip through Unix syntax in eliminate_macros(), since
      # Unix syntax has no way to express "absolute from the top of this device's
      # directory tree".
      if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
      $fixedpath;
  }
  
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  An explanation of VMS file specs can be found at
  L<http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files>.
  
  =cut
  
  1;
DARWIN-2LEVEL_FILE_SPEC_VMS

$fatpacked{"File/Spec/Win32.pm"} = <<'DARWIN-2LEVEL_FILE_SPEC_WIN32';
  package File::Spec::Win32;
  
  use strict;
  
  use vars qw(@ISA $VERSION);
  require File::Spec::Unix;
  
  $VERSION = '3.40';
  $VERSION =~ tr/_//;
  
  @ISA = qw(File::Spec::Unix);
  
  # Some regexes we use for path splitting
  my $DRIVE_RX = '[a-zA-Z]:';
  my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
  my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";
  
  
  =head1 NAME
  
  File::Spec::Win32 - methods for Win32 file specs
  
  =head1 SYNOPSIS
  
   require File::Spec::Win32; # Done internally by File::Spec if needed
  
  =head1 DESCRIPTION
  
  See File::Spec::Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =over 4
  
  =item devnull
  
  Returns a string representation of the null device.
  
  =cut
  
  sub devnull {
      return "nul";
  }
  
  sub rootdir { '\\' }
  
  
  =item tmpdir
  
  Returns a string representation of the first existing directory
  from the following list:
  
      $ENV{TMPDIR}
      $ENV{TEMP}
      $ENV{TMP}
      SYS:/temp
      C:\system\temp
      C:/temp
      /tmp
      /
  
  The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
  for Symbian (the File::Spec::Win32 is used also for those platforms).
  
  Since Perl 5.8.0, if running under taint mode, and if the environment
  variables are tainted, they are not used.
  
  =cut
  
  my $tmpdir;
  sub tmpdir {
      return $tmpdir if defined $tmpdir;
      $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
  			      'SYS:/temp',
  			      'C:\system\temp',
  			      'C:/temp',
  			      '/tmp',
  			      '/'  );
  }
  
  =item case_tolerant
  
  MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
  indicating the case significance when comparing file specifications.
  Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem.
  See http://cygwin.com/ml/cygwin/2007-07/msg00891.html
  Default: 1
  
  =cut
  
  sub case_tolerant {
    eval { require Win32API::File; } or return 1;
    my $drive = shift || "C:";
    my $osFsType = "\0"x256;
    my $osVolName = "\0"x256;
    my $ouFsFlags = 0;
    Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
    if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
    else { return 1; }
  }
  
  =item file_name_is_absolute
  
  As of right now, this returns 2 if the path is absolute with a
  volume, 1 if it's absolute with no volume, 0 otherwise.
  
  =cut
  
  sub file_name_is_absolute {
  
      my ($self,$file) = @_;
  
      if ($file =~ m{^($VOL_RX)}o) {
        my $vol = $1;
        return ($vol =~ m{^$UNC_RX}o ? 2
  	      : $file =~ m{^$DRIVE_RX[\\/]}o ? 2
  	      : 0);
      }
      return $file =~  m{^[\\/]} ? 1 : 0;
  }
  
  =item catfile
  
  Concatenate one or more directory names and a filename to form a
  complete path ending with a filename
  
  =cut
  
  sub catfile {
      shift;
  
      # Legacy / compatibility support
      #
      shift, return _canon_cat( "/", @_ )
  	if $_[0] eq "";
  
      # Compatibility with File::Spec <= 3.26:
      #     catfile('A:', 'foo') should return 'A:\foo'.
      return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
          if $_[0] =~ m{^$DRIVE_RX\z}o;
  
      return _canon_cat( @_ );
  }
  
  sub catdir {
      shift;
  
      # Legacy / compatibility support
      #
      return ""
      	unless @_;
      shift, return _canon_cat( "/", @_ )
  	if $_[0] eq "";
  
      # Compatibility with File::Spec <= 3.26:
      #     catdir('A:', 'foo') should return 'A:\foo'.
      return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
          if $_[0] =~ m{^$DRIVE_RX\z}o;
  
      return _canon_cat( @_ );
  }
  
  sub path {
      my @path = split(';', $ENV{PATH});
      s/"//g for @path;
      @path = grep length, @path;
      unshift(@path, ".");
      return @path;
  }
  
  =item canonpath
  
  No physical check on the filesystem, but a logical cleanup of a
  path. On UNIX eliminated successive slashes and successive "/.".
  On Win32 makes 
  
  	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
  	dir1\dir2\dir3\...\dir4   -> \dir\dir4
  
  =cut
  
  sub canonpath {
      # Legacy / compatibility support
      #
      return $_[1] if !defined($_[1]) or $_[1] eq '';
      return _canon_cat( $_[1] );
  }
  
  =item splitpath
  
      ($volume,$directories,$file) = File::Spec->splitpath( $path );
      ($volume,$directories,$file) = File::Spec->splitpath( $path,
                                                            $no_file );
  
  Splits a path into volume, directory, and filename portions. Assumes that 
  the last file is a path unless the path ends in '\\', '\\.', '\\..'
  or $no_file is true.  On Win32 this means that $no_file true makes this return 
  ( $volume, $path, '' ).
  
  Separators accepted are \ and /.
  
  Volumes can be drive letters or UNC sharenames (\\server\share).
  
  The results can be passed to L</catpath> to get back a path equivalent to
  (usually identical to) the original path.
  
  =cut
  
  sub splitpath {
      my ($self,$path, $nofile) = @_;
      my ($volume,$directory,$file) = ('','','');
      if ( $nofile ) {
          $path =~ 
              m{^ ( $VOL_RX ? ) (.*) }sox;
          $volume    = $1;
          $directory = $2;
      }
      else {
          $path =~ 
              m{^ ( $VOL_RX ? )
                  ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
                  (.*)
               }sox;
          $volume    = $1;
          $directory = $2;
          $file      = $3;
      }
  
      return ($volume,$directory,$file);
  }
  
  
  =item splitdir
  
  The opposite of L<catdir()|File::Spec/catdir>.
  
      @dirs = File::Spec->splitdir( $directories );
  
  $directories must be only the directory portion of the path on systems 
  that have the concept of a volume or that have path syntax that differentiates
  files from directories.
  
  Unlike just splitting the directories on the separator, leading empty and 
  trailing directory entries can be returned, because these are significant
  on some OSs. So,
  
      File::Spec->splitdir( "/a/b/c" );
  
  Yields:
  
      ( '', 'a', 'b', '', 'c', '' )
  
  =cut
  
  sub splitdir {
      my ($self,$directories) = @_ ;
      #
      # split() likes to forget about trailing null fields, so here we
      # check to be sure that there will not be any before handling the
      # simple case.
      #
      if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
          return split( m|[\\/]|, $directories );
      }
      else {
          #
          # since there was a trailing separator, add a file name to the end, 
          # then do the split, then replace it with ''.
          #
          my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
          $directories[ $#directories ]= '' ;
          return @directories ;
      }
  }
  
  
  =item catpath
  
  Takes volume, directory and file portions and returns an entire path. Under
  Unix, $volume is ignored, and this is just like catfile(). On other OSs,
  the $volume become significant.
  
  =cut
  
  sub catpath {
      my ($self,$volume,$directory,$file) = @_;
  
      # If it's UNC, make sure the glue separator is there, reusing
      # whatever separator is first in the $volume
      my $v;
      $volume .= $v
          if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
               $directory =~ m@^[^\\/]@s
             ) ;
  
      $volume .= $directory ;
  
      # If the volume is not just A:, make sure the glue separator is 
      # there, reusing whatever separator is first in the $volume if possible.
      if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
           $volume =~ m@[^\\/]\Z(?!\n)@      &&
           $file   =~ m@[^\\/]@
         ) {
          $volume =~ m@([\\/])@ ;
          my $sep = $1 ? $1 : '\\' ;
          $volume .= $sep ;
      }
  
      $volume .= $file ;
  
      return $volume ;
  }
  
  sub _same {
    lc($_[1]) eq lc($_[2]);
  }
  
  sub rel2abs {
      my ($self,$path,$base ) = @_;
  
      my $is_abs = $self->file_name_is_absolute($path);
  
      # Check for volume (should probably document the '2' thing...)
      return $self->canonpath( $path ) if $is_abs == 2;
  
      if ($is_abs) {
        # It's missing a volume, add one
        my $vol = ($self->splitpath( $self->_cwd() ))[0];
        return $self->canonpath( $vol . $path );
      }
  
      if ( !defined( $base ) || $base eq '' ) {
        require Cwd ;
        $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
        $base = $self->_cwd() unless defined $base ;
      }
      elsif ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
      }
      else {
        $base = $self->canonpath( $base ) ;
      }
  
      my ( $path_directories, $path_file ) =
        ($self->splitpath( $path, 1 ))[1,2] ;
  
      my ( $base_volume, $base_directories ) =
        $self->splitpath( $base, 1 ) ;
  
      $path = $self->catpath( 
  			   $base_volume, 
  			   $self->catdir( $base_directories, $path_directories ), 
  			   $path_file
  			  ) ;
  
      return $self->canonpath( $path ) ;
  }
  
  =back
  
  =head2 Note For File::Spec::Win32 Maintainers
  
  Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2004,2007 by the Perl 5 Porters.  All rights reserved.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  implementation of these methods, not the semantics.
  
  =cut
  
  
  sub _canon_cat				# @path -> path
  {
      my ($first, @rest) = @_;
  
      my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x	# drive letter
      	       ? ucfirst( $1 ).( $2 ? "\\" : "" )
  	       : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
  				 (?: [\\/] ([^\\/]+) )?
  	       			 [\\/]? }{}xs			# UNC volume
  	       ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
  	       : $first =~ s{ \A [\\/] }{}x			# root dir
  	       ? "\\"
  	       : "";
      my $path   = join "\\", $first, @rest;
  
      $path =~ tr#\\/#\\\\#s;		# xx/yy --> xx\yy & xx\\yy --> xx\yy
  
      					# xx/././yy --> xx/yy
      $path =~ s{(?:
  		(?:\A|\\)		# at begin or after a slash
  		\.
  		(?:\\\.)*		# and more
  		(?:\\|\z) 		# at end or followed by slash
  	       )+			# performance boost -- I do not know why
  	     }{\\}gx;
  
      # XXX I do not know whether more dots are supported by the OS supporting
      #     this ... annotation (NetWare or symbian but not MSWin32).
      #     Then .... could easily become ../../.. etc:
      # Replace \.\.\. by (\.\.\.+)  and substitute with
      # { $1 . ".." . "\\.." x (length($2)-2) }gex
  	     				# ... --> ../..
      $path =~ s{ (\A|\\)			# at begin or after a slash
      		\.\.\.
  		(?=\\|\z) 		# at end or followed by slash
  	     }{$1..\\..}gx;
      					# xx\yy\..\zz --> xx\zz
      while ( $path =~ s{(?:
  		(?:\A|\\)		# at begin or after a slash
  		[^\\]+			# rip this 'yy' off
  		\\\.\.
  		(?<!\A\.\.\\\.\.)	# do *not* replace ^..\..
  		(?<!\\\.\.\\\.\.)	# do *not* replace \..\..
  		(?:\\|\z) 		# at end or followed by slash
  	       )+			# performance boost -- I do not know why
  	     }{\\}sx ) {}
  
      $path =~ s#\A\\##;			# \xx --> xx  NOTE: this is *not* root
      $path =~ s#\\\z##;			# xx\ --> xx
  
      if ( $volume =~ m#\\\z# )
      {					# <vol>\.. --> <vol>\
  	$path =~ s{ \A			# at begin
  		    \.\.
  		    (?:\\\.\.)*		# and more
  		    (?:\\|\z) 		# at end or followed by slash
  		 }{}x;
  
  	return $1			# \\HOST\SHARE\ --> \\HOST\SHARE
  	    if    $path eq ""
  	      and $volume =~ m#\A(\\\\.*)\\\z#s;
      }
      return $path ne "" || $volume ? $volume.$path : ".";
  }
  
  1;
DARWIN-2LEVEL_FILE_SPEC_WIN32

$fatpacked{"darwin-2level/JSON/XS.pm"} = <<'DARWIN-2LEVEL_JSON_XS';
  =head1 NAME
  
  JSON::XS - JSON serialising/deserialising, done correctly and fast
  
  =encoding utf-8
  
  JSON::XS - 正しくて高速な JSON シリアライザ/デシリアライザ
             (http://fleur.hio.jp/perldoc/mix/lib/JSON/XS.html)
  
  =head1 SYNOPSIS
  
   use JSON::XS;
  
   # exported functions, they croak on error
   # and expect/generate UTF-8
  
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
  
   # OO-interface
  
   $coder = JSON::XS->new->ascii->pretty->allow_nonref;
   $pretty_printed_unencoded = $coder->encode ($perl_scalar);
   $perl_scalar = $coder->decode ($unicode_json_text);
  
   # Note that JSON version 2.0 and above will automatically use JSON::XS
   # if available, at virtually no speed overhead either, so you should
   # be able to just:
   
   use JSON;
  
   # and do the same things, except that you have a pure-perl fallback now.
  
  =head1 DESCRIPTION
  
  This module converts Perl data structures to JSON and vice versa. Its
  primary goal is to be I<correct> and its secondary goal is to be
  I<fast>. To reach the latter goal it was written in C.
  
  Beginning with version 2.0 of the JSON module, when both JSON and
  JSON::XS are installed, then JSON will fall back on JSON::XS (this can be
  overridden) with no overhead due to emulation (by inheriting constructor
  and methods). If JSON::XS is not available, it will fall back to the
  compatible JSON::PP module as backend, so using JSON instead of JSON::XS
  gives you a portable JSON API that can be fast when you need and doesn't
  require a C compiler when that is a problem.
  
  As this is the n-th-something JSON module on CPAN, what was the reason
  to write yet another JSON module? While it seems there are many JSON
  modules, none of them correctly handle all corner cases, and in most cases
  their maintainers are unresponsive, gone missing, or not listening to bug
  reports for other reasons.
  
  See MAPPING, below, on how JSON::XS maps perl values to JSON values and
  vice versa.
  
  =head2 FEATURES
  
  =over 4
  
  =item * correct Unicode handling
  
  This module knows how to handle Unicode, documents how and when it does
  so, and even documents what "correct" means.
  
  =item * round-trip integrity
  
  When you serialise a perl data structure using only data types supported
  by JSON and Perl, the deserialised data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  MAPPING section below to learn about those.
  
  =item * strict checking of JSON correctness
  
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a security
  feature).
  
  =item * fast
  
  Compared to other JSON modules and other serialisers such as Storable,
  this module usually compares favourably in terms of speed, too.
  
  =item * simple to use
  
  This module has both a simple functional interface as well as an object
  oriented interface interface.
  
  =item * reasonably versatile output formats
  
  You can choose between the most compact guaranteed-single-line format
  possible (nice for simple line-based protocols), a pure-ASCII format
  (for when your transport is not 8-bit clean, still supports the whole
  Unicode range), or a pretty-printed format (for when you want to read that
  stuff). Or you can combine those features in whatever way you like.
  
  =back
  
  =cut
  
  package JSON::XS;
  
  use common::sense;
  
  our $VERSION = 2.34;
  our @ISA = qw(Exporter);
  
  our @EXPORT = qw(encode_json decode_json to_json from_json);
  
  sub to_json($) {
     require Carp;
     Carp::croak ("JSON::XS::to_json has been renamed to encode_json, either downgrade to pre-2.0 versions of JSON::XS or rename the call");
  }
  
  sub from_json($) {
     require Carp;
     Carp::croak ("JSON::XS::from_json has been renamed to decode_json, either downgrade to pre-2.0 versions of JSON::XS or rename the call");
  }
  
  use Exporter;
  use XSLoader;
  
  =head1 FUNCTIONAL INTERFACE
  
  The following convenience methods are provided by this module. They are
  exported by default:
  
  =over 4
  
  =item $json_text = encode_json $perl_scalar
  
  Converts the given Perl data structure to a UTF-8 encoded, binary string
  (that is, the string contains octets only). Croaks on error.
  
  This function call is functionally identical to:
  
     $json_text = JSON::XS->new->utf8->encode ($perl_scalar)
  
  Except being faster.
  
  =item $perl_scalar = decode_json $json_text
  
  The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
  to parse that as an UTF-8 encoded JSON text, returning the resulting
  reference. Croaks on error.
  
  This function call is functionally identical to:
  
     $perl_scalar = JSON::XS->new->utf8->decode ($json_text)
  
  Except being faster.
  
  =item $is_boolean = JSON::XS::is_bool $scalar
  
  Returns true if the passed scalar represents either JSON::XS::true or
  JSON::XS::false, two constants that act like C<1> and C<0>, respectively
  and are used to represent JSON C<true> and C<false> values in Perl.
  
  See MAPPING, below, for more information on how JSON values are mapped to
  Perl.
  
  =back
  
  
  =head1 A FEW NOTES ON UNICODE AND PERL
  
  Since this often leads to confusion, here are a few very clear words on
  how Unicode works in Perl, modulo bugs.
  
  =over 4
  
  =item 1. Perl strings can store characters with ordinal values > 255.
  
  This enables you to store Unicode characters as single characters in a
  Perl string - very natural.
  
  =item 2. Perl does I<not> associate an encoding with your strings.
  
  ... until you force it to, e.g. when matching it against a regex, or
  printing the scalar to a file, in which case Perl either interprets your
  string as locale-encoded text, octets/binary, or as Unicode, depending
  on various settings. In no case is an encoding stored together with your
  data, it is I<use> that decides encoding, not any magical meta data.
  
  =item 3. The internal utf-8 flag has no meaning with regards to the
  encoding of your string.
  
  Just ignore that flag unless you debug a Perl bug, a module written in
  XS or want to dive into the internals of perl. Otherwise it will only
  confuse you, as, despite the name, it says nothing about how your string
  is encoded. You can have Unicode strings with that flag set, with that
  flag clear, and you can have binary data with that flag set and that flag
  clear. Other possibilities exist, too.
  
  If you didn't know about that flag, just the better, pretend it doesn't
  exist.
  
  =item 4. A "Unicode String" is simply a string where each character can be
  validly interpreted as a Unicode code point.
  
  If you have UTF-8 encoded data, it is no longer a Unicode string, but a
  Unicode string encoded in UTF-8, giving you a binary string.
  
  =item 5. A string containing "high" (> 255) character values is I<not> a UTF-8 string.
  
  It's a fact. Learn to live with it.
  
  =back
  
  I hope this helps :)
  
  
  =head1 OBJECT-ORIENTED INTERFACE
  
  The object oriented interface lets you configure your own encoding or
  decoding style, within the limits of supported formats.
  
  =over 4
  
  =item $json = new JSON::XS
  
  Creates a new JSON::XS object that can be used to de/encode JSON
  strings. All boolean flags described below are by default I<disabled>.
  
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
  
     my $json = JSON::XS->new->utf8->space_after->encode ({a => [1,2]})
     => {"a": [1, 2]}
  
  =item $json = $json->ascii ([$enable])
  
  =item $enabled = $json->get_ascii
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  generate characters outside the code range C<0..127> (which is ASCII). Any
  Unicode characters outside that range will be escaped using either a
  single \uXXXX (BMP characters) or a double \uHHHH\uLLLLL escape sequence,
  as per RFC4627. The resulting encoded JSON text can be treated as a native
  Unicode string, an ascii-encoded, latin1-encoded or UTF-8 encoded string,
  or any other superset of ASCII.
  
  If C<$enable> is false, then the C<encode> method will not escape Unicode
  characters unless required by the JSON syntax or other flags. This results
  in a faster and more compact format.
  
  See also the section I<ENCODING/CODESET FLAG NOTES> later in this
  document.
  
  The main use for this flag is to produce JSON texts that can be
  transmitted over a 7-bit channel, as the encoded JSON texts will not
  contain any 8 bit characters.
  
    JSON::XS->new->ascii (1)->encode ([chr 0x10401])
    => ["\ud801\udc01"]
  
  =item $json = $json->latin1 ([$enable])
  
  =item $enabled = $json->get_latin1
  
  If C<$enable> is true (or missing), then the C<encode> method will encode
  the resulting JSON text as latin1 (or iso-8859-1), escaping any characters
  outside the code range C<0..255>. The resulting string can be treated as a
  latin1-encoded JSON text or a native Unicode string. The C<decode> method
  will not be affected in any way by this flag, as C<decode> by default
  expects Unicode, which is a strict superset of latin1.
  
  If C<$enable> is false, then the C<encode> method will not escape Unicode
  characters unless required by the JSON syntax or other flags.
  
  See also the section I<ENCODING/CODESET FLAG NOTES> later in this
  document.
  
  The main use for this flag is efficiently encoding binary data as JSON
  text, as most octets will not be escaped, resulting in a smaller encoded
  size. The disadvantage is that the resulting JSON text is encoded
  in latin1 (and must correctly be treated as such when storing and
  transferring), a rare encoding for JSON. It is therefore most useful when
  you want to store data structures known to contain binary data efficiently
  in files or databases, not when talking to other JSON encoders/decoders.
  
    JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
  
  =item $json = $json->utf8 ([$enable])
  
  =item $enabled = $json->get_utf8
  
  If C<$enable> is true (or missing), then the C<encode> method will encode
  the JSON result into UTF-8, as required by many protocols, while the
  C<decode> method expects to be handled an UTF-8-encoded string.  Please
  note that UTF-8-encoded strings do not contain any characters outside the
  range C<0..255>, they are thus useful for bytewise/binary I/O. In future
  versions, enabling this option might enable autodetection of the UTF-16
  and UTF-32 encoding families, as described in RFC4627.
  
  If C<$enable> is false, then the C<encode> method will return the JSON
  string as a (non-encoded) Unicode string, while C<decode> expects thus a
  Unicode string.  Any decoding or encoding (e.g. to UTF-8 or UTF-16) needs
  to be done yourself, e.g. using the Encode module.
  
  See also the section I<ENCODING/CODESET FLAG NOTES> later in this
  document.
  
  Example, output UTF-16BE-encoded JSON:
  
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::XS->new->encode ($object);
  
  Example, decode UTF-32LE-encoded JSON:
  
    use Encode;
    $object = JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
  
  =item $json = $json->pretty ([$enable])
  
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> (and in the future possibly more) flags in one call to
  generate the most readable (or most compact) form possible.
  
  Example, pretty-print some simple structure:
  
     my $json = JSON::XS->new->pretty(1)->encode ({a => [1,2]})
     =>
     {
        "a" : [
           1,
           2
        ]
     }
  
  =item $json = $json->indent ([$enable])
  
  =item $enabled = $json->get_indent
  
  If C<$enable> is true (or missing), then the C<encode> method will use a multiline
  format as output, putting every array member or object/hash key-value pair
  into its own line, indenting them properly.
  
  If C<$enable> is false, no newlines or indenting will be produced, and the
  resulting JSON text is guaranteed not to contain any C<newlines>.
  
  This setting has no effect when decoding JSON texts.
  
  =item $json = $json->space_before ([$enable])
  
  =item $enabled = $json->get_space_before
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts. You will also
  most likely combine this setting with C<space_after>.
  
  Example, space_before enabled, space_after and indent disabled:
  
     {"key" :"value"}
  
  =item $json = $json->space_after ([$enable])
  
  =item $enabled = $json->get_space_after
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space after the C<:> separating keys from values in JSON objects
  and extra whitespace after the C<,> separating key-value pairs and array
  members.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before and indent disabled, space_after enabled:
  
     {"key": "value"}
  
  =item $json = $json->relaxed ([$enable])
  
  =item $enabled = $json->get_relaxed
  
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
  
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
  
  Currently accepted extensions are:
  
  =over 4
  
  =item * list items can have an end-comma
  
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
  
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
  
  =item * shell-style '#'-comments
  
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
  
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
  
  =back
  
  =item $json = $json->canonical ([$enable])
  
  =item $enabled = $json->get_canonical
  
  If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
  by sorting their keys. This is adding a comparatively high overhead.
  
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script, and can change even within the same run from 5.18
  onwards).
  
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
  
  This setting has no effect when decoding JSON texts.
  
  This setting has currently no effect on tied hashes.
  
  =item $json = $json->allow_nonref ([$enable])
  
  =item $enabled = $json->get_allow_nonref
  
  If C<$enable> is true (or missing), then the C<encode> method can convert a
  non-reference into its corresponding string, number or null JSON value,
  which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
  values instead of croaking.
  
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
  
  Example, encode a Perl scalar as JSON value with enabled C<allow_nonref>,
  resulting in an invalid JSON text:
  
     JSON::XS->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
  
  =item $json = $json->allow_unknown ([$enable])
  
  =item $enabled = $json->get_allow_unknown
  
  If C<$enable> is true (or missing), then C<encode> will I<not> throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON C<null> value. Note
  that blessed objects are not included here and are handled separately by
  c<allow_nonref>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters anything it cannot encode as JSON.
  
  This option does not affect C<decode> in any way, and it is recommended to
  leave it off unless you know your communications partner.
  
  =item $json = $json->allow_blessed ([$enable])
  
  =item $enabled = $json->get_allow_blessed
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
  
  =item $json = $json->convert_blessed ([$enable])
  
  =item $enabled = $json->get_convert_blessed
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
  to do.
  
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with any C<to_json>
  function or method.
  
  This setting does not yet influence C<decode> in any way, but in the
  future, global hooks might get installed that influence C<decode> and are
  enabled by this setting.
  
  If C<$enable> is false, then the C<allow_blessed> setting will decide what
  to do when a blessed object is found.
  
  =item $json = $json->filter_json_object ([$coderef->($hashref)])
  
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument is a reference to the
  newly-created hash. If the code references returns a single scalar (which
  need not be a reference), this value (i.e. a copy of that scalar to avoid
  aliasing) is inserted into the deserialised data structure. If it returns
  an empty list (NOTE: I<not> C<undef>, which is a valid scalar), the
  original deserialised hash will be inserted. This setting can slow down
  decoding considerably.
  
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialised hash in any
  way.
  
  Example, convert all JSON objects into the integer 5:
  
     my $js = JSON::XS->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]')
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
  
  =item $json = $json->filter_json_single_key_object ($key [=> $coderef->($value)])
  
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
  
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
  
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
  
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialise Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialised Perl hash.
  
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
  
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
  
     # return whatever is in $WIDGET{5}:
     JSON::XS
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
  
     # this can be used with a TO_JSON method in some "widget" class
     # for serialisation to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
  
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
  
        { __widget__ => $self->{id} }
     }
  
  =item $json = $json->shrink ([$enable])
  
  =item $enabled = $json->get_shrink
  
  Perl usually over-allocates memory a bit when allocating space for
  strings. This flag optionally resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible. This can save
  memory when your JSON texts are either very very long or you have many
  short strings. It will also try to downgrade any strings to octet-form
  if possible: perl stores strings internally either in an encoding called
  UTF-X or in octet-form. The latter cannot store everything but uses less
  space in general (and some buggy Perl or C code might even rely on that
  internal representation being used).
  
  The actual definition of what shrink does might change in future versions,
  but it will always try to save space at the expense of time.
  
  If C<$enable> is true (or missing), the string returned by C<encode> will
  be shrunk-to-fit, while all strings generated by C<decode> will also be
  shrunk-to-fit.
  
  If C<$enable> is false, then the normal perl allocation algorithms are used.
  If you work with your data, then this is likely to be faster.
  
  In the future, this setting might control other things, such as converting
  strings that look like integers or floats into integers or floats
  internally (there is no difference on the Perl level), saving space.
  
  =item $json = $json->max_depth ([$maximum_nesting_depth])
  
  =item $max_depth = $json->get_max_depth
  
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
  
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
  
  Setting the maximum depth to one disallows any nesting, so that ensures
  that the object is only a single hash/object or array.
  
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
  
  Note that nesting is implemented by recursion in C. The default value has
  been chosen to be as large as typical operating systems allow without
  crashing.
  
  See SECURITY CONSIDERATIONS, below, for more info on why this is useful.
  
  =item $json = $json->max_size ([$maximum_string_size])
  
  =item $max_size = $json->get_max_size
  
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
  
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
  
  See SECURITY CONSIDERATIONS, below, for more info on why this is useful.
  
  =item $json_text = $json->encode ($perl_scalar)
  
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to arrays
  become JSON arrays and references to hashes become JSON objects. Undefined
  Perl values (e.g. C<undef>) become JSON C<null> values. Neither C<true>
  nor C<false> values will be generated.
  
  =item $perl_scalar = $json->decode ($json_text)
  
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
  
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1>, C<false> becomes C<0> and C<null> becomes C<undef>.
  
  =item ($perl_scalar, $characters) = $json->decode_prefix ($json_text)
  
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
  
  This is useful if your JSON texts are not delimited by an outer protocol
  (which is not the brightest thing to do in the first place) and you need
  to know where the JSON text ends.
  
     JSON::XS->new->decode_prefix ("[1] the tail")
     => ([], 3)
  
  =back
  
  
  =head1 INCREMENTAL PARSING
  
  In some cases, there is the need for incremental parsing of JSON
  texts. While this module always has to keep both JSON text and resulting
  Perl data structure in memory at one time, it does allow you to parse a
  JSON stream incrementally. It does so by accumulating text until it has
  a full JSON object, which it then can decode. This process is similar to
  using C<decode_prefix> to see if a full JSON object is available, but
  is much more efficient (and can be implemented with a minimum of method
  calls).
  
  JSON::XS will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect mismatched
  parentheses. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
  
  The following methods implement this incremental parser.
  
  =over 4
  
  =item [void, scalar or list context] = $json->incr_parse ([$string])
  
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
  
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
  
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
  
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the errornous part). This is the most common way of
  using the method.
  
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
  
  Example: Parse some JSON arrays/objects in a given string and return
  them.
  
     my @objs = JSON::XS->new->incr_parse ("[5][7][1,2]");
  
  =item $lvalue_string = $json->incr_text
  
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
  
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
  
  =item $json->incr_skip
  
  This will reset the state of the incremental parser and will remove
  the parsed text from the input buffer so far. This is useful after
  C<incr_parse> died, in which case the input buffer and incremental parser
  state is left unchanged, to skip the text parsed so far and to reset the
  parse state.
  
  The difference to C<incr_reset> is that only text until the parse error
  occured is removed.
  
  =item $json->incr_reset
  
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
  
  This is useful if you want to repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
  
  =back
  
  =head2 LIMITATIONS
  
  All options that affect decoding are supported, except
  C<allow_nonref>. The reason for this is that it cannot be made to
  work sensibly: JSON objects and arrays are self-delimited, i.e. you can concatenate
  them back to back and still decode them perfectly. This does not hold true
  for JSON numbers, however.
  
  For example, is the string C<1> a single JSON number, or is it simply the
  start of C<12>? Or is C<12> a single JSON number, or the concatenation
  of C<1> and C<2>? In neither case you can tell, and this is why JSON::XS
  takes the conservative route and disallows this case.
  
  =head2 EXAMPLES
  
  Some examples will make all this clearer. First, a simple example that
  works similarly to C<decode_prefix>: We want to decode the JSON object at
  the start of a string and identify the portion after the JSON object:
  
     my $text = "[1,2,3] hello";
  
     my $json = new JSON::XS;
  
     my $obj = $json->incr_parse ($text)
        or die "expected JSON object or array at beginning of string";
  
     my $tail = $json->incr_text;
     # $tail now contains " hello"
  
  Easy, isn't it?
  
  Now for a more complicated example: Imagine a hypothetical protocol where
  you read some requests from a TCP stream, and each request is a JSON
  array, without any separation between them (in fact, it is often useful to
  use newlines as "separators", as these get interpreted as whitespace at
  the start of the JSON text, which makes it possible to test said protocol
  with C<telnet>...).
  
  Here is how you'd do it (it is trivial to write this in an event-based
  manner):
  
     my $json = new JSON::XS;
  
     # read some data from the socket
     while (sysread $socket, my $buf, 4096) {
  
        # split and decode as many requests as possible
        for my $request ($json->incr_parse ($buf)) {
           # act on the $request
        }
     }
  
  Another complicated example: Assume you have a string with JSON objects
  or arrays, all separated by (optional) comma characters (e.g. C<[1],[2],
  [3]>). To parse them, we have to skip the commas between the JSON texts,
  and here is where the lvalue-ness of C<incr_text> comes in useful:
  
     my $text = "[1],[2], [3]";
     my $json = new JSON::XS;
  
     # void context, so no parsing done
     $json->incr_parse ($text);
  
     # now extract as many objects as possible. note the
     # use of scalar context so incr_text can be called.
     while (my $obj = $json->incr_parse) {
        # do something with $obj
  
        # now skip the optional comma
        $json->incr_text =~ s/^ \s* , //x;
     }
  
  Now lets go for a very complex example: Assume that you have a gigantic
  JSON array-of-objects, many gigabytes in size, and you want to parse it,
  but you cannot load it into memory fully (this has actually happened in
  the real world :).
  
  Well, you lost, you have to implement your own JSON parser. But JSON::XS
  can still help you: You implement a (very simple) array parser and let
  JSON decode the array elements, which are all full JSON objects on their
  own (this wouldn't work if the array elements could be JSON numbers, for
  example):
  
     my $json = new JSON::XS;
  
     # open the monster
     open my $fh, "<bigfile.json"
        or die "bigfile: $!";
  
     # first parse the initial "["
     for (;;) {
        sysread $fh, my $buf, 65536
           or die "read error: $!";
        $json->incr_parse ($buf); # void context, so no parsing
  
        # Exit the loop once we found and removed(!) the initial "[".
        # In essence, we are (ab-)using the $json object as a simple scalar
        # we append data to.
        last if $json->incr_text =~ s/^ \s* \[ //x;
     }
  
     # now we have the skipped the initial "[", so continue
     # parsing all the elements.
     for (;;) {
        # in this loop we read data until we got a single JSON object
        for (;;) {
           if (my $obj = $json->incr_parse) {
              # do something with $obj
              last;
           }
  
           # add more data
           sysread $fh, my $buf, 65536
              or die "read error: $!";
           $json->incr_parse ($buf); # void context, so no parsing
        }
  
        # in this loop we read data until we either found and parsed the
        # separating "," between elements, or the final "]"
        for (;;) {
           # first skip whitespace
           $json->incr_text =~ s/^\s*//;
  
           # if we find "]", we are done
           if ($json->incr_text =~ s/^\]//) {
              print "finished.\n";
              exit;
           }
  
           # if we find ",", we can continue with the next element
           if ($json->incr_text =~ s/^,//) {
              last;
           }
  
           # if we find anything else, we have a parse error!
           if (length $json->incr_text) {
              die "parse error near ", $json->incr_text;
           }
  
           # else add more data
           sysread $fh, my $buf, 65536
              or die "read error: $!";
           $json->incr_parse ($buf); # void context, so no parsing
        }
  
  This is a complex example, but most of the complexity comes from the fact
  that we are trying to be correct (bear with me if I am wrong, I never ran
  the above example :).
  
  
  
  =head1 MAPPING
  
  This section describes how JSON::XS maps Perl values to JSON values and
  vice versa. These mappings are designed to "do the right thing" in most
  circumstances automatically, preserving round-tripping characteristics
  (what you put in comes out as something equivalent).
  
  For the more enlightened: note that in the following descriptions,
  lowercase I<perl> refers to the Perl interpreter, while uppercase I<Perl>
  refers to the abstract Perl language itself.
  
  
  =head2 JSON -> PERL
  
  =over 4
  
  =item object
  
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserve object key ordering itself).
  
  =item array
  
  A JSON array becomes a reference to an array in Perl.
  
  =item string
  
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
  
  =item number
  
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
  
  If the number consists of digits only, JSON::XS will try to represent
  it as an integer value. If that fails, it will try to represent it as
  a numeric (floating point) value if that is possible without loss of
  precision. Otherwise it will preserve the number as a string value (in
  which case you lose roundtripping ability, as the JSON number will be
  re-encoded toa JSON string).
  
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
  
  Note that precision is not accuracy - binary floating point values cannot
  represent most decimal fractions exactly, and when converting from and to
  floating point, JSON::XS only guarantees precision up to but not including
  the leats significant bit.
  
  =item true, false
  
  These JSON atoms become C<JSON::XS::true> and C<JSON::XS::false>,
  respectively. They are overloaded to act almost exactly like the numbers
  C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
  the C<JSON::XS::is_bool> function.
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  =back
  
  
  =head2 PERL -> JSON
  
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
  
  =over 4
  
  =item hash references
  
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. JSON::XS can
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same datastructure will serialise to the same JSON text (given same
  settings and version of JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
  
  =item array references
  
  Perl array references become JSON arrays.
  
  =item other references
  
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
  also use C<JSON::XS::false> and C<JSON::XS::true> to improve readability.
  
     encode_json [\0, JSON::XS::true]      # yields [false,true]
  
  =item JSON::XS::true, JSON::XS::false
  
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> directly if you want.
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON. See the
  C<allow_blessed> and C<convert_blessed> methods on various options on
  how to deal with this: basically, you can choose between throwing an
  exception, encoding the reference as if it weren't blessed, or provide
  your own serialiser method.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: JSON::XS will encode undefined scalars as
  JSON C<null> values, scalars that have last been used in a string context
  before encoding as JSON strings, and anything else as number value:
  
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
  
     # used as string, so dump as string
     print $value;
     encode_json [$value]                 # yields ["5"]
  
     # undef becomes null
     encode_json [undef]                  # yields [null]
  
  You can force the type to be a JSON string by stringifying it:
  
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
  
  You can force the type to be a JSON number by numifying it:
  
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choice is yours.
  
  You can not currently force the type in other, less obscure, ways. Tell me
  if you need this capability (but don't forget to explain why it's needed
  :).
  
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and it is an
  error to pass those in.
  
  =back
  
  
  =head1 ENCODING/CODESET FLAG NOTES
  
  The interested reader might have seen a number of flags that signify
  encodings or codesets - C<utf8>, C<latin1> and C<ascii>. There seems to be
  some confusion on what these do, so here is a short comparison:
  
  C<utf8> controls whether the JSON text created by C<encode> (and expected
  by C<decode>) is UTF-8 encoded or not, while C<latin1> and C<ascii> only
  control whether C<encode> escapes character values outside their respective
  codeset range. Neither of these flags conflict with each other, although
  some combinations make less sense than others.
  
  Care has been taken to make all flags symmetrical with respect to
  C<encode> and C<decode>, that is, texts encoded with any combination of
  these flag values will be correctly decoded when the same flags are used
  - in general, if you use different flag settings while encoding vs. when
  decoding you likely have a bug somewhere.
  
  Below comes a verbose discussion of these flags. Note that a "codeset" is
  simply an abstract set of character-codepoint pairs, while an encoding
  takes those codepoint numbers and I<encodes> them, in our case into
  octets. Unicode is (among other things) a codeset, UTF-8 is an encoding,
  and ISO-8859-1 (= latin 1) and ASCII are both codesets I<and> encodings at
  the same time, which can be confusing.
  
  =over 4
  
  =item C<utf8> flag disabled
  
  When C<utf8> is disabled (the default), then C<encode>/C<decode> generate
  and expect Unicode strings, that is, characters with high ordinal Unicode
  values (> 255) will be encoded as such characters, and likewise such
  characters are decoded as-is, no canges to them will be done, except
  "(re-)interpreting" them as Unicode codepoints or Unicode characters,
  respectively (to Perl, these are the same thing in strings unless you do
  funny/weird/dumb stuff).
  
  This is useful when you want to do the encoding yourself (e.g. when you
  want to have UTF-16 encoded JSON texts) or when some other layer does
  the encoding for you (for example, when printing to a terminal using a
  filehandle that transparently encodes to UTF-8 you certainly do NOT want
  to UTF-8 encode your data first and have Perl encode it another time).
  
  =item C<utf8> flag enabled
  
  If the C<utf8>-flag is enabled, C<encode>/C<decode> will encode all
  characters using the corresponding UTF-8 multi-byte sequence, and will
  expect your input strings to be encoded as UTF-8, that is, no "character"
  of the input string must have any value > 255, as UTF-8 does not allow
  that.
  
  The C<utf8> flag therefore switches between two modes: disabled means you
  will get a Unicode string in Perl, enabled means you get an UTF-8 encoded
  octet/binary string in Perl.
  
  =item C<latin1> or C<ascii> flags enabled
  
  With C<latin1> (or C<ascii>) enabled, C<encode> will escape characters
  with ordinal values > 255 (> 127 with C<ascii>) and encode the remaining
  characters as specified by the C<utf8> flag.
  
  If C<utf8> is disabled, then the result is also correctly encoded in those
  character sets (as both are proper subsets of Unicode, meaning that a
  Unicode string with all character values < 256 is the same thing as a
  ISO-8859-1 string, and a Unicode string with all character values < 128 is
  the same thing as an ASCII string in Perl).
  
  If C<utf8> is enabled, you still get a correct UTF-8-encoded string,
  regardless of these flags, just some more characters will be escaped using
  C<\uXXXX> then before.
  
  Note that ISO-8859-1-I<encoded> strings are not compatible with UTF-8
  encoding, while ASCII-encoded strings are. That is because the ISO-8859-1
  encoding is NOT a subset of UTF-8 (despite the ISO-8859-1 I<codeset> being
  a subset of Unicode), while ASCII is.
  
  Surprisingly, C<decode> will ignore these flags and so treat all input
  values as governed by the C<utf8> flag. If it is disabled, this allows you
  to decode ISO-8859-1- and ASCII-encoded strings, as both strict subsets of
  Unicode. If it is enabled, you can correctly decode UTF-8 encoded strings.
  
  So neither C<latin1> nor C<ascii> are incompatible with the C<utf8> flag -
  they only govern when the JSON output engine escapes a character or not.
  
  The main use for C<latin1> is to relatively efficiently store binary data
  as JSON, at the expense of breaking compatibility with most JSON decoders.
  
  The main use for C<ascii> is to force the output to not contain characters
  with values > 127, which means you can interpret the resulting string
  as UTF-8, ISO-8859-1, ASCII, KOI8-R or most about any character set and
  8-bit-encoding, and still get the same data structure back. This is useful
  when your channel for JSON transfer is not 8-bit clean or the encoding
  might be mangled in between (e.g. in mail), and works because ASCII is a
  proper subset of most 8-bit and multibyte encodings in use in the world.
  
  =back
  
  
  =head2 JSON and ECMAscript
  
  JSON syntax is based on how literals are represented in javascript (the
  not-standardised predecessor of ECMAscript) which is presumably why it is
  called "JavaScript Object Notation".
  
  However, JSON is not a subset (and also not a superset of course) of
  ECMAscript (the standard) or javascript (whatever browsers actually
  implement).
  
  If you want to use javascript's C<eval> function to "parse" JSON, you
  might run into parse errors for valid JSON texts, or the resulting data
  structure might not be queryable:
  
  One of the problems is that U+2028 and U+2029 are valid characters inside
  JSON strings, but are not allowed in ECMAscript string literals, so the
  following Perl fragment will not output something that can be guaranteed
  to be parsable by javascript's C<eval>:
  
     use JSON::XS;
  
     print encode_json [chr 0x2028];
  
  The right fix for this is to use a proper JSON parser in your javascript
  programs, and not rely on C<eval> (see for example Douglas Crockford's
  F<json2.js> parser).
  
  If this is not an option, you can, as a stop-gap measure, simply encode to
  ASCII-only JSON:
  
     use JSON::XS;
  
     print JSON::XS->new->ascii->encode ([chr 0x2028]);
  
  Note that this will enlarge the resulting JSON text quite a bit if you
  have many non-ASCII characters. You might be tempted to run some regexes
  to only escape U+2028 and U+2029, e.g.:
  
     # DO NOT USE THIS!
     my $json = JSON::XS->new->utf8->encode ([chr 0x2028]);
     $json =~ s/\xe2\x80\xa8/\\u2028/g; # escape U+2028
     $json =~ s/\xe2\x80\xa9/\\u2029/g; # escape U+2029
     print $json;
  
  Note that I<this is a bad idea>: the above only works for U+2028 and
  U+2029 and thus only for fully ECMAscript-compliant parsers. Many existing
  javascript implementations, however, have issues with other characters as
  well - using C<eval> naively simply I<will> cause problems.
  
  Another problem is that some javascript implementations reserve
  some property names for their own purposes (which probably makes
  them non-ECMAscript-compliant). For example, Iceweasel reserves the
  C<__proto__> property name for its own purposes.
  
  If that is a problem, you could parse try to filter the resulting JSON
  output for these property strings, e.g.:
  
     $json =~ s/"__proto__"\s*:/"__proto__renamed":/g;
  
  This works because C<__proto__> is not valid outside of strings, so every
  occurence of C<"__proto__"\s*:> must be a string used as property name.
  
  If you know of other incompatibilities, please let me know.
  
  
  =head2 JSON and YAML
  
  You often hear that JSON is a subset of YAML. This is, however, a mass
  hysteria(*) and very far from the truth (as of the time of this writing),
  so let me state it clearly: I<in general, there is no way to configure
  JSON::XS to output a data structure as valid YAML> that works in all
  cases.
  
  If you really must use JSON::XS to generate YAML, you should use this
  algorithm (subject to change in future versions):
  
     my $to_yaml = JSON::XS->new->utf8->space_after (1);
     my $yaml = $to_yaml->encode ($ref) . "\n";
  
  This will I<usually> generate JSON texts that also parse as valid
  YAML. Please note that YAML has hardcoded limits on (simple) object key
  lengths that JSON doesn't have and also has different and incompatible
  unicode character escape syntax, so you should make sure that your hash
  keys are noticeably shorter than the 1024 "stream characters" YAML allows
  and that you do not have characters with codepoint values outside the
  Unicode BMP (basic multilingual page). YAML also does not allow C<\/>
  sequences in strings (which JSON::XS does not I<currently> generate, but
  other JSON generators might).
  
  There might be other incompatibilities that I am not aware of (or the YAML
  specification has been changed yet again - it does so quite often). In
  general you should not try to generate YAML with a JSON generator or vice
  versa, or try to parse JSON with a YAML parser or vice versa: chances are
  high that you will run into severe interoperability problems when you
  least expect it.
  
  =over 4
  
  =item (*)
  
  I have been pressured multiple times by Brian Ingerson (one of the
  authors of the YAML specification) to remove this paragraph, despite him
  acknowledging that the actual incompatibilities exist. As I was personally
  bitten by this "JSON is YAML" lie, I refused and said I will continue to
  educate people about these issues, so others do not run into the same
  problem again and again. After this, Brian called me a (quote)I<complete
  and worthless idiot>(unquote).
  
  In my opinion, instead of pressuring and insulting people who actually
  clarify issues with YAML and the wrong statements of some of its
  proponents, I would kindly suggest reading the JSON spec (which is not
  that difficult or long) and finally make YAML compatible to it, and
  educating users about the changes, instead of spreading lies about the
  real compatibility for many I<years> and trying to silence people who
  point out that it isn't true.
  
  Addendum/2009: the YAML 1.2 spec is still incompatible with JSON, even
  though the incompatibilities have been documented (and are known to Brian)
  for many years and the spec makes explicit claims that YAML is a superset
  of JSON. It would be so easy to fix, but apparently, bullying people and
  corrupting userdata is so much easier.
  
  =back
  
  
  =head2 SPEED
  
  It seems that JSON::XS is surprisingly fast, as shown in the following
  tables. They have been generated with the help of the C<eg/bench> program
  in the JSON::XS distribution, to make it easy to compare on your own
  system.
  
  First comes a comparison between various modules using
  a very short single-line JSON string (also available at
  L<http://dist.schmorp.de/misc/json/short.json>).
  
     {"method": "handleMessage", "params": ["user1",
     "we were just talking"], "id": null, "array":[1,11,234,-5,1e5,1e7,
     1,  0]}
  
  It shows the number of encodes/decodes per second (JSON::XS uses
  the functional interface, while JSON::XS/2 uses the OO interface
  with pretty-printing and hashkey sorting enabled, JSON::XS/3 enables
  shrink. JSON::DWIW/DS uses the deserialise function, while JSON::DWIW::FJ
  uses the from_json method). Higher is better:
  
     module        |     encode |     decode |
     --------------|------------|------------|
     JSON::DWIW/DS |  86302.551 | 102300.098 |
     JSON::DWIW/FJ |  86302.551 |  75983.768 |
     JSON::PP      |  15827.562 |   6638.658 |
     JSON::Syck    |  63358.066 |  47662.545 |
     JSON::XS      | 511500.488 | 511500.488 |
     JSON::XS/2    | 291271.111 | 388361.481 |
     JSON::XS/3    | 361577.931 | 361577.931 |
     Storable      |  66788.280 | 265462.278 |
     --------------+------------+------------+
  
  That is, JSON::XS is almost six times faster than JSON::DWIW on encoding,
  about five times faster on decoding, and over thirty to seventy times
  faster than JSON's pure perl implementation. It also compares favourably
  to Storable for small amounts of data.
  
  Using a longer test string (roughly 18KB, generated from Yahoo! Locals
  search API (L<http://dist.schmorp.de/misc/json/long.json>).
  
     module        |     encode |     decode |
     --------------|------------|------------|
     JSON::DWIW/DS |   1647.927 |   2673.916 |
     JSON::DWIW/FJ |   1630.249 |   2596.128 |
     JSON::PP      |    400.640 |     62.311 |
     JSON::Syck    |   1481.040 |   1524.869 |
     JSON::XS      |  20661.596 |   9541.183 |
     JSON::XS/2    |  10683.403 |   9416.938 |
     JSON::XS/3    |  20661.596 |   9400.054 |
     Storable      |  19765.806 |  10000.725 |
     --------------+------------+------------+
  
  Again, JSON::XS leads by far (except for Storable which non-surprisingly
  decodes a bit faster).
  
  On large strings containing lots of high Unicode characters, some modules
  (such as JSON::PC) seem to decode faster than JSON::XS, but the result
  will be broken due to missing (or wrong) Unicode handling. Others refuse
  to decode or encode properly, so it was impossible to prepare a fair
  comparison table for that case.
  
  
  =head1 SECURITY CONSIDERATIONS
  
  When you are using JSON in a protocol, talking to untrusted potentially
  hostile creatures requires relatively few measures.
  
  First of all, your JSON decoder should be secure, that is, should not have
  any buffer overflows. Obviously, this module should ensure that and I am
  trying hard on making that true, but you never know.
  
  Second, you need to avoid resource-starving attacks. That means you should
  limit the size of JSON texts you accept, or make sure then when your
  resources run out, that's just fine (e.g. by using a separate process that
  can crash safely). The size of a JSON text in octets or characters is
  usually a good indication of the size of the resources required to decode
  it into a Perl structure. While JSON::XS can check the size of the JSON
  text, it might be too late when you already have it in memory, so you
  might want to check the size before you accept the string.
  
  Third, JSON::XS recurses using the C stack when decoding objects and
  arrays. The C stack is a limited resource: for instance, on my amd64
  machine with 8MB of stack size I can decode around 180k nested arrays but
  only 14k nested JSON objects (due to perl itself recursing deeply on croak
  to free the temporary). If that is exceeded, the program crashes. To be
  conservative, the default nesting limit is set to 512. If your process
  has a smaller stack, you should adjust this setting accordingly with the
  C<max_depth> method.
  
  Something else could bomb you, too, that I forgot to think of. In that
  case, you get to keep the pieces. I am always open for hints, though...
  
  Also keep in mind that JSON::XS might leak contents of your Perl data
  structures in its error messages, so when you serialise sensitive
  information you might want to make sure that exceptions thrown by JSON::XS
  will not end up in front of untrusted eyes.
  
  If you are using JSON::XS to return packets to consumption
  by JavaScript scripts in a browser you should have a look at
  L<http://blog.archive.jpsykes.com/47/practical-csrf-and-json-security/> to
  see whether you are vulnerable to some common attack vectors (which really
  are browser design bugs, but it is still you who will have to deal with
  it, as major browser developers care only for features, not about getting
  security right).
  
  
  =head1 THREADS
  
  This module is I<not> guaranteed to be thread safe and there are no
  plans to change this until Perl gets thread support (as opposed to the
  horribly slow so-called "threads" which are simply slow and bloated
  process simulations - use fork, it's I<much> faster, cheaper, better).
  
  (It might actually work, but you have been warned).
  
  
  =head1 THE PERILS OF SETLOCALE
  
  Sometimes people avoid the Perl locale support and directly call the
  system's setlocale function with C<LC_ALL>.
  
  This breaks both perl and modules such as JSON::XS, as stringification of
  numbers no longer works correcly (e.g. C<$x = 0.1; print "$x"+1> might
  print C<1>, and JSON::XS might output illegal JSON as JSON::XS relies on
  perl to stringify numbers).
  
  The solution is simple: don't call C<setlocale>, or use it for only those
  categories you need, such as C<LC_MESSAGES> or C<LC_CTYPE>.
  
  If you need C<LC_NUMERIC>, you should enable it only around the code that
  actually needs it (avoiding stringification of numbers), and restore it
  afterwards.
  
  
  =head1 BUGS
  
  While the goal of this module is to be correct, that unfortunately does
  not mean it's bug-free, only that I think its design is bug-free. If you
  keep reporting bugs they will be fixed swiftly, though.
  
  Please refrain from using rt.cpan.org or any other bug reporting
  service. I put the contact address into my modules for a reason.
  
  =cut
  
  our $true  = do { bless \(my $dummy = 1), "JSON::XS::Boolean" };
  our $false = do { bless \(my $dummy = 0), "JSON::XS::Boolean" };
  
  sub true()  { $true  }
  sub false() { $false }
  
  sub is_bool($) {
     UNIVERSAL::isa $_[0], "JSON::XS::Boolean"
  #      or UNIVERSAL::isa $_[0], "JSON::Literal"
  }
  
  XSLoader::load "JSON::XS", $VERSION;
  
  package JSON::XS::Boolean;
  
  use overload
     "0+"     => sub { ${$_[0]} },
     "++"     => sub { $_[0] = ${$_[0]} + 1 },
     "--"     => sub { $_[0] = ${$_[0]} - 1 },
     fallback => 1;
  
  1;
  
  =head1 SEE ALSO
  
  The F<json_xs> command line utility for quick experiments.
  
  =head1 AUTHOR
  
   Marc Lehmann <schmorp@schmorp.de>
   http://home.schmorp.de/
  
  =cut
  
DARWIN-2LEVEL_JSON_XS

$fatpacked{"darwin-2level/JSON/XS/Boolean.pm"} = <<'DARWIN-2LEVEL_JSON_XS_BOOLEAN';
  =head1 NAME
  
  JSON::XS::Boolean - dummy module providing JSON::XS::Boolean
  
  =head1 SYNOPSIS
  
   # do not "use" yourself
  
  =head1 DESCRIPTION
  
  This module exists only to provide overload resolution for Storable and similar modules. See
  L<JSON::XS> for more info about this class.
  
  =cut
  
  use JSON::XS ();
  
  1;
  
  =head1 AUTHOR
  
   Marc Lehmann <schmorp@schmorp.de>
   http://home.schmorp.de/
  
  =cut
  
DARWIN-2LEVEL_JSON_XS_BOOLEAN

$fatpacked{"darwin-2level/Sub/Name.pm"} = <<'DARWIN-2LEVEL_SUB_NAME';
  package Sub::Name;
  
  =head1 NAME
  
  Sub::Name - (re)name a sub
  
  =head1 SYNOPSIS
  
      use Sub::Name;
  
      subname $name, $subref;
  
      $subref = subname foo => sub { ... };
  
  =head1 DESCRIPTION
  
  This module has only one function, which is also exported by default:
  
  =head2 subname NAME, CODEREF
  
  Assigns a new name to referenced sub.  If package specification is omitted in 
  the name, then the current package is used.  The return value is the sub.
  
  The name is only used for informative routines (caller, Carp, etc).  You won't 
  be able to actually invoke the sub by the given name.  To allow that, you need 
  to do glob-assignment yourself.
  
  Note that for anonymous closures (subs that reference lexicals declared outside 
  the sub itself) you can name each instance of the closure differently, which 
  can be very useful for debugging.
  
  =head1 AUTHOR
  
  Matthijs van Duin <xmath@cpan.org>
  
  Copyright (C) 2004, 2008  Matthijs van Duin.  All rights reserved.
  This program is free software; you can redistribute it and/or modify 
  it under the same terms as Perl itself.
  
  =cut
  
  use 5.006;
  
  use strict;
  use warnings;
  
  our $VERSION = '0.05';
  
  use base 'Exporter';
  use base 'DynaLoader';
  
  our @EXPORT = qw(subname);
  our @EXPORT_OK = @EXPORT;
  
  bootstrap Sub::Name $VERSION;
  
  1;
DARWIN-2LEVEL_SUB_NAME

$fatpacked{"oo.pm"} = <<'OO';
  package oo;
  
  use strictures 1;
  use Moo::_Utils;
  
  sub moo {
    print <<'EOMOO';
   ______
  < Moo! >
   ------
          \   ^__^
           \  (oo)\_______
              (__)\       )\/\
                  ||----w |
                  ||     ||
  EOMOO
    exit 0;
  }
  
  BEGIN {
      my $package;
      sub import {
          moo() if $0 eq '-';
          $package = $_[1] || 'Class';
          if ($package =~ /^\+/) {
              $package =~ s/^\+//;
              _load_module($package);
          }
      }
      use Filter::Simple sub { s/^/package $package;\nuse Moo;\n/; }
  }
  
  1;
OO

$fatpacked{"strictures.pm"} = <<'STRICTURES';
  package strictures;
  
  use strict;
  use warnings FATAL => 'all';
  
  use constant _PERL_LT_5_8_4 => ($] < 5.008004) ? 1 : 0;
  
  our $VERSION = '1.004004'; # 1.4.4
  
  sub VERSION {
    for ($_[1]) {
      last unless defined && !ref && int != 1;
      die "Major version specified as $_ - this is strictures version 1";
    }
    # disable this since Foo->VERSION(undef) correctly returns the version
    # and that can happen either if our caller passes undef explicitly or
    # because the for above autovivified $_[1] - I could make it stop but
    # it's pointless since we don't want to blow up if the caller does
    # something valid either.
    no warnings 'uninitialized';
    shift->SUPER::VERSION(@_);
  }
  
  my $extra_load_states;
  
  our $Smells_Like_VCS = (-e '.git' || -e '.svn'
    || (-e '../../dist.ini' && (-e '../../.git' || -e '../../.svn')));
  
  sub import {
    strict->import;
    warnings->import(FATAL => 'all');
  
    my $extra_tests = do {
      if (exists $ENV{PERL_STRICTURES_EXTRA}) {
        if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {
          die 'PERL_STRICTURES_EXTRA checks are not available on perls older than 5.8.4: '
            . "please unset \$ENV{PERL_STRICTURES_EXTRA}\n";
        }
        $ENV{PERL_STRICTURES_EXTRA};
      } elsif (! _PERL_LT_5_8_4) {
        !!((caller)[1] =~ /^(?:t|xt|lib|blib)/
           and $Smells_Like_VCS)
      }
    };
    if ($extra_tests) {
      $extra_load_states ||= do {
  
        my (%rv, @failed);
        foreach my $mod (qw(indirect multidimensional bareword::filehandles)) {
          eval "require $mod; \$rv{'$mod'} = 1;" or do {
            push @failed, $mod;
  
            # courtesy of the 5.8 require bug
            # (we do a copy because 5.16.2 at least uses the same read-only
            # scalars for the qw() list and it doesn't seem worth a $^V check)
  
            (my $file = $mod) =~ s|::|/|g;
            delete $INC{"${file}.pm"};
          };
        }
  
        if (@failed) {
          my $failed = join ' ', @failed;
          print STDERR <<EOE;
  strictures.pm extra testing active but couldn't load all modules. Missing were:
  
    $failed
  
  Extra testing is auto-enabled in checkouts only, so if you're the author
  of a strictures-using module you need to run:
  
    cpan indirect multidimensional bareword::filehandles
  
  but these modules are not required by your users.
  EOE
        }
  
        \%rv;
      };
  
      indirect->unimport(':fatal') if $extra_load_states->{indirect};
      multidimensional->unimport if $extra_load_states->{multidimensional};
      bareword::filehandles->unimport if $extra_load_states->{'bareword::filehandles'};
    }
  }
  
  1;
  
  __END__
  =head1 NAME
  
  strictures - turn on strict and make all warnings fatal
  
  =head1 SYNOPSIS
  
    use strictures 1;
  
  is equivalent to
  
    use strict;
    use warnings FATAL => 'all';
  
  except when called from a file which matches:
  
    (caller)[1] =~ /^(?:t|xt|lib|blib)/
  
  and when either C<.git> or C<.svn> is present in the current directory (with
  the intention of only forcing extra tests on the author side) -- or when C<.git>
  or C<.svn> is present two directories up along with C<dist.ini> (which would
  indicate we are in a C<dzil test> operation, via L<Dist::Zilla>) --
  or when the C<PERL_STRICTURES_EXTRA> environment variable is set, in which case
  
    use strictures 1;
  
  is equivalent to
  
    use strict;
    use warnings FATAL => 'all';
    no indirect 'fatal';
    no multidimensional;
    no bareword::filehandles;
  
  Note that C<PERL_STRICTURES_EXTRA> may at some point add even more tests, with only a minor
  version increase, but any changes to the effect of C<use strictures> in
  normal mode will involve a major version bump.
  
  If any of the extra testing modules are not present, L<strictures> will
  complain loudly, once, via C<warn()>, and then shut up. But you really
  should consider installing them, they're all great anti-footgun tools.
  
  =head1 DESCRIPTION
  
  I've been writing the equivalent of this module at the top of my code for
  about a year now. I figured it was time to make it shorter.
  
  Things like the importer in C<use Moose> don't help me because they turn
  warnings on but don't make them fatal -- which from my point of view is
  useless because I want an exception to tell me my code isn't warnings-clean.
  
  Any time I see a warning from my code, that indicates a mistake.
  
  Any time my code encounters a mistake, I want a crash -- not spew to STDERR
  and then unknown (and probably undesired) subsequent behaviour.
  
  I also want to ensure that obvious coding mistakes, like indirect object
  syntax (and not so obvious mistakes that cause things to accidentally compile
  as such) get caught, but not at the cost of an XS dependency and not at the
  cost of blowing things up on another machine.
  
  Therefore, L<strictures> turns on additional checking, but only when it thinks
  it's running in a test file in a VCS checkout -- although if this causes
  undesired behaviour this can be overridden by setting the
  C<PERL_STRICTURES_EXTRA> environment variable.
  
  If additional useful author side checks come to mind, I'll add them to the
  C<PERL_STRICTURES_EXTRA> code path only -- this will result in a minor version increase (e.g.
  1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of
  this code will result in a sub-version increase (e.g. 1.000000 to 1.000001
  (1.0.1)).
  
  If the behaviour of C<use strictures> in normal mode changes in any way, that
  will constitute a major version increase -- and the code already checks
  when its version is tested to ensure that
  
    use strictures 1;
  
  will continue to only introduce the current set of strictures even if 2.0 is
  installed.
  
  =head1 METHODS
  
  =head2 import
  
  This method does the setup work described above in L</DESCRIPTION>
  
  =head2 VERSION
  
  This method traps the C<< strictures->VERSION(1) >> call produced by a use line
  with a version number on it and does the version check.
  
  =head1 EXTRA TESTING RATIONALE
  
  Every so often, somebody complains that they're deploying via C<git pull>
  and that they don't want L<strictures> to enable itself in this case -- and that
  setting C<PERL_STRICTURES_EXTRA> to 0 isn't acceptable (additional ways to
  disable extra testing would be welcome but the discussion never seems to get
  that far).
  
  In order to allow us to skip a couple of stages and get straight to a
  productive conversation, here's my current rationale for turning the
  extra testing on via a heuristic:
  
  The extra testing is all stuff that only ever blows up at compile time;
  this is intentional. So the oft-raised concern that it's different code being
  tested is only sort of the case -- none of the modules involved affect the
  final optree to my knowledge, so the author gets some additional compile
  time crashes which he/she then fixes, and the rest of the testing is
  completely valid for all environments.
  
  The point of the extra testing -- especially C<no indirect> -- is to catch
  mistakes that newbie users won't even realise are mistakes without
  help. For example,
  
    foo { ... };
  
  where foo is an & prototyped sub that you forgot to import -- this is
  pernicious to track down since all I<seems> fine until it gets called
  and you get a crash. Worse still, you can fail to have imported it due
  to a circular require, at which point you have a load order dependent
  bug which I've seen before now I<only> show up in production due to tiny
  differences between the production and the development environment. I wrote
  L<http://shadow.cat/blog/matt-s-trout/indirect-but-still-fatal/> to explain
  this particular problem before L<strictures> itself existed.
  
  As such, in my experience so far L<strictures>' extra testing has
  I<avoided> production versus development differences, not caused them.
  
  Additionally, L<strictures>' policy is very much "try and provide as much
  protection as possible for newbies -- who won't think about whether there's
  an option to turn on or not" -- so having only the environment variable
  is not sufficient to achieve that (I get to explain that you need to add
  C<use strict> at least once a week on freenode #perl -- newbies sometimes
  completely skip steps because they don't understand that that step
  is important).
  
  I make no claims that the heuristic is perfect -- it's already been evolved
  significantly over time, especially for 1.004 where we changed things to
  ensure it only fires on files in your checkout (rather than L<strictures>-using
  modules you happened to have installed, which was just silly). However, I
  hope the above clarifies why a heuristic approach is not only necessary but
  desirable from a point of view of providing new users with as much safety as possible,
  and will allow any future discussion on the subject to focus on "how do we
  minimise annoyance to people deploying from checkouts intentionally".
  
  =head1 COMMUNITY AND SUPPORT
  
  =head2 IRC channel
  
  irc.perl.org #toolchain
  
  (or bug 'mst' in query on there or freenode)
  
  =head2 Git repository
  
  Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is:
  
    git clone git://git.shadowcat.co.uk/p5sagit/strictures.git
  
  The web interface to the repository is at:
  
    http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/strictures.git
  
  =head1 AUTHOR
  
  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  
  =head1 CONTRIBUTORS
  
  None required yet. Maybe this module is perfect (hahahahaha ...).
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  =head1 LICENSE
  
  This library is free software and may be distributed under the same terms
  as perl itself.
  
  =cut
STRICTURES

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 5.008001;
use Carton::CLI;
$Carton::Fatpacked = 1;
exit Carton::CLI->new->run(@ARGV);
