#!/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/Rakubrew.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW';
  package App::Rakubrew;
  use strict;
  use warnings;
  use 5.010;
  our $VERSION = '33';
  
  use Encode::Locale qw(env);
  if (-t) {
      binmode(STDIN, ":encoding(console_in)");
      binmode(STDOUT, ":encoding(console_out)");
      binmode(STDERR, ":encoding(console_out)");
  }
  use FindBin qw($RealBin);
  use File::Path qw(remove_tree);
  use File::Spec::Functions qw(catfile catdir splitpath updir rel2abs);
  
  use App::Rakubrew::Build;
  use App::Rakubrew::Config;
  use App::Rakubrew::Download;
  use App::Rakubrew::Shell;
  use App::Rakubrew::Tools;
  use App::Rakubrew::Update;
  use App::Rakubrew::Variables;
  use App::Rakubrew::VersionHandling;
  
  sub new {
      my ($class, @argv) = @_;
      my %opt = (
          args => \@argv,
      );
      my $self = bless \%opt, $class;
      return $self;
  }
  
  sub run_script {
      my ($self) = @_;
      my @args = @{$self->{args}};
  
      sub _cant_access_home {
          say STDERR "Can't create rakubrew home directory in $prefix";
          say STDERR "Probably rakubrew was denied access. You can either change that folder to be writable";
          say STDERR "or set a different rakubrew home directory by setting the `\$RAKUBREW_HOME` environment";
          say STDERR "prior to calling the rakubrew shell hook. ";
          exit 1;
      }
  
      unless (-d $prefix) {
          _cant_access_home() unless mkdir $prefix;
      }
  
      mkdir(catdir($prefix, 'bin'))    || _cant_access_home() unless (-d catdir($prefix, 'bin'));
      mkdir(catdir($prefix, 'update')) || _cant_access_home() unless (-d catdir($prefix, 'update'));
      mkdir(catdir($prefix, 'repos'))    || _cant_access_home() unless (-d catdir($prefix, 'repos'));
      mkdir $shim_dir                  || _cant_access_home() unless (-d $shim_dir);
      mkdir $versions_dir              || _cant_access_home() unless (-d $versions_dir);
      mkdir $git_reference             || _cant_access_home() unless (-d $git_reference);
  
      { # Check whether we are called as a shim and forward if yes.
          my (undef, undef, $prog_name) = splitpath($0);
  
          # TODO: Mac is also case insensitive. Is this way to compensate for insensitivity safe?
          if ($prog_name ne $brew_name &&
          ($^O !~ /win32/i || $prog_name =~ /^\Q$brew_name\E\z/i)) {
              $self->do_exec($prog_name, \@args);
          }
      }
  
      { # Detect shell environment and initialize the shell object.
          my $shell = '';
          $shell = $args[1] if @args >= 2 && $args[0] eq 'internal_shell_hook';
          $shell = $args[1] if @args >= 2 && $args[0] eq 'internal_hooked';
          $shell = $args[1] if @args >= 2 && $args[0] eq 'init';
          $self->{hook} = App::Rakubrew::Shell->initialize($shell);
      }
  
      if (@args >= 2 && $args[0] eq 'internal_hooked') { # The hook is there, all good!
          shift @args; # Remove the hook so processing code below doesn't need to care about it.
          shift @args; # Remove the shell parameter for the same reason.
      }
      elsif (
      get_brew_mode() eq 'env'
          && !(@args && $args[0] eq 'mode' && $args[1] eq 'shim')
          && !(@args && $args[0] eq 'init')
          && !(@args && $args[0] eq 'home')
          && !(@args && $args[0] =~ /^internal_/)
      || @args && $args[0] eq 'shell'
      || @args >= 2 && $args[0] eq 'mode' && $args[1] eq 'env') {
          say STDERR << "EOL";
  The shell hook required to run rakubrew in either 'env' mode or with the 'shell' command seems not to be installed.
  Run '$brew_name init' for installation instructions if you want to use those features,
  or run '$brew_name mode shim' to use 'shim' mode which doesn't require a shell hook.
  EOL
          exit 1;
      }
  
      my $arg = shift(@args) // 'help';
  
      if ($arg eq 'version' || $arg eq 'current') {
          if (my $c = get_version()) {
              say "Currently running $c"
          } else {
              say STDERR "Not running anything at the moment. Use '$brew_name switch' to set a version";
              exit 1;
          }
  
      } elsif ($arg eq 'versions' || $arg eq 'list') {
          my $cur = get_version() // '';
          map {
              my $version_line = '';
              $version_line .= 'BROKEN ' if is_version_broken($_);
              $version_line .= $_ eq $cur ? '* ' : '  ';
              $version_line .= $_;
              $version_line .= ' -> ' . (get_version_path($_, 1) || '') if is_registered_version($_);
              say $version_line;
          } get_versions();
  
      } elsif ($arg eq 'global' || $arg eq 'switch') {
          if (!@args) {
              my $version = get_global_version();
              if ($version) {
                  say $version;
              }
              else {
                  say "$brew_name: no global version configured";
              }
          }
          else {
              $self->match_and_run($args[0], sub {
                  set_global_version(shift);
              });
          }
  
      } elsif ($arg eq 'shell') {
          if (!@args) {
              my $shell_version = get_shell_version();
              if (defined $shell_version) {
                  say "$shell_version";
              }
              else {
                  say "$brew_name: no shell-specific version configured";
              }
          }
          else {
              my $version = shift @args;
              if ($version ne '--unset') {
                  verify_version($version);
              }
          }
  
      } elsif ($arg eq 'local') {
          validate_brew_mode();
          if (!@args) {
              my $version = get_local_version();
              if ($version) {
                  say $version;
              }
              else {
                  say "$brew_name: no local version configured for this directory";
              }
          }
          else {
              my $version = shift @args;
              if ($version eq '--unset') {
                  set_local_version(undef);
              }
              else {
                  $self->match_and_run($version, sub {
                      set_local_version(shift);
                  });
              }
          }
  
      } elsif ($arg eq 'nuke' || $arg eq 'unregister') {
          my $version = shift @args;
          $self->nuke($version);
  
      } elsif ($arg eq 'rehash') {
          validate_brew_mode();
          rehash();
  
      } elsif ($arg eq 'list-available' || $arg eq 'available') {
          my ($cur_backend, $cur_rakudo) = split '-', (get_version() // ''), 2;
          $cur_backend //= '';
          $cur_rakudo  //= '';
  
          my @downloadables = App::Rakubrew::Download::available_precomp_archives();
          say "Available Rakudo versions:";
          map {
              my $ver = $_;
              my $d = (grep {$_->{ver} eq $ver} @downloadables) ? 'D' : ' ';
              my $s = $cur_rakudo eq $ver                       ? '*' : ' ';
              say "$s$d $ver";
          } App::Rakubrew::Build::available_rakudos();
          say '';
          $cur_backend |= '';
          $cur_rakudo |= '';
          say "Available backends:";
          map { say $cur_backend eq $_ ? "* $_" : "  $_" } App::Rakubrew::Variables::available_backends();
  
      } elsif ($arg eq 'build-rakudo' || $arg eq 'build') {
          my ($impl, $ver, @args) =
              App::Rakubrew::VersionHandling::match_version(@args);
          if (!$ver) {
              my @versions = App::Rakubrew::Build::available_rakudos();
              @versions = grep { /^\d\d\d\d\.\d\d/ } @versions;
              $ver = $versions[-1];
          }
  
          if ($impl eq "panda") {
              say "panda is discontinued; please use zef (rakubrew build-zef) instead";
          } elsif ($impl eq "zef") {
              my $version = get_version();
              if (!$version) {
                  say STDERR "$brew_name: No version set.";
                  exit 1;
              }
              App::Rakubrew::Build::build_zef($version);
              # Might have new executables now -> rehash.
              rehash();
              say "Done, built zef for $version";
          } elsif (!exists $impls{$impl}) {
              my $warning = "Cannot build Rakudo with backend '$impl': this backend ";
              if ($impl eq "parrot") {
                  $warning .= "is no longer supported.";
              } else {
                  $warning .= "does not exist.";
              }
              say $warning;
              exit 1;
          }
          else {
              my $configure_opts = '';
              if (@args && $args[0] =~ /^--configure-opts=/) {
                  $configure_opts = shift @args;
                  $configure_opts =~ s/^\-\-configure-opts=//;
                  $configure_opts =~ s/^'//;
                  $configure_opts =~ s/'$//;
              }
  
              my $name = "$impl-$ver";
              $name = $impl if $impl eq 'moar-blead' && $ver eq 'main';
  
              if ($impl && $impl eq 'all') {
                  for (App::Rakubrew::Variables::available_backends()) {
                      App::Rakubrew::Build::build_impl($_, $ver, $configure_opts);
                  }
              } else {
                  App::Rakubrew::Build::build_impl($impl, $ver, $configure_opts);
              }
  
              # Might have new executables now -> rehash.
              rehash();
              if (get_version() eq 'system') {
                  set_global_version($name);
              }
              say "Done, $name built";
          }
  
      } elsif ($arg eq 'triple') {
          my ($rakudo_ver, $nqp_ver, $moar_ver) = @args[0 .. 2];
          my $name = App::Rakubrew::Build::build_triple($rakudo_ver, $nqp_ver, $moar_ver);
  
          # Might have new executables now -> rehash
          rehash();
          if (get_version() eq 'system') {
              set_global_version($name);
          }
          say "Done, $name built";
  
      } elsif ($arg eq 'download-rakudo' || $arg eq 'download') {
          my ($impl, $ver, @args) =
              App::Rakubrew::VersionHandling::match_version(@args);
  
          if (!exists $impls{$impl}) {
              say STDERR "Cannot download Rakudo on '$impl': this backend does not exist.";
              exit 1;
          }
  
          my $name = App::Rakubrew::Download::download_precomp_archive($impl, $ver);
  
          # Might have new executables now -> rehash
          rehash();
          if (get_version() eq 'system') {
              set_global_version("$name");
          }
          say "Done, $name installed";
      } elsif ($arg eq 'register') {
          my ($name, $path) = @args[0 .. 1];
          if (!$name || !$path) {
              say STDERR "$brew_name: Need a version name and rakudo installation path";
              exit 1;
          }
          if (version_exists($name)) {
              say STDERR "$brew_name: Version $name already exists";
              exit 1;
          }
  
          sub invalid {
              my $path = shift;
              say STDERR "$brew_name: No valid rakudo installation found at '$path'";
              exit 1;
          }
          $path = rel2abs($path);
          invalid($path) if is_version_path_broken($path);
          $path = clean_version_path($path);
  
          spurt(catfile($versions_dir, $name), $path);
  
      } elsif ($arg eq 'build-zef') {
          my $version = get_version();
          my $zef_version = shift(@args);
          if (!$version) {
              say STDERR "$brew_name: No version set.";
              exit 1;
          }
          say("Building zef ", $zef_version || "latest");
          App::Rakubrew::Build::build_zef($version, $zef_version);
          # Might have new executables now -> rehash
          rehash();
          say "Done, built zef for $version";
  
      } elsif ($arg eq 'build-panda') {
          say "panda is discontinued; please use zef (rakubrew build-zef) instead";
  
      } elsif ($arg eq 'exec') {
          my $prog_name = shift @args;
          $self->do_exec($prog_name, \@args);
  
      } elsif ($arg eq 'which') {
          if (!@args) {
              say STDERR "Usage: $brew_name which <command>";
          }
          else {
              my $version = get_version();
              if (!$version) {
                  say STDERR "$brew_name: No version set.";
                  exit 1;
              }
              map {say $_} which($args[0], $version);
          }
  
      } elsif ($arg eq 'whence') {
          if (!@args) {
              say STDERR "Usage: $brew_name whence [--path] <command>";
          }
          else {
              my $param = shift @args;
              my $pathmode = $param eq '--path';
              my $prog = $pathmode ? shift(@args) : $param;
              map {say $_} whence($prog, $pathmode);
          }
  
      } elsif ($arg eq 'mode') {
          if (!@args) {
              say get_brew_mode();
          }
          else {
              set_brew_mode($args[0]);
          }
  
      } elsif ($arg eq 'self-upgrade') {
          App::Rakubrew::Update::update();
  
      } elsif ($arg eq 'init') {
          $self->init(@args);
  
      } elsif ($arg eq 'home') {
          say $prefix;
  
      } elsif ($arg eq 'test') {
          my $version = shift @args;
          if (!$version) {
              $self->test(get_version());
          }
          elsif ($version eq 'all') {
              for (get_versions()) {
                  $self->test($_);
              }
          } else {
              $self->test($version);
          }
      } elsif ($arg eq 'internal_shell_hook') {
          my $shell = shift @args;
          my $sub   = shift @args;
          if (my $ref = $self->{hook}->can($sub)) {
              $self->{hook}->$sub(@args);
          }
  
      } elsif ($arg eq 'internal_win_run') {
          my $prog_name = shift @args;
          my $path = which($prog_name, get_version());
          # Do some filetype detection:
          # - .exe/.bat/.cmd              -> return "filename"
          # - .nqp                        -> return "nqp filename"
          # - shebang contains raku|perl6 -> return "raku|perl6 filename"
          # - shebang contains perl       -> return "perl filename"
          # - nothing of the above        -> return "filename" # if we can't
          #                                  figure out what to do with this
          #                                  filename, let Windows have a try.
          # The first line is potentially the shebang. Thus the search for "perl" and/or perl6/raku.
          my ($basename, undef, $suffix) = my_fileparse($prog_name);
          if($suffix =~ /^\Q\.(exe|bat|cmd)\E\z/i) {
              say $path;
          }
          elsif($suffix =~ /^\Q\.nqp\E\z/i) {
              say which('nqp', get_version()).' '.$path;
          }
          else {
              open(my $fh, '<', $path);
              my $first_line = <$fh>;
              close($fh);
              if($first_line =~ /#!.*(perl6|raku)/) {
                  say get_raku(get_version()) . ' ' . $path;
              }
              elsif($first_line =~ /#!.*perl/) {
                  say 'perl '.$path;
              }
              else {
                  say $path;
              }
          }
  
      } elsif ($arg eq 'internal_update') {
          App::Rakubrew::Update::internal_update(@args);
  
      } elsif ($arg eq 'rakubrew-version') {
          say "rakubrew v$VERSION Build type: $distro_format OS: $^O";
  
      } else {
          require Pod::Usage;
          my $help_text = "";
          open my $pod_fh, ">", \$help_text;
  
          my $verbose = 0;
          @args = grep {
              if ($_ eq '-v' || $_ eq '--verbose') {
                  $verbose = 1;
                  0;
              }
              else { 1; }
          } @args;
  
          if ($arg eq 'help' && @args) {
              # the user wants help for a specific command
              # e.g., rakubrew help list
              my $command = $args[ 0 ];
              $command = 'download-rakudo' if $command eq 'download';
              $command = 'build-rakudo'    if $command eq 'build';
  
              Pod::Usage::pod2usage(
                  -exitval   => "NOEXIT",  # do not terminate this script!
                  -verbose   => 99,        # 99 = indicate the sections
                  -sections  => "COMMAND: " . lc( $command ), # e.g.: COMMAND: list
                  -output    => $pod_fh,   # filehandle reference
                  -noperldoc => 1          # do not call perldoc
              );
  
              # some cleanup
              $help_text =~ s/\A[^\n]+\n//s;
              $help_text =~ s/^    //gm;
  
              $help_text = "Cannot find documentation for [$command]!" if ($help_text =~ /\A\s*\Z/);
          }
          else {
              # Generic help or unknown command
              Pod::Usage::pod2usage(
                  -exitval   => "NOEXIT",  # do not terminate this script!
                  -verbose   => $verbose ? 2 : 1, # 1 = only SYNOPSIS, 2 = print everything
                  -output    => $pod_fh,   # filehandle reference
                  -noperldoc => 1          # do not call perldoc
              );
          }
  
          close $pod_fh;
  
          my $backends = join '|', App::Rakubrew::Variables::available_backends(), 'all';
  
          say $help_text;
      }
  }
  
  sub match_and_run {
      my ($self, $version, $action) = @_;
      if (!$version) {
          say "Which version do you mean?";
          say "Available builds:";
          map {say} get_versions();
          return;
      }
      if (grep { $_ eq $version } get_versions()) {
          $action->($version);
      }
      else {
          say "Sorry, '$version' not found.";
          my @match = grep { /\Q$version/ } get_versions();
          if (@match) {
              say "Did you mean:";
              say $_ for @match;
          }
      }
  }
  
  sub test {
      my ($self, $version) = @_;
      $self->match_and_run($version, sub {
          my $matched = shift;
          verify_version($matched);
          my $v_dir = catdir($versions_dir, $matched);
          if (!-d $v_dir) {
              say STDERR "Version $matched was not built by rakubrew.";
              say STDERR "Refusing to try running spectest there.";
              exit 1;
          }
          chdir catdir($versions_dir, $matched);
          say "Spectesting $matched";
          if (!-f 'Makefile') {
              say STDERR "Can only run spectest in self built Rakudos.";
              say STDERR "This Rakudo is not self built.";
              exit 1;
          }
          run(App::Rakubrew::Build::determine_make($matched), 'spectest');
      });
  }
  
  sub nuke {
      my ($self, $version) = @_;
      $self->match_and_run($version, sub {
          my $matched = shift;
          if (is_registered_version($matched)) {
              say "Unregistering $matched";
              unlink(catfile($versions_dir, $matched));
          }
          elsif ($matched eq 'system') {
              say 'I refuse to nuke system Raku!';
              exit 1;
          }
          elsif ($matched eq get_version()) {
              say "$matched is currently active. I refuse to nuke.";
              exit 1;
          }
          else {
              say "Nuking $matched";
              remove_tree(catdir($versions_dir, $matched));
          }
      });
      # Might have lost executables -> rehash
      rehash();
  }
  
  sub init {
      my $self = shift;
      my $brew_exec = catfile($RealBin, $brew_name);
      if (@_) {
          # We have an argument. That has to be the shell.
          # We already retrieved the shell above, so no need to look at the passed argument here again.
          say $self->{hook}->get_init_code;
      }
      else {
          say $self->{hook}->install_note;
      }
  }
  
  sub de_par_environment {
      # The PAR packager modifies the environment.
      # We undo those modifications here.
  
      # The following code was kindly provided by Roderich Schupp
      # via email.
      my $ldlibpthname = $Config::Config{ldlibpthname};
      my $path_sep = $Config::Config{path_sep};
      $ENV{$ldlibpthname} =~ s/^ \Q$ENV{PAR_TEMP}\E $path_sep? //x;
  
      delete $ENV{PAR_0};
      delete $ENV{PAR_INITIALIZED};
      delete $ENV{PAR_PROGNAME};
      delete $ENV{PAR_TEMP};
  }
  
  sub do_exec {
      my ($self, $program, $args) = @_;
  
      my $target = which($program, get_version());
  
      # Undo PAR env modifications.
      # Only need to do this on MacOS, as only there
      # PAR is used and rakubrew itself does the `exec`.
      # (Windows also uses PAR, but has a .bat shim that
      # does the `exec`.)
      if ($distro_format eq 'macos') {
          de_par_environment;
      }
      
      # Run.
      exec { $target } ($target, @$args);
      die "Executing $target failed with: $!";
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  App::Rakubrew - Raku environment manager
  
  =head1 DESCRIPTION
  
  A tool to manage multiple Rakudo installations.
  
  See L<rakubrew.org|https://rakubrew.org/>.
  
  =head1 AUTHOR
  
  Patrick Böker C<< <patrickb@cpan.org> >>
  Tadeusz Sośnierz C<< <tadzik@cpan.org> >>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2020 by Patrick Böker.
  
  This is free software, licensed under:
  
    The MIT (X11) License
  
APP_RAKUBREW

$fatpacked{"App/Rakubrew/Build.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_BUILD';
  package App::Rakubrew::Build;
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw();
  
  use strict;
  use warnings;
  use 5.010;
  use File::Spec::Functions qw(catdir catfile updir);
  use IPC::Cmd qw(can_run);
  use Cwd qw(cwd);
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  
  sub _version_is_at_least {
      my $min_ver = shift;
      my $rakudo_dir = shift;
      my $ver = slurp(catfile($rakudo_dir, 'VERSION'));
      my ($min_year, $min_month, $min_sub);
      my ($year, $month, $sub);
      if ($ver =~ /(\d\d\d\d)\.(\d\d)(?:\.(\d+))?/ ) {
          $year = $1;
          $month = $2;
          $sub = $3 // 0;
      }
      if ($min_ver =~ /(\d\d\d\d)\.(\d\d)(?:\.(\d+))?/ ) {
          $min_year = $1;
          $min_month = $2;
          $min_sub = $3 // 0;
      }
  
      # If it's not a release by date, it's older.
      return 1 if !$min_year && $year;
      return 0 if $min_year && !$year;
  
      # If both are really old not by date releases, we are conservative and say
      # the release is older hopefully backwards compatibility will save us.
      return 0 if !$min_year && !$year;
  
      return 1 if $min_year < $year;
      return 0 if $min_year > $year;
      return 1 if $min_month < $month;
      return 0 if $min_month > $month;
      return 1 if $min_sub < $sub;
      return 0 if $min_sub > $sub;
  
      return 1; # $min_sub == $sub;
  }
  
  sub _get_git_cache_option {
      my $rakudo_dir = shift;
      if ( _version_is_at_least('2020.02', $rakudo_dir) ) {
          return "--git-cache-dir=\"$git_reference\"";
      }
      else {
          return "--git-reference=\"$git_reference\"";
      }
  }
  
  sub _get_relocatable_option {
      my $rakudo_dir = shift;
      if ( _version_is_at_least('2019.07', $rakudo_dir) ) {
          return "--relocatable";
      }
      say STDERR "The current rakubrew setup requires Rakudo to be relocated, but the";
      say STDERR "Rakudo you selected to be built does not support the `--relocatable`";
      say STDERR "option yet. Try building a newer Rakudo.";
      exit 1;
  }
  
  sub available_rakudos {
      _check_git();
  
      my @output = qx|$GIT ls-remote --tags $git_repos{rakudo}|;
      my @tags = grep(m{refs/tags/([^\^]+)\^\{\}}, @output);
      @tags = map(m{tags/([^\^]+)\^}, @tags);
      @tags = grep(/^\d/, @tags);
      return sort(@tags), 'main';
  }
  
  sub build_impl {
      my ($impl, $ver, $configure_opts) = @_;
  
      _check_build_dependencies();
  
      my $name = "$impl-$ver";
      $name = $impl if $impl eq 'moar-blead' && $ver eq 'main';
  
      if (version_exists($name) && is_registered_version($name)) {
          say STDERR "$name is a registered version. I'm not going to touch it.";
          exit 1;
      }
  
      chdir $versions_dir;
      unless (version_exists($name)) {
          for(@{$impls{$impl}{need_repo}}) {
              _update_git_reference($_);
          }
          run "$GIT clone --reference \"$git_reference/rakudo\" $git_repos{rakudo} $name";
      }
      chdir $name;
      run "$GIT fetch";
      # when people say 'build somebranch', they usually mean 'build origin/somebranch'
      my $ver_to_checkout = $ver;
      eval {
          run "$GIT rev-parse -q --verify origin/$ver";
          $ver_to_checkout = "origin/$ver";
      };
      run "$GIT checkout -q $ver_to_checkout";
  
      $configure_opts .= ' ' . _get_git_cache_option(cwd());
      run $impls{$impl}{configure} . " $configure_opts";
  }
  
  sub determine_make {
      my $version = shift;
  
      my $cmd = get_raku($version) . ' --show-config';
      my $config = qx{$cmd};
  
      my $make;
      $make = $1 if $config =~ m/::make=(.*)$/m;
  
      if (!$make) {
          say STDERR "Couldn't determine correct make program. Aborting.";
          exit 1;
      }
  
      return $make;
  }
  
  sub build_triple {
      my ($rakudo_ver, $nqp_ver, $moar_ver) = @_;
  
      _check_build_dependencies();
  
      my $impl = "moar";
      $rakudo_ver //= 'HEAD';
      $nqp_ver //= 'HEAD';
      $moar_ver //= 'HEAD';
  
      my $name = "$impl-$rakudo_ver-$nqp_ver-$moar_ver";
  
      chdir $versions_dir;
  
      unless (-d $name) {
          _update_git_reference('rakudo');
          run "$GIT clone --reference \"$git_reference/rakudo\" $git_repos{rakudo} $name";
      }
      chdir $name;
      run "$GIT pull";
      run "$GIT checkout $rakudo_ver";
  
      my $configure_opts = '--make-install'
          . ' --prefix=' . catdir($versions_dir, $name, 'install')
          . ' ' . _get_git_cache_option(cwd());
  
      unless (-d "nqp") {
          _update_git_reference('nqp');
          run "$GIT clone --reference \"$git_reference/nqp\" $git_repos{nqp}";
      }
      chdir "nqp";
      run "$GIT pull";
      run "$GIT checkout $nqp_ver";
  
      unless (-d "MoarVM") {
          _update_git_reference('MoarVM');
          run "$GIT clone --reference \"$git_reference/MoarVM\" $git_repos{MoarVM}";
      }
  
      chdir "MoarVM";
      run "$GIT pull";
      run "$GIT checkout $moar_ver";
  
      run "$PERL5 Configure.pl " . $configure_opts;
  
      chdir updir();
      run "$PERL5 Configure.pl --backend=moar " . $configure_opts;
  
      chdir updir();
      run "$PERL5 Configure.pl --backend=moar " . $configure_opts;
  
      if (-d 'zef') {
          say "Updating zef as well";
          build_zef($name);
      }
  
      return $name;
  }
  
  sub _verify_git_branch_exists {
      my $branch = shift;
      return system("$GIT show-ref --verify -q refs/heads/" . $branch) == 0;
  }
  
  sub build_zef {
      my $version = shift;
      my $zef_version = shift;
  
      _check_git();
  
      if (-d $zef_dir) {
          chdir $zef_dir;
          if (!_verify_git_branch_exists('main')) {
              run "$GIT fetch -q origin main";
          }
          run "$GIT checkout -f -q main && git reset --hard HEAD && $GIT pull -q";
      } else {
          run "$GIT clone $git_repos{zef} $zef_dir";
          chdir $zef_dir;
      }
  
      my %tags = map  { chomp($_); $_ => 1 } `$GIT tag`;
      if ( $zef_version && !$tags{$zef_version} ) {
          die "Couldn't find version $zef_version, aborting\n";
      }
  
      if ( $zef_version ) {
          run "$GIT checkout tags/$zef_version";
      } else {
          run "$GIT checkout main";
      }
      run get_raku($version) . " -I. bin/zef test .";
      run get_raku($version) . " -I. bin/zef --/test --force install .";
  }
  
  sub _update_git_reference {
      my $repo = shift;
      my $back = cwd();
      print "Update git reference: $repo\n";
      chdir $git_reference;
      unless (-d $repo) {
          run "$GIT clone --bare $git_repos{$repo} $repo";
      }
      chdir $repo;
      run "$GIT fetch";
      chdir $back;
  }
  
  sub _check_build_dependencies() {
      _check_git();
      _check_perl();
  }
  
  sub _check_git {
      if (!can_run($GIT)) {
          say STDERR "Did not find `$GIT` program. That's a requirement for using some rakubrew commmands. Aborting.";
          exit 1;
      }
  }
  
  sub _check_perl {
      if (!can_run($PERL5)) {
          say STDERR "Did not find `$PERL5` program. That's a requirement for using some rakubrew commands. Aborting.";
          exit 1;
      }
  }
  
  1;
  
APP_RAKUBREW_BUILD

$fatpacked{"App/Rakubrew/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_CONFIG';
  package App::Rakubrew::Config;
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw( $distro_format );
  
  use strict;
  use warnings;
  use 5.010;
  
  # One of: fatpack, macos, win, cpan
  our $distro_format = 'fatpack';
  
APP_RAKUBREW_CONFIG

$fatpacked{"App/Rakubrew/Download.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_DOWNLOAD';
  package App::Rakubrew::Download;
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw();
  
  use strict;
  use warnings;
  use 5.010;
  use HTTP::Tinyish;
  use JSON;
  use Config;
  use Cwd qw(cwd);
  use IO::Uncompress::Unzip qw( $UnzipError );
  use File::Path qw( make_path remove_tree );
  use File::Copy::Recursive qw( dirmove );
  use File::Spec::Functions qw( updir splitpath catfile catdir );
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  
  my $release_index_url   = 'https://rakudo.org/dl/rakudo';
  my $download_url_prefix = 'https://rakudo.org/dl/rakudo/';
  
  sub download_precomp_archive {
      my ($impl, $ver) = @_;
  
      my $ht = HTTP::Tinyish->new();
  
      my @matching_releases = grep {
              $_->{backend} eq $impl && ($ver ? $_->{ver} eq $ver : 1)
          } _retrieve_releases($ht);
  
      if (!@matching_releases) {
          say STDERR 'Couldn\'t find a precomp release for OS: "' . _my_platform() . '", architecture: "' . _my_arch() . '"' . ($ver ? (', version: "' . $ver . '"') : '');
          say STDERR 'You can try building yourself. Use the `rakubrew build` command to do so.';
          exit 1;
      }
      if ($ver && @matching_releases > 1) {
          say STDERR 'Multiple releases found for your architecture. Don\'t know what to install. This shouldn\'t happen.';
          exit 1;
      }
  
      if (!$ver) {
          $ver = $matching_releases[0]->{ver};
      }
  
      my $name = "$impl-$ver";
  
      chdir $versions_dir;
      if (-d $name) {
          say STDERR "$name is already installed.";
          exit 1;
      }
  
      say 'Downloading ' . $matching_releases[0]->{url};
      my $res = $ht->get($matching_releases[0]->{url});
      unless ($res->{success}) {
          say STDERR "Couldn\'t download release. Error: $res->{status} $res->{reason}";
          exit 1;
      }
  
      mkdir $name;
      say 'Extracting';
      if (_my_platform() eq 'win') {
          _unzip(\($res->{content}), $name);
      }
      else {
          _untar($res->{content}, $name);
      }
  
      # Remove top-level rakudo-2020.01 folder and move all files one level up.
      my $back = cwd();
      chdir $name;
      my $rakudo_dir;
      opendir(DIR, '.') || die "Can't open directory: $!\n";
      while (my $file = readdir(DIR)) {
          if (-d $file && $file =~ /^rakudo-/) {
              $rakudo_dir = $file;
              last;
          }
      }
      closedir(DIR);
      unless ($rakudo_dir) {
          say STDERR "Archive didn't look as expected, aborting. Extracted to: $name";
          exit 1;
      }
      dirmove($rakudo_dir, '.');
      rmdir($rakudo_dir);
      chdir $back;
  
      return $name;
  }
  
  sub available_precomp_archives {
      return _retrieve_releases(HTTP::Tinyish->new());
  }
  
  sub _retrieve_releases {
      my $ht = shift;
      my $release_index = _download_release_index($ht);
      my @matching_releases =
          sort { $b->{ver} cmp $a->{ver} }
          grep {
                 $_->{name}     eq 'rakudo'
              && $_->{type}     eq 'archive'
              && $_->{platform} eq _my_platform()
              && $_->{arch}     eq _my_arch()
              && $_->{format}   eq (_my_platform() eq 'win' ? 'zip' : 'tar.gz')
          } @$release_index;
  
      # Filter out older build revisions
      @matching_releases = grep {
          my $this = $_;
          not grep {
                 +($_->{build_rev}) > +($this->{build_rev})
              && $_->{name}     eq $this->{name}
              && $_->{type}     eq $this->{type}
              && $_->{platform} eq $this->{platform}
              && $_->{arch}     eq $this->{arch}
              && $_->{format}   eq $this->{format}
              && $_->{ver}      eq $this->{ver};
          } @matching_releases;
      } @matching_releases;
  
      return @matching_releases;
  }
  
  sub _my_platform {
  	my %oses = (
  		MSWin32 => 'win',
  		darwin  => 'macos',
  		linux   => 'linux',
  		openbsd => 'openbsd',
  	);
      return $oses{$^O} // $^O;
  }
  
  sub _my_arch {
      my $arch =
          $Config{archname} =~ /x64/i                               ? 'x86_64' :
          $Config{archname} =~ /x86_64/i                            ? 'x86_64' :
          $Config{archname} =~ /amd64/i                             ? 'x86_64' :
          $Config{archname} =~ /x86/i                               ? 'x86'    :
          $Config{archname} =~ /i686/i                              ? 'x86'    :
          $Config{archname} =~ /darwin/i && `sysctl -n machdep.cpu.brand_string` =~ /Apple/i ? 'arm64'  : # MacOS M1 / Apple Silicon
          $Config{archname} =~ /darwin/i && `sysctl -n machdep.cpu.brand_string` =~ /Intel/i ? 'x86_64' : # MacOS Intel
          $Config{archname} =~ /aarch64/i                           ? 'arm64'  : # e.g. Raspi >= 2.1 with 64bit OS
          $Config{archname} =~ /arm-linux-gnueabihf/i               ? 'armhf'  : # e.g. Raspi >= 2, with 32bit OS
          $Config{archname} =~ /s390x-linux/i                       ? 's390x'  :
          '';
  
      unless ($arch) {
          say STDERR 'Couldn\'t detect system architecture. Current arch is: ' . $Config{archname};
          say STDERR 'Current uname -a is: ' . `uname -a`;
          exit 1;
      }
      return $arch;
  }
  
  sub _download_release_index {
      my $ht = shift;
      my $res = $ht->get($release_index_url);
      unless ($res->{success}) {
          say STDERR "Couldn\'t fetch release index at $release_index_url. Error: $res->{status} $res->{reason}";
          exit 1;
      }
      return decode_json($res->{content});
  }
  
  sub _untar {
      my ($data, $target) = @_;
      my $back = cwd();
      chdir $target;
      open (TAR, '| tar -xz');
      binmode(TAR);
      print TAR $data;
      close TAR;
      chdir $back;
  }
  
  sub _unzip {
      my ($data_ref, $target) = @_;
  
      my $zip = IO::Uncompress::Unzip->new($data_ref);
      unless ($zip) {
          say STDERR "Reading zip file failed. Error: $UnzipError";
          exit 1;
  	}
  
      my $status;
      for ($status = 1; $status > 0; $status = $zip->nextStream()) {
          my $header = $zip->getHeaderInfo();
  
          my ($vol, $path, $file) = splitpath($header->{Name});
  
          if (index($path, updir()) != -1) {
              say STDERR 'Found updirs in zip file, this is bad. Aborting.';
              exit 1;
          }
  
          my $target_dir  = catdir($target, $path);
  
          unless (-d $target_dir) {
              unless (make_path($target_dir)) {
                  say STDERR "Failed to create directory $target_dir. Error: $!";
                  exit 1;
              }
          }
  
          next unless $file;
  
          my $target_file = catfile($target, $path, $file);
  
          unless (open(FH, '>', $target_file)) {
              say STDERR "Failed to write $target_file. Error: $!";
              exit 1;
          }
          binmode(FH);
  
          my $buf;
          while (($status = $zip->read($buf)) > 0) {
              print FH $buf;
          }
          close FH;
      }
  
      if ($status < 0) {
          say STDERR "Failed to extract archive.";
          exit 1;
      }
  }
  
APP_RAKUBREW_DOWNLOAD

$fatpacked{"App/Rakubrew/Shell.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL';
  package App::Rakubrew::Shell;
  use strict;
  use warnings;
  use 5.010;
  use File::Spec::Functions qw(catdir catfile updir splitpath);
  use Try::Tiny;
  use App::Rakubrew::Tools;
  use App::Rakubrew::Variables;
  use App::Rakubrew::VersionHandling;
  
  # Turn on substring-based command line completion where possible contrary to the
  # "start of the line completion". I.e., to visualize the difference, 'ver'
  # string would result in the following command candidates:
  #   SUBSTRING_COMPLETION==1 -> version versions rakubrew-version
  #   SUBSTRING_COMPLETION==0 -> version versions
  use constant SUBSTRING_COMPLETION => 1;
  
  my $shell_hook;
  
  sub initialize {
      my $class = shift;
      my $shell = shift;
  
      if (!shell_exists('Dummy self', $shell) || $shell eq 'auto') {
          $shell = detect_shell();
      }
  
      eval "require App::Rakubrew::Shell::$shell";
      if ($@) {
          die "Loading shell hook failed: " . $@;
      }
      $shell_hook = bless {}, "App::Rakubrew::Shell::$shell";
      return $shell_hook;
  }
  
  sub detect_shell {
      if ($^O =~ /win32/i) {
          # https://stackoverflow.com/a/8547234
          my $psmodpath = $ENV{PSMODULEPATH};
          my $userprofile = $ENV{USERPROFILE};
          if (index($psmodpath, $userprofile) == 0) {
              return 'PowerShell';
          }
          else {
              return 'Cmd';
          }
      }
      else {
          my $shell = $ENV{'SHELL'} || '/bin/bash';
          $shell = (splitpath( $shell))[2];
          $shell =~ s/[^a-z]+$//; # remove version numbers
  
          # tcsh claims it's csh on FreeBSD. Try to detect that.
          if ($shell eq 'csh' && $ENV{'tcsh'}) {
              $shell = 'tcsh';
          }
  
          $shell = ucfirst $shell;
  
          if (!shell_exists('Dummy self', $shell)) {
              $shell = 'Sh';
          }
  
          return $shell;
      }
  }
  
  sub get {
      my $self = shift;
      return $shell_hook;
  }
  
  sub shell_exists {
      my $self = shift;
      my $shell = shift;
  
      eval "require App::Rakubrew::Shell::$shell";
      return $@ ? 0 : 1;
  }
  
  sub print_shellmod_code {
      my $self = shift;
      my @params = @_;
      my $command = shift(@params) // '';
      my $mode = get_brew_mode(1);
      my $version;
  
      my $sep = $^O =~ /win32/i ? ';' : ':';
  
      if ($command eq 'shell' && @params) {
          $version = $params[0];
          if ($params[0] eq '--unset') {
              say $self->get_shell_unsetter_code();
          }
          elsif (! is_version_broken($params[0])) {
              say $self->get_shell_setter_code($params[0]);
          }
      }
      elsif ($command eq 'mode' && $mode eq 'shim') { # just switched to shim mode
          my $path = $ENV{PATH};
          $path = $self->clean_path($path);
          $path = $shim_dir . $sep . $path;
          say $self->get_path_setter_code($path);
      }
      elsif ($mode eq 'env') {
          $version = get_version();
      }
  
      if ($mode eq 'env') {
          my $path = $ENV{PATH};
          $path = $self->clean_path($path);
  
          if ($version ne 'system') {
              if ($version eq '--unset') {
                  # Get version ignoring the still set shell version.
                  $version = get_version('shell');
              }
              return if is_version_broken($version);
              $path = join($sep, get_bin_paths($version), $path);
          }
  
          # In env mode several commands require changing PATH, so we just always
          # construct a new PATH and see if it's different.
          if ($path ne $ENV{PATH}) {
              say $self->get_path_setter_code($path);
          }
      }
  }
  
  sub clean_path {
      my $self = shift;
      my $path = shift;
      my $also_clean_path = shift;
  
      my $sep = $^O =~ /win32/i ? ';' : ':';
  
      my @paths;
      for my $version (get_versions()) {
          next if $version eq 'system';
          next if is_version_broken($version);
          try {
              push @paths, get_bin_paths($version);
          }
          catch {
              # Version is broken. So it's likely not in path anyways.
              # -> ignore it
          };
      }
      push @paths, $versions_dir;
      push @paths, $shim_dir;
      push @paths, $also_clean_path if $also_clean_path;
      @paths = map { "\Q$_\E" } @paths;
      my $paths_regex = join "|", @paths;
  
      my $old_path;
      do {
          $old_path = $path;
          $path =~ s/^($paths_regex)[^$sep]*$//g;
          $path =~ s/^($paths_regex)[^$sep]*$sep//g;
          $path =~ s/$sep($paths_regex)[^$sep]*$//g;
          $path =~ s/$sep($paths_regex)[^$sep]*$sep/$sep/g;
      } until $path eq $old_path;
      return $path;
  }
  
  # Strips out all elements in arguments array up to and including $bre_name
  # command.  The first argument is index where the completion should look for the
  # word to be completed.
  sub strip_executable {
      my $self = shift;
      my $index = shift;
  
      my $cmd_pos = 0;
      foreach my $word (@_) {
          ++$cmd_pos;
          --$index;
          last if $word =~ /(^|\W)$brew_name$/;
      }
      return ($index, @_[$cmd_pos..$#_])
  }
  
  =pod
  
  Returns a list of completion candidates.
  This function takes two parameters:
  
  =over 4
  
  =item * Index of the word to complete, 0-based. If C<-1> is passed then list of all commands is returned.
  
  =item * A list of words already entered
  
  =back
  
  =cut
  
  sub _filter_candidates {
      my $self = shift;
      my $seed = shift;
      return 
          # If a shell preserves ordering then put the prefix-mathing candidates first. I.e. for 'ver' 'version' would
          # precede 'rakudo-version'
          sort { index($a, $seed) cmp index($b, $seed) }
          grep { 
              my $pos = index($_, $seed);
              SUBSTRING_COMPLETION ? $pos >= 0 : $pos == 0
          } @_
  }
  
  sub get_completions {
      my $self = shift;
      my ($index, @words) = @_;
  
      my @commands = qw(version current versions list global switch shell local nuke unregister rehash available list-available build register build-zef download exec which whence mode self-upgrade triple test home rakubrew-version);
  
      if ($index <= 0) { # if @words is empty then $index == -1
          my $candidate = $index < 0 || !$words[0] ? '' : $words[0];
          my @c = $self->_filter_candidates($candidate, @commands, 'help');
          return @c;
      }
      elsif($index == 1 && ($words[0] eq 'global' || $words[0] eq 'switch' || $words[0] eq 'shell' || $words[0] eq 'local' || $words[0] eq 'nuke' || $words[0] eq 'test')) {
          my @versions = get_versions();
          push @versions, 'all'     if $words[0] eq 'test';
          push @versions, '--unset' if $words[0] eq 'shell';
          my $candidate = $words[1] // '';
          return $self->_filter_candidates($candidate, @versions);
      }
      elsif($index == 1 && $words[0] eq 'build') {
          my $candidate = $words[1] // '';
          return $self->_filter_candidates($candidate, (App::Rakubrew::Variables::available_backends(), 'all'));
      }
      elsif($index == 2 && $words[0] eq 'build') {
          my @installed = map { if ($_ =~ /^\Q$words[1]\E-(.*)$/) {$1} else { () } } get_versions();
          my @installables = grep({ my $able = $_; !grep({ $able eq $_ } @installed) } App::Rakubrew::Build::available_rakudos());
          my $candidate = $words[2] // '';
          return $self->_filter_candidates($candidate, @installables);
      }
      elsif($index == 1 && $words[0] eq 'download') {
          my $candidate = $words[1] // '';
          return $self->_filter_candidates($candidate, ('moar'));
      }
      elsif($index == 2 && $words[0] eq 'download') {
          my @installed = map { if ($_ =~ /^\Q$words[1]\E-(.*)$/) {$1} else { () } } get_versions();
          my @installables = map { $_->{ver} } App::Rakubrew::Download::available_precomp_archives();
          @installables = grep { my $able = $_; !grep({ $able eq $_ } @installed) } @installables;
          my $candidate = $words[2] // '';
          return $self->_filter_candidates($candidate, @installables);
      }
      elsif($index == 1 && $words[0] eq 'mode') {
          my @modes = qw(env shim);
          my $candidate = $words[2] // '';
          return $self->_filter_candidates($candidate, @modes);
      }
      elsif($index == 2 && $words[0] eq 'register') {
          my @completions;
  
          my $path = $words[2];
          my ($volume, $directories, $file) = splitpath($path);
          $path = catdir($volume, $directories, $file); # Normalize the path
          my $basepath = catdir($volume, $directories);
          opendir(my $dh, $basepath) or return '';
          while (my $entry = readdir $dh) {
              my $candidate = catdir($basepath, $entry);
              next if $entry =~ /^\./;
              next if substr($candidate, 0, length($path)) ne $path;
              next if !-d $candidate;
              $candidate .= '/' if length($candidate) > 0 && substr($candidate, -1) ne '/';
              push @completions, $candidate;
          }
          closedir $dh;
          return @completions;
      }
      elsif($index == 1 && $words[0] eq 'help') {
          my $candidate = $words[1] // '';
          my @topics = @commands;
          push @topics, '--verbose';
          return $self->_filter_candidates($candidate, @topics);
      }
  }
  
  1;
APP_RAKUBREW_SHELL

$fatpacked{"App/Rakubrew/Shell/Bash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL_BASH';
  package App::Rakubrew::Shell::Bash;
  use App::Rakubrew::Shell;
  our @ISA = "App::Rakubrew::Shell";
  use strict;
  use warnings;
  use 5.010;
  
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  use App::Rakubrew::Build;
  
  sub supports_hooking {
      my $self = shift;
      1;
  }
  
  sub install_note {
      my $text = <<EOT;
  Load $brew_name automatically in `bash` by adding
  
    eval "\$($brew_exec init Bash)"
  
  to ~/.bashrc. This can be easily done using:
  
    echo 'eval "\$($brew_exec init Bash)"' >> ~/.bashrc
  EOT
  
      if ($prefix =~ / /) {
          $text .= <<EOW;
  
  =================================== WARNING ==================================
  
  rakubrews home directory is currently
  
    $prefix
  
  That folder contains spaces. This will break building rakudos as the build
  system currently doesn't work in such a path. You can work around this problem
  by changing that folder to a directory without spaces. Do so by putting
  
    export RAKUBREW_HOME=/some/folder/without/space/rakubrew
  
  in your `~/.bashrc` file *before* the `eval` line.
  EOW
      }
      return $text;
  }
  
  sub get_init_code {
      my $self = shift;
      my $path = $ENV{PATH};
      $path = $self->clean_path($path);
      if (get_brew_mode() eq 'env') {
          my $version = get_global_version();
          if ($version && $version ne 'system' && !is_version_broken($version)) {
              $path = join(':', get_bin_paths($version), $path);
          }
      }
      else { # get_brew_mode() eq 'shim'
          $path = join(':', $shim_dir, $path);
      }
      return <<EOT;
  export PATH="$path"
  $brew_name() {
      command $brew_exec internal_hooked Bash "\$@" &&
      eval "`command $brew_exec internal_shell_hook Bash post_call_eval "\$@"`"
  }
  _${brew_name}_completions() {
      COMPREPLY=(\$(command $brew_exec internal_shell_hook Bash completions \$COMP_CWORD \$COMP_LINE))
      \$(command $brew_exec internal_shell_hook Bash completion_options \$COMP_CWORD \$COMP_LINE)
  }
  complete -F _${brew_name}_completions $brew_name
  EOT
  }
  
  sub post_call_eval {
      my $self = shift;
      $self->print_shellmod_code(@_);
  }
  
  sub get_path_setter_code {
      my $self = shift;
      my $path = shift;
      return "export PATH=\"$path\"";
  }
  
  sub get_shell_setter_code {
      my $self = shift;
      my $version = shift;
      return "export $env_var=\"$version\"";
  }
  
  sub get_shell_unsetter_code {
      my $self = shift;
      return "unset $env_var";
  }
  
  sub completions {
      my $self = shift;
      my $index = shift;
      say join(' ', $self->get_completions($self->strip_executable($index, @_)));
  }
  
  sub completion_options {
      my $self = shift;
      my $index = shift;
      my @words = @_;
  
      if($index == 3 && $words[1] eq 'register') {
          say 'compopt -o nospace';
      }
      else {
          say '';
      }
  }
  
  1;
  
APP_RAKUBREW_SHELL_BASH

$fatpacked{"App/Rakubrew/Shell/Cmd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL_CMD';
  package App::Rakubrew::Shell::Cmd;
  use App::Rakubrew::Shell;
  our @ISA = "App::Rakubrew::Shell";
  use strict;
  use warnings;
  use 5.010;
  
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  use App::Rakubrew::Build;
  use App::Rakubrew::Config;
  
  # https://superuser.com/a/302553
  
  sub supports_hooking {
      my $self = shift;
      1;
  }
  
  sub install_note {
      # The autorun guard to prevent endless loops is based on this StackOverflow
      # answer: https://stackoverflow.com/a/57451662/1975049
  
      my $text = <<EOT;
  To load $brew_name in CMD automatically you have to do two things:
  
  1. Check that you don't already have a CMD autorun script set.
  
      reg query "HKCU\\Software\\Microsoft\\Command Processor" /v AutoRun
  
    If you don't have an autorun script set (the above command returns an error) you can set one using:
  
      reg add "HKCU\\Software\\Microsoft\\Command Processor" /v AutoRun /t REG_EXPAND_SZ /d \\""\%"USERPROFILE"\%\\Documents\\CMD_profile.cmd"\\" /f
  
  2. Add the following code to the end of the autorun script you linked in step 1:
  
      \@echo off
      setlocal EnableDelayedExpansion
      set "cmd=!cmdcmdline!"
      if "!cmd!" == "!cmd:/=!" (
          endlocal
          FOR /f "delims=" \%\%i in ('"$brew_exec" init Cmd') do \@\%\%i
      )
  
    You can easily do that from a CMD prompt using the following command:
  
      (
      echo \@echo off
      echo setlocal EnableDelayedExpansion
      echo set "cmd=!cmdcmdline!"
      echo if "!cmd!" == "!cmd:/=!" ^(
      echo     endlocal
      echo     FOR /f "delims=" \%\%i in ^('"$brew_exec" init Cmd'^) do \@\%\%i
      echo ^)
      ) >> "\%USERPROFILE\%\\Documents\\CMD_profile.cmd"
  
    If you use a different autorun script location, replace the path in the command above.
  
  (Note that the above does *not* enable auto-loading in PowerShell, that needs a
  separate installation procedure. Call `$brew_exec init` in a PowerShell window
  for respective installation instructions.)
  EOT
  
      if ($prefix =~ / /) {
          $text .= <<EOW;
  
  =================================== WARNING ==================================
  
  rakubrews home directory is currently
  
    $prefix
  
  That folder contains spaces. This will break building rakudos as the build
  system currently doesn't work in such a path. You can work around this problem
  by changing that folder to a directory without spaces. Do so by putting
  
    set RAKUBREW_HOME=/some/folder/without/space/rakubrew
  
  in your profile file *before* the other code.
  EOW
      }
      return $text;
  }
  
  sub get_init_code {
      my $self = shift;
      my $path = $ENV{PATH};
      $path = $self->clean_path($path);
      if (get_brew_mode() eq 'env') {
          my $version = get_global_version();
          if ($version && $version ne 'system' && !is_version_broken($version)) {
              $path = join(';', get_bin_paths($version), $path);
          }
      }
      else { # get_brew_mode() eq 'shim'
          $path = join(';', $shim_dir, $path);
      }
  
      # https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/doskey
      # https://devblogs.microsoft.com/oldnewthing/20120731-00/?p=7003
      # The command that post_call_eval() returns is always a single line, so we can get away with having an empty delimiter.
      # The second for is there to not error on empty lines: https://stackoverflow.com/a/31316333
      return <<EOT;
  SET PATH=$path
  doskey rakubrew="$brew_exec" internal_hooked Cmd \$* && FOR /f "delims=" \%i in ('"$brew_exec" internal_shell_hook Cmd post_call_eval \$*') do \@\%i
  EOT
  }
  
  sub post_call_eval {
      my $self = shift;
      $self->print_shellmod_code(@_);
  }
  
  sub get_path_setter_code {
      my $self = shift;
      my $path = shift;
      return "SET PATH=$path";
  }
  
  sub get_shell_setter_code {
      my $self    = shift;
      my $version = shift;
      return "SET $env_var=$version"
  }
  
  sub get_shell_unsetter_code {
      my $self = shift;
      return "UNSET $env_var";
  }
  
  1;
APP_RAKUBREW_SHELL_CMD

$fatpacked{"App/Rakubrew/Shell/Fish.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL_FISH';
  package App::Rakubrew::Shell::Fish;
  use App::Rakubrew::Shell;
  our @ISA = "App::Rakubrew::Shell";
  use strict;
  use warnings;
  use 5.010;
  
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  use App::Rakubrew::Build;
  
  sub supports_hooking {
      my $self = shift;
      1;
  }
  
  sub install_note {
      my $text = <<EOT;
  Load $brew_name automatically by adding
  
    $brew_exec init Fish | source
  
  to ~/.config/fish/config.fish
  This can be easily done using:
  
  echo '$brew_exec init Fish | source' >> ~/.config/fish/config.fish
  EOT
  
      if ($prefix =~ / /) {
          $text .= <<EOW;
  
  =================================== WARNING ==================================
  
  rakubrews home directory is currently
  
    $prefix
  
  That folder contains spaces. This will break building rakudos as the build
  system currently doesn't work in such a path. You can work around this problem
  by changing that folder to a directory without spaces. Do so by putting
  
    set -x RAKUBREW_HOME "/some/folder/without/space/rakubrew"
  
  in your `~/.config/fish/config.fish` file *before* the `source` line.
  EOW
      }
      return $text;
  }
  
  sub get_init_code {
      my $self = shift;
      my $path = $ENV{PATH};
      $path = $self->clean_path($path);
  
      my @path_components = split /:/, $path;
      @path_components = map { "'$_'" } @path_components;
  
      $path =~ s/:/ /g;
      if (get_brew_mode() eq 'env') {
          my $version = get_global_version();
          if ($version && $version ne 'system' && !is_version_broken($version)) {
              unshift @path_components, map({ "'$_'" } get_bin_paths($version));
          }
      }
      else { # get_brew_mode() eq 'shim'
          unshift @path_components, "'$shim_dir'";
      }
  
      $path = join(' ', @path_components);
  
      return <<EOT;
  set -x PATH $path
  
  function $brew_name
      command $brew_exec internal_hooked Fish \$argv
      and eval (command $brew_exec internal_shell_hook Fish post_call_eval \$argv)
  end
  
  function _${brew_name}_is_not_register
      set args (commandline -poc)
      if [ (count \$args) -eq 3 -a \$args[1] = 'register' ]
          return 1
      else
          return 0
      end
  end
  
  complete -c $brew_name -f -n _${brew_name}_is_not_register -a '(command $brew_exec internal_shell_hook Fish completions (commandline -poc) (commandline -ct) | string split " ")'
  EOT
  
  }
  
  sub post_call_eval {
      my $self = shift;
      $self->print_shellmod_code(@_);
  }
  
  sub get_path_setter_code {
      my $self = shift;
      my $path = shift;
      my @path_components = split /:/, $path;
      @path_components = map { "'$_'" } @path_components;
      return "set -gx PATH " . join(' ', @path_components);
  }
  
  sub get_shell_setter_code {
      my $self = shift;
      my $version = shift;
      return "set -gx $env_var $version";
  }
  
  sub get_shell_unsetter_code {
      my $self = shift;
      return "set -ex $env_var";
  }
  
  sub completions {
      my $self = shift;
      say join(" ", $self->get_completions($self->strip_executable($#_, @_)));
  }
  
  1;
  
APP_RAKUBREW_SHELL_FISH

$fatpacked{"App/Rakubrew/Shell/PowerShell.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL_POWERSHELL';
  package App::Rakubrew::Shell::PowerShell;
  use App::Rakubrew::Shell;
  our @ISA = "App::Rakubrew::Shell";
  use strict;
  use warnings;
  use 5.010;
  
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  use App::Rakubrew::Build;
  use App::Rakubrew::Config;
  
  # https://docs.microsoft.com/en-us/powershell/module/microsoft.powershell.core/about/about_scopes?view=powershell-6
  # https://stackoverflow.com/questions/6766722/how-to-modify-parent-scope-variable-using-powershell
  # https://superuser.com/questions/886951/run-powershell-script-when-you-open-powershell
  # https://www.computerperformance.co.uk/powershell/profile-ps1/
  
  =pod
  
  WARNING:
  Setting PATH to a string longer than 2048 chars (4096 on newer systems) can cause the
  PATH to be truncated, your PATH being set to the empty string and only become available
  again upon reboot and in the worst case cause your system to not boot anymore.
  See https://web.archive.org/web/20190519191717/https://software.intel.com/en-us/articles/limitation-to-the-length-of-the-system-path-variable
  
  This problem is smaller for us, because we only modify PATH in the current console, never globally.
  
  =cut
  
  sub supports_hooking {
      my $self = shift;
      1;
  }
  
  sub install_note {
      my $text = <<EOT;
  Load $brew_name automatically in PowerShell by adding
  
    . "$brew_exec" init PowerShell | Out-String | Invoke-Expression
  
  to your PowerShell profile. (Note the "." at the beginning!)
  This can be easily done using:
  
    New-Item -Path (Split-Path \$PROFILE) -ItemType "Directory" -Force
    Add-Content -Force -Path \$PROFILE -Value '. "$brew_exec" init PowerShell | Out-String | Invoke-Expression'
  
  (Note that the above does *not* enable auto-loading in CMD, that needs a
  separate installation procedure. Call `$brew_exec init` in a CMD window for
  respective installation instructions.)
  EOT
  
      if ($prefix =~ / /) {
          $text .= <<EOW;
  
  =================================== WARNING ==================================
  
  rakubrews home directory is currently
  
    $prefix
  
  That folder contains spaces. This will break building rakudos as the build
  system currently doesn't work in such a path. You can work around this problem
  by changing that folder to a directory without spaces. Do so by putting
  
    \$Env:RAKUBREW_HOME = "/some/folder/without/space/rakubrew"
  
  in your profile file *before* the other code.
  EOW
      }
      return $text;
  }
  
  sub get_init_code {
      my $self = shift;
      my $path = $ENV{PATH};
      $path = $self->clean_path($path);
      if (get_brew_mode() eq 'env') {
          my $version = get_global_version();
          if ($version && $version ne 'system' && !is_version_broken($version)) {
              $path = join(';', get_bin_paths($version), $path);
          }
      }
      else { # get_brew_mode() eq 'shim'
          $path = join(';', $shim_dir, $path);
      }
      return <<EOT;
  \$Env:PATH = "$path"
  Function $brew_name {
      # TODO: In PowerShell functions do not have return codes. Thus we can not forward the underlying return code.
      # For now we just throw if the actual rakubrew has a returncode != 0. Maybe come up with a better way?
      . "$brew_exec" internal_hooked PowerShell \$args
      if (\$LASTEXITCODE -ne 0) {
          Throw "Rakubrew failed with exitcode \$LASTEXITCODE"
      }
      \$cmd = . "$brew_exec" internal_shell_hook PowerShell post_call_eval \$args | Out-String
      if (\$cmd) {
          Invoke-Expression -Command \$cmd
      }
  }
  # TODO: \$PSVersionTable.PSVersion is only available from PowerShell 2.0 onward. Either accept that this fails on PS 1 or find a way to guard against that.
  if (\$PSVersionTable.PSVersion.Major -ge 5) {
      Register-ArgumentCompleter -Native -CommandName $brew_name -ScriptBlock {
          param(\$commandName, \$argumentString, \$position)
          \$completions = . "$brew_exec" internal_shell_hook PowerShell completions "\$position" "\$argumentString" | Out-String
          \$completions = \$completions.trim('\n').Split(' ')
          \$completions | ForEach-Object {
              [System.Management.Automation.CompletionResult]::new(\$_, \$_, 'ParameterValue', \$_)
          }
      }
  }
  EOT
  }
  
  sub post_call_eval {
      my $self = shift;
      $self->print_shellmod_code(@_);
  }
  
  sub get_path_setter_code {
      my $self = shift;
      my $path = shift;
      return "\$Env:PATH = \"$path\"";
  }
  
  sub get_shell_setter_code {
      my $self    = shift;
      my $version = shift;
      return "Set-Variable -Name $env_var -Value \"$version\" -Scope Global";
  }
  
  sub get_shell_unsetter_code {
      my $self = shift;
      return "Remove-Variable -Name $env_var -Scope Global";
  }
  
  sub completions {
      my $self = shift;
      my $position = shift;
      my $argumentString = join ' ', @_;
  
      # Check if the cursor is starting a new word (preceding space).
      my $newWord = $position > length($argumentString) ? 1
          : substr($argumentString, $position - 1, $position) eq ' ' ? 1
          : 0;
  
      # Cut off everything after cursor position.
      $argumentString = substr($argumentString, 0, $position);
  
      # Chop off trailing space.
      $argumentString = chop($argumentString) if substr($argumentString, 0, length($argumentString) - 1) eq ' ';
  
      # Remove command name and trailing space from arguments.
      $argumentString =~ s/(^|.*\W)$brew_name(\.bat|\.exe)? ?//;
  
      my @words = split ' ', $argumentString;
      my $index = @words - 1 + ($newWord ? 1 : 0);
  
      my @completions = $self->get_completions($index, @words);
      say join(' ', @completions);
  }
  
  1;
APP_RAKUBREW_SHELL_POWERSHELL

$fatpacked{"App/Rakubrew/Shell/Sh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL_SH';
  package App::Rakubrew::Shell::Sh;
  use App::Rakubrew::Shell;
  our @ISA = "App::Rakubrew::Shell";
  use strict;
  use warnings;
  use 5.010;
  
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  use App::Rakubrew::Build;
  
  sub supports_hooking {
      my $self = shift;
      1;
  }
  
  sub install_note {
      my $text = <<EOT;
  Load $brew_name automatically in POSIX compatible shells (ash, dash, ksh and
  similar) by adding
  
    eval "\$($brew_exec init Sh)"
  
  to ~/.profile.
  This can be easily done using:
  
    echo 'eval "\$($brew_exec init Sh)"' >> ~/.profile
  
  Note that this enables rakubrew *only* in login shells.
  To get rakubrew also working in non-login shells, you need the following:
  
    echo 'export ENV=~/.shrc' >> ~/.profile
    echo 'eval "\$($brew_exec init Sh)"' >> ~/.shrc
  
  Make sure that `ENV` is not already set to point to some other file.
  EOT
  
      if ($prefix =~ / /) {
          $text .= <<EOW;
  
  ================================ WARNING ======================================
  
  rakubrews home directory is currently
  
    $prefix
  
  That folder contains spaces. This will break building rakudos as the build
  system currently doesn't work in such a path. You can work around this problem
  by changing that folder to a directory without spaces. Do so by putting
  
    export RAKUBREW_HOME=/some/folder/without/space/rakubrew
  
  in your `~/.profile` file.
  EOW
      }
      return $text;
  }
  
  sub get_init_code {
      my $self = shift;
      my $path = $ENV{PATH};
      $path = $self->clean_path($path);
      if (get_brew_mode() eq 'env') {
          my $version = get_global_version();
          if ($version && $version ne 'system' && !is_version_broken($version)) {
              $path = join(':', get_bin_paths($version), $path);
          }
      }
      else { # get_brew_mode() eq 'shim'
          $path = join(':', $shim_dir, $path);
      }
  
      return <<EOT;
  export PATH="$path"
  $brew_name() {
      command $brew_exec internal_hooked Sh "\$@" &&
      eval "`command $brew_exec internal_shell_hook Sh post_call_eval "\$@"`"
  }
  EOT
  
  }
  
  sub post_call_eval {
      my $self = shift;
      $self->print_shellmod_code(@_);
  }
  
  sub get_path_setter_code {
      my $self = shift;
      my $path = shift;
      return "export PATH=\"$path\"";
  }
  
  sub get_shell_setter_code {
      my $self = shift;
      my $version = shift;
      return "export $env_var=\"$version\"";
  }
  
  sub get_shell_unsetter_code {
      my $self = shift;
      return "unset $env_var";
  }
  
  1;
  
APP_RAKUBREW_SHELL_SH

$fatpacked{"App/Rakubrew/Shell/Tcsh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL_TCSH';
  package App::Rakubrew::Shell::Tcsh;
  use App::Rakubrew::Shell;
  our @ISA = "App::Rakubrew::Shell";
  use strict;
  use warnings;
  use 5.010;
  
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  use App::Rakubrew::Build;
  
  sub supports_hooking {
      my $self = shift;
      1;
  }
  
  sub install_note {
      my $text = <<EOT;
  Load $brew_name automatically in `tcsh` by adding
  
    eval `$brew_exec init Tcsh`
  
  to ~/.tcshrc.
  This can be easily done using:
  
    echo 'eval `$brew_exec init Tcsh`' >> ~/.tcshrc
  EOT
  
      if ($prefix =~ / /) {
          $text .= <<EOW;
  
  =================================== WARNING ==================================
  
  rakubrews home directory is currently
  
    $prefix
  
  That folder contains spaces. This will break building rakudos as the build
  system currently doesn't work in such a path. You can work around this problem
  by changing that folder to a directory without spaces. Do so by putting
  
    setenv RAKUBREW_HOME /some/folder/without/space/rakubrew
  
  in your `~/.tcshrc` file *before* the `eval` line.
  EOW
      }
      return $text;
  }
  
  sub get_init_code {
      my $self = shift;
      my $path = $ENV{PATH};
      $path = $self->clean_path($path);
      if (get_brew_mode() eq 'env') {
          my $version = get_global_version();
          if ($version && $version ne 'system' && !is_version_broken($version)) {
              $path = join(':', get_bin_paths($version), $path);
          }
      }
      else { # get_brew_mode() eq 'shim'
          $path = join(':', $shim_dir, $path);
      }
      return "setenv PATH \"$path\" && alias $brew_name '$brew_exec internal_hooked Tcsh \\!* && eval \"`$brew_exec internal_shell_hook Tcsh post_call_eval \\!*`\"' && complete $brew_name 'p,*,`$brew_exec internal_shell_hook Tcsh completions \"\$COMMAND_LINE\"`,'";
  }
  
  sub post_call_eval {
      my $self = shift;
      $self->print_shellmod_code(@_);
  }
  
  sub get_path_setter_code {
      my $self = shift;
      my $path = shift;
      return "setenv PATH \"$path\"";
  }
  
  sub get_shell_setter_code {
      my $self = shift;
      my $version = shift;
      return "setenv $env_var \"$version\"";
  }
  
  sub get_shell_unsetter_code {
      my $self = shift;
      return "unsetenv $env_var";
  }
  
  sub completions {
      my $self = shift;
      my $command = shift;
      my @words = split ' ', $command;
      my $index = @words - 1;
      $index++ if $command =~ / $/;
  
      my @completions = $self->get_completions($self->strip_executable($index, @words));
      say join(' ', @completions);
  }
  
  1;
  
APP_RAKUBREW_SHELL_TCSH

$fatpacked{"App/Rakubrew/Shell/Zsh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_SHELL_ZSH';
  package App::Rakubrew::Shell::Zsh;
  use App::Rakubrew::Shell;
  our @ISA = "App::Rakubrew::Shell";
  use strict;
  use warnings;
  use 5.010;
  use File::Spec::Functions qw(catfile);
  
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  use App::Rakubrew::VersionHandling;
  use App::Rakubrew::Build;
  
  sub supports_hooking {
      my $self = shift;
      1;
  }
  
  sub install_note {
      my $rc_file = qw( .zshenv );
      if ( exists $ENV{ZDOTDIR} ) {
          $rc_file = catfile( $ENV{ZDOTDIR}, $rc_file );
      }
  
      my $text = <<EOT;
  Load $brew_name automatically in `zsh` by adding
  
    eval "\$($brew_exec init Zsh)"
  
  to ~/$rc_file.
  This can be easily done using:
  
    echo 'eval "\$($brew_exec init Zsh)"' >> ~/$rc_file
  EOT
  
      if ($prefix =~ / /) {
          $text .= <<EOW;
  
  =================================== WARNING ==================================
  
  rakubrews home directory is currently
  
    $prefix
  
  That folder contains spaces. This will break building rakudos as the build
  system currently doesn't work in such a path. You can work around this problem
  by changing that folder to a directory without spaces. Do so by putting
  
    export RAKUBREW_HOME=/some/folder/without/space/rakubrew
  
  in your `~/$rc_file` file *before* the `eval` line.
  EOW
      }
      return $text;
  }
  
  sub get_init_code {
      my $self = shift;
      my $path = $ENV{PATH};
      $path = $self->clean_path($path);
      if (get_brew_mode() eq 'env') {
          my $version = get_global_version();
          if ($version && $version ne 'system' && !is_version_broken($version)) {
              $path = join(':', get_bin_paths($version), $path);
          }
      }
      else { # get_brew_mode() eq 'shim'
          $path = join(':', $shim_dir, $path);
      }
  
      return <<EOT;
  export PATH="$path"
  $brew_name() {
      command $brew_exec internal_hooked Zsh "\$@" &&
      eval "`command $brew_exec internal_shell_hook Zsh post_call_eval "\$@"`"
  }
  
  compctl -K _${brew_name}_completions -x 'p[2] w[1,register]' -/ -- $brew_name
  
  _${brew_name}_completions() {
      local WORDS POS RESULT
      read -cA WORDS
      read -cn POS
      reply=(\$(command $brew_exec internal_shell_hook Zsh completions \$POS \$WORDS))
  }
  EOT
  
  }
  
  sub post_call_eval {
      my $self = shift;
      $self->print_shellmod_code(@_);
  }
  
  sub get_path_setter_code {
      my $self = shift;
      my $path = shift;
      return "export PATH=\"$path\"";
  }
  
  sub get_shell_setter_code {
      my $self = shift;
      my $version = shift;
      return "export $env_var=\"$version\"";
  }
  
  sub get_shell_unsetter_code {
      my $self = shift;
      return "unset $env_var";
  }
  
  sub completions {
      my $self = shift;
      my $index = shift;
      say join(' ', $self->get_completions($self->strip_executable($index - 1, @_)));
  }
  
  1;
  
APP_RAKUBREW_SHELL_ZSH

$fatpacked{"App/Rakubrew/Tools.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_TOOLS';
  package App::Rakubrew::Tools;
  require Exporter;
  our @ISA = qw( Exporter );
  our @EXPORT = qw(run slurp spurt trim uniq slurp_dir my_fileparse);
  
  use strict;
  use warnings;
  use 5.010;
  use File::Spec::Functions qw(catfile);
  use File::Basename;
  use Carp qw(croak);
  
  sub run {
      system(@_) and croak "Failed running ".$_[0]
  }
  
  sub slurp {
      my $file = shift;
      open(my $fh, '<', $file);
      local $/ = '';
      my $ret = <$fh>;
      close($fh);
      return $ret // '';
  }
  
  sub spurt {
      my ($file, $cont) = @_;
      open(my $fh, '>', $file);
      say $fh $cont;
      close($fh);
  }
  
  sub trim {
      my $text = shift;
      $text =~ s/^\s+|\s+$//g;
      return $text;
  }
  
  sub uniq {
      my %seen;
      return grep { !$seen{$_}++ } @_;
  }
  
  sub slurp_dir {
      my $name = shift;
      opendir(my $dh, $name) or return;
      my @ret;
      while (my $entry = readdir $dh) {
          next if $entry =~ /^\./;
          next if !-f catfile($name, $entry);
          push @ret, $entry;
      }
      closedir $dh;
      return @ret;
  }
  
  sub my_fileparse {
      return fileparse(shift, ('.dll.lib', qr/\.[^.]+/));
  }
  
  1;
  
APP_RAKUBREW_TOOLS

$fatpacked{"App/Rakubrew/Update.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_UPDATE';
  package App::Rakubrew::Update;
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw();
  
  use strict;
  use warnings;
  use 5.010;
  use HTTP::Tinyish;
  use JSON;
  use FindBin qw( $RealBin $RealScript );
  use File::Copy;
  use File::Spec::Functions qw( catfile catdir );
  use Fcntl;
  use if scalar ($^O =~ /win32/i), 'Win32';
  use if scalar ($^O =~ /win32/i), 'Win32::Process';
  use if scalar ($^O =~ /win32/i), 'Win32::ShellQuote';
  
  use App::Rakubrew;
  use App::Rakubrew::Variables;
  use App::Rakubrew::Config;
  use App::Rakubrew::Tools;
  
  my $release_index_url   = 'https://rakubrew.org/releases';
  my $download_url_prefix = 'https://rakubrew.org';
  
  my %dl_urls = (
      fatpack => "$download_url_prefix/perl/rakubrew",
      win     => "$download_url_prefix/win/rakubrew.exe",
      macos   => "$download_url_prefix/macos/rakubrew",
  );
  
  sub update {
      my $quiet = shift;
  
      # For par packaged executables the following returns the path and name of
      # the par packaged file.
      my $current_rakubrew_file = catfile($RealBin, $RealScript);
  
      # check whether this is a CPAN installation. Abort if yes.
      if ($distro_format eq 'cpan') {
          say STDERR 'Rakubrew was installed via CPAN, use your CPAN client to update.';
          exit 1;
      }
  
      my $ht = HTTP::Tinyish->new();
  	my $release_index = _download_release_index($ht);
  
      # check version
      if ($App::Rakubrew::VERSION >= $release_index->{latest}) {
          say 'Rakubrew is up-to-date!';
          exit 0;
      }
  
      # Display changes
      if (!$quiet) {
          say "Changes\n";
          say "=======\n";
          for my $change (@{$release_index->{releases}}) {
              next if $change->{version} <= $App::Rakubrew::VERSION;
              say $change->{version} . ':';
              say "    $_" for split(/^/, $change->{changes});
              say '';
          }
          print 'Shall we do the update? [y|N] ';
          my $reply = <STDIN>;
          chomp $reply;
          exit 0 if $reply ne 'y';
          say '';
      }
  
      mkdir catdir($prefix, 'update') unless (-d catdir($prefix, 'update'));
      my $update_file = catfile($prefix, 'update', $RealScript);
  
      # delete RAKUBREW_HOME/update/rakubrew
      unlink $update_file;
  
      # download latest to RAKUBREW_HOME/update/rakubrew
      my $res = $ht->get($dl_urls{$distro_format});
      unless ($res->{success}) {
          say STDERR "Couldn\'t download update. Error: $res->{status} $res->{reason}";
          exit 1;
      }
      my $fh;
      if (!sysopen($fh, $update_file, O_WRONLY|O_CREAT|O_EXCL, 0777)) {
          say STDERR "Couldn't write update file to $update_file. Aborting update.";
          exit 1;
      }
      binmode $fh;
      print $fh $res->{content};
      close $fh;
  
      if ($^O =~ /win32/i) {
          # Windows has no real exec(). In addition all the standard perl
          # utilities to start processes automatically make the started process
          # inherit all handles of the parent. This has the effect that it's
          # impossible in the child to delete the parents executable file even
          # when the parent has already exited. So we use the lower level
          # Win32::Process::Create with the 4th argument (inheritHandles) set to 0
          # to get rid of the handles preventing the deletion of the parent
          # executable.
  
          say 'You will now see a command prompt, even though the update process is still running.';
          say 'This is caused by a quirk in Windows\' process handling.';
          say 'Just wait a few seconds until an "Update successful!" message shows up';
          my $ProcessObj;
          if (!Win32::Process::Create(
              $ProcessObj,
              $update_file,
              Win32::ShellQuote::quote_native(
                  $update_file,
                  'internal_update',
                  $App::Rakubrew::VERSION,
                  $current_rakubrew_file),
              0,
              Win32::Process::NORMAL_PRIORITY_CLASS(),
              "."
          )) {
              say STDERR 'Failed to call the downloaded rakubrew executable! Aborting update.';
              exit 1;
          };
          exit 0;
      }
      else {
          { exec($update_file, 'internal_update', $App::Rakubrew::VERSION, $current_rakubrew_file) };
          say STDERR 'Failed to call the downloaded rakubrew executable! Aborting update.';
          exit 1;
      }
  }
  
  sub internal_update {
      my ($old_version, $old_rakubrew_file) = @_;
  
      my $current_script = catfile($RealBin, $RealScript);
      my $update_file = catfile($prefix, 'update', $RealScript);
      if ($update_file ne $current_script) {
          say STDERR "'internal_update' was called on a rakubrew ($current_script) that's not $update_file. That's probably wrong and dangerous. Aborting update.";
          exit 1;
      }
  
      # custom update procedures
      if ($old_version < 29) {
          # Change Github URLs to use the https instead of the git protocol.
          my @repos;
  
          for my $dir ($git_reference, $versions_dir) {
              opendir(my $dh, $dir);
              push @repos, map({ catdir($dir, $_) } grep({ /^[^.]/ } readdir($dh)));
              closedir($dh);
          }
          push @repos, $zef_dir;
  
          for my $repo (@repos) {
              $repo = catdir($repo, '.git') if -d catdir($repo, '.git');
              my $config_file = catfile($repo, 'config');
              if (-f $config_file) {
                  print "Updating Github repository URLs in $config_file...";
                  my $content = slurp($config_file);
                  my $replaced = ($content =~ s|^(\s* url \s* = \s*) git (://github\.com/)|$1https$2|gmx);
                  if ($replaced) {
                      spurt($config_file, $content);
                      say "done";
                  }
                  else {
                      say "nothing to be done";
                  }
              }
          }
      }
      #if ($old_version < 2) {
      #    Do update stuff for version 2.
      #}
  
      # copy RAKUBREW_HOME/update/rakubrew to 'path/to/rakubrew'
      unlink $old_rakubrew_file or die "Failed to unlink old file: $old_rakubrew_file. Error: $!";
      my $fh;
      if (!sysopen($fh, $old_rakubrew_file, O_WRONLY|O_CREAT|O_EXCL, 0777)) {
          say STDERR "Couldn't copy update file to $old_rakubrew_file. Rakubrew is broken now. Try manually copying '$update_file' to '$old_rakubrew_file' to get it fixed again.";
          exit 1;
      }
      binmode $fh;
      if (!copy($update_file, $fh)) {
          close $fh;
          unlink $old_rakubrew_file;
          say STDERR "Couldn't copy update file to $old_rakubrew_file. Rakubrew is broken now. Try manually copying '$update_file' to '$old_rakubrew_file' to get it fixed again.";
          exit 1;
      }
      close $fh;
      unlink $update_file;
  
      say 'Update successful!';
  }
  
  sub _download_release_index {
      my $ht = shift;
      my $res = $ht->get($release_index_url);
      unless ($res->{success}) {
          say STDERR "Couldn\'t fetch release index at $release_index_url. Error: $res->{status} $res->{reason}";
  ;
          exit 1;
      }
      return decode_json($res->{content});
  }
  
APP_RAKUBREW_UPDATE

$fatpacked{"App/Rakubrew/Variables.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_VARIABLES';
  package App::Rakubrew::Variables;
  require Exporter;
  our @ISA = qw( Exporter );
  our @EXPORT = qw( $brew_name $brew_exec $env_var $local_filename $prefix $versions_dir $shim_dir $zef_dir $git_reference $GIT $GIT_PROTO $PERL5 %git_repos %impls );
  
  use strict;
  use warnings;
  use 5.010;
  
  use FindBin qw($RealBin);
  use File::Spec::Functions qw(catfile catdir updir);
  use Cwd qw(abs_path);
  use File::HomeDir;
  use App::Rakubrew::Config;
  
  our $brew_name = 'rakubrew';
  our $brew_exec = catfile($RealBin, $brew_name);
  if ($^O =~ /win32/i ) {
      $brew_exec .= $distro_format eq 'cpan' ? '.bat' : '.exe';
  }
  our $home_env_var = 'RAKUBREW_HOME';
  our $env_var = 'RAKUBREW_VERSION';
  our $local_filename = '.raku-version';
  
  our $prefix = $ENV{$home_env_var}
      // ($^O =~ /win32/i ? 'C:\rakubrew'
      : catdir(File::HomeDir->my_home, '.rakubrew'));
  $prefix = abs_path($prefix) if (-d $prefix);
  
  our $versions_dir = catdir($prefix, 'versions');
  our $shim_dir = catdir($prefix, 'shims');
  our $git_reference = catdir($prefix, 'git_reference');
  our $zef_dir = catdir($prefix, 'repos', 'zef');
  
  our $GIT       = $ENV{GIT_BINARY} // 'git';
  our $GIT_PROTO = $ENV{GIT_PROTOCOL} // 'https';
  our $PERL5     = $^X;
  
  sub get_git_url {
      my ($protocol, $host, $user, $project) = @_;
      if ($protocol eq "ssh") {
          return "git\@${host}:${user}/${project}.git";
      } else {
          return "${protocol}://${host}/${user}/${project}.git";
      }
  }
  
  our %git_repos = (
      rakudo => get_git_url($GIT_PROTO, 'github.com', 'rakudo', 'rakudo'),
      MoarVM => get_git_url($GIT_PROTO, 'github.com', 'MoarVM', 'MoarVM'),
      nqp    => get_git_url($GIT_PROTO, 'github.com', 'perl6',  'nqp'),
      zef    => get_git_url($GIT_PROTO, 'github.com', 'ugexe',  'zef'),
  );
  
  our %impls = (
      jvm => {
          name      => "jvm",
          weight    => 20,
          configure => "$PERL5 Configure.pl --backends=jvm --gen-nqp --make-install",
          need_repo => ['rakudo', 'nqp'],
      },
      moar => {
          name      => "moar",
          weight    => 30,
          configure => "$PERL5 Configure.pl --backends=moar --gen-moar --make-install",
          need_repo => ['rakudo', 'nqp', 'MoarVM'],
      },
      'moar-blead' => {
          name      => "moar-blead",
          weight    => 35,
          configure => "$PERL5 Configure.pl --backends=moar --gen-moar=master --gen-nqp=main --make-install",
          need_repo => ['rakudo', 'nqp', 'MoarVM'],
      },
  );
  
  sub available_backends {
      map {$_->{name}} sort {$a->{weight} <=> $b->{weight}} values %impls;
  }
  
  
  1;
  
APP_RAKUBREW_VARIABLES

$fatpacked{"App/Rakubrew/VersionHandling.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RAKUBREW_VERSIONHANDLING';
  package App::Rakubrew::VersionHandling;
  require Exporter;
  our @ISA = qw( Exporter );
  our @EXPORT = qw(
      get_versions
      get_version
      version_exists
      verify_version
      is_version_broken is_version_path_broken
      is_registered_version
      get_version_path clean_version_path
      get_shell_version
      get_local_version set_local_version
      get_global_version set_global_version
      set_brew_mode get_brew_mode get_brew_mode_shell validate_brew_mode
      get_raku
      which whence
      get_bin_paths
      rehash
  );
  
  use strict;
  use warnings;
  use 5.010;
  use File::Spec::Functions qw(catfile catdir splitdir splitpath catpath canonpath);
  use Cwd qw(realpath);
  use File::Which qw();
  use Try::Tiny;
  use App::Rakubrew::Variables;
  use App::Rakubrew::Tools;
  
  sub get_versions {
      opendir(my $dh, $versions_dir);
      my @versions = (
          'system',
          sort({ $a cmp $b }
              grep({ /^[^.]/ } readdir($dh)))
      );
      closedir($dh);
      return @versions;
  }
  
  sub get_shell_version {
      # Check for shell version by looking for $RAKU_VERSION or $PL6ENV_VERSION the environment.
      if (defined $ENV{$env_var} || defined $ENV{PL6ENV_VERSION}) {
          my $version = $ENV{$env_var} // $ENV{PL6ENV_VERSION};
          if (version_exists($version)) {
              return $version;
          }
          else {
              say STDERR "Version '$version' is set via the RAKU_VERSION environment variable.";
              say STDERR "This version is not installed. Ignoring.";
              say STDERR '';
              return undef;
          }
      }
      else {
          return undef;
      }
  }
  
  sub get_local_version {
      my ($vol, $path, undef) = splitpath(realpath(), 1);
      my @fragments = splitdir($path);
      while (@fragments) {
          for ($local_filename, '.perl6-version') {
              my $filepath = catpath($vol, catdir(@fragments), $_);
              if (-f $filepath) {
                  my $version = trim(slurp($filepath));
                  if(version_exists($version)) {
                      return $version;
                  }
                  else {
                      say STDERR "Version '$version' is given in the";
                      say STDERR "$filepath";
                      say STDERR "file. This version is not installed. Ignoring.";
                      say STDERR '';
                  }
              }
          }
          pop @fragments;
      }
      return undef;
  }
  
  sub is_version_broken {
      my $version = shift;
      return 0 if $version eq 'system';
      my $path = get_version_path($version, 1);
      return 1 if !$path;
      return 0 if !is_version_path_broken($path);
      return 1;
  }
  
  sub is_version_path_broken {
      my $path = shift;
      $path = clean_version_path($path);
      return 1 if !$path;
      for my $exec ('raku', 'raku.bat', 'raku.exe', 'perl6', 'perl6.bat', 'perl6.exe', 'rakudo', 'rakudo.bat', 'rakudo.exe') {
          if (-f catfile($path, 'bin', $exec)) {
              return 0;
          }
      }
      return 1;
  }
  
  sub verify_version {
      my $version = shift;
  
      if (! version_exists($version) ) {
          say STDERR "$brew_name: version '$version' is not installed.";
          exit 1;
      }
  
      if ( is_version_broken($version) ) {
          say STDERR "Version $version is broken. Refusing to switch to it.";
          exit 1;
      }
  }
  
  sub set_local_version {
      my $version = shift;
      if ($version) {
          verify_version($version);
          spurt($local_filename, $version);
      }
      else {
          unlink $local_filename;
          unlink '.perl6-version';
      }
  }
  
  sub get_global_version {
      if (!-e catfile($prefix, 'CURRENT')) {
          set_global_version('system', 1);
      }
      my $cur = slurp(catfile($prefix, 'CURRENT'));
      chomp $cur;
      return $cur;
  }
  
  sub set_global_version {
      my $version = shift;
      my $silent = shift;
      verify_version($version);
      say "Switching to $version" unless $silent;
      spurt(catfile($prefix, 'CURRENT'), $version);
  }
  
  sub get_version {
      my $ignore = shift // '';
      my $version = $ignore eq 'shell' ? undef : get_shell_version();
      return $version if defined $version;
      
      if (get_brew_mode() eq 'shim') {
          # Local version is only supported in shim mode.
          # Check for local version by looking for a `.raku-version` file in the current and parent folders.
          $version = $ignore eq 'local' ? undef : get_local_version();
          return $version if defined $version;
      }
  
      # Check for global version by looking at `$prefix/CURRENT` (`$prefix/version`)
      return get_global_version();
  }
  
  sub set_brew_mode {
      my $mode = shift;
      if ($mode eq 'env') {
          spurt(catfile($prefix, 'MODE'), 'env');
      }
      elsif ($mode eq 'shim') {
          spurt(catfile($prefix, 'MODE'), 'shim');
          rehash();
      }
      else {
          say STDERR "Mode must either be 'env' or 'shim'";
      }
  }
  
  sub get_brew_mode {
      my $silent = shift;
      if (!-e catfile($prefix, 'MODE')) {
          spurt(catfile($prefix, 'MODE'), 'env');
      }
  
      my $mode = trim(slurp(catfile($prefix, 'MODE')));
  
      if ($mode ne 'env' && $mode ne 'shim') {
          say STDERR 'Invalid mode found: ' . $mode unless $silent;
          say STDERR 'Resetting to env-mode'        unless $silent;
          set_brew_mode('env');
          $mode = 'env';
      }
  
      return $mode;
  }
  
  sub validate_brew_mode {
      if (get_brew_mode() eq 'env') {
          say STDERR "This command is not available in 'env' mode. Switch to to 'shim' mode using '$brew_name mode shim'";
          exit 1;
      }
  }
  
  sub version_exists {
      my $version = shift;
      return undef if !defined $version;
      my %versionsMap = map { $_ => 1 } get_versions();
      return exists($versionsMap{$version});
  }
  
  sub is_registered_version {
      my $version = shift;
      my $version_file = catdir($versions_dir, $version);
      if (-f $version_file) {
          return 1;
      }
      else {
          return 0;
      }
  }
  
  sub clean_version_path {
      my $path = shift;
  
      my @cands = (catdir($path, 'install'), $path);
      for my $cand (@cands) {
          return $cand if -d catdir($cand, 'bin')
      }
      return undef;
  }
  
  sub get_version_path {
      my $version = shift;
      my $no_error = shift || 0;
      my $version_path = catdir($versions_dir, $version);
      $version_path = trim(slurp($version_path)) if -f $version_path;
  
      $version_path = clean_version_path($version_path);
      return $version_path if $version_path || $no_error;
      die "Installation is broken: $version";
  }
  
  sub get_raku {
      my $version = shift;
  
      return _which('raku', $version) // which('perl6', $version);
  }
  
  sub match_version {
      my $impl = shift // 'moar';
      my $ver = shift if @_ && $_[0] !~ /^--/;
      my @args = @_;
  
      if (!defined $ver) {
          my $version_regex = '^\d\d\d\d\.\d\d(?:\.\d+)?$';
          my $combined_regex = '('
              . join('|', App::Rakubrew::Variables::available_backends())
              . ')-(.+)';
          if ($impl eq 'moar-blead') {
              $ver = 'main';
          }
          elsif ($impl =~ /$combined_regex/) {
              $impl = $1;
              $ver = $2;
          }
          elsif ($impl =~ /$version_regex/) {
              $ver = $impl;
              $impl = 'moar';
          }
          else {
              $ver = '';
          }
      }
  
      return ($impl, $ver, @args);
  }
  
  sub which {
      my $prog = shift;
      my $version = shift;
  
      my $target = _which($prog, $version);
  
      if (!$target) {
          say STDERR "$brew_name: $prog: command not found";
          if(whence($prog)) {
              say STDERR <<EOT;
  
  The '$prog' command exists in these Raku versions:
  EOT
              map {say STDERR $_} whence($prog);
          }
          exit 1;
      }
  
      return $target;
  }
  
  sub _which {
      my $prog = shift;
      my $version = shift;
  
      my $target; {
          if ($version eq 'system') {
              my @targets = File::Which::which($prog);
              @targets = map({
                  $_ =~ s|\\|/|g;
                  $_ = canonpath($_);
              } @targets);
  
              my $normalized_shim_dir = $shim_dir;
              $normalized_shim_dir =~ s|\\|/|g;
              $normalized_shim_dir = canonpath($normalized_shim_dir);
  
              @targets = grep({
                  my ($volume,$directories,$file) = splitpath( $_ );
                  my $target_dir = catpath($volume, $directories);
                  $target_dir = canonpath($target_dir);
                  $target_dir ne $normalized_shim_dir;
              } @targets);
  
              $target = $targets[0] if @targets;
          }
          elsif ($^O =~ /win32/i && (my_fileparse($prog))[2] eq '') {
              # If we are on Windows and didn't get a full executable name
              # i.e. the suffix is missing.
              # In this case we look for files with a basename matching
              # the given name and select the best candidate via a preference
              # table.
  
              sub check_prog_name_match {
                  my ($prog, $filename) = @_;
                  my ($basename, undef, undef) = my_fileparse($filename);
                  return $prog =~ /^\Q$basename\E\z/i;
              }
  
              my @results = ();
              my @dirs = get_bin_paths($version);
              for my $dir (@dirs) {
                  my @files = slurp_dir($dir);
                  for my $file (@files) {
                      if(check_prog_name_match($prog, $file)) {
                          push @results, catfile($dir, $file);
                      }
                  }
              }
              @results = sort {
                  # .exe > .bat > .raku > .p6 > .pl6 > .pl > nothing > rest
                  my (undef, undef, $suffix_a) = my_fileparse($a);
                  my (undef, undef, $suffix_b) = my_fileparse($b);
                  return -1        if $suffix_a eq '.exe'  && $suffix_b ne '.exe';
                  return  1        if $suffix_a ne '.exe'  && $suffix_b eq '.exe';
                  return $a cmp $b if $suffix_a eq '.exe'  && $suffix_b eq '.exe';
                  return -1        if $suffix_a eq '.bat'  && $suffix_b ne '.bat';
                  return  1        if $suffix_a ne '.bat'  && $suffix_b eq '.bat';
                  return $a cmp $b if $suffix_a eq '.bat'  && $suffix_b eq '.bat';
                  return -1        if $suffix_a eq '.raku' && $suffix_b ne '.raku';
                  return  1        if $suffix_a ne '.raku' && $suffix_b eq '.raku';
                  return $a cmp $b if $suffix_a eq '.raku' && $suffix_b eq '.raku';
                  return -1        if $suffix_a eq '.p6'   && $suffix_b ne '.p6';
                  return  1        if $suffix_a ne '.p6'   && $suffix_b eq '.p6';
                  return $a cmp $b if $suffix_a eq '.p6'   && $suffix_b eq '.p6';
                  return -1        if $suffix_a eq '.pl6'  && $suffix_b ne '.pl6';
                  return  1        if $suffix_a ne '.pl6'  && $suffix_b eq '.pl6';
                  return $a cmp $b if $suffix_a eq '.pl6'  && $suffix_b eq '.pl6';
                  return -1        if $suffix_a eq '.pl'   && $suffix_b ne '.pl';
                  return  1        if $suffix_a ne '.pl'   && $suffix_b eq '.pl';
                  return $a cmp $b if $suffix_a eq '.pl'   && $suffix_b eq '.pl';
                  return -1        if $suffix_a eq ''      && $suffix_b ne '';
                  return  1        if $suffix_a ne ''      && $suffix_b eq '';
                  return $a cmp $b if $suffix_a eq ''      && $suffix_b eq '';
                  return $a cmp $b;
              } @results;
              $target = $results[0];
          }
          else {
              my @paths = get_bin_paths($version, $prog);
              for my $path (@paths) {
                  if (-e $path) {
                      $target = $path;
                      last;
                  }
              }
          }
      }
  
      return $target;
  }
  
  sub whence {
      my $prog = shift;
      my $pathmode = shift // 0;
  
      my @matches = ();
      for my $version (get_versions()) {
          next if $version eq 'system';
          next if is_version_broken($version);
          for my $path (get_bin_paths($version, $prog)) {
              if (-f $path) {
                  if ($pathmode) {
                      push @matches, $path;
                  }
                  else {
                      push @matches, $version;
                  }
                  last;
              }
          }
      }
      return @matches;
  }
  
  sub get_bin_paths {
      my $version = shift;
      my $program = scalar(shift) || undef;
      my $no_error = shift || undef;
      my $version_path = get_version_path($version, 1);
      return () if $no_error && !$version_path;
  
      return (
          catfile($version_path, 'bin', $program // ()),
          catfile($version_path, 'share', 'perl6', 'site', 'bin', $program // ()),
      );
  }
  
  sub rehash {
      return if get_brew_mode() ne 'shim';
  
      my @paths = ();
      for my $version (get_versions()) {
          next if $version eq 'system';
          next if is_version_broken($version);
          push @paths, get_bin_paths($version);
      }
  
      say "Updating shims";
  
      { # Remove the existing shims.
          opendir(my $dh, $shim_dir);
          while (my $entry = readdir $dh) {
              next if $entry =~ /^\./;
              unlink catfile($shim_dir, $entry);
          }
          closedir $dh;
      }
  
      my @bins = map { slurp_dir($_) } @paths;
  
      if ($^O =~ /win32/i) {
          # This wrapper is needed because:
          # - We want rakubrew to work even when the .pl ending is not associated with the perl program and we do not want to put `perl` before every call to a shim.
          # - exec() in perl on Windows behaves differently from running the target program directly (output ends up on the console differently).
          # It retrieves the target executable (only consuming STDOUT of rakubrew) and calls it with the given arguments. STDERR still ends up on the console. The return value is checked and if an error occurs that error values is returned.
          # `IF ERRORLEVEL 1` is true for all exit codes >= 1.
          # See https://stackoverflow.com/a/8254331 for an explanation of the `SETLOCAL` / `ENDLOCAL` mechanics.
          @bins = map { my ($basename, undef, undef) = my_fileparse($_); $basename } @bins;
          @bins = uniq(@bins);
          for (@bins) {
              spurt(catfile($shim_dir, $_.'.bat'), <<EOT);
  \@ECHO OFF
  SETLOCAL
  SET brew_cmd="$brew_exec" internal_win_run \%~n0
  FOR /F "delims=" \%\%i IN ('\%brew_cmd\%') DO SET command=\%\%i
  IF ERRORLEVEL 1 EXIT /B \%errorlevel\%
  ENDLOCAL & "\%command\%" \%*
  EOT
          }
      }
      else {
          for (@bins) {
              symlink $0, catfile($shim_dir, $_);
          }
      }
  }
APP_RAKUBREW_VERSIONHANDLING

$fatpacked{"CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta;
  our $VERSION = '2.120351'; # 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.4400 ();
  
  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
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta - the distribution metadata for a CPAN dist
  
  =head1 VERSION
  
  version 2.120351
  
  =head1 SYNOPSIS
  
    my $meta = CPAN::Meta->load_file('META.json');
  
    printf "testing requirements for %s version %s\n",
      $meta->name,
      $meta->version;
  
    my $prereqs = $meta->requirements_for('configure');
  
    for my $module ($prereqs->required_modules) {
      my $version = get_local_version($module);
  
      die "missing required module $module" unless defined $version;
      die "version for $module not in range"
        unless $prereqs->accepts_module($module, $version);
    }
  
  =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
  
  =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 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
  
  
  __END__
  
  
CPAN_META

$fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Converter;
  our $VERSION = '2.120351'; # VERSION
  
  
  use CPAN::Meta::Validator;
  BEGIN { eval "use version ()" || eval "use ExtUtils::MakeMaker::version ()" }
  use Parse::CPAN::Meta 1.4400 ();
  
  # Perl 5.10.0 didn't have "is_qv" in version.pm
  *_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} };
  
  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 _change_meta_spec {
    my ($element, undef, undef, $version) = @_;
    $element->{version} = $version;
    $element->{url} = $known_specs{$version};
    return $element;
  }
  
  my @valid_licenses_1 = (
    'perl',
    'gpl',
    'apache',
    'artistic',
    'artistic_2',
    'lgpl',
    'bsd',
    'gpl',
    'mit',
    'mozilla',
    'open_source',
    'unrestricted',
    'restrictive',
    'unknown',
  );
  
  my %license_map_1 = (
    ( map { $_ => $_ } @valid_licenses_1 ),
    artistic2 => 'artistic_2',
  );
  
  sub _license_1 {
    my ($element) = @_;
    return 'unknown' unless defined $element;
    if ( $license_map_1{lc $element} ) {
      return $license_map_1{lc $element};
    }
    return 'unknown';
  }
  
  my @valid_licenses_2 = qw(
    agpl_3
    apache_1_1
    apache_2_0
    artistic_1
    artistic_2
    bsd
    freebsd
    gfdl_1_2
    gfdl_1_3
    gpl_1
    gpl_2
    gpl_3
    lgpl_2_1
    lgpl_3_0
    mit
    mozilla_1_0
    mozilla_1_1
    openssl
    perl_5
    qpl_1_0
    ssleay
    sun
    zlib
    open_source
    restricted
    unrestricted
    unknown
  );
  
  # The "old" values were defined by Module::Build, and were often vague.  I have
  # made the decisions below based on reading Module::Build::API and how clearly
  # it specifies the version of the license.
  my %license_map_2 = (
    (map { $_ => $_ } @valid_licenses_2),
    apache      => 'apache_2_0',  # clearly stated as 2.0
    artistic    => 'artistic_1',  # clearly stated as 1
    artistic2   => 'artistic_2',  # clearly stated as 2
    gpl         => 'open_source', # we don't know which GPL; punt
    lgpl        => 'open_source', # we don't know which LGPL; punt
    mozilla     => 'open_source', # we don't know which MPL; punt
    perl        => 'perl_5',      # clearly Perl 5
    restrictive => 'restricted',
  );
  
  sub _license_2 {
    my ($element) = @_;
    return [ 'unknown' ] unless defined $element;
    $element = [ $element ] unless ref $element eq 'ARRAY';
    my @new_list;
    for my $lic ( @$element ) {
      next unless defined $lic;
      if ( my $new = $license_map_2{lc $lic} ) {
        push @new_list, $new;
      }
    }
    return @new_list ? \@new_list : [ 'unknown' ];
  }
  
  my %license_downgrade_map = qw(
    agpl_3            open_source
    apache_1_1        apache
    apache_2_0        apache
    artistic_1        artistic
    artistic_2        artistic_2
    bsd               bsd
    freebsd           open_source
    gfdl_1_2          open_source
    gfdl_1_3          open_source
    gpl_1             gpl
    gpl_2             gpl
    gpl_3             gpl
    lgpl_2_1          lgpl
    lgpl_3_0          lgpl
    mit               mit
    mozilla_1_0       mozilla
    mozilla_1_1       mozilla
    openssl           open_source
    perl_5            perl
    qpl_1_0           open_source
    ssleay            open_source
    sun               open_source
    zlib              open_source
    open_source       open_source
    restricted        restrictive
    unrestricted      unrestricted
    unknown           unknown
  );
  
  sub _downgrade_license {
    my ($element) = @_;
    if ( ! defined $element ) {
      return "unknown";
    }
    elsif( ref $element eq 'ARRAY' ) {
      if ( @$element == 1 ) {
        return $license_downgrade_map{$element->[0]} || "unknown";
      }
    }
    elsif ( ! ref $element ) {
      return $license_downgrade_map{$element} || "unknown";
    }
    return "unknown";
  }
  
  my $no_index_spec_1_2 = {
    'file' => \&_listify,
    'dir' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_1_3 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_2 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _no_index_1_2 {
    my (undef, undef, $meta) = @_;
    my $no_index = $meta->{no_index} || $meta->{private};
    return unless $no_index;
  
    # cleanup wrong format
    if ( ! ref $no_index ) {
      my $item = $no_index;
      $no_index = { dir => [ $item ], file => [ $item ] };
    }
    elsif ( ref $no_index eq 'ARRAY' ) {
      my $list = $no_index;
      $no_index = { dir => [ @$list ], file => [ @$list ] };
    }
  
    # common mistake: files -> file
    if ( exists $no_index->{files} ) {
      $no_index->{file} = delete $no_index->{file};
    }
    # common mistake: modules -> module
    if ( exists $no_index->{modules} ) {
      $no_index->{module} = delete $no_index->{module};
    }
    return _convert($no_index, $no_index_spec_1_2);
  }
  
  sub _no_index_directory {
    my ($element, $key, $meta, $version) = @_;
    return unless $element;
  
    # cleanup wrong format
    if ( ! ref $element ) {
      my $item = $element;
      $element = { directory => [ $item ], file => [ $item ] };
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $list = $element;
      $element = { directory => [ @$list ], file => [ @$list ] };
    }
  
    if ( exists $element->{dir} ) {
      $element->{directory} = delete $element->{dir};
    }
    # common mistake: files -> file
    if ( exists $element->{files} ) {
      $element->{file} = delete $element->{file};
    }
    # common mistake: modules -> module
    if ( exists $element->{modules} ) {
      $element->{module} = delete $element->{module};
    }
    my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3;
    return _convert($element, $spec);
  }
  
  sub _is_module_name {
    my $mod = shift;
    return unless defined $mod && length $mod;
    return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$};
  }
  
  sub _clean_version {
    my ($element, $key, $meta, $to_version) = @_;
    return 0 if ! defined $element;
  
    $element =~ s{^\s*}{};
    $element =~ s{\s*$}{};
    $element =~ s{^\.}{0.};
  
    return 0 if ! length $element;
    return 0 if ( $element eq 'undef' || $element eq '<undef>' );
  
    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 _is_qv($v) ? $v->normal : $element;
    }
    else {
      return 0;
    }
  }
  
  sub _version_map {
    my ($element) = @_;
    return unless defined $element;
    if ( ref $element eq 'HASH' ) {
      my $new_map = {};
      for my $k ( keys %$element ) {
        next unless _is_module_name($k);
        my $value = $element->{$k};
        if ( ! ( defined $value && length $value ) ) {
          $new_map->{$k} = 0;
        }
        elsif ( $value eq 'undef' || $value eq '<undef>' ) {
          $new_map->{$k} = 0;
        }
        elsif ( _is_module_name( $value ) ) { # some weird, old META have this
          $new_map->{$k} = 0;
          $new_map->{$value} = 0;
        }
        else {
          $new_map->{$k} = _clean_version($value);
        }
      }
      return $new_map;
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $hashref = { map { $_ => 0 } @$element };
      return _version_map($hashref); # cleanup any weird stuff
    }
    elsif ( ref $element eq '' && length $element ) {
      return { $element => 0 }
    }
    return;
  }
  
  sub _prereqs_from_1 {
    my (undef, undef, $meta) = @_;
    my $prereqs = {};
    for my $phase ( qw/build configure/ ) {
      my $key = "${phase}_requires";
      $prereqs->{$phase}{requires} = _version_map($meta->{$key})
        if $meta->{$key};
    }
    for my $rel ( qw/requires recommends conflicts/ ) {
      $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
        if $meta->{$rel};
    }
    return $prereqs;
  }
  
  my $prereqs_spec = {
    configure => \&_prereqs_rel,
    build     => \&_prereqs_rel,
    test      => \&_prereqs_rel,
    runtime   => \&_prereqs_rel,
    develop   => \&_prereqs_rel,
    ':custom'  => \&_prefix_custom,
  };
  
  my $relation_spec = {
    requires   => \&_version_map,
    recommends => \&_version_map,
    suggests   => \&_version_map,
    conflicts  => \&_version_map,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _cleanup_prereqs {
    my ($prereqs, $key, $meta, $to_version) = @_;
    return unless $prereqs && ref $prereqs eq 'HASH';
    return _convert( $prereqs, $prereqs_spec, $to_version );
  }
  
  sub _prereqs_rel {
    my ($relation, $key, $meta, $to_version) = @_;
    return unless $relation && ref $relation eq 'HASH';
    return _convert( $relation, $relation_spec, $to_version );
  }
  
  
  BEGIN {
    my @old_prereqs = qw(
      requires
      configure_requires
      recommends
      conflicts
    );
  
    for ( @old_prereqs ) {
      my $sub = "_get_$_";
      my ($phase,$type) = split qr/_/, $_;
      if ( ! defined $type ) {
        $type = $phase;
        $phase = 'runtime';
      }
      no strict 'refs';
      *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
    }
  }
  
  sub _get_build_requires {
    my ($data, $key, $meta) = @_;
  
    my $test_h  = _extract_prereqs($_[2]->{prereqs}, qw(test  requires)) || {};
    my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
  
    require CPAN::Meta::Requirements;
    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 $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'  => \&_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 => \&_clean_version,
  };
  
  my $provides_spec_2 = {
    file => \&_keep,
    version => \&_clean_version,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _provides {
    my ($element, $key, $meta, $to_version) = @_;
    return unless defined $element && ref $element eq 'HASH';
    my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
    my $new_data = {};
    for my $k ( keys %$element ) {
      $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
    }
    return $new_data;
  }
  
  sub _convert {
    my ($data, $spec, $to_version) = @_;
  
    my $new_data = {};
    for my $key ( keys %$spec ) {
      next if $key eq ':custom' || $key eq ':drop';
      next unless my $fcn = $spec->{$key};
      die "spec for '$key' is not a coderef"
        unless ref $fcn && ref $fcn eq 'CODE';
      my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
      $new_data->{$key} = $new_value if defined $new_value;
    }
  
    my $drop_list   = $spec->{':drop'};
    my $customizer  = $spec->{':custom'} || \&_keep;
  
    for my $key ( keys %$data ) {
      next if $drop_list && grep { $key eq $_ } @$drop_list;
      next if exists $spec->{$key}; # we handled it
      $new_data->{ $customizer->($key) } = $data->{$key};
    }
  
    return $new_data;
  }
  
  #--------------------------------------------------------------------------#
  # define converters for each conversion
  #--------------------------------------------------------------------------#
  
  # each converts from prior version
  # special ":custom" field is used for keys not recognized in spec
  my %up_convert = (
    '2-from-1.4' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_2,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'dynamic_config'      => \&_keep_or_one,
      # ADDED MANDATORY
      'release_status'      => \&_release_status_from_version,
      # PRIOR OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_upgrade_optional_features,
      'provides'            => \&_provides,
      'resources'           => \&_upgrade_resources_2,
      # ADDED OPTIONAL
      'description'         => \&_keep,
      'prereqs'             => \&_prereqs_from_1,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
          build_requires
          configure_requires
          conflicts
          distribution_type
          license_url
          private
          recommends
          requires
      ) ],
  
      # other random keys need x_ prefixing
      ':custom'              => \&_prefix_custom,
    },
    '1.4-from-1.3' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_1_4,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_4,
      # ADDED OPTIONAL
      'configure_requires'  => \&_keep,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.3-from-1.2' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.2-from-1.1' => {
      # PRIOR MANDATORY
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'license'             => \&_license_1,
      'name'                => \&_keep,
      'generated_by'        => \&_generated_by,
      # ADDED MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'resources'           => \&_resources_1_2,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.1-from-1.0' => {
      # CHANGED TO MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'license_url'         => \&_url_or_drop,
      'private'             => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
  );
  
  my %down_convert = (
    '1.4-from-2' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_downgrade_license,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_get_build_requires,
      'configure_requires'  => \&_get_configure_requires,
      'conflicts'           => \&_get_conflicts,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_downgrade_optional_features,
      'provides'            => \&_provides,
      'recommends'          => \&_get_recommends,
      'requires'            => \&_get_requires,
      'resources'           => \&_downgrade_resources,
  
      # drop these unsupported fields (after conversion)
      ':drop' => [ qw(
        description
        prereqs
        release_status
      )],
  
      # custom keys will be left unchanged
      ':custom'              => \&_keep
    },
    '1.3-from-1.4' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # drop these unsupported fields, but only after we convert
      ':drop' => [ qw(
        configure_requires
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.2-from-1.3' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.1-from-1.2' => {
      # MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'private'             => \&_keep,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # drop unsupported fields
      ':drop' => [ qw(
        abstract
        author
        provides
        no_index
        keywords
        resources
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.0-from-1.1' => {
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
  );
  
  my %cleanup = (
    '2' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_2,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'dynamic_config'      => \&_keep_or_one,
      # ADDED MANDATORY
      'release_status'      => \&_release_status,
      # PRIOR OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_cleanup_optional_features_2,
      'provides'            => \&_provides,
      'resources'           => \&_cleanup_resources_2,
      # ADDED OPTIONAL
      'description'         => \&_keep,
      'prereqs'             => \&_cleanup_prereqs,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
          build_requires
          configure_requires
          conflicts
          distribution_type
          license_url
          private
          recommends
          requires
      ) ],
  
      # other random keys need x_ prefixing
      ':custom'              => \&_prefix_custom,
    },
    '1.4' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_1_4,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_4,
      # ADDED OPTIONAL
      'configure_requires'  => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.3' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.2' => {
      # PRIOR MANDATORY
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'license'             => \&_license_1,
      'name'                => \&_keep,
      'generated_by'        => \&_generated_by,
      # ADDED MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'resources'           => \&_resources_1_2,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.1' => {
      # CHANGED TO MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'license_url'         => \&_url_or_drop,
      'private'             => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.0' => {
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      'version'             => \&_keep,
      # IMPLIED OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep,
    },
  );
  
  #--------------------------------------------------------------------------#
  # Code
  #--------------------------------------------------------------------------#
  
  
  sub new {
    my ($class,$data) = @_;
  
    # create an attributes hash
    my $self = {
      'data'    => $data,
      'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
    };
  
    # create the object
    return bless $self, $class;
  }
  
  
  sub convert {
    my ($self, %args) = @_;
    my $args = { %args };
  
    my $new_version = $args->{version} || $HIGHEST;
  
    my ($old_version) = $self->{spec};
    my $converted = _dclone($self->{data});
  
    if ( $old_version == $new_version ) {
      $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
      my $cmv = CPAN::Meta::Validator->new( $converted );
      unless ( $cmv->is_valid ) {
        my $errs = join("\n", $cmv->errors);
        die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
      }
      return $converted;
    }
    elsif ( $old_version > $new_version )  {
      my @vers = sort { $b <=> $a } keys %known_specs;
      for my $i ( 0 .. $#vers-1 ) {
        next if $vers[$i] > $old_version;
        last if $vers[$i+1] < $new_version;
        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
        $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
        my $cmv = CPAN::Meta::Validator->new( $converted );
        unless ( $cmv->is_valid ) {
          my $errs = join("\n", $cmv->errors);
          die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
        }
      }
      return $converted;
    }
    else {
      my @vers = sort { $a <=> $b } keys %known_specs;
      for my $i ( 0 .. $#vers-1 ) {
        next if $vers[$i] < $old_version;
        last if $vers[$i+1] > $new_version;
        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
        $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
        my $cmv = CPAN::Meta::Validator->new( $converted );
        unless ( $cmv->is_valid ) {
          my $errs = join("\n", $cmv->errors);
          die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
        }
      }
      return $converted;
    }
  }
  
  1;
  
  # ABSTRACT: Convert CPAN distribution metadata structures
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Converter - Convert CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.120351
  
  =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
  
  
  __END__
  
  
CPAN_META_CONVERTER

$fatpacked{"CPAN/Meta/Feature.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_FEATURE';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Feature;
  our $VERSION = '2.120351'; # 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
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
  
  =head1 VERSION
  
  version 2.120351
  
  =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
  
  
  __END__
  
  
  
CPAN_META_FEATURE

$fatpacked{"CPAN/Meta/History.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_HISTORY';
  # vi:tw=72
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::History;
  our $VERSION = '2.120351'; # VERSION
  
  1;
  
  # ABSTRACT: history of CPAN Meta Spec changes
  
  
  
  __END__
  =pod
  
  =head1 NAME
  
  CPAN::Meta::History - history of CPAN Meta Spec changes
  
  =head1 VERSION
  
  version 2.120351
  
  =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 *
  
  Clarified that all prerequisites take version range specifications
  
  =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 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"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_PREREQS';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Prereqs;
  our $VERSION = '2.120351'; # VERSION
  
  
  use Carp qw(confess);
  use Scalar::Util qw(blessed);
  use CPAN::Meta::Requirements;
  
  
  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
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
  
  =head1 VERSION
  
  version 2.120351
  
  =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
  
  
  __END__
  
  
  
CPAN_META_PREREQS

$fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS';
  use strict;
  use warnings;
  package CPAN::Meta::Requirements;
  our $VERSION = '2.127'; # VERSION
  # ABSTRACT: a set of version requirements for a CPAN dist
  
  #pod =head1 SYNOPSIS
  #pod
  #pod   use CPAN::Meta::Requirements;
  #pod
  #pod   my $build_requires = CPAN::Meta::Requirements->new;
  #pod
  #pod   $build_requires->add_minimum('Library::Foo' => 1.208);
  #pod
  #pod   $build_requires->add_minimum('Library::Foo' => 2.602);
  #pod
  #pod   $build_requires->add_minimum('Module::Bar'  => 'v1.2.3');
  #pod
  #pod   $METAyml->{build_requires} = $build_requires->as_string_hash;
  #pod
  #pod =head1 DESCRIPTION
  #pod
  #pod A CPAN::Meta::Requirements object models a set of version constraints like
  #pod those specified in the F<META.yml> or F<META.json> files in CPAN distributions,
  #pod and as defined by L<CPAN::Meta::Spec>;
  #pod It can be built up by adding more and more constraints, and it will reduce them
  #pod to the simplest representation.
  #pod
  #pod Logically impossible constraints will be identified immediately by thrown
  #pod exceptions.
  #pod
  #pod =cut
  
  use Carp ();
  use Scalar::Util ();
  
  # To help ExtUtils::MakeMaker bootstrap CPAN::Meta::Requirements on perls
  # before 5.10, we fall back to the EUMM bundled compatibility version module if
  # that's the only thing available.  This shouldn't ever happen in a normal CPAN
  # install of CPAN::Meta::Requirements, as version.pm will be picked up from
  # prereqs and be available at runtime.
  
  BEGIN { eval "use version ()" or eval "use ExtUtils::MakeMaker::version" } ## no critic
  
  # Perl 5.10.0 didn't have "is_qv" in version.pm
  *_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} };
  
  #pod =method new
  #pod
  #pod   my $req = CPAN::Meta::Requirements->new;
  #pod
  #pod This returns a new CPAN::Meta::Requirements object.  It takes an optional
  #pod hash reference argument.  Currently, only one key is supported:
  #pod
  #pod =for :list
  #pod * C<bad_version_hook> -- if provided, when a version cannot be parsed into
  #pod   a version object, this code reference will be called with the invalid version
  #pod   string as an argument.  It must return a valid version object.
  #pod
  #pod All other keys are ignored.
  #pod
  #pod =cut
  
  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;
  }
  
  # from version::vpp
  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_object {
    my ($self, $version) = @_;
  
    my $vobj;
  
    # hack around version::vpp not handling <3 character vstring literals
    if ( $INC{'version/vpp.pm'} || $INC{'ExtUtils/MakeMaker/version/vpp.pm'} ) {
      my $magic = _find_magic_vstring( $version );
      $version = $magic if length $magic;
    }
  
    eval {
      local $SIG{__WARN__} = sub { die "Invalid version: $_[0]" };
      $vobj  = (! defined $version)                ? version->new(0)
             : (! Scalar::Util::blessed($version)) ? version->new($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->new("0$vobj");
    }
  
    # ensure normal v-string form
    if ( _is_qv($vobj) ) {
      $vobj = version->new($vobj->normal);
    }
  
    return $vobj;
  }
  
  #pod =method add_minimum
  #pod
  #pod   $req->add_minimum( $module => $version );
  #pod
  #pod This adds a new minimum version requirement.  If the new requirement is
  #pod redundant to the existing specification, this has no effect.
  #pod
  #pod Minimum requirements are inclusive.  C<$version> is required, along with any
  #pod greater version number.
  #pod
  #pod This method returns the requirements object.
  #pod
  #pod =method add_maximum
  #pod
  #pod   $req->add_maximum( $module => $version );
  #pod
  #pod This adds a new maximum version requirement.  If the new requirement is
  #pod redundant to the existing specification, this has no effect.
  #pod
  #pod Maximum requirements are inclusive.  No version strictly greater than the given
  #pod version is allowed.
  #pod
  #pod This method returns the requirements object.
  #pod
  #pod =method add_exclusion
  #pod
  #pod   $req->add_exclusion( $module => $version );
  #pod
  #pod This adds a new excluded version.  For example, you might use these three
  #pod method calls:
  #pod
  #pod   $req->add_minimum( $module => '1.00' );
  #pod   $req->add_maximum( $module => '1.82' );
  #pod
  #pod   $req->add_exclusion( $module => '1.75' );
  #pod
  #pod Any version between 1.00 and 1.82 inclusive would be acceptable, except for
  #pod 1.75.
  #pod
  #pod This method returns the requirements object.
  #pod
  #pod =method exact_version
  #pod
  #pod   $req->exact_version( $module => $version );
  #pod
  #pod This sets the version required for the given module to I<exactly> the given
  #pod version.  No other version would be considered acceptable.
  #pod
  #pod This method returns the requirements object.
  #pod
  #pod =cut
  
  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;
    }
  }
  
  #pod =method add_requirements
  #pod
  #pod   $req->add_requirements( $another_req_object );
  #pod
  #pod This method adds all the requirements in the given CPAN::Meta::Requirements object
  #pod to the requirements object on which it was called.  If there are any conflicts,
  #pod an exception is thrown.
  #pod
  #pod This method returns the requirements object.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method accepts_module
  #pod
  #pod   my $bool = $req->accepts_module($module => $version);
  #pod
  #pod Given an module and version, this method returns true if the version
  #pod specification for the module accepts the provided version.  In other words,
  #pod given:
  #pod
  #pod   Module => '>= 1.00, < 2.00'
  #pod
  #pod We will accept 1.00 and 1.75 but not 0.50 or 2.00.
  #pod
  #pod For modules that do not appear in the requirements, this method will return
  #pod true.
  #pod
  #pod =cut
  
  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);
  }
  
  #pod =method clear_requirement
  #pod
  #pod   $req->clear_requirement( $module );
  #pod
  #pod This removes the requirement for a given module from the object.
  #pod
  #pod This method returns the requirements object.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method requirements_for_module
  #pod
  #pod   $req->requirements_for_module( $module );
  #pod
  #pod This returns a string containing the version requirements for a given module in
  #pod the format described in L<CPAN::Meta::Spec> or undef if the given module has no
  #pod requirements. This should only be used for informational purposes such as error
  #pod messages and should not be interpreted or used for comparison (see
  #pod L</accepts_module> instead.)
  #pod
  #pod =cut
  
  sub requirements_for_module {
    my ($self, $module) = @_;
    my $entry = $self->__entry_for($module);
    return unless $entry;
    return $entry->as_string;
  }
  
  #pod =method required_modules
  #pod
  #pod This method returns a list of all the modules for which requirements have been
  #pod specified.
  #pod
  #pod =cut
  
  sub required_modules { keys %{ $_[0]{requirements} } }
  
  #pod =method clone
  #pod
  #pod   $req->clone;
  #pod
  #pod This method returns a clone of the invocant.  The clone and the original object
  #pod can then be changed independent of one another.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method is_simple
  #pod
  #pod This method returns true if and only if all requirements are inclusive minimums
  #pod -- that is, if their string expression is just the version number.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method is_finalized
  #pod
  #pod This method returns true if the requirements have been finalized by having the
  #pod C<finalize> method called on them.
  #pod
  #pod =cut
  
  sub is_finalized { $_[0]{finalized} }
  
  #pod =method finalize
  #pod
  #pod This method marks the requirements finalized.  Subsequent attempts to change
  #pod the requirements will be fatal, I<if> they would result in a change.  If they
  #pod would not alter the requirements, they have no effect.
  #pod
  #pod If a finalized set of requirements is cloned, the cloned requirements are not
  #pod also finalized.
  #pod
  #pod =cut
  
  sub finalize { $_[0]{finalized} = 1 }
  
  #pod =method as_string_hash
  #pod
  #pod This returns a reference to a hash describing the requirements using the
  #pod strings in the L<CPAN::Meta::Spec> specification.
  #pod
  #pod For example after the following program:
  #pod
  #pod   my $req = CPAN::Meta::Requirements->new;
  #pod
  #pod   $req->add_minimum('CPAN::Meta::Requirements' => 0.102);
  #pod
  #pod   $req->add_minimum('Library::Foo' => 1.208);
  #pod
  #pod   $req->add_maximum('Library::Foo' => 2.602);
  #pod
  #pod   $req->add_minimum('Module::Bar'  => 'v1.2.3');
  #pod
  #pod   $req->add_exclusion('Module::Bar'  => 'v1.2.8');
  #pod
  #pod   $req->exact_version('Xyzzy'  => '6.01');
  #pod
  #pod   my $hashref = $req->as_string_hash;
  #pod
  #pod C<$hashref> would contain:
  #pod
  #pod   {
  #pod     'CPAN::Meta::Requirements' => '0.102',
  #pod     'Library::Foo' => '>= 1.208, <= 2.206',
  #pod     'Module::Bar'  => '>= v1.2.3, != v1.2.8',
  #pod     'Xyzzy'        => '== 6.01',
  #pod   }
  #pod
  #pod =cut
  
  sub as_string_hash {
    my ($self) = @_;
  
    my %hash = map {; $_ => $self->{requirements}{$_}->as_string }
               $self->required_modules;
  
    return \%hash;
  }
  
  #pod =method add_string_requirement
  #pod
  #pod   $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206');
  #pod
  #pod This method parses the passed in string and adds the appropriate requirement
  #pod for the given module.  It understands version ranges as described in the
  #pod L<CPAN::Meta::Spec/Version Ranges>. For example:
  #pod
  #pod =over 4
  #pod
  #pod =item 1.3
  #pod
  #pod =item >= 1.3
  #pod
  #pod =item <= 1.3
  #pod
  #pod =item == 1.3
  #pod
  #pod =item != 1.3
  #pod
  #pod =item > 1.3
  #pod
  #pod =item < 1.3
  #pod
  #pod =item >= 1.3, != 1.5, <= 2.0
  #pod
  #pod A version number without an operator is equivalent to specifying a minimum
  #pod (C<E<gt>=>).  Extra whitespace is allowed.
  #pod
  #pod =back
  #pod
  #pod =cut
  
  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;
      }
    }
  }
  
  #pod =method from_string_hash
  #pod
  #pod   my $req = CPAN::Meta::Requirements->from_string_hash( \%hash );
  #pod
  #pod This is an alternate constructor for a CPAN::Meta::Requirements object.  It takes
  #pod a hash of module names and version requirement strings and returns a new
  #pod CPAN::Meta::Requirements object.
  #pod
  #pod =cut
  
  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.127
  
  =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,
  and as defined by L<CPAN::Meta::Spec>;
  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.  Currently, only one key is supported:
  
  =over 4
  
  =item *
  
  C<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_module($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 L<CPAN::Meta::Spec> 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://github.com/dagolden/CPAN-Meta-Requirements/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/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 CONTRIBUTORS
  
  =for stopwords Karen Etheridge robario
  
  =over 4
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  robario <webmaster@robario.com>
  
  =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"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_SPEC';
  # vi:tw=72
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Spec;
  our $VERSION = '2.120351'; # VERSION
  
  1;
  
  # ABSTRACT: specification for CPAN distribution metadata
  
  
  
  __END__
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Spec - specification for CPAN distribution metadata
  
  =head1 VERSION
  
  version 2.120351
  
  =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.  The values are Maps with the following valid subkeys:
  
  =over
  
  =item file
  
  This field is required.  The value must contain a Unix-style relative
  file path from the root of the distribution to the module containing the
  package.
  
  =item version
  
  This field contains a I<Version> String for the package, if one exists.
  
  =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 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"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_VALIDATOR';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Validator;
  our $VERSION = '2.120351'; # 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
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Validator - validate CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.120351
  
  =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
  
  
  __END__
  
  
  
CPAN_META_VALIDATOR

$fatpacked{"CPAN/Meta/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'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{"Encode/Locale.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ENCODE_LOCALE';
  package Encode::Locale;
  
  use strict;
  our $VERSION = "1.05";
  
  use base 'Exporter';
  our @EXPORT_OK = qw(
      decode_argv env
      $ENCODING_LOCALE $ENCODING_LOCALE_FS
      $ENCODING_CONSOLE_IN $ENCODING_CONSOLE_OUT
  );
  
  use Encode ();
  use Encode::Alias ();
  
  our $ENCODING_LOCALE;
  our $ENCODING_LOCALE_FS;
  our $ENCODING_CONSOLE_IN;
  our $ENCODING_CONSOLE_OUT;
  
  sub DEBUG () { 0 }
  
  sub _init {
      if ($^O eq "MSWin32") {
  	unless ($ENCODING_LOCALE) {
  	    # Try to obtain what the Windows ANSI code page is
  	    eval {
  		unless (defined &GetACP) {
  		    require Win32;
                      eval { Win32::GetACP() };
  		    *GetACP = sub { &Win32::GetACP } unless $@;
  		}
  		unless (defined &GetACP) {
  		    require Win32::API;
  		    Win32::API->Import('kernel32', 'int GetACP()');
  		}
  		if (defined &GetACP) {
  		    my $cp = GetACP();
  		    $ENCODING_LOCALE = "cp$cp" if $cp;
  		}
  	    };
  	}
  
  	unless ($ENCODING_CONSOLE_IN) {
              # only test one since set together
              unless (defined &GetInputCP) {
                  eval {
                      require Win32;
                      eval { Win32::GetConsoleCP() };
                      # manually "import" it since Win32->import refuses
                      *GetInputCP = sub { &Win32::GetConsoleCP } unless $@;
                      *GetOutputCP = sub { &Win32::GetConsoleOutputCP } unless $@;
                  };
                  unless (defined &GetInputCP) {
                      eval {
                          # try Win32::Console module for codepage to use
                          require Win32::Console;
                          eval { Win32::Console::InputCP() };
                          *GetInputCP = sub { &Win32::Console::InputCP }
                              unless $@;
                          *GetOutputCP = sub { &Win32::Console::OutputCP }
                              unless $@;
                      };
                  }
                  unless (defined &GetInputCP) {
                      # final fallback
                      *GetInputCP = *GetOutputCP = sub {
                          # another fallback that could work is:
                          # reg query HKLM\System\CurrentControlSet\Control\Nls\CodePage /v ACP
                          ((qx(chcp) || '') =~ /^Active code page: (\d+)/)
                              ? $1 : ();
                      };
                  }
  	    }
              my $cp = GetInputCP();
              $ENCODING_CONSOLE_IN = "cp$cp" if $cp;
              $cp = GetOutputCP();
              $ENCODING_CONSOLE_OUT = "cp$cp" if $cp;
  	}
      }
  
      unless ($ENCODING_LOCALE) {
  	eval {
  	    require I18N::Langinfo;
  	    $ENCODING_LOCALE = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
  
  	    # Workaround of Encode < v2.25.  The "646" encoding  alias was
  	    # introduced in Encode-2.25, but we don't want to require that version
  	    # quite yet.  Should avoid the CPAN testers failure reported from
  	    # openbsd-4.7/perl-5.10.0 combo.
  	    $ENCODING_LOCALE = "ascii" if $ENCODING_LOCALE eq "646";
  
  	    # https://rt.cpan.org/Ticket/Display.html?id=66373
  	    $ENCODING_LOCALE = "hp-roman8" if $^O eq "hpux" && $ENCODING_LOCALE eq "roman8";
  	};
  	$ENCODING_LOCALE ||= $ENCODING_CONSOLE_IN;
      }
  
      if ($^O eq "darwin") {
  	$ENCODING_LOCALE_FS ||= "UTF-8";
      }
  
      # final fallback
      $ENCODING_LOCALE ||= $^O eq "MSWin32" ? "cp1252" : "UTF-8";
      $ENCODING_LOCALE_FS ||= $ENCODING_LOCALE;
      $ENCODING_CONSOLE_IN ||= $ENCODING_LOCALE;
      $ENCODING_CONSOLE_OUT ||= $ENCODING_CONSOLE_IN;
  
      unless (Encode::find_encoding($ENCODING_LOCALE)) {
  	my $foundit;
  	if (lc($ENCODING_LOCALE) eq "gb18030") {
  	    eval {
  		require Encode::HanExtra;
  	    };
  	    if ($@) {
  		die "Need Encode::HanExtra to be installed to support locale codeset ($ENCODING_LOCALE), stopped";
  	    }
  	    $foundit++ if Encode::find_encoding($ENCODING_LOCALE);
  	}
  	die "The locale codeset ($ENCODING_LOCALE) isn't one that perl can decode, stopped"
  	    unless $foundit;
  
      }
  
      # use Data::Dump; ddx $ENCODING_LOCALE, $ENCODING_LOCALE_FS, $ENCODING_CONSOLE_IN, $ENCODING_CONSOLE_OUT;
  }
  
  _init();
  Encode::Alias::define_alias(sub {
      no strict 'refs';
      no warnings 'once';
      return ${"ENCODING_" . uc(shift)};
  }, "locale");
  
  sub _flush_aliases {
      no strict 'refs';
      for my $a (keys %Encode::Alias::Alias) {
  	if (defined ${"ENCODING_" . uc($a)}) {
  	    delete $Encode::Alias::Alias{$a};
  	    warn "Flushed alias cache for $a" if DEBUG;
  	}
      }
  }
  
  sub reinit {
      $ENCODING_LOCALE = shift;
      $ENCODING_LOCALE_FS = shift;
      $ENCODING_CONSOLE_IN = $ENCODING_LOCALE;
      $ENCODING_CONSOLE_OUT = $ENCODING_LOCALE;
      _init();
      _flush_aliases();
  }
  
  sub decode_argv {
      die if defined wantarray;
      for (@ARGV) {
  	$_ = Encode::decode(locale => $_, @_);
      }
  }
  
  sub env {
      my $k = Encode::encode(locale => shift);
      my $old = $ENV{$k};
      if (@_) {
  	my $v = shift;
  	if (defined $v) {
  	    $ENV{$k} = Encode::encode(locale => $v);
  	}
  	else {
  	    delete $ENV{$k};
  	}
      }
      return Encode::decode(locale => $old) if defined wantarray;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Encode::Locale - Determine the locale encoding
  
  =head1 SYNOPSIS
  
    use Encode::Locale;
    use Encode;
  
    $string = decode(locale => $bytes);
    $bytes = encode(locale => $string);
  
    if (-t) {
        binmode(STDIN, ":encoding(console_in)");
        binmode(STDOUT, ":encoding(console_out)");
        binmode(STDERR, ":encoding(console_out)");
    }
  
    # Processing file names passed in as arguments
    my $uni_filename = decode(locale => $ARGV[0]);
    open(my $fh, "<", encode(locale_fs => $uni_filename))
       || die "Can't open '$uni_filename': $!";
    binmode($fh, ":encoding(locale)");
    ...
  
  =head1 DESCRIPTION
  
  In many applications it's wise to let Perl use Unicode for the strings it
  processes.  Most of the interfaces Perl has to the outside world are still byte
  based.  Programs therefore need to decode byte strings that enter the program
  from the outside and encode them again on the way out.
  
  The POSIX locale system is used to specify both the language conventions
  requested by the user and the preferred character set to consume and
  output.  The C<Encode::Locale> module looks up the charset and encoding (called
  a CODESET in the locale jargon) and arranges for the L<Encode> module to know
  this encoding under the name "locale".  It means bytes obtained from the
  environment can be converted to Unicode strings by calling C<<
  Encode::encode(locale => $bytes) >> and converted back again with C<<
  Encode::decode(locale => $string) >>.
  
  Where file systems interfaces pass file names in and out of the program we also
  need care.  The trend is for operating systems to use a fixed file encoding
  that don't actually depend on the locale; and this module determines the most
  appropriate encoding for file names. The L<Encode> module will know this
  encoding under the name "locale_fs".  For traditional Unix systems this will
  be an alias to the same encoding as "locale".
  
  For programs running in a terminal window (called a "Console" on some systems)
  the "locale" encoding is usually a good choice for what to expect as input and
  output.  Some systems allows us to query the encoding set for the terminal and
  C<Encode::Locale> will do that if available and make these encodings known
  under the C<Encode> aliases "console_in" and "console_out".  For systems where
  we can't determine the terminal encoding these will be aliased as the same
  encoding as "locale".  The advice is to use "console_in" for input known to
  come from the terminal and "console_out" for output to the terminal.
  
  In addition to arranging for various Encode aliases the following functions and
  variables are provided:
  
  =over
  
  =item decode_argv( )
  
  =item decode_argv( Encode::FB_CROAK )
  
  This will decode the command line arguments to perl (the C<@ARGV> array) in-place.
  
  The function will by default replace characters that can't be decoded by
  "\x{FFFD}", the Unicode replacement character.
  
  Any argument provided is passed as CHECK to underlying Encode::decode() call.
  Pass the value C<Encode::FB_CROAK> to have the decoding croak if not all the
  command line arguments can be decoded.  See L<Encode/"Handling Malformed Data">
  for details on other options for CHECK.
  
  =item env( $uni_key )
  
  =item env( $uni_key => $uni_value )
  
  Interface to get/set environment variables.  Returns the current value as a
  Unicode string. The $uni_key and $uni_value arguments are expected to be
  Unicode strings as well.  Passing C<undef> as $uni_value deletes the
  environment variable named $uni_key.
  
  The returned value will have the characters that can't be decoded replaced by
  "\x{FFFD}", the Unicode replacement character.
  
  There is no interface to request alternative CHECK behavior as for
  decode_argv().  If you need that you need to call encode/decode yourself.
  For example:
  
      my $key = Encode::encode(locale => $uni_key, Encode::FB_CROAK);
      my $uni_value = Encode::decode(locale => $ENV{$key}, Encode::FB_CROAK);
  
  =item reinit( )
  
  =item reinit( $encoding )
  
  Reinitialize the encodings from the locale.  You want to call this function if
  you changed anything in the environment that might influence the locale.
  
  This function will croak if the determined encoding isn't recognized by
  the Encode module.
  
  With argument force $ENCODING_... variables to set to the given value.
  
  =item $ENCODING_LOCALE
  
  The encoding name determined to be suitable for the current locale.
  L<Encode> know this encoding as "locale".
  
  =item $ENCODING_LOCALE_FS
  
  The encoding name determined to be suitable for file system interfaces
  involving file names.
  L<Encode> know this encoding as "locale_fs".
  
  =item $ENCODING_CONSOLE_IN
  
  =item $ENCODING_CONSOLE_OUT
  
  The encodings to be used for reading and writing output to the a console.
  L<Encode> know these encodings as "console_in" and "console_out".
  
  =back
  
  =head1 NOTES
  
  This table summarizes the mapping of the encodings set up
  by the C<Encode::Locale> module:
  
    Encode      |         |              |
    Alias       | Windows | Mac OS X     | POSIX
    ------------+---------+--------------+------------
    locale      | ANSI    | nl_langinfo  | nl_langinfo
    locale_fs   | ANSI    | UTF-8        | nl_langinfo
    console_in  | OEM     | nl_langinfo  | nl_langinfo
    console_out | OEM     | nl_langinfo  | nl_langinfo
  
  =head2 Windows
  
  Windows has basically 2 sets of APIs.  A wide API (based on passing UTF-16
  strings) and a byte based API based a character set called ANSI.  The
  regular Perl interfaces to the OS currently only uses the ANSI APIs.
  Unfortunately ANSI is not a single character set.
  
  The encoding that corresponds to ANSI varies between different editions of
  Windows.  For many western editions of Windows ANSI corresponds to CP-1252
  which is a character set similar to ISO-8859-1.  Conceptually the ANSI
  character set is a similar concept to the POSIX locale CODESET so this module
  figures out what the ANSI code page is and make this available as
  $ENCODING_LOCALE and the "locale" Encoding alias.
  
  Windows systems also operate with another byte based character set.
  It's called the OEM code page.  This is the encoding that the Console
  takes as input and output.  It's common for the OEM code page to
  differ from the ANSI code page.
  
  =head2 Mac OS X
  
  On Mac OS X the file system encoding is always UTF-8 while the locale
  can otherwise be set up as normal for POSIX systems.
  
  File names on Mac OS X will at the OS-level be converted to
  NFD-form.  A file created by passing a NFC-filename will come
  in NFD-form from readdir().  See L<Unicode::Normalize> for details
  of NFD/NFC.
  
  Actually, Apple does not follow the Unicode NFD standard since not all
  character ranges are decomposed.  The claim is that this avoids problems with
  round trip conversions from old Mac text encodings.  See L<Encode::UTF8Mac> for
  details.
  
  =head2 POSIX (Linux and other Unixes)
  
  File systems might vary in what encoding is to be used for
  filenames.  Since this module has no way to actually figure out
  what the is correct it goes with the best guess which is to
  assume filenames are encoding according to the current locale.
  Users are advised to always specify UTF-8 as the locale charset.
  
  =head1 SEE ALSO
  
  L<I18N::Langinfo>, L<Encode>, L<Term::Encoding>
  
  =head1 AUTHOR
  
  Copyright 2010 Gisle Aas <gisle@aas.no>.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
ENCODE_LOCALE

$fatpacked{"ExtUtils/Command/MM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_COMMAND_MM';
  package ExtUtils::Command::MM;
  
  require 5.006;
  
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  
  our @EXPORT  = qw(test_harness pod2man perllocal_install uninstall
                    warn_if_old_packlist test_s cp_nonempty);
  our $VERSION = '7.04';
  
  my $Is_VMS = $^O eq 'VMS';
  
  eval {  require Time::HiRes; die unless Time::HiRes->can("stat"); };
  *mtime = $@ ?
   sub { [             stat($_[0])]->[9] } :
   sub { [Time::HiRes::stat($_[0])]->[9] } ;
  
  =head1 NAME
  
  ExtUtils::Command::MM - Commands for the MM's to use in Makefiles
  
  =head1 SYNOPSIS
  
    perl "-MExtUtils::Command::MM" -e "function" "--" arguments...
  
  
  =head1 DESCRIPTION
  
  B<FOR INTERNAL USE ONLY!>  The interface is not stable.
  
  ExtUtils::Command::MM encapsulates code which would otherwise have to
  be done with large "one" liners.
  
  Any $(FOO) used in the examples are make variables, not Perl.
  
  =over 4
  
  =item B<test_harness>
  
    test_harness($verbose, @test_libs);
  
  Runs the tests on @ARGV via Test::Harness passing through the $verbose
  flag.  Any @test_libs will be unshifted onto the test's @INC.
  
  @test_libs are run in alphabetical order.
  
  =cut
  
  sub test_harness {
      require Test::Harness;
      require File::Spec;
  
      $Test::Harness::verbose = shift;
  
      # Because Windows doesn't do this for us and listing all the *.t files
      # out on the command line can blow over its exec limit.
      require ExtUtils::Command;
      my @argv = ExtUtils::Command::expand_wildcards(@ARGV);
  
      local @INC = @INC;
      unshift @INC, map { File::Spec->rel2abs($_) } @_;
      Test::Harness::runtests(sort { lc $a cmp lc $b } @argv);
  }
  
  
  
  =item B<pod2man>
  
    pod2man( '--option=value',
             $podfile1 => $manpage1,
             $podfile2 => $manpage2,
             ...
           );
  
    # or args on @ARGV
  
  pod2man() is a function performing most of the duties of the pod2man
  program.  Its arguments are exactly the same as pod2man as of 5.8.0
  with the addition of:
  
      --perm_rw   octal permission to set the resulting manpage to
  
  And the removal of:
  
      --verbose/-v
      --help/-h
  
  If no arguments are given to pod2man it will read from @ARGV.
  
  If Pod::Man is unavailable, this function will warn and return undef.
  
  =cut
  
  sub pod2man {
      local @ARGV = @_ ? @_ : @ARGV;
  
      {
          local $@;
          if( !eval { require Pod::Man } ) {
              warn "Pod::Man is not available: $@".
                   "Man pages will not be generated during this install.\n";
              return 0;
          }
      }
      require Getopt::Long;
  
      # We will cheat and just use Getopt::Long.  We fool it by putting
      # our arguments into @ARGV.  Should be safe.
      my %options = ();
      Getopt::Long::config ('bundling_override');
      Getopt::Long::GetOptions (\%options,
                  'section|s=s', 'release|r=s', 'center|c=s',
                  'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
                  'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l',
                  'name|n=s', 'perm_rw=i', 'utf8|u'
      );
      delete $options{utf8} unless $Pod::Man::VERSION >= 2.17;
  
      # If there's no files, don't bother going further.
      return 0 unless @ARGV;
  
      # Official sets --center, but don't override things explicitly set.
      if ($options{official} && !defined $options{center}) {
          $options{center} = q[Perl Programmer's Reference Guide];
      }
  
      # This isn't a valid Pod::Man option and is only accepted for backwards
      # compatibility.
      delete $options{lax};
      my $count = scalar @ARGV / 2;
      my $plural = $count == 1 ? 'document' : 'documents';
      print "Manifying $count pod $plural\n";
  
      do {{  # so 'next' works
          my ($pod, $man) = splice(@ARGV, 0, 2);
  
          next if ((-e $man) &&
                   (mtime($man) > mtime($pod)) &&
                   (mtime($man) > mtime("Makefile")));
  
          my $parser = Pod::Man->new(%options);
          $parser->parse_from_file($pod, $man)
            or do { warn("Could not install $man\n");  next };
  
          if (exists $options{perm_rw}) {
              chmod(oct($options{perm_rw}), $man)
                or do { warn("chmod $options{perm_rw} $man: $!\n"); next };
          }
      }} while @ARGV;
  
      return 1;
  }
  
  
  =item B<warn_if_old_packlist>
  
    perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile>
  
  Displays a warning that an old packlist file was found.  Reads the
  filename from @ARGV.
  
  =cut
  
  sub warn_if_old_packlist {
      my $packlist = $ARGV[0];
  
      return unless -f $packlist;
      print <<"PACKLIST_WARNING";
  WARNING: I have found an old package in
      $packlist.
  Please make sure the two installations are not conflicting
  PACKLIST_WARNING
  
  }
  
  
  =item B<perllocal_install>
  
      perl "-MExtUtils::Command::MM" -e perllocal_install
          <type> <module name> <key> <value> ...
  
      # VMS only, key|value pairs come on STDIN
      perl "-MExtUtils::Command::MM" -e perllocal_install
          <type> <module name> < <key>|<value> ...
  
  Prints a fragment of POD suitable for appending to perllocal.pod.
  Arguments are read from @ARGV.
  
  'type' is the type of what you're installing.  Usually 'Module'.
  
  'module name' is simply the name of your module.  (Foo::Bar)
  
  Key/value pairs are extra information about the module.  Fields include:
  
      installed into      which directory your module was out into
      LINKTYPE            dynamic or static linking
      VERSION             module version number
      EXE_FILES           any executables installed in a space seperated
                          list
  
  =cut
  
  sub perllocal_install {
      my($type, $name) = splice(@ARGV, 0, 2);
  
      # VMS feeds args as a piped file on STDIN since it usually can't
      # fit all the args on a single command line.
      my @mod_info = $Is_VMS ? split /\|/, <STDIN>
                             : @ARGV;
  
      my $pod;
      $pod = sprintf <<POD, scalar localtime;
   =head2 %s: C<$type> L<$name|$name>
  
   =over 4
  
  POD
  
      do {
          my($key, $val) = splice(@mod_info, 0, 2);
  
          $pod .= <<POD
   =item *
  
   C<$key: $val>
  
  POD
  
      } while(@mod_info);
  
      $pod .= "=back\n\n";
      $pod =~ s/^ //mg;
      print $pod;
  
      return 1;
  }
  
  =item B<uninstall>
  
      perl "-MExtUtils::Command::MM" -e uninstall <packlist>
  
  A wrapper around ExtUtils::Install::uninstall().  Warns that
  uninstallation is deprecated and doesn't actually perform the
  uninstallation.
  
  =cut
  
  sub uninstall {
      my($packlist) = shift @ARGV;
  
      require ExtUtils::Install;
  
      print <<'WARNING';
  
  Uninstall is unsafe and deprecated, the uninstallation was not performed.
  We will show what would have been done.
  
  WARNING
  
      ExtUtils::Install::uninstall($packlist, 1, 1);
  
      print <<'WARNING';
  
  Uninstall is unsafe and deprecated, the uninstallation was not performed.
  Please check the list above carefully, there may be errors.
  Remove the appropriate files manually.
  Sorry for the inconvenience.
  
  WARNING
  
  }
  
  =item B<test_s>
  
     perl "-MExtUtils::Command::MM" -e test_s <file>
  
  Tests if a file exists and is not empty (size > 0).
  I<Exits> with 0 if it does, 1 if it does not.
  
  =cut
  
  sub test_s {
    exit(-s $ARGV[0] ? 0 : 1);
  }
  
  =item B<cp_nonempty>
  
    perl "-MExtUtils::Command::MM" -e cp_nonempty <srcfile> <dstfile> <perm>
  
  Tests if the source file exists and is not empty (size > 0). If it is not empty
  it copies it to the given destination with the given permissions.
  
  =back
  
  =cut
  
  sub cp_nonempty {
    my @args = @ARGV;
    return 0 unless -s $args[0];
    require ExtUtils::Command;
    {
      local @ARGV = @args[0,1];
      ExtUtils::Command::cp(@ARGV);
    }
    {
      local @ARGV = @args[2,1];
      ExtUtils::Command::chmod(@ARGV);
    }
  }
  
  
  1;
EXTUTILS_COMMAND_MM

$fatpacked{"ExtUtils/Liblist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_LIBLIST';
  package ExtUtils::Liblist;
  
  use strict;
  
  our $VERSION = '7.04';
  
  use File::Spec;
  require ExtUtils::Liblist::Kid;
  our @ISA = qw(ExtUtils::Liblist::Kid File::Spec);
  
  # Backwards compatibility with old interface.
  sub ext {
      goto &ExtUtils::Liblist::Kid::ext;
  }
  
  sub lsdir {
    shift;
    my $rex = qr/$_[1]/;
    opendir DIR, $_[0];
    my @out = grep /$rex/, readdir DIR;
    closedir DIR;
    return @out;
  }
  
  __END__
  
  =head1 NAME
  
  ExtUtils::Liblist - determine libraries to use and how to use them
  
  =head1 SYNOPSIS
  
    require ExtUtils::Liblist;
  
    $MM->ext($potential_libs, $verbose, $need_names);
  
    # Usually you can get away with:
    ExtUtils::Liblist->ext($potential_libs, $verbose, $need_names)
  
  =head1 DESCRIPTION
  
  This utility takes a list of libraries in the form C<-llib1 -llib2
  -llib3> and returns lines suitable for inclusion in an extension
  Makefile.  Extra library paths may be included with the form
  C<-L/another/path> this will affect the searches for all subsequent
  libraries.
  
  It returns an array of four or five scalar values: EXTRALIBS,
  BSLOADLIBS, LDLOADLIBS, LD_RUN_PATH, and, optionally, a reference to
  the array of the filenames of actual libraries.  Some of these don't
  mean anything unless on Unix.  See the details about those platform
  specifics below.  The list of the filenames is returned only if
  $need_names argument is true.
  
  Dependent libraries can be linked in one of three ways:
  
  =over 2
  
  =item * For static extensions
  
  by the ld command when the perl binary is linked with the extension
  library. See EXTRALIBS below.
  
  =item * For dynamic extensions at build/link time
  
  by the ld command when the shared object is built/linked. See
  LDLOADLIBS below.
  
  =item * For dynamic extensions at load time
  
  by the DynaLoader when the shared object is loaded. See BSLOADLIBS
  below.
  
  =back
  
  =head2 EXTRALIBS
  
  List of libraries that need to be linked with when linking a perl
  binary which includes this extension. Only those libraries that
  actually exist are included.  These are written to a file and used
  when linking perl.
  
  =head2 LDLOADLIBS and LD_RUN_PATH
  
  List of those libraries which can or must be linked into the shared
  library when created using ld. These may be static or dynamic
  libraries.  LD_RUN_PATH is a colon separated list of the directories
  in LDLOADLIBS. It is passed as an environment variable to the process
  that links the shared library.
  
  =head2 BSLOADLIBS
  
  List of those libraries that are needed but can be linked in
  dynamically at run time on this platform.  SunOS/Solaris does not need
  this because ld records the information (from LDLOADLIBS) into the
  object file.  This list is used to create a .bs (bootstrap) file.
  
  =head1 PORTABILITY
  
  This module deals with a lot of system dependencies and has quite a
  few architecture specific C<if>s in the code.
  
  =head2 VMS implementation
  
  The version of ext() which is executed under VMS differs from the
  Unix-OS/2 version in several respects:
  
  =over 2
  
  =item *
  
  Input library and path specifications are accepted with or without the
  C<-l> and C<-L> prefixes used by Unix linkers.  If neither prefix is
  present, a token is considered a directory to search if it is in fact
  a directory, and a library to search for otherwise.  Authors who wish
  their extensions to be portable to Unix or OS/2 should use the Unix
  prefixes, since the Unix-OS/2 version of ext() requires them.
  
  =item *
  
  Wherever possible, shareable images are preferred to object libraries,
  and object libraries to plain object files.  In accordance with VMS
  naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
  it also looks for I<lib>lib and libI<lib> to accommodate Unix conventions
  used in some ported software.
  
  =item *
  
  For each library that is found, an appropriate directive for a linker options
  file is generated.  The return values are space-separated strings of
  these directives, rather than elements used on the linker command line.
  
  =item *
  
  LDLOADLIBS contains both the libraries found based on C<$potential_libs> and
  the CRTLs, if any, specified in Config.pm.  EXTRALIBS contains just those
  libraries found based on C<$potential_libs>.  BSLOADLIBS and LD_RUN_PATH
  are always empty.
  
  =back
  
  In addition, an attempt is made to recognize several common Unix library
  names, and filter them out or convert them to their VMS equivalents, as
  appropriate.
  
  In general, the VMS version of ext() should properly handle input from
  extensions originally designed for a Unix or VMS environment.  If you
  encounter problems, or discover cases where the search could be improved,
  please let us know.
  
  =head2 Win32 implementation
  
  The version of ext() which is executed under Win32 differs from the
  Unix-OS/2 version in several respects:
  
  =over 2
  
  =item *
  
  If C<$potential_libs> is empty, the return value will be empty.
  Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm)
  will be appended to the list of C<$potential_libs>.  The libraries
  will be searched for in the directories specified in C<$potential_libs>,
  C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>.
  For each library that is found,  a space-separated list of fully qualified
  library pathnames is generated.
  
  =item *
  
  Input library and path specifications are accepted with or without the
  C<-l> and C<-L> prefixes used by Unix linkers.
  
  An entry of the form C<-La:\foo> specifies the C<a:\foo> directory to look
  for the libraries that follow.
  
  An entry of the form C<-lfoo> specifies the library C<foo>, which may be
  spelled differently depending on what kind of compiler you are using.  If
  you are using GCC, it gets translated to C<libfoo.a>, but for other win32
  compilers, it becomes C<foo.lib>.  If no files are found by those translated
  names, one more attempt is made to find them using either C<foo.a> or
  C<libfoo.lib>, depending on whether GCC or some other win32 compiler is
  being used, respectively.
  
  If neither the C<-L> or C<-l> prefix is present in an entry, the entry is
  considered a directory to search if it is in fact a directory, and a
  library to search for otherwise.  The C<$Config{lib_ext}> suffix will
  be appended to any entries that are not directories and don't already have
  the suffix.
  
  Note that the C<-L> and C<-l> prefixes are B<not required>, but authors
  who wish their extensions to be portable to Unix or OS/2 should use the
  prefixes, since the Unix-OS/2 version of ext() requires them.
  
  =item *
  
  Entries cannot be plain object files, as many Win32 compilers will
  not handle object files in the place of libraries.
  
  =item *
  
  Entries in C<$potential_libs> beginning with a colon and followed by
  alphanumeric characters are treated as flags.  Unknown flags will be ignored.
  
  An entry that matches C</:nodefault/i> disables the appending of default
  libraries found in C<$Config{perllibs}> (this should be only needed very rarely).
  
  An entry that matches C</:nosearch/i> disables all searching for
  the libraries specified after it.  Translation of C<-Lfoo> and
  C<-lfoo> still happens as appropriate (depending on compiler being used,
  as reflected by C<$Config{cc}>), but the entries are not verified to be
  valid files or directories.
  
  An entry that matches C</:search/i> reenables searching for
  the libraries specified after it.  You can put it at the end to
  enable searching for default libraries specified by C<$Config{perllibs}>.
  
  =item *
  
  The libraries specified may be a mixture of static libraries and
  import libraries (to link with DLLs).  Since both kinds are used
  pretty transparently on the Win32 platform, we do not attempt to
  distinguish between them.
  
  =item *
  
  LDLOADLIBS and EXTRALIBS are always identical under Win32, and BSLOADLIBS
  and LD_RUN_PATH are always empty (this may change in future).
  
  =item *
  
  You must make sure that any paths and path components are properly
  surrounded with double-quotes if they contain spaces. For example,
  C<$potential_libs> could be (literally):
  
  	"-Lc:\Program Files\vc\lib" msvcrt.lib "la test\foo bar.lib"
  
  Note how the first and last entries are protected by quotes in order
  to protect the spaces.
  
  =item *
  
  Since this module is most often used only indirectly from extension
  C<Makefile.PL> files, here is an example C<Makefile.PL> entry to add
  a library to the build process for an extension:
  
          LIBS => ['-lgl']
  
  When using GCC, that entry specifies that MakeMaker should first look
  for C<libgl.a> (followed by C<gl.a>) in all the locations specified by
  C<$Config{libpth}>.
  
  When using a compiler other than GCC, the above entry will search for
  C<gl.lib> (followed by C<libgl.lib>).
  
  If the library happens to be in a location not in C<$Config{libpth}>,
  you need:
  
          LIBS => ['-Lc:\gllibs -lgl']
  
  Here is a less often used example:
  
          LIBS => ['-lgl', ':nosearch -Ld:\mesalibs -lmesa -luser32']
  
  This specifies a search for library C<gl> as before.  If that search
  fails to find the library, it looks at the next item in the list. The
  C<:nosearch> flag will prevent searching for the libraries that follow,
  so it simply returns the value as C<-Ld:\mesalibs -lmesa -luser32>,
  since GCC can use that value as is with its linker.
  
  When using the Visual C compiler, the second item is returned as
  C<-libpath:d:\mesalibs mesa.lib user32.lib>.
  
  When using the Borland compiler, the second item is returned as
  C<-Ld:\mesalibs mesa.lib user32.lib>, and MakeMaker takes care of
  moving the C<-Ld:\mesalibs> to the correct place in the linker
  command line.
  
  =back
  
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker>
  
  =cut
  
EXTUTILS_LIBLIST

$fatpacked{"ExtUtils/Liblist/Kid.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_LIBLIST_KID';
  package ExtUtils::Liblist::Kid;
  
  # XXX Splitting this out into its own .pm is a temporary solution.
  
  # This kid package is to be used by MakeMaker.  It will not work if
  # $self is not a Makemaker.
  
  use 5.006;
  
  # Broken out of MakeMaker from version 4.11
  
  use strict;
  use warnings;
  our $VERSION = '7.04';
  
  use ExtUtils::MakeMaker::Config;
  use Cwd 'cwd';
  use File::Basename;
  use File::Spec;
  
  sub ext {
      if    ( $^O eq 'VMS' )     { return &_vms_ext; }
      elsif ( $^O eq 'MSWin32' ) { return &_win32_ext; }
      else                       { return &_unix_os2_ext; }
  }
  
  sub _unix_os2_ext {
      my ( $self, $potential_libs, $verbose, $give_libs ) = @_;
      $verbose ||= 0;
  
      if ( $^O =~ /os2|android/ and $Config{perllibs} ) {
  
          # Dynamic libraries are not transitive, so we may need including
          # the libraries linked against perl.dll/libperl.so again.
  
          $potential_libs .= " " if $potential_libs;
          $potential_libs .= $Config{perllibs};
      }
      return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs;
      warn "Potential libraries are '$potential_libs':\n" if $verbose;
  
      my ( $so ) = $Config{so};
      my ( $libs ) = defined $Config{perllibs} ? $Config{perllibs} : $Config{libs};
      my $Config_libext = $Config{lib_ext} || ".a";
      my $Config_dlext = $Config{dlext};
  
      # compute $extralibs, $bsloadlibs and $ldloadlibs from
      # $potential_libs
      # this is a rewrite of Andy Dougherty's extliblist in perl
  
      my ( @searchpath );    # from "-L/path" entries in $potential_libs
      my ( @libpath ) = split " ", $Config{'libpth'} || '';
      my ( @ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen );
      my ( @libs,       %libs_seen );
      my ( $fullname,   @fullname );
      my ( $pwd )   = cwd();    # from Cwd.pm
      my ( $found ) = 0;
  
      foreach my $thislib ( split ' ', $potential_libs ) {
          my ( $custom_name ) = '';
  
          # Handle possible linker path arguments.
          if ( $thislib =~ s/^(-[LR]|-Wl,-R|-Wl,-rpath,)// ) {    # save path flag type
              my ( $ptype ) = $1;
              unless ( -d $thislib ) {
                  warn "$ptype$thislib ignored, directory does not exist\n"
                    if $verbose;
                  next;
              }
              my ( $rtype ) = $ptype;
              if ( ( $ptype eq '-R' ) or ( $ptype =~ m!^-Wl,-[Rr]! ) ) {
                  if ( $Config{'lddlflags'} =~ /-Wl,-[Rr]/ ) {
                      $rtype = '-Wl,-R';
                  }
                  elsif ( $Config{'lddlflags'} =~ /-R/ ) {
                      $rtype = '-R';
                  }
              }
              unless ( File::Spec->file_name_is_absolute( $thislib ) ) {
                  warn "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n";
                  $thislib = $self->catdir( $pwd, $thislib );
              }
              push( @searchpath, $thislib );
              push( @extralibs,  "$ptype$thislib" );
              push( @ldloadlibs, "$rtype$thislib" );
              next;
          }
  
          if ( $thislib =~ m!^-Wl,! ) {
              push( @extralibs,  $thislib );
              push( @ldloadlibs, $thislib );
              next;
          }
  
          # Handle possible library arguments.
          if ( $thislib =~ s/^-l(:)?// ) {
              # Handle -l:foo.so, which means that the library will
              # actually be called foo.so, not libfoo.so.  This
              # is used in Android by ExtUtils::Depends to allow one XS
              # module to link to another.
              $custom_name = $1 || '';
          }
          else {
              warn "Unrecognized argument in LIBS ignored: '$thislib'\n";
              next;
          }
  
          my ( $found_lib ) = 0;
          foreach my $thispth ( @searchpath, @libpath ) {
  
              # Try to find the full name of the library.  We need this to
              # determine whether it's a dynamically-loadable library or not.
              # This tends to be subject to various os-specific quirks.
              # For gcc-2.6.2 on linux (March 1995), DLD can not load
              # .sa libraries, with the exception of libm.sa, so we
              # deliberately skip them.
              if ((@fullname =
                   $self->lsdir($thispth, "^\Qlib$thislib.$so.\E[0-9]+")) ||
                  (@fullname =
                   $self->lsdir($thispth, "^\Qlib$thislib.\E[0-9]+\Q\.$so"))) {
                  # Take care that libfoo.so.10 wins against libfoo.so.9.
                  # Compare two libraries to find the most recent version
                  # number.  E.g.  if you have libfoo.so.9.0.7 and
                  # libfoo.so.10.1, first convert all digits into two
                  # decimal places.  Then we'll add ".00" to the shorter
                  # strings so that we're comparing strings of equal length
                  # Thus we'll compare libfoo.so.09.07.00 with
                  # libfoo.so.10.01.00.  Some libraries might have letters
                  # in the version.  We don't know what they mean, but will
                  # try to skip them gracefully -- we'll set any letter to
                  # '0'.  Finally, sort in reverse so we can take the
                  # first element.
  
                  #TODO: iterate through the directory instead of sorting
  
                  $fullname = "$thispth/" . (
                      sort {
                          my ( $ma ) = $a;
                          my ( $mb ) = $b;
                          $ma =~ tr/A-Za-z/0/s;
                          $ma =~ s/\b(\d)\b/0$1/g;
                          $mb =~ tr/A-Za-z/0/s;
                          $mb =~ s/\b(\d)\b/0$1/g;
                          while ( length( $ma ) < length( $mb ) ) { $ma .= ".00"; }
                          while ( length( $mb ) < length( $ma ) ) { $mb .= ".00"; }
  
                          # Comparison deliberately backwards
                          $mb cmp $ma;
                        } @fullname
                  )[0];
              }
              elsif ( -f ( $fullname = "$thispth/lib$thislib.$so" )
                  && ( ( $Config{'dlsrc'} ne "dl_dld.xs" ) || ( $thislib eq "m" ) ) )
              {
              }
              elsif (-f ( $fullname = "$thispth/lib${thislib}_s$Config_libext" )
                  && ( $Config{'archname'} !~ /RM\d\d\d-svr4/ )
                  && ( $thislib .= "_s" ) )
              {    # we must explicitly use _s version
              }
              elsif ( -f ( $fullname = "$thispth/lib$thislib$Config_libext" ) ) {
              }
              elsif ( defined( $Config_dlext )
                  && -f ( $fullname = "$thispth/lib$thislib.$Config_dlext" ) )
              {
              }
              elsif ( -f ( $fullname = "$thispth/$thislib$Config_libext" ) ) {
              }
              elsif ( -f ( $fullname = "$thispth/lib$thislib.dll$Config_libext" ) ) {
              }
              elsif ( $^O eq 'cygwin' && -f ( $fullname = "$thispth/$thislib.dll" ) ) {
              }
              elsif ( -f ( $fullname = "$thispth/Slib$thislib$Config_libext" ) ) {
              }
              elsif ($^O eq 'dgux'
                  && -l ( $fullname = "$thispth/lib$thislib$Config_libext" )
                  && readlink( $fullname ) =~ /^elink:/s )
              {
  
                  # Some of DG's libraries look like misconnected symbolic
                  # links, but development tools can follow them.  (They
                  # look like this:
                  #
                  #    libm.a -> elink:${SDE_PATH:-/usr}/sde/\
                  #    ${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib/libm.a
                  #
                  # , the compilation tools expand the environment variables.)
              }
              elsif ( $custom_name && -f ( $fullname = "$thispth/$thislib" ) ) {
              }
              else {
                  warn "$thislib not found in $thispth\n" if $verbose;
                  next;
              }
              warn "'-l$thislib' found at $fullname\n" if $verbose;
              push @libs, $fullname unless $libs_seen{$fullname}++;
              $found++;
              $found_lib++;
  
              # Now update library lists
  
              # what do we know about this library...
              my $is_dyna = ( $fullname !~ /\Q$Config_libext\E\z/ );
              my $in_perl = ( $libs =~ /\B-l:?\Q${thislib}\E\b/s );
  
              # include the path to the lib once in the dynamic linker path
              # but only if it is a dynamic lib and not in Perl itself
              my ( $fullnamedir ) = dirname( $fullname );
              push @ld_run_path, $fullnamedir
                if $is_dyna
                    && !$in_perl
                    && !$ld_run_path_seen{$fullnamedir}++;
  
              # Do not add it into the list if it is already linked in
              # with the main perl executable.
              # We have to special-case the NeXT, because math and ndbm
              # are both in libsys_s
              unless (
                  $in_perl
                  || ( $Config{'osname'} eq 'next'
                      && ( $thislib eq 'm' || $thislib eq 'ndbm' ) )
                )
              {
                  push( @extralibs, "-l$custom_name$thislib" );
              }
  
              # We might be able to load this archive file dynamically
              if (   ( $Config{'dlsrc'} =~ /dl_next/ && $Config{'osvers'} lt '4_0' )
                  || ( $Config{'dlsrc'} =~ /dl_dld/ ) )
              {
  
                  # We push -l$thislib instead of $fullname because
                  # it avoids hardwiring a fixed path into the .bs file.
                  # Mkbootstrap will automatically add dl_findfile() to
                  # the .bs file if it sees a name in the -l format.
                  # USE THIS, when dl_findfile() is fixed:
                  # push(@bsloadlibs, "-l$thislib");
                  # OLD USE WAS while checking results against old_extliblist
                  push( @bsloadlibs, "$fullname" );
              }
              else {
                  if ( $is_dyna ) {
  
                      # For SunOS4, do not add in this shared library if
                      # it is already linked in the main perl executable
                      push( @ldloadlibs, "-l$custom_name$thislib" )
                        unless ( $in_perl and $^O eq 'sunos' );
                  }
                  else {
                      push( @ldloadlibs, "-l$custom_name$thislib" );
                  }
              }
              last;    # found one here so don't bother looking further
          }
          warn "Warning (mostly harmless): " . "No library found for -l$thislib\n"
            unless $found_lib > 0;
      }
  
      unless ( $found ) {
          return ( '', '', '', '', ( $give_libs ? \@libs : () ) );
      }
      else {
          return ( "@extralibs", "@bsloadlibs", "@ldloadlibs", join( ":", @ld_run_path ), ( $give_libs ? \@libs : () ) );
      }
  }
  
  sub _win32_ext {
  
      require Text::ParseWords;
  
      my ( $self, $potential_libs, $verbose, $give_libs ) = @_;
      $verbose ||= 0;
  
      # If user did not supply a list, we punt.
      # (caller should probably use the list in $Config{libs})
      return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs;
  
      # TODO: make this use MM_Win32.pm's compiler detection
      my %libs_seen;
      my @extralibs;
      my $cc = $Config{cc} || '';
      my $VC = $cc =~ /\bcl\b/i;
      my $GC = $cc =~ /\bgcc\b/i;
  
      my $libext     = _win32_lib_extensions();
      my @searchpath = ( '' );                                    # from "-L/path" entries in $potential_libs
      my @libpath    = _win32_default_search_paths( $VC, $GC );
      my $pwd        = cwd();                                     # from Cwd.pm
      my $search     = 1;
  
      # compute @extralibs from $potential_libs
      my @lib_search_list = _win32_make_lib_search_list( $potential_libs, $verbose );
      for ( @lib_search_list ) {
  
          my $thislib = $_;
  
          # see if entry is a flag
          if ( /^:\w+$/ ) {
              $search = 0 if lc eq ':nosearch';
              $search = 1 if lc eq ':search';
              _debug( "Ignoring unknown flag '$thislib'\n", $verbose ) if !/^:(no)?(search|default)$/i;
              next;
          }
  
          # if searching is disabled, do compiler-specific translations
          unless ( $search ) {
              s/^-l(.+)$/$1.lib/ unless $GC;
              s/^-L/-libpath:/ if $VC;
              push( @extralibs, $_ );
              next;
          }
  
          # handle possible linker path arguments
          if ( s/^-L// and not -d ) {
              _debug( "$thislib ignored, directory does not exist\n", $verbose );
              next;
          }
          elsif ( -d ) {
              unless ( File::Spec->file_name_is_absolute( $_ ) ) {
                  warn "Warning: '$thislib' changed to '-L$pwd/$_'\n";
                  $_ = $self->catdir( $pwd, $_ );
              }
              push( @searchpath, $_ );
              next;
          }
  
          my @paths = ( @searchpath, @libpath );
          my ( $fullname, $path ) = _win32_search_file( $thislib, $libext, \@paths, $verbose, $GC );
  
          if ( !$fullname ) {
              warn "Warning (mostly harmless): No library found for $thislib\n";
              next;
          }
  
          _debug( "'$thislib' found as '$fullname'\n", $verbose );
          push( @extralibs, $fullname );
          $libs_seen{$fullname} = 1 if $path;    # why is this a special case?
      }
  
      my @libs = keys %libs_seen;
  
      return ( '', '', '', '', ( $give_libs ? \@libs : () ) ) unless @extralibs;
  
      # make sure paths with spaces are properly quoted
      @extralibs = map { qq["$_"] } @extralibs;
      @libs      = map { qq["$_"] } @libs;
  
      my $lib = join( ' ', @extralibs );
  
      # normalize back to backward slashes (to help braindead tools)
      # XXX this may break equally braindead GNU tools that don't understand
      # backslashes, either.  Seems like one can't win here.  Cursed be CP/M.
      $lib =~ s,/,\\,g;
  
      _debug( "Result: $lib\n", $verbose );
      wantarray ? ( $lib, '', $lib, '', ( $give_libs ? \@libs : () ) ) : $lib;
  }
  
  sub _win32_make_lib_search_list {
      my ( $potential_libs, $verbose ) = @_;
  
      # If Config.pm defines a set of default libs, we always
      # tack them on to the user-supplied list, unless the user
      # specified :nodefault
      my $libs = $Config{'perllibs'};
      $potential_libs = join( ' ', $potential_libs, $libs ) if $libs and $potential_libs !~ /:nodefault/i;
      _debug( "Potential libraries are '$potential_libs':\n", $verbose );
  
      $potential_libs =~ s,\\,/,g;    # normalize to forward slashes
  
      my @list = Text::ParseWords::quotewords( '\s+', 0, $potential_libs );
  
      return @list;
  }
  
  sub _win32_default_search_paths {
      my ( $VC, $GC ) = @_;
  
      my $libpth = $Config{'libpth'} || '';
      $libpth =~ s,\\,/,g;            # normalize to forward slashes
  
      my @libpath = Text::ParseWords::quotewords( '\s+', 0, $libpth );
      push @libpath, "$Config{installarchlib}/CORE";    # add "$Config{installarchlib}/CORE" to default search path
  
      push @libpath, split /;/, $ENV{LIB}          if $VC and $ENV{LIB};
      push @libpath, split /;/, $ENV{LIBRARY_PATH} if $GC and $ENV{LIBRARY_PATH};
  
      return @libpath;
  }
  
  sub _win32_search_file {
      my ( $thislib, $libext, $paths, $verbose, $GC ) = @_;
  
      my @file_list = _win32_build_file_list( $thislib, $GC, $libext );
  
      for my $lib_file ( @file_list ) {
          for my $path ( @{$paths} ) {
              my $fullname = $lib_file;
              $fullname = "$path\\$fullname" if $path;
  
              return ( $fullname, $path ) if -f $fullname;
  
              _debug( "'$thislib' not found as '$fullname'\n", $verbose );
          }
      }
  
      return;
  }
  
  sub _win32_build_file_list {
      my ( $lib, $GC, $extensions ) = @_;
  
      my @pre_fixed = _win32_build_prefixed_list( $lib, $GC );
      return map _win32_attach_extensions( $_, $extensions ), @pre_fixed;
  }
  
  sub _win32_build_prefixed_list {
      my ( $lib, $GC ) = @_;
  
      return $lib if $lib !~ s/^-l//;
      return $lib if $lib =~ /^lib/ and !$GC;
  
      ( my $no_prefix = $lib ) =~ s/^lib//i;
      $lib = "lib$lib" if $no_prefix eq $lib;
  
      return ( $lib, $no_prefix ) if $GC;
      return ( $no_prefix, $lib );
  }
  
  sub _win32_attach_extensions {
      my ( $lib, $extensions ) = @_;
      return map _win32_try_attach_extension( $lib, $_ ), @{$extensions};
  }
  
  sub _win32_try_attach_extension {
      my ( $lib, $extension ) = @_;
  
      return $lib if $lib =~ /\Q$extension\E$/i;
      return "$lib$extension";
  }
  
  sub _win32_lib_extensions {
      my @extensions;
      push @extensions, $Config{'lib_ext'} if $Config{'lib_ext'};
      push @extensions, '.dll.a' if grep { m!^\.a$! } @extensions;
      push @extensions, '.lib' unless grep { m!^\.lib$! } @extensions;
      return \@extensions;
  }
  
  sub _debug {
      my ( $message, $verbose ) = @_;
      return if !$verbose;
      warn $message;
      return;
  }
  
  sub _vms_ext {
      my ( $self, $potential_libs, $verbose, $give_libs ) = @_;
      $verbose ||= 0;
  
      my ( @crtls, $crtlstr );
      @crtls = ( ( $Config{'ldflags'} =~ m-/Debug-i ? $Config{'dbgprefix'} : '' ) . 'PerlShr/Share' );
      push( @crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'} );
      push( @crtls, grep { not /\(/ } split /\s+/, $Config{'libc'} );
  
      # In general, we pass through the basic libraries from %Config unchanged.
      # The one exception is that if we're building in the Perl source tree, and
      # a library spec could be resolved via a logical name, we go to some trouble
      # to insure that the copy in the local tree is used, rather than one to
      # which a system-wide logical may point.
      if ( $self->{PERL_SRC} ) {
          my ( $locspec, $type );
          foreach my $lib ( @crtls ) {
              if ( ( $locspec, $type ) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i ) {
                  if    ( lc $type eq '/share' )   { $locspec .= $Config{'exe_ext'}; }
                  elsif ( lc $type eq '/library' ) { $locspec .= $Config{'lib_ext'}; }
                  else                             { $locspec .= $Config{'obj_ext'}; }
                  $locspec = $self->catfile( $self->{PERL_SRC}, $locspec );
                  $lib = "$locspec$type" if -e $locspec;
              }
          }
      }
      $crtlstr = @crtls ? join( ' ', @crtls ) : '';
  
      unless ( $potential_libs ) {
          warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose;
          return ( '', '', $crtlstr, '', ( $give_libs ? [] : () ) );
      }
  
      my ( %found, @fndlibs, $ldlib );
      my $cwd = cwd();
      my ( $so, $lib_ext, $obj_ext ) = @Config{ 'so', 'lib_ext', 'obj_ext' };
  
      # List of common Unix library names and their VMS equivalents
      # (VMS equivalent of '' indicates that the library is automatically
      # searched by the linker, and should be skipped here.)
      my ( @flibs, %libs_seen );
      my %libmap = (
          'm'      => '',
          'f77'    => '',
          'F77'    => '',
          'V77'    => '',
          'c'      => '',
          'malloc' => '',
          'crypt'  => '',
          'resolv' => '',
          'c_s'    => '',
          'socket' => '',
          'X11'    => 'DECW$XLIBSHR',
          'Xt'     => 'DECW$XTSHR',
          'Xm'     => 'DECW$XMLIBSHR',
          'Xmu'    => 'DECW$XMULIBSHR'
      );
  
      warn "Potential libraries are '$potential_libs'\n" if $verbose;
  
      # First, sort out directories and library names in the input
      my ( @dirs, @libs );
      foreach my $lib ( split ' ', $potential_libs ) {
          push( @dirs, $1 ),   next if $lib =~ /^-L(.*)/;
          push( @dirs, $lib ), next if $lib =~ /[:>\]]$/;
          push( @dirs, $lib ), next if -d $lib;
          push( @libs, $1 ),   next if $lib =~ /^-l(.*)/;
          push( @libs, $lib );
      }
      push( @dirs, split( ' ', $Config{'libpth'} ) );
  
      # Now make sure we've got VMS-syntax absolute directory specs
      # (We don't, however, check whether someone's hidden a relative
      # path in a logical name.)
      foreach my $dir ( @dirs ) {
          unless ( -d $dir ) {
              warn "Skipping nonexistent Directory $dir\n" if $verbose > 1;
              $dir = '';
              next;
          }
          warn "Resolving directory $dir\n" if $verbose;
          if ( File::Spec->file_name_is_absolute( $dir ) ) {
              $dir = VMS::Filespec::vmspath( $dir );
          }
          else {
              $dir = $self->catdir( $cwd, $dir );
          }
      }
      @dirs = grep { length( $_ ) } @dirs;
      unshift( @dirs, '' );    # Check each $lib without additions first
  
    LIB: foreach my $lib ( @libs ) {
          if ( exists $libmap{$lib} ) {
              next unless length $libmap{$lib};
              $lib = $libmap{$lib};
          }
  
          my ( @variants, $cand );
          my ( $ctype ) = '';
  
          # If we don't have a file type, consider it a possibly abbreviated name and
          # check for common variants.  We try these first to grab libraries before
          # a like-named executable image (e.g. -lperl resolves to perlshr.exe
          # before perl.exe).
          if ( $lib !~ /\.[^:>\]]*$/ ) {
              push( @variants, "${lib}shr", "${lib}rtl", "${lib}lib" );
              push( @variants, "lib$lib" ) if $lib !~ /[:>\]]/;
          }
          push( @variants, $lib );
          warn "Looking for $lib\n" if $verbose;
          foreach my $variant ( @variants ) {
              my ( $fullname, $name );
  
              foreach my $dir ( @dirs ) {
                  my ( $type );
  
                  $name = "$dir$variant";
                  warn "\tChecking $name\n" if $verbose > 2;
                  $fullname = VMS::Filespec::rmsexpand( $name );
                  if ( defined $fullname and -f $fullname ) {
  
                      # It's got its own suffix, so we'll have to figure out the type
                      if    ( $fullname =~ /(?:$so|exe)$/i )      { $type = 'SHR'; }
                      elsif ( $fullname =~ /(?:$lib_ext|olb)$/i ) { $type = 'OLB'; }
                      elsif ( $fullname =~ /(?:$obj_ext|obj)$/i ) {
                          warn "Warning (mostly harmless): " . "Plain object file $fullname found in library list\n";
                          $type = 'OBJ';
                      }
                      else {
                          warn "Warning (mostly harmless): " . "Unknown library type for $fullname; assuming shared\n";
                          $type = 'SHR';
                      }
                  }
                  elsif (-f ( $fullname = VMS::Filespec::rmsexpand( $name, $so ) )
                      or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.exe' ) ) )
                  {
                      $type = 'SHR';
                      $name = $fullname unless $fullname =~ /exe;?\d*$/i;
                  }
                  elsif (
                      not length( $ctype ) and    # If we've got a lib already,
                                                  # don't bother
                      ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $lib_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.olb' ) ) )
                    )
                  {
                      $type = 'OLB';
                      $name = $fullname unless $fullname =~ /olb;?\d*$/i;
                  }
                  elsif (
                      not length( $ctype ) and    # If we've got a lib already,
                                                  # don't bother
                      ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $obj_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.obj' ) ) )
                    )
                  {
                      warn "Warning (mostly harmless): " . "Plain object file $fullname found in library list\n";
                      $type = 'OBJ';
                      $name = $fullname unless $fullname =~ /obj;?\d*$/i;
                  }
                  if ( defined $type ) {
                      $ctype = $type;
                      $cand  = $name;
                      last if $ctype eq 'SHR';
                  }
              }
              if ( $ctype ) {
  
                  push @{ $found{$ctype} }, $cand;
                  warn "\tFound as $cand (really $fullname), type $ctype\n"
                    if $verbose > 1;
                  push @flibs, $name unless $libs_seen{$fullname}++;
                  next LIB;
              }
          }
          warn "Warning (mostly harmless): " . "No library found for $lib\n";
      }
  
      push @fndlibs, @{ $found{OBJ} } if exists $found{OBJ};
      push @fndlibs, map { "$_/Library" } @{ $found{OLB} } if exists $found{OLB};
      push @fndlibs, map { "$_/Share" } @{ $found{SHR} }   if exists $found{SHR};
      my $lib = join( ' ', @fndlibs );
  
      $ldlib = $crtlstr ? "$lib $crtlstr" : $lib;
      $ldlib =~ s/^\s+|\s+$//g;
      warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose;
      wantarray ? ( $lib, '', $ldlib, '', ( $give_libs ? \@flibs : () ) ) : $lib;
  }
  
  1;
EXTUTILS_LIBLIST_KID

$fatpacked{"ExtUtils/MM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM';
  package ExtUtils::MM;
  
  use strict;
  use ExtUtils::MakeMaker::Config;
  
  our $VERSION = '7.04';
  
  require ExtUtils::Liblist;
  require ExtUtils::MakeMaker;
  our @ISA = qw(ExtUtils::Liblist ExtUtils::MakeMaker);
  
  =head1 NAME
  
  ExtUtils::MM - OS adjusted ExtUtils::MakeMaker subclass
  
  =head1 SYNOPSIS
  
    require ExtUtils::MM;
    my $mm = MM->new(...);
  
  =head1 DESCRIPTION
  
  B<FOR INTERNAL USE ONLY>
  
  ExtUtils::MM is a subclass of ExtUtils::MakeMaker which automatically
  chooses the appropriate OS specific subclass for you
  (ie. ExtUils::MM_Unix, etc...).
  
  It also provides a convenient alias via the MM class (I didn't want
  MakeMaker modules outside of ExtUtils/).
  
  This class might turn out to be a temporary solution, but MM won't go
  away.
  
  =cut
  
  {
      # Convenient alias.
      package MM;
      our @ISA = qw(ExtUtils::MM);
      sub DESTROY {}
  }
  
  sub _is_win95 {
      # miniperl might not have the Win32 functions available and we need
      # to run in miniperl.
      my $have_win32 = eval { require Win32 };
      return $have_win32 && defined &Win32::IsWin95 ? Win32::IsWin95()
                                                    : ! defined $ENV{SYSTEMROOT};
  }
  
  my %Is = ();
  $Is{VMS}    = $^O eq 'VMS';
  $Is{OS2}    = $^O eq 'os2';
  $Is{MacOS}  = $^O eq 'MacOS';
  if( $^O eq 'MSWin32' ) {
      _is_win95() ? $Is{Win95} = 1 : $Is{Win32} = 1;
  }
  $Is{UWIN}   = $^O =~ /^uwin(-nt)?$/;
  $Is{Cygwin} = $^O eq 'cygwin';
  $Is{NW5}    = $Config{osname} eq 'NetWare';  # intentional
  $Is{BeOS}   = ($^O =~ /beos/i or $^O eq 'haiku');
  $Is{DOS}    = $^O eq 'dos';
  if( $Is{NW5} ) {
      $^O = 'NetWare';
      delete $Is{Win32};
  }
  $Is{VOS}    = $^O eq 'vos';
  $Is{QNX}    = $^O eq 'qnx';
  $Is{AIX}    = $^O eq 'aix';
  $Is{Darwin} = $^O eq 'darwin';
  
  $Is{Unix}   = !grep { $_ } values %Is;
  
  map { delete $Is{$_} unless $Is{$_} } keys %Is;
  _assert( keys %Is == 1 );
  my($OS) = keys %Is;
  
  
  my $class = "ExtUtils::MM_$OS";
  eval "require $class" unless $INC{"ExtUtils/MM_$OS.pm"}; ## no critic
  die $@ if $@;
  unshift @ISA, $class;
  
  
  sub _assert {
      my $sanity = shift;
      die sprintf "Assert failed at %s line %d\n", (caller)[1,2] unless $sanity;
      return;
  }
EXTUTILS_MM

$fatpacked{"ExtUtils/MM_AIX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_AIX';
  package ExtUtils::MM_AIX;
  
  use strict;
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Unix;
  our @ISA = qw(ExtUtils::MM_Unix);
  
  use ExtUtils::MakeMaker qw(neatvalue);
  
  
  =head1 NAME
  
  ExtUtils::MM_AIX - AIX specific subclass of ExtUtils::MM_Unix
  
  =head1 SYNOPSIS
  
    Don't use this module directly.
    Use ExtUtils::MM and let it choose.
  
  =head1 DESCRIPTION
  
  This is a subclass of ExtUtils::MM_Unix which contains functionality for
  AIX.
  
  Unless otherwise stated it works just like ExtUtils::MM_Unix
  
  =head2 Overridden methods
  
  =head3 dlsyms
  
  Define DL_FUNCS and DL_VARS and write the *.exp files.
  
  =cut
  
  sub dlsyms {
      my($self,%attribs) = @_;
  
      return '' unless $self->needs_linking();
  
      my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
      my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
      my($funclist)  = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
      my(@m);
  
      push(@m,"
  dynamic :: $self->{BASEEXT}.exp
  
  ") unless $self->{SKIPHASH}{'dynamic'}; # dynamic and static are subs, so...
  
      push(@m,"
  static :: $self->{BASEEXT}.exp
  
  ") unless $self->{SKIPHASH}{'static'};  # we avoid a warning if we tick them
  
      push(@m,"
  $self->{BASEEXT}.exp: Makefile.PL
  ",'	$(PERLRUN) -e \'use ExtUtils::Mksymlists; \\
  	Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
  	neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist),
  	', "DL_VARS" => ', neatvalue($vars), ');\'
  ');
  
      join('',@m);
  }
  
  
  =head1 AUTHOR
  
  Michael G Schwern <schwern@pobox.com> with code from ExtUtils::MM_Unix
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker>
  
  =cut
  
  
  1;
EXTUTILS_MM_AIX

$fatpacked{"ExtUtils/MM_Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_ANY';
  package ExtUtils::MM_Any;
  
  use strict;
  our $VERSION = '7.04';
  
  use Carp;
  use File::Spec;
  use File::Basename;
  BEGIN { our @ISA = qw(File::Spec); }
  
  # We need $Verbose
  use ExtUtils::MakeMaker qw($Verbose);
  
  use ExtUtils::MakeMaker::Config;
  
  
  # So we don't have to keep calling the methods over and over again,
  # we have these globals to cache the values.  Faster and shrtr.
  my $Curdir  = __PACKAGE__->curdir;
  my $Rootdir = __PACKAGE__->rootdir;
  my $Updir   = __PACKAGE__->updir;
  
  
  =head1 NAME
  
  ExtUtils::MM_Any - Platform-agnostic MM methods
  
  =head1 SYNOPSIS
  
    FOR INTERNAL USE ONLY!
  
    package ExtUtils::MM_SomeOS;
  
    # Temporarily, you have to subclass both.  Put MM_Any first.
    require ExtUtils::MM_Any;
    require ExtUtils::MM_Unix;
    @ISA = qw(ExtUtils::MM_Any ExtUtils::Unix);
  
  =head1 DESCRIPTION
  
  B<FOR INTERNAL USE ONLY!>
  
  ExtUtils::MM_Any is a superclass for the ExtUtils::MM_* set of
  modules.  It contains methods which are either inherently
  cross-platform or are written in a cross-platform manner.
  
  Subclass off of ExtUtils::MM_Any I<and> ExtUtils::MM_Unix.  This is a
  temporary solution.
  
  B<THIS MAY BE TEMPORARY!>
  
  
  =head1 METHODS
  
  Any methods marked I<Abstract> must be implemented by subclasses.
  
  
  =head2 Cross-platform helper methods
  
  These are methods which help writing cross-platform code.
  
  
  
  =head3 os_flavor  I<Abstract>
  
      my @os_flavor = $mm->os_flavor;
  
  @os_flavor is the style of operating system this is, usually
  corresponding to the MM_*.pm file we're using.
  
  The first element of @os_flavor is the major family (ie. Unix,
  Windows, VMS, OS/2, etc...) and the rest are sub families.
  
  Some examples:
  
      Cygwin98       ('Unix',  'Cygwin', 'Cygwin9x')
      Windows        ('Win32')
      Win98          ('Win32', 'Win9x')
      Linux          ('Unix',  'Linux')
      MacOS X        ('Unix',  'Darwin', 'MacOS', 'MacOS X')
      OS/2           ('OS/2')
  
  This is used to write code for styles of operating system.
  See os_flavor_is() for use.
  
  
  =head3 os_flavor_is
  
      my $is_this_flavor = $mm->os_flavor_is($this_flavor);
      my $is_this_flavor = $mm->os_flavor_is(@one_of_these_flavors);
  
  Checks to see if the current operating system is one of the given flavors.
  
  This is useful for code like:
  
      if( $mm->os_flavor_is('Unix') ) {
          $out = `foo 2>&1`;
      }
      else {
          $out = `foo`;
      }
  
  =cut
  
  sub os_flavor_is {
      my $self = shift;
      my %flavors = map { ($_ => 1) } $self->os_flavor;
      return (grep { $flavors{$_} } @_) ? 1 : 0;
  }
  
  
  =head3 can_load_xs
  
      my $can_load_xs = $self->can_load_xs;
  
  Returns true if we have the ability to load XS.
  
  This is important because miniperl, used to build XS modules in the
  core, can not load XS.
  
  =cut
  
  sub can_load_xs {
      return defined &DynaLoader::boot_DynaLoader ? 1 : 0;
  }
  
  
  =head3 can_run
  
    use ExtUtils::MM;
    my $runnable = MM->can_run($Config{make});
  
  If called in a scalar context it will return the full path to the binary
  you asked for if it was found, or C<undef> if it was not.
  
  If called in a list context, it will return a list of the full paths to instances
  of the binary where found in C<PATH>, or an empty list if it was not found.
  
  Copied from L<IPC::Cmd|IPC::Cmd/"$path = can_run( PROGRAM );">, but modified into
  a method (and removed C<$INSTANCES> capability).
  
  =cut
  
  sub can_run {
      my ($self, $command) = @_;
  
      # a lot of VMS executables have a symbol defined
      # check those first
      if ( $^O eq 'VMS' ) {
          require VMS::DCLsym;
          my $syms = VMS::DCLsym->new;
          return $command if scalar $syms->getsym( uc $command );
      }
  
      my @possibles;
  
      if( File::Spec->file_name_is_absolute($command) ) {
          return $self->maybe_command($command);
  
      } else {
          for my $dir (
              File::Spec->path,
              File::Spec->curdir
          ) {
              next if ! $dir || ! -d $dir;
              my $abs = File::Spec->catfile($self->os_flavor_is('Win32') ? Win32::GetShortPathName( $dir ) : $dir, $command);
              push @possibles, $abs if $abs = $self->maybe_command($abs);
          }
      }
      return @possibles if wantarray;
      return shift @possibles;
  }
  
  
  =head3 can_redirect_error
  
    $useredirect = MM->can_redirect_error;
  
  True if on an OS where qx operator (or backticks) can redirect C<STDERR>
  onto C<STDOUT>.
  
  =cut
  
  sub can_redirect_error {
    my $self = shift;
    $self->os_flavor_is('Unix')
        or ($self->os_flavor_is('Win32') and !$self->os_flavor_is('Win9x'))
        or $self->os_flavor_is('OS/2')
  }
  
  
  =head3 is_make_type
  
      my $is_dmake = $self->is_make_type('dmake');
  
  Returns true if C<<$self->make>> is the given type; possibilities are:
  
    gmake    GNU make
    dmake
    nmake
    bsdmake  BSD pmake-derived
  
  =cut
  
  sub is_make_type {
      my($self, $type) = @_;
      (undef, undef, my $make_basename) = $self->splitpath($self->make);
      return 1 if $make_basename =~ /\b$type\b/i; # executable's filename
      return 0 if $make_basename =~ /\b(dmake|nmake)\b/i; # Never fall through for dmake/nmake
      # now have to run with "-v" and guess
      my $redirect = $self->can_redirect_error ? '2>&1' : '';
      my $make = $self->make || $self->{MAKE};
      my $minus_v = `"$make" -v $redirect`;
      return 1 if $type eq 'gmake' and $minus_v =~ /GNU make/i;
      return 1 if $type eq 'bsdmake'
        and $minus_v =~ /^usage: make \[-BeikNnqrstWwX\]/im;
      0; # it wasn't whatever you asked
  }
  
  
  =head3 can_dep_space
  
      my $can_dep_space = $self->can_dep_space;
  
  Returns true if C<make> can handle (probably by quoting)
  dependencies that contain a space. Currently known true for GNU make,
  false for BSD pmake derivative.
  
  =cut
  
  my $cached_dep_space;
  sub can_dep_space {
      my $self = shift;
      return $cached_dep_space if defined $cached_dep_space;
      return $cached_dep_space = 1 if $self->is_make_type('gmake');
      return $cached_dep_space = 0 if $self->is_make_type('dmake'); # only on W32
      return $cached_dep_space = 0 if $self->is_make_type('bsdmake');
      return $cached_dep_space = 0; # assume no
  }
  
  
  =head3 quote_dep
  
    $text = $mm->quote_dep($text);
  
  Method that protects Makefile single-value constants (mainly filenames),
  so that make will still treat them as single values even if they
  inconveniently have spaces in. If the make program being used cannot
  achieve such protection and the given text would need it, throws an
  exception.
  
  =cut
  
  sub quote_dep {
      my ($self, $arg) = @_;
      die <<EOF if $arg =~ / / and not $self->can_dep_space;
  Tried to use make dependency with space for make that can't:
    '$arg'
  EOF
      $arg =~ s/( )/\\$1/g; # how GNU make does it
      return $arg;
  }
  
  
  =head3 split_command
  
      my @cmds = $MM->split_command($cmd, @args);
  
  Most OS have a maximum command length they can execute at once.  Large
  modules can easily generate commands well past that limit.  Its
  necessary to split long commands up into a series of shorter commands.
  
  C<split_command> will return a series of @cmds each processing part of
  the args.  Collectively they will process all the arguments.  Each
  individual line in @cmds will not be longer than the
  $self->max_exec_len being careful to take into account macro expansion.
  
  $cmd should include any switches and repeated initial arguments.
  
  If no @args are given, no @cmds will be returned.
  
  Pairs of arguments will always be preserved in a single command, this
  is a heuristic for things like pm_to_blib and pod2man which work on
  pairs of arguments.  This makes things like this safe:
  
      $self->split_command($cmd, %pod2man);
  
  
  =cut
  
  sub split_command {
      my($self, $cmd, @args) = @_;
  
      my @cmds = ();
      return(@cmds) unless @args;
  
      # If the command was given as a here-doc, there's probably a trailing
      # newline.
      chomp $cmd;
  
      # set aside 30% for macro expansion.
      my $len_left = int($self->max_exec_len * 0.70);
      $len_left -= length $self->_expand_macros($cmd);
  
      do {
          my $arg_str = '';
          my @next_args;
          while( @next_args = splice(@args, 0, 2) ) {
              # Two at a time to preserve pairs.
              my $next_arg_str = "\t  ". join ' ', @next_args, "\n";
  
              if( !length $arg_str ) {
                  $arg_str .= $next_arg_str
              }
              elsif( length($arg_str) + length($next_arg_str) > $len_left ) {
                  unshift @args, @next_args;
                  last;
              }
              else {
                  $arg_str .= $next_arg_str;
              }
          }
          chop $arg_str;
  
          push @cmds, $self->escape_newlines("$cmd \n$arg_str");
      } while @args;
  
      return @cmds;
  }
  
  
  sub _expand_macros {
      my($self, $cmd) = @_;
  
      $cmd =~ s{\$\((\w+)\)}{
          defined $self->{$1} ? $self->{$1} : "\$($1)"
      }e;
      return $cmd;
  }
  
  
  =head3 echo
  
      my @commands = $MM->echo($text);
      my @commands = $MM->echo($text, $file);
      my @commands = $MM->echo($text, $file, \%opts);
  
  Generates a set of @commands which print the $text to a $file.
  
  If $file is not given, output goes to STDOUT.
  
  If $opts{append} is true the $file will be appended to rather than
  overwritten.  Default is to overwrite.
  
  If $opts{allow_variables} is true, make variables of the form
  C<$(...)> will not be escaped.  Other C<$> will.  Default is to escape
  all C<$>.
  
  Example of use:
  
      my $make = map "\t$_\n", $MM->echo($text, $file);
  
  =cut
  
  sub echo {
      my($self, $text, $file, $opts) = @_;
  
      # Compatibility with old options
      if( !ref $opts ) {
          my $append = $opts;
          $opts = { append => $append || 0 };
      }
      $opts->{allow_variables} = 0 unless defined $opts->{allow_variables};
  
      my $ql_opts = { allow_variables => $opts->{allow_variables} };
      my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) }
                 split /\n/, $text;
      if( $file ) {
          my $redirect = $opts->{append} ? '>>' : '>';
          $cmds[0] .= " $redirect $file";
          $_ .= " >> $file" foreach @cmds[1..$#cmds];
      }
  
      return @cmds;
  }
  
  
  =head3 wraplist
  
    my $args = $mm->wraplist(@list);
  
  Takes an array of items and turns them into a well-formatted list of
  arguments.  In most cases this is simply something like:
  
      FOO \
      BAR \
      BAZ
  
  =cut
  
  sub wraplist {
      my $self = shift;
      return join " \\\n\t", @_;
  }
  
  
  =head3 maketext_filter
  
      my $filter_make_text = $mm->maketext_filter($make_text);
  
  The text of the Makefile is run through this method before writing to
  disk.  It allows systems a chance to make portability fixes to the
  Makefile.
  
  By default it does nothing.
  
  This method is protected and not intended to be called outside of
  MakeMaker.
  
  =cut
  
  sub maketext_filter { return $_[1] }
  
  
  =head3 cd  I<Abstract>
  
    my $subdir_cmd = $MM->cd($subdir, @cmds);
  
  This will generate a make fragment which runs the @cmds in the given
  $dir.  The rough equivalent to this, except cross platform.
  
    cd $subdir && $cmd
  
  Currently $dir can only go down one level.  "foo" is fine.  "foo/bar" is
  not.  "../foo" is right out.
  
  The resulting $subdir_cmd has no leading tab nor trailing newline.  This
  makes it easier to embed in a make string.  For example.
  
        my $make = sprintf <<'CODE', $subdir_cmd;
    foo :
        $(ECHO) what
        %s
        $(ECHO) mouche
    CODE
  
  
  =head3 oneliner  I<Abstract>
  
    my $oneliner = $MM->oneliner($perl_code);
    my $oneliner = $MM->oneliner($perl_code, \@switches);
  
  This will generate a perl one-liner safe for the particular platform
  you're on based on the given $perl_code and @switches (a -e is
  assumed) suitable for using in a make target.  It will use the proper
  shell quoting and escapes.
  
  $(PERLRUN) will be used as perl.
  
  Any newlines in $perl_code will be escaped.  Leading and trailing
  newlines will be stripped.  Makes this idiom much easier:
  
      my $code = $MM->oneliner(<<'CODE', [...switches...]);
  some code here
  another line here
  CODE
  
  Usage might be something like:
  
      # an echo emulation
      $oneliner = $MM->oneliner('print "Foo\n"');
      $make = '$oneliner > somefile';
  
  All dollar signs must be doubled in the $perl_code if you expect them
  to be interpreted normally, otherwise it will be considered a make
  macro.  Also remember to quote make macros else it might be used as a
  bareword.  For example:
  
      # Assign the value of the $(VERSION_FROM) make macro to $vf.
      $oneliner = $MM->oneliner('$$vf = "$(VERSION_FROM)"');
  
  Its currently very simple and may be expanded sometime in the figure
  to include more flexible code and switches.
  
  
  =head3 quote_literal  I<Abstract>
  
      my $safe_text = $MM->quote_literal($text);
      my $safe_text = $MM->quote_literal($text, \%options);
  
  This will quote $text so it is interpreted literally in the shell.
  
  For example, on Unix this would escape any single-quotes in $text and
  put single-quotes around the whole thing.
  
  If $options{allow_variables} is true it will leave C<'$(FOO)'> make
  variables untouched.  If false they will be escaped like any other
  C<$>.  Defaults to true.
  
  =head3 escape_dollarsigns
  
      my $escaped_text = $MM->escape_dollarsigns($text);
  
  Escapes stray C<$> so they are not interpreted as make variables.
  
  It lets by C<$(...)>.
  
  =cut
  
  sub escape_dollarsigns {
      my($self, $text) = @_;
  
      # Escape dollar signs which are not starting a variable
      $text =~ s{\$ (?!\() }{\$\$}gx;
  
      return $text;
  }
  
  
  =head3 escape_all_dollarsigns
  
      my $escaped_text = $MM->escape_all_dollarsigns($text);
  
  Escapes all C<$> so they are not interpreted as make variables.
  
  =cut
  
  sub escape_all_dollarsigns {
      my($self, $text) = @_;
  
      # Escape dollar signs
      $text =~ s{\$}{\$\$}gx;
  
      return $text;
  }
  
  
  =head3 escape_newlines  I<Abstract>
  
      my $escaped_text = $MM->escape_newlines($text);
  
  Shell escapes newlines in $text.
  
  
  =head3 max_exec_len  I<Abstract>
  
      my $max_exec_len = $MM->max_exec_len;
  
  Calculates the maximum command size the OS can exec.  Effectively,
  this is the max size of a shell command line.
  
  =for _private
  $self->{_MAX_EXEC_LEN} is set by this method, but only for testing purposes.
  
  
  =head3 make
  
      my $make = $MM->make;
  
  Returns the make variant we're generating the Makefile for.  This attempts
  to do some normalization on the information from %Config or the user.
  
  =cut
  
  sub make {
      my $self = shift;
  
      my $make = lc $self->{MAKE};
  
      # Truncate anything like foomake6 to just foomake.
      $make =~ s/^(\w+make).*/$1/;
  
      # Turn gnumake into gmake.
      $make =~ s/^gnu/g/;
  
      return $make;
  }
  
  
  =head2 Targets
  
  These are methods which produce make targets.
  
  
  =head3 all_target
  
  Generate the default target 'all'.
  
  =cut
  
  sub all_target {
      my $self = shift;
  
      return <<'MAKE_EXT';
  all :: pure_all
  	$(NOECHO) $(NOOP)
  MAKE_EXT
  
  }
  
  
  =head3 blibdirs_target
  
      my $make_frag = $mm->blibdirs_target;
  
  Creates the blibdirs target which creates all the directories we use
  in blib/.
  
  The blibdirs.ts target is deprecated.  Depend on blibdirs instead.
  
  
  =cut
  
  sub blibdirs_target {
      my $self = shift;
  
      my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib
                                             autodir archautodir
                                             bin script
                                             man1dir man3dir
                                            );
  
      my @exists = map { $_.'$(DFSEP).exists' } @dirs;
  
      my $make = sprintf <<'MAKE', join(' ', @exists);
  blibdirs : %s
  	$(NOECHO) $(NOOP)
  
  # Backwards compat with 6.18 through 6.25
  blibdirs.ts : blibdirs
  	$(NOECHO) $(NOOP)
  
  MAKE
  
      $make .= $self->dir_target(@dirs);
  
      return $make;
  }
  
  
  =head3 clean (o)
  
  Defines the clean target.
  
  =cut
  
  sub clean {
  # --- Cleanup and Distribution Sections ---
  
      my($self, %attribs) = @_;
      my @m;
      push(@m, '
  # Delete temporary files but do not touch installed files. We don\'t delete
  # the Makefile here so a later make realclean still has a makefile to use.
  
  clean :: clean_subdirs
  ');
  
      my @files = sort values %{$self->{XS}}; # .c files from *.xs files
      my @dirs  = qw(blib);
  
      # Normally these are all under blib but they might have been
      # redefined.
      # XXX normally this would be a good idea, but the Perl core sets
      # INST_LIB = ../../lib rather than actually installing the files.
      # So a "make clean" in an ext/ directory would blow away lib.
      # Until the core is adjusted let's leave this out.
  #     push @dirs, qw($(INST_ARCHLIB) $(INST_LIB)
  #                    $(INST_BIN) $(INST_SCRIPT)
  #                    $(INST_MAN1DIR) $(INST_MAN3DIR)
  #                    $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR)
  #                    $(INST_STATIC) $(INST_DYNAMIC)
  #                 );
  
  
      if( $attribs{FILES} ) {
          # Use @dirs because we don't know what's in here.
          push @dirs, ref $attribs{FILES}                ?
                          @{$attribs{FILES}}             :
                          split /\s+/, $attribs{FILES}   ;
      }
  
      push(@files, qw[$(MAKE_APERL_FILE)
                      MYMETA.json MYMETA.yml perlmain.c tmon.out mon.out so_locations
                      blibdirs.ts pm_to_blib pm_to_blib.ts
                      *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT)
                      $(BOOTSTRAP) $(BASEEXT).bso
                      $(BASEEXT).def lib$(BASEEXT).def
                      $(BASEEXT).exp $(BASEEXT).x
                     ]);
  
      push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
      push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld'));
  
      # core files
      if ($^O eq 'vos') {
          push(@files, qw[perl*.kp]);
      }
      else {
          push(@files, qw[core core.*perl.*.? *perl.core]);
      }
  
      push(@files, map { "core." . "[0-9]"x$_ } (1..5));
  
      # OS specific things to clean up.  Use @dirs since we don't know
      # what might be in here.
      push @dirs, $self->extra_clean_files;
  
      # Occasionally files are repeated several times from different sources
      { my(%f) = map { ($_ => 1) } @files; @files = sort keys %f; }
      { my(%d) = map { ($_ => 1) } @dirs;  @dirs  = sort keys %d; }
  
      push @m, map "\t$_\n", $self->split_command('- $(RM_F)',  @files);
      push @m, map "\t$_\n", $self->split_command('- $(RM_RF)', @dirs);
  
      # Leave Makefile.old around for realclean
      push @m, <<'MAKE';
  	  $(NOECHO) $(RM_F) $(MAKEFILE_OLD)
  	- $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
  MAKE
  
      push(@m, "\t$attribs{POSTOP}\n")   if $attribs{POSTOP};
  
      join("", @m);
  }
  
  
  =head3 clean_subdirs_target
  
    my $make_frag = $MM->clean_subdirs_target;
  
  Returns the clean_subdirs target.  This is used by the clean target to
  call clean on any subdirectories which contain Makefiles.
  
  =cut
  
  sub clean_subdirs_target {
      my($self) = shift;
  
      # No subdirectories, no cleaning.
      return <<'NOOP_FRAG' unless @{$self->{DIR}};
  clean_subdirs :
  	$(NOECHO) $(NOOP)
  NOOP_FRAG
  
  
      my $clean = "clean_subdirs :\n";
  
      for my $dir (@{$self->{DIR}}) {
          my $subclean = $self->oneliner(sprintf <<'CODE', $dir);
  exit 0 unless chdir '%s';  system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)';
  CODE
  
          $clean .= "\t$subclean\n";
      }
  
      return $clean;
  }
  
  
  =head3 dir_target
  
      my $make_frag = $mm->dir_target(@directories);
  
  Generates targets to create the specified directories and set its
  permission to PERM_DIR.
  
  Because depending on a directory to just ensure it exists doesn't work
  too well (the modified time changes too often) dir_target() creates a
  .exists file in the created directory.  It is this you should depend on.
  For portability purposes you should use the $(DIRFILESEP) macro rather
  than a '/' to separate the directory from the file.
  
      yourdirectory$(DIRFILESEP).exists
  
  =cut
  
  sub dir_target {
      my($self, @dirs) = @_;
  
      my $make = '';
      foreach my $dir (@dirs) {
          $make .= sprintf <<'MAKE', ($dir) x 4;
  %s$(DFSEP).exists :: Makefile.PL
  	$(NOECHO) $(MKPATH) %s
  	$(NOECHO) $(CHMOD) $(PERM_DIR) %s
  	$(NOECHO) $(TOUCH) %s$(DFSEP).exists
  
  MAKE
  
      }
  
      return $make;
  }
  
  
  =head3 distdir
  
  Defines the scratch directory target that will hold the distribution
  before tar-ing (or shar-ing).
  
  =cut
  
  # For backwards compatibility.
  *dist_dir = *distdir;
  
  sub distdir {
      my($self) = shift;
  
      my $meta_target = $self->{NO_META} ? '' : 'distmeta';
      my $sign_target = !$self->{SIGN}   ? '' : 'distsignature';
  
      return sprintf <<'MAKE_FRAG', $meta_target, $sign_target;
  create_distdir :
  	$(RM_RF) $(DISTVNAME)
  	$(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
  		-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
  
  distdir : create_distdir %s %s
  	$(NOECHO) $(NOOP)
  
  MAKE_FRAG
  
  }
  
  
  =head3 dist_test
  
  Defines a target that produces the distribution in the
  scratch directory, and runs 'perl Makefile.PL; make ;make test' in that
  subdirectory.
  
  =cut
  
  sub dist_test {
      my($self) = shift;
  
      my $mpl_args = join " ", map qq["$_"], @ARGV;
  
      my $test = $self->cd('$(DISTVNAME)',
                           '$(ABSPERLRUN) Makefile.PL '.$mpl_args,
                           '$(MAKE) $(PASTHRU)',
                           '$(MAKE) test $(PASTHRU)'
                          );
  
      return sprintf <<'MAKE_FRAG', $test;
  disttest : distdir
  	%s
  
  MAKE_FRAG
  
  
  }
  
  
  =head3 dynamic (o)
  
  Defines the dynamic target.
  
  =cut
  
  sub dynamic {
  # --- Dynamic Loading Sections ---
  
      my($self) = shift;
      '
  dynamic :: $(FIRST_MAKEFILE) $(BOOTSTRAP) $(INST_DYNAMIC)
  	$(NOECHO) $(NOOP)
  ';
  }
  
  
  =head3 makemakerdflt_target
  
    my $make_frag = $mm->makemakerdflt_target
  
  Returns a make fragment with the makemakerdeflt_target specified.
  This target is the first target in the Makefile, is the default target
  and simply points off to 'all' just in case any make variant gets
  confused or something gets snuck in before the real 'all' target.
  
  =cut
  
  sub makemakerdflt_target {
      return <<'MAKE_FRAG';
  makemakerdflt : all
  	$(NOECHO) $(NOOP)
  MAKE_FRAG
  
  }
  
  
  =head3 manifypods_target
  
    my $manifypods_target = $self->manifypods_target;
  
  Generates the manifypods target.  This target generates man pages from
  all POD files in MAN1PODS and MAN3PODS.
  
  =cut
  
  sub manifypods_target {
      my($self) = shift;
  
      my $man1pods      = '';
      my $man3pods      = '';
      my $dependencies  = '';
  
      # populate manXpods & dependencies:
      foreach my $name (sort keys %{$self->{MAN1PODS}}, sort keys %{$self->{MAN3PODS}}) {
          $dependencies .= " \\\n\t$name";
      }
  
      my $manify = <<END;
  manifypods : pure_all $dependencies
  END
  
      my @man_cmds;
      foreach my $section (qw(1 3)) {
          my $pods = $self->{"MAN${section}PODS"};
          my $p2m = sprintf <<CMD, $] > 5.008 ? " -u" : "";
  	\$(NOECHO) \$(POD2MAN) --section=$section --perm_rw=\$(PERM_RW)%s
  CMD
          push @man_cmds, $self->split_command($p2m, map {($_,$pods->{$_})} sort keys %$pods);
      }
  
      $manify .= "\t\$(NOECHO) \$(NOOP)\n" unless @man_cmds;
      $manify .= join '', map { "$_\n" } @man_cmds;
  
      return $manify;
  }
  
  sub _has_cpan_meta {
      return eval {
        require CPAN::Meta;
        CPAN::Meta->VERSION(2.112150);
        1;
      };
  }
  
  =head3 metafile_target
  
      my $target = $mm->metafile_target;
  
  Generate the metafile target.
  
  Writes the file META.yml (YAML encoded meta-data) and META.json
  (JSON encoded meta-data) about the module in the distdir.
  The format follows Module::Build's as closely as possible.
  
  =cut
  
  sub metafile_target {
      my $self = shift;
      return <<'MAKE_FRAG' if $self->{NO_META} or ! _has_cpan_meta();
  metafile :
  	$(NOECHO) $(NOOP)
  MAKE_FRAG
  
      my %metadata   = $self->metafile_data(
          $self->{META_ADD}   || {},
          $self->{META_MERGE} || {},
      );
  
      _fix_metadata_before_conversion( \%metadata );
  
      # paper over validation issues, but still complain, necessary because
      # there's no guarantee that the above will fix ALL errors
      my $meta = eval { CPAN::Meta->create( \%metadata, { lazy_validation => 1 } ) };
      warn $@ if $@ and
                 $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/;
  
      # use the original metadata straight if the conversion failed
      # or if it can't be stringified.
      if( !$meta                                                  ||
          !eval { $meta->as_string( { version => "1.4" } ) }      ||
          !eval { $meta->as_string }
      )
      {
          $meta = bless \%metadata, 'CPAN::Meta';
      }
  
      my @write_metayml = $self->echo(
        $meta->as_string({version => "1.4"}), 'META_new.yml'
      );
      my @write_metajson = $self->echo(
        $meta->as_string(), 'META_new.json'
      );
  
      my $metayml = join("\n\t", @write_metayml);
      my $metajson = join("\n\t", @write_metajson);
      return sprintf <<'MAKE_FRAG', $metayml, $metajson;
  metafile : create_distdir
  	$(NOECHO) $(ECHO) Generating META.yml
  	%s
  	-$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
  	$(NOECHO) $(ECHO) Generating META.json
  	%s
  	-$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json
  MAKE_FRAG
  
  }
  
  =begin private
  
  =head3 _fix_metadata_before_conversion
  
      _fix_metadata_before_conversion( \%metadata );
  
  Fixes errors in the metadata before it's handed off to CPAN::Meta for
  conversion. This hopefully results in something that can be used further
  on, no guarantee is made though.
  
  =end private
  
  =cut
  
  sub _fix_metadata_before_conversion {
      my ( $metadata ) = @_;
  
      # we should never be called unless this already passed but
      # prefer to be defensive in case somebody else calls this
  
      return unless _has_cpan_meta;
  
      my $bad_version = $metadata->{version} &&
                        !CPAN::Meta::Validator->new->version( 'version', $metadata->{version} );
  
      # just delete all invalid versions
      if( $bad_version ) {
          warn "Can't parse version '$metadata->{version}'\n";
          $metadata->{version} = '';
      }
  
      my $validator = CPAN::Meta::Validator->new( $metadata );
      return if $validator->is_valid;
  
      # fix non-camelcase custom resource keys (only other trick we know)
      for my $error ( $validator->errors ) {
          my ( $key ) = ( $error =~ /Custom resource '(.*)' must be in CamelCase./ );
          next if !$key;
  
          # first try to remove all non-alphabetic chars
          ( my $new_key = $key ) =~ s/[^_a-zA-Z]//g;
  
          # if that doesn't work, uppercase first one
          $new_key = ucfirst $new_key if !$validator->custom_1( $new_key );
  
          # copy to new key if that worked
          $metadata->{resources}{$new_key} = $metadata->{resources}{$key}
            if $validator->custom_1( $new_key );
  
          # and delete old one in any case
          delete $metadata->{resources}{$key};
      }
  
      return;
  }
  
  
  =begin private
  
  =head3 _sort_pairs
  
      my @pairs = _sort_pairs($sort_sub, \%hash);
  
  Sorts the pairs of a hash based on keys ordered according
  to C<$sort_sub>.
  
  =end private
  
  =cut
  
  sub _sort_pairs {
      my $sort  = shift;
      my $pairs = shift;
      return map  { $_ => $pairs->{$_} }
             sort $sort
             keys %$pairs;
  }
  
  
  # Taken from Module::Build::Base
  sub _hash_merge {
      my ($self, $h, $k, $v) = @_;
      if (ref $h->{$k} eq 'ARRAY') {
          push @{$h->{$k}}, ref $v ? @$v : $v;
      } elsif (ref $h->{$k} eq 'HASH') {
          $self->_hash_merge($h->{$k}, $_, $v->{$_}) foreach keys %$v;
      } else {
          $h->{$k} = $v;
      }
  }
  
  
  =head3 metafile_data
  
      my @metadata_pairs = $mm->metafile_data(\%meta_add, \%meta_merge);
  
  Returns the data which MakeMaker turns into the META.yml file 
  and the META.json file.
  
  Values of %meta_add will overwrite any existing metadata in those
  keys.  %meta_merge will be merged with them.
  
  =cut
  
  sub metafile_data {
      my $self = shift;
      my($meta_add, $meta_merge) = @_;
  
      my %meta = (
          # required
          name         => $self->{DISTNAME},
          version      => _normalize_version($self->{VERSION}),
          abstract     => $self->{ABSTRACT} || 'unknown',
          license      => $self->{LICENSE} || 'unknown',
          dynamic_config => 1,
  
          # optional
          distribution_type => $self->{PM} ? 'module' : 'script',
  
          no_index     => {
              directory   => [qw(t inc)]
          },
  
          generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION",
          'meta-spec'  => {
              url         => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
              version     => 1.4
          },
      );
  
      # The author key is required and it takes a list.
      $meta{author}   = defined $self->{AUTHOR}    ? $self->{AUTHOR} : [];
  
      {
        my $vers = _metaspec_version( $meta_add, $meta_merge );
        my $method = $vers =~ m!^2!
                 ? '_add_requirements_to_meta_v2'
                 : '_add_requirements_to_meta_v1_4';
        %meta = $self->$method( %meta );
      }
  
      while( my($key, $val) = each %$meta_add ) {
          $meta{$key} = $val;
      }
  
      while( my($key, $val) = each %$meta_merge ) {
          $self->_hash_merge(\%meta, $key, $val);
      }
  
      return %meta;
  }
  
  
  =begin private
  
  =cut
  
  sub _metaspec_version {
    my ( $meta_add, $meta_merge ) = @_;
    return $meta_add->{'meta-spec'}->{version}
      if defined $meta_add->{'meta-spec'}
         and defined $meta_add->{'meta-spec'}->{version};
    return $meta_merge->{'meta-spec'}->{version}
      if defined $meta_merge->{'meta-spec'}
         and  defined $meta_merge->{'meta-spec'}->{version};
    return '1.4';
  }
  
  sub _add_requirements_to_meta_v1_4 {
      my ( $self, %meta ) = @_;
  
      # Check the original args so we can tell between the user setting it
      # to an empty hash and it just being initialized.
      if( $self->{ARGS}{CONFIGURE_REQUIRES} ) {
          $meta{configure_requires} = $self->{CONFIGURE_REQUIRES};
      } else {
          $meta{configure_requires} = {
              'ExtUtils::MakeMaker'       => 0,
          };
      }
  
      if( $self->{ARGS}{BUILD_REQUIRES} ) {
          $meta{build_requires} = $self->{BUILD_REQUIRES};
      } else {
          $meta{build_requires} = {
              'ExtUtils::MakeMaker'       => 0,
          };
      }
  
      if( $self->{ARGS}{TEST_REQUIRES} ) {
          $meta{build_requires} = {
            %{ $meta{build_requires} },
            %{ $self->{TEST_REQUIRES} },
          };
      }
  
      $meta{requires} = $self->{PREREQ_PM}
          if defined $self->{PREREQ_PM};
      $meta{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION})
          if $self->{MIN_PERL_VERSION};
  
      return %meta;
  }
  
  sub _add_requirements_to_meta_v2 {
      my ( $self, %meta ) = @_;
  
      # Check the original args so we can tell between the user setting it
      # to an empty hash and it just being initialized.
      if( $self->{ARGS}{CONFIGURE_REQUIRES} ) {
          $meta{prereqs}{configure}{requires} = $self->{CONFIGURE_REQUIRES};
      } else {
          $meta{prereqs}{configure}{requires} = {
              'ExtUtils::MakeMaker'       => 0,
          };
      }
  
      if( $self->{ARGS}{BUILD_REQUIRES} ) {
          $meta{prereqs}{build}{requires} = $self->{BUILD_REQUIRES};
      } else {
          $meta{prereqs}{build}{requires} = {
              'ExtUtils::MakeMaker'       => 0,
          };
      }
  
      if( $self->{ARGS}{TEST_REQUIRES} ) {
          $meta{prereqs}{test}{requires} = $self->{TEST_REQUIRES};
      }
  
      $meta{prereqs}{runtime}{requires} = $self->{PREREQ_PM}
          if $self->{ARGS}{PREREQ_PM};
      $meta{prereqs}{runtime}{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION})
          if $self->{MIN_PERL_VERSION};
  
      return %meta;
  }
  
  # Adapted from Module::Build::Base
  sub _normalize_version {
    my ($version) = @_;
    $version = 0 unless defined $version;
  
    if ( 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;
  }
  
  =head3 _dump_hash
  
      $yaml = _dump_hash(\%options, %hash);
  
  Implements a fake YAML dumper for a hash given
  as a list of pairs. No quoting/escaping is done. Keys
  are supposed to be strings. Values are undef, strings,
  hash refs or array refs of strings.
  
  Supported options are:
  
      delta => STR - indentation delta
      use_header => BOOL - whether to include a YAML header
      indent => STR - a string of spaces
            default: ''
  
      max_key_length => INT - maximum key length used to align
          keys and values of the same hash
          default: 20
      key_sort => CODE - a sort sub
              It may be undef, which means no sorting by keys
          default: sub { lc $a cmp lc $b }
  
      customs => HASH - special options for certain keys
             (whose values are hashes themselves)
          may contain: max_key_length, key_sort, customs
  
  =end private
  
  =cut
  
  sub _dump_hash {
      croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH';
      my $options = shift;
      my %hash = @_;
  
      # Use a list to preserve order.
      my @pairs;
  
      my $k_sort
          = exists $options->{key_sort} ? $options->{key_sort}
                                        : sub { lc $a cmp lc $b };
      if ($k_sort) {
          croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE';
          @pairs = _sort_pairs($k_sort, \%hash);
      } else { # list of pairs, no sorting
          @pairs = @_;
      }
  
      my $yaml     = $options->{use_header} ? "--- #YAML:1.0\n" : '';
      my $indent   = $options->{indent} || '';
      my $k_length = min(
          ($options->{max_key_length} || 20),
          max(map { length($_) + 1 } grep { !ref $hash{$_} } keys %hash)
      );
      my $customs  = $options->{customs} || {};
  
      # printf format for key
      my $k_format = "%-${k_length}s";
  
      while( @pairs ) {
          my($key, $val) = splice @pairs, 0, 2;
          $val = '~' unless defined $val;
          if(ref $val eq 'HASH') {
              if ( keys %$val ) {
                  my %k_options = ( # options for recursive call
                      delta => $options->{delta},
                      use_header => 0,
                      indent => $indent . $options->{delta},
                  );
                  if (exists $customs->{$key}) {
                      my %k_custom = %{$customs->{$key}};
                      foreach my $k (qw(key_sort max_key_length customs)) {
                          $k_options{$k} = $k_custom{$k} if exists $k_custom{$k};
                      }
                  }
                  $yaml .= $indent . "$key:\n"
                    . _dump_hash(\%k_options, %$val);
              }
              else {
                  $yaml .= $indent . "$key:  {}\n";
              }
          }
          elsif (ref $val eq 'ARRAY') {
              if( @$val ) {
                  $yaml .= $indent . "$key:\n";
  
                  for (@$val) {
                      croak "only nested arrays of non-refs are supported" if ref $_;
                      $yaml .= $indent . $options->{delta} . "- $_\n";
                  }
              }
              else {
                  $yaml .= $indent . "$key:  []\n";
              }
          }
          elsif( ref $val and !blessed($val) ) {
              croak "only nested hashes, arrays and objects are supported";
          }
          else {  # if it's an object, just stringify it
              $yaml .= $indent . sprintf "$k_format  %s\n", "$key:", $val;
          }
      };
  
      return $yaml;
  
  }
  
  sub blessed {
      return eval { $_[0]->isa("UNIVERSAL"); };
  }
  
  sub max {
      return (sort { $b <=> $a } @_)[0];
  }
  
  sub min {
      return (sort { $a <=> $b } @_)[0];
  }
  
  =head3 metafile_file
  
      my $meta_yml = $mm->metafile_file(@metadata_pairs);
  
  Turns the @metadata_pairs into YAML.
  
  This method does not implement a complete YAML dumper, being limited
  to dump a hash with values which are strings, undef's or nested hashes
  and arrays of strings. No quoting/escaping is done.
  
  =cut
  
  sub metafile_file {
      my $self = shift;
  
      my %dump_options = (
          use_header => 1,
          delta      => ' ' x 4,
          key_sort   => undef,
      );
      return _dump_hash(\%dump_options, @_);
  
  }
  
  
  =head3 distmeta_target
  
      my $make_frag = $mm->distmeta_target;
  
  Generates the distmeta target to add META.yml and META.json to the MANIFEST
  in the distdir.
  
  =cut
  
  sub distmeta_target {
      my $self = shift;
  
      my @add_meta = (
        $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']),
  exit unless -e q{META.yml};
  eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }
      or print "Could not add META.yml to MANIFEST: $${'@'}\n"
  CODE
        $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd'])
  exit unless -f q{META.json};
  eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }
      or print "Could not add META.json to MANIFEST: $${'@'}\n"
  CODE
      );
  
      my @add_meta_to_distdir = map { $self->cd('$(DISTVNAME)', $_) } @add_meta;
  
      return sprintf <<'MAKE', @add_meta_to_distdir;
  distmeta : create_distdir metafile
  	$(NOECHO) %s
  	$(NOECHO) %s
  
  MAKE
  
  }
  
  
  =head3 mymeta
  
      my $mymeta = $mm->mymeta;
  
  Generate MYMETA information as a hash either from an existing CPAN Meta file
  (META.json or META.yml) or from internal data.
  
  =cut
  
  sub mymeta {
      my $self = shift;
      my $file = shift || ''; # for testing
  
      my $mymeta = $self->_mymeta_from_meta($file);
      my $v2 = 1;
  
      unless ( $mymeta ) {
          my @metadata = $self->metafile_data(
              $self->{META_ADD}   || {},
              $self->{META_MERGE} || {},
          );
          $mymeta = {@metadata};
          $v2 = 0;
      }
  
      # Overwrite the non-configure dependency hashes
  
      my $method = $v2
                 ? '_add_requirements_to_meta_v2'
                 : '_add_requirements_to_meta_v1_4';
  
      $mymeta = { $self->$method( %$mymeta ) };
  
      $mymeta->{dynamic_config} = 0;
  
      return $mymeta;
  }
  
  
  sub _mymeta_from_meta {
      my $self = shift;
      my $metafile = shift || ''; # for testing
  
      return unless _has_cpan_meta();
  
      my $meta;
      for my $file ( $metafile, "META.json", "META.yml" ) {
        next unless -e $file;
        eval {
            $meta = CPAN::Meta->load_file($file)->as_struct( { version => 2 } );
        };
        last if $meta;
      }
      return unless $meta;
  
      # META.yml before 6.25_01 cannot be trusted.  META.yml lived in the source directory.
      # There was a good chance the author accidentally uploaded a stale META.yml if they
      # rolled their own tarball rather than using "make dist".
      if ($meta->{generated_by} &&
          $meta->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
          my $eummv = do { local $^W = 0; $1+0; };
          if ($eummv < 6.2501) {
              return;
          }
      }
  
      return $meta;
  }
  
  =head3 write_mymeta
  
      $self->write_mymeta( $mymeta );
  
  Write MYMETA information to MYMETA.json and MYMETA.yml.
  
  =cut
  
  sub write_mymeta {
      my $self = shift;
      my $mymeta = shift;
  
      return unless _has_cpan_meta();
  
      _fix_metadata_before_conversion( $mymeta );
  
      # this can still blow up
      # not sure if i should just eval this and skip file creation if it
      # blows up
      my $meta_obj = CPAN::Meta->new( $mymeta, { lazy_validation => 1 } );
      $meta_obj->save( 'MYMETA.json' );
      $meta_obj->save( 'MYMETA.yml', { version => "1.4" } );
      return 1;
  }
  
  =head3 realclean (o)
  
  Defines the realclean target.
  
  =cut
  
  sub realclean {
      my($self, %attribs) = @_;
  
      my @dirs  = qw($(DISTVNAME));
      my @files = qw($(FIRST_MAKEFILE) $(MAKEFILE_OLD));
  
      # Special exception for the perl core where INST_* is not in blib.
      # This cleans up the files built from the ext/ directory (all XS).
      if( $self->{PERL_CORE} ) {
          push @dirs, qw($(INST_AUTODIR) $(INST_ARCHAUTODIR));
          push @files, values %{$self->{PM}};
      }
  
      if( $self->has_link_code ){
          push @files, qw($(OBJECT));
      }
  
      if( $attribs{FILES} ) {
          if( ref $attribs{FILES} ) {
              push @dirs, @{ $attribs{FILES} };
          }
          else {
              push @dirs, split /\s+/, $attribs{FILES};
          }
      }
  
      # Occasionally files are repeated several times from different sources
      { my(%f) = map { ($_ => 1) } @files;  @files = keys %f; }
      { my(%d) = map { ($_ => 1) } @dirs;   @dirs  = keys %d; }
  
      my $rm_cmd  = join "\n\t", map { "$_" }
                      $self->split_command('- $(RM_F)',  @files);
      my $rmf_cmd = join "\n\t", map { "$_" }
                      $self->split_command('- $(RM_RF)', @dirs);
  
      my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd;
  # Delete temporary files (via clean) and also delete dist files
  realclean purge ::  clean realclean_subdirs
  	%s
  	%s
  MAKE
  
      $m .= "\t$attribs{POSTOP}\n" if $attribs{POSTOP};
  
      return $m;
  }
  
  
  =head3 realclean_subdirs_target
  
    my $make_frag = $MM->realclean_subdirs_target;
  
  Returns the realclean_subdirs target.  This is used by the realclean
  target to call realclean on any subdirectories which contain Makefiles.
  
  =cut
  
  sub realclean_subdirs_target {
      my $self = shift;
  
      return <<'NOOP_FRAG' unless @{$self->{DIR}};
  realclean_subdirs :
  	$(NOECHO) $(NOOP)
  NOOP_FRAG
  
      my $rclean = "realclean_subdirs :\n";
  
      foreach my $dir (@{$self->{DIR}}) {
          foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) {
              my $subrclean .= $self->oneliner(sprintf <<'CODE', $dir, ($makefile) x 2);
  chdir '%s';  system '$(MAKE) $(USEMAKEFILE) %s realclean' if -f '%s';
  CODE
  
              $rclean .= sprintf <<'RCLEAN', $subrclean;
  	- %s
  RCLEAN
  
          }
      }
  
      return $rclean;
  }
  
  
  =head3 signature_target
  
      my $target = $mm->signature_target;
  
  Generate the signature target.
  
  Writes the file SIGNATURE with "cpansign -s".
  
  =cut
  
  sub signature_target {
      my $self = shift;
  
      return <<'MAKE_FRAG';
  signature :
  	cpansign -s
  MAKE_FRAG
  
  }
  
  
  =head3 distsignature_target
  
      my $make_frag = $mm->distsignature_target;
  
  Generates the distsignature target to add SIGNATURE to the MANIFEST in the
  distdir.
  
  =cut
  
  sub distsignature_target {
      my $self = shift;
  
      my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']);
  eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) }
      or print "Could not add SIGNATURE to MANIFEST: $${'@'}\n"
  CODE
  
      my $sign_dist        = $self->cd('$(DISTVNAME)' => 'cpansign -s');
  
      # cpansign -s complains if SIGNATURE is in the MANIFEST yet does not
      # exist
      my $touch_sig        = $self->cd('$(DISTVNAME)' => '$(TOUCH) SIGNATURE');
      my $add_sign_to_dist = $self->cd('$(DISTVNAME)' => $add_sign );
  
      return sprintf <<'MAKE', $add_sign_to_dist, $touch_sig, $sign_dist
  distsignature : create_distdir
  	$(NOECHO) %s
  	$(NOECHO) %s
  	%s
  
  MAKE
  
  }
  
  
  =head3 special_targets
  
    my $make_frag = $mm->special_targets
  
  Returns a make fragment containing any targets which have special
  meaning to make.  For example, .SUFFIXES and .PHONY.
  
  =cut
  
  sub special_targets {
      my $make_frag = <<'MAKE_FRAG';
  .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
  
  .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
  
  MAKE_FRAG
  
      $make_frag .= <<'MAKE_FRAG' if $ENV{CLEARCASE_ROOT};
  .NO_CONFIG_REC: Makefile
  
  MAKE_FRAG
  
      return $make_frag;
  }
  
  
  
  
  =head2 Init methods
  
  Methods which help initialize the MakeMaker object and macros.
  
  
  =head3 init_ABSTRACT
  
      $mm->init_ABSTRACT
  
  =cut
  
  sub init_ABSTRACT {
      my $self = shift;
  
      if( $self->{ABSTRACT_FROM} and $self->{ABSTRACT} ) {
          warn "Both ABSTRACT_FROM and ABSTRACT are set.  ".
               "Ignoring ABSTRACT_FROM.\n";
          return;
      }
  
      if ($self->{ABSTRACT_FROM}){
          $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or
              carp "WARNING: Setting ABSTRACT via file ".
                   "'$self->{ABSTRACT_FROM}' failed\n";
      }
  
      if ($self->{ABSTRACT} && $self->{ABSTRACT} =~ m![[:cntrl:]]+!) {
              warn "WARNING: ABSTRACT contains control character(s),".
                   " they will be removed\n";
              $self->{ABSTRACT} =~ s![[:cntrl:]]+!!g;
              return;
      }
  }
  
  =head3 init_INST
  
      $mm->init_INST;
  
  Called by init_main.  Sets up all INST_* variables except those related
  to XS code.  Those are handled in init_xs.
  
  =cut
  
  sub init_INST {
      my($self) = shift;
  
      $self->{INST_ARCHLIB} ||= $self->catdir($Curdir,"blib","arch");
      $self->{INST_BIN}     ||= $self->catdir($Curdir,'blib','bin');
  
      # INST_LIB typically pre-set if building an extension after
      # perl has been built and installed. Setting INST_LIB allows
      # you to build directly into, say $Config{privlibexp}.
      unless ($self->{INST_LIB}){
          if ($self->{PERL_CORE}) {
              $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
          } else {
              $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib");
          }
      }
  
      my @parentdir = split(/::/, $self->{PARENT_NAME});
      $self->{INST_LIBDIR}      = $self->catdir('$(INST_LIB)',     @parentdir);
      $self->{INST_ARCHLIBDIR}  = $self->catdir('$(INST_ARCHLIB)', @parentdir);
      $self->{INST_AUTODIR}     = $self->catdir('$(INST_LIB)', 'auto',
                                                '$(FULLEXT)');
      $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto',
                                                '$(FULLEXT)');
  
      $self->{INST_SCRIPT}  ||= $self->catdir($Curdir,'blib','script');
  
      $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1');
      $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3');
  
      return 1;
  }
  
  
  =head3 init_INSTALL
  
      $mm->init_INSTALL;
  
  Called by init_main.  Sets up all INSTALL_* variables (except
  INSTALLDIRS) and *PREFIX.
  
  =cut
  
  sub init_INSTALL {
      my($self) = shift;
  
      if( $self->{ARGS}{INSTALL_BASE} and $self->{ARGS}{PREFIX} ) {
          die "Only one of PREFIX or INSTALL_BASE can be given.  Not both.\n";
      }
  
      if( $self->{ARGS}{INSTALL_BASE} ) {
          $self->init_INSTALL_from_INSTALL_BASE;
      }
      else {
          $self->init_INSTALL_from_PREFIX;
      }
  }
  
  
  =head3 init_INSTALL_from_PREFIX
  
    $mm->init_INSTALL_from_PREFIX;
  
  =cut
  
  sub init_INSTALL_from_PREFIX {
      my $self = shift;
  
      $self->init_lib2arch;
  
      # There are often no Config.pm defaults for these new man variables so
      # we fall back to the old behavior which is to use installman*dir
      foreach my $num (1, 3) {
          my $k = 'installsiteman'.$num.'dir';
  
          $self->{uc $k} ||= uc "\$(installman${num}dir)"
            unless $Config{$k};
      }
  
      foreach my $num (1, 3) {
          my $k = 'installvendorman'.$num.'dir';
  
          unless( $Config{$k} ) {
              $self->{uc $k}  ||= $Config{usevendorprefix}
                                ? uc "\$(installman${num}dir)"
                                : '';
          }
      }
  
      $self->{INSTALLSITEBIN} ||= '$(INSTALLBIN)'
        unless $Config{installsitebin};
      $self->{INSTALLSITESCRIPT} ||= '$(INSTALLSCRIPT)'
        unless $Config{installsitescript};
  
      unless( $Config{installvendorbin} ) {
          $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix}
                                      ? $Config{installbin}
                                      : '';
      }
      unless( $Config{installvendorscript} ) {
          $self->{INSTALLVENDORSCRIPT} ||= $Config{usevendorprefix}
                                         ? $Config{installscript}
                                         : '';
      }
  
  
      my $iprefix = $Config{installprefixexp} || $Config{installprefix} ||
                    $Config{prefixexp}        || $Config{prefix} || '';
      my $vprefix = $Config{usevendorprefix}  ? $Config{vendorprefixexp} : '';
      my $sprefix = $Config{siteprefixexp}    || '';
  
      # 5.005_03 doesn't have a siteprefix.
      $sprefix = $iprefix unless $sprefix;
  
  
      $self->{PREFIX}       ||= '';
  
      if( $self->{PREFIX} ) {
          @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} =
            ('$(PREFIX)') x 3;
      }
      else {
          $self->{PERLPREFIX}   ||= $iprefix;
          $self->{SITEPREFIX}   ||= $sprefix;
          $self->{VENDORPREFIX} ||= $vprefix;
  
          # Lots of MM extension authors like to use $(PREFIX) so we
          # put something sensible in there no matter what.
          $self->{PREFIX} = '$('.uc $self->{INSTALLDIRS}.'PREFIX)';
      }
  
      my $arch    = $Config{archname};
      my $version = $Config{version};
  
      # default style
      my $libstyle = $Config{installstyle} || 'lib/perl5';
      my $manstyle = '';
  
      if( $self->{LIBSTYLE} ) {
          $libstyle = $self->{LIBSTYLE};
          $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : '';
      }
  
      # Some systems, like VOS, set installman*dir to '' if they can't
      # read man pages.
      for my $num (1, 3) {
          $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none'
            unless $Config{'installman'.$num.'dir'};
      }
  
      my %bin_layouts =
      (
          bin         => { s => $iprefix,
                           t => 'perl',
                           d => 'bin' },
          vendorbin   => { s => $vprefix,
                           t => 'vendor',
                           d => 'bin' },
          sitebin     => { s => $sprefix,
                           t => 'site',
                           d => 'bin' },
          script      => { s => $iprefix,
                           t => 'perl',
                           d => 'bin' },
          vendorscript=> { s => $vprefix,
                           t => 'vendor',
                           d => 'bin' },
          sitescript  => { s => $sprefix,
                           t => 'site',
                           d => 'bin' },
      );
  
      my %man_layouts =
      (
          man1dir         => { s => $iprefix,
                               t => 'perl',
                               d => 'man/man1',
                               style => $manstyle, },
          siteman1dir     => { s => $sprefix,
                               t => 'site',
                               d => 'man/man1',
                               style => $manstyle, },
          vendorman1dir   => { s => $vprefix,
                               t => 'vendor',
                               d => 'man/man1',
                               style => $manstyle, },
  
          man3dir         => { s => $iprefix,
                               t => 'perl',
                               d => 'man/man3',
                               style => $manstyle, },
          siteman3dir     => { s => $sprefix,
                               t => 'site',
                               d => 'man/man3',
                               style => $manstyle, },
          vendorman3dir   => { s => $vprefix,
                               t => 'vendor',
                               d => 'man/man3',
                               style => $manstyle, },
      );
  
      my %lib_layouts =
      (
          privlib     => { s => $iprefix,
                           t => 'perl',
                           d => '',
                           style => $libstyle, },
          vendorlib   => { s => $vprefix,
                           t => 'vendor',
                           d => '',
                           style => $libstyle, },
          sitelib     => { s => $sprefix,
                           t => 'site',
                           d => 'site_perl',
                           style => $libstyle, },
  
          archlib     => { s => $iprefix,
                           t => 'perl',
                           d => "$version/$arch",
                           style => $libstyle },
          vendorarch  => { s => $vprefix,
                           t => 'vendor',
                           d => "$version/$arch",
                           style => $libstyle },
          sitearch    => { s => $sprefix,
                           t => 'site',
                           d => "site_perl/$version/$arch",
                           style => $libstyle },
      );
  
  
      # Special case for LIB.
      if( $self->{LIB} ) {
          foreach my $var (keys %lib_layouts) {
              my $Installvar = uc "install$var";
  
              if( $var =~ /arch/ ) {
                  $self->{$Installvar} ||=
                    $self->catdir($self->{LIB}, $Config{archname});
              }
              else {
                  $self->{$Installvar} ||= $self->{LIB};
              }
          }
      }
  
      my %type2prefix = ( perl    => 'PERLPREFIX',
                          site    => 'SITEPREFIX',
                          vendor  => 'VENDORPREFIX'
                        );
  
      my %layouts = (%bin_layouts, %man_layouts, %lib_layouts);
      while( my($var, $layout) = each(%layouts) ) {
          my($s, $t, $d, $style) = @{$layout}{qw(s t d style)};
          my $r = '$('.$type2prefix{$t}.')';
  
          warn "Prefixing $var\n" if $Verbose >= 2;
  
          my $installvar = "install$var";
          my $Installvar = uc $installvar;
          next if $self->{$Installvar};
  
          $d = "$style/$d" if $style;
          $self->prefixify($installvar, $s, $r, $d);
  
          warn "  $Installvar == $self->{$Installvar}\n"
            if $Verbose >= 2;
      }
  
      # Generate these if they weren't figured out.
      $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH};
      $self->{VENDORLIBEXP}  ||= $self->{INSTALLVENDORLIB};
  
      return 1;
  }
  
  
  =head3 init_from_INSTALL_BASE
  
      $mm->init_from_INSTALL_BASE
  
  =cut
  
  my %map = (
             lib      => [qw(lib perl5)],
             arch     => [('lib', 'perl5', $Config{archname})],
             bin      => [qw(bin)],
             man1dir  => [qw(man man1)],
             man3dir  => [qw(man man3)]
            );
  $map{script} = $map{bin};
  
  sub init_INSTALL_from_INSTALL_BASE {
      my $self = shift;
  
      @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} =
                                                           '$(INSTALL_BASE)';
  
      my %install;
      foreach my $thing (keys %map) {
          foreach my $dir (('', 'SITE', 'VENDOR')) {
              my $uc_thing = uc $thing;
              my $key = "INSTALL".$dir.$uc_thing;
  
              $install{$key} ||=
                $self->catdir('$(INSTALL_BASE)', @{$map{$thing}});
          }
      }
  
      # Adjust for variable quirks.
      $install{INSTALLARCHLIB} ||= delete $install{INSTALLARCH};
      $install{INSTALLPRIVLIB} ||= delete $install{INSTALLLIB};
  
      foreach my $key (keys %install) {
          $self->{$key} ||= $install{$key};
      }
  
      return 1;
  }
  
  
  =head3 init_VERSION  I<Abstract>
  
      $mm->init_VERSION
  
  Initialize macros representing versions of MakeMaker and other tools
  
  MAKEMAKER: path to the MakeMaker module.
  
  MM_VERSION: ExtUtils::MakeMaker Version
  
  MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards
               compat)
  
  VERSION: version of your module
  
  VERSION_MACRO: which macro represents the version (usually 'VERSION')
  
  VERSION_SYM: like version but safe for use as an RCS revision number
  
  DEFINE_VERSION: -D line to set the module version when compiling
  
  XS_VERSION: version in your .xs file.  Defaults to $(VERSION)
  
  XS_VERSION_MACRO: which macro represents the XS version.
  
  XS_DEFINE_VERSION: -D line to set the xs version when compiling.
  
  Called by init_main.
  
  =cut
  
  sub init_VERSION {
      my($self) = shift;
  
      $self->{MAKEMAKER}  = $ExtUtils::MakeMaker::Filename;
      $self->{MM_VERSION} = $ExtUtils::MakeMaker::VERSION;
      $self->{MM_REVISION}= $ExtUtils::MakeMaker::Revision;
      $self->{VERSION_FROM} ||= '';
  
      if ($self->{VERSION_FROM}){
          $self->{VERSION} = $self->parse_version($self->{VERSION_FROM});
          if( $self->{VERSION} eq 'undef' ) {
              carp("WARNING: Setting VERSION via file ".
                   "'$self->{VERSION_FROM}' failed\n");
          }
      }
  
      if (defined $self->{VERSION}) {
          if ( $self->{VERSION} !~ /^\s*v?[\d_\.]+\s*$/ ) {
            require version;
            my $normal = eval { version->new( $self->{VERSION} ) };
            $self->{VERSION} = $normal if defined $normal;
          }
          $self->{VERSION} =~ s/^\s+//;
          $self->{VERSION} =~ s/\s+$//;
      }
      else {
          $self->{VERSION} = '';
      }
  
  
      $self->{VERSION_MACRO}  = 'VERSION';
      ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g;
      $self->{DEFINE_VERSION} = '-D$(VERSION_MACRO)=\"$(VERSION)\"';
  
  
      # Graham Barr and Paul Marquess had some ideas how to ensure
      # version compatibility between the *.pm file and the
      # corresponding *.xs file. The bottom line was, that we need an
      # XS_VERSION macro that defaults to VERSION:
      $self->{XS_VERSION} ||= $self->{VERSION};
  
      $self->{XS_VERSION_MACRO}  = 'XS_VERSION';
      $self->{XS_DEFINE_VERSION} = '-D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"';
  
  }
  
  
  =head3 init_tools
  
      $MM->init_tools();
  
  Initializes the simple macro definitions used by tools_other() and
  places them in the $MM object.  These use conservative cross platform
  versions and should be overridden with platform specific versions for
  performance.
  
  Defines at least these macros.
  
    Macro             Description
  
    NOOP              Do nothing
    NOECHO            Tell make not to display the command itself
  
    SHELL             Program used to run shell commands
  
    ECHO              Print text adding a newline on the end
    RM_F              Remove a file
    RM_RF             Remove a directory
    TOUCH             Update a file's timestamp
    TEST_F            Test for a file's existence
    TEST_S            Test the size of a file
    CP                Copy a file
    CP_NONEMPTY       Copy a file if it is not empty
    MV                Move a file
    CHMOD             Change permissions on a file
    FALSE             Exit with non-zero
    TRUE              Exit with zero
  
    UMASK_NULL        Nullify umask
    DEV_NULL          Suppress all command output
  
  =cut
  
  sub init_tools {
      my $self = shift;
  
      $self->{ECHO}     ||= $self->oneliner('binmode STDOUT, qq{:raw}; print qq{@ARGV}', ['-l']);
      $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');
  
      $self->{TOUCH}    ||= $self->oneliner('touch', ["-MExtUtils::Command"]);
      $self->{CHMOD}    ||= $self->oneliner('chmod', ["-MExtUtils::Command"]);
      $self->{RM_F}     ||= $self->oneliner('rm_f',  ["-MExtUtils::Command"]);
      $self->{RM_RF}    ||= $self->oneliner('rm_rf', ["-MExtUtils::Command"]);
      $self->{TEST_F}   ||= $self->oneliner('test_f', ["-MExtUtils::Command"]);
      $self->{TEST_S}   ||= $self->oneliner('test_s', ["-MExtUtils::Command::MM"]);
      $self->{CP_NONEMPTY} ||= $self->oneliner('cp_nonempty', ["-MExtUtils::Command::MM"]);
      $self->{FALSE}    ||= $self->oneliner('exit 1');
      $self->{TRUE}     ||= $self->oneliner('exit 0');
  
      $self->{MKPATH}   ||= $self->oneliner('mkpath', ["-MExtUtils::Command"]);
  
      $self->{CP}       ||= $self->oneliner('cp', ["-MExtUtils::Command"]);
      $self->{MV}       ||= $self->oneliner('mv', ["-MExtUtils::Command"]);
  
      $self->{MOD_INSTALL} ||=
        $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
  install([ from_to => {@ARGV}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]);
  CODE
      $self->{DOC_INSTALL} ||= $self->oneliner('perllocal_install', ["-MExtUtils::Command::MM"]);
      $self->{UNINSTALL}   ||= $self->oneliner('uninstall', ["-MExtUtils::Command::MM"]);
      $self->{WARN_IF_OLD_PACKLIST} ||=
        $self->oneliner('warn_if_old_packlist', ["-MExtUtils::Command::MM"]);
      $self->{FIXIN}       ||= $self->oneliner('MY->fixin(shift)', ["-MExtUtils::MY"]);
      $self->{EQUALIZE_TIMESTAMP} ||= $self->oneliner('eqtime', ["-MExtUtils::Command"]);
  
      $self->{UNINST}     ||= 0;
      $self->{VERBINST}   ||= 0;
  
      $self->{SHELL}              ||= $Config{sh};
  
      # UMASK_NULL is not used by MakeMaker but some CPAN modules
      # make use of it.
      $self->{UMASK_NULL}         ||= "umask 0";
  
      # Not the greatest default, but its something.
      $self->{DEV_NULL}           ||= "> /dev/null 2>&1";
  
      $self->{NOOP}               ||= '$(TRUE)';
      $self->{NOECHO}             = '@' unless defined $self->{NOECHO};
  
      $self->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE} || 'Makefile';
      $self->{MAKEFILE}           ||= $self->{FIRST_MAKEFILE};
      $self->{MAKEFILE_OLD}       ||= $self->{MAKEFILE}.'.old';
      $self->{MAKE_APERL_FILE}    ||= $self->{MAKEFILE}.'.aperl';
  
      # Not everybody uses -f to indicate "use this Makefile instead"
      $self->{USEMAKEFILE}        ||= '-f';
  
      # Some makes require a wrapper around macros passed in on the command
      # line.
      $self->{MACROSTART}         ||= '';
      $self->{MACROEND}           ||= '';
  
      return;
  }
  
  
  =head3 init_others
  
      $MM->init_others();
  
  Initializes the macro definitions having to do with compiling and
  linking used by tools_other() and places them in the $MM object.
  
  If there is no description, its the same as the parameter to
  WriteMakefile() documented in ExtUtils::MakeMaker.
  
  =cut
  
  sub init_others {
      my $self = shift;
  
      $self->{LD_RUN_PATH} = "";
  
      $self->{LIBS} = $self->_fix_libs($self->{LIBS});
  
      # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS}
      foreach my $libs ( @{$self->{LIBS}} ){
          $libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace
          my(@libs) = $self->extliblist($libs);
          if ($libs[0] or $libs[1] or $libs[2]){
              # LD_RUN_PATH now computed by ExtUtils::Liblist
              ($self->{EXTRALIBS},  $self->{BSLOADLIBS},
               $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs;
              last;
          }
      }
  
      if ( $self->{OBJECT} ) {
          $self->{OBJECT} = join(" ", @{$self->{OBJECT}}) if ref $self->{OBJECT};
          $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g;
      } elsif ( $self->{MAGICXS} && @{$self->{O_FILES}||[]} ) {
          $self->{OBJECT} = join(" ", @{$self->{O_FILES}});
          $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g;
      } else {
          # init_dirscan should have found out, if we have C files
          $self->{OBJECT} = "";
          $self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]};
      }
      $self->{OBJECT} =~ s/\n+/ \\\n\t/g;
  
      $self->{BOOTDEP}  = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : "";
      $self->{PERLMAINCC} ||= '$(CC)';
      $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM};
  
      # Sanity check: don't define LINKTYPE = dynamic if we're skipping
      # the 'dynamic' section of MM.  We don't have this problem with
      # 'static', since we either must use it (%Config says we can't
      # use dynamic loading) or the caller asked for it explicitly.
      if (!$self->{LINKTYPE}) {
         $self->{LINKTYPE} = $self->{SKIPHASH}{'dynamic'}
                          ? 'static'
                          : ($Config{usedl} ? 'dynamic' : 'static');
      }
  
      return;
  }
  
  
  # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or
  # undefined. In any case we turn it into an anon array
  sub _fix_libs {
      my($self, $libs) = @_;
  
      return !defined $libs       ? ['']          :
             !ref $libs           ? [$libs]       :
             !defined $libs->[0]  ? ['']          :
                                    $libs         ;
  }
  
  
  =head3 tools_other
  
      my $make_frag = $MM->tools_other;
  
  Returns a make fragment containing definitions for the macros init_others()
  initializes.
  
  =cut
  
  sub tools_other {
      my($self) = shift;
      my @m;
  
      # We set PM_FILTER as late as possible so it can see all the earlier
      # on macro-order sensitive makes such as nmake.
      for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH
                        UMASK_NULL DEV_NULL MKPATH EQUALIZE_TIMESTAMP
                        FALSE TRUE
                        ECHO ECHO_N
                        UNINST VERBINST
                        MOD_INSTALL DOC_INSTALL UNINSTALL
                        WARN_IF_OLD_PACKLIST
                        MACROSTART MACROEND
                        USEMAKEFILE
                        PM_FILTER
                        FIXIN
                        CP_NONEMPTY
                      } )
      {
          next unless defined $self->{$tool};
          push @m, "$tool = $self->{$tool}\n";
      }
  
      return join "", @m;
  }
  
  
  =head3 init_DIRFILESEP  I<Abstract>
  
    $MM->init_DIRFILESEP;
    my $dirfilesep = $MM->{DIRFILESEP};
  
  Initializes the DIRFILESEP macro which is the separator between the
  directory and filename in a filepath.  ie. / on Unix, \ on Win32 and
  nothing on VMS.
  
  For example:
  
      # instead of $(INST_ARCHAUTODIR)/extralibs.ld
      $(INST_ARCHAUTODIR)$(DIRFILESEP)extralibs.ld
  
  Something of a hack but it prevents a lot of code duplication between
  MM_* variants.
  
  Do not use this as a separator between directories.  Some operating
  systems use different separators between subdirectories as between
  directories and filenames (for example:  VOLUME:[dir1.dir2]file on VMS).
  
  =head3 init_linker  I<Abstract>
  
      $mm->init_linker;
  
  Initialize macros which have to do with linking.
  
  PERL_ARCHIVE: path to libperl.a equivalent to be linked to dynamic
  extensions.
  
  PERL_ARCHIVE_AFTER: path to a library which should be put on the
  linker command line I<after> the external libraries to be linked to
  dynamic extensions.  This may be needed if the linker is one-pass, and
  Perl includes some overrides for C RTL functions, such as malloc().
  
  EXPORT_LIST: name of a file that is passed to linker to define symbols
  to be exported.
  
  Some OSes do not need these in which case leave it blank.
  
  
  =head3 init_platform
  
      $mm->init_platform
  
  Initialize any macros which are for platform specific use only.
  
  A typical one is the version number of your OS specific module.
  (ie. MM_Unix_VERSION or MM_VMS_VERSION).
  
  =cut
  
  sub init_platform {
      return '';
  }
  
  
  =head3 init_MAKE
  
      $mm->init_MAKE
  
  Initialize MAKE from either a MAKE environment variable or $Config{make}.
  
  =cut
  
  sub init_MAKE {
      my $self = shift;
  
      $self->{MAKE} ||= $ENV{MAKE} || $Config{make};
  }
  
  
  =head2 Tools
  
  A grab bag of methods to generate specific macros and commands.
  
  
  
  =head3 manifypods
  
  Defines targets and routines to translate the pods into manpages and
  put them into the INST_* directories.
  
  =cut
  
  sub manifypods {
      my $self          = shift;
  
      my $POD2MAN_macro = $self->POD2MAN_macro();
      my $manifypods_target = $self->manifypods_target();
  
      return <<END_OF_TARGET;
  
  $POD2MAN_macro
  
  $manifypods_target
  
  END_OF_TARGET
  
  }
  
  
  =head3 POD2MAN_macro
  
    my $pod2man_macro = $self->POD2MAN_macro
  
  Returns a definition for the POD2MAN macro.  This is a program
  which emulates the pod2man utility.  You can add more switches to the
  command by simply appending them on the macro.
  
  Typical usage:
  
      $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) podfile1 man_page1 ...
  
  =cut
  
  sub POD2MAN_macro {
      my $self = shift;
  
  # Need the trailing '--' so perl stops gobbling arguments and - happens
  # to be an alternative end of line separator on VMS so we quote it
      return <<'END_OF_DEF';
  POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
  POD2MAN = $(POD2MAN_EXE)
  END_OF_DEF
  }
  
  
  =head3 test_via_harness
  
    my $command = $mm->test_via_harness($perl, $tests);
  
  Returns a $command line which runs the given set of $tests with
  Test::Harness and the given $perl.
  
  Used on the t/*.t files.
  
  =cut
  
  sub test_via_harness {
      my($self, $perl, $tests) = @_;
  
      return qq{\t$perl "-MExtUtils::Command::MM" "-MTest::Harness" }.
             qq{"-e" "undef *Test::Harness::Switches; test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n};
  }
  
  =head3 test_via_script
  
    my $command = $mm->test_via_script($perl, $script);
  
  Returns a $command line which just runs a single test without
  Test::Harness.  No checks are done on the results, they're just
  printed.
  
  Used for test.pl, since they don't always follow Test::Harness
  formatting.
  
  =cut
  
  sub test_via_script {
      my($self, $perl, $script) = @_;
      return qq{\t$perl "-I\$(INST_LIB)" "-I\$(INST_ARCHLIB)" $script\n};
  }
  
  
  =head3 tool_autosplit
  
  Defines a simple perl call that runs autosplit. May be deprecated by
  pm_to_blib soon.
  
  =cut
  
  sub tool_autosplit {
      my($self, %attribs) = @_;
  
      my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};'
                                    : '';
  
      my $asplit = $self->oneliner(sprintf <<'PERL_CODE', $maxlen);
  use AutoSplit; %s autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)
  PERL_CODE
  
      return sprintf <<'MAKE_FRAG', $asplit;
  # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
  AUTOSPLITFILE = %s
  
  MAKE_FRAG
  
  }
  
  
  =head3 arch_check
  
      my $arch_ok = $mm->arch_check(
          $INC{"Config.pm"},
          File::Spec->catfile($Config{archlibexp}, "Config.pm")
      );
  
  A sanity check that what Perl thinks the architecture is and what
  Config thinks the architecture is are the same.  If they're not it
  will return false and show a diagnostic message.
  
  When building Perl it will always return true, as nothing is installed
  yet.
  
  The interface is a bit odd because this is the result of a
  quick refactoring.  Don't rely on it.
  
  =cut
  
  sub arch_check {
      my $self = shift;
      my($pconfig, $cconfig) = @_;
  
      return 1 if $self->{PERL_SRC};
  
      my($pvol, $pthinks) = $self->splitpath($pconfig);
      my($cvol, $cthinks) = $self->splitpath($cconfig);
  
      $pthinks = $self->canonpath($pthinks);
      $cthinks = $self->canonpath($cthinks);
  
      my $ret = 1;
      if ($pthinks ne $cthinks) {
          print "Have $pthinks\n";
          print "Want $cthinks\n";
  
          $ret = 0;
  
          my $arch = (grep length, $self->splitdir($pthinks))[-1];
  
          print <<END unless $self->{UNINSTALLED_PERL};
  Your perl and your Config.pm seem to have different ideas about the
  architecture they are running on.
  Perl thinks: [$arch]
  Config says: [$Config{archname}]
  This may or may not cause problems. Please check your installation of perl
  if you have problems building this extension.
  END
      }
  
      return $ret;
  }
  
  
  
  =head2 File::Spec wrappers
  
  ExtUtils::MM_Any is a subclass of File::Spec.  The methods noted here
  override File::Spec.
  
  
  
  =head3 catfile
  
  File::Spec <= 0.83 has a bug where the file part of catfile is not
  canonicalized.  This override fixes that bug.
  
  =cut
  
  sub catfile {
      my $self = shift;
      return $self->canonpath($self->SUPER::catfile(@_));
  }
  
  
  
  =head2 Misc
  
  Methods I can't really figure out where they should go yet.
  
  
  =head3 find_tests
  
    my $test = $mm->find_tests;
  
  Returns a string suitable for feeding to the shell to return all
  tests in t/*.t.
  
  =cut
  
  sub find_tests {
      my($self) = shift;
      return -d 't' ? 't/*.t' : '';
  }
  
  =head3 find_tests_recursive
  
    my $tests = $mm->find_tests_recursive;
  
  Returns a string suitable for feeding to the shell to return all
  tests in t/ but recursively.
  
  =cut
  
  sub find_tests_recursive {
      my($self) = shift;
      return '' unless -d 't';
  
      require File::Find;
  
      my %testfiles;
  
      my $wanted = sub {
          return unless m!\.t$!;
          my ($volume,$directories,$file) =
              File::Spec->splitpath( $File::Find::name  );
          my @dirs = File::Spec->splitdir( $directories );
          for ( @dirs ) {
            next if $_ eq 't';
            unless ( $_ ) {
              $_ = '*.t';
              next;
            }
            $_ = '*';
          }
          my $testfile = join '/', @dirs;
          $testfiles{ $testfile } = 1;
      };
  
      File::Find::find( $wanted, 't' );
  
      return join ' ', sort keys %testfiles;
  }
  
  =head3 extra_clean_files
  
      my @files_to_clean = $MM->extra_clean_files;
  
  Returns a list of OS specific files to be removed in the clean target in
  addition to the usual set.
  
  =cut
  
  # An empty method here tickled a perl 5.8.1 bug and would return its object.
  sub extra_clean_files {
      return;
  }
  
  
  =head3 installvars
  
      my @installvars = $mm->installvars;
  
  A list of all the INSTALL* variables without the INSTALL prefix.  Useful
  for iteration or building related variable sets.
  
  =cut
  
  sub installvars {
      return qw(PRIVLIB SITELIB  VENDORLIB
                ARCHLIB SITEARCH VENDORARCH
                BIN     SITEBIN  VENDORBIN
                SCRIPT  SITESCRIPT  VENDORSCRIPT
                MAN1DIR SITEMAN1DIR VENDORMAN1DIR
                MAN3DIR SITEMAN3DIR VENDORMAN3DIR
               );
  }
  
  
  =head3 libscan
  
    my $wanted = $self->libscan($path);
  
  Takes a path to a file or dir and returns an empty string if we don't
  want to include this file in the library.  Otherwise it returns the
  the $path unchanged.
  
  Mainly used to exclude version control administrative directories from
  installation.
  
  =cut
  
  sub libscan {
      my($self,$path) = @_;
      my($dirs,$file) = ($self->splitpath($path))[1,2];
      return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/,
                       $self->splitdir($dirs), $file;
  
      return $path;
  }
  
  
  =head3 platform_constants
  
      my $make_frag = $mm->platform_constants
  
  Returns a make fragment defining all the macros initialized in
  init_platform() rather than put them in constants().
  
  =cut
  
  sub platform_constants {
      return '';
  }
  
  =begin private
  
  =head3 _PREREQ_PRINT
  
      $self->_PREREQ_PRINT;
  
  Implements PREREQ_PRINT.
  
  Refactored out of MakeMaker->new().
  
  =end private
  
  =cut
  
  sub _PREREQ_PRINT {
      my $self = shift;
  
      require Data::Dumper;
      my @what = ('PREREQ_PM');
      push @what, 'MIN_PERL_VERSION' if $self->{MIN_PERL_VERSION};
      push @what, 'BUILD_REQUIRES'   if $self->{BUILD_REQUIRES};
      print Data::Dumper->Dump([@{$self}{@what}], \@what);
      exit 0;
  }
  
  
  =begin private
  
  =head3 _PRINT_PREREQ
  
    $mm->_PRINT_PREREQ;
  
  Implements PRINT_PREREQ, a slightly different version of PREREQ_PRINT
  added by Redhat to, I think, support generating RPMs from Perl modules.
  
  Should not include BUILD_REQUIRES as RPMs do not incluide them.
  
  Refactored out of MakeMaker->new().
  
  =end private
  
  =cut
  
  sub _PRINT_PREREQ {
      my $self = shift;
  
      my $prereqs= $self->{PREREQ_PM};
      my @prereq = map { [$_, $prereqs->{$_}] } keys %$prereqs;
  
      if ( $self->{MIN_PERL_VERSION} ) {
          push @prereq, ['perl' => $self->{MIN_PERL_VERSION}];
      }
  
      print join(" ", map { "perl($_->[0])>=$_->[1] " }
                   sort { $a->[0] cmp $b->[0] } @prereq), "\n";
      exit 0;
  }
  
  
  =begin private
  
  =head3 _all_prereqs
  
    my $prereqs = $self->_all_prereqs;
  
  Returns a hash ref of both PREREQ_PM and BUILD_REQUIRES.
  
  =end private
  
  =cut
  
  sub _all_prereqs {
      my $self = shift;
  
      return { %{$self->{PREREQ_PM}}, %{$self->{BUILD_REQUIRES}} };
  }
  
  =begin private
  
  =head3 _perl_header_files
  
    my $perl_header_files= $self->_perl_header_files;
  
  returns a sorted list of header files as found in PERL_SRC or $archlibexp/CORE.
  
  Used by perldepend() in MM_Unix and MM_VMS via _perl_header_files_fragment()
  
  =end private
  
  =cut
  
  sub _perl_header_files {
      my $self = shift;
  
      my $header_dir = $self->{PERL_SRC} || $ENV{PERL_SRC} || $self->catdir($Config{archlibexp}, 'CORE');
      opendir my $dh, $header_dir
          or die "Failed to opendir '$header_dir' to find header files: $!";
  
      # we need to use a temporary here as the sort in scalar context would have undefined results.
      my @perl_headers= sort grep { /\.h\z/ } readdir($dh);
  
      closedir $dh;
  
      return @perl_headers;
  }
  
  =begin private
  
  =head3 _perl_header_files_fragment ($o, $separator)
  
    my $perl_header_files_fragment= $self->_perl_header_files_fragment("/");
  
  return a Makefile fragment which holds the list of perl header files which
  XS code depends on $(PERL_INC), and sets up the dependency for the $(OBJECT) file.
  
  The $separator argument defaults to "". MM_VMS will set it to "" and MM_UNIX to "/"
  in perldepend(). This reason child subclasses need to control this is that in
  VMS the $(PERL_INC) directory will already have delimiters in it, but in
  UNIX $(PERL_INC) will need a slash between it an the filename. Hypothetically
  win32 could use "\\" (but it doesn't need to).
  
  =end private
  
  =cut
  
  sub _perl_header_files_fragment {
      my ($self, $separator)= @_;
      $separator ||= "";
      return join("\\\n",
                  "PERL_HDRS = ",
                  map {
                      sprintf( "        \$(PERL_INCDEP)%s%s            ", $separator, $_ )
                  } $self->_perl_header_files()
             ) . "\n\n"
             . "\$(OBJECT) : \$(PERL_HDRS)\n";
  }
  
  
  =head1 AUTHOR
  
  Michael G Schwern <schwern@pobox.com> and the denizens of
  makemaker@perl.org with code from ExtUtils::MM_Unix and
  ExtUtils::MM_Win32.
  
  
  =cut
  
  1;
EXTUTILS_MM_ANY

$fatpacked{"ExtUtils/MM_BeOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_BEOS';
  package ExtUtils::MM_BeOS;
  
  use strict;
  
  =head1 NAME
  
  ExtUtils::MM_BeOS - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
   use ExtUtils::MM_BeOS;	# Done internally by ExtUtils::MakeMaker if needed
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =over 4
  
  =cut
  
  use ExtUtils::MakeMaker::Config;
  use File::Spec;
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  our $VERSION = '7.04';
  
  
  =item os_flavor
  
  BeOS is BeOS.
  
  =cut
  
  sub os_flavor {
      return('BeOS');
  }
  
  =item init_linker
  
  libperl.a equivalent to be linked to dynamic extensions.
  
  =cut
  
  sub init_linker {
      my($self) = shift;
  
      $self->{PERL_ARCHIVE} ||=
        File::Spec->catdir('$(PERL_INC)',$Config{libperl});
      $self->{PERL_ARCHIVEDEP} ||= '';
      $self->{PERL_ARCHIVE_AFTER} ||= '';
      $self->{EXPORT_LIST}  ||= '';
  }
  
  =back
  
  1;
  __END__
  
EXTUTILS_MM_BEOS

$fatpacked{"ExtUtils/MM_Cygwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_CYGWIN';
  package ExtUtils::MM_Cygwin;
  
  use strict;
  
  use ExtUtils::MakeMaker::Config;
  use File::Spec;
  
  require ExtUtils::MM_Unix;
  require ExtUtils::MM_Win32;
  our @ISA = qw( ExtUtils::MM_Unix );
  
  our $VERSION = '7.04';
  
  
  =head1 NAME
  
  ExtUtils::MM_Cygwin - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
   use ExtUtils::MM_Cygwin; # Done internally by ExtUtils::MakeMaker if needed
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided there.
  
  =over 4
  
  =item os_flavor
  
  We're Unix and Cygwin.
  
  =cut
  
  sub os_flavor {
      return('Unix', 'Cygwin');
  }
  
  =item cflags
  
  if configured for dynamic loading, triggers #define EXT in EXTERN.h
  
  =cut
  
  sub cflags {
      my($self,$libperl)=@_;
      return $self->{CFLAGS} if $self->{CFLAGS};
      return '' unless $self->needs_linking();
  
      my $base = $self->SUPER::cflags($libperl);
      foreach (split /\n/, $base) {
          /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
      };
      $self->{CCFLAGS} .= " -DUSEIMPORTLIB" if ($Config{useshrplib} eq 'true');
  
      return $self->{CFLAGS} = qq{
  CCFLAGS = $self->{CCFLAGS}
  OPTIMIZE = $self->{OPTIMIZE}
  PERLTYPE = $self->{PERLTYPE}
  };
  
  }
  
  
  =item replace_manpage_separator
  
  replaces strings '::' with '.' in MAN*POD man page names
  
  =cut
  
  sub replace_manpage_separator {
      my($self, $man) = @_;
      $man =~ s{/+}{.}g;
      return $man;
  }
  
  =item init_linker
  
  points to libperl.a
  
  =cut
  
  sub init_linker {
      my $self = shift;
  
      if ($Config{useshrplib} eq 'true') {
          my $libperl = '$(PERL_INC)' .'/'. "$Config{libperl}";
          if( $] >= 5.006002 ) {
              $libperl =~ s/a$/dll.a/;
          }
          $self->{PERL_ARCHIVE} = $libperl;
      } else {
          $self->{PERL_ARCHIVE} =
            '$(PERL_INC)' .'/'. ("$Config{libperl}" or "libperl.a");
      }
  
      $self->{PERL_ARCHIVEDEP} ||= '';
      $self->{PERL_ARCHIVE_AFTER} ||= '';
      $self->{EXPORT_LIST}  ||= '';
  }
  
  =item maybe_command
  
  Determine whether a file is native to Cygwin by checking whether it
  resides inside the Cygwin installation (using Windows paths). If so,
  use C<ExtUtils::MM_Unix> to determine if it may be a command.
  Otherwise use the tests from C<ExtUtils::MM_Win32>.
  
  =cut
  
  sub maybe_command {
      my ($self, $file) = @_;
  
      my $cygpath = Cygwin::posix_to_win_path('/', 1);
      my $filepath = Cygwin::posix_to_win_path($file, 1);
  
      return (substr($filepath,0,length($cygpath)) eq $cygpath)
      ? $self->SUPER::maybe_command($file) # Unix
      : ExtUtils::MM_Win32->maybe_command($file); # Win32
  }
  
  =item dynamic_lib
  
  Use the default to produce the *.dll's.
  But for new archdir dll's use the same rebase address if the old exists.
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      my $s = ExtUtils::MM_Unix::dynamic_lib($self, %attribs);
      my $ori = "$self->{INSTALLARCHLIB}/auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{DLEXT}";
      if (-e $ori) {
          my $imagebase = `/bin/objdump -p $ori | /bin/grep ImageBase | /bin/cut -c12-`;
          chomp $imagebase;
          if ($imagebase gt "40000000") {
              my $LDDLFLAGS = $self->{LDDLFLAGS};
              $LDDLFLAGS =~ s/-Wl,--enable-auto-image-base/-Wl,--image-base=0x$imagebase/;
              $s =~ s/ \$\(LDDLFLAGS\) / $LDDLFLAGS /m;
          }
      }
      $s;
  }
  
  =item all_target
  
  Build man pages, too
  
  =cut
  
  sub all_target {
      ExtUtils::MM_Unix::all_target(shift);
  }
  
  =back
  
  =cut
  
  1;
EXTUTILS_MM_CYGWIN

$fatpacked{"ExtUtils/MM_DOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_DOS';
  package ExtUtils::MM_DOS;
  
  use strict;
  
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  
  
  =head1 NAME
  
  ExtUtils::MM_DOS - DOS specific subclass of ExtUtils::MM_Unix
  
  =head1 SYNOPSIS
  
    Don't use this module directly.
    Use ExtUtils::MM and let it choose.
  
  =head1 DESCRIPTION
  
  This is a subclass of ExtUtils::MM_Unix which contains functionality
  for DOS.
  
  Unless otherwise stated, it works just like ExtUtils::MM_Unix
  
  =head2 Overridden methods
  
  =over 4
  
  =item os_flavor
  
  =cut
  
  sub os_flavor {
      return('DOS');
  }
  
  =item B<replace_manpage_separator>
  
  Generates Foo__Bar.3 style man page names
  
  =cut
  
  sub replace_manpage_separator {
      my($self, $man) = @_;
  
      $man =~ s,/+,__,g;
      return $man;
  }
  
  =back
  
  =head1 AUTHOR
  
  Michael G Schwern <schwern@pobox.com> with code from ExtUtils::MM_Unix
  
  =head1 SEE ALSO
  
  L<ExtUtils::MM_Unix>, L<ExtUtils::MakeMaker>
  
  =cut
  
  1;
EXTUTILS_MM_DOS

$fatpacked{"ExtUtils/MM_Darwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_DARWIN';
  package ExtUtils::MM_Darwin;
  
  use strict;
  
  BEGIN {
      require ExtUtils::MM_Unix;
      our @ISA = qw( ExtUtils::MM_Unix );
  }
  
  our $VERSION = '7.04';
  
  
  =head1 NAME
  
  ExtUtils::MM_Darwin - special behaviors for OS X
  
  =head1 SYNOPSIS
  
      For internal MakeMaker use only
  
  =head1 DESCRIPTION
  
  See L<ExtUtils::MM_Unix> for L<ExtUtils::MM_Any> for documentation on the
  methods overridden here.
  
  =head2 Overriden Methods
  
  =head3 init_dist
  
  Turn off Apple tar's tendency to copy resource forks as "._foo" files.
  
  =cut
  
  sub init_dist {
      my $self = shift;
  
      # Thank you, Apple, for breaking tar and then breaking the work around.
      # 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE while 10.5 wants
      # COPYFILE_DISABLE.  I'm not going to push my luck and instead just
      # set both.
      $self->{TAR} ||=
          'COPY_EXTENDED_ATTRIBUTES_DISABLE=1 COPYFILE_DISABLE=1 tar';
  
      $self->SUPER::init_dist(@_);
  }
  
  1;
EXTUTILS_MM_DARWIN

$fatpacked{"ExtUtils/MM_MacOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_MACOS';
  package ExtUtils::MM_MacOS;
  
  use strict;
  
  our $VERSION = '7.04';
  
  sub new {
      die 'MacOS Classic (MacPerl) is no longer supported by MakeMaker';
  }
  
  =head1 NAME
  
  ExtUtils::MM_MacOS - once produced Makefiles for MacOS Classic
  
  =head1 SYNOPSIS
  
    # MM_MacOS no longer contains any code.  This is just a stub.
  
  =head1 DESCRIPTION
  
  Once upon a time, MakeMaker could produce an approximation of a correct
  Makefile on MacOS Classic (MacPerl).  Due to a lack of maintainers, this
  fell out of sync with the rest of MakeMaker and hadn't worked in years.
  Since there's little chance of it being repaired, MacOS Classic is fading
  away, and the code was icky to begin with, the code has been deleted to
  make maintenance easier.
  
  Anyone interested in resurrecting this file should pull the old version
  from the MakeMaker CVS repository and contact makemaker@perl.org.
  
  =cut
  
  1;
EXTUTILS_MM_MACOS

$fatpacked{"ExtUtils/MM_NW5.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_NW5';
  package ExtUtils::MM_NW5;
  
  =head1 NAME
  
  ExtUtils::MM_NW5 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
   use ExtUtils::MM_NW5; # Done internally by ExtUtils::MakeMaker if needed
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =over
  
  =cut
  
  use strict;
  use ExtUtils::MakeMaker::Config;
  use File::Basename;
  
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Win32;
  our @ISA = qw(ExtUtils::MM_Win32);
  
  use ExtUtils::MakeMaker qw( &neatvalue );
  
  $ENV{EMXSHELL} = 'sh'; # to run `commands`
  
  my $BORLAND  = $Config{'cc'} =~ /^bcc/i;
  my $GCC      = $Config{'cc'} =~ /^gcc/i;
  
  
  =item os_flavor
  
  We're Netware in addition to being Windows.
  
  =cut
  
  sub os_flavor {
      my $self = shift;
      return ($self->SUPER::os_flavor, 'Netware');
  }
  
  =item init_platform
  
  Add Netware macros.
  
  LIBPTH, BASE_IMPORT, NLM_VERSION, MPKTOOL, TOOLPATH, BOOT_SYMBOL,
  NLM_SHORT_NAME, INCLUDE, PATH, MM_NW5_REVISION
  
  
  =item platform_constants
  
  Add Netware macros initialized above to the Makefile.
  
  =cut
  
  sub init_platform {
      my($self) = shift;
  
      # To get Win32's setup.
      $self->SUPER::init_platform;
  
      # incpath is copied to makefile var INCLUDE in constants sub, here just
      # make it empty
      my $libpth = $Config{'libpth'};
      $libpth =~ s( )(;);
      $self->{'LIBPTH'} = $libpth;
  
      $self->{'BASE_IMPORT'} = $Config{'base_import'};
  
      # Additional import file specified from Makefile.pl
      if($self->{'base_import'}) {
          $self->{'BASE_IMPORT'} .= ', ' . $self->{'base_import'};
      }
  
      $self->{'NLM_VERSION'} = $Config{'nlm_version'};
      $self->{'MPKTOOL'}	= $Config{'mpktool'};
      $self->{'TOOLPATH'}	= $Config{'toolpath'};
  
      (my $boot = $self->{'NAME'}) =~ s/:/_/g;
      $self->{'BOOT_SYMBOL'}=$boot;
  
      # If the final binary name is greater than 8 chars,
      # truncate it here.
      if(length($self->{'BASEEXT'}) > 8) {
          $self->{'NLM_SHORT_NAME'} = substr($self->{'BASEEXT'},0,8);
      }
  
      # Get the include path and replace the spaces with ;
      # Copy this to makefile as INCLUDE = d:\...;d:\;
      ($self->{INCLUDE} = $Config{'incpath'}) =~ s/([ ]*)-I/;/g;
  
      # Set the path to CodeWarrior binaries which might not have been set in
      # any other place
      $self->{PATH} = '$(PATH);$(TOOLPATH)';
  
      $self->{MM_NW5_VERSION} = $VERSION;
  }
  
  sub platform_constants {
      my($self) = shift;
      my $make_frag = '';
  
      # Setup Win32's constants.
      $make_frag .= $self->SUPER::platform_constants;
  
      foreach my $macro (qw(LIBPTH BASE_IMPORT NLM_VERSION MPKTOOL
                            TOOLPATH BOOT_SYMBOL NLM_SHORT_NAME INCLUDE PATH
                            MM_NW5_VERSION
                        ))
      {
          next unless defined $self->{$macro};
          $make_frag .= "$macro = $self->{$macro}\n";
      }
  
      return $make_frag;
  }
  
  
  =item const_cccmd
  
  =cut
  
  sub const_cccmd {
      my($self,$libperl)=@_;
      return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
      return '' unless $self->needs_linking();
      return $self->{CONST_CCCMD} = <<'MAKE_FRAG';
  CCCMD = $(CC) $(CCFLAGS) $(INC) $(OPTIMIZE) \
  	$(PERLTYPE) $(MPOLLUTE) -o $@ \
  	-DVERSION=\"$(VERSION)\" -DXS_VERSION=\"$(XS_VERSION)\"
  MAKE_FRAG
  
  }
  
  
  =item static_lib
  
  =cut
  
  sub static_lib {
      my($self) = @_;
  
      return '' unless $self->has_link_code;
  
      my $m = <<'END';
  $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(RM_RF) $@
  END
  
      # If this extension has it's own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      $m .= <<'END'  if $self->{MYEXTLIB};
  	$self->{CP} $(MYEXTLIB) $@
  END
  
      my $ar_arg;
      if( $BORLAND ) {
          $ar_arg = '$@ $(OBJECT:^"+")';
      }
      elsif( $GCC ) {
          $ar_arg = '-ru $@ $(OBJECT)';
      }
      else {
          $ar_arg = '-type library -o $@ $(OBJECT)';
      }
  
      $m .= sprintf <<'END', $ar_arg;
  	$(AR) %s
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
  	$(CHMOD) 755 $@
  END
  
      $m .= <<'END' if $self->{PERL_SRC};
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
  
  
  END
      return $m;
  }
  
  =item dynamic_lib
  
  Defines how to produce the *.so (or equivalent) files.
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      return '' unless $self->needs_linking(); #might be because of a subdir
  
      return '' unless $self->has_link_code;
  
      my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
      my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
      my($ldfrom) = '$(LDFROM)';
  
      (my $boot = $self->{NAME}) =~ s/:/_/g;
  
      my $m = <<'MAKE_FRAG';
  # This section creates the dynamically loadable $(INST_DYNAMIC)
  # from $(OBJECT) and possibly $(MYEXTLIB).
  OTHERLDFLAGS = '.$otherldflags.'
  INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  
  # Create xdc data for an MT safe NLM in case of mpk build
  $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(NOECHO) $(ECHO) Export boot_$(BOOT_SYMBOL) > $(BASEEXT).def
  	$(NOECHO) $(ECHO) $(BASE_IMPORT) >> $(BASEEXT).def
  	$(NOECHO) $(ECHO) Import @$(PERL_INC)\perl.imp >> $(BASEEXT).def
  MAKE_FRAG
  
  
      if ( $self->{CCFLAGS} =~ m/ -DMPK_ON /) {
          $m .= <<'MAKE_FRAG';
  	$(MPKTOOL) $(XDCFLAGS) $(BASEEXT).xdc
  	$(NOECHO) $(ECHO) xdcdata $(BASEEXT).xdc >> $(BASEEXT).def
  MAKE_FRAG
      }
  
      # Reconstruct the X.Y.Z version.
      my $version = join '.', map { sprintf "%d", $_ }
                                $] =~ /(\d)\.(\d{3})(\d{2})/;
      $m .= sprintf '	$(LD) $(LDFLAGS) $(OBJECT:.obj=.obj) -desc "Perl %s Extension ($(BASEEXT))  XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION)', $version;
  
      # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc
      if($self->{NLM_SHORT_NAME}) {
          # In case of nlms with names exceeding 8 chars, build nlm in the
          # current dir, rename and move to auto\lib.
          $m .= q{ -o $(NLM_SHORT_NAME).$(DLEXT)}
      } else {
          $m .= q{ -o $(INST_AUTODIR)\\$(BASEEXT).$(DLEXT)}
      }
  
      # Add additional lib files if any (SDBM_File)
      $m .= q{ $(MYEXTLIB) } if $self->{MYEXTLIB};
  
      $m .= q{ $(PERL_INC)\Main.lib -commandfile $(BASEEXT).def}."\n";
  
      if($self->{NLM_SHORT_NAME}) {
          $m .= <<'MAKE_FRAG';
  	if exist $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) del $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT)
  	move $(NLM_SHORT_NAME).$(DLEXT) $(INST_AUTODIR)
  MAKE_FRAG
      }
  
      $m .= <<'MAKE_FRAG';
  
  	$(CHMOD) 755 $@
  MAKE_FRAG
  
      return $m;
  }
  
  
  1;
  __END__
  
  =back
  
  =cut
  
  
EXTUTILS_MM_NW5

$fatpacked{"ExtUtils/MM_OS2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_OS2';
  package ExtUtils::MM_OS2;
  
  use strict;
  
  use ExtUtils::MakeMaker qw(neatvalue);
  use File::Spec;
  
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw(ExtUtils::MM_Any ExtUtils::MM_Unix);
  
  =pod
  
  =head1 NAME
  
  ExtUtils::MM_OS2 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
   use ExtUtils::MM_OS2; # Done internally by ExtUtils::MakeMaker if needed
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =head1 METHODS
  
  =over 4
  
  =item init_dist
  
  Define TO_UNIX to convert OS2 linefeeds to Unix style.
  
  =cut
  
  sub init_dist {
      my($self) = @_;
  
      $self->{TO_UNIX} ||= <<'MAKE_TEXT';
  $(NOECHO) $(TEST_F) tmp.zip && $(RM_F) tmp.zip; $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM_F) tmp.zip
  MAKE_TEXT
  
      $self->SUPER::init_dist;
  }
  
  sub dlsyms {
      my($self,%attribs) = @_;
  
      my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
      my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
      my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
      my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
      my(@m);
      (my $boot = $self->{NAME}) =~ s/:/_/g;
  
      if (not $self->{SKIPHASH}{'dynamic'}) {
  	push(@m,"
  $self->{BASEEXT}.def: Makefile.PL
  ",
       '	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
       Mksymlists("NAME" => "$(NAME)", "DLBASE" => "$(DLBASE)", ',
       '"VERSION" => "$(VERSION)", "DISTNAME" => "$(DISTNAME)", ',
       '"INSTALLDIRS" => "$(INSTALLDIRS)", ',
       '"DL_FUNCS" => ',neatvalue($funcs),
       ', "FUNCLIST" => ',neatvalue($funclist),
       ', "IMPORTS" => ',neatvalue($imports),
       ', "DL_VARS" => ', neatvalue($vars), ');\'
  ');
      }
      if ($self->{IMPORTS} && %{$self->{IMPORTS}}) {
  	# Make import files (needed for static build)
  	-d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp";
  	open my $imp, '>', 'tmpimp.imp' or die "Can't open tmpimp.imp";
  	while (my($name, $exp) = each %{$self->{IMPORTS}}) {
  	    my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'";
  	    print $imp "$name $lib $id ?\n";
  	}
  	close $imp or die "Can't close tmpimp.imp";
  	# print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n";
  	system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp"
  	    and die "Cannot make import library: $!, \$?=$?";
  	# May be running under miniperl, so have no glob...
  	eval { unlink <tmp_imp/*>; 1 } or system "rm tmp_imp/*";
  	system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}"
  	    and die "Cannot extract import objects: $!, \$?=$?";
      }
      join('',@m);
  }
  
  sub static_lib {
      my($self) = @_;
      my $old = $self->ExtUtils::MM_Unix::static_lib();
      return $old unless $self->{IMPORTS} && %{$self->{IMPORTS}};
  
      my @chunks = split /\n{2,}/, $old;
      shift @chunks unless length $chunks[0]; # Empty lines at the start
      $chunks[0] .= <<'EOC';
  
  	$(AR) $(AR_STATIC_ARGS) $@ tmp_imp/* && $(RANLIB) $@
  EOC
      return join "\n\n". '', @chunks;
  }
  
  sub replace_manpage_separator {
      my($self,$man) = @_;
      $man =~ s,/+,.,g;
      $man;
  }
  
  sub maybe_command {
      my($self,$file) = @_;
      $file =~ s,[/\\]+,/,g;
      return $file if -x $file && ! -d _;
      return "$file.exe" if -x "$file.exe" && ! -d _;
      return "$file.cmd" if -x "$file.cmd" && ! -d _;
      return;
  }
  
  =item init_linker
  
  =cut
  
  sub init_linker {
      my $self = shift;
  
      $self->{PERL_ARCHIVE} = "\$(PERL_INC)/libperl\$(LIB_EXT)";
  
      $self->{PERL_ARCHIVEDEP} ||= '';
      $self->{PERL_ARCHIVE_AFTER} = $OS2::is_aout
        ? ''
        : '$(PERL_INC)/libperl_override$(LIB_EXT)';
      $self->{EXPORT_LIST} = '$(BASEEXT).def';
  }
  
  =item os_flavor
  
  OS/2 is OS/2
  
  =cut
  
  sub os_flavor {
      return('OS/2');
  }
  
  =back
  
  =cut
  
  1;
EXTUTILS_MM_OS2

$fatpacked{"ExtUtils/MM_QNX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_QNX';
  package ExtUtils::MM_QNX;
  
  use strict;
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Unix;
  our @ISA = qw(ExtUtils::MM_Unix);
  
  
  =head1 NAME
  
  ExtUtils::MM_QNX - QNX specific subclass of ExtUtils::MM_Unix
  
  =head1 SYNOPSIS
  
    Don't use this module directly.
    Use ExtUtils::MM and let it choose.
  
  =head1 DESCRIPTION
  
  This is a subclass of ExtUtils::MM_Unix which contains functionality for
  QNX.
  
  Unless otherwise stated it works just like ExtUtils::MM_Unix
  
  =head2 Overridden methods
  
  =head3 extra_clean_files
  
  Add .err files corresponding to each .c file.
  
  =cut
  
  sub extra_clean_files {
      my $self = shift;
  
      my @errfiles = @{$self->{C}};
      for ( @errfiles ) {
  	s/.c$/.err/;
      }
  
      return( @errfiles, 'perlmain.err' );
  }
  
  
  =head1 AUTHOR
  
  Michael G Schwern <schwern@pobox.com> with code from ExtUtils::MM_Unix
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker>
  
  =cut
  
  
  1;
EXTUTILS_MM_QNX

$fatpacked{"ExtUtils/MM_UWIN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_UWIN';
  package ExtUtils::MM_UWIN;
  
  use strict;
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Unix;
  our @ISA = qw(ExtUtils::MM_Unix);
  
  
  =head1 NAME
  
  ExtUtils::MM_UWIN - U/WIN specific subclass of ExtUtils::MM_Unix
  
  =head1 SYNOPSIS
  
    Don't use this module directly.
    Use ExtUtils::MM and let it choose.
  
  =head1 DESCRIPTION
  
  This is a subclass of ExtUtils::MM_Unix which contains functionality for
  the AT&T U/WIN UNIX on Windows environment.
  
  Unless otherwise stated it works just like ExtUtils::MM_Unix
  
  =head2 Overridden methods
  
  =over 4
  
  =item os_flavor
  
  In addition to being Unix, we're U/WIN.
  
  =cut
  
  sub os_flavor {
      return('Unix', 'U/WIN');
  }
  
  
  =item B<replace_manpage_separator>
  
  =cut
  
  sub replace_manpage_separator {
      my($self, $man) = @_;
  
      $man =~ s,/+,.,g;
      return $man;
  }
  
  =back
  
  =head1 AUTHOR
  
  Michael G Schwern <schwern@pobox.com> with code from ExtUtils::MM_Unix
  
  =head1 SEE ALSO
  
  L<ExtUtils::MM_Win32>, L<ExtUtils::MakeMaker>
  
  =cut
  
  1;
EXTUTILS_MM_UWIN

$fatpacked{"ExtUtils/MM_Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_UNIX';
  package ExtUtils::MM_Unix;
  
  require 5.006;
  
  use strict;
  
  use Carp;
  use ExtUtils::MakeMaker::Config;
  use File::Basename qw(basename dirname);
  use DirHandle;
  
  our %Config_Override;
  
  use ExtUtils::MakeMaker qw($Verbose neatvalue);
  
  # If we make $VERSION an our variable parse_version() breaks
  use vars qw($VERSION);
  $VERSION = '7.04';
  $VERSION = eval $VERSION;  ## no critic [BuiltinFunctions::ProhibitStringyEval]
  
  require ExtUtils::MM_Any;
  our @ISA = qw(ExtUtils::MM_Any);
  
  my %Is;
  BEGIN {
      $Is{OS2}     = $^O eq 'os2';
      $Is{Win32}   = $^O eq 'MSWin32' || $Config{osname} eq 'NetWare';
      $Is{Dos}     = $^O eq 'dos';
      $Is{VMS}     = $^O eq 'VMS';
      $Is{OSF}     = $^O eq 'dec_osf';
      $Is{IRIX}    = $^O eq 'irix';
      $Is{NetBSD}  = $^O eq 'netbsd';
      $Is{Interix} = $^O eq 'interix';
      $Is{SunOS4}  = $^O eq 'sunos';
      $Is{Solaris} = $^O eq 'solaris';
      $Is{SunOS}   = $Is{SunOS4} || $Is{Solaris};
      $Is{BSD}     = ($^O =~ /^(?:free|net|open)bsd$/ or
                     grep( $^O eq $_, qw(bsdos interix dragonfly) )
                    );
      $Is{Android} = $^O =~ /android/;
  }
  
  BEGIN {
      if( $Is{VMS} ) {
          # For things like vmsify()
          require VMS::Filespec;
          VMS::Filespec->import;
      }
  }
  
  
  =head1 NAME
  
  ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
  C<require ExtUtils::MM_Unix;>
  
  =head1 DESCRIPTION
  
  The methods provided by this package are designed to be used in
  conjunction with ExtUtils::MakeMaker. When MakeMaker writes a
  Makefile, it creates one or more objects that inherit their methods
  from a package C<MM>. MM itself doesn't provide any methods, but it
  ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating
  specific packages take the responsibility for all the methods provided
  by MM_Unix. We are trying to reduce the number of the necessary
  overrides by defining rather primitive operations within
  ExtUtils::MM_Unix.
  
  If you are going to write a platform specific MM package, please try
  to limit the necessary overrides to primitive methods, and if it is not
  possible to do so, let's work out how to achieve that gain.
  
  If you are overriding any of these methods in your Makefile.PL (in the
  MY class), please report that to the makemaker mailing list. We are
  trying to minimize the necessary method overrides and switch to data
  driven Makefile.PLs wherever possible. In the long run less methods
  will be overridable via the MY class.
  
  =head1 METHODS
  
  The following description of methods is still under
  development. Please refer to the code for not suitably documented
  sections and complain loudly to the makemaker@perl.org mailing list.
  Better yet, provide a patch.
  
  Not all of the methods below are overridable in a
  Makefile.PL. Overridable methods are marked as (o). All methods are
  overridable by a platform specific MM_*.pm file.
  
  Cross-platform methods are being moved into MM_Any.  If you can't find
  something that used to be in here, look in MM_Any.
  
  =cut
  
  # So we don't have to keep calling the methods over and over again,
  # we have these globals to cache the values.  Faster and shrtr.
  my $Curdir  = __PACKAGE__->curdir;
  my $Rootdir = __PACKAGE__->rootdir;
  my $Updir   = __PACKAGE__->updir;
  
  
  =head2 Methods
  
  =over 4
  
  =item os_flavor
  
  Simply says that we're Unix.
  
  =cut
  
  sub os_flavor {
      return('Unix');
  }
  
  
  =item c_o (o)
  
  Defines the suffix rules to compile different flavors of C files to
  object files.
  
  =cut
  
  sub c_o {
  # --- Translation Sections ---
  
      my($self) = shift;
      return '' unless $self->needs_linking();
      my(@m);
  
      my $command = '$(CCCMD)';
      my $flags   = '$(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE)';
  
      if (my $cpp = $Config{cpprun}) {
          my $cpp_cmd = $self->const_cccmd;
          $cpp_cmd =~ s/^CCCMD\s*=\s*\$\(CC\)/$cpp/;
          push @m, qq{
  .c.i:
  	$cpp_cmd $flags \$*.c > \$*.i
  };
      }
  
      push @m, qq{
  .c.s:
  	$command -S $flags \$*.c
  
  .c\$(OBJ_EXT):
  	$command $flags \$*.c
  
  .cpp\$(OBJ_EXT):
  	$command $flags \$*.cpp
  
  .cxx\$(OBJ_EXT):
  	$command $flags \$*.cxx
  
  .cc\$(OBJ_EXT):
  	$command $flags \$*.cc
  };
  
      push @m, qq{
  .C\$(OBJ_EXT):
  	$command $flags \$*.C
  } if !$Is{OS2} and !$Is{Win32} and !$Is{Dos}; #Case-specific
  
      return join "", @m;
  }
  
  =item cflags (o)
  
  Does very much the same as the cflags script in the perl
  distribution. It doesn't return the whole compiler command line, but
  initializes all of its parts. The const_cccmd method then actually
  returns the definition of the CCCMD macro which uses these parts.
  
  =cut
  
  #'
  
  sub cflags {
      my($self,$libperl)=@_;
      return $self->{CFLAGS} if $self->{CFLAGS};
      return '' unless $self->needs_linking();
  
      my($prog, $uc, $perltype, %cflags);
      $libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ;
      $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/;
  
      @cflags{qw(cc ccflags optimize shellflags)}
  	= @Config{qw(cc ccflags optimize shellflags)};
  
      # Perl 5.21.4 adds the (gcc) warning (-Wall ...) and std (-std=c89)
      # flags to the %Config, and the modules in the core should be built
      # with the warning flags, but NOT the -std=c89 flags (the latter
      # would break using any system header files that are strict C99).
      my @ccextraflags = qw(ccwarnflags);
      if ($ENV{PERL_CORE}) {
        for my $x (@ccextraflags) {
          if (exists $Config{$x}) {
            $cflags{$x} = $Config{$x};
          }
        }
      }
  
      my($optdebug) = "";
  
      $cflags{shellflags} ||= '';
  
      my(%map) =  (
  		D =>   '-DDEBUGGING',
  		E =>   '-DEMBED',
  		DE =>  '-DDEBUGGING -DEMBED',
  		M =>   '-DEMBED -DMULTIPLICITY',
  		DM =>  '-DDEBUGGING -DEMBED -DMULTIPLICITY',
  		);
  
      if ($libperl =~ /libperl(\w*)\Q$self->{LIB_EXT}/){
  	$uc = uc($1);
      } else {
  	$uc = ""; # avoid warning
      }
      $perltype = $map{$uc} ? $map{$uc} : "";
  
      if ($uc =~ /^D/) {
  	$optdebug = "-g";
      }
  
  
      my($name);
      ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
      if ($prog = $Config{$name}) {
  	# Expand hints for this extension via the shell
  	print "Processing $name hint:\n" if $Verbose;
  	my(@o)=`cc=\"$cflags{cc}\"
  	  ccflags=\"$cflags{ccflags}\"
  	  optimize=\"$cflags{optimize}\"
  	  perltype=\"$cflags{perltype}\"
  	  optdebug=\"$cflags{optdebug}\"
  	  eval '$prog'
  	  echo cc=\$cc
  	  echo ccflags=\$ccflags
  	  echo optimize=\$optimize
  	  echo perltype=\$perltype
  	  echo optdebug=\$optdebug
  	  `;
  	foreach my $line (@o){
  	    chomp $line;
  	    if ($line =~ /(.*?)=\s*(.*)\s*$/){
  		$cflags{$1} = $2;
  		print "	$1 = $2\n" if $Verbose;
  	    } else {
  		print "Unrecognised result from hint: '$line'\n";
  	    }
  	}
      }
  
      if ($optdebug) {
  	$cflags{optimize} = $optdebug;
      }
  
      for (qw(ccflags optimize perltype)) {
          $cflags{$_} ||= '';
  	$cflags{$_} =~ s/^\s+//;
  	$cflags{$_} =~ s/\s+/ /g;
  	$cflags{$_} =~ s/\s+$//;
  	$self->{uc $_} ||= $cflags{$_};
      }
  
      if ($self->{POLLUTE}) {
  	$self->{CCFLAGS} .= ' -DPERL_POLLUTE ';
      }
  
      for my $x (@ccextraflags) {
        next unless exists $cflags{$x};
        $self->{CCFLAGS} .= $cflags{$x} =~ m!^\s! ? $cflags{$x} : ' ' . $cflags{$x};
      }
  
      my $pollute = '';
      if ($Config{usemymalloc} and not $Config{bincompat5005}
  	and not $Config{ccflags} =~ /-DPERL_POLLUTE_MALLOC\b/
  	and $self->{PERL_MALLOC_OK}) {
  	$pollute = '$(PERL_MALLOC_DEF)';
      }
  
      $self->{CCFLAGS}  = quote_paren($self->{CCFLAGS});
      $self->{OPTIMIZE} = quote_paren($self->{OPTIMIZE});
  
      return $self->{CFLAGS} = qq{
  CCFLAGS = $self->{CCFLAGS}
  OPTIMIZE = $self->{OPTIMIZE}
  PERLTYPE = $self->{PERLTYPE}
  MPOLLUTE = $pollute
  };
  
  }
  
  
  =item const_cccmd (o)
  
  Returns the full compiler call for C programs and stores the
  definition in CONST_CCCMD.
  
  =cut
  
  sub const_cccmd {
      my($self,$libperl)=@_;
      return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
      return '' unless $self->needs_linking();
      return $self->{CONST_CCCMD} =
  	q{CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \\
  	$(CCFLAGS) $(OPTIMIZE) \\
  	$(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \\
  	$(XS_DEFINE_VERSION)};
  }
  
  =item const_config (o)
  
  Defines a couple of constants in the Makefile that are imported from
  %Config.
  
  =cut
  
  sub const_config {
  # --- Constants Sections ---
  
      my($self) = shift;
      my @m = <<"END";
  
  # These definitions are from config.sh (via $INC{'Config.pm'}).
  # They may have been overridden via Makefile.PL or on the command line.
  END
  
      my(%once_only);
      foreach my $key (@{$self->{CONFIG}}){
          # SITE*EXP macros are defined in &constants; avoid duplicates here
          next if $once_only{$key};
          $self->{uc $key} = quote_paren($self->{uc $key});
          push @m, uc($key) , ' = ' , $self->{uc $key}, "\n";
          $once_only{$key} = 1;
      }
      join('', @m);
  }
  
  =item const_loadlibs (o)
  
  Defines EXTRALIBS, LDLOADLIBS, BSLOADLIBS, LD_RUN_PATH. See
  L<ExtUtils::Liblist> for details.
  
  =cut
  
  sub const_loadlibs {
      my($self) = shift;
      return "" unless $self->needs_linking;
      my @m;
      push @m, qq{
  # $self->{NAME} might depend on some other libraries:
  # See ExtUtils::Liblist for details
  #
  };
      for my $tmp (qw/
           EXTRALIBS LDLOADLIBS BSLOADLIBS
           /) {
          next unless defined $self->{$tmp};
          push @m, "$tmp = $self->{$tmp}\n";
      }
      # don't set LD_RUN_PATH if empty
      for my $tmp (qw/
           LD_RUN_PATH
           /) {
          next unless $self->{$tmp};
          push @m, "$tmp = $self->{$tmp}\n";
      }
      return join "", @m;
  }
  
  =item constants (o)
  
    my $make_frag = $mm->constants;
  
  Prints out macros for lots of constants.
  
  =cut
  
  sub constants {
      my($self) = @_;
      my @m = ();
  
      $self->{DFSEP} = '$(DIRFILESEP)';  # alias for internal use
  
      for my $macro (qw(
  
                AR_STATIC_ARGS DIRFILESEP DFSEP
                NAME NAME_SYM
                VERSION    VERSION_MACRO    VERSION_SYM DEFINE_VERSION
                XS_VERSION XS_VERSION_MACRO             XS_DEFINE_VERSION
                INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB
                INST_MAN1DIR INST_MAN3DIR
                MAN1EXT      MAN3EXT
                INSTALLDIRS INSTALL_BASE DESTDIR PREFIX
                PERLPREFIX      SITEPREFIX      VENDORPREFIX
                     ),
                     (map { ("INSTALL".$_,
                            "DESTINSTALL".$_)
                          } $self->installvars),
                     qw(
                PERL_LIB
                PERL_ARCHLIB PERL_ARCHLIBDEP
                LIBPERL_A MYEXTLIB
                FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE
                PERLMAINCC PERL_SRC PERL_INC PERL_INCDEP
                PERL            FULLPERL          ABSPERL
                PERLRUN         FULLPERLRUN       ABSPERLRUN
                PERLRUNINST     FULLPERLRUNINST   ABSPERLRUNINST
                PERL_CORE
                PERM_DIR PERM_RW PERM_RWX
  
  	      ) )
      {
  	next unless defined $self->{$macro};
  
          # pathnames can have sharp signs in them; escape them so
          # make doesn't think it is a comment-start character.
          $self->{$macro} =~ s/#/\\#/g;
  	$self->{$macro} = $self->quote_dep($self->{$macro})
  	  if $ExtUtils::MakeMaker::macro_dep{$macro};
  	push @m, "$macro = $self->{$macro}\n";
      }
  
      push @m, qq{
  MAKEMAKER   = $self->{MAKEMAKER}
  MM_VERSION  = $self->{MM_VERSION}
  MM_REVISION = $self->{MM_REVISION}
  };
  
      push @m, q{
  # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
  # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
  # PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
  # DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
  };
  
      for my $macro (qw/
                MAKE
  	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
  	      LDFROM LINKTYPE BOOTDEP
  	      /	)
      {
  	next unless defined $self->{$macro};
  	push @m, "$macro = $self->{$macro}\n";
      }
  
      push @m, "
  # Handy lists of source code files:
  XS_FILES = ".$self->wraplist(sort keys %{$self->{XS}})."
  C_FILES  = ".$self->wraplist(@{$self->{C}})."
  O_FILES  = ".$self->wraplist(@{$self->{O_FILES}})."
  H_FILES  = ".$self->wraplist(@{$self->{H}})."
  MAN1PODS = ".$self->wraplist(sort keys %{$self->{MAN1PODS}})."
  MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})."
  ";
  
  
      push @m, q{
  # Where is the Config information that we are using/depend on
  CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h
  } if -e File::Spec->catfile( $self->{PERL_INC}, 'config.h' );
  
  
      push @m, qq{
  # Where to build things
  INST_LIBDIR      = $self->{INST_LIBDIR}
  INST_ARCHLIBDIR  = $self->{INST_ARCHLIBDIR}
  
  INST_AUTODIR     = $self->{INST_AUTODIR}
  INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR}
  
  INST_STATIC      = $self->{INST_STATIC}
  INST_DYNAMIC     = $self->{INST_DYNAMIC}
  INST_BOOT        = $self->{INST_BOOT}
  };
  
      push @m, qq{
  # Extra linker info
  EXPORT_LIST        = $self->{EXPORT_LIST}
  PERL_ARCHIVE       = $self->{PERL_ARCHIVE}
  PERL_ARCHIVEDEP    = $self->{PERL_ARCHIVEDEP}
  PERL_ARCHIVE_AFTER = $self->{PERL_ARCHIVE_AFTER}
  };
  
      push @m, "
  
  TO_INST_PM = ".$self->wraplist(sort keys %{$self->{PM}})."
  
  PM_TO_BLIB = ".$self->wraplist(map { ($_ => $self->{PM}->{$_}) } sort keys %{$self->{PM}})."
  ";
  
      join('',@m);
  }
  
  
  =item depend (o)
  
  Same as macro for the depend attribute.
  
  =cut
  
  sub depend {
      my($self,%attribs) = @_;
      my(@m,$key,$val);
      while (($key,$val) = each %attribs){
  	last unless defined $key;
  	push @m, "$key : $val\n";
      }
      join "", @m;
  }
  
  
  =item init_DEST
  
    $mm->init_DEST
  
  Defines the DESTDIR and DEST* variables paralleling the INSTALL*.
  
  =cut
  
  sub init_DEST {
      my $self = shift;
  
      # Initialize DESTDIR
      $self->{DESTDIR} ||= '';
  
      # Make DEST variables.
      foreach my $var ($self->installvars) {
          my $destvar = 'DESTINSTALL'.$var;
          $self->{$destvar} ||= '$(DESTDIR)$(INSTALL'.$var.')';
      }
  }
  
  
  =item init_dist
  
    $mm->init_dist;
  
  Defines a lot of macros for distribution support.
  
    macro         description                     default
  
    TAR           tar command to use              tar
    TARFLAGS      flags to pass to TAR            cvf
  
    ZIP           zip command to use              zip
    ZIPFLAGS      flags to pass to ZIP            -r
  
    COMPRESS      compression command to          gzip --best
                  use for tarfiles
    SUFFIX        suffix to put on                .gz
                  compressed files
  
    SHAR          shar command to use             shar
  
    PREOP         extra commands to run before
                  making the archive
    POSTOP        extra commands to run after
                  making the archive
  
    TO_UNIX       a command to convert linefeeds
                  to Unix style in your archive
  
    CI            command to checkin your         ci -u
                  sources to version control
    RCS_LABEL     command to label your sources   rcs -Nv$(VERSION_SYM): -q
                  just after CI is run
  
    DIST_CP       $how argument to manicopy()     best
                  when the distdir is created
  
    DIST_DEFAULT  default target to use to        tardist
                  create a distribution
  
    DISTVNAME     name of the resulting archive   $(DISTNAME)-$(VERSION)
                  (minus suffixes)
  
  =cut
  
  sub init_dist {
      my $self = shift;
  
      $self->{TAR}      ||= 'tar';
      $self->{TARFLAGS} ||= 'cvf';
      $self->{ZIP}      ||= 'zip';
      $self->{ZIPFLAGS} ||= '-r';
      $self->{COMPRESS} ||= 'gzip --best';
      $self->{SUFFIX}   ||= '.gz';
      $self->{SHAR}     ||= 'shar';
      $self->{PREOP}    ||= '$(NOECHO) $(NOOP)'; # eg update MANIFEST
      $self->{POSTOP}   ||= '$(NOECHO) $(NOOP)'; # eg remove the distdir
      $self->{TO_UNIX}  ||= '$(NOECHO) $(NOOP)';
  
      $self->{CI}       ||= 'ci -u';
      $self->{RCS_LABEL}||= 'rcs -Nv$(VERSION_SYM): -q';
      $self->{DIST_CP}  ||= 'best';
      $self->{DIST_DEFAULT} ||= 'tardist';
  
      ($self->{DISTNAME} = $self->{NAME}) =~ s{::}{-}g unless $self->{DISTNAME};
      $self->{DISTVNAME} ||= $self->{DISTNAME}.'-'.$self->{VERSION};
  }
  
  =item dist (o)
  
    my $dist_macros = $mm->dist(%overrides);
  
  Generates a make fragment defining all the macros initialized in
  init_dist.
  
  %overrides can be used to override any of the above.
  
  =cut
  
  sub dist {
      my($self, %attribs) = @_;
  
      my $make = '';
      if ( $attribs{SUFFIX} && $attribs{SUFFIX} !~ m!^\.! ) {
        $attribs{SUFFIX} = '.' . $attribs{SUFFIX};
      }
      foreach my $key (qw(
              TAR TARFLAGS ZIP ZIPFLAGS COMPRESS SUFFIX SHAR
              PREOP POSTOP TO_UNIX
              CI RCS_LABEL DIST_CP DIST_DEFAULT
              DISTNAME DISTVNAME
             ))
      {
          my $value = $attribs{$key} || $self->{$key};
          $make .= "$key = $value\n";
      }
  
      return $make;
  }
  
  =item dist_basics (o)
  
  Defines the targets distclean, distcheck, skipcheck, manifest, veryclean.
  
  =cut
  
  sub dist_basics {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  distclean :: realclean distcheck
  	$(NOECHO) $(NOOP)
  
  distcheck :
  	$(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
  
  skipcheck :
  	$(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
  
  manifest :
  	$(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
  
  veryclean : realclean
  	$(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old
  
  MAKE_FRAG
  
  }
  
  =item dist_ci (o)
  
  Defines a check in target for RCS.
  
  =cut
  
  sub dist_ci {
      my($self) = shift;
      return q{
  ci :
  	$(PERLRUN) "-MExtUtils::Manifest=maniread" \\
  	  -e "@all = keys %{ maniread() };" \\
  	  -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \\
  	  -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
  };
  }
  
  =item dist_core (o)
  
    my $dist_make_fragment = $MM->dist_core;
  
  Puts the targets necessary for 'make dist' together into one make
  fragment.
  
  =cut
  
  sub dist_core {
      my($self) = shift;
  
      my $make_frag = '';
      foreach my $target (qw(dist tardist uutardist tarfile zipdist zipfile
                             shdist))
      {
          my $method = $target.'_target';
          $make_frag .= "\n";
          $make_frag .= $self->$method();
      }
  
      return $make_frag;
  }
  
  
  =item B<dist_target>
  
    my $make_frag = $MM->dist_target;
  
  Returns the 'dist' target to make an archive for distribution.  This
  target simply checks to make sure the Makefile is up-to-date and
  depends on $(DIST_DEFAULT).
  
  =cut
  
  sub dist_target {
      my($self) = shift;
  
      my $date_check = $self->oneliner(<<'CODE', ['-l']);
  print 'Warning: Makefile possibly out of date with $(VERSION_FROM)'
      if -e '$(VERSION_FROM)' and -M '$(VERSION_FROM)' < -M '$(FIRST_MAKEFILE)';
  CODE
  
      return sprintf <<'MAKE_FRAG', $date_check;
  dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
  	$(NOECHO) %s
  MAKE_FRAG
  }
  
  =item B<tardist_target>
  
    my $make_frag = $MM->tardist_target;
  
  Returns the 'tardist' target which is simply so 'make tardist' works.
  The real work is done by the dynamically named tardistfile_target()
  method, tardist should have that as a dependency.
  
  =cut
  
  sub tardist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  tardist : $(DISTVNAME).tar$(SUFFIX)
  	$(NOECHO) $(NOOP)
  MAKE_FRAG
  }
  
  =item B<zipdist_target>
  
    my $make_frag = $MM->zipdist_target;
  
  Returns the 'zipdist' target which is simply so 'make zipdist' works.
  The real work is done by the dynamically named zipdistfile_target()
  method, zipdist should have that as a dependency.
  
  =cut
  
  sub zipdist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  zipdist : $(DISTVNAME).zip
  	$(NOECHO) $(NOOP)
  MAKE_FRAG
  }
  
  =item B<tarfile_target>
  
    my $make_frag = $MM->tarfile_target;
  
  The name of this target is the name of the tarball generated by
  tardist.  This target does the actual work of turning the distdir into
  a tarball.
  
  =cut
  
  sub tarfile_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  $(DISTVNAME).tar$(SUFFIX) : distdir
  	$(PREOP)
  	$(TO_UNIX)
  	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
  	$(RM_RF) $(DISTVNAME)
  	$(COMPRESS) $(DISTVNAME).tar
  	$(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)'
  	$(POSTOP)
  MAKE_FRAG
  }
  
  =item zipfile_target
  
    my $make_frag = $MM->zipfile_target;
  
  The name of this target is the name of the zip file generated by
  zipdist.  This target does the actual work of turning the distdir into
  a zip file.
  
  =cut
  
  sub zipfile_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  $(DISTVNAME).zip : distdir
  	$(PREOP)
  	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
  	$(RM_RF) $(DISTVNAME)
  	$(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip'
  	$(POSTOP)
  MAKE_FRAG
  }
  
  =item uutardist_target
  
    my $make_frag = $MM->uutardist_target;
  
  Converts the tarfile into a uuencoded file
  
  =cut
  
  sub uutardist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  uutardist : $(DISTVNAME).tar$(SUFFIX)
  	uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
  	$(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu'
  MAKE_FRAG
  }
  
  
  =item shdist_target
  
    my $make_frag = $MM->shdist_target;
  
  Converts the distdir into a shell archive.
  
  =cut
  
  sub shdist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  shdist : distdir
  	$(PREOP)
  	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
  	$(RM_RF) $(DISTVNAME)
  	$(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar'
  	$(POSTOP)
  MAKE_FRAG
  }
  
  
  =item dlsyms (o)
  
  Used by some OS' to define DL_FUNCS and DL_VARS and write the *.exp files.
  
  Normally just returns an empty string.
  
  =cut
  
  sub dlsyms {
      return '';
  }
  
  
  =item dynamic_bs (o)
  
  Defines targets for bootstrap files.
  
  =cut
  
  sub dynamic_bs {
      my($self, %attribs) = @_;
      return '
  BOOTSTRAP =
  ' unless $self->has_link_code();
  
      my $target = $Is{VMS} ? '$(MMS$TARGET)' : '$@';
  
      return sprintf <<'MAKE_FRAG', ($target) x 2;
  BOOTSTRAP = $(BASEEXT).bs
  
  # As Mkbootstrap might not write a file (if none is required)
  # we use touch to prevent make continually trying to remake it.
  # The DynaLoader only reads a non-empty file.
  $(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
  	$(NOECHO) $(PERLRUN) \
  		"-MExtUtils::Mkbootstrap" \
  		-e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
  	$(NOECHO) $(TOUCH) "%s"
  	$(CHMOD) $(PERM_RW) "%s"
  MAKE_FRAG
  }
  
  =item dynamic_lib (o)
  
  Defines how to produce the *.so (or equivalent) files.
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      return '' unless $self->needs_linking(); #might be because of a subdir
  
      return '' unless $self->has_link_code;
  
      my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
      my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
      my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":";
      my($ldfrom) = '$(LDFROM)';
      $armaybe = 'ar' if ($Is{OSF} and $armaybe eq ':');
      my(@m);
      my $ld_opt = $Is{OS2} ? '$(OPTIMIZE) ' : '';	# Useful on other systems too?
      my $ld_fix = $Is{OS2} ? '|| ( $(RM_F) $@ && sh -c false )' : '';
      push(@m,'
  # This section creates the dynamically loadable $(INST_DYNAMIC)
  # from $(OBJECT) and possibly $(MYEXTLIB).
  ARMAYBE = '.$armaybe.'
  OTHERLDFLAGS = '.$ld_opt.$otherldflags.'
  INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  INST_DYNAMIC_FIX = '.$ld_fix.'
  
  $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVEDEP) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
  ');
      if ($armaybe ne ':'){
  	$ldfrom = 'tmp$(LIB_EXT)';
  	push(@m,'	$(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n");
  	push(@m,'	$(RANLIB) '."$ldfrom\n");
      }
      $ldfrom = "-all $ldfrom -none" if $Is{OSF};
  
      # The IRIX linker doesn't use LD_RUN_PATH
      my $ldrun = $Is{IRIX} && $self->{LD_RUN_PATH} ?
                         qq{-rpath "$self->{LD_RUN_PATH}"} : '';
  
      # For example in AIX the shared objects/libraries from previous builds
      # linger quite a while in the shared dynalinker cache even when nobody
      # is using them.  This is painful if one for instance tries to restart
      # a failed build because the link command will fail unnecessarily 'cos
      # the shared object/library is 'busy'.
      push(@m,'	$(RM_F) $@
  ');
  
      my $libs = '$(LDLOADLIBS)';
  
      if (($Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') {
  	# Use nothing on static perl platforms, and to the flags needed
  	# to link against the shared libperl library on shared perl
  	# platforms.  We peek at lddlflags to see if we need -Wl,-R
  	# or -R to add paths to the run-time library search path.
          if ($Config{'lddlflags'} =~ /-Wl,-R/) {
              $libs .= ' "-L$(PERL_INC)" "-Wl,-R$(INSTALLARCHLIB)/CORE" "-Wl,-R$(PERL_ARCHLIB)/CORE" -lperl';
          } elsif ($Config{'lddlflags'} =~ /-R/) {
              $libs .= ' "-L$(PERL_INC)" "-R$(INSTALLARCHLIB)/CORE" "-R$(PERL_ARCHLIB)/CORE" -lperl';
          } elsif ( $Is{Android} ) {
              # The Android linker will not recognize symbols from
              # libperl unless the module explicitly depends on it.
              $libs .= ' "-L$(PERL_INC)" -lperl';
          }
      }
  
      my $ld_run_path_shell = "";
      if ($self->{LD_RUN_PATH} ne "") {
  	$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
      }
  
      push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $ldfrom, $libs;
  	%s$(LD) %s $(LDDLFLAGS) %s $(OTHERLDFLAGS) -o $@ $(MYEXTLIB)	\
  	  $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST)	\
  	  $(INST_DYNAMIC_FIX)
  MAKE
  
      push @m, <<'MAKE';
  	$(CHMOD) $(PERM_RWX) $@
  	$(NOECHO) $(RM_RF) $(BOOTSTRAP)
  	- $(CP_NONEMPTY) $(BOOTSTRAP) $(INST_BOOT) $(PERM_RW)
  MAKE
  
      return join('',@m);
  }
  
  =item exescan
  
  Deprecated method. Use libscan instead.
  
  =cut
  
  sub exescan {
      my($self,$path) = @_;
      $path;
  }
  
  =item extliblist
  
  Called by init_others, and calls ext ExtUtils::Liblist. See
  L<ExtUtils::Liblist> for details.
  
  =cut
  
  sub extliblist {
      my($self,$libs) = @_;
      require ExtUtils::Liblist;
      $self->ext($libs, $Verbose);
  }
  
  =item find_perl
  
  Finds the executables PERL and FULLPERL
  
  =cut
  
  sub find_perl {
      my($self, $ver, $names, $dirs, $trace) = @_;
  
      if ($trace >= 2){
          print "Looking for perl $ver by these names:
  @$names
  in these dirs:
  @$dirs
  ";
      }
  
      my $stderr_duped = 0;
      local *STDERR_COPY;
  
      unless ($Is{BSD}) {
          # >& and lexical filehandles together give 5.6.2 indigestion
          if( open(STDERR_COPY, '>&STDERR') ) {  ## no critic
              $stderr_duped = 1;
          }
          else {
              warn <<WARNING;
  find_perl() can't dup STDERR: $!
  You might see some garbage while we search for Perl
  WARNING
          }
      }
  
      foreach my $name (@$names){
          foreach my $dir (@$dirs){
              next unless defined $dir; # $self->{PERL_SRC} may be undefined
              my ($abs, $val);
              if ($self->file_name_is_absolute($name)) {     # /foo/bar
                  $abs = $name;
              } elsif ($self->canonpath($name) eq
                       $self->canonpath(basename($name))) {  # foo
                  $abs = $self->catfile($dir, $name);
              } else {                                            # foo/bar
                  $abs = $self->catfile($Curdir, $name);
              }
              print "Checking $abs\n" if ($trace >= 2);
              next unless $self->maybe_command($abs);
              print "Executing $abs\n" if ($trace >= 2);
  
              my $version_check = qq{"$abs" -le "require $ver; print qq{VER_OK}"};
  
              # To avoid using the unportable 2>&1 to suppress STDERR,
              # we close it before running the command.
              # However, thanks to a thread library bug in many BSDs
              # ( http://www.freebsd.org/cgi/query-pr.cgi?pr=51535 )
              # we cannot use the fancier more portable way in here
              # but instead need to use the traditional 2>&1 construct.
              if ($Is{BSD}) {
                  $val = `$version_check 2>&1`;
              } else {
                  close STDERR if $stderr_duped;
                  $val = `$version_check`;
  
                  # 5.6.2's 3-arg open doesn't work with >&
                  open STDERR, ">&STDERR_COPY"  ## no critic
                          if $stderr_duped;
              }
  
              if ($val =~ /^VER_OK/m) {
                  print "Using PERL=$abs\n" if $trace;
                  return $abs;
              } elsif ($trace >= 2) {
                  print "Result: '$val' ".($? >> 8)."\n";
              }
          }
      }
      print "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
      0; # false and not empty
  }
  
  
  =item fixin
  
    $mm->fixin(@files);
  
  Inserts the sharpbang or equivalent magic number to a set of @files.
  
  =cut
  
  sub fixin {    # stolen from the pink Camel book, more or less
      my ( $self, @files ) = @_;
  
      for my $file (@files) {
          my $file_new = "$file.new";
          my $file_bak = "$file.bak";
  
          open( my $fixin, '<', $file ) or croak "Can't process '$file': $!";
          local $/ = "\n";
          chomp( my $line = <$fixin> );
          next unless $line =~ s/^\s*\#!\s*//;    # Not a shebang file.
  
          my $shb = $self->_fixin_replace_shebang( $file, $line );
          next unless defined $shb;
  
          open( my $fixout, ">", "$file_new" ) or do {
              warn "Can't create new $file: $!\n";
              next;
          };
  
          # Print out the new #! line (or equivalent).
          local $\;
          local $/;
          print $fixout $shb, <$fixin>;
          close $fixin;
          close $fixout;
  
          chmod 0666, $file_bak;
          unlink $file_bak;
          unless ( _rename( $file, $file_bak ) ) {
              warn "Can't rename $file to $file_bak: $!";
              next;
          }
          unless ( _rename( $file_new, $file ) ) {
              warn "Can't rename $file_new to $file: $!";
              unless ( _rename( $file_bak, $file ) ) {
                  warn "Can't rename $file_bak back to $file either: $!";
                  warn "Leaving $file renamed as $file_bak\n";
              }
              next;
          }
          unlink $file_bak;
      }
      continue {
          system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
      }
  }
  
  
  sub _rename {
      my($old, $new) = @_;
  
      foreach my $file ($old, $new) {
          if( $Is{VMS} and basename($file) !~ /\./ ) {
              # rename() in 5.8.0 on VMS will not rename a file if it
              # does not contain a dot yet it returns success.
              $file = "$file.";
          }
      }
  
      return rename($old, $new);
  }
  
  sub _fixin_replace_shebang {
      my ( $self, $file, $line ) = @_;
  
      # Now figure out the interpreter name.
      my ( $cmd, $arg ) = split ' ', $line, 2;
      $cmd =~ s!^.*/!!;
  
      # Now look (in reverse) for interpreter in absolute PATH (unless perl).
      my $interpreter;
      if ( $cmd =~ m{^perl(?:\z|[^a-z])} ) {
          if ( $Config{startperl} =~ m,^\#!.*/perl, ) {
              $interpreter = $Config{startperl};
              $interpreter =~ s,^\#!,,;
          }
          else {
              $interpreter = $Config{perlpath};
          }
      }
      else {
          my (@absdirs)
              = reverse grep { $self->file_name_is_absolute($_) } $self->path;
          $interpreter = '';
  
           foreach my $dir (@absdirs) {
              if ( $self->maybe_command($cmd) ) {
                  warn "Ignoring $interpreter in $file\n"
                      if $Verbose && $interpreter;
                  $interpreter = $self->catfile( $dir, $cmd );
              }
          }
      }
  
      # Figure out how to invoke interpreter on this machine.
  
      my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/;
      my ($shb) = "";
      if ($interpreter) {
          print "Changing sharpbang in $file to $interpreter"
              if $Verbose;
           # this is probably value-free on DOSISH platforms
          if ($does_shbang) {
              $shb .= "$Config{'sharpbang'}$interpreter";
              $shb .= ' ' . $arg if defined $arg;
              $shb .= "\n";
          }
      }
      else {
          warn "Can't find $cmd in PATH, $file unchanged"
              if $Verbose;
          return;
      }
      return $shb
  }
  
  =item force (o)
  
  Writes an empty FORCE: target.
  
  =cut
  
  sub force {
      my($self) = shift;
      '# Phony target to force checking subdirectories.
  FORCE :
  	$(NOECHO) $(NOOP)
  ';
  }
  
  =item guess_name
  
  Guess the name of this package by examining the working directory's
  name. MakeMaker calls this only if the developer has not supplied a
  NAME attribute.
  
  =cut
  
  # ';
  
  sub guess_name {
      my($self) = @_;
      use Cwd 'cwd';
      my $name = basename(cwd());
      $name =~ s|[\-_][\d\.\-]+\z||;  # this is new with MM 5.00, we
                                      # strip minus or underline
                                      # followed by a float or some such
      print "Warning: Guessing NAME [$name] from current directory name.\n";
      $name;
  }
  
  =item has_link_code
  
  Returns true if C, XS, MYEXTLIB or similar objects exist within this
  object that need a compiler. Does not descend into subdirectories as
  needs_linking() does.
  
  =cut
  
  sub has_link_code {
      my($self) = shift;
      return $self->{HAS_LINK_CODE} if defined $self->{HAS_LINK_CODE};
      if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}){
  	$self->{HAS_LINK_CODE} = 1;
  	return 1;
      }
      return $self->{HAS_LINK_CODE} = 0;
  }
  
  
  =item init_dirscan
  
  Scans the directory structure and initializes DIR, XS, XS_FILES,
  C, C_FILES, O_FILES, H, H_FILES, PL_FILES, EXE_FILES.
  
  Called by init_main.
  
  =cut
  
  sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
      my($self) = @_;
      my(%dir, %xs, %c, %o, %h, %pl_files, %pm);
  
      my %ignore = map {( $_ => 1 )} qw(Makefile.PL Build.PL test.pl t);
  
      # ignore the distdir
      $Is{VMS} ? $ignore{"$self->{DISTVNAME}.dir"} = 1
              : $ignore{$self->{DISTVNAME}} = 1;
  
      my $distprefix = $Is{VMS} ? qr/^\Q$self->{DISTNAME}\E-v?[\d\.]+\.dir$/i
                                : qr/^\Q$self->{DISTNAME}\E-v?[\d\.]+$/;
  
      @ignore{map lc, keys %ignore} = values %ignore if $Is{VMS};
  
      if ( defined $self->{XS} and !defined $self->{C} ) {
  	my @c_files = grep { m/\.c(pp|xx)?\z/i } values %{$self->{XS}};
  	my @o_files = grep { m/(?:.(?:o(?:bj)?)|\$\(OBJ_EXT\))\z/i } values %{$self->{XS}};
  	%c = map { $_ => 1 } @c_files;
  	%o = map { $_ => 1 } @o_files;
      }
  
      foreach my $name ($self->lsdir($Curdir)){
  	next if $name =~ /\#/;
  	next if $name =~ $distprefix && -d $name;
  	$name = lc($name) if $Is{VMS};
  	next if $name eq $Curdir or $name eq $Updir or $ignore{$name};
  	next unless $self->libscan($name);
  	if (-d $name){
  	    next if -l $name; # We do not support symlinks at all
              next if $self->{NORECURS};
  	    $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL"));
  	} elsif ($name =~ /\.xs\z/){
  	    my($c); ($c = $name) =~ s/\.xs\z/.c/;
  	    $xs{$name} = $c;
  	    $c{$c} = 1;
  	} elsif ($name =~ /\.c(pp|xx|c)?\z/i){  # .c .C .cpp .cxx .cc
  	    $c{$name} = 1
  		unless $name =~ m/perlmain\.c/; # See MAP_TARGET
  	} elsif ($name =~ /\.h\z/i){
  	    $h{$name} = 1;
  	} elsif ($name =~ /\.PL\z/) {
  	    ($pl_files{$name} = $name) =~ s/\.PL\z// ;
  	} elsif (($Is{VMS} || $Is{Dos}) && $name =~ /[._]pl$/i) {
  	    # case-insensitive filesystem, one dot per name, so foo.h.PL
  	    # under Unix appears as foo.h_pl under VMS or fooh.pl on Dos
  	    local($/); open(my $pl, '<', $name); my $txt = <$pl>; close $pl;
  	    if ($txt =~ /Extracting \S+ \(with variable substitutions/) {
  		($pl_files{$name} = $name) =~ s/[._]pl\z//i ;
  	    }
  	    else {
                  $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name);
              }
  	} elsif ($name =~ /\.(p[ml]|pod)\z/){
  	    $pm{$name} = $self->catfile($self->{INST_LIBDIR},$name);
  	}
      }
  
      $self->{PL_FILES}   ||= \%pl_files;
      $self->{DIR}        ||= [sort keys %dir];
      $self->{XS}         ||= \%xs;
      $self->{C}          ||= [sort keys %c];
      $self->{H}          ||= [sort keys %h];
      $self->{PM}         ||= \%pm;
  
      my @o_files = @{$self->{C}};
      %o = (%o, map { $_ => 1 } grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files);
      $self->{O_FILES} = [sort keys %o];
  }
  
  
  =item init_MANPODS
  
  Determines if man pages should be generated and initializes MAN1PODS
  and MAN3PODS as appropriate.
  
  =cut
  
  sub init_MANPODS {
      my $self = shift;
  
      # Set up names of manual pages to generate from pods
      foreach my $man (qw(MAN1 MAN3)) {
          if ( $self->{"${man}PODS"}
               or $self->{"INSTALL${man}DIR"} =~ /^(none|\s*)$/
          ) {
              $self->{"${man}PODS"} ||= {};
          }
          else {
              my $init_method = "init_${man}PODS";
              $self->$init_method();
          }
      }
  }
  
  
  sub _has_pod {
      my($self, $file) = @_;
  
      my($ispod)=0;
      if (open( my $fh, '<', $file )) {
          while (<$fh>) {
              if (/^=(?:head\d+|item|pod)\b/) {
                  $ispod=1;
                  last;
              }
          }
          close $fh;
      } else {
          # If it doesn't exist yet, we assume, it has pods in it
          $ispod = 1;
      }
  
      return $ispod;
  }
  
  
  =item init_MAN1PODS
  
  Initializes MAN1PODS from the list of EXE_FILES.
  
  =cut
  
  sub init_MAN1PODS {
      my($self) = @_;
  
      if ( exists $self->{EXE_FILES} ) {
  	foreach my $name (@{$self->{EXE_FILES}}) {
  	    next unless $self->_has_pod($name);
  
  	    $self->{MAN1PODS}->{$name} =
  		$self->catfile("\$(INST_MAN1DIR)",
  			       basename($name).".\$(MAN1EXT)");
  	}
      }
  }
  
  
  =item init_MAN3PODS
  
  Initializes MAN3PODS from the list of PM files.
  
  =cut
  
  sub init_MAN3PODS {
      my $self = shift;
  
      my %manifypods = (); # we collect the keys first, i.e. the files
                           # we have to convert to pod
  
      foreach my $name (keys %{$self->{PM}}) {
  	if ($name =~ /\.pod\z/ ) {
  	    $manifypods{$name} = $self->{PM}{$name};
  	} elsif ($name =~ /\.p[ml]\z/ ) {
  	    if( $self->_has_pod($name) ) {
  		$manifypods{$name} = $self->{PM}{$name};
  	    }
  	}
      }
  
      my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}};
  
      # Remove "Configure.pm" and similar, if it's not the only pod listed
      # To force inclusion, just name it "Configure.pod", or override
      # MAN3PODS
      foreach my $name (keys %manifypods) {
  	if ($self->{PERL_CORE} and $name =~ /(config|setup).*\.pm/is) {
  	    delete $manifypods{$name};
  	    next;
  	}
  	my($manpagename) = $name;
  	$manpagename =~ s/\.p(od|m|l)\z//;
  	# everything below lib is ok
  	unless($manpagename =~ s!^\W*($parentlibs_re)\W+!!s) {
  	    $manpagename = $self->catfile(
  	        split(/::/,$self->{PARENT_NAME}),$manpagename
  	    );
  	}
  	$manpagename = $self->replace_manpage_separator($manpagename);
  	$self->{MAN3PODS}->{$name} =
  	    $self->catfile("\$(INST_MAN3DIR)", "$manpagename.\$(MAN3EXT)");
      }
  }
  
  
  =item init_PM
  
  Initializes PMLIBDIRS and PM from PMLIBDIRS.
  
  =cut
  
  sub init_PM {
      my $self = shift;
  
      # Some larger extensions often wish to install a number of *.pm/pl
      # files into the library in various locations.
  
      # The attribute PMLIBDIRS holds an array reference which lists
      # subdirectories which we should search for library files to
      # install. PMLIBDIRS defaults to [ 'lib', $self->{BASEEXT} ].  We
      # recursively search through the named directories (skipping any
      # which don't exist or contain Makefile.PL files).
  
      # For each *.pm or *.pl file found $self->libscan() is called with
      # the default installation path in $_[1]. The return value of
      # libscan defines the actual installation location.  The default
      # libscan function simply returns the path.  The file is skipped
      # if libscan returns false.
  
      # The default installation location passed to libscan in $_[1] is:
      #
      #  ./*.pm		=> $(INST_LIBDIR)/*.pm
      #  ./xyz/...	=> $(INST_LIBDIR)/xyz/...
      #  ./lib/...	=> $(INST_LIB)/...
      #
      # In this way the 'lib' directory is seen as the root of the actual
      # perl library whereas the others are relative to INST_LIBDIR
      # (which includes PARENT_NAME). This is a subtle distinction but one
      # that's important for nested modules.
  
      unless( $self->{PMLIBDIRS} ) {
          if( $Is{VMS} ) {
              # Avoid logical name vs directory collisions
              $self->{PMLIBDIRS} = ['./lib', "./$self->{BASEEXT}"];
          }
          else {
              $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}];
          }
      }
  
      #only existing directories that aren't in $dir are allowed
  
      # Avoid $_ wherever possible:
      # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}};
      my (@pmlibdirs) = @{$self->{PMLIBDIRS}};
      @{$self->{PMLIBDIRS}} = ();
      my %dir = map { ($_ => $_) } @{$self->{DIR}};
      foreach my $pmlibdir (@pmlibdirs) {
  	-d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir;
      }
  
      unless( $self->{PMLIBPARENTDIRS} ) {
  	@{$self->{PMLIBPARENTDIRS}} = ('lib');
      }
  
      return if $self->{PM} and $self->{ARGS}{PM};
  
      if (@{$self->{PMLIBDIRS}}){
  	print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n"
  	    if ($Verbose >= 2);
  	require File::Find;
          File::Find::find(sub {
              if (-d $_){
                  unless ($self->libscan($_)){
                      $File::Find::prune = 1;
                  }
                  return;
              }
              return if /\#/;
              return if /~$/;             # emacs temp files
              return if /,v$/;            # RCS files
              return if m{\.swp$};        # vim swap files
  
  	    my $path   = $File::Find::name;
              my $prefix = $self->{INST_LIBDIR};
              my $striplibpath;
  
  	    my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}};
  	    $prefix =  $self->{INST_LIB}
                  if ($striplibpath = $path) =~ s{^(\W*)($parentlibs_re)\W}
  	                                       {$1}i;
  
  	    my($inst) = $self->catfile($prefix,$striplibpath);
  	    local($_) = $inst; # for backwards compatibility
  	    $inst = $self->libscan($inst);
  	    print "libscan($path) => '$inst'\n" if ($Verbose >= 2);
  	    return unless $inst;
  	    $self->{PM}{$path} = $inst;
  	}, @{$self->{PMLIBDIRS}});
      }
  }
  
  
  =item init_DIRFILESEP
  
  Using / for Unix.  Called by init_main.
  
  =cut
  
  sub init_DIRFILESEP {
      my($self) = shift;
  
      $self->{DIRFILESEP} = '/';
  }
  
  
  =item init_main
  
  Initializes AR, AR_STATIC_ARGS, BASEEXT, CONFIG, DISTNAME, DLBASE,
  EXE_EXT, FULLEXT, FULLPERL, FULLPERLRUN, FULLPERLRUNINST, INST_*,
  INSTALL*, INSTALLDIRS, LIB_EXT, LIBPERL_A, MAP_TARGET, NAME,
  OBJ_EXT, PARENT_NAME, PERL, PERL_ARCHLIB, PERL_INC, PERL_LIB,
  PERL_SRC, PERLRUN, PERLRUNINST, PREFIX, VERSION,
  VERSION_SYM, XS_VERSION.
  
  =cut
  
  sub init_main {
      my($self) = @_;
  
      # --- Initialize Module Name and Paths
  
      # NAME    = Foo::Bar::Oracle
      # FULLEXT = Foo/Bar/Oracle
      # BASEEXT = Oracle
      # PARENT_NAME = Foo::Bar
  ### Only UNIX:
  ###    ($self->{FULLEXT} =
  ###     $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket
      $self->{FULLEXT} = $self->catdir(split /::/, $self->{NAME});
  
  
      # Copied from DynaLoader:
  
      my(@modparts) = split(/::/,$self->{NAME});
      my($modfname) = $modparts[-1];
  
      # Some systems have restrictions on files names for DLL's etc.
      # mod2fname returns appropriate file base name (typically truncated)
      # It may also edit @modparts if required.
      # We require DynaLoader to make sure that mod2fname is loaded
      eval { require DynaLoader };
      if (defined &DynaLoader::mod2fname) {
          $modfname = &DynaLoader::mod2fname(\@modparts);
      }
  
      ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!(?:([\w:]+)::)?(\w+)\z! ;
      $self->{PARENT_NAME} ||= '';
  
      if (defined &DynaLoader::mod2fname) {
  	# As of 5.001m, dl_os2 appends '_'
  	$self->{DLBASE} = $modfname;
      } else {
  	$self->{DLBASE} = '$(BASEEXT)';
      }
  
  
      # --- Initialize PERL_LIB, PERL_SRC
  
      # *Real* information: where did we get these two from? ...
      my $inc_config_dir = dirname($INC{'Config.pm'});
      my $inc_carp_dir   = dirname($INC{'Carp.pm'});
  
      unless ($self->{PERL_SRC}){
          foreach my $dir_count (1..8) { # 8 is the VMS limit for nesting
              my $dir = $self->catdir(($Updir) x $dir_count);
  
              if (-f $self->catfile($dir,"config_h.SH")   &&
                  -f $self->catfile($dir,"perl.h")        &&
                  -f $self->catfile($dir,"lib","strict.pm")
              ) {
                  $self->{PERL_SRC}=$dir ;
                  last;
              }
          }
      }
  
      warn "PERL_CORE is set but I can't find your PERL_SRC!\n" if
        $self->{PERL_CORE} and !$self->{PERL_SRC};
  
      if ($self->{PERL_SRC}){
  	$self->{PERL_LIB}     ||= $self->catdir("$self->{PERL_SRC}","lib");
  
          $self->{PERL_ARCHLIB} = $self->{PERL_LIB};
          $self->{PERL_INC}     = ($Is{Win32}) ?
              $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC};
  
  	# catch a situation that has occurred a few times in the past:
  	unless (
  		-s $self->catfile($self->{PERL_SRC},'cflags')
  		or
  		$Is{VMS}
  		&&
  		-s $self->catfile($self->{PERL_SRC},'vmsish.h')
  		or
  		$Is{Win32}
  	       ){
  	    warn qq{
  You cannot build extensions below the perl source tree after executing
  a 'make clean' in the perl source tree.
  
  To rebuild extensions distributed with the perl source you should
  simply Configure (to include those extensions) and then build perl as
  normal. After installing perl the source tree can be deleted. It is
  not needed for building extensions by running 'perl Makefile.PL'
  usually without extra arguments.
  
  It is recommended that you unpack and build additional extensions away
  from the perl source tree.
  };
  	}
      } else {
  	# we should also consider $ENV{PERL5LIB} here
          my $old = $self->{PERL_LIB} || $self->{PERL_ARCHLIB} || $self->{PERL_INC};
  	$self->{PERL_LIB}     ||= $Config{privlibexp};
  	$self->{PERL_ARCHLIB} ||= $Config{archlibexp};
  	$self->{PERL_INC}     = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now
  	my $perl_h;
  
  	if (not -f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h"))
  	    and not $old){
  	    # Maybe somebody tries to build an extension with an
  	    # uninstalled Perl outside of Perl build tree
  	    my $lib;
  	    for my $dir (@INC) {
  	      $lib = $dir, last if -e $self->catfile($dir, "Config.pm");
  	    }
  	    if ($lib) {
                # Win32 puts its header files in /perl/src/lib/CORE.
                # Unix leaves them in /perl/src.
  	      my $inc = $Is{Win32} ? $self->catdir($lib, "CORE" )
                                    : dirname $lib;
  	      if (-e $self->catfile($inc, "perl.h")) {
  		$self->{PERL_LIB}	   = $lib;
  		$self->{PERL_ARCHLIB}	   = $lib;
  		$self->{PERL_INC}	   = $inc;
  		$self->{UNINSTALLED_PERL}  = 1;
  		print <<EOP;
  ... Detected uninstalled Perl.  Trying to continue.
  EOP
  	      }
  	    }
  	}
      }
  
      if ($Is{Android}) {
      	# Android fun times!
      	# ../../perl -I../../lib -MFile::Glob -e1 works
      	# ../../../perl -I../../../lib -MFile::Glob -e1 fails to find
      	# the .so for File::Glob.
      	# This always affects core perl, but may also affect an installed
      	# perl built with -Duserelocatableinc.
      	$self->{PERL_LIB} = File::Spec->rel2abs($self->{PERL_LIB});
      	$self->{PERL_ARCHLIB} = File::Spec->rel2abs($self->{PERL_ARCHLIB});
      }
      $self->{PERL_INCDEP} = $self->{PERL_INC};
      $self->{PERL_ARCHLIBDEP} = $self->{PERL_ARCHLIB};
  
      # We get SITELIBEXP and SITEARCHEXP directly via
      # Get_from_Config. When we are running standard modules, these
      # won't matter, we will set INSTALLDIRS to "perl". Otherwise we
      # set it to "site". I prefer that INSTALLDIRS be set from outside
      # MakeMaker.
      $self->{INSTALLDIRS} ||= "site";
  
      $self->{MAN1EXT} ||= $Config{man1ext};
      $self->{MAN3EXT} ||= $Config{man3ext};
  
      # Get some stuff out of %Config if we haven't yet done so
      print "CONFIG must be an array ref\n"
          if ($self->{CONFIG} and ref $self->{CONFIG} ne 'ARRAY');
      $self->{CONFIG} = [] unless (ref $self->{CONFIG});
      push(@{$self->{CONFIG}}, @ExtUtils::MakeMaker::Get_from_Config);
      push(@{$self->{CONFIG}}, 'shellflags') if $Config{shellflags};
      my(%once_only);
      foreach my $m (@{$self->{CONFIG}}){
          next if $once_only{$m};
          print "CONFIG key '$m' does not exist in Config.pm\n"
                  unless exists $Config{$m};
          $self->{uc $m} ||= $Config{$m};
          $once_only{$m} = 1;
      }
  
  # This is too dangerous:
  #    if ($^O eq "next") {
  #	$self->{AR} = "libtool";
  #	$self->{AR_STATIC_ARGS} = "-o";
  #    }
  # But I leave it as a placeholder
  
      $self->{AR_STATIC_ARGS} ||= "cr";
  
      # These should never be needed
      $self->{OBJ_EXT} ||= '.o';
      $self->{LIB_EXT} ||= '.a';
  
      $self->{MAP_TARGET} ||= "perl";
  
      $self->{LIBPERL_A} ||= "libperl$self->{LIB_EXT}";
  
      # make a simple check if we find strict
      warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory
          (strict.pm not found)"
          unless -f $self->catfile("$self->{PERL_LIB}","strict.pm") ||
                 $self->{NAME} eq "ExtUtils::MakeMaker";
  }
  
  =item init_tools
  
  Initializes tools to use their common (and faster) Unix commands.
  
  =cut
  
  sub init_tools {
      my $self = shift;
  
      $self->{ECHO}       ||= 'echo';
      $self->{ECHO_N}     ||= 'echo -n';
      $self->{RM_F}       ||= "rm -f";
      $self->{RM_RF}      ||= "rm -rf";
      $self->{TOUCH}      ||= "touch";
      $self->{TEST_F}     ||= "test -f";
      $self->{TEST_S}     ||= "test -s";
      $self->{CP}         ||= "cp";
      $self->{MV}         ||= "mv";
      $self->{CHMOD}      ||= "chmod";
      $self->{FALSE}      ||= 'false';
      $self->{TRUE}       ||= 'true';
  
      $self->{LD}         ||= 'ld';
  
      return $self->SUPER::init_tools(@_);
  
      # After SUPER::init_tools so $Config{shell} has a
      # chance to get set.
      $self->{SHELL}      ||= '/bin/sh';
  
      return;
  }
  
  
  =item init_linker
  
  Unix has no need of special linker flags.
  
  =cut
  
  sub init_linker {
      my($self) = shift;
      $self->{PERL_ARCHIVE} ||= '';
      $self->{PERL_ARCHIVEDEP} ||= '';
      $self->{PERL_ARCHIVE_AFTER} ||= '';
      $self->{EXPORT_LIST}  ||= '';
  }
  
  
  =begin _protected
  
  =item init_lib2arch
  
      $mm->init_lib2arch
  
  =end _protected
  
  =cut
  
  sub init_lib2arch {
      my($self) = shift;
  
      # The user who requests an installation directory explicitly
      # should not have to tell us an architecture installation directory
      # as well. We look if a directory exists that is named after the
      # architecture. If not we take it as a sign that it should be the
      # same as the requested installation directory. Otherwise we take
      # the found one.
      for my $libpair ({l=>"privlib",   a=>"archlib"},
                       {l=>"sitelib",   a=>"sitearch"},
                       {l=>"vendorlib", a=>"vendorarch"},
                      )
      {
          my $lib = "install$libpair->{l}";
          my $Lib = uc $lib;
          my $Arch = uc "install$libpair->{a}";
          if( $self->{$Lib} && ! $self->{$Arch} ){
              my($ilib) = $Config{$lib};
  
              $self->prefixify($Arch,$ilib,$self->{$Lib});
  
              unless (-d $self->{$Arch}) {
                  print "Directory $self->{$Arch} not found\n"
                    if $Verbose;
                  $self->{$Arch} = $self->{$Lib};
              }
              print "Defaulting $Arch to $self->{$Arch}\n" if $Verbose;
          }
      }
  }
  
  
  =item init_PERL
  
      $mm->init_PERL;
  
  Called by init_main.  Sets up ABSPERL, PERL, FULLPERL and all the
  *PERLRUN* permutations.
  
      PERL is allowed to be miniperl
      FULLPERL must be a complete perl
  
      ABSPERL is PERL converted to an absolute path
  
      *PERLRUN contains everything necessary to run perl, find it's
           libraries, etc...
  
      *PERLRUNINST is *PERLRUN + everything necessary to find the
           modules being built.
  
  =cut
  
  sub init_PERL {
      my($self) = shift;
  
      my @defpath = ();
      foreach my $component ($self->{PERL_SRC}, $self->path(),
                             $Config{binexp})
      {
  	push @defpath, $component if defined $component;
      }
  
      # Build up a set of file names (not command names).
      my $thisperl = $self->canonpath($^X);
      $thisperl .= $Config{exe_ext} unless
                  # VMS might have a file version # at the end
        $Is{VMS} ? $thisperl =~ m/$Config{exe_ext}(;\d+)?$/i
                : $thisperl =~ m/$Config{exe_ext}$/i;
  
      # We need a relative path to perl when in the core.
      $thisperl = $self->abs2rel($thisperl) if $self->{PERL_CORE};
  
      my @perls = ($thisperl);
      push @perls, map { "$_$Config{exe_ext}" }
                       ("perl$Config{version}", 'perl5', 'perl');
  
      # miniperl has priority over all but the canonical perl when in the
      # core.  Otherwise its a last resort.
      my $miniperl = "miniperl$Config{exe_ext}";
      if( $self->{PERL_CORE} ) {
          splice @perls, 1, 0, $miniperl;
      }
      else {
          push @perls, $miniperl;
      }
  
      $self->{PERL} ||=
          $self->find_perl(5.0, \@perls, \@defpath, $Verbose );
  
      my $perl = $self->{PERL};
      $perl =~ s/^"//;
      my $has_mcr = $perl =~ s/^MCR\s*//;
      my $perlflags = '';
      my $stripped_perl;
      while ($perl) {
  	($stripped_perl = $perl) =~ s/"$//;
  	last if -x $stripped_perl;
  	last unless $perl =~ s/(\s+\S+)$//;
  	$perlflags = $1.$perlflags;
      }
      $self->{PERL} = $stripped_perl;
      $self->{PERL} = 'MCR '.$self->{PERL} if $has_mcr || $Is{VMS};
  
      # When built for debugging, VMS doesn't create perl.exe but ndbgperl.exe.
      my $perl_name = 'perl';
      $perl_name = 'ndbgperl' if $Is{VMS} &&
        defined $Config{usevmsdebug} && $Config{usevmsdebug} eq 'define';
  
      # XXX This logic is flawed.  If "miniperl" is anywhere in the path
      # it will get confused.  It should be fixed to work only on the filename.
      # Define 'FULLPERL' to be a non-miniperl (used in test: target)
      unless ($self->{FULLPERL}) {
        ($self->{FULLPERL} = $self->{PERL}) =~ s/\Q$miniperl\E$/$perl_name$Config{exe_ext}/i;
        $self->{FULLPERL} = qq{"$self->{FULLPERL}"}.$perlflags;
      }
      # Can't have an image name with quotes, and findperl will have
      # already escaped spaces.
      $self->{FULLPERL} =~ tr/"//d if $Is{VMS};
  
      # Little hack to get around VMS's find_perl putting "MCR" in front
      # sometimes.
      $self->{ABSPERL} = $self->{PERL};
      $has_mcr = $self->{ABSPERL} =~ s/^MCR\s*//;
      if( $self->file_name_is_absolute($self->{ABSPERL}) ) {
          $self->{ABSPERL} = '$(PERL)';
      }
      else {
          $self->{ABSPERL} = $self->rel2abs($self->{ABSPERL});
  
          # Quote the perl command if it contains whitespace
          $self->{ABSPERL} = $self->quote_literal($self->{ABSPERL})
            if $self->{ABSPERL} =~ /\s/;
  
          $self->{ABSPERL} = 'MCR '.$self->{ABSPERL} if $has_mcr;
      }
      $self->{PERL} = qq{"$self->{PERL}"}.$perlflags;
  
      # Can't have an image name with quotes, and findperl will have
      # already escaped spaces.
      $self->{PERL} =~ tr/"//d if $Is{VMS};
  
      # Are we building the core?
      $self->{PERL_CORE} = $ENV{PERL_CORE} unless exists $self->{PERL_CORE};
      $self->{PERL_CORE} = 0               unless defined $self->{PERL_CORE};
  
      # How do we run perl?
      foreach my $perl (qw(PERL FULLPERL ABSPERL)) {
          my $run  = $perl.'RUN';
  
          $self->{$run}  = qq{\$($perl)};
  
          # Make sure perl can find itself before it's installed.
          $self->{$run} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"}
            if $self->{UNINSTALLED_PERL} || $self->{PERL_CORE};
  
          $self->{$perl.'RUNINST'} =
            sprintf q{$(%sRUN)%s "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"},
  	    $perl, $perlflags;
      }
  
      return 1;
  }
  
  
  =item init_platform
  
  =item platform_constants
  
  Add MM_Unix_VERSION.
  
  =cut
  
  sub init_platform {
      my($self) = shift;
  
      $self->{MM_Unix_VERSION} = $VERSION;
      $self->{PERL_MALLOC_DEF} = '-DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc '.
                                 '-Dfree=Perl_mfree -Drealloc=Perl_realloc '.
                                 '-Dcalloc=Perl_calloc';
  
  }
  
  sub platform_constants {
      my($self) = shift;
      my $make_frag = '';
  
      foreach my $macro (qw(MM_Unix_VERSION PERL_MALLOC_DEF))
      {
          next unless defined $self->{$macro};
          $make_frag .= "$macro = $self->{$macro}\n";
      }
  
      return $make_frag;
  }
  
  
  =item init_PERM
  
    $mm->init_PERM
  
  Called by init_main.  Initializes PERL_*
  
  =cut
  
  sub init_PERM {
      my($self) = shift;
  
      $self->{PERM_DIR} = 755  unless defined $self->{PERM_DIR};
      $self->{PERM_RW}  = 644  unless defined $self->{PERM_RW};
      $self->{PERM_RWX} = 755  unless defined $self->{PERM_RWX};
  
      return 1;
  }
  
  
  =item init_xs
  
      $mm->init_xs
  
  Sets up macros having to do with XS code.  Currently just INST_STATIC,
  INST_DYNAMIC and INST_BOOT.
  
  =cut
  
  sub init_xs {
      my $self = shift;
  
      if ($self->has_link_code()) {
          $self->{INST_STATIC}  =
            $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT)$(LIB_EXT)');
          $self->{INST_DYNAMIC} =
            $self->catfile('$(INST_ARCHAUTODIR)', '$(DLBASE).$(DLEXT)');
          $self->{INST_BOOT}    =
            $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT).bs');
      } else {
          $self->{INST_STATIC}  = '';
          $self->{INST_DYNAMIC} = '';
          $self->{INST_BOOT}    = '';
      }
  }
  
  =item install (o)
  
  Defines the install target.
  
  =cut
  
  sub install {
      my($self, %attribs) = @_;
      my(@m);
  
      push @m, q{
  install :: pure_install doc_install
  	$(NOECHO) $(NOOP)
  
  install_perl :: pure_perl_install doc_perl_install
  	$(NOECHO) $(NOOP)
  
  install_site :: pure_site_install doc_site_install
  	$(NOECHO) $(NOOP)
  
  install_vendor :: pure_vendor_install doc_vendor_install
  	$(NOECHO) $(NOOP)
  
  pure_install :: pure_$(INSTALLDIRS)_install
  	$(NOECHO) $(NOOP)
  
  doc_install :: doc_$(INSTALLDIRS)_install
  	$(NOECHO) $(NOOP)
  
  pure__install : pure_site_install
  	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  
  doc__install : doc_site_install
  	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  
  pure_perl_install :: all
  	$(NOECHO) $(MOD_INSTALL) \
  };
  
      push @m,
  q{		read "}.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{" \
  		write "}.$self->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{" \
  } unless $self->{NO_PACKLIST};
  
      push @m,
  q{		"$(INST_LIB)" "$(DESTINSTALLPRIVLIB)" \
  		"$(INST_ARCHLIB)" "$(DESTINSTALLARCHLIB)" \
  		"$(INST_BIN)" "$(DESTINSTALLBIN)" \
  		"$(INST_SCRIPT)" "$(DESTINSTALLSCRIPT)" \
  		"$(INST_MAN1DIR)" "$(DESTINSTALLMAN1DIR)" \
  		"$(INST_MAN3DIR)" "$(DESTINSTALLMAN3DIR)"
  	$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
  		"}.$self->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{"
  
  
  pure_site_install :: all
  	$(NOECHO) $(MOD_INSTALL) \
  };
      push @m,
  q{		read "}.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{" \
  		write "}.$self->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{" \
  } unless $self->{NO_PACKLIST};
  
      push @m,
  q{		"$(INST_LIB)" "$(DESTINSTALLSITELIB)" \
  		"$(INST_ARCHLIB)" "$(DESTINSTALLSITEARCH)" \
  		"$(INST_BIN)" "$(DESTINSTALLSITEBIN)" \
  		"$(INST_SCRIPT)" "$(DESTINSTALLSITESCRIPT)" \
  		"$(INST_MAN1DIR)" "$(DESTINSTALLSITEMAN1DIR)" \
  		"$(INST_MAN3DIR)" "$(DESTINSTALLSITEMAN3DIR)"
  	$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
  		"}.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{"
  
  pure_vendor_install :: all
  	$(NOECHO) $(MOD_INSTALL) \
  };
      push @m,
  q{		read "}.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{" \
  		write "}.$self->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').q{" \
  } unless $self->{NO_PACKLIST};
  
      push @m,
  q{		"$(INST_LIB)" "$(DESTINSTALLVENDORLIB)" \
  		"$(INST_ARCHLIB)" "$(DESTINSTALLVENDORARCH)" \
  		"$(INST_BIN)" "$(DESTINSTALLVENDORBIN)" \
  		"$(INST_SCRIPT)" "$(DESTINSTALLVENDORSCRIPT)" \
  		"$(INST_MAN1DIR)" "$(DESTINSTALLVENDORMAN1DIR)" \
  		"$(INST_MAN3DIR)" "$(DESTINSTALLVENDORMAN3DIR)"
  
  };
  
      push @m, q{
  doc_perl_install :: all
  	$(NOECHO) $(NOOP)
  
  doc_site_install :: all
  	$(NOECHO) $(NOOP)
  
  doc_vendor_install :: all
  	$(NOECHO) $(NOOP)
  
  } if $self->{NO_PERLLOCAL};
  
      push @m, q{
  doc_perl_install :: all
  	$(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod"
  	-$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)"
  	-$(NOECHO) $(DOC_INSTALL) \
  		"Module" "$(NAME)" \
  		"installed into" $(INSTALLPRIVLIB) \
  		LINKTYPE "$(LINKTYPE)" \
  		VERSION "$(VERSION)" \
  		EXE_FILES "$(EXE_FILES)" \
  		>> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{"
  
  doc_site_install :: all
  	$(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod"
  	-$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)"
  	-$(NOECHO) $(DOC_INSTALL) \
  		"Module" "$(NAME)" \
  		"installed into" $(INSTALLSITELIB) \
  		LINKTYPE "$(LINKTYPE)" \
  		VERSION "$(VERSION)" \
  		EXE_FILES "$(EXE_FILES)" \
  		>> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{"
  
  doc_vendor_install :: all
  	$(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod"
  	-$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)"
  	-$(NOECHO) $(DOC_INSTALL) \
  		"Module" "$(NAME)" \
  		"installed into" $(INSTALLVENDORLIB) \
  		LINKTYPE "$(LINKTYPE)" \
  		VERSION "$(VERSION)" \
  		EXE_FILES "$(EXE_FILES)" \
  		>> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{"
  
  } unless $self->{NO_PERLLOCAL};
  
      push @m, q{
  uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  	$(NOECHO) $(NOOP)
  
  uninstall_from_perldirs ::
  	$(NOECHO) $(UNINSTALL) "}.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{"
  
  uninstall_from_sitedirs ::
  	$(NOECHO) $(UNINSTALL) "}.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{"
  
  uninstall_from_vendordirs ::
  	$(NOECHO) $(UNINSTALL) "}.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{"
  };
  
      join("",@m);
  }
  
  =item installbin (o)
  
  Defines targets to make and to install EXE_FILES.
  
  =cut
  
  sub installbin {
      my($self) = shift;
  
      return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
      my @exefiles = @{$self->{EXE_FILES}};
      return "" unless @exefiles;
  
      @exefiles = map vmsify($_), @exefiles if $Is{VMS};
  
      my %fromto;
      for my $from (@exefiles) {
  	my($path)= $self->catfile('$(INST_SCRIPT)', basename($from));
  
  	local($_) = $path; # for backwards compatibility
  	my $to = $self->libscan($path);
  	print "libscan($from) => '$to'\n" if ($Verbose >=2);
  
          $to = vmsify($to) if $Is{VMS};
  	$fromto{$from} = $to;
      }
      my @to   = values %fromto;
  
      my @m;
      push(@m, qq{
  EXE_FILES = @exefiles
  
  pure_all :: @to
  	\$(NOECHO) \$(NOOP)
  
  realclean ::
  });
  
      # realclean can get rather large.
      push @m, map "\t$_\n", $self->split_command('$(RM_F)', @to);
      push @m, "\n";
  
  
      # A target for each exe file.
      while (my($from,$to) = each %fromto) {
  	last unless defined $from;
  
  	push @m, sprintf <<'MAKE', $to, $from, $to, $from, $to, $to, $to;
  %s : %s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
  	$(NOECHO) $(RM_F) %s
  	$(CP) %s %s
  	$(FIXIN) %s
  	-$(NOECHO) $(CHMOD) $(PERM_RWX) %s
  
  MAKE
  
      }
  
      join "", @m;
  }
  
  
  =item linkext (o)
  
  Defines the linkext target which in turn defines the LINKTYPE.
  
  =cut
  
  sub linkext {
      my($self, %attribs) = @_;
      # LINKTYPE => static or dynamic or ''
      my($linktype) = defined $attribs{LINKTYPE} ?
        $attribs{LINKTYPE} : '$(LINKTYPE)';
      "
  linkext :: $linktype
  	\$(NOECHO) \$(NOOP)
  ";
  }
  
  =item lsdir
  
  Takes as arguments a directory name and a regular expression. Returns
  all entries in the directory that match the regular expression.
  
  =cut
  
  sub lsdir {
      my($self) = shift;
      my($dir, $regex) = @_;
      my(@ls);
      my $dh = new DirHandle;
      $dh->open($dir || ".") or return ();
      @ls = $dh->read;
      $dh->close;
      @ls = grep(/$regex/, @ls) if $regex;
      @ls;
  }
  
  =item macro (o)
  
  Simple subroutine to insert the macros defined by the macro attribute
  into the Makefile.
  
  =cut
  
  sub macro {
      my($self,%attribs) = @_;
      my(@m,$key,$val);
      while (($key,$val) = each %attribs){
  	last unless defined $key;
  	push @m, "$key = $val\n";
      }
      join "", @m;
  }
  
  =item makeaperl (o)
  
  Called by staticmake. Defines how to write the Makefile to produce a
  static new perl.
  
  By default the Makefile produced includes all the static extensions in
  the perl library. (Purified versions of library files, e.g.,
  DynaLoader_pure_p1_c0_032.a are automatically ignored to avoid link errors.)
  
  =cut
  
  sub makeaperl {
      my($self, %attribs) = @_;
      my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
  	@attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
      my(@m);
      push @m, "
  # --- MakeMaker makeaperl section ---
  MAP_TARGET    = $target
  FULLPERL      = $self->{FULLPERL}
  ";
      return join '', @m if $self->{PARENT};
  
      my($dir) = join ":", @{$self->{DIR}};
  
      unless ($self->{MAKEAPERL}) {
  	push @m, q{
  $(MAP_TARGET) :: static $(MAKE_APERL_FILE)
  	$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
  
  $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
  	$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
  	$(NOECHO) $(PERLRUNINST) \
  		Makefile.PL DIR="}, $dir, q{" \
  		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
  		MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=};
  
  	foreach (@ARGV){
  		if( /\s/ ){
  			s/=(.*)/='$1'/;
  		}
  		push @m, " \\\n\t\t$_";
  	}
  #	push @m, map( " \\\n\t\t$_", @ARGV );
  	push @m, "\n";
  
  	return join '', @m;
      }
  
  
  
      my($cccmd, $linkcmd, $lperl);
  
  
      $cccmd = $self->const_cccmd($libperl);
      $cccmd =~ s/^CCCMD\s*=\s*//;
      $cccmd =~ s/\$\(INC\)/ "-I$self->{PERL_INC}" /;
      $cccmd .= " $Config{cccdlflags}"
  	if ($Config{useshrplib} eq 'true');
      $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/;
  
      # The front matter of the linkcommand...
      $linkcmd = join ' ', "\$(CC)",
  	    grep($_, @Config{qw(ldflags ccdlflags)});
      $linkcmd =~ s/\s+/ /g;
      $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,;
  
      # Which *.a files could we make use of...
      my %static;
      require File::Find;
      File::Find::find(sub {
  	return unless m/\Q$self->{LIB_EXT}\E$/;
  
          # Skip perl's libraries.
          return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/;
  
  	# Skip purified versions of libraries
          # (e.g., DynaLoader_pure_p1_c0_032.a)
  	return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure";
  
  	if( exists $self->{INCLUDE_EXT} ){
  		my $found = 0;
  
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,s;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything not explicitly marked for inclusion.
  		# DynaLoader is implied.
  		foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
  			if( $xx eq $incl ){
  				$found++;
  				last;
  			}
  		}
  		return unless $found;
  	}
  	elsif( exists $self->{EXCLUDE_EXT} ){
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,s;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything explicitly marked for exclusion
  		foreach my $excl (@{$self->{EXCLUDE_EXT}}){
  			return if( $xx eq $excl );
  		}
  	}
  
  	# don't include the installed version of this extension. I
  	# leave this line here, although it is not necessary anymore:
  	# I patched minimod.PL instead, so that Miniperl.pm won't
  	# include duplicates
  
  	# Once the patch to minimod.PL is in the distribution, I can
  	# drop it
  	return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}\z:;
  	use Cwd 'cwd';
  	$static{cwd() . "/" . $_}++;
      }, grep( -d $_, @{$searchdirs || []}) );
  
      # We trust that what has been handed in as argument, will be buildable
      $static = [] unless $static;
      @static{@{$static}} = (1) x @{$static};
  
      $extra = [] unless $extra && ref $extra eq 'ARRAY';
      for (sort keys %static) {
  	next unless /\Q$self->{LIB_EXT}\E\z/;
  	$_ = dirname($_) . "/extralibs.ld";
  	push @$extra, $_;
      }
  
      s/^(.*)/"-I$1"/ for @{$perlinc || []};
  
      $target ||= "perl";
      $tmp    ||= ".";
  
  # MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we
  # regenerate the Makefiles, MAP_STATIC and the dependencies for
  # extralibs.all are computed correctly
      push @m, "
  MAP_LINKCMD   = $linkcmd
  MAP_PERLINC   = @{$perlinc || []}
  MAP_STATIC    = ",
  join(" \\\n\t", reverse sort keys %static), "
  
  MAP_PRELIBS   = $Config{perllibs} $Config{cryptlib}
  ";
  
      if (defined $libperl) {
  	($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/;
      }
      unless ($libperl && -f $lperl) { # Ilya's code...
  	my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE";
  	$dir = "$self->{PERL_ARCHLIB}/.." if $self->{UNINSTALLED_PERL};
  	$libperl ||= "libperl$self->{LIB_EXT}";
  	$libperl   = "$dir/$libperl";
  	$lperl   ||= "libperl$self->{LIB_EXT}";
  	$lperl     = "$dir/$lperl";
  
          if (! -f $libperl and ! -f $lperl) {
            # We did not find a static libperl. Maybe there is a shared one?
            if ($Is{SunOS}) {
              $lperl  = $libperl = "$dir/$Config{libperl}";
              # SUNOS ld does not take the full path to a shared library
              $libperl = '' if $Is{SunOS4};
            }
          }
  
  	print "Warning: $libperl not found
      If you're going to build a static perl binary, make sure perl is installed
      otherwise ignore this warning\n"
  		unless (-f $lperl || defined($self->{PERL_SRC}));
      }
  
      # SUNOS ld does not take the full path to a shared library
      my $llibperl = $libperl ? '$(MAP_LIBPERL)' : '-lperl';
  
      push @m, "
  MAP_LIBPERL = $libperl
  LLIBPERL    = $llibperl
  ";
  
      push @m, '
  $(INST_ARCHAUTODIR)/extralibs.all : $(INST_ARCHAUTODIR)$(DFSEP).exists '.join(" \\\n\t", @$extra).'
  	$(NOECHO) $(RM_F)  $@
  	$(NOECHO) $(TOUCH) $@
  ';
  
      foreach my $catfile (@$extra){
  	push @m, "\tcat $catfile >> \$\@\n";
      }
  
  push @m, "
  \$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
  	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) \$(LLIBPERL) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
  	\$(NOECHO) \$(ECHO) 'To install the new \"\$(MAP_TARGET)\" binary, call'
  	\$(NOECHO) \$(ECHO) '    \$(MAKE) \$(USEMAKEFILE) $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
  	\$(NOECHO) \$(ECHO) 'To remove the intermediate files say'
  	\$(NOECHO) \$(ECHO) '    \$(MAKE) \$(USEMAKEFILE) $makefilename map_clean'
  
  $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
  ";
      push @m, "\t".$self->cd($tmp, qq[$cccmd "-I\$(PERL_INC)" perlmain.c])."\n";
  
      push @m, qq{
  $tmp/perlmain.c: $makefilename}, q{
  	$(NOECHO) $(ECHO) Writing $@
  	$(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \\
  		-e "writemain(grep s#.*/auto/##s, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@
  
  };
      push @m, "\t", q{$(NOECHO) $(PERL) "$(INSTALLSCRIPT)/fixpmain"
  } if (defined (&Dos::UseLFN) && Dos::UseLFN()==0);
  
  
      push @m, q{
  doc_inst_perl :
  	$(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLARCHLIB)/perllocal.pod"
  	-$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)"
  	-$(NOECHO) $(DOC_INSTALL) \
  		"Perl binary" "$(MAP_TARGET)" \
  		MAP_STATIC "$(MAP_STATIC)" \
  		MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \
  		MAP_LIBPERL "$(MAP_LIBPERL)" \
  		>> "}.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{"
  
  };
  
      push @m, q{
  inst_perl : pure_inst_perl doc_inst_perl
  
  pure_inst_perl : $(MAP_TARGET)
  	}.$self->{CP}.q{ $(MAP_TARGET) "}.$self->catfile('$(DESTINSTALLBIN)','$(MAP_TARGET)').q{"
  
  clean :: map_clean
  
  map_clean :
  	}.$self->{RM_F}.qq{ $tmp/perlmain\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all
  };
  
      join '', @m;
  }
  
  =item makefile (o)
  
  Defines how to rewrite the Makefile.
  
  =cut
  
  sub makefile {
      my($self) = shift;
      my $m;
      # We do not know what target was originally specified so we
      # must force a manual rerun to be sure. But as it should only
      # happen very rarely it is not a significant problem.
      $m = '
  $(OBJECT) : $(FIRST_MAKEFILE)
  
  ' if $self->{OBJECT};
  
      my $newer_than_target = $Is{VMS} ? '$(MMS$SOURCE_LIST)' : '$?';
      my $mpl_args = join " ", map qq["$_"], @ARGV;
      my $cross = '';
      if (defined $::Cross::platform) {
          # Inherited from win32/buildext.pl
          $cross = "-MCross=$::Cross::platform ";
      }
      $m .= sprintf <<'MAKE_FRAG', $newer_than_target, $cross, $mpl_args;
  # We take a very conservative approach here, but it's worth it.
  # We move Makefile to Makefile.old here to avoid gnu make looping.
  $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
  	$(NOECHO) $(ECHO) "Makefile out-of-date with respect to %s"
  	$(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
  	-$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
  	-$(NOECHO) $(MV)   $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
  	- $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
  	$(PERLRUN) %sMakefile.PL %s
  	$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
  	$(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command.  <=="
  	$(FALSE)
  
  MAKE_FRAG
  
      return $m;
  }
  
  
  =item maybe_command
  
  Returns true, if the argument is likely to be a command.
  
  =cut
  
  sub maybe_command {
      my($self,$file) = @_;
      return $file if -x $file && ! -d $file;
      return;
  }
  
  
  =item needs_linking (o)
  
  Does this module need linking? Looks into subdirectory objects (see
  also has_link_code())
  
  =cut
  
  sub needs_linking {
      my($self) = shift;
  
      my $caller = (caller(0))[3];
      confess("needs_linking called too early") if
        $caller =~ /^ExtUtils::MakeMaker::/;
      return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING};
      if ($self->has_link_code or $self->{MAKEAPERL}){
  	$self->{NEEDS_LINKING} = 1;
  	return 1;
      }
      foreach my $child (keys %{$self->{CHILDREN}}) {
  	if ($self->{CHILDREN}->{$child}->needs_linking) {
  	    $self->{NEEDS_LINKING} = 1;
  	    return 1;
  	}
      }
      return $self->{NEEDS_LINKING} = 0;
  }
  
  
  =item parse_abstract
  
  parse a file and return what you think is the ABSTRACT
  
  =cut
  
  sub parse_abstract {
      my($self,$parsefile) = @_;
      my $result;
  
      local $/ = "\n";
      open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!";
      my $inpod = 0;
      my $pod_encoding;
      my $package = $self->{DISTNAME};
      $package =~ s/-/::/g;
      while (<$fh>) {
          $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
          next if !$inpod;
          chop;
  
          if ( /^=encoding\s*(.*)$/i ) {
              $pod_encoding = $1;
          }
  
          if ( /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x ) {
            $result = $2;
            next;
          }
          next unless $result;
  
          if ( $result && ( /^\s*$/ || /^\=/ ) ) {
            last;
          }
          $result = join ' ', $result, $_;
      }
      close $fh;
  
      if ( $pod_encoding and !( $] < 5.008 or !$Config{useperlio} ) ) {
          # Have to wrap in an eval{} for when running under PERL_CORE
          # Encode isn't available during build phase and parsing
          # ABSTRACT isn't important there
          eval {
            require Encode;
            $result = Encode::decode($pod_encoding, $result);
          }
      }
  
      return $result;
  }
  
  =item parse_version
  
      my $version = MM->parse_version($file);
  
  Parse a $file and return what $VERSION is set to by the first assignment.
  It will return the string "undef" if it can't figure out what $VERSION
  is. $VERSION should be for all to see, so C<our $VERSION> or plain $VERSION
  are okay, but C<my $VERSION> is not.
  
  C<<package Foo VERSION>> is also checked for.  The first version
  declaration found is used, but this may change as it differs from how
  Perl does it.
  
  parse_version() will try to C<use version> before checking for
  C<$VERSION> so the following will work.
  
      $VERSION = qv(1.2.3);
  
  =cut
  
  sub parse_version {
      my($self,$parsefile) = @_;
      my $result;
  
      local $/ = "\n";
      local $_;
      open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!";
      my $inpod = 0;
      while (<$fh>) {
          $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
          next if $inpod || /^\s*#/;
          chop;
          next if /^\s*(if|unless|elsif)/;
          if ( m{^ \s* package \s+ \w[\w\:\']* \s+ (v?[0-9._]+) \s* ;  }x ) {
              local $^W = 0;
              $result = $1;
          }
          elsif ( m{(?<!\\) ([\$*]) (([\w\:\']*) \bVERSION)\b .* (?<![<>=!])\=[^=]}x ) {
  			$result = $self->get_version($parsefile, $1, $2);
          }
          else {
            next;
          }
          last if defined $result;
      }
      close $fh;
  
      if ( defined $result && $result !~ /^v?[\d_\.]+$/ ) {
        require version;
        my $normal = eval { version->new( $result ) };
        $result = $normal if defined $normal;
      }
      $result = "undef" unless defined $result;
      return $result;
  }
  
  sub get_version {
      my ($self, $parsefile, $sigil, $name) = @_;
      my $line = $_; # from the while() loop in parse_version
      {
          package ExtUtils::MakeMaker::_version;
          undef *version; # in case of unexpected version() sub
          eval {
              require version;
              version::->import;
          };
          no strict;
          local *{$name};
          local $^W = 0;
          $line = $1 if $line =~ m{^(.+)}s;
          eval($line); ## no critic
          return ${$name};
      }
  }
  
  =item pasthru (o)
  
  Defines the string that is passed to recursive make calls in
  subdirectories.
  
  =cut
  
  sub pasthru {
      my($self) = shift;
      my(@m);
  
      my(@pasthru);
      my($sep) = $Is{VMS} ? ',' : '';
      $sep .= "\\\n\t";
  
      foreach my $key (qw(LIB LIBPERL_A LINKTYPE OPTIMIZE
                       PREFIX INSTALL_BASE)
                   )
      {
          next unless defined $self->{$key};
  	push @pasthru, "$key=\"\$($key)\"";
      }
  
      foreach my $key (qw(DEFINE INC)) {
          next unless defined $self->{$key};
  	push @pasthru, "PASTHRU_$key=\"\$(PASTHRU_$key)\"";
      }
  
      push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n";
      join "", @m;
  }
  
  =item perl_script
  
  Takes one argument, a file name, and returns the file name, if the
  argument is likely to be a perl script. On MM_Unix this is true for
  any ordinary, readable file.
  
  =cut
  
  sub perl_script {
      my($self,$file) = @_;
      return $file if -r $file && -f _;
      return;
  }
  
  =item perldepend (o)
  
  Defines the dependency from all *.h files that come with the perl
  distribution.
  
  =cut
  
  sub perldepend {
      my($self) = shift;
      my(@m);
  
      my $make_config = $self->cd('$(PERL_SRC)', '$(MAKE) lib/Config.pm');
  
      push @m, sprintf <<'MAKE_FRAG', $make_config if $self->{PERL_SRC};
  # Check for unpropogated config.sh changes. Should never happen.
  # We do NOT just update config.h because that is not sufficient.
  # An out of date config.h is not fatal but complains loudly!
  $(PERL_INCDEP)/config.h: $(PERL_SRC)/config.sh
  	-$(NOECHO) $(ECHO) "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; $(FALSE)
  
  $(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh
  	$(NOECHO) $(ECHO) "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh"
  	%s
  MAKE_FRAG
  
      return join "", @m unless $self->needs_linking;
  
      if ($self->{OBJECT}) {
          # Need to add an object file dependency on the perl headers.
          # this is very important for XS modules in perl.git development.
          push @m, $self->_perl_header_files_fragment("/"); # Directory separator between $(PERL_INC)/header.h
      }
  
      push @m, join(" ", sort values %{$self->{XS}})." : \$(XSUBPPDEPS)\n"  if %{$self->{XS}};
  
      return join "\n", @m;
  }
  
  
  =item pm_to_blib
  
  Defines target that copies all files in the hash PM to their
  destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
  
  =cut
  
  sub pm_to_blib {
      my $self = shift;
      my($autodir) = $self->catdir('$(INST_LIB)','auto');
      my $r = q{
  pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM)
  };
  
      # VMS will swallow '' and PM_FILTER is often empty.  So use q[]
      my $pm_to_blib = $self->oneliner(<<CODE, ['-MExtUtils::Install']);
  pm_to_blib({\@ARGV}, '$autodir', q[\$(PM_FILTER)], '\$(PERM_DIR)')
  CODE
  
      my @cmds = $self->split_command($pm_to_blib,
                    map { ($_, $self->{PM}->{$_}) } sort keys %{$self->{PM}});
  
      $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds;
      $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n};
  
      return $r;
  }
  
  =item post_constants (o)
  
  Returns an empty string per default. Dedicated to overrides from
  within Makefile.PL after all constants have been defined.
  
  =cut
  
  sub post_constants{
      "";
  }
  
  =item post_initialize (o)
  
  Returns an empty string per default. Used in Makefile.PLs to add some
  chunk of text to the Makefile after the object is initialized.
  
  =cut
  
  sub post_initialize {
      "";
  }
  
  =item postamble (o)
  
  Returns an empty string. Can be used in Makefile.PLs to write some
  text to the Makefile at the end.
  
  =cut
  
  sub postamble {
      "";
  }
  
  # transform dot-separated version string into comma-separated quadruple
  # examples:  '1.2.3.4.5' => '1,2,3,4'
  #            '1.2.3'     => '1,2,3,0'
  sub _ppd_version {
      my ($self, $string) = @_;
      return join ',', ((split /\./, $string), (0) x 4)[0..3];
  }
  
  =item ppd
  
  Defines target that creates a PPD (Perl Package Description) file
  for a binary distribution.
  
  =cut
  
  sub ppd {
      my($self) = @_;
  
      my $abstract = $self->{ABSTRACT} || '';
      $abstract =~ s/\n/\\n/sg;
      $abstract =~ s/</&lt;/g;
      $abstract =~ s/>/&gt;/g;
  
      my $author = join(', ',@{$self->{AUTHOR} || []});
      $author =~ s/</&lt;/g;
      $author =~ s/>/&gt;/g;
  
      my $ppd_file = '$(DISTNAME).ppd';
  
      my @ppd_cmds = $self->echo(<<'PPD_HTML', $ppd_file, { append => 0, allow_variables => 1 });
  <SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">
  PPD_HTML
  
      my $ppd_xml = sprintf <<'PPD_HTML', $abstract, $author;
      <ABSTRACT>%s</ABSTRACT>
      <AUTHOR>%s</AUTHOR>
  PPD_HTML
  
      $ppd_xml .= "    <IMPLEMENTATION>\n";
      if ( $self->{MIN_PERL_VERSION} ) {
          my $min_perl_version = $self->_ppd_version($self->{MIN_PERL_VERSION});
          $ppd_xml .= sprintf <<'PPD_PERLVERS', $min_perl_version;
          <PERLCORE VERSION="%s" />
  PPD_PERLVERS
  
      }
  
      # Don't add "perl" to requires.  perl dependencies are
      # handles by ARCHITECTURE.
      my %prereqs = %{$self->{PREREQ_PM}};
      delete $prereqs{perl};
  
      # Build up REQUIRE
      foreach my $prereq (sort keys %prereqs) {
          my $name = $prereq;
          $name .= '::' unless $name =~ /::/;
          my $version = $prereqs{$prereq};
  
          my %attrs = ( NAME => $name );
          $attrs{VERSION} = $version if $version;
          my $attrs = join " ", map { qq[$_="$attrs{$_}"] } sort keys %attrs;
          $ppd_xml .= qq(        <REQUIRE $attrs />\n);
      }
  
      my $archname = $Config{archname};
      if ($] >= 5.008) {
          # archname did not change from 5.6 to 5.8, but those versions may
          # not be not binary compatible so now we append the part of the
          # version that changes when binary compatibility may change
          $archname .= "-$Config{PERL_REVISION}.$Config{PERL_VERSION}";
      }
      $ppd_xml .= sprintf <<'PPD_OUT', $archname;
          <ARCHITECTURE NAME="%s" />
  PPD_OUT
  
      if ($self->{PPM_INSTALL_SCRIPT}) {
          if ($self->{PPM_INSTALL_EXEC}) {
              $ppd_xml .= sprintf qq{        <INSTALL EXEC="%s">%s</INSTALL>\n},
                    $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT};
          }
          else {
              $ppd_xml .= sprintf qq{        <INSTALL>%s</INSTALL>\n},
                    $self->{PPM_INSTALL_SCRIPT};
          }
      }
  
      if ($self->{PPM_UNINSTALL_SCRIPT}) {
          if ($self->{PPM_UNINSTALL_EXEC}) {
              $ppd_xml .= sprintf qq{        <UNINSTALL EXEC="%s">%s</UNINSTALL>\n},
                    $self->{PPM_UNINSTALL_EXEC}, $self->{PPM_UNINSTALL_SCRIPT};
          }
          else {
              $ppd_xml .= sprintf qq{        <UNINSTALL>%s</UNINSTALL>\n},
                    $self->{PPM_UNINSTALL_SCRIPT};
          }
      }
  
      my ($bin_location) = $self->{BINARY_LOCATION} || '';
      $bin_location =~ s/\\/\\\\/g;
  
      $ppd_xml .= sprintf <<'PPD_XML', $bin_location;
          <CODEBASE HREF="%s" />
      </IMPLEMENTATION>
  </SOFTPKG>
  PPD_XML
  
      push @ppd_cmds, $self->echo($ppd_xml, $ppd_file, { append => 1 });
  
      return sprintf <<'PPD_OUT', join "\n\t", @ppd_cmds;
  # Creates a PPD (Perl Package Description) for a binary distribution.
  ppd :
  	%s
  PPD_OUT
  
  }
  
  =item prefixify
  
    $MM->prefixify($var, $prefix, $new_prefix, $default);
  
  Using either $MM->{uc $var} || $Config{lc $var}, it will attempt to
  replace it's $prefix with a $new_prefix.
  
  Should the $prefix fail to match I<AND> a PREFIX was given as an
  argument to WriteMakefile() it will set it to the $new_prefix +
  $default.  This is for systems whose file layouts don't neatly fit into
  our ideas of prefixes.
  
  This is for heuristics which attempt to create directory structures
  that mirror those of the installed perl.
  
  For example:
  
      $MM->prefixify('installman1dir', '/usr', '/home/foo', 'man/man1');
  
  this will attempt to remove '/usr' from the front of the
  $MM->{INSTALLMAN1DIR} path (initializing it to $Config{installman1dir}
  if necessary) and replace it with '/home/foo'.  If this fails it will
  simply use '/home/foo/man/man1'.
  
  =cut
  
  sub prefixify {
      my($self,$var,$sprefix,$rprefix,$default) = @_;
  
      my $path = $self->{uc $var} ||
                 $Config_Override{lc $var} || $Config{lc $var} || '';
  
      $rprefix .= '/' if $sprefix =~ m|/$|;
  
      warn "  prefixify $var => $path\n" if $Verbose >= 2;
      warn "    from $sprefix to $rprefix\n" if $Verbose >= 2;
  
      if( $self->{ARGS}{PREFIX} &&
          $path !~ s{^\Q$sprefix\E\b}{$rprefix}s )
      {
  
          warn "    cannot prefix, using default.\n" if $Verbose >= 2;
          warn "    no default!\n" if !$default && $Verbose >= 2;
  
          $path = $self->catdir($rprefix, $default) if $default;
      }
  
      print "    now $path\n" if $Verbose >= 2;
      return $self->{uc $var} = $path;
  }
  
  
  =item processPL (o)
  
  Defines targets to run *.PL files.
  
  =cut
  
  sub processPL {
      my $self = shift;
      my $pl_files = $self->{PL_FILES};
  
      return "" unless $pl_files;
  
      my $m = '';
      foreach my $plfile (sort keys %$pl_files) {
          my $list = ref($pl_files->{$plfile})
                       ?  $pl_files->{$plfile}
  		     : [$pl_files->{$plfile}];
  
  	foreach my $target (@$list) {
              if( $Is{VMS} ) {
                  $plfile = vmsify($self->eliminate_macros($plfile));
                  $target = vmsify($self->eliminate_macros($target));
              }
  
  	    # Normally a .PL file runs AFTER pm_to_blib so it can have
  	    # blib in its @INC and load the just built modules.  BUT if
  	    # the generated module is something in $(TO_INST_PM) which
  	    # pm_to_blib depends on then it can't depend on pm_to_blib
  	    # else we have a dependency loop.
  	    my $pm_dep;
  	    my $perlrun;
  	    if( defined $self->{PM}{$target} ) {
  		$pm_dep  = '';
  		$perlrun = 'PERLRUN';
  	    }
  	    else {
  		$pm_dep  = 'pm_to_blib';
  		$perlrun = 'PERLRUNINST';
  	    }
  
              $m .= <<MAKE_FRAG;
  
  all :: $target
  	\$(NOECHO) \$(NOOP)
  
  $target :: $plfile $pm_dep
  	\$($perlrun) $plfile $target
  MAKE_FRAG
  
  	}
      }
  
      return $m;
  }
  
  =item quote_paren
  
  Backslashes parentheses C<()> in command line arguments.
  Doesn't handle recursive Makefile C<$(...)> constructs,
  but handles simple ones.
  
  =cut
  
  sub quote_paren {
      my $arg = shift;
      $arg =~ s{\$\((.+?)\)}{\$\\\\($1\\\\)}g;	# protect $(...)
      $arg =~ s{(?<!\\)([()])}{\\$1}g;		# quote unprotected
      $arg =~ s{\$\\\\\((.+?)\\\\\)}{\$($1)}g;	# unprotect $(...)
      return $arg;
  }
  
  =item replace_manpage_separator
  
    my $man_name = $MM->replace_manpage_separator($file_path);
  
  Takes the name of a package, which may be a nested package, in the
  form 'Foo/Bar.pm' and replaces the slash with C<::> or something else
  safe for a man page file name.  Returns the replacement.
  
  =cut
  
  sub replace_manpage_separator {
      my($self,$man) = @_;
  
      $man =~ s,/+,::,g;
      return $man;
  }
  
  
  =item cd
  
  =cut
  
  sub cd {
      my($self, $dir, @cmds) = @_;
  
      # No leading tab and no trailing newline makes for easier embedding
      my $make_frag = join "\n\t", map { "cd $dir && $_" } @cmds;
  
      return $make_frag;
  }
  
  =item oneliner
  
  =cut
  
  sub oneliner {
      my($self, $cmd, $switches) = @_;
      $switches = [] unless defined $switches;
  
      # Strip leading and trailing newlines
      $cmd =~ s{^\n+}{};
      $cmd =~ s{\n+$}{};
  
      my @cmds = split /\n/, $cmd;
      $cmd = join " \n\t  -e ", map $self->quote_literal($_), @cmds;
      $cmd = $self->escape_newlines($cmd);
  
      $switches = join ' ', @$switches;
  
      return qq{\$(ABSPERLRUN) $switches -e $cmd --};
  }
  
  
  =item quote_literal
  
  Quotes macro literal value suitable for being used on a command line so
  that when expanded by make, will be received by command as given to
  this method:
  
    my $quoted = $mm->quote_literal(q{it isn't});
    # returns:
    #   'it isn'\''t'
    print MAKEFILE "target:\n\techo $quoted\n";
    # when run "make target", will output:
    #   it isn't
  
  =cut
  
  sub quote_literal {
      my($self, $text, $opts) = @_;
      $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
  
      # Quote single quotes
      $text =~ s{'}{'\\''}g;
  
      $text = $opts->{allow_variables}
        ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
  
      return "'$text'";
  }
  
  
  =item escape_newlines
  
  =cut
  
  sub escape_newlines {
      my($self, $text) = @_;
  
      $text =~ s{\n}{\\\n}g;
  
      return $text;
  }
  
  
  =item max_exec_len
  
  Using POSIX::ARG_MAX.  Otherwise falling back to 4096.
  
  =cut
  
  sub max_exec_len {
      my $self = shift;
  
      if (!defined $self->{_MAX_EXEC_LEN}) {
          if (my $arg_max = eval { require POSIX;  &POSIX::ARG_MAX }) {
              $self->{_MAX_EXEC_LEN} = $arg_max;
          }
          else {      # POSIX minimum exec size
              $self->{_MAX_EXEC_LEN} = 4096;
          }
      }
  
      return $self->{_MAX_EXEC_LEN};
  }
  
  
  =item static (o)
  
  Defines the static target.
  
  =cut
  
  sub static {
  # --- Static Loading Sections ---
  
      my($self) = shift;
      '
  ## $(INST_PM) has been moved to the all: target.
  ## It remains here for awhile to allow for old usage: "make static"
  static :: $(FIRST_MAKEFILE) $(INST_STATIC)
  	$(NOECHO) $(NOOP)
  ';
  }
  
  =item static_lib (o)
  
  Defines how to produce the *.a (or equivalent) files.
  
  =cut
  
  sub static_lib {
      my($self) = @_;
      return '' unless $self->has_link_code;
  
      my(@m);
      push(@m, <<'END');
  
  $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(RM_RF) $@
  END
  
      # If this extension has its own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      push(@m, <<'MAKE_FRAG') if $self->{MYEXTLIB};
  	$(CP) $(MYEXTLIB) "$@"
  MAKE_FRAG
  
      my $ar;
      if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) {
          # Prefer the absolute pathed ar if available so that PATH
          # doesn't confuse us.  Perl itself is built with the full_ar.
          $ar = 'FULL_AR';
      } else {
          $ar = 'AR';
      }
      push @m, sprintf <<'MAKE_FRAG', $ar;
  	$(%s) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
  	$(CHMOD) $(PERM_RWX) $@
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > "$(INST_ARCHAUTODIR)/extralibs.ld"
  MAKE_FRAG
  
      # Old mechanism - still available:
      push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> "$(PERL_SRC)/ext.libs"
  MAKE_FRAG
  
      join('', @m);
  }
  
  =item staticmake (o)
  
  Calls makeaperl.
  
  =cut
  
  sub staticmake {
      my($self, %attribs) = @_;
      my(@static);
  
      my(@searchdirs)=($self->{PERL_ARCHLIB}, $self->{SITEARCHEXP},  $self->{INST_ARCHLIB});
  
      # And as it's not yet built, we add the current extension
      # but only if it has some C code (or XS code, which implies C code)
      if (@{$self->{C}}) {
  	@static = $self->catfile($self->{INST_ARCHLIB},
  				 "auto",
  				 $self->{FULLEXT},
  				 "$self->{BASEEXT}$self->{LIB_EXT}"
  				);
      }
  
      # Either we determine now, which libraries we will produce in the
      # subdirectories or we do it at runtime of the make.
  
      # We could ask all subdir objects, but I cannot imagine, why it
      # would be necessary.
  
      # Instead we determine all libraries for the new perl at
      # runtime.
      my(@perlinc) = ($self->{INST_ARCHLIB}, $self->{INST_LIB}, $self->{PERL_ARCHLIB}, $self->{PERL_LIB});
  
      $self->makeaperl(MAKE	=> $self->{MAKEFILE},
  		     DIRS	=> \@searchdirs,
  		     STAT	=> \@static,
  		     INCL	=> \@perlinc,
  		     TARGET	=> $self->{MAP_TARGET},
  		     TMP	=> "",
  		     LIBPERL	=> $self->{LIBPERL_A}
  		    );
  }
  
  =item subdir_x (o)
  
  Helper subroutine for subdirs
  
  =cut
  
  sub subdir_x {
      my($self, $subdir) = @_;
  
      my $subdir_cmd = $self->cd($subdir,
        '$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU)'
      );
      return sprintf <<'EOT', $subdir_cmd;
  
  subdirs ::
  	$(NOECHO) %s
  EOT
  
  }
  
  =item subdirs (o)
  
  Defines targets to process subdirectories.
  
  =cut
  
  sub subdirs {
  # --- Sub-directory Sections ---
      my($self) = shift;
      my(@m);
      # This method provides a mechanism to automatically deal with
      # subdirectories containing further Makefile.PL scripts.
      # It calls the subdir_x() method for each subdirectory.
      foreach my $dir (@{$self->{DIR}}){
  	push(@m, $self->subdir_x($dir));
  ####	print "Including $dir subdirectory\n";
      }
      if (@m){
  	unshift(@m, "
  # The default clean, realclean and test targets in this Makefile
  # have automatically been given entries for each subdir.
  
  ");
      } else {
  	push(@m, "\n# none")
      }
      join('',@m);
  }
  
  =item test (o)
  
  Defines the test targets.
  
  =cut
  
  sub test {
  # --- Test and Installation Sections ---
  
      my($self, %attribs) = @_;
      my $tests = $attribs{TESTS} || '';
      if (!$tests && -d 't' && defined $attribs{RECURSIVE_TEST_FILES}) {
          $tests = $self->find_tests_recursive;
      }
      elsif (!$tests && -d 't') {
          $tests = $self->find_tests;
      }
      # have to do this because nmake is broken
      $tests =~ s!/!\\!g if $self->is_make_type('nmake');
      # note: 'test.pl' name is also hardcoded in init_dirscan()
      my(@m);
      push(@m,"
  TEST_VERBOSE=0
  TEST_TYPE=test_\$(LINKTYPE)
  TEST_FILE = test.pl
  TEST_FILES = $tests
  TESTDB_SW = -d
  
  testdb :: testdb_\$(LINKTYPE)
  
  test :: \$(TEST_TYPE) subdirs-test
  
  subdirs-test ::
  	\$(NOECHO) \$(NOOP)
  
  ");
  
      foreach my $dir (@{ $self->{DIR} }) {
          my $test = $self->cd($dir, '$(MAKE) test $(PASTHRU)');
  
          push @m, <<END
  subdirs-test ::
  	\$(NOECHO) $test
  
  END
      }
  
      push(@m, "\t\$(NOECHO) \$(ECHO) 'No tests defined for \$(NAME) extension.'\n")
  	unless $tests or -f "test.pl" or @{$self->{DIR}};
      push(@m, "\n");
  
      push(@m, "test_dynamic :: pure_all\n");
      push(@m, $self->test_via_harness('$(FULLPERLRUN)', '$(TEST_FILES)'))
        if $tests;
      push(@m, $self->test_via_script('$(FULLPERLRUN)', '$(TEST_FILE)'))
        if -f "test.pl";
      push(@m, "\n");
  
      push(@m, "testdb_dynamic :: pure_all\n");
      push(@m, $self->test_via_script('$(FULLPERLRUN) $(TESTDB_SW)',
                                      '$(TEST_FILE)'));
      push(@m, "\n");
  
      # Occasionally we may face this degenerate target:
      push @m, "test_ : test_dynamic\n\n";
  
      if ($self->needs_linking()) {
  	push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
  	push(@m, $self->test_via_harness('./$(MAP_TARGET)', '$(TEST_FILES)')) if $tests;
  	push(@m, $self->test_via_script('./$(MAP_TARGET)', '$(TEST_FILE)')) if -f "test.pl";
  	push(@m, "\n");
  	push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
  	push(@m, $self->test_via_script('./$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
  	push(@m, "\n");
      } else {
  	push @m, "test_static :: test_dynamic\n";
  	push @m, "testdb_static :: testdb_dynamic\n";
      }
      join("", @m);
  }
  
  =item test_via_harness (override)
  
  For some reason which I forget, Unix machines like to have
  PERL_DL_NONLAZY set for tests.
  
  =cut
  
  sub test_via_harness {
      my($self, $perl, $tests) = @_;
      return $self->SUPER::test_via_harness("PERL_DL_NONLAZY=1 $perl", $tests);
  }
  
  =item test_via_script (override)
  
  Again, the PERL_DL_NONLAZY thing.
  
  =cut
  
  sub test_via_script {
      my($self, $perl, $script) = @_;
      return $self->SUPER::test_via_script("PERL_DL_NONLAZY=1 $perl", $script);
  }
  
  
  =item tool_xsubpp (o)
  
  Determines typemaps, xsubpp version, prototype behaviour.
  
  =cut
  
  sub tool_xsubpp {
      my($self) = shift;
      return "" unless $self->needs_linking;
  
      my $xsdir;
      my @xsubpp_dirs = @INC;
  
      # Make sure we pick up the new xsubpp if we're building perl.
      unshift @xsubpp_dirs, $self->{PERL_LIB} if $self->{PERL_CORE};
  
      my $foundxsubpp = 0;
      foreach my $dir (@xsubpp_dirs) {
          $xsdir = $self->catdir($dir, 'ExtUtils');
          if( -r $self->catfile($xsdir, "xsubpp") ) {
              $foundxsubpp = 1;
              last;
          }
      }
      die "ExtUtils::MM_Unix::tool_xsubpp : Can't find xsubpp" if !$foundxsubpp;
  
      my $tmdir   = File::Spec->catdir($self->{PERL_LIB},"ExtUtils");
      my(@tmdeps) = $self->catfile($tmdir,'typemap');
      if( $self->{TYPEMAPS} ){
          foreach my $typemap (@{$self->{TYPEMAPS}}){
              if( ! -f  $typemap ) {
                  warn "Typemap $typemap not found.\n";
              }
              else {
                  push(@tmdeps,  $typemap);
              }
          }
      }
      push(@tmdeps, "typemap") if -f "typemap";
      my @tmargs = map(qq{-typemap "$_"}, @tmdeps);
      $_ = $self->quote_dep($_) for @tmdeps;
      if( exists $self->{XSOPT} ){
          unshift( @tmargs, $self->{XSOPT} );
      }
  
      if ($Is{VMS}                          &&
          $Config{'ldflags'}               &&
          $Config{'ldflags'} =~ m!/Debug!i &&
          (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/)
         )
      {
          unshift(@tmargs,'-nolinenumbers');
      }
  
  
      $self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG};
      my $xsdirdep = $self->quote_dep($xsdir);
      # -dep for use when dependency not command
  
      return qq{
  XSUBPPDIR = $xsdir
  XSUBPP = "\$(XSUBPPDIR)\$(DFSEP)xsubpp"
  XSUBPPRUN = \$(PERLRUN) \$(XSUBPP)
  XSPROTOARG = $self->{XSPROTOARG}
  XSUBPPDEPS = @tmdeps $xsdirdep\$(DFSEP)xsubpp
  XSUBPPARGS = @tmargs
  XSUBPP_EXTRA_ARGS =
  };
  }
  
  
  =item all_target
  
  Build man pages, too
  
  =cut
  
  sub all_target {
      my $self = shift;
  
      return <<'MAKE_EXT';
  all :: pure_all manifypods
  	$(NOECHO) $(NOOP)
  MAKE_EXT
  }
  
  =item top_targets (o)
  
  Defines the targets all, subdirs, config, and O_FILES
  
  =cut
  
  sub top_targets {
  # --- Target Sections ---
  
      my($self) = shift;
      my(@m);
  
      push @m, $self->all_target, "\n" unless $self->{SKIPHASH}{'all'};
  
      push @m, '
  pure_all :: config pm_to_blib subdirs linkext
  	$(NOECHO) $(NOOP)
  
  subdirs :: $(MYEXTLIB)
  	$(NOECHO) $(NOOP)
  
  config :: $(FIRST_MAKEFILE) blibdirs
  	$(NOECHO) $(NOOP)
  ';
  
      push @m, '
  $(O_FILES): $(H_FILES)
  ' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
  
      push @m, q{
  help :
  	perldoc ExtUtils::MakeMaker
  };
  
      join('',@m);
  }
  
  =item writedoc
  
  Obsolete, deprecated method. Not used since Version 5.21.
  
  =cut
  
  sub writedoc {
  # --- perllocal.pod section ---
      my($self,$what,$name,@attribs)=@_;
      my $time = localtime;
      print "=head2 $time: $what C<$name>\n\n=over 4\n\n=item *\n\n";
      print join "\n\n=item *\n\n", map("C<$_>",@attribs);
      print "\n\n=back\n\n";
  }
  
  =item xs_c (o)
  
  Defines the suffix rules to compile XS files to C.
  
  =cut
  
  sub xs_c {
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs.c:
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
  ';
  }
  
  =item xs_cpp (o)
  
  Defines the suffix rules to compile XS files to C++.
  
  =cut
  
  sub xs_cpp {
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs.cpp:
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp
  ';
  }
  
  =item xs_o (o)
  
  Defines suffix rules to go from XS to object files directly. This is
  only intended for broken make implementations.
  
  =cut
  
  sub xs_o {	# many makes are too dumb to use xs_c then c_o
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs$(OBJ_EXT):
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
  	$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
  ';
  }
  
  
  1;
  
  =back
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker>
  
  =cut
  
  __END__
EXTUTILS_MM_UNIX

$fatpacked{"ExtUtils/MM_VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_VMS';
  package ExtUtils::MM_VMS;
  
  use strict;
  
  use ExtUtils::MakeMaker::Config;
  require Exporter;
  
  BEGIN {
      # so we can compile the thing on non-VMS platforms.
      if( $^O eq 'VMS' ) {
          require VMS::Filespec;
          VMS::Filespec->import;
      }
  }
  
  use File::Basename;
  
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  
  use ExtUtils::MakeMaker qw($Verbose neatvalue);
  our $Revision = $ExtUtils::MakeMaker::Revision;
  
  
  =head1 NAME
  
  ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
    Do not use this directly.
    Instead, use ExtUtils::MM and it will figure out which MM_*
    class to use for you.
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =head2 Methods always loaded
  
  =over 4
  
  =item wraplist
  
  Converts a list into a string wrapped at approximately 80 columns.
  
  =cut
  
  sub wraplist {
      my($self) = shift;
      my($line,$hlen) = ('',0);
  
      foreach my $word (@_) {
        # Perl bug -- seems to occasionally insert extra elements when
        # traversing array (scalar(@array) doesn't show them, but
        # foreach(@array) does) (5.00307)
        next unless $word =~ /\w/;
        $line .= ' ' if length($line);
        if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
        $line .= $word;
        $hlen += length($word) + 2;
      }
      $line;
  }
  
  
  # This isn't really an override.  It's just here because ExtUtils::MM_VMS
  # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext()
  # in MM_VMS, then AUTOLOAD is called, and bad things happen.  So, we just
  # mimic inheritance here and hand off to ExtUtils::Liblist::Kid.
  # XXX This hackery will die soon. --Schwern
  sub ext {
      require ExtUtils::Liblist::Kid;
      goto &ExtUtils::Liblist::Kid::ext;
  }
  
  =back
  
  =head2 Methods
  
  Those methods which override default MM_Unix methods are marked
  "(override)", while methods unique to MM_VMS are marked "(specific)".
  For overridden methods, documentation is limited to an explanation
  of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
  documentation for more details.
  
  =over 4
  
  =item guess_name (override)
  
  Try to determine name of extension being built.  We begin with the name
  of the current directory.  Since VMS filenames are case-insensitive,
  however, we look for a F<.pm> file whose name matches that of the current
  directory (presumably the 'main' F<.pm> file for this extension), and try
  to find a C<package> statement from which to obtain the Mixed::Case
  package name.
  
  =cut
  
  sub guess_name {
      my($self) = @_;
      my($defname,$defpm,@pm,%xs);
      local *PM;
  
      $defname = basename(fileify($ENV{'DEFAULT'}));
      $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
      $defpm = $defname;
      # Fallback in case for some reason a user has copied the files for an
      # extension into a working directory whose name doesn't reflect the
      # extension's name.  We'll use the name of a unique .pm file, or the
      # first .pm file with a matching .xs file.
      if (not -e "${defpm}.pm") {
        @pm = glob('*.pm');
        s/.pm$// for @pm;
        if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
        elsif (@pm) {
          %xs = map { s/.xs$//; ($_,1) } glob('*.xs');  ## no critic
          if (keys %xs) {
              foreach my $pm (@pm) {
                  $defpm = $pm, last if exists $xs{$pm};
              }
          }
        }
      }
      if (open(my $pm, '<', "${defpm}.pm")){
          while (<$pm>) {
              if (/^\s*package\s+([^;]+)/i) {
                  $defname = $1;
                  last;
              }
          }
          print "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
                       "defaulting package name to $defname\n"
              if eof($pm);
          close $pm;
      }
      else {
          print "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
                       "defaulting package name to $defname\n";
      }
      $defname =~ s#[\d.\-_]+$##;
      $defname;
  }
  
  =item find_perl (override)
  
  Use VMS file specification syntax and CLI commands to find and
  invoke Perl images.
  
  =cut
  
  sub find_perl {
      my($self, $ver, $names, $dirs, $trace) = @_;
      my($vmsfile,@sdirs,@snames,@cand);
      my($rslt);
      my($inabs) = 0;
      local *TCF;
  
      if( $self->{PERL_CORE} ) {
          # Check in relative directories first, so we pick up the current
          # version of Perl if we're running MakeMaker as part of the main build.
          @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
                          my($absb) = $self->file_name_is_absolute($b);
                          if ($absa && $absb) { return $a cmp $b }
                          else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
                        } @$dirs;
          # Check miniperl before perl, and check names likely to contain
          # version numbers before "generic" names, so we pick up an
          # executable that's less likely to be from an old installation.
          @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
                           my($bb) = $b =~ m!([^:>\]/]+)$!;
                           my($ahasdir) = (length($a) - length($ba) > 0);
                           my($bhasdir) = (length($b) - length($bb) > 0);
                           if    ($ahasdir and not $bhasdir) { return 1; }
                           elsif ($bhasdir and not $ahasdir) { return -1; }
                           else { $bb =~ /\d/ <=> $ba =~ /\d/
                                    or substr($ba,0,1) cmp substr($bb,0,1)
                                    or length($bb) <=> length($ba) } } @$names;
      }
      else {
          @sdirs  = @$dirs;
          @snames = @$names;
      }
  
      # Image names containing Perl version use '_' instead of '.' under VMS
      s/\.(\d+)$/_$1/ for @snames;
      if ($trace >= 2){
          print "Looking for perl $ver by these names:\n";
          print "\t@snames,\n";
          print "in these dirs:\n";
          print "\t@sdirs\n";
      }
      foreach my $dir (@sdirs){
          next unless defined $dir; # $self->{PERL_SRC} may be undefined
          $inabs++ if $self->file_name_is_absolute($dir);
          if ($inabs == 1) {
              # We've covered relative dirs; everything else is an absolute
              # dir (probably an installed location).  First, we'll try
              # potential command names, to see whether we can avoid a long
              # MCR expression.
              foreach my $name (@snames) {
                  push(@cand,$name) if $name =~ /^[\w\-\$]+$/;
              }
              $inabs++; # Should happen above in next $dir, but just in case...
          }
          foreach my $name (@snames){
              push @cand, ($name !~ m![/:>\]]!) ? $self->catfile($dir,$name)
                                                : $self->fixpath($name,0);
          }
      }
      foreach my $name (@cand) {
          print "Checking $name\n" if $trace >= 2;
          # If it looks like a potential command, try it without the MCR
          if ($name =~ /^[\w\-\$]+$/) {
              open(my $tcf, ">", "temp_mmvms.com")
                  or die('unable to open temp file');
              print $tcf "\$ set message/nofacil/nosever/noident/notext\n";
              print $tcf "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n";
              close $tcf;
              $rslt = `\@temp_mmvms.com` ;
              unlink('temp_mmvms.com');
              if ($rslt =~ /VER_OK/) {
                  print "Using PERL=$name\n" if $trace;
                  return $name;
              }
          }
          next unless $vmsfile = $self->maybe_command($name);
          $vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
          print "Executing $vmsfile\n" if ($trace >= 2);
          open(my $tcf, '>', "temp_mmvms.com")
                  or die('unable to open temp file');
          print $tcf "\$ set message/nofacil/nosever/noident/notext\n";
          print $tcf "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n";
          close $tcf;
          $rslt = `\@temp_mmvms.com`;
          unlink('temp_mmvms.com');
          if ($rslt =~ /VER_OK/) {
              print "Using PERL=MCR $vmsfile\n" if $trace;
              return "MCR $vmsfile";
          }
      }
      print "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
      0; # false and not empty
  }
  
  =item _fixin_replace_shebang (override)
  
  Helper routine for MM->fixin(), overridden because there's no such thing as an
  actual shebang line that will be interpreted by the shell, so we just prepend
  $Config{startperl} and preserve the shebang line argument for any switches it
  may contain.
  
  =cut
  
  sub _fixin_replace_shebang {
      my ( $self, $file, $line ) = @_;
  
      my ( undef, $arg ) = split ' ', $line, 2;
  
      return $Config{startperl} . "\n" . $Config{sharpbang} . "perl $arg\n";
  }
  
  =item maybe_command (override)
  
  Follows VMS naming conventions for executable files.
  If the name passed in doesn't exactly match an executable file,
  appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
  to check for DCL procedure.  If this fails, checks directories in DCL$PATH
  and finally F<Sys$System:> for an executable file having the name specified,
  with or without the F<.Exe>-equivalent suffix.
  
  =cut
  
  sub maybe_command {
      my($self,$file) = @_;
      return $file if -x $file && ! -d _;
      my(@dirs) = ('');
      my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
  
      if ($file !~ m![/:>\]]!) {
          for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
              my $dir = $ENV{"DCL\$PATH;$i"};
              $dir .= ':' unless $dir =~ m%[\]:]$%;
              push(@dirs,$dir);
          }
          push(@dirs,'Sys$System:');
          foreach my $dir (@dirs) {
              my $sysfile = "$dir$file";
              foreach my $ext (@exts) {
                  return $file if -x "$sysfile$ext" && ! -d _;
              }
          }
      }
      return 0;
  }
  
  
  =item pasthru (override)
  
  VMS has $(MMSQUALIFIERS) which is a listing of all the original command line
  options.  This is used in every invocation of make in the VMS Makefile so
  PASTHRU should not be necessary.  Using PASTHRU tends to blow commands past
  the 256 character limit.
  
  =cut
  
  sub pasthru {
      return "PASTHRU=\n";
  }
  
  
  =item pm_to_blib (override)
  
  VMS wants a dot in every file so we can't have one called 'pm_to_blib',
  it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when
  you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'.
  
  So in VMS its pm_to_blib.ts.
  
  =cut
  
  sub pm_to_blib {
      my $self = shift;
  
      my $make = $self->SUPER::pm_to_blib;
  
      $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m;
      $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts};
  
      $make = <<'MAKE' . $make;
  # Dummy target to match Unix target name; we use pm_to_blib.ts as
  # timestamp file to avoid repeated invocations under VMS
  pm_to_blib : pm_to_blib.ts
  	$(NOECHO) $(NOOP)
  
  MAKE
  
      return $make;
  }
  
  
  =item perl_script (override)
  
  If name passed in doesn't specify a readable file, appends F<.com> or
  F<.pl> and tries again, since it's customary to have file types on all files
  under VMS.
  
  =cut
  
  sub perl_script {
      my($self,$file) = @_;
      return $file if -r $file && ! -d _;
      return "$file.com" if -r "$file.com";
      return "$file.pl" if -r "$file.pl";
      return '';
  }
  
  
  =item replace_manpage_separator
  
  Use as separator a character which is legal in a VMS-syntax file name.
  
  =cut
  
  sub replace_manpage_separator {
      my($self,$man) = @_;
      $man = unixify($man);
      $man =~ s#/+#__#g;
      $man;
  }
  
  =item init_DEST
  
  (override) Because of the difficulty concatenating VMS filepaths we
  must pre-expand the DEST* variables.
  
  =cut
  
  sub init_DEST {
      my $self = shift;
  
      $self->SUPER::init_DEST;
  
      # Expand DEST variables.
      foreach my $var ($self->installvars) {
          my $destvar = 'DESTINSTALL'.$var;
          $self->{$destvar} = $self->eliminate_macros($self->{$destvar});
      }
  }
  
  
  =item init_DIRFILESEP
  
  No separator between a directory path and a filename on VMS.
  
  =cut
  
  sub init_DIRFILESEP {
      my($self) = shift;
  
      $self->{DIRFILESEP} = '';
      return 1;
  }
  
  
  =item init_main (override)
  
  
  =cut
  
  sub init_main {
      my($self) = shift;
  
      $self->SUPER::init_main;
  
      $self->{DEFINE} ||= '';
      if ($self->{DEFINE} ne '') {
          my(@terms) = split(/\s+/,$self->{DEFINE});
          my(@defs,@udefs);
          foreach my $def (@terms) {
              next unless $def;
              my $targ = \@defs;
              if ($def =~ s/^-([DU])//) {    # If it was a Unix-style definition
                  $targ = \@udefs if $1 eq 'U';
                  $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
                  $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
              }
              if ($def =~ /=/) {
                  $def =~ s/"/""/g;  # Protect existing " from DCL
                  $def = qq["$def"]; # and quote to prevent parsing of =
              }
              push @$targ, $def;
          }
  
          $self->{DEFINE} = '';
          if (@defs)  {
              $self->{DEFINE}  = '/Define=(' . join(',',@defs)  . ')';
          }
          if (@udefs) {
              $self->{DEFINE} .= '/Undef=('  . join(',',@udefs) . ')';
          }
      }
  }
  
  =item init_tools (override)
  
  Provide VMS-specific forms of various utility commands.
  
  Sets DEV_NULL to nothing because I don't know how to do it on VMS.
  
  Changes EQUALIZE_TIMESTAMP to set revision date of target file to
  one second later than source file, since MMK interprets precisely
  equal revision dates for a source and target file as a sign that the
  target needs to be updated.
  
  =cut
  
  sub init_tools {
      my($self) = @_;
  
      $self->{NOOP}               = 'Continue';
      $self->{NOECHO}             ||= '@ ';
  
      $self->{MAKEFILE}           ||= $self->{FIRST_MAKEFILE} || 'Descrip.MMS';
      $self->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE};
      $self->{MAKE_APERL_FILE}    ||= 'Makeaperl.MMS';
      $self->{MAKEFILE_OLD}       ||= $self->eliminate_macros('$(FIRST_MAKEFILE)_old');
  #
  #   If an extension is not specified, then MMS/MMK assumes an
  #   an extension of .MMS.  If there really is no extension,
  #   then a trailing "." needs to be appended to specify a
  #   a null extension.
  #
      $self->{MAKEFILE} .= '.' unless $self->{MAKEFILE} =~ m/\./;
      $self->{FIRST_MAKEFILE} .= '.' unless $self->{FIRST_MAKEFILE} =~ m/\./;
      $self->{MAKE_APERL_FILE} .= '.' unless $self->{MAKE_APERL_FILE} =~ m/\./;
      $self->{MAKEFILE_OLD} .= '.' unless $self->{MAKEFILE_OLD} =~ m/\./;
  
      $self->{MACROSTART}         ||= '/Macro=(';
      $self->{MACROEND}           ||= ')';
      $self->{USEMAKEFILE}        ||= '/Descrip=';
  
      $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"';
  
      $self->{MOD_INSTALL} ||=
        $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
  install([ from_to => {split('\|', <STDIN>)}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]);
  CODE
  
      $self->{UMASK_NULL} = '! ';
  
      $self->SUPER::init_tools;
  
      # Use the default shell
      $self->{SHELL}    ||= 'Posix';
  
      # Redirection on VMS goes before the command, not after as on Unix.
      # $(DEV_NULL) is used once and its not worth going nuts over making
      # it work.  However, Unix's DEV_NULL is quite wrong for VMS.
      $self->{DEV_NULL}   = '';
  
      return;
  }
  
  =item init_platform (override)
  
  Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION.
  
  MM_VMS_REVISION is for backwards compatibility before MM_VMS had a
  $VERSION.
  
  =cut
  
  sub init_platform {
      my($self) = shift;
  
      $self->{MM_VMS_REVISION} = $Revision;
      $self->{MM_VMS_VERSION}  = $VERSION;
      $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS')
        if $self->{PERL_SRC};
  }
  
  
  =item platform_constants
  
  =cut
  
  sub platform_constants {
      my($self) = shift;
      my $make_frag = '';
  
      foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION))
      {
          next unless defined $self->{$macro};
          $make_frag .= "$macro = $self->{$macro}\n";
      }
  
      return $make_frag;
  }
  
  
  =item init_VERSION (override)
  
  Override the *DEFINE_VERSION macros with VMS semantics.  Translate the
  MAKEMAKER filepath to VMS style.
  
  =cut
  
  sub init_VERSION {
      my $self = shift;
  
      $self->SUPER::init_VERSION;
  
      $self->{DEFINE_VERSION}    = '"$(VERSION_MACRO)=""$(VERSION)"""';
      $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""';
      $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'});
  }
  
  
  =item constants (override)
  
  Fixes up numerous file and directory macros to insure VMS syntax
  regardless of input syntax.  Also makes lists of files
  comma-separated.
  
  =cut
  
  sub constants {
      my($self) = @_;
  
      # Be kind about case for pollution
      for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }
  
      # Cleanup paths for directories in MMS macros.
      foreach my $macro ( qw [
              INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB
              PERL_LIB PERL_ARCHLIB
              PERL_INC PERL_SRC ],
                          (map { 'INSTALL'.$_ } $self->installvars)
                        )
      {
          next unless defined $self->{$macro};
          next if $macro =~ /MAN/ && $self->{$macro} eq 'none';
          $self->{$macro} = $self->fixpath($self->{$macro},1);
      }
  
      # Cleanup paths for files in MMS macros.
      foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD
                             MAKE_APERL_FILE MYEXTLIB] )
      {
          next unless defined $self->{$macro};
          $self->{$macro} = $self->fixpath($self->{$macro},0);
      }
  
      # Fixup files for MMS macros
      # XXX is this list complete?
      for my $macro (qw/
                     FULLEXT VERSION_FROM
  	      /	) {
          next unless defined $self->{$macro};
          $self->{$macro} = $self->fixpath($self->{$macro},0);
      }
  
  
      for my $macro (qw/
                     OBJECT LDFROM
  	      /	) {
          next unless defined $self->{$macro};
  
          # Must expand macros before splitting on unescaped whitespace.
          $self->{$macro} = $self->eliminate_macros($self->{$macro});
          if ($self->{$macro} =~ /(?<!\^)\s/) {
              $self->{$macro} =~ s/(\\)?\n+\s+/ /g;
              $self->{$macro} = $self->wraplist(
                  map $self->fixpath($_,0), split /,?(?<!\^)\s+/, $self->{$macro}
              );
          }
          else {
              $self->{$macro} = $self->fixpath($self->{$macro},0);
          }
      }
  
      for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) {
          # Where is the space coming from? --jhi
          next unless $self ne " " && defined $self->{$macro};
          my %tmp = ();
          for my $key (keys %{$self->{$macro}}) {
              $tmp{$self->fixpath($key,0)} =
                                       $self->fixpath($self->{$macro}{$key},0);
          }
          $self->{$macro} = \%tmp;
      }
  
      for my $macro (qw/ C O_FILES H /) {
          next unless defined $self->{$macro};
          my @tmp = ();
          for my $val (@{$self->{$macro}}) {
              push(@tmp,$self->fixpath($val,0));
          }
          $self->{$macro} = \@tmp;
      }
  
      # mms/k does not define a $(MAKE) macro.
      $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)';
  
      return $self->SUPER::constants;
  }
  
  
  =item special_targets
  
  Clear the default .SUFFIXES and put in our own list.
  
  =cut
  
  sub special_targets {
      my $self = shift;
  
      my $make_frag .= <<'MAKE_FRAG';
  .SUFFIXES :
  .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs
  
  MAKE_FRAG
  
      return $make_frag;
  }
  
  =item cflags (override)
  
  Bypass shell script and produce qualifiers for CC directly (but warn
  user if a shell script for this extension exists).  Fold multiple
  /Defines into one, since some C compilers pay attention to only one
  instance of this qualifier on the command line.
  
  =cut
  
  sub cflags {
      my($self,$libperl) = @_;
      my($quals) = $self->{CCFLAGS} || $Config{'ccflags'};
      my($definestr,$undefstr,$flagoptstr) = ('','','');
      my($incstr) = '/Include=($(PERL_INC)';
      my($name,$sys,@m);
  
      ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
      print "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
           " required to modify CC command for $self->{'BASEEXT'}\n"
      if ($Config{$name});
  
      if ($quals =~ / -[DIUOg]/) {
  	while ($quals =~ / -([Og])(\d*)\b/) {
  	    my($type,$lvl) = ($1,$2);
  	    $quals =~ s/ -$type$lvl\b\s*//;
  	    if ($type eq 'g') { $flagoptstr = '/NoOptimize'; }
  	    else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); }
  	}
  	while ($quals =~ / -([DIU])(\S+)/) {
  	    my($type,$def) = ($1,$2);
  	    $quals =~ s/ -$type$def\s*//;
  	    $def =~ s/"/""/g;
  	    if    ($type eq 'D') { $definestr .= qq["$def",]; }
  	    elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
  	    else                 { $undefstr  .= qq["$def",]; }
  	}
      }
      if (length $quals and $quals !~ m!/!) {
  	warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
  	$quals = '';
      }
      $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE};
      if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
      if (length $undefstr)  { chop($undefstr);  $quals .= "/Undef=($undefstr)";   }
      # Deal with $self->{DEFINE} here since some C compilers pay attention
      # to only one /Define clause on command line, so we have to
      # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
      # ($self->{DEFINE} has already been VMSified in constants() above)
      if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; }
      for my $type (qw(Def Undef)) {
  	my(@terms);
  	while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) {
  		my $term = $1;
  		$term =~ s:^\((.+)\)$:$1:;
  		push @terms, $term;
  	    }
  	if ($type eq 'Def') {
  	    push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ];
  	}
  	if (@terms) {
  	    $quals =~ s:/${type}i?n?e?=[^/]+::ig;
  	    $quals .= "/${type}ine=(" . join(',',@terms) . ')';
  	}
      }
  
      $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
  
      # Likewise with $self->{INC} and /Include
      if ($self->{'INC'}) {
  	my(@includes) = split(/\s+/,$self->{INC});
  	foreach (@includes) {
  	    s/^-I//;
  	    $incstr .= ','.$self->fixpath($_,1);
  	}
      }
      $quals .= "$incstr)";
  #    $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g;
      $self->{CCFLAGS} = $quals;
  
      $self->{PERLTYPE} ||= '';
  
      $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
      if ($self->{OPTIMIZE} !~ m!/!) {
  	if    ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
  	elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
  	    $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
  	}
  	else {
  	    warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
  	    $self->{OPTIMIZE} = '/Optimize';
  	}
      }
  
      return $self->{CFLAGS} = qq{
  CCFLAGS = $self->{CCFLAGS}
  OPTIMIZE = $self->{OPTIMIZE}
  PERLTYPE = $self->{PERLTYPE}
  };
  }
  
  =item const_cccmd (override)
  
  Adds directives to point C preprocessor to the right place when
  handling #include E<lt>sys/foo.hE<gt> directives.  Also constructs CC
  command line a bit differently than MM_Unix method.
  
  =cut
  
  sub const_cccmd {
      my($self,$libperl) = @_;
      my(@m);
  
      return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
      return '' unless $self->needs_linking();
      if ($Config{'vms_cc_type'} eq 'gcc') {
          push @m,'
  .FIRST
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
      }
      elsif ($Config{'vms_cc_type'} eq 'vaxc') {
          push @m,'
  .FIRST
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
      }
      else {
          push @m,'
  .FIRST
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
  		($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
      }
  
      push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
  
      $self->{CONST_CCCMD} = join('',@m);
  }
  
  
  =item tools_other (override)
  
  Throw in some dubious extra macros for Makefile args.
  
  Also keep around the old $(SAY) macro in case somebody's using it.
  
  =cut
  
  sub tools_other {
      my($self) = @_;
  
      # XXX Are these necessary?  Does anyone override them?  They're longer
      # than just typing the literal string.
      my $extra_tools = <<'EXTRA_TOOLS';
  
  # Just in case anyone is using the old macro.
  USEMACROS = $(MACROSTART)
  SAY = $(ECHO)
  
  EXTRA_TOOLS
  
      return $self->SUPER::tools_other . $extra_tools;
  }
  
  =item init_dist (override)
  
  VMSish defaults for some values.
  
    macro         description                     default
  
    ZIPFLAGS      flags to pass to ZIP            -Vu
  
    COMPRESS      compression command to          gzip
                  use for tarfiles
    SUFFIX        suffix to put on                -gz
                  compressed files
  
    SHAR          shar command to use             vms_share
  
    DIST_DEFAULT  default target to use to        tardist
                  create a distribution
  
    DISTVNAME     Use VERSION_SYM instead of      $(DISTNAME)-$(VERSION_SYM)
                  VERSION for the name
  
  =cut
  
  sub init_dist {
      my($self) = @_;
      $self->{ZIPFLAGS}     ||= '-Vu';
      $self->{COMPRESS}     ||= 'gzip';
      $self->{SUFFIX}       ||= '-gz';
      $self->{SHAR}         ||= 'vms_share';
      $self->{DIST_DEFAULT} ||= 'zipdist';
  
      $self->SUPER::init_dist;
  
      $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION_SYM}"
        unless $self->{ARGS}{DISTVNAME};
  
      return;
  }
  
  =item c_o (override)
  
  Use VMS syntax on command line.  In particular, $(DEFINE) and
  $(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
  
  =cut
  
  sub c_o {
      my($self) = @_;
      return '' unless $self->needs_linking();
      '
  .c$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  
  .cpp$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
  
  .cxx$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
  
  ';
  }
  
  =item xs_c (override)
  
  Use MM[SK] macros.
  
  =cut
  
  sub xs_c {
      my($self) = @_;
      return '' unless $self->needs_linking();
      '
  .xs.c :
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
  ';
  }
  
  =item xs_o (override)
  
  Use MM[SK] macros, and VMS command line for C compiler.
  
  =cut
  
  sub xs_o {	# many makes are too dumb to use xs_c then c_o
      my($self) = @_;
      return '' unless $self->needs_linking();
      '
  .xs$(OBJ_EXT) :
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  ';
  }
  
  
  =item dlsyms (override)
  
  Create VMS linker options files specifying universal symbols for this
  extension's shareable image, and listing other shareable images or
  libraries to which it should be linked.
  
  =cut
  
  sub dlsyms {
      my($self,%attribs) = @_;
  
      return '' unless $self->needs_linking();
  
      my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
      my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
      my($funclist)  = $attribs{FUNCLIST}  || $self->{FUNCLIST}  || [];
      my(@m);
  
      unless ($self->{SKIPHASH}{'dynamic'}) {
  	push(@m,'
  dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
  	$(NOECHO) $(NOOP)
  ');
      }
  
      push(@m,'
  static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
  	$(NOECHO) $(NOOP)
  ') unless $self->{SKIPHASH}{'static'};
  
      push @m,'
  $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
  	$(CP) $(MMS$SOURCE) $(MMS$TARGET)
  
  $(BASEEXT).opt : Makefile.PL
  	$(PERLRUN) -e "use ExtUtils::Mksymlists;" -
  	',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
  	neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
  	q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n];
  
      push @m, '	$(PERL) -e "print ""$(INST_STATIC)/Include=';
      if ($self->{OBJECT} =~ /\bBASEEXT\b/ or
          $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) {
          push @m, ($Config{d_vms_case_sensitive_symbols}
  	           ? uc($self->{BASEEXT}) :'$(BASEEXT)');
      }
      else {  # We don't have a "main" object file, so pull 'em all in
          # Upcase module names if linker is being case-sensitive
          my($upcase) = $Config{d_vms_case_sensitive_symbols};
          my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT});
          for (@omods) {
              s/\.[^.]*$//;         # Trim off file type
              s[\$\(\w+_EXT\)][];   # even as a macro
              s/.*[:>\/\]]//;       # Trim off dir spec
              $_ = uc if $upcase;
          };
  
          my(@lines);
          my $tmp = shift @omods;
          foreach my $elt (@omods) {
              $tmp .= ",$elt";
              if (length($tmp) > 80) { push @lines, $tmp;  $tmp = ''; }
          }
          push @lines, $tmp;
          push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')';
      }
      push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n";
  
      if (length $self->{LDLOADLIBS}) {
          my($line) = '';
          foreach my $lib (split ' ', $self->{LDLOADLIBS}) {
              $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
              if (length($line) + length($lib) > 160) {
                  push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
                  $line = $lib . '\n';
              }
              else { $line .= $lib . '\n'; }
          }
          push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
      }
  
      join('',@m);
  
  }
  
  =item dynamic_lib (override)
  
  Use VMS Link command.
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      return '' unless $self->needs_linking(); #might be because of a subdir
  
      return '' unless $self->has_link_code();
  
      my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
      my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
      my $shr = $Config{'dbgprefix'} . 'PerlShr';
      my(@m);
      push @m,"
  
  OTHERLDFLAGS = $otherldflags
  INST_DYNAMIC_DEP = $inst_dynamic_dep
  
  ";
      push @m, '
  $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  	If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
  	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
  ';
  
      join('',@m);
  }
  
  
  =item static_lib (override)
  
  Use VMS commands to manipulate object library.
  
  =cut
  
  sub static_lib {
      my($self) = @_;
      return '' unless $self->needs_linking();
  
      return '
  $(INST_STATIC) :
  	$(NOECHO) $(NOOP)
  ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
  
      my(@m);
      push @m,'
  # Rely on suffix rule for update action
  $(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists
  
  $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
  ';
      # If this extension has its own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
  
      push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
  
      # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
      # 'cause it's a library and you can't stick them in other libraries.
      # In that case, we use $OBJECT instead and hope for the best
      if ($self->{MYEXTLIB}) {
        push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
      } else {
        push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
      }
  
      push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
      foreach my $lib (split ' ', $self->{EXTRALIBS}) {
        push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
      }
      join('',@m);
  }
  
  
  =item extra_clean_files
  
  Clean up some OS specific files.  Plus the temp file used to shorten
  a lot of commands.  And the name mangler database.
  
  =cut
  
  sub extra_clean_files {
      return qw(
                *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso
                .MM_Tmp cxx_repository
               );
  }
  
  
  =item zipfile_target
  
  =item tarfile_target
  
  =item shdist_target
  
  Syntax for invoking shar, tar and zip differs from that for Unix.
  
  =cut
  
  sub zipfile_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  $(DISTVNAME).zip : distdir
  	$(PREOP)
  	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
  	$(RM_RF) $(DISTVNAME)
  	$(POSTOP)
  MAKE_FRAG
  }
  
  sub tarfile_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  $(DISTVNAME).tar$(SUFFIX) : distdir
  	$(PREOP)
  	$(TO_UNIX)
          $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
  	$(RM_RF) $(DISTVNAME)
  	$(COMPRESS) $(DISTVNAME).tar
  	$(POSTOP)
  MAKE_FRAG
  }
  
  sub shdist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  shdist : distdir
  	$(PREOP)
  	$(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share
  	$(RM_RF) $(DISTVNAME)
  	$(POSTOP)
  MAKE_FRAG
  }
  
  
  # --- Test and Installation Sections ---
  
  =item install (override)
  
  Work around DCL's 255 character limit several times,and use
  VMS-style command line quoting in a few cases.
  
  =cut
  
  sub install {
      my($self, %attribs) = @_;
      my(@m);
  
      push @m, q[
  install :: all pure_install doc_install
  	$(NOECHO) $(NOOP)
  
  install_perl :: all pure_perl_install doc_perl_install
  	$(NOECHO) $(NOOP)
  
  install_site :: all pure_site_install doc_site_install
  	$(NOECHO) $(NOOP)
  
  install_vendor :: all pure_vendor_install doc_vendor_install
  	$(NOECHO) $(NOOP)
  
  pure_install :: pure_$(INSTALLDIRS)_install
  	$(NOECHO) $(NOOP)
  
  doc_install :: doc_$(INSTALLDIRS)_install
          $(NOECHO) $(NOOP)
  
  pure__install : pure_site_install
  	$(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
  
  doc__install : doc_site_install
  	$(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
  
  # This hack brought to you by DCL's 255-character command line limit
  pure_perl_install ::
  ];
      push @m,
  q[	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read|'.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').'|'" >.MM_tmp
  	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write|'.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').'|'" >>.MM_tmp
  ] unless $self->{NO_PACKLIST};
  
      push @m,
  q[	$(NOECHO) $(ECHO_N) "$(INST_LIB)|$(DESTINSTALLPRIVLIB)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_ARCHLIB)|$(DESTINSTALLARCHLIB)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_BIN)|$(DESTINSTALLBIN)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_SCRIPT)|$(DESTINSTALLSCRIPT)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_MAN3DIR)|$(DESTINSTALLMAN3DIR)" >>.MM_tmp
  	$(NOECHO) $(MOD_INSTALL) <.MM_tmp
  	$(NOECHO) $(RM_F) .MM_tmp
  	$(NOECHO) $(WARN_IF_OLD_PACKLIST) "].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q["
  
  # Likewise
  pure_site_install ::
  ];
      push @m,
  q[	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read|'.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').'|'" >.MM_tmp
  	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write|'.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').'|'" >>.MM_tmp
  ] unless $self->{NO_PACKLIST};
  
      push @m,
  q[	$(NOECHO) $(ECHO_N) "$(INST_LIB)|$(DESTINSTALLSITELIB)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_ARCHLIB)|$(DESTINSTALLSITEARCH)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_BIN)|$(DESTINSTALLSITEBIN)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_SCRIPT)|$(DESTINSTALLSCRIPT)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_MAN1DIR)|$(DESTINSTALLSITEMAN1DIR)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_MAN3DIR)|$(DESTINSTALLSITEMAN3DIR)" >>.MM_tmp
  	$(NOECHO) $(MOD_INSTALL) <.MM_tmp
  	$(NOECHO) $(RM_F) .MM_tmp
  	$(NOECHO) $(WARN_IF_OLD_PACKLIST) "].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q["
  
  pure_vendor_install ::
  ];
      push @m,
  q[	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read|'.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').'|'" >.MM_tmp
  	$(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write|'.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').'|'" >>.MM_tmp
  ] unless $self->{NO_PACKLIST};
  
      push @m,
  q[	$(NOECHO) $(ECHO_N) "$(INST_LIB)|$(DESTINSTALLVENDORLIB)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_ARCHLIB)|$(DESTINSTALLVENDORARCH)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_BIN)|$(DESTINSTALLVENDORBIN)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_SCRIPT)|$(DESTINSTALLSCRIPT)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_MAN1DIR)|$(DESTINSTALLVENDORMAN1DIR)|" >>.MM_tmp
  	$(NOECHO) $(ECHO_N) "$(INST_MAN3DIR)|$(DESTINSTALLVENDORMAN3DIR)" >>.MM_tmp
  	$(NOECHO) $(MOD_INSTALL) <.MM_tmp
  	$(NOECHO) $(RM_F) .MM_tmp
  
  ];
  
      push @m, q[
  # Ditto
  doc_perl_install ::
  	$(NOECHO) $(NOOP)
  
  # And again
  doc_site_install ::
  	$(NOECHO) $(NOOP)
  
  doc_vendor_install ::
  	$(NOECHO) $(NOOP)
  
  ] if $self->{NO_PERLLOCAL};
  
      push @m, q[
  # Ditto
  doc_perl_install ::
  	$(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
  	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  	$(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp
  	$(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
  	$(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
  	$(NOECHO) $(RM_F) .MM_tmp
  
  # And again
  doc_site_install ::
  	$(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
  	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  	$(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp
  	$(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
  	$(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
  	$(NOECHO) $(RM_F) .MM_tmp
  
  doc_vendor_install ::
  	$(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
  	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  	$(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp
  	$(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
  	$(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
  	$(NOECHO) $(RM_F) .MM_tmp
  
  ] unless $self->{NO_PERLLOCAL};
  
      push @m, q[
  uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  	$(NOECHO) $(NOOP)
  
  uninstall_from_perldirs ::
  	$(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
  
  uninstall_from_sitedirs ::
  	$(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
  
  uninstall_from_vendordirs ::
  	$(NOECHO) $(UNINSTALL) ].$self->catfile($self->{VENDORARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
  ];
  
      join('',@m);
  }
  
  =item perldepend (override)
  
  Use VMS-style syntax for files; it's cheaper to just do it directly here
  than to have the MM_Unix method call C<catfile> repeatedly.  Also, if
  we have to rebuild Config.pm, use MM[SK] to do it.
  
  =cut
  
  sub perldepend {
      my($self) = @_;
      my(@m);
  
      if ($self->{OBJECT}) {
          # Need to add an object file dependency on the perl headers.
          # this is very important for XS modules in perl.git development.
  
          push @m, $self->_perl_header_files_fragment(""); # empty separator on VMS as its in the $(PERL_INC)
      }
  
      if ($self->{PERL_SRC}) {
  	my(@macros);
  	my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
  	push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
  	push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
  	push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
  	push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
  	push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
  	$mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
  	push(@m,q[
  # Check for unpropagated config.sh changes. Should never happen.
  # We do NOT just update config.h because that is not sufficient.
  # An out of date config.h is not fatal but complains loudly!
  $(PERL_INC)config.h : $(PERL_SRC)config.sh
  	$(NOOP)
  
  $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
  	$(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
  	olddef = F$Environment("Default")
  	Set Default $(PERL_SRC)
  	$(MMS)],$mmsquals,);
  	if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
  	    my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
  	    $target =~ s/\Q$prefix/[/;
  	    push(@m," $target");
  	}
  	else { push(@m,' $(MMS$TARGET)'); }
  	push(@m,q[
  	Set Default 'olddef'
  ]);
      }
  
      push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
        if %{$self->{XS}};
  
      join('',@m);
  }
  
  
  =item makeaperl (override)
  
  Undertake to build a new set of Perl images using VMS commands.  Since
  VMS does dynamic loading, it's not necessary to statically link each
  extension into the Perl image, so this isn't the normal build path.
  Consequently, it hasn't really been tested, and may well be incomplete.
  
  =cut
  
  our %olbs;  # needs to be localized
  
  sub makeaperl {
      my($self, %attribs) = @_;
      my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) =
        @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
      my(@m);
      push @m, "
  # --- MakeMaker makeaperl section ---
  MAP_TARGET    = $target
  ";
      return join '', @m if $self->{PARENT};
  
      my($dir) = join ":", @{$self->{DIR}};
  
      unless ($self->{MAKEAPERL}) {
  	push @m, q{
  $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
  	$(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
  	$(NOECHO) $(PERLRUNINST) \
  		Makefile.PL DIR=}, $dir, q{ \
  		FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
  		MAKEAPERL=1 NORECURS=1 };
  
  	push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
  
  $(MAP_TARGET) :: $(MAKE_APERL_FILE)
  	$(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
  };
  	push @m, "\n";
  
  	return join '', @m;
      }
  
  
      my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
      local($_);
  
      # The front matter of the linkcommand...
      $linkcmd = join ' ', $Config{'ld'},
  	    grep($_, @Config{qw(large split ldflags ccdlflags)});
      $linkcmd =~ s/\s+/ /g;
  
      # Which *.olb files could we make use of...
      local(%olbs);       # XXX can this be lexical?
      $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
      require File::Find;
      File::Find::find(sub {
  	return unless m/\Q$self->{LIB_EXT}\E$/;
  	return if m/^libperl/;
  
  	if( exists $self->{INCLUDE_EXT} ){
  		my $found = 0;
  
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything not explicitly marked for inclusion.
  		# DynaLoader is implied.
  		foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
  			if( $xx eq $incl ){
  				$found++;
  				last;
  			}
  		}
  		return unless $found;
  	}
  	elsif( exists $self->{EXCLUDE_EXT} ){
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything explicitly marked for exclusion
  		foreach my $excl (@{$self->{EXCLUDE_EXT}}){
  			return if( $xx eq $excl );
  		}
  	}
  
  	$olbs{$ENV{DEFAULT}} = $_;
      }, grep( -d $_, @{$searchdirs || []}));
  
      # We trust that what has been handed in as argument will be buildable
      $static = [] unless $static;
      @olbs{@{$static}} = (1) x @{$static};
  
      $extra = [] unless $extra && ref $extra eq 'ARRAY';
      # Sort the object libraries in inverse order of
      # filespec length to try to insure that dependent extensions
      # will appear before their parents, so the linker will
      # search the parent library to resolve references.
      # (e.g. Intuit::DWIM will precede Intuit, so unresolved
      # references from [.intuit.dwim]dwim.obj can be found
      # in [.intuit]intuit.olb).
      for (sort { length($a) <=> length($b) } keys %olbs) {
  	next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
  	my($dir) = $self->fixpath($_,1);
  	my($extralibs) = $dir . "extralibs.ld";
  	my($extopt) = $dir . $olbs{$_};
  	$extopt =~ s/$self->{LIB_EXT}$/.opt/;
  	push @optlibs, "$dir$olbs{$_}";
  	# Get external libraries this extension will need
  	if (-f $extralibs ) {
  	    my %seenthis;
  	    open my $list, "<", $extralibs or warn $!,next;
  	    while (<$list>) {
  		chomp;
  		# Include a library in the link only once, unless it's mentioned
  		# multiple times within a single extension's options file, in which
  		# case we assume the builder needed to search it again later in the
  		# link.
  		my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
  		$libseen{$_}++;  $seenthis{$_}++;
  		next if $skip;
  		push @$extra,$_;
  	    }
  	}
  	# Get full name of extension for ExtUtils::Miniperl
  	if (-f $extopt) {
  	    open my $opt, '<', $extopt or die $!;
  	    while (<$opt>) {
  		next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
  		my $pkg = $1;
  		$pkg =~ s#__*#::#g;
  		push @staticpkgs,$pkg;
  	    }
  	}
      }
      # Place all of the external libraries after all of the Perl extension
      # libraries in the final link, in order to maximize the opportunity
      # for XS code from multiple extensions to resolve symbols against the
      # same external library while only including that library once.
      push @optlibs, @$extra;
  
      $target = "Perl$Config{'exe_ext'}" unless $target;
      my $shrtarget;
      ($shrtarget,$targdir) = fileparse($target);
      $shrtarget =~ s/^([^.]*)/$1Shr/;
      $shrtarget = $targdir . $shrtarget;
      $target = "Perlshr.$Config{'dlext'}" unless $target;
      $tmpdir = "[]" unless $tmpdir;
      $tmpdir = $self->fixpath($tmpdir,1);
      if (@optlibs) { $extralist = join(' ',@optlibs); }
      else          { $extralist = ''; }
      # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
      # that's what we're building here).
      push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
      if ($libperl) {
  	unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
  	    print "Warning: $libperl not found\n";
  	    undef $libperl;
  	}
      }
      unless ($libperl) {
  	if (defined $self->{PERL_SRC}) {
  	    $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
  	} elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
  	} else {
  	    print "Warning: $libperl not found
      If you're going to build a static perl binary, make sure perl is installed
      otherwise ignore this warning\n";
  	}
      }
      $libperldir = $self->fixpath((fileparse($libperl))[1],1);
  
      push @m, '
  # Fill in the target you want to produce if it\'s not perl
  MAP_TARGET    = ',$self->fixpath($target,0),'
  MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
  MAP_LINKCMD   = $linkcmd
  MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
  MAP_EXTRA     = $extralist
  MAP_LIBPERL = ",$self->fixpath($libperl,0),'
  ';
  
  
      push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
      foreach (@optlibs) {
  	push @m,'	$(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
      }
      push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
      push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
  
      push @m,'
  $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
  	$(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
  $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
  	$(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
  	$(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
  	$(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
  	$(NOECHO) $(ECHO) "To remove the intermediate files, say
  	$(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
  ';
      push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
      push @m, "# More from the 255-char line length limit\n";
      foreach (@staticpkgs) {
  	push @m,'	$(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
      }
  
      push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
  	$(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
  	$(NOECHO) $(RM_F) %sWritemain.tmp
  MAKE_FRAG
  
      push @m, q[
  # Still more from the 255-char line length limit
  doc_inst_perl :
  	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  	$(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
  	$(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
  	$(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
  	$(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
  	$(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
  	$(NOECHO) $(RM_F) .MM_tmp
  ];
  
      push @m, "
  inst_perl : pure_inst_perl doc_inst_perl
  	\$(NOECHO) \$(NOOP)
  
  pure_inst_perl : \$(MAP_TARGET)
  	$self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
  	$self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
  
  clean :: map_clean
  	\$(NOECHO) \$(NOOP)
  
  map_clean :
  	\$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
  	\$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
  ";
  
      join '', @m;
  }
  
  
  # --- Output postprocessing section ---
  
  =item maketext_filter (override)
  
  Insure that colons marking targets are preceded by space, in order
  to distinguish the target delimiter from a colon appearing as
  part of a filespec.
  
  =cut
  
  sub maketext_filter {
      my($self, $text) = @_;
  
      $text =~ s/^([^\s:=]+)(:+\s)/$1 $2/mg;
      return $text;
  }
  
  =item prefixify (override)
  
  prefixifying on VMS is simple.  Each should simply be:
  
      perl_root:[some.dir]
  
  which can just be converted to:
  
      volume:[your.prefix.some.dir]
  
  otherwise you get the default layout.
  
  In effect, your search prefix is ignored and $Config{vms_prefix} is
  used instead.
  
  =cut
  
  sub prefixify {
      my($self, $var, $sprefix, $rprefix, $default) = @_;
  
      # Translate $(PERLPREFIX) to a real path.
      $rprefix = $self->eliminate_macros($rprefix);
      $rprefix = vmspath($rprefix) if $rprefix;
      $sprefix = vmspath($sprefix) if $sprefix;
  
      $default = vmsify($default)
        unless $default =~ /\[.*\]/;
  
      (my $var_no_install = $var) =~ s/^install//;
      my $path = $self->{uc $var} ||
                 $ExtUtils::MM_Unix::Config_Override{lc $var} ||
                 $Config{lc $var} || $Config{lc $var_no_install};
  
      if( !$path ) {
          warn "  no Config found for $var.\n" if $Verbose >= 2;
          $path = $self->_prefixify_default($rprefix, $default);
      }
      elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) {
          # do nothing if there's no prefix or if its relative
      }
      elsif( $sprefix eq $rprefix ) {
          warn "  no new prefix.\n" if $Verbose >= 2;
      }
      else {
  
          warn "  prefixify $var => $path\n"     if $Verbose >= 2;
          warn "    from $sprefix to $rprefix\n" if $Verbose >= 2;
  
          my($path_vol, $path_dirs) = $self->splitpath( $path );
          if( $path_vol eq $Config{vms_prefix}.':' ) {
              warn "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
  
              $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
              $path = $self->_catprefix($rprefix, $path_dirs);
          }
          else {
              $path = $self->_prefixify_default($rprefix, $default);
          }
      }
  
      print "    now $path\n" if $Verbose >= 2;
      return $self->{uc $var} = $path;
  }
  
  
  sub _prefixify_default {
      my($self, $rprefix, $default) = @_;
  
      warn "  cannot prefix, using default.\n" if $Verbose >= 2;
  
      if( !$default ) {
          warn "No default!\n" if $Verbose >= 1;
          return;
      }
      if( !$rprefix ) {
          warn "No replacement prefix!\n" if $Verbose >= 1;
          return '';
      }
  
      return $self->_catprefix($rprefix, $default);
  }
  
  sub _catprefix {
      my($self, $rprefix, $default) = @_;
  
      my($rvol, $rdirs) = $self->splitpath($rprefix);
      if( $rvol ) {
          return $self->catpath($rvol,
                                     $self->catdir($rdirs, $default),
                                     ''
                                    )
      }
      else {
          return $self->catdir($rdirs, $default);
      }
  }
  
  
  =item cd
  
  =cut
  
  sub cd {
      my($self, $dir, @cmds) = @_;
  
      $dir = vmspath($dir);
  
      my $cmd = join "\n\t", map "$_", @cmds;
  
      # No leading tab makes it look right when embedded
      my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
  startdir = F$Environment("Default")
  	Set Default %s
  	%s
  	Set Default 'startdir'
  MAKE_FRAG
  
      # No trailing newline makes this easier to embed
      chomp $make_frag;
  
      return $make_frag;
  }
  
  
  =item oneliner
  
  =cut
  
  sub oneliner {
      my($self, $cmd, $switches) = @_;
      $switches = [] unless defined $switches;
  
      # Strip leading and trailing newlines
      $cmd =~ s{^\n+}{};
      $cmd =~ s{\n+$}{};
  
      $cmd = $self->quote_literal($cmd);
      $cmd = $self->escape_newlines($cmd);
  
      # Switches must be quoted else they will be lowercased.
      $switches = join ' ', map { qq{"$_"} } @$switches;
  
      return qq{\$(ABSPERLRUN) $switches -e $cmd "--"};
  }
  
  
  =item B<echo>
  
  perl trips up on "<foo>" thinking it's an input redirect.  So we use the
  native Write command instead.  Besides, its faster.
  
  =cut
  
  sub echo {
      my($self, $text, $file, $opts) = @_;
  
      # Compatibility with old options
      if( !ref $opts ) {
          my $append = $opts;
          $opts = { append => $append || 0 };
      }
      my $opencmd = $opts->{append} ? 'Open/Append' : 'Open/Write';
  
      $opts->{allow_variables} = 0 unless defined $opts->{allow_variables};
  
      my $ql_opts = { allow_variables => $opts->{allow_variables} };
  
      my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
      push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_, $ql_opts) }
                  split /\n/, $text;
      push @cmds, '$(NOECHO) Close MMECHOFILE';
      return @cmds;
  }
  
  
  =item quote_literal
  
  =cut
  
  sub quote_literal {
      my($self, $text, $opts) = @_;
      $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
  
      # I believe this is all we should need.
      $text =~ s{"}{""}g;
  
      $text = $opts->{allow_variables}
        ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
  
      return qq{"$text"};
  }
  
  =item escape_dollarsigns
  
  Quote, don't escape.
  
  =cut
  
  sub escape_dollarsigns {
      my($self, $text) = @_;
  
      # Quote dollar signs which are not starting a variable
      $text =~ s{\$ (?!\() }{"\$"}gx;
  
      return $text;
  }
  
  
  =item escape_all_dollarsigns
  
  Quote, don't escape.
  
  =cut
  
  sub escape_all_dollarsigns {
      my($self, $text) = @_;
  
      # Quote dollar signs
      $text =~ s{\$}{"\$\"}gx;
  
      return $text;
  }
  
  =item escape_newlines
  
  =cut
  
  sub escape_newlines {
      my($self, $text) = @_;
  
      $text =~ s{\n}{-\n}g;
  
      return $text;
  }
  
  =item max_exec_len
  
  256 characters.
  
  =cut
  
  sub max_exec_len {
      my $self = shift;
  
      return $self->{_MAX_EXEC_LEN} ||= 256;
  }
  
  =item init_linker
  
  =cut
  
  sub init_linker {
      my $self = shift;
      $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
  
      my $shr = $Config{dbgprefix} . 'PERLSHR';
      if ($self->{PERL_SRC}) {
          $self->{PERL_ARCHIVE} ||=
            $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
      }
      else {
          $self->{PERL_ARCHIVE} ||=
            $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
      }
  
      $self->{PERL_ARCHIVEDEP} ||= '';
      $self->{PERL_ARCHIVE_AFTER} ||= '';
  }
  
  
  =item catdir (override)
  
  =item catfile (override)
  
  Eliminate the macros in the output to the MMS/MMK file.
  
  (File::Spec::VMS used to do this for us, but it's being removed)
  
  =cut
  
  sub catdir {
      my $self = shift;
  
      # Process the macros on VMS MMS/MMK
      my @args = map { m{\$\(} ? $self->eliminate_macros($_) : $_  } @_;
  
      my $dir = $self->SUPER::catdir(@args);
  
      # Fix up the directory and force it to VMS format.
      $dir = $self->fixpath($dir, 1);
  
      return $dir;
  }
  
  sub catfile {
      my $self = shift;
  
      # Process the macros on VMS MMS/MMK
      my @args = map { m{\$\(} ? $self->eliminate_macros($_) : $_  } @_;
  
      my $file = $self->SUPER::catfile(@args);
  
      $file = vmsify($file);
  
      return $file
  }
  
  
  =item eliminate_macros
  
  Expands MM[KS]/Make macros in a text string, using the contents of
  identically named elements of C<%$self>, and returns the result
  as a file specification in Unix syntax.
  
  NOTE:  This is the canonical version of the method.  The version in
  File::Spec::VMS is deprecated.
  
  =cut
  
  sub eliminate_macros {
      my($self,$path) = @_;
      return '' unless $path;
      $self = {} unless ref $self;
  
      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;
  }
  
  =item fixpath
  
     my $path = $mm->fixpath($path);
     my $path = $mm->fixpath($path, $is_dir);
  
  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.
  
  NOTE:  This is the canonical version of the method.  The version in
  File::Spec::VMS is deprecated.
  
  =cut
  
  sub fixpath {
      my($self,$path,$force_path) = @_;
      return '' unless $path;
      $self = bless {}, $self unless ref $self;
      my($fixedpath,$prefix,$name);
  
      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/^[^\[<]+//; }
  
      return $fixedpath;
  }
  
  
  =item os_flavor
  
  VMS is VMS.
  
  =cut
  
  sub os_flavor {
      return('VMS');
  }
  
  
  =item is_make_type (override)
  
  None of the make types being checked for is viable on VMS,
  plus our $self->{MAKE} is an unexpanded (and unexpandable)
  macro whose value is known only to the make utility itself.
  
  =cut
  
  sub is_make_type {
      my($self, $type) = @_;
      return 0;
  }
  
  
  =back
  
  
  =head1 AUTHOR
  
  Original author Charles Bailey F<bailey@newman.upenn.edu>
  
  Maintained by Michael G Schwern F<schwern@pobox.com>
  
  See L<ExtUtils::MakeMaker> for patching and contact information.
  
  
  =cut
  
  1;
  
EXTUTILS_MM_VMS

$fatpacked{"ExtUtils/MM_VOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_VOS';
  package ExtUtils::MM_VOS;
  
  use strict;
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Unix;
  our @ISA = qw(ExtUtils::MM_Unix);
  
  
  =head1 NAME
  
  ExtUtils::MM_VOS - VOS specific subclass of ExtUtils::MM_Unix
  
  =head1 SYNOPSIS
  
    Don't use this module directly.
    Use ExtUtils::MM and let it choose.
  
  =head1 DESCRIPTION
  
  This is a subclass of ExtUtils::MM_Unix which contains functionality for
  VOS.
  
  Unless otherwise stated it works just like ExtUtils::MM_Unix
  
  =head2 Overridden methods
  
  =head3 extra_clean_files
  
  Cleanup VOS core files
  
  =cut
  
  sub extra_clean_files {
      return qw(*.kp);
  }
  
  
  =head1 AUTHOR
  
  Michael G Schwern <schwern@pobox.com> with code from ExtUtils::MM_Unix
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker>
  
  =cut
  
  
  1;
EXTUTILS_MM_VOS

$fatpacked{"ExtUtils/MM_Win32.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_WIN32';
  package ExtUtils::MM_Win32;
  
  use strict;
  
  
  =head1 NAME
  
  ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
   use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =cut
  
  use ExtUtils::MakeMaker::Config;
  use File::Basename;
  use File::Spec;
  use ExtUtils::MakeMaker qw( neatvalue );
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  our $VERSION = '7.04';
  
  $ENV{EMXSHELL} = 'sh'; # to run `commands`
  
  my ( $BORLAND, $GCC, $DLLTOOL ) = _identify_compiler_environment( \%Config );
  
  sub _identify_compiler_environment {
  	my ( $config ) = @_;
  
  	my $BORLAND = $config->{cc} =~ /^bcc/i ? 1 : 0;
  	my $GCC     = $config->{cc} =~ /\bgcc\b/i ? 1 : 0;
  	my $DLLTOOL = $config->{dlltool} || 'dlltool';
  
  	return ( $BORLAND, $GCC, $DLLTOOL );
  }
  
  
  =head2 Overridden methods
  
  =over 4
  
  =item B<dlsyms>
  
  =cut
  
  sub dlsyms {
      my($self,%attribs) = @_;
  
      my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
      my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
      my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
      my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
      my(@m);
  
      if (not $self->{SKIPHASH}{'dynamic'}) {
  	push(@m,"
  $self->{BASEEXT}.def: Makefile.PL
  ",
       q!	$(PERLRUN) -MExtUtils::Mksymlists \\
       -e "Mksymlists('NAME'=>\"!, $self->{NAME},
       q!\", 'DLBASE' => '!,$self->{DLBASE},
       # The above two lines quoted differently to work around
       # a bug in the 4DOS/4NT command line interpreter.  The visible
       # result of the bug was files named q('extension_name',) *with the
       # single quotes and the comma* in the extension build directories.
       q!', 'DL_FUNCS' => !,neatvalue($funcs),
       q!, 'FUNCLIST' => !,neatvalue($funclist),
       q!, 'IMPORTS' => !,neatvalue($imports),
       q!, 'DL_VARS' => !, neatvalue($vars), q!);"
  !);
      }
      join('',@m);
  }
  
  =item replace_manpage_separator
  
  Changes the path separator with .
  
  =cut
  
  sub replace_manpage_separator {
      my($self,$man) = @_;
      $man =~ s,/+,.,g;
      $man;
  }
  
  
  =item B<maybe_command>
  
  Since Windows has nothing as simple as an executable bit, we check the
  file extension.
  
  The PATHEXT env variable will be used to get a list of extensions that
  might indicate a command, otherwise .com, .exe, .bat and .cmd will be
  used by default.
  
  =cut
  
  sub maybe_command {
      my($self,$file) = @_;
      my @e = exists($ENV{'PATHEXT'})
            ? split(/;/, $ENV{PATHEXT})
  	  : qw(.com .exe .bat .cmd);
      my $e = '';
      for (@e) { $e .= "\Q$_\E|" }
      chop $e;
      # see if file ends in one of the known extensions
      if ($file =~ /($e)$/i) {
  	return $file if -e $file;
      }
      else {
  	for (@e) {
  	    return "$file$_" if -e "$file$_";
  	}
      }
      return;
  }
  
  
  =item B<init_DIRFILESEP>
  
  Using \ for Windows, except for "gmake" where it is /.
  
  =cut
  
  sub init_DIRFILESEP {
      my($self) = shift;
  
      # The ^ makes sure its not interpreted as an escape in nmake
      $self->{DIRFILESEP} = $self->is_make_type('nmake') ? '^\\' :
                            $self->is_make_type('dmake') ? '\\\\' :
                            $self->is_make_type('gmake') ? '/'
                                                         : '\\';
  }
  
  =item init_tools
  
  Override some of the slower, portable commands with Windows specific ones.
  
  =cut
  
  sub init_tools {
      my ($self) = @_;
  
      $self->{NOOP}     ||= 'rem';
      $self->{DEV_NULL} ||= '> NUL';
  
      $self->{FIXIN}    ||= $self->{PERL_CORE} ?
        "\$(PERLRUN) $self->{PERL_SRC}\\win32\\bin\\pl2bat.pl" :
        'pl2bat.bat';
  
      $self->SUPER::init_tools;
  
      # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
      delete $self->{SHELL};
  
      return;
  }
  
  
  =item init_others
  
  Override the default link and compile tools.
  
  LDLOADLIBS's default is changed to $Config{libs}.
  
  Adjustments are made for Borland's quirks needing -L to come first.
  
  =cut
  
  sub init_others {
      my $self = shift;
  
      $self->{LD}     ||= 'link';
      $self->{AR}     ||= 'lib';
  
      $self->SUPER::init_others;
  
      $self->{LDLOADLIBS} ||= $Config{libs};
      # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
      if ($BORLAND) {
          my $libs = $self->{LDLOADLIBS};
          my $libpath = '';
          while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
              $libpath .= ' ' if length $libpath;
              $libpath .= $1;
          }
          $self->{LDLOADLIBS} = $libs;
          $self->{LDDLFLAGS} ||= $Config{lddlflags};
          $self->{LDDLFLAGS} .= " $libpath";
      }
  
      return;
  }
  
  
  =item init_platform
  
  Add MM_Win32_VERSION.
  
  =item platform_constants
  
  =cut
  
  sub init_platform {
      my($self) = shift;
  
      $self->{MM_Win32_VERSION} = $VERSION;
  
      return;
  }
  
  sub platform_constants {
      my($self) = shift;
      my $make_frag = '';
  
      foreach my $macro (qw(MM_Win32_VERSION))
      {
          next unless defined $self->{$macro};
          $make_frag .= "$macro = $self->{$macro}\n";
      }
  
      return $make_frag;
  }
  
  
  =item constants
  
  Add MAXLINELENGTH for dmake before all the constants are output.
  
  =cut
  
  sub constants {
      my $self = shift;
  
      my $make_text = $self->SUPER::constants;
      return $make_text unless $self->is_make_type('dmake');
  
      # dmake won't read any single "line" (even those with escaped newlines)
      # larger than a certain size which can be as small as 8k.  PM_TO_BLIB
      # on large modules like DateTime::TimeZone can create lines over 32k.
      # So we'll crank it up to a <ironic>WHOPPING</ironic> 64k.
      #
      # This has to come here before all the constants and not in
      # platform_constants which is after constants.
      my $size = $self->{MAXLINELENGTH} || 800000;
      my $prefix = qq{
  # Get dmake to read long commands like PM_TO_BLIB
  MAXLINELENGTH = $size
  
  };
  
      return $prefix . $make_text;
  }
  
  
  =item special_targets
  
  Add .USESHELL target for dmake.
  
  =cut
  
  sub special_targets {
      my($self) = @_;
  
      my $make_frag = $self->SUPER::special_targets;
  
      $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake');
  .USESHELL :
  MAKE_FRAG
  
      return $make_frag;
  }
  
  
  =item static_lib
  
  Changes how to run the linker.
  
  The rest is duplicate code from MM_Unix.  Should move the linker code
  to its own method.
  
  =cut
  
  sub static_lib {
      my($self) = @_;
      return '' unless $self->has_link_code;
  
      my(@m);
      push(@m, <<'END');
  $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(RM_RF) $@
  END
  
      # If this extension has its own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
  	$(CP) $(MYEXTLIB) $@
  MAKE_FRAG
  
      push @m,
  q{	$(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
  			  : ($GCC ? '-ru $@ $(OBJECT)'
  			          : '-out:$@ $(OBJECT)')).q{
  	$(CHMOD) $(PERM_RWX) $@
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
  };
  
      # Old mechanism - still available:
      push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
  MAKE_FRAG
  
      join('', @m);
  }
  
  
  =item dynamic_lib
  
  Complicated stuff for Win32 that I don't understand. :(
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      return '' unless $self->needs_linking(); #might be because of a subdir
  
      return '' unless $self->has_link_code;
  
      my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
      my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
      my($ldfrom) = '$(LDFROM)';
      my(@m);
  
      push(@m,'
  # This section creates the dynamically loadable $(INST_DYNAMIC)
  # from $(OBJECT) and possibly $(MYEXTLIB).
  OTHERLDFLAGS = '.$otherldflags.'
  INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  
  $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVEDEP) $(INST_DYNAMIC_DEP)
  ');
      if ($GCC) {
        push(@m,
         q{	}.$DLLTOOL.q{ --def $(EXPORT_LIST) --output-exp dll.exp
  	$(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) dll.exp
  	}.$DLLTOOL.q{ --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
  	$(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) dll.exp });
      } elsif ($BORLAND) {
        push(@m,
         q{	$(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
         .($self->is_make_type('dmake')
                  ? q{"$(PERL_ARCHIVE:s,/,\,)" $(LDLOADLIBS:s,/,\,) }
  		 .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
  		: q{"$(subst /,\,$(PERL_ARCHIVE))" $(subst /,\,$(LDLOADLIBS)) }
  		 .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
         .q{,$(RESFILES)});
      } else {	# VC
        push(@m,
         q{	$(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
        .q{$(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:$(EXPORT_LIST)});
  
        # Embed the manifest file if it exists
        push(@m, q{
  	if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
  	if exist $@.manifest del $@.manifest});
      }
      push @m, '
  	$(CHMOD) $(PERM_RWX) $@
  ';
  
      join('',@m);
  }
  
  =item extra_clean_files
  
  Clean out some extra dll.{base,exp} files which might be generated by
  gcc.  Otherwise, take out all *.pdb files.
  
  =cut
  
  sub extra_clean_files {
      my $self = shift;
  
      return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
  }
  
  =item init_linker
  
  =cut
  
  sub init_linker {
      my $self = shift;
  
      $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
      $self->{PERL_ARCHIVEDEP}    = "\$(PERL_INCDEP)\\$Config{libperl}";
      $self->{PERL_ARCHIVE_AFTER} = '';
      $self->{EXPORT_LIST}        = '$(BASEEXT).def';
  }
  
  
  =item perl_script
  
  Checks for the perl program under several common perl extensions.
  
  =cut
  
  sub perl_script {
      my($self,$file) = @_;
      return $file if -r $file && -f _;
      return "$file.pl"  if -r "$file.pl" && -f _;
      return "$file.plx" if -r "$file.plx" && -f _;
      return "$file.bat" if -r "$file.bat" && -f _;
      return;
  }
  
  sub can_dep_space {
      my $self = shift;
      1; # with Win32::GetShortPathName
  }
  
  =item quote_dep
  
  =cut
  
  sub quote_dep {
      my ($self, $arg) = @_;
      if ($arg =~ / / and not $self->is_make_type('gmake')) {
          require Win32;
          $arg = Win32::GetShortPathName($arg);
          die <<EOF if not defined $arg or $arg =~ / /;
  Tried to use make dependency with space for non-GNU make:
    '$arg'
  Fallback to short pathname failed.
  EOF
          return $arg;
      }
      return $self->SUPER::quote_dep($arg);
  }
  
  =item xs_o
  
  This target is stubbed out.  Not sure why.
  
  =cut
  
  sub xs_o {
      return ''
  }
  
  
  =item pasthru
  
  All we send is -nologo to nmake to prevent it from printing its damned
  banner.
  
  =cut
  
  sub pasthru {
      my($self) = shift;
      return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : "");
  }
  
  
  =item arch_check (override)
  
  Normalize all arguments for consistency of comparison.
  
  =cut
  
  sub arch_check {
      my $self = shift;
  
      # Win32 is an XS module, minperl won't have it.
      # arch_check() is not critical, so just fake it.
      return 1 unless $self->can_load_xs;
      return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_);
  }
  
  sub _normalize_path_name {
      my $self = shift;
      my $file = shift;
  
      require Win32;
      my $short = Win32::GetShortPathName($file);
      return defined $short ? lc $short : lc $file;
  }
  
  
  =item oneliner
  
  These are based on what command.com does on Win98.  They may be wrong
  for other Windows shells, I don't know.
  
  =cut
  
  sub oneliner {
      my($self, $cmd, $switches) = @_;
      $switches = [] unless defined $switches;
  
      # Strip leading and trailing newlines
      $cmd =~ s{^\n+}{};
      $cmd =~ s{\n+$}{};
  
      $cmd = $self->quote_literal($cmd);
      $cmd = $self->escape_newlines($cmd);
  
      $switches = join ' ', @$switches;
  
      return qq{\$(ABSPERLRUN) $switches -e $cmd --};
  }
  
  
  sub quote_literal {
      my($self, $text, $opts) = @_;
      $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
  
      # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP
  
      # Apply the Microsoft C/C++ parsing rules
      $text =~ s{\\\\"}{\\\\\\\\\\"}g;  # \\" -> \\\\\"
      $text =~ s{(?<!\\)\\"}{\\\\\\"}g; # \"  -> \\\"
      $text =~ s{(?<!\\)"}{\\"}g;       # "   -> \"
      $text = qq{"$text"} if $text =~ /[ \t]/;
  
      # Apply the Command Prompt parsing rules (cmd.exe)
      my @text = split /("[^"]*")/, $text;
      # We should also escape parentheses, but it breaks one-liners containing
      # $(MACRO)s in makefiles.
      s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text;
      $text = join('', @text);
  
      # dmake expands {{ to { and }} to }.
      if( $self->is_make_type('dmake') ) {
          $text =~ s/{/{{/g;
          $text =~ s/}/}}/g;
      }
  
      $text = $opts->{allow_variables}
        ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
  
      return $text;
  }
  
  
  sub escape_newlines {
      my($self, $text) = @_;
  
      # Escape newlines
      $text =~ s{\n}{\\\n}g;
  
      return $text;
  }
  
  
  =item cd
  
  dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
  wants:
  
      cd dir1\dir2
      command
      another_command
      cd ..\..
  
  =cut
  
  sub cd {
      my($self, $dir, @cmds) = @_;
  
      return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
  
      my $cmd = join "\n\t", map "$_", @cmds;
  
      my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
  
      # No leading tab and no trailing newline makes for easier embedding.
      my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
  cd %s
  	%s
  	cd %s
  MAKE_FRAG
  
      chomp $make_frag;
  
      return $make_frag;
  }
  
  
  =item max_exec_len
  
  nmake 1.50 limits command length to 2048 characters.
  
  =cut
  
  sub max_exec_len {
      my $self = shift;
  
      return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
  }
  
  
  =item os_flavor
  
  Windows is Win32.
  
  =cut
  
  sub os_flavor {
      return('Win32');
  }
  
  
  =item cflags
  
  Defines the PERLDLL symbol if we are configured for static building since all
  code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
  defined.
  
  =cut
  
  sub cflags {
      my($self,$libperl)=@_;
      return $self->{CFLAGS} if $self->{CFLAGS};
      return '' unless $self->needs_linking();
  
      my $base = $self->SUPER::cflags($libperl);
      foreach (split /\n/, $base) {
          /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
      };
      $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
  
      return $self->{CFLAGS} = qq{
  CCFLAGS = $self->{CCFLAGS}
  OPTIMIZE = $self->{OPTIMIZE}
  PERLTYPE = $self->{PERLTYPE}
  };
  
  }
  
  1;
  __END__
  
  =back
EXTUTILS_MM_WIN32

$fatpacked{"ExtUtils/MM_Win95.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MM_WIN95';
  package ExtUtils::MM_Win95;
  
  use strict;
  
  our $VERSION = '7.04';
  
  require ExtUtils::MM_Win32;
  our @ISA = qw(ExtUtils::MM_Win32);
  
  use ExtUtils::MakeMaker::Config;
  
  
  =head1 NAME
  
  ExtUtils::MM_Win95 - method to customize MakeMaker for Win9X
  
  =head1 SYNOPSIS
  
    You should not be using this module directly.
  
  =head1 DESCRIPTION
  
  This is a subclass of ExtUtils::MM_Win32 containing changes necessary
  to get MakeMaker playing nice with command.com and other Win9Xisms.
  
  =head2 Overridden methods
  
  Most of these make up for limitations in the Win9x/nmake command shell.
  Mostly its lack of &&.
  
  =over 4
  
  
  =item xs_c
  
  The && problem.
  
  =cut
  
  sub xs_c {
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs.c:
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c
  	'
  }
  
  
  =item xs_cpp
  
  The && problem
  
  =cut
  
  sub xs_cpp {
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs.cpp:
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp
  	';
  }
  
  =item xs_o
  
  The && problem.
  
  =cut
  
  sub xs_o {
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs$(OBJ_EXT):
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c
  	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
  	';
  }
  
  
  =item max_exec_len
  
  Win98 chokes on things like Encode if we set the max length to nmake's max
  of 2K.  So we go for a more conservative value of 1K.
  
  =cut
  
  sub max_exec_len {
      my $self = shift;
  
      return $self->{_MAX_EXEC_LEN} ||= 1024;
  }
  
  
  =item os_flavor
  
  Win95 and Win98 and WinME are collectively Win9x and Win32
  
  =cut
  
  sub os_flavor {
      my $self = shift;
      return ($self->SUPER::os_flavor, 'Win9x');
  }
  
  
  =back
  
  
  =head1 AUTHOR
  
  Code originally inside MM_Win32.  Original author unknown.
  
  Currently maintained by Michael G Schwern C<schwern@pobox.com>.
  
  Send patches and ideas to C<makemaker@perl.org>.
  
  See https://metacpan.org/release/ExtUtils-MakeMaker.
  
  =cut
  
  
  1;
EXTUTILS_MM_WIN95

$fatpacked{"ExtUtils/MY.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MY';
  package ExtUtils::MY;
  
  use strict;
  require ExtUtils::MM;
  
  our $VERSION = '7.04';
  our @ISA = qw(ExtUtils::MM);
  
  {
      package MY;
      our @ISA = qw(ExtUtils::MY);
  }
  
  sub DESTROY {}
  
  
  =head1 NAME
  
  ExtUtils::MY - ExtUtils::MakeMaker subclass for customization
  
  =head1 SYNOPSIS
  
    # in your Makefile.PL
    sub MY::whatever {
        ...
    }
  
  =head1 DESCRIPTION
  
  B<FOR INTERNAL USE ONLY>
  
  ExtUtils::MY is a subclass of ExtUtils::MM.  Its provided in your
  Makefile.PL for you to add and override MakeMaker functionality.
  
  It also provides a convenient alias via the MY class.
  
  ExtUtils::MY might turn out to be a temporary solution, but MY won't
  go away.
  
  =cut
EXTUTILS_MY

$fatpacked{"ExtUtils/MakeMaker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER';
  # $Id$
  package ExtUtils::MakeMaker;
  
  use strict;
  
  BEGIN {require 5.006;}
  
  require Exporter;
  use ExtUtils::MakeMaker::Config;
  use ExtUtils::MakeMaker::version; # ensure we always have our fake version.pm
  use Carp;
  use File::Path;
  my $CAN_DECODE = eval { require ExtUtils::MakeMaker::Locale; }; # 2 birds, 1 stone
  eval { ExtUtils::MakeMaker::Locale::reinit('UTF-8') }
    if $CAN_DECODE and $ExtUtils::MakeMaker::Locale::ENCODING_LOCALE eq 'US-ASCII';
  
  our $Verbose = 0;       # exported
  our @Parent;            # needs to be localized
  our @Get_from_Config;   # referenced by MM_Unix
  our @MM_Sections;
  our @Overridable;
  my @Prepend_parent;
  my %Recognized_Att_Keys;
  our %macro_fsentity; # whether a macro is a filesystem name
  our %macro_dep; # whether a macro is a dependency
  
  our $VERSION = '7.04';
  $VERSION = eval $VERSION;  ## no critic [BuiltinFunctions::ProhibitStringyEval]
  
  # Emulate something resembling CVS $Revision$
  (our $Revision = $VERSION) =~ s{_}{};
  $Revision = int $Revision * 10000;
  
  our $Filename = __FILE__;   # referenced outside MakeMaker
  
  our @ISA = qw(Exporter);
  our @EXPORT    = qw(&WriteMakefile $Verbose &prompt);
  our @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists
                      &WriteEmptyMakefile);
  
  # These will go away once the last of the Win32 & VMS specific code is
  # purged.
  my $Is_VMS     = $^O eq 'VMS';
  my $Is_Win32   = $^O eq 'MSWin32';
  my $UNDER_CORE = $ENV{PERL_CORE};
  
  full_setup();
  
  require ExtUtils::MM;  # Things like CPAN assume loading ExtUtils::MakeMaker
                         # will give them MM.
  
  require ExtUtils::MY;  # XXX pre-5.8 versions of ExtUtils::Embed expect
                         # loading ExtUtils::MakeMaker will give them MY.
                         # This will go when Embed is its own CPAN module.
  
  
  sub WriteMakefile {
      croak "WriteMakefile: Need even number of args" if @_ % 2;
  
      require ExtUtils::MY;
      my %att = @_;
  
      _convert_compat_attrs(\%att);
  
      _verify_att(\%att);
  
      my $mm = MM->new(\%att);
      $mm->flush;
  
      return $mm;
  }
  
  
  # Basic signatures of the attributes WriteMakefile takes.  Each is the
  # reference type.  Empty value indicate it takes a non-reference
  # scalar.
  my %Att_Sigs;
  my %Special_Sigs = (
   AUTHOR             => 'ARRAY',
   C                  => 'ARRAY',
   CONFIG             => 'ARRAY',
   CONFIGURE          => 'CODE',
   DIR                => 'ARRAY',
   DL_FUNCS           => 'HASH',
   DL_VARS            => 'ARRAY',
   EXCLUDE_EXT        => 'ARRAY',
   EXE_FILES          => 'ARRAY',
   FUNCLIST           => 'ARRAY',
   H                  => 'ARRAY',
   IMPORTS            => 'HASH',
   INCLUDE_EXT        => 'ARRAY',
   LIBS               => ['ARRAY',''],
   MAN1PODS           => 'HASH',
   MAN3PODS           => 'HASH',
   META_ADD           => 'HASH',
   META_MERGE         => 'HASH',
   OBJECT             => ['ARRAY', ''],
   PL_FILES           => 'HASH',
   PM                 => 'HASH',
   PMLIBDIRS          => 'ARRAY',
   PMLIBPARENTDIRS    => 'ARRAY',
   PREREQ_PM          => 'HASH',
   BUILD_REQUIRES     => 'HASH',
   CONFIGURE_REQUIRES => 'HASH',
   TEST_REQUIRES      => 'HASH',
   SKIP               => 'ARRAY',
   TYPEMAPS           => 'ARRAY',
   XS                 => 'HASH',
   VERSION            => ['version',''],
   _KEEP_AFTER_FLUSH  => '',
  
   clean      => 'HASH',
   depend     => 'HASH',
   dist       => 'HASH',
   dynamic_lib=> 'HASH',
   linkext    => 'HASH',
   macro      => 'HASH',
   postamble  => 'HASH',
   realclean  => 'HASH',
   test       => 'HASH',
   tool_autosplit => 'HASH',
  );
  
  @Att_Sigs{keys %Recognized_Att_Keys} = ('') x keys %Recognized_Att_Keys;
  @Att_Sigs{keys %Special_Sigs} = values %Special_Sigs;
  
  sub _convert_compat_attrs { #result of running several times should be same
      my($att) = @_;
      if (exists $att->{AUTHOR}) {
          if ($att->{AUTHOR}) {
              if (!ref($att->{AUTHOR})) {
                  my $t = $att->{AUTHOR};
                  $att->{AUTHOR} = [$t];
              }
          } else {
                  $att->{AUTHOR} = [];
          }
      }
  }
  
  sub _verify_att {
      my($att) = @_;
  
      while( my($key, $val) = each %$att ) {
          my $sig = $Att_Sigs{$key};
          unless( defined $sig ) {
              warn "WARNING: $key is not a known parameter.\n";
              next;
          }
  
          my @sigs   = ref $sig ? @$sig : $sig;
          my $given  = ref $val;
          unless( grep { _is_of_type($val, $_) } @sigs ) {
              my $takes = join " or ", map { _format_att($_) } @sigs;
  
              my $has = _format_att($given);
              warn "WARNING: $key takes a $takes not a $has.\n".
                   "         Please inform the author.\n";
          }
      }
  }
  
  
  # Check if a given thing is a reference or instance of $type
  sub _is_of_type {
      my($thing, $type) = @_;
  
      return 1 if ref $thing eq $type;
  
      local $SIG{__DIE__};
      return 1 if eval{ $thing->isa($type) };
  
      return 0;
  }
  
  
  sub _format_att {
      my $given = shift;
  
      return $given eq ''        ? "string/number"
           : uc $given eq $given ? "$given reference"
           :                       "$given object"
           ;
  }
  
  
  sub prompt ($;$) {  ## no critic
      my($mess, $def) = @_;
      confess("prompt function called without an argument")
          unless defined $mess;
  
      my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
  
      my $dispdef = defined $def ? "[$def] " : " ";
      $def = defined $def ? $def : "";
  
      local $|=1;
      local $\;
      print "$mess $dispdef";
  
      my $ans;
      if ($ENV{PERL_MM_USE_DEFAULT} || (!$isa_tty && eof STDIN)) {
          print "$def\n";
      }
      else {
          $ans = <STDIN>;
          if( defined $ans ) {
              $ans =~ s{\015?\012$}{};
          }
          else { # user hit ctrl-D
              print "\n";
          }
      }
  
      return (!defined $ans || $ans eq '') ? $def : $ans;
  }
  
  sub eval_in_subdirs {
      my($self) = @_;
      use Cwd qw(cwd abs_path);
      my $pwd = cwd() || die "Can't figure out your cwd!";
  
      local @INC = map eval {abs_path($_) if -e} || $_, @INC;
      push @INC, '.';     # '.' has to always be at the end of @INC
  
      foreach my $dir (@{$self->{DIR}}){
          my($abs) = $self->catdir($pwd,$dir);
          eval { $self->eval_in_x($abs); };
          last if $@;
      }
      chdir $pwd;
      die $@ if $@;
  }
  
  sub eval_in_x {
      my($self,$dir) = @_;
      chdir $dir or carp("Couldn't change to directory $dir: $!");
  
      {
          package main;
          do './Makefile.PL';
      };
      if ($@) {
  #         if ($@ =~ /prerequisites/) {
  #             die "MakeMaker WARNING: $@";
  #         } else {
  #             warn "WARNING from evaluation of $dir/Makefile.PL: $@";
  #         }
          die "ERROR from evaluation of $dir/Makefile.PL: $@";
      }
  }
  
  
  # package name for the classes into which the first object will be blessed
  my $PACKNAME = 'PACK000';
  
  sub full_setup {
      $Verbose ||= 0;
  
      my @dep_macros = qw/
      PERL_INCDEP        PERL_ARCHLIBDEP     PERL_ARCHIVEDEP
      /;
  
      my @fs_macros = qw/
      FULLPERL XSUBPPDIR
  
      INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB INST_MAN1DIR INST_MAN3DIR
      INSTALLDIRS
      DESTDIR PREFIX INSTALL_BASE
      PERLPREFIX      SITEPREFIX      VENDORPREFIX
      INSTALLPRIVLIB  INSTALLSITELIB  INSTALLVENDORLIB
      INSTALLARCHLIB  INSTALLSITEARCH INSTALLVENDORARCH
      INSTALLBIN      INSTALLSITEBIN  INSTALLVENDORBIN
      INSTALLMAN1DIR          INSTALLMAN3DIR
      INSTALLSITEMAN1DIR      INSTALLSITEMAN3DIR
      INSTALLVENDORMAN1DIR    INSTALLVENDORMAN3DIR
      INSTALLSCRIPT   INSTALLSITESCRIPT  INSTALLVENDORSCRIPT
      PERL_LIB        PERL_ARCHLIB
      SITELIBEXP      SITEARCHEXP
  
      MAKE LIBPERL_A LIB PERL_SRC PERL_INC
      PPM_INSTALL_EXEC PPM_UNINSTALL_EXEC
      PPM_INSTALL_SCRIPT PPM_UNINSTALL_SCRIPT
      /;
  
      my @attrib_help = qw/
  
      AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION
      C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DISTVNAME
      DL_FUNCS DL_VARS
      EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE
      FULLPERLRUN FULLPERLRUNINST
      FUNCLIST H IMPORTS
  
      INC INCLUDE_EXT LDFROM LIBS LICENSE
      LINKTYPE MAKEAPERL MAKEFILE MAKEFILE_OLD MAN1PODS MAN3PODS MAP_TARGET
      META_ADD META_MERGE MIN_PERL_VERSION BUILD_REQUIRES CONFIGURE_REQUIRES
      MYEXTLIB NAME NEEDS_LINKING NOECHO NO_META NO_MYMETA NO_PACKLIST NO_PERLLOCAL
      NORECURS NO_VC OBJECT OPTIMIZE PERL_MALLOC_OK PERL PERLMAINCC PERLRUN
      PERLRUNINST PERL_CORE
      PERM_DIR PERM_RW PERM_RWX MAGICXS
      PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE
      PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
      SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS XSOPT XSPROTOARG
      XS_VERSION clean depend dist dynamic_lib linkext macro realclean
      tool_autosplit
  
      MAN1EXT MAN3EXT
  
      MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC
      MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED
          /;
      push @attrib_help, @fs_macros;
      @macro_fsentity{@fs_macros, @dep_macros} = (1) x (@fs_macros+@dep_macros);
      @macro_dep{@dep_macros} = (1) x @dep_macros;
  
      # IMPORTS is used under OS/2 and Win32
  
      # @Overridable is close to @MM_Sections but not identical.  The
      # order is important. Many subroutines declare macros. These
      # depend on each other. Let's try to collect the macros up front,
      # then pasthru, then the rules.
  
      # MM_Sections are the sections we have to call explicitly
      # in Overridable we have subroutines that are used indirectly
  
  
      @MM_Sections =
          qw(
  
   post_initialize const_config constants platform_constants
   tool_autosplit tool_xsubpp tools_other
  
   makemakerdflt
  
   dist macro depend cflags const_loadlibs const_cccmd
   post_constants
  
   pasthru
  
   special_targets
   c_o xs_c xs_o
   top_targets blibdirs linkext dlsyms dynamic_bs dynamic
   dynamic_lib static static_lib manifypods processPL
   installbin subdirs
   clean_subdirs clean realclean_subdirs realclean
   metafile signature
   dist_basics dist_core distdir dist_test dist_ci distmeta distsignature
   install force perldepend makefile staticmake test ppd
  
            ); # loses section ordering
  
      @Overridable = @MM_Sections;
      push @Overridable, qw[
  
   libscan makeaperl needs_linking
   subdir_x test_via_harness test_via_script
  
   init_VERSION init_dist init_INST init_INSTALL init_DEST init_dirscan
   init_PM init_MANPODS init_xs init_PERL init_DIRFILESEP init_linker
                           ];
  
      push @MM_Sections, qw[
  
   pm_to_blib selfdocument
  
                           ];
  
      # Postamble needs to be the last that was always the case
      push @MM_Sections, "postamble";
      push @Overridable, "postamble";
  
      # All sections are valid keys.
      @Recognized_Att_Keys{@MM_Sections} = (1) x @MM_Sections;
  
      # we will use all these variables in the Makefile
      @Get_from_Config =
          qw(
             ar cc cccdlflags ccdlflags dlext dlsrc exe_ext full_ar ld
             lddlflags ldflags libc lib_ext obj_ext osname osvers ranlib
             sitelibexp sitearchexp so
            );
  
      # 5.5.3 doesn't have any concept of vendor libs
      push @Get_from_Config, qw( vendorarchexp vendorlibexp ) if $] >= 5.006;
  
      foreach my $item (@attrib_help){
          $Recognized_Att_Keys{$item} = 1;
      }
      foreach my $item (@Get_from_Config) {
          $Recognized_Att_Keys{uc $item} = $Config{$item};
          print "Attribute '\U$item\E' => '$Config{$item}'\n"
              if ($Verbose >= 2);
      }
  
      #
      # When we eval a Makefile.PL in a subdirectory, that one will ask
      # us (the parent) for the values and will prepend "..", so that
      # all files to be installed end up below OUR ./blib
      #
      @Prepend_parent = qw(
             INST_BIN INST_LIB INST_ARCHLIB INST_SCRIPT
             MAP_TARGET INST_MAN1DIR INST_MAN3DIR PERL_SRC
             PERL FULLPERL
      );
  }
  
  sub new {
      my($class,$self) = @_;
      my($key);
  
      _convert_compat_attrs($self) if defined $self && $self;
  
      # Store the original args passed to WriteMakefile()
      foreach my $k (keys %$self) {
          $self->{ARGS}{$k} = $self->{$k};
      }
  
      $self = {} unless defined $self;
  
      # Temporarily bless it into MM so it can be used as an
      # object.  It will be blessed into a temp package later.
      bless $self, "MM";
  
      # Cleanup all the module requirement bits
      for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) {
          $self->{$key}      ||= {};
          $self->clean_versions( $key );
      }
  
  
      if ("@ARGV" =~ /\bPREREQ_PRINT\b/) {
          $self->_PREREQ_PRINT;
      }
  
      # PRINT_PREREQ is RedHatism.
      if ("@ARGV" =~ /\bPRINT_PREREQ\b/) {
          $self->_PRINT_PREREQ;
     }
  
      print "MakeMaker (v$VERSION)\n" if $Verbose;
      if (-f "MANIFEST" && ! -f "Makefile" && ! $ENV{PERL_CORE}){
          check_manifest();
      }
  
      check_hints($self);
  
      if ( defined $self->{MIN_PERL_VERSION}
            && $self->{MIN_PERL_VERSION} !~ /^v?[\d_\.]+$/ ) {
        require version;
        my $normal = eval {
          local $SIG{__WARN__} = sub {
              # simulate "use warnings FATAL => 'all'" for vintage perls
              die @_;
          };
          version->new( $self->{MIN_PERL_VERSION} )
        };
        $self->{MIN_PERL_VERSION} = $normal if defined $normal && !$@;
      }
  
      # Translate X.Y.Z to X.00Y00Z
      if( defined $self->{MIN_PERL_VERSION} ) {
          $self->{MIN_PERL_VERSION} =~ s{ ^v? (\d+) \. (\d+) \. (\d+) $ }
                                        {sprintf "%d.%03d%03d", $1, $2, $3}ex;
      }
  
      my $perl_version_ok = eval {
          local $SIG{__WARN__} = sub {
              # simulate "use warnings FATAL => 'all'" for vintage perls
              die @_;
          };
          !$self->{MIN_PERL_VERSION} or $self->{MIN_PERL_VERSION} <= $]
      };
      if (!$perl_version_ok) {
          if (!defined $perl_version_ok) {
              die <<'END';
  Warning: MIN_PERL_VERSION is not in a recognized format.
  Recommended is a quoted numerical value like '5.005' or '5.008001'.
  END
          }
          elsif ($self->{PREREQ_FATAL}) {
              die sprintf <<"END", $self->{MIN_PERL_VERSION}, $];
  MakeMaker FATAL: perl version too low for this distribution.
  Required is %s. We run %s.
  END
          }
          else {
              warn sprintf
                  "Warning: Perl version %s or higher required. We run %s.\n",
                  $self->{MIN_PERL_VERSION}, $];
          }
      }
  
      my %configure_att;         # record &{$self->{CONFIGURE}} attributes
      my(%initial_att) = %$self; # record initial attributes
  
      my(%unsatisfied) = ();
      my $prereqs = $self->_all_prereqs;
      foreach my $prereq (sort keys %$prereqs) {
          my $required_version = $prereqs->{$prereq};
  
          my $pr_version = 0;
          my $installed_file;
  
          if ( $prereq eq 'perl' ) {
            if ( defined $required_version && $required_version =~ /^v?[\d_\.]+$/
                 || $required_version !~ /^v?[\d_\.]+$/ ) {
              require version;
              my $normal = eval { version->new( $required_version ) };
              $required_version = $normal if defined $normal;
            }
            $installed_file = $prereq;
            $pr_version = $];
          }
          else {
            $installed_file = MM->_installed_file_for_module($prereq);
            $pr_version = MM->parse_version($installed_file) if $installed_file;
            $pr_version = 0 if $pr_version eq 'undef';
          }
  
          # convert X.Y_Z alpha version #s to X.YZ for easier comparisons
          $pr_version =~ s/(\d+)\.(\d+)_(\d+)/$1.$2$3/;
  
          if (!$installed_file) {
              warn sprintf "Warning: prerequisite %s %s not found.\n",
                $prereq, $required_version
                     unless $self->{PREREQ_FATAL}
                         or $ENV{PERL_CORE};
  
              $unsatisfied{$prereq} = 'not installed';
          }
          elsif ($pr_version < $required_version ){
              warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n",
                $prereq, $required_version, ($pr_version || 'unknown version')
                    unless $self->{PREREQ_FATAL}
                         or $ENV{PERL_CORE};
  
              $unsatisfied{$prereq} = $required_version ? $required_version : 'unknown version' ;
          }
      }
  
      if (%unsatisfied && $self->{PREREQ_FATAL}){
          my $failedprereqs = join "\n", map {"    $_ $unsatisfied{$_}"}
                              sort { $a cmp $b } keys %unsatisfied;
          die <<"END";
  MakeMaker FATAL: prerequisites not found.
  $failedprereqs
  
  Please install these modules first and rerun 'perl Makefile.PL'.
  END
      }
  
      if (defined $self->{CONFIGURE}) {
          if (ref $self->{CONFIGURE} eq 'CODE') {
              %configure_att = %{&{$self->{CONFIGURE}}};
              _convert_compat_attrs(\%configure_att);
              $self = { %$self, %configure_att };
          } else {
              croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n";
          }
      }
  
      # This is for old Makefiles written pre 5.00, will go away
      if ( Carp::longmess("") =~ /runsubdirpl/s ){
          carp("WARNING: Please rerun 'perl Makefile.PL' to regenerate your Makefiles\n");
      }
  
      my $newclass = ++$PACKNAME;
      local @Parent = @Parent;    # Protect against non-local exits
      {
          print "Blessing Object into class [$newclass]\n" if $Verbose>=2;
          mv_all_methods("MY",$newclass);
          bless $self, $newclass;
          push @Parent, $self;
          require ExtUtils::MY;
  
          no strict 'refs';   ## no critic;
          @{"$newclass\:\:ISA"} = 'MM';
      }
  
      if (defined $Parent[-2]){
          $self->{PARENT} = $Parent[-2];
          for my $key (@Prepend_parent) {
              next unless defined $self->{PARENT}{$key};
  
              # Don't stomp on WriteMakefile() args.
              next if defined $self->{ARGS}{$key} and
                      $self->{ARGS}{$key} eq $self->{$key};
  
              $self->{$key} = $self->{PARENT}{$key};
  
              if ($Is_VMS && $key =~ /PERL$/) {
                  # PERL or FULLPERL will be a command verb or even a
                  # command with an argument instead of a full file
                  # specification under VMS.  So, don't turn the command
                  # into a filespec, but do add a level to the path of
                  # the argument if not already absolute.
                  my @cmd = split /\s+/, $self->{$key};
                  $cmd[1] = $self->catfile('[-]',$cmd[1])
                    unless (@cmd < 2) || $self->file_name_is_absolute($cmd[1]);
                  $self->{$key} = join(' ', @cmd);
              } else {
                  my $value = $self->{$key};
                  # not going to test in FS so only stripping start
                  $value =~ s/^"// if $key =~ /PERL$/;
                  $value = $self->catdir("..", $value)
                    unless $self->file_name_is_absolute($value);
                  $value = qq{"$value} if $key =~ /PERL$/;
                  $self->{$key} = $value;
              }
          }
          if ($self->{PARENT}) {
              $self->{PARENT}->{CHILDREN}->{$newclass} = $self;
              foreach my $opt (qw(POLLUTE PERL_CORE LINKTYPE LD OPTIMIZE)) {
                  if (exists $self->{PARENT}->{$opt}
                      and not exists $self->{$opt})
                      {
                          # inherit, but only if already unspecified
                          $self->{$opt} = $self->{PARENT}->{$opt};
                      }
              }
          }
          my @fm = grep /^FIRST_MAKEFILE=/, @ARGV;
          parse_args($self,@fm) if @fm;
      }
      else {
          parse_args($self, _shellwords($ENV{PERL_MM_OPT} || ''),@ARGV);
      }
  
      # RT#91540 PREREQ_FATAL not recognized on command line
      if (%unsatisfied && $self->{PREREQ_FATAL}){
          my $failedprereqs = join "\n", map {"    $_ $unsatisfied{$_}"}
                              sort { $a cmp $b } keys %unsatisfied;
          die <<"END";
  MakeMaker FATAL: prerequisites not found.
  $failedprereqs
  
  Please install these modules first and rerun 'perl Makefile.PL'.
  END
      }
  
      $self->{NAME} ||= $self->guess_name;
  
      warn "Warning: NAME must be a package name\n"
        unless $self->{NAME} =~ m!^[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*$!;
  
      ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g;
  
      $self->init_MAKE;
      $self->init_main;
      $self->init_VERSION;
      $self->init_dist;
      $self->init_INST;
      $self->init_INSTALL;
      $self->init_DEST;
      $self->init_dirscan;
      $self->init_PM;
      $self->init_MANPODS;
      $self->init_xs;
      $self->init_PERL;
      $self->init_DIRFILESEP;
      $self->init_linker;
      $self->init_ABSTRACT;
  
      $self->arch_check(
          $INC{'Config.pm'},
          $self->catfile($Config{'archlibexp'}, "Config.pm")
      );
  
      $self->init_tools();
      $self->init_others();
      $self->init_platform();
      $self->init_PERM();
      my($argv) = neatvalue(\@ARGV);
      $argv =~ s/^\[/(/;
      $argv =~ s/\]$/)/;
  
      push @{$self->{RESULT}}, <<END;
  # This Makefile is for the $self->{NAME} extension to perl.
  #
  # It was generated automatically by MakeMaker version
  # $VERSION (Revision: $Revision) from the contents of
  # Makefile.PL. Don't edit this file, edit Makefile.PL instead.
  #
  #       ANY CHANGES MADE HERE WILL BE LOST!
  #
  #   MakeMaker ARGV: $argv
  #
  END
  
      push @{$self->{RESULT}}, $self->_MakeMaker_Parameters_section(\%initial_att);
  
      if (defined $self->{CONFIGURE}) {
         push @{$self->{RESULT}}, <<END;
  
  #   MakeMaker 'CONFIGURE' Parameters:
  END
          if (scalar(keys %configure_att) > 0) {
              foreach my $key (sort keys %configure_att){
                 next if $key eq 'ARGS';
                 my($v) = neatvalue($configure_att{$key});
                 $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
                 $v =~ tr/\n/ /s;
                 push @{$self->{RESULT}}, "#     $key => $v";
              }
          }
          else
          {
             push @{$self->{RESULT}}, "# no values returned";
          }
          undef %configure_att;  # free memory
      }
  
      # turn the SKIP array into a SKIPHASH hash
      for my $skip (@{$self->{SKIP} || []}) {
          $self->{SKIPHASH}{$skip} = 1;
      }
      delete $self->{SKIP}; # free memory
  
      if ($self->{PARENT}) {
          for (qw/install dist dist_basics dist_core distdir dist_test dist_ci/) {
              $self->{SKIPHASH}{$_} = 1;
          }
      }
  
      # We run all the subdirectories now. They don't have much to query
      # from the parent, but the parent has to query them: if they need linking!
      unless ($self->{NORECURS}) {
          $self->eval_in_subdirs if @{$self->{DIR}};
      }
  
      foreach my $section ( @MM_Sections ){
          # Support for new foo_target() methods.
          my $method = $section;
          $method .= '_target' unless $self->can($method);
  
          print "Processing Makefile '$section' section\n" if ($Verbose >= 2);
          my($skipit) = $self->skipcheck($section);
          if ($skipit){
              push @{$self->{RESULT}}, "\n# --- MakeMaker $section section $skipit.";
          } else {
              my(%a) = %{$self->{$section} || {}};
              push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:";
              push @{$self->{RESULT}}, "# " . join ", ", %a if $Verbose && %a;
              push @{$self->{RESULT}}, $self->maketext_filter(
                  $self->$method( %a )
              );
          }
      }
  
      push @{$self->{RESULT}}, "\n# End.";
  
      $self;
  }
  
  sub WriteEmptyMakefile {
      croak "WriteEmptyMakefile: Need an even number of args" if @_ % 2;
  
      my %att = @_;
      my $self = MM->new(\%att);
  
      my $new = $self->{MAKEFILE};
      my $old = $self->{MAKEFILE_OLD};
      if (-f $old) {
          _unlink($old) or warn "unlink $old: $!";
      }
      if ( -f $new ) {
          _rename($new, $old) or warn "rename $new => $old: $!"
      }
      open my $mfh, '>', $new or die "open $new for write: $!";
      print $mfh <<'EOP';
  all :
  
  clean :
  
  install :
  
  makemakerdflt :
  
  test :
  
  EOP
      close $mfh or die "close $new for write: $!";
  }
  
  
  =begin private
  
  =head3 _installed_file_for_module
  
    my $file = MM->_installed_file_for_module($module);
  
  Return the first installed .pm $file associated with the $module.  The
  one which will show up when you C<use $module>.
  
  $module is something like "strict" or "Test::More".
  
  =end private
  
  =cut
  
  sub _installed_file_for_module {
      my $class  = shift;
      my $prereq = shift;
  
      my $file = "$prereq.pm";
      $file =~ s{::}{/}g;
  
      my $path;
      for my $dir (@INC) {
          my $tmp = File::Spec->catfile($dir, $file);
          if ( -r $tmp ) {
              $path = $tmp;
              last;
          }
      }
  
      return $path;
  }
  
  
  # Extracted from MakeMaker->new so we can test it
  sub _MakeMaker_Parameters_section {
      my $self = shift;
      my $att  = shift;
  
      my @result = <<'END';
  #   MakeMaker Parameters:
  END
  
      foreach my $key (sort keys %$att){
          next if $key eq 'ARGS';
          my $v;
          if ($key eq 'PREREQ_PM') {
              # CPAN.pm takes prereqs from this field in 'Makefile'
              # and does not know about BUILD_REQUIRES
              $v = neatvalue({
                  %{ $att->{PREREQ_PM} || {} },
                  %{ $att->{BUILD_REQUIRES} || {} },
                  %{ $att->{TEST_REQUIRES} || {} },
              });
          } else {
              $v = neatvalue($att->{$key});
          }
  
          $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
          $v =~ tr/\n/ /s;
          push @result, "#     $key => $v";
      }
  
      return @result;
  }
  
  # _shellwords and _parseline borrowed from Text::ParseWords
  sub _shellwords {
      my (@lines) = @_;
      my @allwords;
  
      foreach my $line (@lines) {
        $line =~ s/^\s+//;
        my @words = _parse_line('\s+', 0, $line);
        pop @words if (@words and !defined $words[-1]);
        return() unless (@words || !length($line));
        push(@allwords, @words);
      }
      return(@allwords);
  }
  
  sub _parse_line {
      my($delimiter, $keep, $line) = @_;
      my($word, @pieces);
  
      no warnings 'uninitialized';  # we will be testing undef strings
  
      while (length($line)) {
          # This pattern is optimised to be stack conservative on older perls.
          # Do not refactor without being careful and testing it on very long strings.
          # See Perl bug #42980 for an example of a stack busting input.
          $line =~ s/^
                      (?:
                          # double quoted string
                          (")                             # $quote
                          ((?>[^\\"]*(?:\\.[^\\"]*)*))"   # $quoted
          | # --OR--
                          # singe quoted string
                          (')                             # $quote
                          ((?>[^\\']*(?:\\.[^\\']*)*))'   # $quoted
                      |   # --OR--
                          # unquoted string
              (                               # $unquoted
                              (?:\\.|[^\\"'])*?
                          )
                          # followed by
              (                               # $delim
                              \Z(?!\n)                    # EOL
                          |   # --OR--
                              (?-x:$delimiter)            # delimiter
                          |   # --OR--
                              (?!^)(?=["'])               # a quote
                          )
          )//xs or return;    # extended layout
          my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);
  
  
    return() unless( defined($quote) || length($unquoted) || length($delim));
  
          if ($keep) {
        $quoted = "$quote$quoted$quote";
    }
          else {
        $unquoted =~ s/\\(.)/$1/sg;
        if (defined $quote) {
      $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
      #$quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
              }
    }
          $word .= substr($line, 0, 0); # leave results tainted
          $word .= defined $quote ? $quoted : $unquoted;
  
          if (length($delim)) {
              push(@pieces, $word);
              push(@pieces, $delim) if ($keep eq 'delimiters');
              undef $word;
          }
          if (!length($line)) {
              push(@pieces, $word);
    }
      }
      return(@pieces);
  }
  
  sub check_manifest {
      print "Checking if your kit is complete...\n";
      require ExtUtils::Manifest;
      # avoid warning
      $ExtUtils::Manifest::Quiet = $ExtUtils::Manifest::Quiet = 1;
      my(@missed) = ExtUtils::Manifest::manicheck();
      if (@missed) {
          print "Warning: the following files are missing in your kit:\n";
          print "\t", join "\n\t", @missed;
          print "\n";
          print "Please inform the author.\n";
      } else {
          print "Looks good\n";
      }
  }
  
  sub parse_args{
      my($self, @args) = @_;
      @args = map { Encode::decode(locale => $_) } @args if $CAN_DECODE;
      foreach (@args) {
          unless (m/(.*?)=(.*)/) {
              ++$Verbose if m/^verb/;
              next;
          }
          my($name, $value) = ($1, $2);
          if ($value =~ m/^~(\w+)?/) { # tilde with optional username
              $value =~ s [^~(\w*)]
                  [$1 ?
                   ((getpwnam($1))[7] || "~$1") :
                   (getpwuid($>))[7]
                   ]ex;
          }
  
          # Remember the original args passed it.  It will be useful later.
          $self->{ARGS}{uc $name} = $self->{uc $name} = $value;
      }
  
      # catch old-style 'potential_libs' and inform user how to 'upgrade'
      if (defined $self->{potential_libs}){
          my($msg)="'potential_libs' => '$self->{potential_libs}' should be";
          if ($self->{potential_libs}){
              print "$msg changed to:\n\t'LIBS' => ['$self->{potential_libs}']\n";
          } else {
              print "$msg deleted.\n";
          }
          $self->{LIBS} = [$self->{potential_libs}];
          delete $self->{potential_libs};
      }
      # catch old-style 'ARMAYBE' and inform user how to 'upgrade'
      if (defined $self->{ARMAYBE}){
          my($armaybe) = $self->{ARMAYBE};
          print "ARMAYBE => '$armaybe' should be changed to:\n",
                          "\t'dynamic_lib' => {ARMAYBE => '$armaybe'}\n";
          my(%dl) = %{$self->{dynamic_lib} || {}};
          $self->{dynamic_lib} = { %dl, ARMAYBE => $armaybe};
          delete $self->{ARMAYBE};
      }
      if (defined $self->{LDTARGET}){
          print "LDTARGET should be changed to LDFROM\n";
          $self->{LDFROM} = $self->{LDTARGET};
          delete $self->{LDTARGET};
      }
      # Turn a DIR argument on the command line into an array
      if (defined $self->{DIR} && ref \$self->{DIR} eq 'SCALAR') {
          # So they can choose from the command line, which extensions they want
          # the grep enables them to have some colons too much in case they
          # have to build a list with the shell
          $self->{DIR} = [grep $_, split ":", $self->{DIR}];
      }
      # Turn a INCLUDE_EXT argument on the command line into an array
      if (defined $self->{INCLUDE_EXT} && ref \$self->{INCLUDE_EXT} eq 'SCALAR') {
          $self->{INCLUDE_EXT} = [grep $_, split '\s+', $self->{INCLUDE_EXT}];
      }
      # Turn a EXCLUDE_EXT argument on the command line into an array
      if (defined $self->{EXCLUDE_EXT} && ref \$self->{EXCLUDE_EXT} eq 'SCALAR') {
          $self->{EXCLUDE_EXT} = [grep $_, split '\s+', $self->{EXCLUDE_EXT}];
      }
  
      foreach my $mmkey (sort keys %$self){
          next if $mmkey eq 'ARGS';
          print "  $mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose;
          print "'$mmkey' is not a known MakeMaker parameter name.\n"
              unless exists $Recognized_Att_Keys{$mmkey};
      }
      $| = 1 if $Verbose;
  }
  
  sub check_hints {
      my($self) = @_;
      # We allow extension-specific hints files.
  
      require File::Spec;
      my $curdir = File::Spec->curdir;
  
      my $hint_dir = File::Spec->catdir($curdir, "hints");
      return unless -d $hint_dir;
  
      # First we look for the best hintsfile we have
      my($hint)="${^O}_$Config{osvers}";
      $hint =~ s/\./_/g;
      $hint =~ s/_$//;
      return unless $hint;
  
      # Also try without trailing minor version numbers.
      while (1) {
          last if -f File::Spec->catfile($hint_dir, "$hint.pl");  # found
      } continue {
          last unless $hint =~ s/_[^_]*$//; # nothing to cut off
      }
      my $hint_file = File::Spec->catfile($hint_dir, "$hint.pl");
  
      return unless -f $hint_file;    # really there
  
      _run_hintfile($self, $hint_file);
  }
  
  sub _run_hintfile {
      our $self;
      local($self) = shift;       # make $self available to the hint file.
      my($hint_file) = shift;
  
      local($@, $!);
      warn "Processing hints file $hint_file\n";
  
      # Just in case the ./ isn't on the hint file, which File::Spec can
      # often strip off, we bung the curdir into @INC
      local @INC = (File::Spec->curdir, @INC);
      my $ret = do $hint_file;
      if( !defined $ret ) {
          my $error = $@ || $!;
          warn $error;
      }
  }
  
  sub mv_all_methods {
      my($from,$to) = @_;
  
      # Here you see the *current* list of methods that are overridable
      # from Makefile.PL via MY:: subroutines. As of VERSION 5.07 I'm
      # still trying to reduce the list to some reasonable minimum --
      # because I want to make it easier for the user. A.K.
  
      local $SIG{__WARN__} = sub {
          # can't use 'no warnings redefined', 5.6 only
          warn @_ unless $_[0] =~ /^Subroutine .* redefined/
      };
      foreach my $method (@Overridable) {
  
          # We cannot say "next" here. Nick might call MY->makeaperl
          # which isn't defined right now
  
          # Above statement was written at 4.23 time when Tk-b8 was
          # around. As Tk-b9 only builds with 5.002something and MM 5 is
          # standard, we try to enable the next line again. It was
          # commented out until MM 5.23
  
          next unless defined &{"${from}::$method"};
  
          {
              no strict 'refs';   ## no critic
              *{"${to}::$method"} = \&{"${from}::$method"};
  
              # If we delete a method, then it will be undefined and cannot
              # be called.  But as long as we have Makefile.PLs that rely on
              # %MY:: being intact, we have to fill the hole with an
              # inheriting method:
  
              {
                  package MY;
                  my $super = "SUPER::".$method;
                  *{$method} = sub {
                      shift->$super(@_);
                  };
              }
          }
      }
  
      # We have to clean out %INC also, because the current directory is
      # changed frequently and Graham Barr prefers to get his version
      # out of a History.pl file which is "required" so wouldn't get
      # loaded again in another extension requiring a History.pl
  
      # With perl5.002_01 the deletion of entries in %INC caused Tk-b11
      # to core dump in the middle of a require statement. The required
      # file was Tk/MMutil.pm.  The consequence is, we have to be
      # extremely careful when we try to give perl a reason to reload a
      # library with same name.  The workaround prefers to drop nothing
      # from %INC and teach the writers not to use such libraries.
  
  #    my $inc;
  #    foreach $inc (keys %INC) {
  #       #warn "***$inc*** deleted";
  #       delete $INC{$inc};
  #    }
  }
  
  sub skipcheck {
      my($self) = shift;
      my($section) = @_;
      if ($section eq 'dynamic') {
          print "Warning (non-fatal): Target 'dynamic' depends on targets ",
          "in skipped section 'dynamic_bs'\n"
              if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
          print "Warning (non-fatal): Target 'dynamic' depends on targets ",
          "in skipped section 'dynamic_lib'\n"
              if $self->{SKIPHASH}{dynamic_lib} && $Verbose;
      }
      if ($section eq 'dynamic_lib') {
          print "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on ",
          "targets in skipped section 'dynamic_bs'\n"
              if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
      }
      if ($section eq 'static') {
          print "Warning (non-fatal): Target 'static' depends on targets ",
          "in skipped section 'static_lib'\n"
              if $self->{SKIPHASH}{static_lib} && $Verbose;
      }
      return 'skipped' if $self->{SKIPHASH}{$section};
      return '';
  }
  
  sub flush {
      my $self = shift;
  
      # This needs a bit more work for more wacky OSen
      my $type = 'Unix-style';
      if ( $self->os_flavor_is('Win32') ) {
        my $make = $self->make;
        $make = +( File::Spec->splitpath( $make ) )[-1];
        $make =~ s!\.exe$!!i;
        $type = $make . '-style';
      }
      elsif ( $Is_VMS ) {
          $type = $Config{make} . '-style';
      }
  
      my $finalname = $self->{MAKEFILE};
      print "Generating a $type $finalname\n";
      print "Writing $finalname for $self->{NAME}\n";
  
      unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ());
      open(my $fh,">", "MakeMaker.tmp")
          or die "Unable to open MakeMaker.tmp: $!";
      binmode $fh, ':encoding(locale)' if $CAN_DECODE;
  
      for my $chunk (@{$self->{RESULT}}) {
          my $to_write = "$chunk\n";
          if (!$CAN_DECODE && $] > 5.008) {
              utf8::encode $to_write;
          }
          print $fh "$chunk\n"
              or die "Can't write to MakeMaker.tmp: $!";
      }
  
      close $fh
          or die "Can't write to MakeMaker.tmp: $!";
      _rename("MakeMaker.tmp", $finalname) or
        warn "rename MakeMaker.tmp => $finalname: $!";
      chmod 0644, $finalname unless $Is_VMS;
  
      unless ($self->{NO_MYMETA}) {
          # Write MYMETA.yml to communicate metadata up to the CPAN clients
          if ( $self->write_mymeta( $self->mymeta ) ) {
              print "Writing MYMETA.yml and MYMETA.json\n";
          }
  
      }
      my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE);
      if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) {
          foreach (keys %$self) { # safe memory
              delete $self->{$_} unless $keep{$_};
          }
      }
  
      system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":";
  }
  
  # This is a rename for OS's where the target must be unlinked first.
  sub _rename {
      my($src, $dest) = @_;
      chmod 0666, $dest;
      unlink $dest;
      return rename $src, $dest;
  }
  
  # This is an unlink for OS's where the target must be writable first.
  sub _unlink {
      my @files = @_;
      chmod 0666, @files;
      return unlink @files;
  }
  
  
  # The following mkbootstrap() is only for installations that are calling
  # the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker
  # writes Makefiles, that use ExtUtils::Mkbootstrap directly.
  sub mkbootstrap {
      die <<END;
  !!! Your Makefile has been built such a long time ago, !!!
  !!! that is unlikely to work with current MakeMaker.   !!!
  !!! Please rebuild your Makefile                       !!!
  END
  }
  
  # Ditto for mksymlists() as of MakeMaker 5.17
  sub mksymlists {
      die <<END;
  !!! Your Makefile has been built such a long time ago, !!!
  !!! that is unlikely to work with current MakeMaker.   !!!
  !!! Please rebuild your Makefile                       !!!
  END
  }
  
  sub neatvalue {
      my($v) = @_;
      return "undef" unless defined $v;
      my($t) = ref $v;
      return "q[$v]" unless $t;
      if ($t eq 'ARRAY') {
          my(@m, @neat);
          push @m, "[";
          foreach my $elem (@$v) {
              push @neat, "q[$elem]";
          }
          push @m, join ", ", @neat;
          push @m, "]";
          return join "", @m;
      }
      return $v unless $t eq 'HASH';
      my(@m, $key, $val);
      for my $key (sort keys %$v) {
          last unless defined $key; # cautious programming in case (undef,undef) is true
          push @m,"$key=>".neatvalue($v->{$key});
      }
      return "{ ".join(', ',@m)." }";
  }
  
  sub _find_magic_vstring {
      my $value = shift;
      return $value if $UNDER_CORE;
      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;
  }
  
  
  # Look for weird version numbers, warn about them and set them to 0
  # before CPAN::Meta chokes.
  sub clean_versions {
      my($self, $key) = @_;
      my $reqs = $self->{$key};
      for my $module (keys %$reqs) {
          my $v = $reqs->{$module};
          my $printable = _find_magic_vstring($v);
          $v = $printable if length $printable;
          my $version = eval {
              local $SIG{__WARN__} = sub {
                # simulate "use warnings FATAL => 'all'" for vintage perls
                die @_;
              };
              version->new($v)->stringify;
          };
          if( $@ || $reqs->{$module} eq '' ) {
              if ( $] < 5.008 && $v !~ /^v?[\d_\.]+$/ ) {
                 $v = sprintf "v%vd", $v unless $v eq '';
              }
              carp "Unparsable version '$v' for prerequisite $module";
              $reqs->{$module} = 0;
          }
          else {
              $reqs->{$module} = $version;
          }
      }
  }
  
  sub selfdocument {
      my($self) = @_;
      my(@m);
      if ($Verbose){
          push @m, "\n# Full list of MakeMaker attribute values:";
          foreach my $key (sort keys %$self){
              next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/;
              my($v) = neatvalue($self->{$key});
              $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
              $v =~ tr/\n/ /s;
              push @m, "# $key => $v";
          }
      }
      join "\n", @m;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  ExtUtils::MakeMaker - Create a module Makefile
  
  =head1 SYNOPSIS
  
    use ExtUtils::MakeMaker;
  
    WriteMakefile(
        NAME              => "Foo::Bar",
        VERSION_FROM      => "lib/Foo/Bar.pm",
    );
  
  =head1 DESCRIPTION
  
  This utility is designed to write a Makefile for an extension module
  from a Makefile.PL. It is based on the Makefile.SH model provided by
  Andy Dougherty and the perl5-porters.
  
  It splits the task of generating the Makefile into several subroutines
  that can be individually overridden.  Each subroutine returns the text
  it wishes to have written to the Makefile.
  
  As there are various Make programs with incompatible syntax, which
  use operating system shells, again with incompatible syntax, it is
  important for users of this module to know which flavour of Make
  a Makefile has been written for so they'll use the correct one and
  won't have to face the possibly bewildering errors resulting from
  using the wrong one.
  
  On POSIX systems, that program will likely be GNU Make; on Microsoft
  Windows, it will be either Microsoft NMake, DMake or GNU Make.
  See the section on the L</"MAKE"> parameter for details.
  
  ExtUtils::MakeMaker (EUMM) is object oriented. Each directory below the current
  directory that contains a Makefile.PL is treated as a separate
  object. This makes it possible to write an unlimited number of
  Makefiles with a single invocation of WriteMakefile().
  
  All inputs to WriteMakefile are Unicode characters, not just octets. EUMM
  seeks to handle all of these correctly. It is currently still not possible
  to portably use Unicode characters in module names, because this requires
  Perl to handle Unicode filenames, which is not yet the case on Windows.
  
  =head2 How To Write A Makefile.PL
  
  See L<ExtUtils::MakeMaker::Tutorial>.
  
  The long answer is the rest of the manpage :-)
  
  =head2 Default Makefile Behaviour
  
  The generated Makefile enables the user of the extension to invoke
  
    perl Makefile.PL # optionally "perl Makefile.PL verbose"
    make
    make test        # optionally set TEST_VERBOSE=1
    make install     # See below
  
  The Makefile to be produced may be altered by adding arguments of the
  form C<KEY=VALUE>. E.g.
  
    perl Makefile.PL INSTALL_BASE=~
  
  Other interesting targets in the generated Makefile are
  
    make config     # to check if the Makefile is up-to-date
    make clean      # delete local temp files (Makefile gets renamed)
    make realclean  # delete derived files (including ./blib)
    make ci         # check in all the files in the MANIFEST file
    make dist       # see below the Distribution Support section
  
  =head2 make test
  
  MakeMaker checks for the existence of a file named F<test.pl> in the
  current directory, and if it exists it executes the script with the
  proper set of perl C<-I> options.
  
  MakeMaker also checks for any files matching glob("t/*.t"). It will
  execute all matching files in alphabetical order via the
  L<Test::Harness> module with the C<-I> switches set correctly.
  
  If you'd like to see the raw output of your tests, set the
  C<TEST_VERBOSE> variable to true.
  
    make test TEST_VERBOSE=1
  
  If you want to run particular test files, set the C<TEST_FILES> variable.
  It is possible to use globbing with this mechanism.
  
    make test TEST_FILES='t/foobar.t t/dagobah*.t'
  
  Windows users who are using C<nmake> should note that due to a bug in C<nmake>,
  when specifying C<TEST_FILES> you must use back-slashes instead of forward-slashes.
  
    nmake test TEST_FILES='t\foobar.t t\dagobah*.t'
  
  =head2 make testdb
  
  A useful variation of the above is the target C<testdb>. It runs the
  test under the Perl debugger (see L<perldebug>). If the file
  F<test.pl> exists in the current directory, it is used for the test.
  
  If you want to debug some other testfile, set the C<TEST_FILE> variable
  thusly:
  
    make testdb TEST_FILE=t/mytest.t
  
  By default the debugger is called using C<-d> option to perl. If you
  want to specify some other option, set the C<TESTDB_SW> variable:
  
    make testdb TESTDB_SW=-Dx
  
  =head2 make install
  
  make alone puts all relevant files into directories that are named by
  the macros INST_LIB, INST_ARCHLIB, INST_SCRIPT, INST_MAN1DIR and
  INST_MAN3DIR.  All these default to something below ./blib if you are
  I<not> building below the perl source directory. If you I<are>
  building below the perl source, INST_LIB and INST_ARCHLIB default to
  ../../lib, and INST_SCRIPT is not defined.
  
  The I<install> target of the generated Makefile copies the files found
  below each of the INST_* directories to their INSTALL*
  counterparts. Which counterparts are chosen depends on the setting of
  INSTALLDIRS according to the following table:
  
                                   INSTALLDIRS set to
                             perl        site          vendor
  
                   PERLPREFIX      SITEPREFIX          VENDORPREFIX
    INST_ARCHLIB   INSTALLARCHLIB  INSTALLSITEARCH     INSTALLVENDORARCH
    INST_LIB       INSTALLPRIVLIB  INSTALLSITELIB      INSTALLVENDORLIB
    INST_BIN       INSTALLBIN      INSTALLSITEBIN      INSTALLVENDORBIN
    INST_SCRIPT    INSTALLSCRIPT   INSTALLSITESCRIPT   INSTALLVENDORSCRIPT
    INST_MAN1DIR   INSTALLMAN1DIR  INSTALLSITEMAN1DIR  INSTALLVENDORMAN1DIR
    INST_MAN3DIR   INSTALLMAN3DIR  INSTALLSITEMAN3DIR  INSTALLVENDORMAN3DIR
  
  The INSTALL... macros in turn default to their %Config
  ($Config{installprivlib}, $Config{installarchlib}, etc.) counterparts.
  
  You can check the values of these variables on your system with
  
      perl '-V:install.*'
  
  And to check the sequence in which the library directories are
  searched by perl, run
  
      perl -le 'print join $/, @INC'
  
  Sometimes older versions of the module you're installing live in other
  directories in @INC.  Because Perl loads the first version of a module it
  finds, not the newest, you might accidentally get one of these older
  versions even after installing a brand new version.  To delete I<all other
  versions of the module you're installing> (not simply older ones) set the
  C<UNINST> variable.
  
      make install UNINST=1
  
  
  =head2 INSTALL_BASE
  
  INSTALL_BASE can be passed into Makefile.PL to change where your
  module will be installed.  INSTALL_BASE is more like what everyone
  else calls "prefix" than PREFIX is.
  
  To have everything installed in your home directory, do the following.
  
      # Unix users, INSTALL_BASE=~ works fine
      perl Makefile.PL INSTALL_BASE=/path/to/your/home/dir
  
  Like PREFIX, it sets several INSTALL* attributes at once.  Unlike
  PREFIX it is easy to predict where the module will end up.  The
  installation pattern looks like this:
  
      INSTALLARCHLIB     INSTALL_BASE/lib/perl5/$Config{archname}
      INSTALLPRIVLIB     INSTALL_BASE/lib/perl5
      INSTALLBIN         INSTALL_BASE/bin
      INSTALLSCRIPT      INSTALL_BASE/bin
      INSTALLMAN1DIR     INSTALL_BASE/man/man1
      INSTALLMAN3DIR     INSTALL_BASE/man/man3
  
  INSTALL_BASE in MakeMaker and C<--install_base> in Module::Build (as
  of 0.28) install to the same location.  If you want MakeMaker and
  Module::Build to install to the same location simply set INSTALL_BASE
  and C<--install_base> to the same location.
  
  INSTALL_BASE was added in 6.31.
  
  
  =head2 PREFIX and LIB attribute
  
  PREFIX and LIB can be used to set several INSTALL* attributes in one
  go.  Here's an example for installing into your home directory.
  
      # Unix users, PREFIX=~ works fine
      perl Makefile.PL PREFIX=/path/to/your/home/dir
  
  This will install all files in the module under your home directory,
  with man pages and libraries going into an appropriate place (usually
  ~/man and ~/lib).  How the exact location is determined is complicated
  and depends on how your Perl was configured.  INSTALL_BASE works more
  like what other build systems call "prefix" than PREFIX and we
  recommend you use that instead.
  
  Another way to specify many INSTALL directories with a single
  parameter is LIB.
  
      perl Makefile.PL LIB=~/lib
  
  This will install the module's architecture-independent files into
  ~/lib, the architecture-dependent files into ~/lib/$archname.
  
  Note, that in both cases the tilde expansion is done by MakeMaker, not
  by perl by default, nor by make.
  
  Conflicts between parameters LIB, PREFIX and the various INSTALL*
  arguments are resolved so that:
  
  =over 4
  
  =item *
  
  setting LIB overrides any setting of INSTALLPRIVLIB, INSTALLARCHLIB,
  INSTALLSITELIB, INSTALLSITEARCH (and they are not affected by PREFIX);
  
  =item *
  
  without LIB, setting PREFIX replaces the initial C<$Config{prefix}>
  part of those INSTALL* arguments, even if the latter are explicitly
  set (but are set to still start with C<$Config{prefix}>).
  
  =back
  
  If the user has superuser privileges, and is not working on AFS or
  relatives, then the defaults for INSTALLPRIVLIB, INSTALLARCHLIB,
  INSTALLSCRIPT, etc. will be appropriate, and this incantation will be
  the best:
  
      perl Makefile.PL;
      make;
      make test
      make install
  
  make install by default writes some documentation of what has been
  done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This feature
  can be bypassed by calling make pure_install.
  
  =head2 AFS users
  
  will have to specify the installation directories as these most
  probably have changed since perl itself has been installed. They will
  have to do this by calling
  
      perl Makefile.PL INSTALLSITELIB=/afs/here/today \
          INSTALLSCRIPT=/afs/there/now INSTALLMAN3DIR=/afs/for/manpages
      make
  
  Be careful to repeat this procedure every time you recompile an
  extension, unless you are sure the AFS installation directories are
  still valid.
  
  =head2 Static Linking of a new Perl Binary
  
  An extension that is built with the above steps is ready to use on
  systems supporting dynamic loading. On systems that do not support
  dynamic loading, any newly created extension has to be linked together
  with the available resources. MakeMaker supports the linking process
  by creating appropriate targets in the Makefile whenever an extension
  is built. You can invoke the corresponding section of the makefile with
  
      make perl
  
  That produces a new perl binary in the current directory with all
  extensions linked in that can be found in INST_ARCHLIB, SITELIBEXP,
  and PERL_ARCHLIB. To do that, MakeMaker writes a new Makefile, on
  UNIX, this is called F<Makefile.aperl> (may be system dependent). If you
  want to force the creation of a new perl, it is recommended that you
  delete this F<Makefile.aperl>, so the directories are searched through
  for linkable libraries again.
  
  The binary can be installed into the directory where perl normally
  resides on your machine with
  
      make inst_perl
  
  To produce a perl binary with a different name than C<perl>, either say
  
      perl Makefile.PL MAP_TARGET=myperl
      make myperl
      make inst_perl
  
  or say
  
      perl Makefile.PL
      make myperl MAP_TARGET=myperl
      make inst_perl MAP_TARGET=myperl
  
  In any case you will be prompted with the correct invocation of the
  C<inst_perl> target that installs the new binary into INSTALLBIN.
  
  make inst_perl by default writes some documentation of what has been
  done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This
  can be bypassed by calling make pure_inst_perl.
  
  Warning: the inst_perl: target will most probably overwrite your
  existing perl binary. Use with care!
  
  Sometimes you might want to build a statically linked perl although
  your system supports dynamic loading. In this case you may explicitly
  set the linktype with the invocation of the Makefile.PL or make:
  
      perl Makefile.PL LINKTYPE=static    # recommended
  
  or
  
      make LINKTYPE=static                # works on most systems
  
  =head2 Determination of Perl Library and Installation Locations
  
  MakeMaker needs to know, or to guess, where certain things are
  located.  Especially INST_LIB and INST_ARCHLIB (where to put the files
  during the make(1) run), PERL_LIB and PERL_ARCHLIB (where to read
  existing modules from), and PERL_INC (header files and C<libperl*.*>).
  
  Extensions may be built either using the contents of the perl source
  directory tree or from the installed perl library. The recommended way
  is to build extensions after you have run 'make install' on perl
  itself. You can do that in any directory on your hard disk that is not
  below the perl source tree. The support for extensions below the ext
  directory of the perl distribution is only good for the standard
  extensions that come with perl.
  
  If an extension is being built below the C<ext/> directory of the perl
  source then MakeMaker will set PERL_SRC automatically (e.g.,
  C<../..>).  If PERL_SRC is defined and the extension is recognized as
  a standard extension, then other variables default to the following:
  
    PERL_INC     = PERL_SRC
    PERL_LIB     = PERL_SRC/lib
    PERL_ARCHLIB = PERL_SRC/lib
    INST_LIB     = PERL_LIB
    INST_ARCHLIB = PERL_ARCHLIB
  
  If an extension is being built away from the perl source then MakeMaker
  will leave PERL_SRC undefined and default to using the installed copy
  of the perl library. The other variables default to the following:
  
    PERL_INC     = $archlibexp/CORE
    PERL_LIB     = $privlibexp
    PERL_ARCHLIB = $archlibexp
    INST_LIB     = ./blib/lib
    INST_ARCHLIB = ./blib/arch
  
  If perl has not yet been installed then PERL_SRC can be defined on the
  command line as shown in the previous section.
  
  
  =head2 Which architecture dependent directory?
  
  If you don't want to keep the defaults for the INSTALL* macros,
  MakeMaker helps you to minimize the typing needed: the usual
  relationship between INSTALLPRIVLIB and INSTALLARCHLIB is determined
  by Configure at perl compilation time. MakeMaker supports the user who
  sets INSTALLPRIVLIB. If INSTALLPRIVLIB is set, but INSTALLARCHLIB not,
  then MakeMaker defaults the latter to be the same subdirectory of
  INSTALLPRIVLIB as Configure decided for the counterparts in %Config,
  otherwise it defaults to INSTALLPRIVLIB. The same relationship holds
  for INSTALLSITELIB and INSTALLSITEARCH.
  
  MakeMaker gives you much more freedom than needed to configure
  internal variables and get different results. It is worth mentioning
  that make(1) also lets you configure most of the variables that are
  used in the Makefile. But in the majority of situations this will not
  be necessary, and should only be done if the author of a package
  recommends it (or you know what you're doing).
  
  =head2 Using Attributes and Parameters
  
  The following attributes may be specified as arguments to WriteMakefile()
  or as NAME=VALUE pairs on the command line. Attributes that became
  available with later versions of MakeMaker are indicated.
  
  In order to maintain portability of attributes with older versions of
  MakeMaker you may want to use L<App::EUMM::Upgrade> with your C<Makefile.PL>.
  
  =over 2
  
  =item ABSTRACT
  
  One line description of the module. Will be included in PPD file.
  
  =item ABSTRACT_FROM
  
  Name of the file that contains the package description. MakeMaker looks
  for a line in the POD matching /^($package\s-\s)(.*)/. This is typically
  the first line in the "=head1 NAME" section. $2 becomes the abstract.
  
  =item AUTHOR
  
  Array of strings containing name (and email address) of package author(s).
  Is used in CPAN Meta files (META.yml or META.json) and PPD
  (Perl Package Description) files for PPM (Perl Package Manager).
  
  =item BINARY_LOCATION
  
  Used when creating PPD files for binary packages.  It can be set to a
  full or relative path or URL to the binary archive for a particular
  architecture.  For example:
  
          perl Makefile.PL BINARY_LOCATION=x86/Agent.tar.gz
  
  builds a PPD package that references a binary of the C<Agent> package,
  located in the C<x86> directory relative to the PPD itself.
  
  =item BUILD_REQUIRES
  
  Available in version 6.5503 and above.
  
  A hash of modules that are needed to build your module but not run it.
  
  This will go into the C<build_requires> field of your F<META.yml> and the C<build> of the C<prereqs> field of your F<META.json>.
  
  Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> if this attribute is not specified.
  
  The format is the same as PREREQ_PM.
  
  =item C
  
  Ref to array of *.c file names. Initialised from a directory scan
  and the values portion of the XS attribute hash. This is not
  currently used by MakeMaker but may be handy in Makefile.PLs.
  
  =item CCFLAGS
  
  String that will be included in the compiler call command line between
  the arguments INC and OPTIMIZE.
  
  =item CONFIG
  
  Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from
  config.sh. MakeMaker will add to CONFIG the following values anyway:
  ar
  cc
  cccdlflags
  ccdlflags
  dlext
  dlsrc
  ld
  lddlflags
  ldflags
  libc
  lib_ext
  obj_ext
  ranlib
  sitelibexp
  sitearchexp
  so
  
  =item CONFIGURE
  
  CODE reference. The subroutine should return a hash reference. The
  hash may contain further attributes, e.g. {LIBS =E<gt> ...}, that have to
  be determined by some evaluation method.
  
  =item CONFIGURE_REQUIRES
  
  Available in version 6.52 and above.
  
  A hash of modules that are required to run Makefile.PL itself, but not
  to run your distribution.
  
  This will go into the C<configure_requires> field of your F<META.yml> and the C<configure> of the C<prereqs> field of your F<META.json>.
  
  Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>> if this attribute is not specified.
  
  The format is the same as PREREQ_PM.
  
  =item DEFINE
  
  Something like C<"-DHAVE_UNISTD_H">
  
  =item DESTDIR
  
  This is the root directory into which the code will be installed.  It
  I<prepends itself to the normal prefix>.  For example, if your code
  would normally go into F</usr/local/lib/perl> you could set DESTDIR=~/tmp/
  and installation would go into F<~/tmp/usr/local/lib/perl>.
  
  This is primarily of use for people who repackage Perl modules.
  
  NOTE: Due to the nature of make, it is important that you put the trailing
  slash on your DESTDIR.  F<~/tmp/> not F<~/tmp>.
  
  =item DIR
  
  Ref to array of subdirectories containing Makefile.PLs e.g. ['sdbm']
  in ext/SDBM_File
  
  =item DISTNAME
  
  A safe filename for the package.
  
  Defaults to NAME below but with :: replaced with -.
  
  For example, Foo::Bar becomes Foo-Bar.
  
  =item DISTVNAME
  
  Your name for distributing the package with the version number
  included.  This is used by 'make dist' to name the resulting archive
  file.
  
  Defaults to DISTNAME-VERSION.
  
  For example, version 1.04 of Foo::Bar becomes Foo-Bar-1.04.
  
  On some OS's where . has special meaning VERSION_SYM may be used in
  place of VERSION.
  
  =item DLEXT
  
  Specifies the extension of the module's loadable object. For example:
  
    DLEXT => 'unusual_ext', # Default value is $Config{so}
  
  NOTE: When using this option to alter the extension of a module's
  loadable object, it is also necessary that the module's pm file
  specifies the same change:
  
    local $DynaLoader::dl_dlext = 'unusual_ext';
  
  =item DL_FUNCS
  
  Hashref of symbol names for routines to be made available as universal
  symbols.  Each key/value pair consists of the package name and an
  array of routine names in that package.  Used only under AIX, OS/2,
  VMS and Win32 at present.  The routine names supplied will be expanded
  in the same way as XSUB names are expanded by the XS() macro.
  Defaults to
  
    {"$(NAME)" => ["boot_$(NAME)" ] }
  
  e.g.
  
    {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )],
     "NetconfigPtr" => [ 'DESTROY'] }
  
  Please see the L<ExtUtils::Mksymlists> documentation for more information
  about the DL_FUNCS, DL_VARS and FUNCLIST attributes.
  
  =item DL_VARS
  
  Array of symbol names for variables to be made available as universal symbols.
  Used only under AIX, OS/2, VMS and Win32 at present.  Defaults to [].
  (e.g. [ qw(Foo_version Foo_numstreams Foo_tree ) ])
  
  =item EXCLUDE_EXT
  
  Array of extension names to exclude when doing a static build.  This
  is ignored if INCLUDE_EXT is present.  Consult INCLUDE_EXT for more
  details.  (e.g.  [ qw( Socket POSIX ) ] )
  
  This attribute may be most useful when specified as a string on the
  command line:  perl Makefile.PL EXCLUDE_EXT='Socket Safe'
  
  =item EXE_FILES
  
  Ref to array of executable files. The files will be copied to the
  INST_SCRIPT directory. Make realclean will delete them from there
  again.
  
  If your executables start with something like #!perl or
  #!/usr/bin/perl MakeMaker will change this to the path of the perl
  'Makefile.PL' was invoked with so the programs will be sure to run
  properly even if perl is not in /usr/bin/perl.
  
  =item FIRST_MAKEFILE
  
  The name of the Makefile to be produced.  This is used for the second
  Makefile that will be produced for the MAP_TARGET.
  
  Defaults to 'Makefile' or 'Descrip.MMS' on VMS.
  
  (Note: we couldn't use MAKEFILE because dmake uses this for something
  else).
  
  =item FULLPERL
  
  Perl binary able to run this extension, load XS modules, etc...
  
  =item FULLPERLRUN
  
  Like PERLRUN, except it uses FULLPERL.
  
  =item FULLPERLRUNINST
  
  Like PERLRUNINST, except it uses FULLPERL.
  
  =item FUNCLIST
  
  This provides an alternate means to specify function names to be
  exported from the extension.  Its value is a reference to an
  array of function names to be exported by the extension.  These
  names are passed through unaltered to the linker options file.
  
  =item H
  
  Ref to array of *.h file names. Similar to C.
  
  =item IMPORTS
  
  This attribute is used to specify names to be imported into the
  extension. Takes a hash ref.
  
  It is only used on OS/2 and Win32.
  
  =item INC
  
  Include file dirs eg: C<"-I/usr/5include -I/path/to/inc">
  
  =item INCLUDE_EXT
  
  Array of extension names to be included when doing a static build.
  MakeMaker will normally build with all of the installed extensions when
  doing a static build, and that is usually the desired behavior.  If
  INCLUDE_EXT is present then MakeMaker will build only with those extensions
  which are explicitly mentioned. (e.g.  [ qw( Socket POSIX ) ])
  
  It is not necessary to mention DynaLoader or the current extension when
  filling in INCLUDE_EXT.  If the INCLUDE_EXT is mentioned but is empty then
  only DynaLoader and the current extension will be included in the build.
  
  This attribute may be most useful when specified as a string on the
  command line:  perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
  
  =item INSTALLARCHLIB
  
  Used by 'make install', which copies files from INST_ARCHLIB to this
  directory if INSTALLDIRS is set to perl.
  
  =item INSTALLBIN
  
  Directory to install binary files (e.g. tkperl) into if
  INSTALLDIRS=perl.
  
  =item INSTALLDIRS
  
  Determines which of the sets of installation directories to choose:
  perl, site or vendor.  Defaults to site.
  
  =item INSTALLMAN1DIR
  
  =item INSTALLMAN3DIR
  
  These directories get the man pages at 'make install' time if
  INSTALLDIRS=perl.  Defaults to $Config{installman*dir}.
  
  If set to 'none', no man pages will be installed.
  
  =item INSTALLPRIVLIB
  
  Used by 'make install', which copies files from INST_LIB to this
  directory if INSTALLDIRS is set to perl.
  
  Defaults to $Config{installprivlib}.
  
  =item INSTALLSCRIPT
  
  Used by 'make install' which copies files from INST_SCRIPT to this
  directory if INSTALLDIRS=perl.
  
  =item INSTALLSITEARCH
  
  Used by 'make install', which copies files from INST_ARCHLIB to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLSITEBIN
  
  Used by 'make install', which copies files from INST_BIN to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLSITELIB
  
  Used by 'make install', which copies files from INST_LIB to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLSITEMAN1DIR
  
  =item INSTALLSITEMAN3DIR
  
  These directories get the man pages at 'make install' time if
  INSTALLDIRS=site (default).  Defaults to
  $(SITEPREFIX)/man/man$(MAN*EXT).
  
  If set to 'none', no man pages will be installed.
  
  =item INSTALLSITESCRIPT
  
  Used by 'make install' which copies files from INST_SCRIPT to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLVENDORARCH
  
  Used by 'make install', which copies files from INST_ARCHLIB to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INSTALLVENDORBIN
  
  Used by 'make install', which copies files from INST_BIN to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INSTALLVENDORLIB
  
  Used by 'make install', which copies files from INST_LIB to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INSTALLVENDORMAN1DIR
  
  =item INSTALLVENDORMAN3DIR
  
  These directories get the man pages at 'make install' time if
  INSTALLDIRS=vendor.  Defaults to $(VENDORPREFIX)/man/man$(MAN*EXT).
  
  If set to 'none', no man pages will be installed.
  
  =item INSTALLVENDORSCRIPT
  
  Used by 'make install' which copies files from INST_SCRIPT to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INST_ARCHLIB
  
  Same as INST_LIB for architecture dependent files.
  
  =item INST_BIN
  
  Directory to put real binary files during 'make'. These will be copied
  to INSTALLBIN during 'make install'
  
  =item INST_LIB
  
  Directory where we put library files of this extension while building
  it.
  
  =item INST_MAN1DIR
  
  Directory to hold the man pages at 'make' time
  
  =item INST_MAN3DIR
  
  Directory to hold the man pages at 'make' time
  
  =item INST_SCRIPT
  
  Directory where executable files should be installed during
  'make'. Defaults to "./blib/script", just to have a dummy location during
  testing. make install will copy the files in INST_SCRIPT to
  INSTALLSCRIPT.
  
  =item LD
  
  Program to be used to link libraries for dynamic loading.
  
  Defaults to $Config{ld}.
  
  =item LDDLFLAGS
  
  Any special flags that might need to be passed to ld to create a
  shared library suitable for dynamic loading.  It is up to the makefile
  to use it.  (See L<Config/lddlflags>)
  
  Defaults to $Config{lddlflags}.
  
  =item LDFROM
  
  Defaults to "$(OBJECT)" and is used in the ld command to specify
  what files to link/load from (also see dynamic_lib below for how to
  specify ld flags)
  
  =item LIB
  
  LIB should only be set at C<perl Makefile.PL> time but is allowed as a
  MakeMaker argument. It has the effect of setting both INSTALLPRIVLIB
  and INSTALLSITELIB to that value regardless any explicit setting of
  those arguments (or of PREFIX).  INSTALLARCHLIB and INSTALLSITEARCH
  are set to the corresponding architecture subdirectory.
  
  =item LIBPERL_A
  
  The filename of the perllibrary that will be used together with this
  extension. Defaults to libperl.a.
  
  =item LIBS
  
  An anonymous array of alternative library
  specifications to be searched for (in order) until
  at least one library is found. E.g.
  
    'LIBS' => ["-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs"]
  
  Mind, that any element of the array
  contains a complete set of arguments for the ld
  command. So do not specify
  
    'LIBS' => ["-ltcl", "-ltk", "-lX11"]
  
  See ODBM_File/Makefile.PL for an example, where an array is needed. If
  you specify a scalar as in
  
    'LIBS' => "-ltcl -ltk -lX11"
  
  MakeMaker will turn it into an array with one element.
  
  =item LICENSE
  
  Available in version 6.31 and above.
  
  The licensing terms of your distribution.  Generally it's "perl_5" for the
  same license as Perl itself.
  
  See L<CPAN::Meta::Spec> for the list of options.
  
  Defaults to "unknown".
  
  =item LINKTYPE
  
  'static' or 'dynamic' (default unless usedl=undef in
  config.sh). Should only be used to force static linking (also see
  linkext below).
  
  =item MAGICXS
  
  When this is set to C<1>, C<OBJECT> will be automagically derived from
  C<O_FILES>.
  
  =item MAKE
  
  Variant of make you intend to run the generated Makefile with.  This
  parameter lets Makefile.PL know what make quirks to account for when
  generating the Makefile.
  
  MakeMaker also honors the MAKE environment variable.  This parameter
  takes precedence.
  
  Currently the only significant values are 'dmake' and 'nmake' for Windows
  users, instructing MakeMaker to generate a Makefile in the flavour of
  DMake ("Dennis Vadura's Make") or Microsoft NMake respectively.
  
  Defaults to $Config{make}, which may go looking for a Make program
  in your environment.
  
  How are you supposed to know what flavour of Make a Makefile has
  been generated for if you didn't specify a value explicitly? Search
  the generated Makefile for the definition of the MAKE variable,
  which is used to recursively invoke the Make utility. That will tell
  you what Make you're supposed to invoke the Makefile with.
  
  =item MAKEAPERL
  
  Boolean which tells MakeMaker that it should include the rules to
  make a perl. This is handled automatically as a switch by
  MakeMaker. The user normally does not need it.
  
  =item MAKEFILE_OLD
  
  When 'make clean' or similar is run, the $(FIRST_MAKEFILE) will be
  backed up at this location.
  
  Defaults to $(FIRST_MAKEFILE).old or $(FIRST_MAKEFILE)_old on VMS.
  
  =item MAN1PODS
  
  Hashref of pod-containing files. MakeMaker will default this to all
  EXE_FILES files that include POD directives. The files listed
  here will be converted to man pages and installed as was requested
  at Configure time.
  
  This hash should map POD files (or scripts containing POD) to the
  man file names under the C<blib/man1/> directory, as in the following
  example:
  
    MAN1PODS            => {
      'doc/command.pod'    => 'blib/man1/command.1',
      'scripts/script.pl'  => 'blib/man1/script.1',
    }
  
  =item MAN3PODS
  
  Hashref that assigns to *.pm and *.pod files the files into which the
  manpages are to be written. MakeMaker parses all *.pod and *.pm files
  for POD directives. Files that contain POD will be the default keys of
  the MAN3PODS hashref. These will then be converted to man pages during
  C<make> and will be installed during C<make install>.
  
  Example similar to MAN1PODS.
  
  =item MAP_TARGET
  
  If it is intended that a new perl binary be produced, this variable
  may hold a name for that binary. Defaults to perl
  
  =item META_ADD
  
  =item META_MERGE
  
  Available in version 6.46 and above.
  
  A hashref of items to add to the CPAN Meta file (F<META.yml> or
  F<META.json>).
  
  They differ in how they behave if they have the same key as the
  default metadata.  META_ADD will override the default value with its
  own.  META_MERGE will merge its value with the default.
  
  Unless you want to override the defaults, prefer META_MERGE so as to
  get the advantage of any future defaults.
  
  Where prereqs are concerned, if META_MERGE is used, prerequisites are merged
  with their counterpart C<WriteMakefile()> argument
  (PREREQ_PM is merged into {prereqs}{runtime}{requires},
  BUILD_REQUIRES into C<{prereqs}{build}{requires}>,
  CONFIGURE_REQUIRES into C<{prereqs}{configure}{requires}>,
  and TEST_REQUIRES into C<{prereqs}{test}{requires})>.
  When prereqs are specified with META_ADD, the only prerequisites added to the
  file come from the metadata, not C<WriteMakefile()> arguments.
  
  Note that these configuration options are only used for generating F<META.yml>
  and F<META.json> -- they are NOT used for F<MYMETA.yml> and F<MYMETA.json>.
  Therefore data in these fields should NOT be used for dynamic (user-side)
  configuration.
  
  By default CPAN Meta specification C<1.4> is used. In order to use
  CPAN Meta specification C<2.0>, indicate with C<meta-spec> the version
  you want to use.
  
    META_MERGE        => {
  
      "meta-spec" => { version => 2 },
  
      resources => {
  
        repository => {
            type => 'git',
            url => 'git://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker.git',
            web => 'https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker',
        },
  
      },
  
    },
  
  =item MIN_PERL_VERSION
  
  Available in version 6.48 and above.
  
  The minimum required version of Perl for this distribution.
  
  Either the 5.006001 or the 5.6.1 format is acceptable.
  
  =item MYEXTLIB
  
  If the extension links to a library that it builds, set this to the
  name of the library (see SDBM_File)
  
  =item NAME
  
  The package representing the distribution. For example, C<Test::More>
  or C<ExtUtils::MakeMaker>. It will be used to derive information about
  the distribution such as the L</DISTNAME>, installation locations
  within the Perl library and where XS files will be looked for by
  default (see L</XS>).
  
  C<NAME> I<must> be a valid Perl package name and it I<must> have an
  associated C<.pm> file. For example, C<Foo::Bar> is a valid C<NAME>
  and there must exist F<Foo/Bar.pm>.  Any XS code should be in
  F<Bar.xs> unless stated otherwise.
  
  Your distribution B<must> have a C<NAME>.
  
  =item NEEDS_LINKING
  
  MakeMaker will figure out if an extension contains linkable code
  anywhere down the directory tree, and will set this variable
  accordingly, but you can speed it up a very little bit if you define
  this boolean variable yourself.
  
  =item NOECHO
  
  Command so make does not print the literal commands it's running.
  
  By setting it to an empty string you can generate a Makefile that
  prints all commands. Mainly used in debugging MakeMaker itself.
  
  Defaults to C<@>.
  
  =item NORECURS
  
  Boolean.  Attribute to inhibit descending into subdirectories.
  
  =item NO_META
  
  When true, suppresses the generation and addition to the MANIFEST of
  the META.yml and META.json module meta-data files during 'make distdir'.
  
  Defaults to false.
  
  =item NO_MYMETA
  
  When true, suppresses the generation of MYMETA.yml and MYMETA.json module
  meta-data files during 'perl Makefile.PL'.
  
  Defaults to false.
  
  =item NO_PACKLIST
  
  When true, suppresses the writing of C<packlist> files for installs.
  
  Defaults to false.
  
  =item NO_PERLLOCAL
  
  When true, suppresses the appending of installations to C<perllocal>.
  
  Defaults to false.
  
  =item NO_VC
  
  In general, any generated Makefile checks for the current version of
  MakeMaker and the version the Makefile was built under. If NO_VC is
  set, the version check is neglected. Do not write this into your
  Makefile.PL, use it interactively instead.
  
  =item OBJECT
  
  List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long
  string or an array containing all object files, e.g. "tkpBind.o
  tkpButton.o tkpCanvas.o" or ["tkpBind.o", "tkpButton.o", "tkpCanvas.o"]
  
  (Where BASEEXT is the last component of NAME, and OBJ_EXT is $Config{obj_ext}.)
  
  =item OPTIMIZE
  
  Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is
  passed to subdirectory makes.
  
  =item PERL
  
  Perl binary for tasks that can be done by miniperl.
  
  =item PERL_CORE
  
  Set only when MakeMaker is building the extensions of the Perl core
  distribution.
  
  =item PERLMAINCC
  
  The call to the program that is able to compile perlmain.c. Defaults
  to $(CC).
  
  =item PERL_ARCHLIB
  
  Same as for PERL_LIB, but for architecture dependent files.
  
  Used only when MakeMaker is building the extensions of the Perl core
  distribution (because normally $(PERL_ARCHLIB) is automatically in @INC,
  and adding it would get in the way of PERL5LIB).
  
  =item PERL_LIB
  
  Directory containing the Perl library to use.
  
  Used only when MakeMaker is building the extensions of the Perl core
  distribution (because normally $(PERL_LIB) is automatically in @INC,
  and adding it would get in the way of PERL5LIB).
  
  =item PERL_MALLOC_OK
  
  defaults to 0.  Should be set to TRUE if the extension can work with
  the memory allocation routines substituted by the Perl malloc() subsystem.
  This should be applicable to most extensions with exceptions of those
  
  =over 4
  
  =item *
  
  with bugs in memory allocations which are caught by Perl's malloc();
  
  =item *
  
  which interact with the memory allocator in other ways than via
  malloc(), realloc(), free(), calloc(), sbrk() and brk();
  
  =item *
  
  which rely on special alignment which is not provided by Perl's malloc().
  
  =back
  
  B<NOTE.>  Neglecting to set this flag in I<any one> of the loaded extension
  nullifies many advantages of Perl's malloc(), such as better usage of
  system resources, error detection, memory usage reporting, catchable failure
  of memory allocations, etc.
  
  =item PERLPREFIX
  
  Directory under which core modules are to be installed.
  
  Defaults to $Config{installprefixexp}, falling back to
  $Config{installprefix}, $Config{prefixexp} or $Config{prefix} should
  $Config{installprefixexp} not exist.
  
  Overridden by PREFIX.
  
  =item PERLRUN
  
  Use this instead of $(PERL) when you wish to run perl.  It will set up
  extra necessary flags for you.
  
  =item PERLRUNINST
  
  Use this instead of $(PERL) when you wish to run perl to work with
  modules.  It will add things like -I$(INST_ARCH) and other necessary
  flags so perl can see the modules you're about to install.
  
  =item PERL_SRC
  
  Directory containing the Perl source code (use of this should be
  avoided, it may be undefined)
  
  =item PERM_DIR
  
  Desired permission for directories. Defaults to C<755>.
  
  =item PERM_RW
  
  Desired permission for read/writable files. Defaults to C<644>.
  
  =item PERM_RWX
  
  Desired permission for executable files. Defaults to C<755>.
  
  =item PL_FILES
  
  MakeMaker can run programs to generate files for you at build time.
  By default any file named *.PL (except Makefile.PL and Build.PL) in
  the top level directory will be assumed to be a Perl program and run
  passing its own basename in as an argument.  For example...
  
      perl foo.PL foo
  
  This behavior can be overridden by supplying your own set of files to
  search.  PL_FILES accepts a hash ref, the key being the file to run
  and the value is passed in as the first argument when the PL file is run.
  
      PL_FILES => {'bin/foobar.PL' => 'bin/foobar'}
  
  Would run bin/foobar.PL like this:
  
      perl bin/foobar.PL bin/foobar
  
  If multiple files from one program are desired an array ref can be used.
  
      PL_FILES => {'bin/foobar.PL' => [qw(bin/foobar1 bin/foobar2)]}
  
  In this case the program will be run multiple times using each target file.
  
      perl bin/foobar.PL bin/foobar1
      perl bin/foobar.PL bin/foobar2
  
  PL files are normally run B<after> pm_to_blib and include INST_LIB and
  INST_ARCH in their C<@INC>, so the just built modules can be
  accessed... unless the PL file is making a module (or anything else in
  PM) in which case it is run B<before> pm_to_blib and does not include
  INST_LIB and INST_ARCH in its C<@INC>.  This apparently odd behavior
  is there for backwards compatibility (and it's somewhat DWIM).
  
  
  =item PM
  
  Hashref of .pm files and *.pl files to be installed.  e.g.
  
    {'name_of_file.pm' => '$(INST_LIB)/install_as.pm'}
  
  By default this will include *.pm and *.pl and the files found in
  the PMLIBDIRS directories.  Defining PM in the
  Makefile.PL will override PMLIBDIRS.
  
  =item PMLIBDIRS
  
  Ref to array of subdirectories containing library files.  Defaults to
  [ 'lib', $(BASEEXT) ]. The directories will be scanned and I<any> files
  they contain will be installed in the corresponding location in the
  library.  A libscan() method can be used to alter the behaviour.
  Defining PM in the Makefile.PL will override PMLIBDIRS.
  
  (Where BASEEXT is the last component of NAME.)
  
  =item PM_FILTER
  
  A filter program, in the traditional Unix sense (input from stdin, output
  to stdout) that is passed on each .pm file during the build (in the
  pm_to_blib() phase).  It is empty by default, meaning no filtering is done.
  
  Great care is necessary when defining the command if quoting needs to be
  done.  For instance, you would need to say:
  
    {'PM_FILTER' => 'grep -v \\"^\\#\\"'}
  
  to remove all the leading comments on the fly during the build.  The
  extra \\ are necessary, unfortunately, because this variable is interpolated
  within the context of a Perl program built on the command line, and double
  quotes are what is used with the -e switch to build that command line.  The
  # is escaped for the Makefile, since what is going to be generated will then
  be:
  
    PM_FILTER = grep -v \"^\#\"
  
  Without the \\ before the #, we'd have the start of a Makefile comment,
  and the macro would be incorrectly defined.
  
  =item POLLUTE
  
  Release 5.005 grandfathered old global symbol names by providing preprocessor
  macros for extension source compatibility.  As of release 5.6, these
  preprocessor definitions are not available by default.  The POLLUTE flag
  specifies that the old names should still be defined:
  
    perl Makefile.PL POLLUTE=1
  
  Please inform the module author if this is necessary to successfully install
  a module under 5.6 or later.
  
  =item PPM_INSTALL_EXEC
  
  Name of the executable used to run C<PPM_INSTALL_SCRIPT> below. (e.g. perl)
  
  =item PPM_INSTALL_SCRIPT
  
  Name of the script that gets executed by the Perl Package Manager after
  the installation of a package.
  
  =item PPM_UNINSTALL_EXEC
  
  Name of the executable used to run C<PPM_UNINSTALL_SCRIPT> below. (e.g. perl)
  
  =item PPM_UNINSTALL_SCRIPT
  
  Name of the script that gets executed by the Perl Package Manager before
  the removal of a package.
  
  =item PREFIX
  
  This overrides all the default install locations.  Man pages,
  libraries, scripts, etc...  MakeMaker will try to make an educated
  guess about where to place things under the new PREFIX based on your
  Config defaults.  Failing that, it will fall back to a structure
  which should be sensible for your platform.
  
  If you specify LIB or any INSTALL* variables they will not be affected
  by the PREFIX.
  
  =item PREREQ_FATAL
  
  Bool. If this parameter is true, failing to have the required modules
  (or the right versions thereof) will be fatal. C<perl Makefile.PL>
  will C<die> instead of simply informing the user of the missing dependencies.
  
  It is I<extremely> rare to have to use C<PREREQ_FATAL>. Its use by module
  authors is I<strongly discouraged> and should never be used lightly.
  
  For dependencies that are required in order to run C<Makefile.PL>,
  see C<CONFIGURE_REQUIRES>.
  
  Module installation tools have ways of resolving unmet dependencies but
  to do that they need a F<Makefile>.  Using C<PREREQ_FATAL> breaks this.
  That's bad.
  
  Assuming you have good test coverage, your tests should fail with
  missing dependencies informing the user more strongly that something
  is wrong.  You can write a F<t/00compile.t> test which will simply
  check that your code compiles and stop "make test" prematurely if it
  doesn't.  See L<Test::More/BAIL_OUT> for more details.
  
  
  =item PREREQ_PM
  
  A hash of modules that are needed to run your module.  The keys are
  the module names ie. Test::More, and the minimum version is the
  value. If the required version number is 0 any version will do.
  
  This will go into the C<requires> field of your F<META.yml> and the C<runtime> of the C<prereqs> field of your F<META.json>.
  
      PREREQ_PM => {
          # Require Test::More at least 0.47
          "Test::More" => "0.47",
  
          # Require any version of Acme::Buffy
          "Acme::Buffy" => 0,
      }
  
  =item PREREQ_PRINT
  
  Bool.  If this parameter is true, the prerequisites will be printed to
  stdout and MakeMaker will exit.  The output format is an evalable hash
  ref.
  
    $PREREQ_PM = {
                   'A::B' => Vers1,
                   'C::D' => Vers2,
                   ...
                 };
  
  If a distribution defines a minimal required perl version, this is
  added to the output as an additional line of the form:
  
    $MIN_PERL_VERSION = '5.008001';
  
  If BUILD_REQUIRES is not empty, it will be dumped as $BUILD_REQUIRES hashref.
  
  =item PRINT_PREREQ
  
  RedHatism for C<PREREQ_PRINT>.  The output format is different, though:
  
      perl(A::B)>=Vers1 perl(C::D)>=Vers2 ...
  
  A minimal required perl version, if present, will look like this:
  
      perl(perl)>=5.008001
  
  =item SITEPREFIX
  
  Like PERLPREFIX, but only for the site install locations.
  
  Defaults to $Config{siteprefixexp}.  Perls prior to 5.6.0 didn't have
  an explicit siteprefix in the Config.  In those cases
  $Config{installprefix} will be used.
  
  Overridable by PREFIX
  
  =item SIGN
  
  When true, perform the generation and addition to the MANIFEST of the
  SIGNATURE file in the distdir during 'make distdir', via 'cpansign
  -s'.
  
  Note that you need to install the Module::Signature module to
  perform this operation.
  
  Defaults to false.
  
  =item SKIP
  
  Arrayref. E.g. [qw(name1 name2)] skip (do not write) sections of the
  Makefile. Caution! Do not use the SKIP attribute for the negligible
  speedup. It may seriously damage the resulting Makefile. Only use it
  if you really need it.
  
  =item TEST_REQUIRES
  
  Available in version 6.64 and above.
  
  A hash of modules that are needed to test your module but not run or
  build it.
  
  This will go into the C<build_requires> field of your F<META.yml> and the C<test> of the C<prereqs> field of your F<META.json>.
  
  The format is the same as PREREQ_PM.
  
  =item TYPEMAPS
  
  Ref to array of typemap file names.  Use this when the typemaps are
  in some directory other than the current directory or when they are
  not named B<typemap>.  The last typemap in the list takes
  precedence.  A typemap in the current directory has highest
  precedence, even if it isn't listed in TYPEMAPS.  The default system
  typemap has lowest precedence.
  
  =item VENDORPREFIX
  
  Like PERLPREFIX, but only for the vendor install locations.
  
  Defaults to $Config{vendorprefixexp}.
  
  Overridable by PREFIX
  
  =item VERBINST
  
  If true, make install will be verbose
  
  =item VERSION
  
  Your version number for distributing the package.  This defaults to
  0.1.
  
  =item VERSION_FROM
  
  Instead of specifying the VERSION in the Makefile.PL you can let
  MakeMaker parse a file to determine the version number. The parsing
  routine requires that the file named by VERSION_FROM contains one
  single line to compute the version number. The first line in the file
  that contains something like a $VERSION assignment or C<package Name
  VERSION> will be used. The following lines will be parsed o.k.:
  
      # Good
      package Foo::Bar 1.23;                      # 1.23
      $VERSION   = '1.00';                        # 1.00
      *VERSION   = \'1.01';                       # 1.01
      ($VERSION) = q$Revision$ =~ /(\d+)/g;       # The digits in $Revision$
      $FOO::VERSION = '1.10';                     # 1.10
      *FOO::VERSION = \'1.11';                    # 1.11
  
  but these will fail:
  
      # Bad
      my $VERSION         = '1.01';
      local $VERSION      = '1.02';
      local $FOO::VERSION = '1.30';
  
  (Putting C<my> or C<local> on the preceding line will work o.k.)
  
  "Version strings" are incompatible and should not be used.
  
      # Bad
      $VERSION = 1.2.3;
      $VERSION = v1.2.3;
  
  L<version> objects are fine.  As of MakeMaker 6.35 version.pm will be
  automatically loaded, but you must declare the dependency on version.pm.
  For compatibility with older MakeMaker you should load on the same line
  as $VERSION is declared.
  
      # All on one line
      use version; our $VERSION = qv(1.2.3);
  
  The file named in VERSION_FROM is not added as a dependency to
  Makefile. This is not really correct, but it would be a major pain
  during development to have to rewrite the Makefile for any smallish
  change in that file. If you want to make sure that the Makefile
  contains the correct VERSION macro after any change of the file, you
  would have to do something like
  
      depend => { Makefile => '$(VERSION_FROM)' }
  
  See attribute C<depend> below.
  
  =item VERSION_SYM
  
  A sanitized VERSION with . replaced by _.  For places where . has
  special meaning (some filesystems, RCS labels, etc...)
  
  =item XS
  
  Hashref of .xs files. MakeMaker will default this.  e.g.
  
    {'name_of_file.xs' => 'name_of_file.c'}
  
  The .c files will automatically be included in the list of files
  deleted by a make clean.
  
  =item XSOPT
  
  String of options to pass to xsubpp.  This might include C<-C++> or
  C<-extern>.  Do not include typemaps here; the TYPEMAP parameter exists for
  that purpose.
  
  =item XSPROTOARG
  
  May be set to C<-protoypes>, C<-noprototypes> or the empty string.  The
  empty string is equivalent to the xsubpp default, or C<-noprototypes>.
  See the xsubpp documentation for details.  MakeMaker
  defaults to the empty string.
  
  =item XS_VERSION
  
  Your version number for the .xs file of this package.  This defaults
  to the value of the VERSION attribute.
  
  =back
  
  =head2 Additional lowercase attributes
  
  can be used to pass parameters to the methods which implement that
  part of the Makefile.  Parameters are specified as a hash ref but are
  passed to the method as a hash.
  
  =over 2
  
  =item clean
  
    {FILES => "*.xyz foo"}
  
  =item depend
  
    {ANY_TARGET => ANY_DEPENDENCY, ...}
  
  (ANY_TARGET must not be given a double-colon rule by MakeMaker.)
  
  =item dist
  
    {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => '.gz',
    SHAR => 'shar -m', DIST_CP => 'ln', ZIP => '/bin/zip',
    ZIPFLAGS => '-rl', DIST_DEFAULT => 'private tardist' }
  
  If you specify COMPRESS, then SUFFIX should also be altered, as it is
  needed to tell make the target file of the compression. Setting
  DIST_CP to ln can be useful, if you need to preserve the timestamps on
  your files. DIST_CP can take the values 'cp', which copies the file,
  'ln', which links the file, and 'best' which copies symbolic links and
  links the rest. Default is 'best'.
  
  =item dynamic_lib
  
    {ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'}
  
  =item linkext
  
    {LINKTYPE => 'static', 'dynamic' or ''}
  
  NB: Extensions that have nothing but *.pm files had to say
  
    {LINKTYPE => ''}
  
  with Pre-5.0 MakeMakers. Since version 5.00 of MakeMaker such a line
  can be deleted safely. MakeMaker recognizes when there's nothing to
  be linked.
  
  =item macro
  
    {ANY_MACRO => ANY_VALUE, ...}
  
  =item postamble
  
  Anything put here will be passed to MY::postamble() if you have one.
  
  =item realclean
  
    {FILES => '$(INST_ARCHAUTODIR)/*.xyz'}
  
  =item test
  
  Specify the targets for testing.
  
    {TESTS => 't/*.t'}
  
  C<RECURSIVE_TEST_FILES> can be used to include all directories
  recursively under C<t> that contain C<.t> files. It will be ignored if
  you provide your own C<TESTS> attribute, defaults to false.
  
    {RECURSIVE_TEST_FILES=>1}
  
  =item tool_autosplit
  
    {MAXLEN => 8}
  
  =back
  
  =head2 Overriding MakeMaker Methods
  
  If you cannot achieve the desired Makefile behaviour by specifying
  attributes you may define private subroutines in the Makefile.PL.
  Each subroutine returns the text it wishes to have written to
  the Makefile. To override a section of the Makefile you can
  either say:
  
          sub MY::c_o { "new literal text" }
  
  or you can edit the default by saying something like:
  
          package MY; # so that "SUPER" works right
          sub c_o {
              my $inherited = shift->SUPER::c_o(@_);
              $inherited =~ s/old text/new text/;
              $inherited;
          }
  
  If you are running experiments with embedding perl as a library into
  other applications, you might find MakeMaker is not sufficient. You'd
  better have a look at ExtUtils::Embed which is a collection of utilities
  for embedding.
  
  If you still need a different solution, try to develop another
  subroutine that fits your needs and submit the diffs to
  C<makemaker@perl.org>
  
  For a complete description of all MakeMaker methods see
  L<ExtUtils::MM_Unix>.
  
  Here is a simple example of how to add a new target to the generated
  Makefile:
  
      sub MY::postamble {
          return <<'MAKE_FRAG';
      $(MYEXTLIB): sdbm/Makefile
              cd sdbm && $(MAKE) all
  
      MAKE_FRAG
      }
  
  =head2 The End Of Cargo Cult Programming
  
  WriteMakefile() now does some basic sanity checks on its parameters to
  protect against typos and malformatted values.  This means some things
  which happened to work in the past will now throw warnings and
  possibly produce internal errors.
  
  Some of the most common mistakes:
  
  =over 2
  
  =item C<< MAN3PODS => ' ' >>
  
  This is commonly used to suppress the creation of man pages.  MAN3PODS
  takes a hash ref not a string, but the above worked by accident in old
  versions of MakeMaker.
  
  The correct code is C<< MAN3PODS => { } >>.
  
  =back
  
  
  =head2 Hintsfile support
  
  MakeMaker.pm uses the architecture-specific information from
  Config.pm. In addition it evaluates architecture specific hints files
  in a C<hints/> directory. The hints files are expected to be named
  like their counterparts in C<PERL_SRC/hints>, but with an C<.pl> file
  name extension (eg. C<next_3_2.pl>). They are simply C<eval>ed by
  MakeMaker within the WriteMakefile() subroutine, and can be used to
  execute commands as well as to include special variables. The rules
  which hintsfile is chosen are the same as in Configure.
  
  The hintsfile is eval()ed immediately after the arguments given to
  WriteMakefile are stuffed into a hash reference $self but before this
  reference becomes blessed. So if you want to do the equivalent to
  override or create an attribute you would say something like
  
      $self->{LIBS} = ['-ldbm -lucb -lc'];
  
  =head2 Distribution Support
  
  For authors of extensions MakeMaker provides several Makefile
  targets. Most of the support comes from the ExtUtils::Manifest module,
  where additional documentation can be found.
  
  =over 4
  
  =item    make distcheck
  
  reports which files are below the build directory but not in the
  MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for
  details)
  
  =item    make skipcheck
  
  reports which files are skipped due to the entries in the
  C<MANIFEST.SKIP> file (See ExtUtils::Manifest::skipcheck() for
  details)
  
  =item    make distclean
  
  does a realclean first and then the distcheck. Note that this is not
  needed to build a new distribution as long as you are sure that the
  MANIFEST file is ok.
  
  =item    make veryclean
  
  does a realclean first and then removes backup files such as C<*~>,
  C<*.bak>, C<*.old> and C<*.orig>
  
  =item    make manifest
  
  rewrites the MANIFEST file, adding all remaining files found (See
  ExtUtils::Manifest::mkmanifest() for details)
  
  =item    make distdir
  
  Copies all the files that are in the MANIFEST file to a newly created
  directory with the name C<$(DISTNAME)-$(VERSION)>. If that directory
  exists, it will be removed first.
  
  Additionally, it will create META.yml and META.json module meta-data file
  in the distdir and add this to the distdir's MANIFEST.  You can shut this
  behavior off with the NO_META flag.
  
  =item   make disttest
  
  Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and
  a make test in that directory.
  
  =item    make tardist
  
  First does a distdir. Then a command $(PREOP) which defaults to a null
  command, followed by $(TO_UNIX), which defaults to a null command under
  UNIX, and will convert files in distribution directory to UNIX format
  otherwise. Next it runs C<tar> on that directory into a tarfile and
  deletes the directory. Finishes with a command $(POSTOP) which
  defaults to a null command.
  
  =item    make dist
  
  Defaults to $(DIST_DEFAULT) which in turn defaults to tardist.
  
  =item    make uutardist
  
  Runs a tardist first and uuencodes the tarfile.
  
  =item    make shdist
  
  First does a distdir. Then a command $(PREOP) which defaults to a null
  command. Next it runs C<shar> on that directory into a sharfile and
  deletes the intermediate directory again. Finishes with a command
  $(POSTOP) which defaults to a null command.  Note: For shdist to work
  properly a C<shar> program that can handle directories is mandatory.
  
  =item    make zipdist
  
  First does a distdir. Then a command $(PREOP) which defaults to a null
  command. Runs C<$(ZIP) $(ZIPFLAGS)> on that directory into a
  zipfile. Then deletes that directory. Finishes with a command
  $(POSTOP) which defaults to a null command.
  
  =item    make ci
  
  Does a $(CI) and a $(RCS_LABEL) on all files in the MANIFEST file.
  
  =back
  
  Customization of the dist targets can be done by specifying a hash
  reference to the dist attribute of the WriteMakefile call. The
  following parameters are recognized:
  
      CI           ('ci -u')
      COMPRESS     ('gzip --best')
      POSTOP       ('@ :')
      PREOP        ('@ :')
      TO_UNIX      (depends on the system)
      RCS_LABEL    ('rcs -q -Nv$(VERSION_SYM):')
      SHAR         ('shar')
      SUFFIX       ('.gz')
      TAR          ('tar')
      TARFLAGS     ('cvf')
      ZIP          ('zip')
      ZIPFLAGS     ('-r')
  
  An example:
  
      WriteMakefile(
          ...other options...
          dist => {
              COMPRESS => "bzip2",
              SUFFIX   => ".bz2"
          }
      );
  
  
  =head2 Module Meta-Data (META and MYMETA)
  
  Long plaguing users of MakeMaker based modules has been the problem of
  getting basic information about the module out of the sources
  I<without> running the F<Makefile.PL> and doing a bunch of messy
  heuristics on the resulting F<Makefile>.  Over the years, it has become
  standard to keep this information in one or more CPAN Meta files
  distributed with each distribution.
  
  The original format of CPAN Meta files was L<YAML> and the corresponding
  file was called F<META.yml>.  In 2010, version 2 of the L<CPAN::Meta::Spec>
  was released, which mandates JSON format for the metadata in order to
  overcome certain compatibility issues between YAML serializers and to
  avoid breaking older clients unable to handle a new version of the spec.
  The L<CPAN::Meta> library is now standard for accessing old and new-style
  Meta files.
  
  If L<CPAN::Meta> is installed, MakeMaker will automatically generate
  F<META.json> and F<META.yml> files for you and add them to your F<MANIFEST> as
  part of the 'distdir' target (and thus the 'dist' target).  This is intended to
  seamlessly and rapidly populate CPAN with module meta-data.  If you wish to
  shut this feature off, set the C<NO_META> C<WriteMakefile()> flag to true.
  
  At the 2008 QA Hackathon in Oslo, Perl module toolchain maintainers agrees
  to use the CPAN Meta format to communicate post-configuration requirements
  between toolchain components.  These files, F<MYMETA.json> and F<MYMETA.yml>,
  are generated when F<Makefile.PL> generates a F<Makefile> (if L<CPAN::Meta>
  is installed).  Clients like L<CPAN> or L<CPANPLUS> will read this
  files to see what prerequisites must be fulfilled before building or testing
  the distribution.  If you with to shut this feature off, set the C<NO_MYMETA>
  C<WriteMakeFile()> flag to true.
  
  =head2 Disabling an extension
  
  If some events detected in F<Makefile.PL> imply that there is no way
  to create the Module, but this is a normal state of things, then you
  can create a F<Makefile> which does nothing, but succeeds on all the
  "usual" build targets.  To do so, use
  
      use ExtUtils::MakeMaker qw(WriteEmptyMakefile);
      WriteEmptyMakefile();
  
  instead of WriteMakefile().
  
  This may be useful if other modules expect this module to be I<built>
  OK, as opposed to I<work> OK (say, this system-dependent module builds
  in a subdirectory of some other distribution, or is listed as a
  dependency in a CPAN::Bundle, but the functionality is supported by
  different means on the current architecture).
  
  =head2 Other Handy Functions
  
  =over 4
  
  =item prompt
  
      my $value = prompt($message);
      my $value = prompt($message, $default);
  
  The C<prompt()> function provides an easy way to request user input
  used to write a makefile.  It displays the $message as a prompt for
  input.  If a $default is provided it will be used as a default.  The
  function returns the $value selected by the user.
  
  If C<prompt()> detects that it is not running interactively and there
  is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable
  is set to true, the $default will be used without prompting.  This
  prevents automated processes from blocking on user input.
  
  If no $default is provided an empty string will be used instead.
  
  =back
  
  =head2 Supported versions of Perl
  
  Please note that while this module works on Perl 5.6, it is no longer
  being routinely tested on 5.6 - the earliest Perl version being routinely
  tested, and expressly supported, is 5.8.1. However, patches to repair
  any breakage on 5.6 are still being accepted.
  
  =head1 ENVIRONMENT
  
  =over 4
  
  =item PERL_MM_OPT
  
  Command line options used by C<MakeMaker-E<gt>new()>, and thus by
  C<WriteMakefile()>.  The string is split as the shell would, and the result
  is processed before any actual command line arguments are processed.
  
    PERL_MM_OPT='CCFLAGS="-Wl,-rpath -Wl,/foo/bar/lib" LIBS="-lwibble -lwobble"'
  
  =item PERL_MM_USE_DEFAULT
  
  If set to a true value then MakeMaker's prompt function will
  always return the default without waiting for user input.
  
  =item PERL_CORE
  
  Same as the PERL_CORE parameter.  The parameter overrides this.
  
  =back
  
  =head1 SEE ALSO
  
  L<Module::Build> is a pure-Perl alternative to MakeMaker which does
  not rely on make or any other external utility.  It is easier to
  extend to suit your needs.
  
  L<Module::Install> is a wrapper around MakeMaker which adds features
  not normally available.
  
  L<ExtUtils::ModuleMaker> and L<Module::Starter> are both modules to
  help you setup your distribution.
  
  L<CPAN::Meta> and L<CPAN::Meta::Spec> explain CPAN Meta files in detail.
  
  L<File::ShareDir::Install> makes it easy to install static, sometimes
  also referred to as 'shared' files. L<File::ShareDir> helps accessing
  the shared files after installation.
  
  L<Dist::Zilla> makes it easy for the module author to create MakeMaker-based
  distributions with lots of bells and whistles.
  
  =head1 AUTHORS
  
  Andy Dougherty C<doughera@lafayette.edu>, Andreas KE<ouml>nig
  C<andreas.koenig@mind.de>, Tim Bunce C<timb@cpan.org>.  VMS
  support by Charles Bailey C<bailey@newman.upenn.edu>.  OS/2 support
  by Ilya Zakharevich C<ilya@math.ohio-state.edu>.
  
  Currently maintained by Michael G Schwern C<schwern@pobox.com>
  
  Send patches and ideas to C<makemaker@perl.org>.
  
  Send bug reports via http://rt.cpan.org/.  Please send your
  generated Makefile along with your report.
  
  For more up-to-date information, see L<https://metacpan.org/release/ExtUtils-MakeMaker>.
  
  Repository available at L<https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker>.
  
  =head1 LICENSE
  
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  See L<http://www.perl.com/perl/misc/Artistic.html>
  
  
  =cut
EXTUTILS_MAKEMAKER

$fatpacked{"ExtUtils/MakeMaker/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_CONFIG';
  package ExtUtils::MakeMaker::Config;
  
  use strict;
  
  our $VERSION = '7.04';
  
  use Config ();
  
  # Give us an overridable config.
  our %Config = %Config::Config;
  
  sub import {
      my $caller = caller;
  
      no strict 'refs';   ## no critic
      *{$caller.'::Config'} = \%Config;
  }
  
  1;
  
  
  =head1 NAME
  
  ExtUtils::MakeMaker::Config - Wrapper around Config.pm
  
  
  =head1 SYNOPSIS
  
    use ExtUtils::MakeMaker::Config;
    print $Config{installbin};  # or whatever
  
  
  =head1 DESCRIPTION
  
  B<FOR INTERNAL USE ONLY>
  
  A very thin wrapper around Config.pm so MakeMaker is easier to test.
  
  =cut
EXTUTILS_MAKEMAKER_CONFIG

$fatpacked{"ExtUtils/MakeMaker/Locale.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_LOCALE';
  package ExtUtils::MakeMaker::Locale;
  
  use strict;
  our $VERSION = "7.04";
  
  use base 'Exporter';
  our @EXPORT_OK = qw(
      decode_argv env
      $ENCODING_LOCALE $ENCODING_LOCALE_FS
      $ENCODING_CONSOLE_IN $ENCODING_CONSOLE_OUT
  );
  
  use Encode ();
  use Encode::Alias ();
  
  our $ENCODING_LOCALE;
  our $ENCODING_LOCALE_FS;
  our $ENCODING_CONSOLE_IN;
  our $ENCODING_CONSOLE_OUT;
  
  sub DEBUG () { 0 }
  
  sub _init {
      if ($^O eq "MSWin32") {
  	unless ($ENCODING_LOCALE) {
  	    # Try to obtain what the Windows ANSI code page is
  	    eval {
  		unless (defined &GetACP) {
  		    require Win32::API;
  		    Win32::API->Import('kernel32', 'int GetACP()');
  		};
  		if (defined &GetACP) {
  		    my $cp = GetACP();
  		    $ENCODING_LOCALE = "cp$cp" if $cp;
  		}
  	    };
  	}
  
  	unless ($ENCODING_CONSOLE_IN) {
  	    # If we have the Win32::Console module installed we can ask
  	    # it for the code set to use
  	    eval {
  		require Win32::Console;
  		my $cp = Win32::Console::InputCP();
  		$ENCODING_CONSOLE_IN = "cp$cp" if $cp;
  		$cp = Win32::Console::OutputCP();
  		$ENCODING_CONSOLE_OUT = "cp$cp" if $cp;
  	    };
  	    # Invoking the 'chcp' program might also work
  	    if (!$ENCODING_CONSOLE_IN && (qx(chcp) || '') =~ /^Active code page: (\d+)/) {
  		$ENCODING_CONSOLE_IN = "cp$1";
  	    }
  	}
      }
  
      unless ($ENCODING_LOCALE) {
  	eval {
  	    require I18N::Langinfo;
  	    $ENCODING_LOCALE = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
  
  	    # Workaround of Encode < v2.25.  The "646" encoding  alias was
  	    # introduced in Encode-2.25, but we don't want to require that version
  	    # quite yet.  Should avoid the CPAN testers failure reported from
  	    # openbsd-4.7/perl-5.10.0 combo.
  	    $ENCODING_LOCALE = "ascii" if $ENCODING_LOCALE eq "646";
  
  	    # https://rt.cpan.org/Ticket/Display.html?id=66373
  	    $ENCODING_LOCALE = "hp-roman8" if $^O eq "hpux" && $ENCODING_LOCALE eq "roman8";
  	};
  	$ENCODING_LOCALE ||= $ENCODING_CONSOLE_IN;
      }
  
      if ($^O eq "darwin") {
  	$ENCODING_LOCALE_FS ||= "UTF-8";
      }
  
      # final fallback
      $ENCODING_LOCALE ||= $^O eq "MSWin32" ? "cp1252" : "UTF-8";
      $ENCODING_LOCALE_FS ||= $ENCODING_LOCALE;
      $ENCODING_CONSOLE_IN ||= $ENCODING_LOCALE;
      $ENCODING_CONSOLE_OUT ||= $ENCODING_CONSOLE_IN;
  
      unless (Encode::find_encoding($ENCODING_LOCALE)) {
  	my $foundit;
  	if (lc($ENCODING_LOCALE) eq "gb18030") {
  	    eval {
  		require Encode::HanExtra;
  	    };
  	    if ($@) {
  		die "Need Encode::HanExtra to be installed to support locale codeset ($ENCODING_LOCALE), stopped";
  	    }
  	    $foundit++ if Encode::find_encoding($ENCODING_LOCALE);
  	}
  	die "The locale codeset ($ENCODING_LOCALE) isn't one that perl can decode, stopped"
  	    unless $foundit;
  
      }
  
      # use Data::Dump; ddx $ENCODING_LOCALE, $ENCODING_LOCALE_FS, $ENCODING_CONSOLE_IN, $ENCODING_CONSOLE_OUT;
  }
  
  _init();
  Encode::Alias::define_alias(sub {
      no strict 'refs';
      no warnings 'once';
      return ${"ENCODING_" . uc(shift)};
  }, "locale");
  
  sub _flush_aliases {
      no strict 'refs';
      for my $a (keys %Encode::Alias::Alias) {
  	if (defined ${"ENCODING_" . uc($a)}) {
  	    delete $Encode::Alias::Alias{$a};
  	    warn "Flushed alias cache for $a" if DEBUG;
  	}
      }
  }
  
  sub reinit {
      $ENCODING_LOCALE = shift;
      $ENCODING_LOCALE_FS = shift;
      $ENCODING_CONSOLE_IN = $ENCODING_LOCALE;
      $ENCODING_CONSOLE_OUT = $ENCODING_LOCALE;
      _init();
      _flush_aliases();
  }
  
  sub decode_argv {
      die if defined wantarray;
      for (@ARGV) {
  	$_ = Encode::decode(locale => $_, @_);
      }
  }
  
  sub env {
      my $k = Encode::encode(locale => shift);
      my $old = $ENV{$k};
      if (@_) {
  	my $v = shift;
  	if (defined $v) {
  	    $ENV{$k} = Encode::encode(locale => $v);
  	}
  	else {
  	    delete $ENV{$k};
  	}
      }
      return Encode::decode(locale => $old) if defined wantarray;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  ExtUtils::MakeMaker::Locale - bundled Encode::Locale
  
  =head1 SYNOPSIS
  
    use Encode::Locale;
    use Encode;
  
    $string = decode(locale => $bytes);
    $bytes = encode(locale => $string);
  
    if (-t) {
        binmode(STDIN, ":encoding(console_in)");
        binmode(STDOUT, ":encoding(console_out)");
        binmode(STDERR, ":encoding(console_out)");
    }
  
    # Processing file names passed in as arguments
    my $uni_filename = decode(locale => $ARGV[0]);
    open(my $fh, "<", encode(locale_fs => $uni_filename))
       || die "Can't open '$uni_filename': $!";
    binmode($fh, ":encoding(locale)");
    ...
  
  =head1 DESCRIPTION
  
  In many applications it's wise to let Perl use Unicode for the strings it
  processes.  Most of the interfaces Perl has to the outside world are still byte
  based.  Programs therefore need to decode byte strings that enter the program
  from the outside and encode them again on the way out.
  
  The POSIX locale system is used to specify both the language conventions
  requested by the user and the preferred character set to consume and
  output.  The C<Encode::Locale> module looks up the charset and encoding (called
  a CODESET in the locale jargon) and arranges for the L<Encode> module to know
  this encoding under the name "locale".  It means bytes obtained from the
  environment can be converted to Unicode strings by calling C<<
  Encode::encode(locale => $bytes) >> and converted back again with C<<
  Encode::decode(locale => $string) >>.
  
  Where file systems interfaces pass file names in and out of the program we also
  need care.  The trend is for operating systems to use a fixed file encoding
  that don't actually depend on the locale; and this module determines the most
  appropriate encoding for file names. The L<Encode> module will know this
  encoding under the name "locale_fs".  For traditional Unix systems this will
  be an alias to the same encoding as "locale".
  
  For programs running in a terminal window (called a "Console" on some systems)
  the "locale" encoding is usually a good choice for what to expect as input and
  output.  Some systems allows us to query the encoding set for the terminal and
  C<Encode::Locale> will do that if available and make these encodings known
  under the C<Encode> aliases "console_in" and "console_out".  For systems where
  we can't determine the terminal encoding these will be aliased as the same
  encoding as "locale".  The advice is to use "console_in" for input known to
  come from the terminal and "console_out" for output known to go from the
  terminal.
  
  In addition to arranging for various Encode aliases the following functions and
  variables are provided:
  
  =over
  
  =item decode_argv( )
  
  =item decode_argv( Encode::FB_CROAK )
  
  This will decode the command line arguments to perl (the C<@ARGV> array) in-place.
  
  The function will by default replace characters that can't be decoded by
  "\x{FFFD}", the Unicode replacement character.
  
  Any argument provided is passed as CHECK to underlying Encode::decode() call.
  Pass the value C<Encode::FB_CROAK> to have the decoding croak if not all the
  command line arguments can be decoded.  See L<Encode/"Handling Malformed Data">
  for details on other options for CHECK.
  
  =item env( $uni_key )
  
  =item env( $uni_key => $uni_value )
  
  Interface to get/set environment variables.  Returns the current value as a
  Unicode string. The $uni_key and $uni_value arguments are expected to be
  Unicode strings as well.  Passing C<undef> as $uni_value deletes the
  environment variable named $uni_key.
  
  The returned value will have the characters that can't be decoded replaced by
  "\x{FFFD}", the Unicode replacement character.
  
  There is no interface to request alternative CHECK behavior as for
  decode_argv().  If you need that you need to call encode/decode yourself.
  For example:
  
      my $key = Encode::encode(locale => $uni_key, Encode::FB_CROAK);
      my $uni_value = Encode::decode(locale => $ENV{$key}, Encode::FB_CROAK);
  
  =item reinit( )
  
  =item reinit( $encoding )
  
  Reinitialize the encodings from the locale.  You want to call this function if
  you changed anything in the environment that might influence the locale.
  
  This function will croak if the determined encoding isn't recognized by
  the Encode module.
  
  With argument force $ENCODING_... variables to set to the given value.
  
  =item $ENCODING_LOCALE
  
  The encoding name determined to be suitable for the current locale.
  L<Encode> know this encoding as "locale".
  
  =item $ENCODING_LOCALE_FS
  
  The encoding name determined to be suiteable for file system interfaces
  involving file names.
  L<Encode> know this encoding as "locale_fs".
  
  =item $ENCODING_CONSOLE_IN
  
  =item $ENCODING_CONSOLE_OUT
  
  The encodings to be used for reading and writing output to the a console.
  L<Encode> know these encodings as "console_in" and "console_out".
  
  =back
  
  =head1 NOTES
  
  This table summarizes the mapping of the encodings set up
  by the C<Encode::Locale> module:
  
    Encode      |         |              |
    Alias       | Windows | Mac OS X     | POSIX
    ------------+---------+--------------+------------
    locale      | ANSI    | nl_langinfo  | nl_langinfo
    locale_fs   | ANSI    | UTF-8        | nl_langinfo
    console_in  | OEM     | nl_langinfo  | nl_langinfo
    console_out | OEM     | nl_langinfo  | nl_langinfo
  
  =head2 Windows
  
  Windows has basically 2 sets of APIs.  A wide API (based on passing UTF-16
  strings) and a byte based API based a character set called ANSI.  The
  regular Perl interfaces to the OS currently only uses the ANSI APIs.
  Unfortunately ANSI is not a single character set.
  
  The encoding that corresponds to ANSI varies between different editions of
  Windows.  For many western editions of Windows ANSI corresponds to CP-1252
  which is a character set similar to ISO-8859-1.  Conceptually the ANSI
  character set is a similar concept to the POSIX locale CODESET so this module
  figures out what the ANSI code page is and make this available as
  $ENCODING_LOCALE and the "locale" Encoding alias.
  
  Windows systems also operate with another byte based character set.
  It's called the OEM code page.  This is the encoding that the Console
  takes as input and output.  It's common for the OEM code page to
  differ from the ANSI code page.
  
  =head2 Mac OS X
  
  On Mac OS X the file system encoding is always UTF-8 while the locale
  can otherwise be set up as normal for POSIX systems.
  
  File names on Mac OS X will at the OS-level be converted to
  NFD-form.  A file created by passing a NFC-filename will come
  in NFD-form from readdir().  See L<Unicode::Normalize> for details
  of NFD/NFC.
  
  Actually, Apple does not follow the Unicode NFD standard since not all
  character ranges are decomposed.  The claim is that this avoids problems with
  round trip conversions from old Mac text encodings.  See L<Encode::UTF8Mac> for
  details.
  
  =head2 POSIX (Linux and other Unixes)
  
  File systems might vary in what encoding is to be used for
  filenames.  Since this module has no way to actually figure out
  what the is correct it goes with the best guess which is to
  assume filenames are encoding according to the current locale.
  Users are advised to always specify UTF-8 as the locale charset.
  
  =head1 SEE ALSO
  
  L<I18N::Langinfo>, L<Encode>
  
  =head1 AUTHOR
  
  Copyright 2010 Gisle Aas <gisle@aas.no>.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
EXTUTILS_MAKEMAKER_LOCALE

$fatpacked{"ExtUtils/MakeMaker/version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_VERSION';
  #--------------------------------------------------------------------------#
  # This is a modified copy of version.pm 0.9909, bundled exclusively for
  # use by ExtUtils::Makemaker and its dependencies to bootstrap when
  # version.pm is not available.  It should not be used by ordinary modules.
  #
  # When loaded, it will try to load version.pm.  If that fails, it will load
  # ExtUtils::MakeMaker::version::vpp and alias various *version functions
  # to functions in that module.  It will also override UNIVERSAL::VERSION.
  #--------------------------------------------------------------------------#
  
  package ExtUtils::MakeMaker::version;
  
  use 5.006002;
  use strict;
  
  use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
  
  $VERSION = '7.04';
  $CLASS = 'version';
  
  {
      local $SIG{'__DIE__'};
      eval "use version";
      if ( $@ ) { # don't have any version.pm installed
          eval "use ExtUtils::MakeMaker::version::vpp";
          die "$@" if ( $@ );
          local $^W;
          delete $INC{'version.pm'};
          $INC{'version.pm'} = $INC{'ExtUtils/MakeMaker/version.pm'};
          push @version::ISA, "ExtUtils::MakeMaker::version::vpp";
          $version::VERSION = $VERSION;
          *version::qv = \&ExtUtils::MakeMaker::version::vpp::qv;
          *version::declare = \&ExtUtils::MakeMaker::version::vpp::declare;
          *version::_VERSION = \&ExtUtils::MakeMaker::version::vpp::_VERSION;
          *version::vcmp = \&ExtUtils::MakeMaker::version::vpp::vcmp;
          *version::new = \&ExtUtils::MakeMaker::version::vpp::new;
          if ($] >= 5.009000) {
              no strict 'refs';
              *version::stringify = \&ExtUtils::MakeMaker::version::vpp::stringify;
              *{'version::(""'} = \&ExtUtils::MakeMaker::version::vpp::stringify;
              *{'version::(<=>'} = \&ExtUtils::MakeMaker::version::vpp::vcmp;
              *version::parse = \&ExtUtils::MakeMaker::version::vpp::parse;
          }
          require ExtUtils::MakeMaker::version::regex;
          *version::is_lax = \&ExtUtils::MakeMaker::version::regex::is_lax;
          *version::is_strict = \&ExtUtils::MakeMaker::version::regex::is_strict;
          *LAX = \$ExtUtils::MakeMaker::version::regex::LAX;
          *STRICT = \$ExtUtils::MakeMaker::version::regex::STRICT;
      }
      elsif ( ! version->can('is_qv') ) {
          *version::is_qv = sub { exists $_[0]->{qv} };
      }
  }
  
  1;
EXTUTILS_MAKEMAKER_VERSION

$fatpacked{"ExtUtils/MakeMaker/version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_VERSION_REGEX';
  #--------------------------------------------------------------------------#
  # This is a modified copy of version.pm 0.9909, bundled exclusively for
  # use by ExtUtils::Makemaker and its dependencies to bootstrap when
  # version.pm is not available.  It should not be used by ordinary modules.
  #--------------------------------------------------------------------------#
  
  package ExtUtils::MakeMaker::version::regex;
  
  use strict;
  
  use vars qw($VERSION $CLASS $STRICT $LAX);
  
  $VERSION = '7.04';
  
  #--------------------------------------------------------------------------#
  # 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;
  
  #--------------------------------------------------------------------------#
  
  # Preloaded methods go here.
  sub is_strict	{ defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
  sub is_lax	{ defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
  
  1;
EXTUTILS_MAKEMAKER_VERSION_REGEX

$fatpacked{"ExtUtils/MakeMaker/version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MAKEMAKER_VERSION_VPP';
  #--------------------------------------------------------------------------#
  # This is a modified copy of version.pm 0.9909, bundled exclusively for
  # use by ExtUtils::Makemaker and its dependencies to bootstrap when
  # version.pm is not available.  It should not be used by ordinary modules.
  #--------------------------------------------------------------------------#
  
  package ExtUtils::MakeMaker::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 ExtUtils::MakeMaker::version::vpp;
  
  use 5.006002;
  use strict;
  
  use Config;
  use vars qw($VERSION $CLASS @ISA $LAX $STRICT);
  $VERSION = '7.04';
  $CLASS = 'ExtUtils::MakeMaker::version::vpp';
  
  require ExtUtils::MakeMaker::version::regex;
  *ExtUtils::MakeMaker::version::vpp::is_strict = \&ExtUtils::MakeMaker::version::regex::is_strict;
  *ExtUtils::MakeMaker::version::vpp::is_lax = \&ExtUtils::MakeMaker::version::regex::is_lax;
  *LAX = \$ExtUtils::MakeMaker::version::regex::LAX;
  *STRICT = \$ExtUtils::MakeMaker::version::regex::STRICT;
  
  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;
      ';
  }
  
  sub import {
      no strict 'refs';
      my ($class) = shift;
  
      # Set up any derived class
      unless ($class eq $CLASS) {
  	local $^W;
  	*{$class.'::declare'} =  \&{$CLASS.'::declare'};
  	*{$class.'::qv'} = \&{$CLASS.'::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
  		= \&{$CLASS.'::_VERSION'};
      }
  
      if (exists($args{'VERSION'})) {
  	*{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
      }
  
      if (exists($args{'is_strict'})) {
  	*{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
  	  unless defined(&{$callpkg.'::is_strict'});
      }
  
      if (exists($args{'is_lax'})) {
  	*{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
  	  unless defined(&{$callpkg.'::is_lax'});
      }
  }
  
  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 ExtUtils::MakeMaker::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') {
  	    require 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 = shift;
      unless (defined $class or $#_ > 1) {
  	require Carp;
  	Carp::croak('Usage: version::new(class, version)');
      }
  
      my $self = bless ({}, ref ($class) || $class);
      my $qv = FALSE;
  
      if ( $#_ == 1 ) { # must be CVS-style
  	$qv = TRUE;
      }
      my $value = pop; # always going to be the last element
  
      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;
      }
  
      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 (ref($value) =~ m/ARRAY|HASH/) {
  	require Carp;
  	Carp::croak("Invalid version format (non-numeric data)");
      }
  
      $value = _un_vstring($value);
  
      if ($Config{d_setlocale} && eval { require POSIX } ) {
        require locale;
  	my $currlocale = POSIX::setlocale(&POSIX::LC_ALL);
  
  	# if the current locale uses commas for decimal points, we
  	# just replace commas with decimal places, rather than changing
  	# locales
  	if ( POSIX::localeconv()->{decimal_point} eq ',' ) {
  	    $value =~ tr/,/./;
  	}
      }
  
      # 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 = $CLASS;
      if (@_) {
  	$class = ref($value) || $value;
  	$value = shift;
      }
  
      $value = _un_vstring($value);
      $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
      my $obj = $CLASS->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 ExtUtils::MakeMaker::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 = ExtUtils::MakeMaker::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 = ExtUtils::MakeMaker::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
EXTUTILS_MAKEMAKER_VERSION_VPP

$fatpacked{"ExtUtils/Manifest.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MANIFEST';
  package ExtUtils::Manifest;
  
  require Exporter;
  use Config;
  use File::Basename;
  use File::Copy 'copy';
  use File::Find;
  use File::Spec;
  use Carp;
  use strict;
  use warnings;
  
  our $VERSION = '1.65';
  our @ISA = ('Exporter');
  our @EXPORT_OK = qw(mkmanifest
                  manicheck  filecheck  fullcheck  skipcheck
                  manifind   maniread   manicopy   maniadd
                  maniskip
                 );
  
  our $Is_MacOS = $^O eq 'MacOS';
  our $Is_VMS   = $^O eq 'VMS';
  our $Is_VMS_mode = 0;
  our $Is_VMS_lc = 0;
  our $Is_VMS_nodot = 0;  # No dots in dir names or double dots in files
  
  if ($Is_VMS) {
      require VMS::Filespec if $Is_VMS;
      my $vms_unix_rpt;
      my $vms_efs;
      my $vms_case;
  
      $Is_VMS_mode = 1;
      $Is_VMS_lc = 1;
      $Is_VMS_nodot = 1;
      if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
          $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
          $vms_efs = VMS::Feature::current("efs_charset");
          $vms_case = VMS::Feature::current("efs_case_preserve");
      } else {
          my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
          my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
          my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
          $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
          $vms_efs = $efs_charset =~ /^[ET1]/i;
          $vms_case = $efs_case =~ /^[ET1]/i;
      }
      $Is_VMS_lc = 0 if ($vms_case);
      $Is_VMS_mode = 0 if ($vms_unix_rpt);
      $Is_VMS_nodot = 0 if ($vms_efs);
  }
  
  our $Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
  our $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
                     $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
  our $Quiet = 0;
  our $MANIFEST = 'MANIFEST';
  
  our $DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" );
  
  
  =head1 NAME
  
  ExtUtils::Manifest - utilities to write and check a MANIFEST file
  
  =head1 SYNOPSIS
  
      use ExtUtils::Manifest qw(...funcs to import...);
  
      mkmanifest();
  
      my @missing_files    = manicheck;
      my @skipped          = skipcheck;
      my @extra_files      = filecheck;
      my($missing, $extra) = fullcheck;
  
      my $found    = manifind();
  
      my $manifest = maniread();
  
      manicopy($read,$target);
  
      maniadd({$file => $comment, ...});
  
  
  =head1 DESCRIPTION
  
  =head2 Functions
  
  ExtUtils::Manifest exports no functions by default.  The following are
  exported on request
  
  =over 4
  
  =item mkmanifest
  
      mkmanifest();
  
  Writes all files in and below the current directory to your F<MANIFEST>.
  It works similar to the result of the Unix command
  
      find . > MANIFEST
  
  All files that match any regular expression in a file F<MANIFEST.SKIP>
  (if it exists) are ignored.
  
  Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.
  
  =cut
  
  sub _sort {
      return sort { lc $a cmp lc $b } @_;
  }
  
  sub mkmanifest {
      my $manimiss = 0;
      my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
      $read = {} if $manimiss;
      local *M;
      my $bakbase = $MANIFEST;
      $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots
      rename $MANIFEST, "$bakbase.bak" unless $manimiss;
      open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!";
      binmode M, ':raw';
      my $skip = maniskip();
      my $found = manifind();
      my($key,$val,$file,%all);
      %all = (%$found, %$read);
      $all{$MANIFEST} = ($Is_VMS_mode ? "$MANIFEST\t\t" : '') .
                       'This list of files'
          if $manimiss; # add new MANIFEST to known file list
      foreach $file (_sort keys %all) {
  	if ($skip->($file)) {
  	    # Policy: only remove files if they're listed in MANIFEST.SKIP.
  	    # Don't remove files just because they don't exist.
  	    warn "Removed from $MANIFEST: $file\n" if $Verbose and exists $read->{$file};
  	    next;
  	}
  	if ($Verbose){
  	    warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
  	}
  	my $text = $all{$file};
  	$file = _unmacify($file);
  	my $tabs = (5 - (length($file)+1)/8);
  	$tabs = 1 if $tabs < 1;
  	$tabs = 0 unless $text;
          if ($file =~ /\s/) {
              $file =~ s/([\\'])/\\$1/g;
              $file = "'$file'";
          }
  	print M $file, "\t" x $tabs, $text, "\n";
      }
      close M;
  }
  
  # Geez, shouldn't this use File::Spec or File::Basename or something?
  # Why so careful about dependencies?
  sub clean_up_filename {
    my $filename = shift;
    $filename =~ s|^\./||;
    $filename =~ s/^:([^:]+)$/$1/ if $Is_MacOS;
    if ( $Is_VMS ) {
        $filename =~ s/\.$//;                           # trim trailing dot
        $filename = VMS::Filespec::unixify($filename);  # unescape spaces, etc.
        if( $Is_VMS_lc ) {
            $filename = lc($filename);
            $filename = uc($filename) if $filename =~ /^MANIFEST(\.SKIP)?$/i;
        }
    }
    return $filename;
  }
  
  
  =item manifind
  
      my $found = manifind();
  
  returns a hash reference. The keys of the hash are the files found
  below the current directory.
  
  =cut
  
  sub manifind {
      my $p = shift || {};
      my $found = {};
  
      my $wanted = sub {
  	my $name = clean_up_filename($File::Find::name);
  	warn "Debug: diskfile $name\n" if $Debug;
  	return if -d $_;
  	$found->{$name} = "";
      };
  
      # We have to use "$File::Find::dir/$_" in preprocess, because
      # $File::Find::name is unavailable.
      # Also, it's okay to use / here, because MANIFEST files use Unix-style
      # paths.
      find({wanted => $wanted},
  	 $Is_MacOS ? ":" : ".");
  
      return $found;
  }
  
  
  =item manicheck
  
      my @missing_files = manicheck();
  
  checks if all the files within a C<MANIFEST> in the current directory
  really do exist. If C<MANIFEST> and the tree below the current
  directory are in sync it silently returns an empty list.
  Otherwise it returns a list of files which are listed in the
  C<MANIFEST> but missing from the directory, and by default also
  outputs these names to STDERR.
  
  =cut
  
  sub manicheck {
      return _check_files();
  }
  
  
  =item filecheck
  
      my @extra_files = filecheck();
  
  finds files below the current directory that are not mentioned in the
  C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be
  consulted. Any file matching a regular expression in such a file will
  not be reported as missing in the C<MANIFEST> file. The list of any
  extraneous files found is returned, and by default also reported to
  STDERR.
  
  =cut
  
  sub filecheck {
      return _check_manifest();
  }
  
  
  =item fullcheck
  
      my($missing, $extra) = fullcheck();
  
  does both a manicheck() and a filecheck(), returning then as two array
  refs.
  
  =cut
  
  sub fullcheck {
      return [_check_files()], [_check_manifest()];
  }
  
  
  =item skipcheck
  
      my @skipped = skipcheck();
  
  lists all the files that are skipped due to your C<MANIFEST.SKIP>
  file.
  
  =cut
  
  sub skipcheck {
      my($p) = @_;
      my $found = manifind();
      my $matches = maniskip();
  
      my @skipped = ();
      foreach my $file (_sort keys %$found){
          if (&$matches($file)){
              warn "Skipping $file\n" unless $Quiet;
              push @skipped, $file;
              next;
          }
      }
  
      return @skipped;
  }
  
  
  sub _check_files {
      my $p = shift;
      my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
      my $read = maniread() || {};
      my $found = manifind($p);
  
      my(@missfile) = ();
      foreach my $file (_sort keys %$read){
          warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
          if ($dosnames){
              $file = lc $file;
              $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
              $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
          }
          unless ( exists $found->{$file} ) {
              warn "No such file: $file\n" unless $Quiet;
              push @missfile, $file;
          }
      }
  
      return @missfile;
  }
  
  
  sub _check_manifest {
      my($p) = @_;
      my $read = maniread() || {};
      my $found = manifind($p);
      my $skip  = maniskip();
  
      my @missentry = ();
      foreach my $file (_sort keys %$found){
          next if $skip->($file);
          warn "Debug: manicheck checking from disk $file\n" if $Debug;
          unless ( exists $read->{$file} ) {
              my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
              warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
              push @missentry, $file;
          }
      }
  
      return @missentry;
  }
  
  
  =item maniread
  
      my $manifest = maniread();
      my $manifest = maniread($manifest_file);
  
  reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current
  directory) and returns a HASH reference with files being the keys and
  comments being the values of the HASH.  Blank lines and lines which
  start with C<#> in the C<MANIFEST> file are discarded.
  
  =cut
  
  sub maniread {
      my ($mfile) = @_;
      $mfile ||= $MANIFEST;
      my $read = {};
      local *M;
      unless (open M, "< $mfile"){
          warn "Problem opening $mfile: $!";
          return $read;
      }
      local $_;
      while (<M>){
          chomp;
          next if /^\s*#/;
  
          my($file, $comment);
  
          # filename may contain spaces if enclosed in ''
          # (in which case, \\ and \' are escapes)
          if (($file, $comment) = /^'(\\[\\']|.+)+'\s*(.*)/) {
              $file =~ s/\\([\\'])/$1/g;
          }
          else {
              ($file, $comment) = /^(\S+)\s*(.*)/;
          }
          next unless $file;
  
          if ($Is_MacOS) {
              $file = _macify($file);
              $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
          }
          elsif ($Is_VMS_mode) {
              require File::Basename;
              my($base,$dir) = File::Basename::fileparse($file);
              # Resolve illegal file specifications in the same way as tar
              if ($Is_VMS_nodot) {
                  $dir =~ tr/./_/;
                  my(@pieces) = split(/\./,$base);
                  if (@pieces > 2)
                      { $base = shift(@pieces) . '.' . join('_',@pieces); }
                  my $okfile = "$dir$base";
                  warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
                  $file = $okfile;
              }
              if( $Is_VMS_lc ) {
                  $file = lc($file);
                  $file = uc($file) if $file =~ /^MANIFEST(\.SKIP)?$/i;
              }
          }
  
          $read->{$file} = $comment;
      }
      close M;
      $read;
  }
  
  =item maniskip
  
      my $skipchk = maniskip();
      my $skipchk = maniskip($manifest_skip_file);
  
      if ($skipchk->($file)) { .. }
  
  reads a named C<MANIFEST.SKIP> file (defaults to C<MANIFEST.SKIP> in
  the current directory) and returns a CODE reference that tests whether
  a given filename should be skipped.
  
  =cut
  
  # returns an anonymous sub that decides if an argument matches
  sub maniskip {
      my @skip ;
      my $mfile = shift || "$MANIFEST.SKIP";
      _check_mskip_directives($mfile) if -f $mfile;
      local(*M, $_);
      open M, "< $mfile" or open M, "< $DEFAULT_MSKIP" or return sub {0};
      while (<M>){
        chomp;
        s/\r//;
        $_ =~ qr{^\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$};
        #my $comment = $3;
        my $filename = $2;
        if ( defined($1) ) {
          $filename = $1;
          $filename =~ s/\\(['\\])/$1/g;
        }
        next if (not defined($filename) or not $filename);
        push @skip, _macify($filename);
      }
      close M;
      return sub {0} unless (scalar @skip > 0);
  
      my $opts = $Is_VMS_mode ? '(?i)' : '';
  
      # Make sure each entry is isolated in its own parentheses, in case
      # any of them contain alternations
      my $regex = join '|', map "(?:$_)", @skip;
  
      return sub { $_[0] =~ qr{$opts$regex} };
  }
  
  # checks for the special directives
  #   #!include_default
  #   #!include /path/to/some/manifest.skip
  # in a custom MANIFEST.SKIP for, for including
  # the content of, respectively, the default MANIFEST.SKIP
  # and an external manifest.skip file
  sub _check_mskip_directives {
      my $mfile = shift;
      local (*M, $_);
      my @lines = ();
      my $flag = 0;
      unless (open M, "< $mfile") {
          warn "Problem opening $mfile: $!";
          return;
      }
      while (<M>) {
          if (/^#!include_default\s*$/) {
  	    if (my @default = _include_mskip_file()) {
  	        push @lines, @default;
  		warn "Debug: Including default MANIFEST.SKIP\n" if $Debug;
  		$flag++;
  	    }
  	    next;
          }
  	if (/^#!include\s+(.*)\s*$/) {
  	    my $external_file = $1;
  	    if (my @external = _include_mskip_file($external_file)) {
  	        push @lines, @external;
  		warn "Debug: Including external $external_file\n" if $Debug;
  		$flag++;
  	    }
              next;
          }
          push @lines, $_;
      }
      close M;
      return unless $flag;
      my $bakbase = $mfile;
      $bakbase =~ s/\./_/g if $Is_VMS_nodot;  # avoid double dots
      rename $mfile, "$bakbase.bak";
      warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug;
      unless (open M, "> $mfile") {
          warn "Problem opening $mfile: $!";
          return;
      }
      binmode M, ':raw';
      print M $_ for (@lines);
      close M;
      return;
  }
  
  # returns an array containing the lines of an external
  # manifest.skip file, if given, or $DEFAULT_MSKIP
  sub _include_mskip_file {
      my $mskip = shift || $DEFAULT_MSKIP;
      unless (-f $mskip) {
          warn qq{Included file "$mskip" not found - skipping};
          return;
      }
      local (*M, $_);
      unless (open M, "< $mskip") {
          warn "Problem opening $mskip: $!";
          return;
      }
      my @lines = ();
      push @lines, "\n#!start included $mskip\n";
      push @lines, $_ while <M>;
      close M;
      push @lines, "#!end included $mskip\n\n";
      return @lines;
  }
  
  =item manicopy
  
      manicopy(\%src, $dest_dir);
      manicopy(\%src, $dest_dir, $how);
  
  Copies the files that are the keys in %src to the $dest_dir.  %src is
  typically returned by the maniread() function.
  
      manicopy( maniread(), $dest_dir );
  
  This function is useful for producing a directory tree identical to the
  intended distribution tree.
  
  $how can be used to specify a different methods of "copying".  Valid
  values are C<cp>, which actually copies the files, C<ln> which creates
  hard links, and C<best> which mostly links the files but copies any
  symbolic link to make a tree without any symbolic link.  C<cp> is the
  default.
  
  =cut
  
  sub manicopy {
      my($read,$target,$how)=@_;
      croak "manicopy() called without target argument" unless defined $target;
      $how ||= 'cp';
      require File::Path;
      require File::Basename;
  
      $target = VMS::Filespec::unixify($target) if $Is_VMS_mode;
      File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755);
      foreach my $file (keys %$read){
  	if ($Is_MacOS) {
  	    if ($file =~ m!:!) {
  		my $dir = _maccat($target, $file);
  		$dir =~ s/[^:]+$//;
  		File::Path::mkpath($dir,1,0755);
  	    }
  	    cp_if_diff($file, _maccat($target, $file), $how);
  	} else {
  	    $file = VMS::Filespec::unixify($file) if $Is_VMS_mode;
  	    if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
  		my $dir = File::Basename::dirname($file);
  		$dir = VMS::Filespec::unixify($dir) if $Is_VMS_mode;
  		File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755);
  	    }
  	    cp_if_diff($file, "$target/$file", $how);
  	}
      }
  }
  
  sub cp_if_diff {
      my($from, $to, $how)=@_;
      if (! -f $from) {
          carp "$from not found";
          return;
      }
      my($diff) = 0;
      local(*F,*T);
      open(F,"< $from\0") or die "Can't read $from: $!\n";
      if (open(T,"< $to\0")) {
          local $_;
  	while (<F>) { $diff++,last if $_ ne <T>; }
  	$diff++ unless eof(T);
  	close T;
      }
      else { $diff++; }
      close F;
      if ($diff) {
  	if (-e $to) {
  	    unlink($to) or confess "unlink $to: $!";
  	}
          STRICT_SWITCH: {
  	    best($from,$to), last STRICT_SWITCH if $how eq 'best';
  	    cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
  	    ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
  	    croak("ExtUtils::Manifest::cp_if_diff " .
  		  "called with illegal how argument [$how]. " .
  		  "Legal values are 'best', 'cp', and 'ln'.");
  	}
      }
  }
  
  sub cp {
      my ($srcFile, $dstFile) = @_;
      my ($access,$mod) = (stat $srcFile)[8,9];
  
      copy($srcFile,$dstFile);
      utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
      _manicopy_chmod($srcFile, $dstFile);
  }
  
  
  sub ln {
      my ($srcFile, $dstFile) = @_;
      # Fix-me - VMS can support links.
      return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95());
      link($srcFile, $dstFile);
  
      unless( _manicopy_chmod($srcFile, $dstFile) ) {
          unlink $dstFile;
          return;
      }
      1;
  }
  
  # 1) Strip off all group and world permissions.
  # 2) Let everyone read it.
  # 3) If the owner can execute it, everyone can.
  sub _manicopy_chmod {
      my($srcFile, $dstFile) = @_;
  
      my $perm = 0444 | (stat $srcFile)[2] & 0700;
      chmod( $perm | ( $perm & 0100 ? 0111 : 0 ), $dstFile );
  }
  
  # Files that are often modified in the distdir.  Don't hard link them.
  my @Exceptions = qw(MANIFEST META.yml SIGNATURE);
  sub best {
      my ($srcFile, $dstFile) = @_;
  
      my $is_exception = grep $srcFile =~ /$_/, @Exceptions;
      if ($is_exception or !$Config{d_link} or -l $srcFile) {
  	cp($srcFile, $dstFile);
      } else {
  	ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
      }
  }
  
  sub _macify {
      my($file) = @_;
  
      return $file unless $Is_MacOS;
  
      $file =~ s|^\./||;
      if ($file =~ m|/|) {
  	$file =~ s|/+|:|g;
  	$file = ":$file";
      }
  
      $file;
  }
  
  sub _maccat {
      my($f1, $f2) = @_;
  
      return "$f1/$f2" unless $Is_MacOS;
  
      $f1 .= ":$f2";
      $f1 =~ s/([^:]:):/$1/g;
      return $f1;
  }
  
  sub _unmacify {
      my($file) = @_;
  
      return $file unless $Is_MacOS;
  
      $file =~ s|^:||;
      $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge;
      $file =~ y|:|/|;
  
      $file;
  }
  
  
  =item maniadd
  
    maniadd({ $file => $comment, ...});
  
  Adds an entry to an existing F<MANIFEST> unless its already there.
  
  $file will be normalized (ie. Unixified).  B<UNIMPLEMENTED>
  
  =cut
  
  sub maniadd {
      my($additions) = shift;
  
      _normalize($additions);
      _fix_manifest($MANIFEST);
  
      my $manifest = maniread();
      my @needed = grep { !exists $manifest->{$_} } keys %$additions;
      return 1 unless @needed;
  
      open(MANIFEST, ">>$MANIFEST") or
        die "maniadd() could not open $MANIFEST: $!";
      binmode MANIFEST, ':raw';
  
      foreach my $file (_sort @needed) {
          my $comment = $additions->{$file} || '';
          if ($file =~ /\s/) {
              $file =~ s/([\\'])/\\$1/g;
              $file = "'$file'";
          }
          printf MANIFEST "%-40s %s\n", $file, $comment;
      }
      close MANIFEST or die "Error closing $MANIFEST: $!";
  
      return 1;
  }
  
  
  # Make sure this MANIFEST is consistently written with native
  # newlines and has a terminal newline.
  sub _fix_manifest {
      my $manifest_file = shift;
  
      open MANIFEST, $MANIFEST or die "Could not open $MANIFEST: $!";
      local $/;
      my @manifest = split /(\015\012|\012|\015)/, <MANIFEST>, -1;
      close MANIFEST;
      my $must_rewrite = "";
      if ($manifest[-1] eq ""){
          # sane case: last line had a terminal newline
          pop @manifest;
          for (my $i=1; $i<=$#manifest; $i+=2) {
              unless ($manifest[$i] eq "\n") {
                  $must_rewrite = "not a newline at pos $i";
                  last;
              }
          }
      } else {
          $must_rewrite = "last line without newline";
      }
  
      if ( $must_rewrite ) {
          1 while unlink $MANIFEST; # avoid multiple versions on VMS
          open MANIFEST, ">", $MANIFEST or die "(must_rewrite=$must_rewrite) Could not open >$MANIFEST: $!";
  	binmode MANIFEST, ':raw';
          for (my $i=0; $i<=$#manifest; $i+=2) {
              print MANIFEST "$manifest[$i]\n";
          }
          close MANIFEST or die "could not write $MANIFEST: $!";
      }
  }
  
  
  # UNIMPLEMENTED
  sub _normalize {
      return;
  }
  
  
  =back
  
  =head2 MANIFEST
  
  A list of files in the distribution, one file per line.  The MANIFEST
  always uses Unix filepath conventions even if you're not on Unix.  This
  means F<foo/bar> style not F<foo\bar>.
  
  Anything between white space and an end of line within a C<MANIFEST>
  file is considered to be a comment.  Any line beginning with # is also
  a comment. Beginning with ExtUtils::Manifest 1.52, a filename may
  contain whitespace characters if it is enclosed in single quotes; single
  quotes or backslashes in that filename must be backslash-escaped.
  
      # this a comment
      some/file
      some/other/file            comment about some/file
      'some/third file'          comment
  
  
  =head2 MANIFEST.SKIP
  
  The file MANIFEST.SKIP may contain regular expressions of files that
  should be ignored by mkmanifest() and filecheck(). The regular
  expressions should appear one on each line. Blank lines and lines
  which start with C<#> are skipped.  Use C<\#> if you need a regular
  expression to start with a C<#>.
  
  For example:
  
      # Version control files and dirs.
      \bRCS\b
      \bCVS\b
      ,v$
      \B\.svn\b
  
      # Makemaker generated files and dirs.
      ^MANIFEST\.
      ^Makefile$
      ^blib/
      ^MakeMaker-\d
  
      # Temp, old and emacs backup files.
      ~$
      \.old$
      ^#.*#$
      ^\.#
  
  If no MANIFEST.SKIP file is found, a default set of skips will be
  used, similar to the example above.  If you want nothing skipped,
  simply make an empty MANIFEST.SKIP file.
  
  In one's own MANIFEST.SKIP file, certain directives
  can be used to include the contents of other MANIFEST.SKIP
  files. At present two such directives are recognized.
  
  =over 4
  
  =item #!include_default
  
  This inserts the contents of the default MANIFEST.SKIP file
  
  =item #!include /Path/to/another/manifest.skip
  
  This inserts the contents of the specified external file
  
  =back
  
  The included contents will be inserted into the MANIFEST.SKIP
  file in between I<#!start included /path/to/manifest.skip>
  and I<#!end included /path/to/manifest.skip> markers.
  The original MANIFEST.SKIP is saved as MANIFEST.SKIP.bak.
  
  =head2 EXPORT_OK
  
  C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
  C<&maniread>, and C<&manicopy> are exportable.
  
  =head2 GLOBAL VARIABLES
  
  C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
  results in both a different C<MANIFEST> and a different
  C<MANIFEST.SKIP> file. This is useful if you want to maintain
  different distributions for different audiences (say a user version
  and a developer version including RCS).
  
  C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
  all functions act silently.
  
  C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
  or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
  produced.
  
  =head1 DIAGNOSTICS
  
  All diagnostic output is sent to C<STDERR>.
  
  =over 4
  
  =item C<Not in MANIFEST:> I<file>
  
  is reported if a file is found which is not in C<MANIFEST>.
  
  =item C<Skipping> I<file>
  
  is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
  
  =item C<No such file:> I<file>
  
  is reported if a file mentioned in a C<MANIFEST> file does not
  exist.
  
  =item C<MANIFEST:> I<$!>
  
  is reported if C<MANIFEST> could not be opened.
  
  =item C<Added to MANIFEST:> I<file>
  
  is reported by mkmanifest() if $Verbose is set and a file is added
  to MANIFEST. $Verbose is set to 1 by default.
  
  =back
  
  =head1 ENVIRONMENT
  
  =over 4
  
  =item B<PERL_MM_MANIFEST_DEBUG>
  
  Turns on debugging
  
  =back
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
  
  =head1 AUTHOR
  
  Andreas Koenig C<andreas.koenig@anima.de>
  
  Maintained by Michael G Schwern C<schwern@pobox.com> within the
  ExtUtils-MakeMaker package and, as a separate CPAN package, by
  Randy Kobes C<r.kobes@uwinnipeg.ca>.
  
  =cut
  
  1;
EXTUTILS_MANIFEST

$fatpacked{"ExtUtils/Mkbootstrap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MKBOOTSTRAP';
  package ExtUtils::Mkbootstrap;
  
  # There's just too much Dynaloader incest here to turn on strict vars.
  use strict 'refs';
  
  our $VERSION = '7.04';
  
  require Exporter;
  our @ISA = ('Exporter');
  our @EXPORT = ('&Mkbootstrap');
  
  use Config;
  
  our $Verbose = 0;
  
  
  sub Mkbootstrap {
      my($baseext, @bsloadlibs)=@_;
      @bsloadlibs = grep($_, @bsloadlibs); # strip empty libs
  
      print "	bsloadlibs=@bsloadlibs\n" if $Verbose;
  
      # We need DynaLoader here because we and/or the *_BS file may
      # call dl_findfile(). We don't say `use' here because when
      # first building perl extensions the DynaLoader will not have
      # been built when MakeMaker gets first used.
      require DynaLoader;
  
      rename "$baseext.bs", "$baseext.bso"
        if -s "$baseext.bs";
  
      if (-f "${baseext}_BS"){
  	$_ = "${baseext}_BS";
  	package DynaLoader; # execute code as if in DynaLoader
  	local($osname, $dlsrc) = (); # avoid warnings
  	($osname, $dlsrc) = @Config::Config{qw(osname dlsrc)};
  	$bscode = "";
  	unshift @INC, ".";
  	require $_;
  	shift @INC;
      }
  
      if ($Config{'dlsrc'} =~ /^dl_dld/){
  	package DynaLoader;
  	push(@dl_resolve_using, dl_findfile('-lc'));
      }
  
      my(@all) = (@bsloadlibs, @DynaLoader::dl_resolve_using);
      my($method) = '';
      if (@all){
  	open my $bs, ">", "$baseext.bs"
  		or die "Unable to open $baseext.bs: $!";
  	print "Writing $baseext.bs\n";
  	print "	containing: @all" if $Verbose;
  	print $bs "# $baseext DynaLoader bootstrap file for $^O architecture.\n";
  	print $bs "# Do not edit this file, changes will be lost.\n";
  	print $bs "# This file was automatically generated by the\n";
  	print $bs "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$VERSION).\n";
  	print $bs "\@DynaLoader::dl_resolve_using = ";
  	# If @all contains names in the form -lxxx or -Lxxx then it's asking for
  	# runtime library location so we automatically add a call to dl_findfile()
  	if (" @all" =~ m/ -[lLR]/){
  	    print $bs "  dl_findfile(qw(\n  @all\n  ));\n";
  	}else{
  	    print $bs "  qw(@all);\n";
  	}
  	# write extra code if *_BS says so
  	print $bs $DynaLoader::bscode if $DynaLoader::bscode;
  	print $bs "\n1;\n";
  	close $bs;
      }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader
  
  =head1 SYNOPSIS
  
  C<Mkbootstrap>
  
  =head1 DESCRIPTION
  
  Mkbootstrap typically gets called from an extension Makefile.
  
  There is no C<*.bs> file supplied with the extension. Instead, there may
  be a C<*_BS> file which has code for the special cases, like posix for
  berkeley db on the NeXT.
  
  This file will get parsed, and produce a maybe empty
  C<@DynaLoader::dl_resolve_using> array for the current architecture.
  That will be extended by $BSLOADLIBS, which was computed by
  ExtUtils::Liblist::ext(). If this array still is empty, we do nothing,
  else we write a .bs file with an C<@DynaLoader::dl_resolve_using>
  array.
  
  The C<*_BS> file can put some code into the generated C<*.bs> file by
  placing it in C<$bscode>. This is a handy 'escape' mechanism that may
  prove useful in complex situations.
  
  If @DynaLoader::dl_resolve_using contains C<-L*> or C<-l*> entries then
  Mkbootstrap will automatically add a dl_findfile() call to the
  generated C<*.bs> file.
  
  =cut
EXTUTILS_MKBOOTSTRAP

$fatpacked{"ExtUtils/Mksymlists.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_MKSYMLISTS';
  package ExtUtils::Mksymlists;
  
  use 5.006;
  use strict qw[ subs refs ];
  # no strict 'vars';  # until filehandles are exempted
  
  use Carp;
  use Exporter;
  use Config;
  
  our @ISA = qw(Exporter);
  our @EXPORT = qw(&Mksymlists);
  our $VERSION = '7.04';
  
  sub Mksymlists {
      my(%spec) = @_;
      my($osname) = $^O;
  
      croak("Insufficient information specified to Mksymlists")
          unless ( $spec{NAME} or
                   ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) );
  
      $spec{DL_VARS} = [] unless $spec{DL_VARS};
      ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
      $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
      $spec{DL_FUNCS} = { $spec{NAME} => [] }
          unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
                   @{$spec{FUNCLIST}});
      if (defined $spec{DL_FUNCS}) {
          foreach my $package (sort keys %{$spec{DL_FUNCS}}) {
              my($packprefix,$bootseen);
              ($packprefix = $package) =~ s/\W/_/g;
              foreach my $sym (@{$spec{DL_FUNCS}->{$package}}) {
                  if ($sym =~ /^boot_/) {
                      push(@{$spec{FUNCLIST}},$sym);
                      $bootseen++;
                  }
                  else {
                      push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym");
                  }
              }
              push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
          }
      }
  
  #    We'll need this if we ever add any OS which uses mod2fname
  #    not as pseudo-builtin.
  #    require DynaLoader;
      if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
          $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
      }
  
      if    ($osname eq 'aix') { _write_aix(\%spec); }
      elsif ($osname eq 'MacOS'){ _write_aix(\%spec) }
      elsif ($osname eq 'VMS') { _write_vms(\%spec) }
      elsif ($osname eq 'os2') { _write_os2(\%spec) }
      elsif ($osname eq 'MSWin32') { _write_win32(\%spec) }
      else {
          croak("Don't know how to create linker option file for $osname\n");
      }
  }
  
  
  sub _write_aix {
      my($data) = @_;
  
      rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";
  
      open( my $exp, ">", "$data->{FILE}.exp")
          or croak("Can't create $data->{FILE}.exp: $!\n");
      print $exp join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
      print $exp join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
      close $exp;
  }
  
  
  sub _write_os2 {
      my($data) = @_;
      require Config;
      my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
  
      if (not $data->{DLBASE}) {
          ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
          $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
      }
      my $distname = $data->{DISTNAME} || $data->{NAME};
      $distname = "Distribution $distname";
      my $patchlevel = " pl$Config{perl_patchlevel}" || '';
      my $comment = sprintf "Perl (v%s%s%s) module %s",
        $Config::Config{version}, $threaded, $patchlevel, $data->{NAME};
      chomp $comment;
      if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') {
          $distname = 'perl5-porters@perl.org';
          $comment = "Core $comment";
      }
      $comment = "$comment (Perl-config: $Config{config_args})";
      $comment = substr($comment, 0, 200) . "...)" if length $comment > 203;
      rename "$data->{FILE}.def", "$data->{FILE}_def.old";
  
      open(my $def, ">", "$data->{FILE}.def")
          or croak("Can't create $data->{FILE}.def: $!\n");
      print $def "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
      print $def "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n";
      print $def "CODE LOADONCALL\n";
      print $def "DATA LOADONCALL NONSHARED MULTIPLE\n";
      print $def "EXPORTS\n  ";
      print $def join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
      print $def join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
      _print_imports($def, $data);
      close $def;
  }
  
  sub _print_imports {
      my ($def, $data)= @_;
      my $imports= $data->{IMPORTS}
          or return;
      if ( keys %$imports ) {
          print $def "IMPORTS\n";
          foreach my $name (sort keys %$imports) {
              print $def "  $name=$imports->{$name}\n";
          }
      }
  }
  
  sub _write_win32 {
      my($data) = @_;
  
      require Config;
      if (not $data->{DLBASE}) {
          ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
          $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
      }
      rename "$data->{FILE}.def", "$data->{FILE}_def.old";
  
      open( my $def, ">", "$data->{FILE}.def" )
          or croak("Can't create $data->{FILE}.def: $!\n");
      # put library name in quotes (it could be a keyword, like 'Alias')
      if ($Config::Config{'cc'} !~ /^gcc/i) {
          print $def "LIBRARY \"$data->{DLBASE}\"\n";
      }
      print $def "EXPORTS\n  ";
      my @syms;
      # Export public symbols both with and without underscores to
      # ensure compatibility between DLLs from Borland C and Visual C
      # NOTE: DynaLoader itself only uses the names without underscores,
      # so this is only to cover the case when the extension DLL may be
      # linked to directly from C. GSAR 97-07-10
  
      #bcc dropped in 5.16, so dont create useless extra symbols for export table
      unless($] >= 5.016) {
          if ($Config::Config{'cc'} =~ /^bcc/i) {
              push @syms, "_$_", "$_ = _$_"
                  for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}});
          }
          else {
              push @syms, "$_", "_$_ = $_"
                  for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}});
          }
      } else {
          push @syms, "$_"
              for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}});
      }
      print $def join("\n  ",@syms, "\n") if @syms;
      _print_imports($def, $data);
      close $def;
  }
  
  
  sub _write_vms {
      my($data) = @_;
  
      require Config; # a reminder for once we do $^O
      require ExtUtils::XSSymSet;
  
      my($isvax) = $Config::Config{'archname'} =~ /VAX/i;
      my($set) = new ExtUtils::XSSymSet;
  
      rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
  
      open(my $opt,">", "$data->{FILE}.opt")
          or croak("Can't create $data->{FILE}.opt: $!\n");
  
      # Options file declaring universal symbols
      # Used when linking shareable image for dynamic extension,
      # or when linking PerlShr into which we've added this package
      # as a static extension
      # We don't do anything to preserve order, so we won't relax
      # the GSMATCH criteria for a dynamic extension
  
      print $opt "case_sensitive=yes\n"
          if $Config::Config{d_vms_case_sensitive_symbols};
  
      foreach my $sym (@{$data->{FUNCLIST}}) {
          my $safe = $set->addsym($sym);
          if ($isvax) { print $opt "UNIVERSAL=$safe\n" }
          else        { print $opt "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
      }
  
      foreach my $sym (@{$data->{DL_VARS}}) {
          my $safe = $set->addsym($sym);
          print $opt "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
          if ($isvax) { print $opt "UNIVERSAL=$safe\n" }
          else        { print $opt "SYMBOL_VECTOR=($safe=DATA)\n"; }
      }
  
      close $opt;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  ExtUtils::Mksymlists - write linker options files for dynamic extension
  
  =head1 SYNOPSIS
  
      use ExtUtils::Mksymlists;
      Mksymlists(  NAME     => $name ,
                   DL_VARS  => [ $var1, $var2, $var3 ],
                   DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
                                 $pkg2 => [ $func3 ] );
  
  =head1 DESCRIPTION
  
  C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
  during the creation of shared libraries for dynamic extensions.  It is
  normally called from a MakeMaker-generated Makefile when the extension
  is built.  The linker option file is generated by calling the function
  C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
  It takes one argument, a list of key-value pairs, in which the following
  keys are recognized:
  
  =over 4
  
  =item DLBASE
  
  This item specifies the name by which the linker knows the
  extension, which may be different from the name of the
  extension itself (for instance, some linkers add an '_' to the
  name of the extension).  If it is not specified, it is derived
  from the NAME attribute.  It is presently used only by OS2 and Win32.
  
  =item DL_FUNCS
  
  This is identical to the DL_FUNCS attribute available via MakeMaker,
  from which it is usually taken.  Its value is a reference to an
  associative array, in which each key is the name of a package, and
  each value is an a reference to an array of function names which
  should be exported by the extension.  For instance, one might say
  C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
  Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>.  The
  function names should be identical to those in the XSUB code;
  C<Mksymlists> will alter the names written to the linker option
  file to match the changes made by F<xsubpp>.  In addition, if
  none of the functions in a list begin with the string B<boot_>,
  C<Mksymlists> will add a bootstrap function for that package,
  just as xsubpp does.  (If a B<boot_E<lt>pkgE<gt>> function is
  present in the list, it is passed through unchanged.)  If
  DL_FUNCS is not specified, it defaults to the bootstrap
  function for the extension specified in NAME.
  
  =item DL_VARS
  
  This is identical to the DL_VARS attribute available via MakeMaker,
  and, like DL_FUNCS, it is usually specified via MakeMaker.  Its
  value is a reference to an array of variable names which should
  be exported by the extension.
  
  =item FILE
  
  This key can be used to specify the name of the linker option file
  (minus the OS-specific extension), if for some reason you do not
  want to use the default value, which is the last word of the NAME
  attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>).
  
  =item FUNCLIST
  
  This provides an alternate means to specify function names to be
  exported from the extension.  Its value is a reference to an
  array of function names to be exported by the extension.  These
  names are passed through unaltered to the linker options file.
  Specifying a value for the FUNCLIST attribute suppresses automatic
  generation of the bootstrap function for the package. To still create
  the bootstrap name you have to specify the package name in the
  DL_FUNCS hash:
  
      Mksymlists(  NAME     => $name ,
  		 FUNCLIST => [ $func1, $func2 ],
                   DL_FUNCS => { $pkg => [] } );
  
  
  =item IMPORTS
  
  This attribute is used to specify names to be imported into the
  extension. It is currently only used by OS/2 and Win32.
  
  =item NAME
  
  This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which
  the linker option file will be produced.
  
  =back
  
  When calling C<Mksymlists>, one should always specify the NAME
  attribute.  In most cases, this is all that's necessary.  In
  the case of unusual extensions, however, the other attributes
  can be used to provide additional information to the linker.
  
  =head1 AUTHOR
  
  Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>>
  
  =head1 REVISION
  
  Last revised 14-Feb-1996, for Perl 5.002.
EXTUTILS_MKSYMLISTS

$fatpacked{"ExtUtils/testlib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_TESTLIB';
  package ExtUtils::testlib;
  
  use strict;
  use warnings;
  
  our $VERSION = '7.04';
  
  use Cwd;
  use File::Spec;
  
  # So the tests can chdir around and not break @INC.
  # We use getcwd() because otherwise rel2abs will blow up under taint
  # mode pre-5.8.  We detaint is so @INC won't be tainted.  This is
  # no worse, and probably better, than just shoving an untainted,
  # relative "blib/lib" onto @INC.
  my $cwd;
  BEGIN {
      ($cwd) = getcwd() =~ /(.*)/;
  }
  use lib map { File::Spec->rel2abs($_, $cwd) } qw(blib/arch blib/lib);
  1;
  __END__
  
  =head1 NAME
  
  ExtUtils::testlib - add blib/* directories to @INC
  
  =head1 SYNOPSIS
  
    use ExtUtils::testlib;
  
  =head1 DESCRIPTION
  
  After an extension has been built and before it is installed it may be
  desirable to test it bypassing C<make test>. By adding
  
      use ExtUtils::testlib;
  
  to a test program the intermediate directories used by C<make> are
  added to @INC.
  
EXTUTILS_TESTLIB

$fatpacked{"File/Copy/Recursive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_COPY_RECURSIVE';
  package File::Copy::Recursive;
  
  use strict;
  
  BEGIN {
      # Keep older versions of Perl from trying to use lexical warnings
      $INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006;
  }
  use warnings;
  
  use Carp;
  use File::Copy;
  use File::Spec;    #not really needed because File::Copy already gets it, but for good measure :)
  use Cwd ();
  
  use vars qw(
    @ISA      @EXPORT_OK $VERSION  $MaxDepth $KeepMode $CPRFComp $CopyLink
    $PFSCheck $RemvBase $NoFtlPth  $ForcePth $CopyLoop $RMTrgFil $RMTrgDir
    $CondCopy $BdTrgWrn $SkipFlop  $DirPerms
  );
  
  require Exporter;
  @ISA       = qw(Exporter);
  @EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir rcopy_glob rmove_glob);
  
  $VERSION = '0.45';
  
  $MaxDepth = 0;
  $KeepMode = 1;
  $CPRFComp = 0;
  $CopyLink = eval { local $SIG{'__DIE__'}; symlink '', ''; 1 } || 0;
  $PFSCheck = 1;
  $RemvBase = 0;
  $NoFtlPth = 0;
  $ForcePth = 0;
  $CopyLoop = 0;
  $RMTrgFil = 0;
  $RMTrgDir = 0;
  $CondCopy = {};
  $BdTrgWrn = 0;
  $SkipFlop = 0;
  $DirPerms = 0777;
  
  my $samecheck = sub {
      return 1 if $^O eq 'MSWin32';    # need better way to check for this on winders...
      return if @_ != 2 || !defined $_[0] || !defined $_[1];
      return if $_[0] eq $_[1];
  
      my $one = '';
      if ($PFSCheck) {
          $one = join( '-', ( stat $_[0] )[ 0, 1 ] ) || '';
          my $two = join( '-', ( stat $_[1] )[ 0, 1 ] ) || '';
          if ( $one eq $two && $one ) {
              carp "$_[0] and $_[1] are identical";
              return;
          }
      }
  
      if ( -d $_[0] && !$CopyLoop ) {
          $one = join( '-', ( stat $_[0] )[ 0, 1 ] ) if !$one;
          my $abs = File::Spec->rel2abs( $_[1] );
          my @pth = File::Spec->splitdir($abs);
          while (@pth) {
              if ( $pth[-1] eq '..' ) {    # cheaper than Cwd::realpath() plus we don't want to resolve symlinks at this point, right?
                  pop @pth;
                  pop @pth unless -l File::Spec->catdir(@pth);
                  next;
              }
              my $cur = File::Spec->catdir(@pth);
              last if !$cur;               # probably not necessary, but nice to have just in case :)
              my $two = join( '-', ( stat $cur )[ 0, 1 ] ) || '';
              if ( $one eq $two && $one ) {
  
                  # $! = 62; # Too many levels of symbolic links
                  carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";
                  return;
              }
  
              pop @pth;
          }
      }
  
      return 1;
  };
  
  my $glob = sub {
      my ( $do, $src_glob, @args ) = @_;
  
      local $CPRFComp = 1;
      require File::Glob;
  
      my @rt;
      for my $path ( File::Glob::bsd_glob($src_glob) ) {
          my @call = [ $do->( $path, @args ) ] or return;
          push @rt, \@call;
      }
  
      return @rt;
  };
  
  my $move = sub {
      my $fl = shift;
      my @x;
      if ($fl) {
          @x = fcopy(@_) or return;
      }
      else {
          @x = dircopy(@_) or return;
      }
      if (@x) {
          if ($fl) {
              unlink $_[0] or return;
          }
          else {
              pathrmdir( $_[0] ) or return;
          }
          if ($RemvBase) {
              my ( $volm, $path ) = File::Spec->splitpath( $_[0] );
              pathrm( File::Spec->catpath( $volm, $path, '' ), $ForcePth, $NoFtlPth ) or return;
          }
      }
      return wantarray ? @x : $x[0];
  };
  
  my $ok_todo_asper_condcopy = sub {
      my $org  = shift;
      my $copy = 1;
      if ( exists $CondCopy->{$org} ) {
          if ( $CondCopy->{$org}{'md5'} ) {
  
          }
          if ($copy) {
  
          }
      }
      return $copy;
  };
  
  sub fcopy {
      $samecheck->(@_) or return;
      if ( $RMTrgFil && ( -d $_[1] || -e $_[1] ) ) {
          my $trg = $_[1];
          if ( -d $trg ) {
              my @trgx = File::Spec->splitpath( $_[0] );
              $trg = File::Spec->catfile( $_[1], $trgx[$#trgx] );
          }
          $samecheck->( $_[0], $trg ) or return;
          if ( -e $trg ) {
              if ( $RMTrgFil == 1 ) {
                  unlink $trg or carp "\$RMTrgFil failed: $!";
              }
              else {
                  unlink $trg or return;
              }
          }
      }
      my ( $volm, $path ) = File::Spec->splitpath( $_[1] );
      if ( $path && !-d $path ) {
          pathmk( File::Spec->catpath( $volm, $path, '' ), $NoFtlPth );
      }
      if ( -l $_[0] && $CopyLink ) {
          my $target = readlink( shift() );
          ($target) = $target =~ m/(.*)/;    # mass-untaint is OK since we have to allow what the file system does
          carp "Copying a symlink ($_[0]) whose target does not exist"
            if !-e $target && $BdTrgWrn;
          my $new = shift();
          unlink $new if -l $new;
          symlink( $target, $new ) or return;
      }
      elsif ( -d $_[0] && -f $_[1] ) {
          return;
      }
      else {
          return if -d $_[0];                # address File::Copy::copy() bug outlined in https://rt.perl.org/Public/Bug/Display.html?id=132866
          copy(@_) or return;
  
          my @base_file = File::Spec->splitpath( $_[0] );
          my $mode_trg = -d $_[1] ? File::Spec->catfile( $_[1], $base_file[$#base_file] ) : $_[1];
  
          chmod scalar( ( stat( $_[0] ) )[2] ), $mode_trg if $KeepMode;
      }
      return wantarray ? ( 1, 0, 0 ) : 1;    # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings
  }
  
  sub rcopy {
      if ( -l $_[0] && $CopyLink ) {
          goto &fcopy;
      }
  
      goto &dircopy if -d $_[0] || substr( $_[0], ( 1 * -1 ), 1 ) eq '*';
      goto &fcopy;
  }
  
  sub rcopy_glob {
      $glob->( \&rcopy, @_ );
  }
  
  sub dircopy {
      if ( $RMTrgDir && -d $_[1] ) {
          if ( $RMTrgDir == 1 ) {
              pathrmdir( $_[1] ) or carp "\$RMTrgDir failed: $!";
          }
          else {
              pathrmdir( $_[1] ) or return;
          }
      }
      my $globstar = 0;
      my $_zero    = $_[0];
      my $_one     = $_[1];
      if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*' ) {
          $globstar = 1;
          $_zero = substr( $_zero, 0, ( length($_zero) - 1 ) );
      }
  
      $samecheck->( $_zero, $_[1] ) or return;
      if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) {
          $! = 20;
          return;
      }
  
      if ( !-d $_[1] ) {
          pathmk( $_[1], $NoFtlPth ) or return;
      }
      else {
          if ( $CPRFComp && !$globstar ) {
              my @parts = File::Spec->splitdir($_zero);
              while ( $parts[$#parts] eq '' ) { pop @parts; }
              $_one = File::Spec->catdir( $_[1], $parts[$#parts] );
          }
      }
      my $baseend = $_one;
      my $level   = 0;
      my $filen   = 0;
      my $dirn    = 0;
  
      my $recurs;    #must be my()ed before sub {} since it calls itself
      $recurs = sub {
          my ( $str, $end, $buf ) = @_;
          $filen++ if $end eq $baseend;
          $dirn++  if $end eq $baseend;
  
          $DirPerms = oct($DirPerms) if substr( $DirPerms, 0, 1 ) eq '0';
          mkdir( $end, $DirPerms ) or return if !-d $end;
          if ( $MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth ) {
              chmod scalar( ( stat($str) )[2] ), $end if $KeepMode;
              return ( $filen, $dirn, $level ) if wantarray;
              return $filen;
          }
  
          $level++;
  
          my @files;
          if ( $] < 5.006 ) {
              opendir( STR_DH, $str ) or return;
              @files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH) );
              closedir STR_DH;
          }
          else {
              opendir( my $str_dh, $str ) or return;
              @files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh) );
              closedir $str_dh;
          }
  
          for my $file (@files) {
              my ($file_ut) = $file =~ m{ (.*) }xms;
              my $org = File::Spec->catfile( $str, $file_ut );
              my $new = File::Spec->catfile( $end, $file_ut );
              if ( -l $org && $CopyLink ) {
                  my $target = readlink($org);
                  ($target) = $target =~ m/(.*)/;    # mass-untaint is OK since we have to allow what the file system does
                  carp "Copying a symlink ($org) whose target does not exist"
                    if !-e $target && $BdTrgWrn;
                  unlink $new if -l $new;
                  symlink( $target, $new ) or return;
              }
              elsif ( -d $org ) {
                  my $rc;
                  if ( !-w $org && $KeepMode ) {
                      local $KeepMode = 0;
                      $rc = $recurs->( $org, $new, $buf ) if defined $buf;
                      $rc = $recurs->( $org, $new ) if !defined $buf;
                      chmod scalar( ( stat($org) )[2] ), $new;
                  }
                  else {
                      $rc = $recurs->( $org, $new, $buf ) if defined $buf;
                      $rc = $recurs->( $org, $new ) if !defined $buf;
                  }
                  if ( !$rc ) {
                      if ($SkipFlop) {
                          next;
                      }
                      else {
                          return;
                      }
                  }
                  $filen++;
                  $dirn++;
              }
              else {
                  if ( $ok_todo_asper_condcopy->($org) ) {
                      if ($SkipFlop) {
                          fcopy( $org, $new, $buf ) or next if defined $buf;
                          fcopy( $org, $new ) or next if !defined $buf;
                      }
                      else {
                          fcopy( $org, $new, $buf ) or return if defined $buf;
                          fcopy( $org, $new ) or return if !defined $buf;
                      }
                      chmod scalar( ( stat($org) )[2] ), $new if $KeepMode;
                      $filen++;
                  }
              }
          }
          $level--;
          chmod scalar( ( stat($str) )[2] ), $end if $KeepMode;
          1;
  
      };
  
      $recurs->( $_zero, $_one, $_[2] ) or return;
      return wantarray ? ( $filen, $dirn, $level ) : $filen;
  }
  
  sub fmove { $move->( 1, @_ ) }
  
  sub rmove {
      if ( -l $_[0] && $CopyLink ) {
          goto &fmove;
      }
  
      goto &dirmove if -d $_[0] || substr( $_[0], ( 1 * -1 ), 1 ) eq '*';
      goto &fmove;
  }
  
  sub rmove_glob {
      $glob->( \&rmove, @_ );
  }
  
  sub dirmove { $move->( 0, @_ ) }
  
  sub pathmk {
      my ( $vol, $dir, $file ) = File::Spec->splitpath( shift() );
      my $nofatal = shift;
  
      $DirPerms = oct($DirPerms) if substr( $DirPerms, 0, 1 ) eq '0';
  
      if ( defined($dir) ) {
          my (@dirs) = File::Spec->splitdir($dir);
  
          for ( my $i = 0; $i < scalar(@dirs); $i++ ) {
              my $newdir = File::Spec->catdir( @dirs[ 0 .. $i ] );
              my $newpth = File::Spec->catpath( $vol, $newdir, "" );
  
              mkdir( $newpth, $DirPerms ) or return if !-d $newpth && !$nofatal;
              mkdir( $newpth, $DirPerms ) if !-d $newpth && $nofatal;
          }
      }
  
      if ( defined($file) ) {
          my $newpth = File::Spec->catpath( $vol, $dir, $file );
  
          mkdir( $newpth, $DirPerms ) or return if !-d $newpth && !$nofatal;
          mkdir( $newpth, $DirPerms ) if !-d $newpth && $nofatal;
      }
  
      1;
  }
  
  sub pathempty {
      my $pth = shift;
  
      my ( $orig_dev, $orig_ino ) = ( lstat $pth )[ 0, 1 ];
      return 2 if !-d _ || !defined($orig_dev) || ( $^O ne 'MSWin32' && !$orig_ino );    #stat.inode is 0 on Windows
  
      my $starting_point = Cwd::cwd();
      my ( $starting_dev, $starting_ino ) = ( lstat $starting_point )[ 0, 1 ];
      chdir($pth) or Carp::croak("Failed to change directory to “$pth”: $!");
      $pth = '.';
      _bail_if_changed( $pth, $orig_dev, $orig_ino );
  
      my @names;
      my $pth_dh;
      if ( $] < 5.006 ) {
          opendir( PTH_DH, $pth ) or return;
          @names = grep !/^\.\.?$/, readdir(PTH_DH);
          closedir PTH_DH;
      }
      else {
          opendir( $pth_dh, $pth ) or return;
          @names = grep !/^\.\.?$/, readdir($pth_dh);
          closedir $pth_dh;
      }
      _bail_if_changed( $pth, $orig_dev, $orig_ino );
  
      for my $name (@names) {
          my ($name_ut) = $name =~ m{ (.*) }xms;
          my $flpth = File::Spec->catdir( $pth, $name_ut );
  
          if ( -l $flpth ) {
              _bail_if_changed( $pth, $orig_dev, $orig_ino );
              unlink $flpth or return;
          }
          elsif ( -d $flpth ) {
              _bail_if_changed( $pth, $orig_dev, $orig_ino );
              pathrmdir($flpth) or return;
          }
          else {
              _bail_if_changed( $pth, $orig_dev, $orig_ino );
              unlink $flpth or return;
          }
      }
  
      chdir($starting_point) or Carp::croak("Failed to change directory to “$starting_point”: $!");
      _bail_if_changed( ".", $starting_dev, $starting_ino );
  
      return 1;
  }
  
  sub pathrm {
      my ( $path, $force, $nofail ) = @_;
  
      my ( $orig_dev, $orig_ino ) = ( lstat $path )[ 0, 1 ];
      return 2 if !-d _ || !defined($orig_dev) || !$orig_ino;
  
      # Manual test (I hate this function :/):
      #    sudo mkdir /foo && perl -MFile::Copy::Recursive=pathrm -le 'print pathrm("/foo",1)' && sudo rm -rf /foo
      if ( $force && File::Spec->file_name_is_absolute($path) ) {
          Carp::croak("pathrm() w/ force on abspath is not allowed");
      }
  
      my @pth = File::Spec->splitdir($path);
  
      my %fs_check;
      my $aggregate_path;
      for my $part (@pth) {
          $aggregate_path = defined $aggregate_path ? File::Spec->catdir( $aggregate_path, $part ) : $part;
          $fs_check{$aggregate_path} = [ ( lstat $aggregate_path )[ 0, 1 ] ];
      }
  
      while (@pth) {
          my $cur = File::Spec->catdir(@pth);
          last if !$cur;    # necessary ???
  
          if ($force) {
              _bail_if_changed( $cur, $fs_check{$cur}->[0], $fs_check{$cur}->[1] );
              if ( !pathempty($cur) ) {
                  return unless $nofail;
              }
          }
          _bail_if_changed( $cur, $fs_check{$cur}->[0], $fs_check{$cur}->[1] );
          if ($nofail) {
              rmdir $cur;
          }
          else {
              rmdir $cur or return;
          }
          pop @pth;
      }
  
      return 1;
  }
  
  sub pathrmdir {
      my $dir = shift;
      if ( -e $dir ) {
          return if !-d $dir;
      }
      else {
          return 2;
      }
  
      my ( $orig_dev, $orig_ino ) = ( lstat $dir )[ 0, 1 ];
      return 2 if !defined($orig_dev) || ( $^O ne 'MSWin32' && !$orig_ino );
  
      pathempty($dir) or return;
      _bail_if_changed( $dir, $orig_dev, $orig_ino );
      rmdir $dir or return;
  
      return 1;
  }
  
  sub _bail_if_changed {
      my ( $path, $orig_dev, $orig_ino ) = @_;
  
      my ( $cur_dev, $cur_ino ) = ( lstat $path )[ 0, 1 ];
  
      if ( !defined $cur_dev || !defined $cur_ino ) {
          $cur_dev ||= "undef(path went away?)";
          $cur_ino ||= "undef(path went away?)";
      }
      else {
          $path = Cwd::abs_path($path);
      }
  
      if ( $orig_dev ne $cur_dev || $orig_ino ne $cur_ino ) {
          local $Carp::CarpLevel += 1;
          Carp::croak("directory $path changed: expected dev=$orig_dev ino=$orig_ino, actual dev=$cur_dev ino=$cur_ino, aborting");
      }
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  File::Copy::Recursive - Perl extension for recursively copying files and directories
  
  =head1 SYNOPSIS
  
    use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
  
    fcopy($orig,$new[,$buf]) or die $!;
    rcopy($orig,$new[,$buf]) or die $!;
    dircopy($orig,$new[,$buf]) or die $!;
  
    fmove($orig,$new[,$buf]) or die $!;
    rmove($orig,$new[,$buf]) or die $!;
    dirmove($orig,$new[,$buf]) or die $!;
    
    rcopy_glob("orig/stuff-*", $trg [, $buf]) or die $!;
    rmove_glob("orig/stuff-*", $trg [,$buf]) or die $!;
  
  =head1 DESCRIPTION
  
  This module copies and moves directories recursively (or single files, well... singley) to an optional depth and attempts to preserve each file or directory's mode.
  
  =head1 EXPORT
  
  None by default. But you can export all the functions as in the example above and the path* functions if you wish.
  
  =head2 fcopy()
  
  This function uses File::Copy's copy() function to copy a file but not a directory. Any directories are recursively created if need be.
  One difference to File::Copy::copy() is that fcopy attempts to preserve the mode (see Preserving Mode below)
  The optional $buf in the synopsis is the same as File::Copy::copy()'s 3rd argument.
  This function returns the same as File::Copy::copy() in scalar context and 1,0,0 in list context to accomodate rcopy()'s list context on regular files. (See below for more info)
  
  =head2 dircopy()
  
  This function recursively traverses the $orig directory's structure and recursively copies it to the $new directory.
  $new is created if necessary (multiple non existent directories is ok (i.e. foo/bar/baz). The script logically and portably creates all of them if necessary).
  It attempts to preserve the mode (see Preserving Mode below) and 
  by default it copies all the way down into the directory (see Managing Depth, below).
  If a directory is not specified it croaks just like fcopy croaks if its not a file that is specified.
  
  This function returns true or false: for true in scalar context it returns the number of files and directories copied,
  whereas in list context it returns the number of files and directories, number of directories only, depth level traversed.
  
    my $num_of_files_and_dirs = dircopy($orig,$new);
    my($num_of_files_and_dirs,$num_of_dirs,$depth_traversed) = dircopy($orig,$new);
    
  Normally it stops and returns if a copy fails. To continue on regardless, set $File::Copy::Recursive::SkipFlop to true.
  
      local $File::Copy::Recursive::SkipFlop = 1;
  
  That way it will copy everythging it can in a directory and won't stop because of permissions, etc...
  
  =head2 rcopy()
  
  This function will allow you to specify a file *or* a directory. It calls fcopy() if you passed file and dircopy() if you passed a directory.
  If you call rcopy() (or fcopy() for that matter) on a file in list context, the values will be 1,0,0 since no directories and no depth are used. 
  This is important because if it's a directory in list context and there is only the initial directory the return value is 1,1,1.
  
  =head2 rcopy_glob()
  
  This function lets you specify a pattern suitable for perl's File::Glob::bsd_glob() as the first argument. Subsequently each path returned by perl's File::Glob::bsd_glob() gets rcopy()ied.
  
  It returns and array whose items are array refs that contain the return value of each rcopy() call.
  
  It forces behavior as if $File::Copy::Recursive::CPRFComp is true.
  
  =head2 fmove()
  
  Copies the file then removes the original. You can manage the path the original file is in according to $RemvBase.
  
  =head2 dirmove()
  
  Uses dircopy() to copy the directory then removes the original. You can manage the path the original directory is in according to $RemvBase.
  
  =head2 rmove()
  
  Like rcopy() but calls fmove() or dirmove() instead.
  
  =head2 rmove_glob()
  
  Like rcopy_glob() but calls rmove() instead of rcopy()
  
  =head3 $RemvBase
  
  Default is false. When set to true the *move() functions will not only attempt to remove the original file or directory but will remove the given path it is in.
  
  So if you:
  
     rmove('foo/bar/baz', '/etc/');
     # "baz" is removed from foo/bar after it is successfully copied to /etc/
     
     local $File::Copy::Recursive::Remvbase = 1;
     rmove('foo/bar/baz','/etc/');
     # if baz is successfully copied to /etc/ :
     # first "baz" is removed from foo/bar
     # then "foo/bar is removed via pathrm()
  
  =head4 $ForcePth
  
  Default is false. When set to true it calls pathempty() before any directories are removed to empty the directory so it can be rmdir()'ed when $RemvBase is in effect.
  
  =head2 Creating and Removing Paths
  
  =head3 $NoFtlPth
  
  Default is false. If set to true  rmdir(), mkdir(), and pathempty() calls in pathrm() and pathmk() do not return() on failure.
  
  If its set to true they just silently go about their business regardless. This isn't a good idea but it's there if you want it.
  
  =head3 $DirPerms
  
  Mode to pass to any mkdir() calls. Defaults to 0777 as per umask()'s POD. Explicitly having this allows older perls to be able to use FCR and might add a bit of flexibility for you.
  
  Any value you set it to should be suitable for oct().
  
  =head3 Path functions
  
  These functions exist solely because they were necessary for the move and copy functions to have the features they do and not because they are of themselves the purpose of this module. That being said, here is how they work so you can understand how the copy and move functions work and use them by themselves if you wish.
  
  =head4 pathrm()
  
  Removes a given path recursively. It removes the *entire* path so be careful!!!
  
  Returns 2 if the given path is not a directory.
  
    File::Copy::Recursive::pathrm('foo/bar/baz') or die $!;
    # foo no longer exists
  
  Same as:
  
    rmdir 'foo/bar/baz' or die $!;
    rmdir 'foo/bar' or die $!;
    rmdir 'foo' or die $!;
  
  An optional second argument makes it call pathempty() before any rmdir()'s when set to true.
  
    File::Copy::Recursive::pathrm('foo/bar/baz', 1) or die $!;
    # foo no longer exists
  
  Same as:PFSCheck
  
    File::Copy::Recursive::pathempty('foo/bar/baz') or die $!;
    rmdir 'foo/bar/baz' or die $!;
    File::Copy::Recursive::pathempty('foo/bar/') or die $!;
    rmdir 'foo/bar' or die $!;
    File::Copy::Recursive::pathempty('foo/') or die $!;
    rmdir 'foo' or die $!;
  
  An optional third argument acts like $File::Copy::Recursive::NoFtlPth, again probably not a good idea.
  
  =head4 pathempty()
  
  Recursively removes the given directory's contents so it is empty. Returns 2 if the given argument is not a directory, 1 on successfully emptying the directory.
  
     File::Copy::Recursive::pathempty($pth) or die $!;
     # $pth is now an empty directory
  
  =head4 pathmk()
  
  Creates a given path recursively. Creates foo/bar/baz even if foo does not exist.
  
     File::Copy::Recursive::pathmk('foo/bar/baz') or die $!;
  
  An optional second argument if true acts just like $File::Copy::Recursive::NoFtlPth, which means you'd never get your die() if something went wrong. Again, probably a *bad* idea.
  
  =head4 pathrmdir()
  
  Same as rmdir() but it calls pathempty() first to recursively empty it first since rmdir can not remove a directory with contents.
  Just removes the top directory the path given instead of the entire path like pathrm(). Returns 2 if the given argument does not exist (i.e. it's already gone). Returns false if it exists but is not a directory.
  
  =head2 Preserving Mode
  
  By default a quiet attempt is made to change the new file or directory to the mode of the old one.
  To turn this behavior off set
    $File::Copy::Recursive::KeepMode
  to false;
  
  =head2 Managing Depth
  
  You can set the maximum depth a directory structure is recursed by setting:
    $File::Copy::Recursive::MaxDepth 
  to a whole number greater than 0.
  
  =head2 SymLinks
  
  If your system supports symlinks then symlinks will be copied as symlinks instead of as the target file.
  Perl's symlink() is used instead of File::Copy's copy().
  You can customize this behavior by setting $File::Copy::Recursive::CopyLink to a true or false value.
  It is already set to true or false depending on your system's support of symlinks so you can check it with an if statement to see how it will behave:
  
      if($File::Copy::Recursive::CopyLink) {
          print "Symlinks will be preserved\n";
      } else {
          print "Symlinks will not be preserved because your system does not support it\n";
      }
  
  If symlinks are being copied you can set $File::Copy::Recursive::BdTrgWrn to true to make it carp when it copies a link whose target does not exist. It's false by default.
  
      local $File::Copy::Recursive::BdTrgWrn  = 1;
  
  =head2 Removing existing target file or directory before copying.
  
  This can be done by setting $File::Copy::Recursive::RMTrgFil or $File::Copy::Recursive::RMTrgDir for file or directory behavior respectively.
  
  0 = off (This is the default)
  
  1 = carp() $! if removal fails
  
  2 = return if removal fails
  
      local $File::Copy::Recursive::RMTrgFil = 1;
      fcopy($orig, $target) or die $!;
      # if it fails it does warn() and keeps going
  
      local $File::Copy::Recursive::RMTrgDir = 2;
      dircopy($orig, $target) or die $!;
      # if it fails it does your "or die"
  
  This should be unnecessary most of the time but it's there if you need it :)
  
  =head2 Turning off stat() check
  
  By default the files or directories are checked to see if they are the same (i.e. linked, or two paths (absolute/relative or different relative paths) to the same file) by comparing the file's stat() info. 
  It's a very efficient check that croaks if they are and shouldn't be turned off but if you must for some weird reason just set $File::Copy::Recursive::PFSCheck to a false value. ("PFS" stands for "Physical File System")
  
  =head2 Emulating cp -rf dir1/ dir2/
  
  By default dircopy($dir1,$dir2) will put $dir1's contents right into $dir2 whether $dir2 exists or not.
  
  You can make dircopy() emulate cp -rf by setting $File::Copy::Recursive::CPRFComp to true.
  
  NOTE: This only emulates -f in the sense that it does not prompt. It does not remove the target file or directory if it exists.
  If you need to do that then use the variables $RMTrgFil and $RMTrgDir described in "Removing existing target file or directory before copying" above.
  
  That means that if $dir2 exists it puts the contents into $dir2/$dir1 instead of $dir2 just like cp -rf.
  If $dir2 does not exist then the contents go into $dir2 like normal (also like cp -rf).
  
  So assuming 'foo/file':
  
      dircopy('foo', 'bar') or die $!;
      # if bar does not exist the result is bar/file
      # if bar does exist the result is bar/file
  
      $File::Copy::Recursive::CPRFComp = 1;
      dircopy('foo', 'bar') or die $!;
      # if bar does not exist the result is bar/file
      # if bar does exist the result is bar/foo/file
  
  You can also specify a star for cp -rf glob type behavior:
  
      dircopy('foo/*', 'bar') or die $!;
      # if bar does not exist the result is bar/file
      # if bar does exist the result is bar/file
  
      $File::Copy::Recursive::CPRFComp = 1;
      dircopy('foo/*', 'bar') or die $!;
      # if bar does not exist the result is bar/file
      # if bar does exist the result is bar/file
  
  NOTE: The '*' is only like cp -rf foo/* and *DOES NOT EXPAND PARTIAL DIRECTORY NAMES LIKE YOUR SHELL DOES* (i.e. not like cp -rf fo* to copy foo/*).
  
  =head2 Allowing Copy Loops
  
  If you want to allow:
  
    cp -rf . foo/
  
  type behavior set $File::Copy::Recursive::CopyLoop to true.
  
  This is false by default so that a check is done to see if the source directory will contain the target directory and croaks to avoid this problem.
  
  If you ever find a situation where $CopyLoop = 1 is desirable let me know. (i.e. it's a bad bad idea but is there if you want it)
  
  (Note: On Windows this was necessary since it uses stat() to determine sameness and stat() is essentially useless for this on Windows. 
  The test is now simply skipped on Windows but I'd rather have an actual reliable check if anyone in Microsoft land would care to share)
  
  =head1 SEE ALSO
  
  L<File::Copy> L<File::Spec>
  
  =head1 TO DO
  
  I am currently working on and reviewing some other modules to use in the new interface so we can lose the horrid globals as well as some other undesirable traits and also more easily make available some long standing requests.
  
  Tests will be easier to do with the new interface and hence the testing focus will shift to the new interface and aim to be comprehensive.
  
  The old interface will work, it just won't be brought in until it is used, so it will add no overhead for users of the new interface.
  
  I'll add this after the latest version has been out for a while with no new features or issues found :)
  
  =head1 AUTHOR
  
  Daniel Muey, L<http://drmuey.com/cpan_contact.pl>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2004 by Daniel Muey
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
FILE_COPY_RECURSIVE

$fatpacked{"File/HomeDir.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR';
  package File::HomeDir;
  
  # See POD at end for documentation
  
  use 5.008003;
  use strict;
  use warnings;
  use Carp        ();
  use Config      ();
  use File::Spec  ();
  use File::Which ();
  
  # Globals
  use vars qw{$VERSION @EXPORT @EXPORT_OK $IMPLEMENTED_BY};    ## no critic qw(AutomaticExportation)
  use base qw(Exporter);
  
  BEGIN
  {
      $VERSION = '1.006';
  
      # Inherit manually
      require Exporter;
      @EXPORT    = qw{home};
      @EXPORT_OK = qw{
        home
        my_home
        my_desktop
        my_documents
        my_music
        my_pictures
        my_videos
        my_data
        my_dist_config
        my_dist_data
        users_home
        users_desktop
        users_documents
        users_music
        users_pictures
        users_videos
        users_data
      };
  }
  
  # Inlined Params::Util functions
  sub _CLASS ($)    ## no critic qw(SubroutinePrototypes)
  {
      (defined $_[0] and not ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
  }
  
  sub _DRIVER ($$)    ## no critic qw(SubroutinePrototypes)
  {
      (defined _CLASS($_[0]) and eval "require $_[0]; 1" and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
  }
  
  # Platform detection
  if ($IMPLEMENTED_BY)
  {
      # Allow for custom HomeDir classes
      # Leave it as the existing value
  }
  elsif ($^O eq 'MSWin32')
  {
      # All versions of Windows
      $IMPLEMENTED_BY = 'File::HomeDir::Windows';
  }
  elsif ($^O eq 'darwin')
  {
      # 1st: try Mac::SystemDirectory by chansen
      if (eval "require Mac::SystemDirectory; 1")
      {
          $IMPLEMENTED_BY = 'File::HomeDir::Darwin::Cocoa';
      }
      elsif (eval "require Mac::Files; 1")
      {
          # 2nd try Mac::Files: Carbon - unmaintained since 2006 except some 64bit fixes
          $IMPLEMENTED_BY = 'File::HomeDir::Darwin::Carbon';
      }
      else
      {
          # 3rd: fallback: pure perl
          $IMPLEMENTED_BY = 'File::HomeDir::Darwin';
      }
  }
  elsif ($^O eq 'MacOS')
  {
      # Legacy Mac OS
      $IMPLEMENTED_BY = 'File::HomeDir::MacOS9';
  }
  elsif (File::Which::which('xdg-user-dir'))
  {
      # freedesktop unixes
      $IMPLEMENTED_BY = 'File::HomeDir::FreeDesktop';
  }
  else
  {
      # Default to Unix semantics
      $IMPLEMENTED_BY = 'File::HomeDir::Unix';
  }
  
  unless (_DRIVER($IMPLEMENTED_BY, 'File::HomeDir::Driver'))
  {
      Carp::croak("Missing or invalid File::HomeDir driver $IMPLEMENTED_BY");
  }
  
  #####################################################################
  # Current User Methods
  
  sub my_home
  {
      $IMPLEMENTED_BY->my_home;
  }
  
  sub my_desktop
  {
      $IMPLEMENTED_BY->can('my_desktop')
        ? $IMPLEMENTED_BY->my_desktop
        : Carp::croak("The my_desktop method is not implemented on this platform");
  }
  
  sub my_documents
  {
      $IMPLEMENTED_BY->can('my_documents')
        ? $IMPLEMENTED_BY->my_documents
        : Carp::croak("The my_documents method is not implemented on this platform");
  }
  
  sub my_music
  {
      $IMPLEMENTED_BY->can('my_music')
        ? $IMPLEMENTED_BY->my_music
        : Carp::croak("The my_music method is not implemented on this platform");
  }
  
  sub my_pictures
  {
      $IMPLEMENTED_BY->can('my_pictures')
        ? $IMPLEMENTED_BY->my_pictures
        : Carp::croak("The my_pictures method is not implemented on this platform");
  }
  
  sub my_videos
  {
      $IMPLEMENTED_BY->can('my_videos')
        ? $IMPLEMENTED_BY->my_videos
        : Carp::croak("The my_videos method is not implemented on this platform");
  }
  
  sub my_data
  {
      $IMPLEMENTED_BY->can('my_data')
        ? $IMPLEMENTED_BY->my_data
        : Carp::croak("The my_data method is not implemented on this platform");
  }
  
  sub my_dist_data
  {
      my $params = ref $_[-1] eq 'HASH' ? pop : {};
      my $dist   = pop or Carp::croak("The my_dist_data method requires an argument");
      my $data   = my_data();
  
      # If datadir is not defined, there's nothing we can do: bail out
      # and return nothing...
      return undef unless defined $data;
  
      # On traditional unixes, hide the top-level directory
      my $var =
        $data eq home()
        ? File::Spec->catdir($data, '.perl', 'dist', $dist)
        : File::Spec->catdir($data, 'Perl',  'dist', $dist);
  
      # directory exists: return it
      return $var if -d $var;
  
      # directory doesn't exist: check if we need to create it...
      return undef unless $params->{create};
  
      # user requested directory creation
      require File::Path;
      File::Path::mkpath($var);
      return $var;
  }
  
  sub my_dist_config
  {
      my $params = ref $_[-1] eq 'HASH' ? pop : {};
      my $dist   = pop or Carp::croak("The my_dist_config method requires an argument");
  
      # not all platforms support a specific my_config() method
      my $config =
          $IMPLEMENTED_BY->can('my_config')
        ? $IMPLEMENTED_BY->my_config
        : $IMPLEMENTED_BY->my_documents;
  
      # If neither configdir nor my_documents is defined, there's
      # nothing we can do: bail out and return nothing...
      return undef unless defined $config;
  
      # On traditional unixes, hide the top-level dir
      my $etc =
        $config eq home()
        ? File::Spec->catdir($config, '.perl', $dist)
        : File::Spec->catdir($config, 'Perl',  $dist);
  
      # directory exists: return it
      return $etc if -d $etc;
  
      # directory doesn't exist: check if we need to create it...
      return undef unless $params->{create};
  
      # user requested directory creation
      require File::Path;
      File::Path::mkpath($etc);
      return $etc;
  }
  
  #####################################################################
  # General User Methods
  
  sub users_home
  {
      $IMPLEMENTED_BY->can('users_home')
        ? $IMPLEMENTED_BY->users_home($_[-1])
        : Carp::croak("The users_home method is not implemented on this platform");
  }
  
  sub users_desktop
  {
      $IMPLEMENTED_BY->can('users_desktop')
        ? $IMPLEMENTED_BY->users_desktop($_[-1])
        : Carp::croak("The users_desktop method is not implemented on this platform");
  }
  
  sub users_documents
  {
      $IMPLEMENTED_BY->can('users_documents')
        ? $IMPLEMENTED_BY->users_documents($_[-1])
        : Carp::croak("The users_documents method is not implemented on this platform");
  }
  
  sub users_music
  {
      $IMPLEMENTED_BY->can('users_music')
        ? $IMPLEMENTED_BY->users_music($_[-1])
        : Carp::croak("The users_music method is not implemented on this platform");
  }
  
  sub users_pictures
  {
      $IMPLEMENTED_BY->can('users_pictures')
        ? $IMPLEMENTED_BY->users_pictures($_[-1])
        : Carp::croak("The users_pictures method is not implemented on this platform");
  }
  
  sub users_videos
  {
      $IMPLEMENTED_BY->can('users_videos')
        ? $IMPLEMENTED_BY->users_videos($_[-1])
        : Carp::croak("The users_videos method is not implemented on this platform");
  }
  
  sub users_data
  {
      $IMPLEMENTED_BY->can('users_data')
        ? $IMPLEMENTED_BY->users_data($_[-1])
        : Carp::croak("The users_data method is not implemented on this platform");
  }
  
  #####################################################################
  # Legacy Methods
  
  # Find the home directory of an arbitrary user
  sub home (;$)    ## no critic qw(SubroutinePrototypes)
  {
      # Allow to be called as a method
      if ($_[0] and $_[0] eq 'File::HomeDir')
      {
          shift();
      }
  
      # No params means my home
      return my_home() unless @_;
  
      # Check the param
      my $name = shift;
      if (!defined $name)
      {
          Carp::croak("Can't use undef as a username");
      }
      if (!length $name)
      {
          Carp::croak("Can't use empty-string (\"\") as a username");
      }
  
      # A dot also means my home
      ### Is this meant to mean File::Spec->curdir?
      if ($name eq '.')
      {
          return my_home();
      }
  
      # Now hand off to the implementor
      $IMPLEMENTED_BY->users_home($name);
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  File::HomeDir - Find your home and other directories on any platform
  
  =begin html
  
  <a href="https://travis-ci.org/perl5-utils/File-HomeDir"><img src="https://travis-ci.org/perl5-utils/File-HomeDir.svg?branch=master" alt="Travis CI"/></a>
  <a href='https://coveralls.io/github/perl5-utils/File-HomeDir?branch=master'><img src='https://coveralls.io/repos/github/perl5-utils/File-HomeDir/badge.svg?branch=master' alt='Coverage Status'/></a>
  
  =end html
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Modern Interface (Current User)
    $home     = File::HomeDir->my_home;
    $desktop  = File::HomeDir->my_desktop;
    $docs     = File::HomeDir->my_documents;
    $music    = File::HomeDir->my_music;
    $pics     = File::HomeDir->my_pictures;
    $videos   = File::HomeDir->my_videos;
    $data     = File::HomeDir->my_data;
    $dist     = File::HomeDir->my_dist_data('File-HomeDir');
    $dist     = File::HomeDir->my_dist_config('File-HomeDir');
    
    # Modern Interface (Other Users)
    $home    = File::HomeDir->users_home('foo');
    $desktop = File::HomeDir->users_desktop('foo');
    $docs    = File::HomeDir->users_documents('foo');
    $music   = File::HomeDir->users_music('foo');
    $pics    = File::HomeDir->users_pictures('foo');
    $video   = File::HomeDir->users_videos('foo');
    $data    = File::HomeDir->users_data('foo');
  
  =head1 DESCRIPTION
  
  B<File::HomeDir> is a module for locating the directories that are "owned"
  by a user (typically your user) and to solve the various issues that arise
  trying to find them consistently across a wide variety of platforms.
  
  The end result is a single API that can find your resources on any platform,
  making it relatively trivial to create Perl software that works elegantly
  and correctly no matter where you run it.
  
  =head2 Platform Neutrality
  
  In the Unix world, many different types of data can be mixed together
  in your home directory (although on some Unix platforms this is no longer
  the case, particularly for "desktop"-oriented platforms).
  
  On some non-Unix platforms, separate directories are allocated for
  different types of data and have been for a long time.
  
  When writing applications on top of B<File::HomeDir>, you should thus
  always try to use the most specific method you can. User documents should
  be saved in C<my_documents>, data that supports an application but isn't
  normally editing by the user directory should go into C<my_data>.
  
  On platforms that do not make any distinction, all these different
  methods will harmlessly degrade to the main home directory, but on
  platforms that care B<File::HomeDir> will always try to Do The Right
  Thing(tm).
  
  =head1 METHODS
  
  Two types of methods are provided. The C<my_method> series of methods for
  finding resources for the current user, and the C<users_method> (read as
  "user's method") series for finding resources for arbitrary users.
  
  This split is necessary, as on most platforms it is B<much> easier to find
  information about the current user compared to other users, and indeed
  on a number you cannot find out information such as C<users_desktop> at
  all, due to security restrictions.
  
  All methods will double check (using a C<-d> test) that a directory
  actually exists before returning it, so you may trust in the values
  that are returned (subject to the usual caveats of race conditions of
  directories being deleted at the moment between a directory being returned
  and you using it).
  
  However, because in some cases platforms may not support the concept of home
  directories at all, any method may return C<undef> (both in scalar and list
  context) to indicate that there is no matching directory on the system.
  
  For example, most untrusted 'nobody'-type users do not have a home
  directory. So any modules that are used in a CGI application that
  at some level of recursion use your code, will result in calls to
  File::HomeDir returning undef, even for a basic home() call.
  
  =head2 my_home
  
  The C<my_home> method takes no arguments and returns the main home/profile
  directory for the current user.
  
  If the distinction is important to you, the term "current" refers to the
  real user, and not the effective user.
  
  This is also the case for all of the other "my" methods.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a home directory, or dies on error.
  
  =head2 my_desktop
  
  The C<my_desktop> method takes no arguments and returns the "desktop"
  directory for the current user.
  
  Due to the diversity and complexity of implementations required to deal with
  implementing the required functionality fully and completely, the
  C<my_desktop> method may or may not be implemented on each platform.
  
  That said, I am extremely interested in code to implement C<my_desktop> on
  Unix, as long as it is capable of dealing (as the Windows implementation
  does) with internationalization. It should also avoid false positive
  results by making sure it only returns the appropriate directories for the
  appropriate platforms.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a desktop directory, or dies on error.
  
  =head2 my_documents
  
  The C<my_documents> method takes no arguments and returns the directory (for
  the current user) where the user's documents are stored.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a documents directory, or dies on error.
  
  =head2 my_music
  
  The C<my_music> method takes no arguments and returns the directory
  where the current user's music is stored.
  
  No bias is made to any particular music type or music program, rather the
  concept of a directory to hold the user's music is made at the level of the
  underlying operating system or (at least) desktop environment.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a suitable directory, or dies on error.
  
  =head2 my_pictures
  
  The C<my_pictures> method takes no arguments and returns the directory
  where the current user's pictures are stored.
  
  No bias is made to any particular picture type or picture program, rather the
  concept of a directory to hold the user's pictures is made at the level of the
  underlying operating system or (at least) desktop environment.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a suitable directory, or dies on error.
  
  =head2 my_videos
  
  The C<my_videos> method takes no arguments and returns the directory
  where the current user's videos are stored.
  
  No bias is made to any particular video type or video program, rather the
  concept of a directory to hold the user's videos is made at the level of the
  underlying operating system or (at least) desktop environment.
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a suitable directory, or dies on error.
  
  =head2 my_data
  
  The C<my_data> method takes no arguments and returns the directory where
  local applications should store their internal data for the current
  user.
  
  Generally an application would create a subdirectory such as C<.foo>,
  beneath this directory, and store its data there. By creating your
  directory this way, you get an accurate result on the maximum number of
  platforms. But see the documentation about C<my_dist_config()> or
  C<my_dist_data()> below.
  
  For example, on Unix you get C<~/.foo> and on Win32 you get
  C<~/Local Settings/Application Data/.foo>
  
  Returns the directory path as a string, C<undef> if the current user
  does not have a data directory, or dies on error.
  
  
  =head2 my_dist_config
  
    File::HomeDir->my_dist_config( $dist [, \%params] );
    
    # For example...
    
    File::HomeDir->my_dist_config( 'File-HomeDir' );
    File::HomeDir->my_dist_config( 'File-HomeDir', { create => 1 } );
  
  The C<my_dist_config> method takes a distribution name as argument and
  returns an application-specific directory where they should store their
  internal configuration.
  
  The base directory will be either C<my_config> if the platform supports
  it, or C<my_documents> otherwise. The subdirectory itself will be 
  C<BASE/Perl/Dist-Name>. If the base directory is the user's home directory,
  C<my_dist_config> will be in C<~/.perl/Dist-Name> (and thus be hidden on
  all Unixes).
  
  The optional last argument is a hash reference to tweak the method
  behaviour. The following hash keys are recognized:
  
  =over 4
  
  =item * create
  
  Passing a true value to this key will force the creation of the
  directory if it doesn't exist (remember that C<File::HomeDir>'s policy
  is to return C<undef> if the directory doesn't exist).
  
  Defaults to false, meaning no automatic creation of directory.
  
  =back
  
  
  =head2 my_dist_data
  
    File::HomeDir->my_dist_data( $dist [, \%params] );
    
    # For example...
    
    File::HomeDir->my_dist_data( 'File-HomeDir' );
    File::HomeDir->my_dist_data( 'File-HomeDir', { create => 1 } );
  
  The C<my_dist_data> method takes a distribution name as argument and
  returns an application-specific directory where they should store their
  internal data.
  
  This directory will be of course a subdirectory of C<my_data>. Platforms
  supporting data-specific directories will use
  C<DATA_DIR/perl/dist/Dist-Name> following the common
  "DATA/vendor/application" pattern. If the C<my_data> directory is the
  user's home directory, C<my_dist_data> will be in C<~/.perl/dist/Dist-Name>
  (and thus be hidden on all Unixes).
  
  The optional last argument is a hash reference to tweak the method
  behaviour. The following hash keys are recognized:
  
  =over 4
  
  =item * create
  
  Passing a true value to this key will force the creation of the
  directory if it doesn't exist (remember that C<File::HomeDir>'s policy
  is to return C<undef> if the directory doesn't exist).
  
  Defaults to false, meaning no automatic creation of directory.
  
  =back
  
  =head2 users_home
  
    $home = File::HomeDir->users_home('foo');
  
  The C<users_home> method takes a single parameter and is used to locate the
  parent home/profile directory for an identified user on the system.
  
  While most of the time this identifier would be some form of user name,
  it is permitted to vary per-platform to support user ids or UUIDs as
  applicable for that platform.
  
  Returns the directory path as a string, C<undef> if that user
  does not have a home directory, or dies on error.
  
  =head2 users_documents
  
    $docs = File::HomeDir->users_documents('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a documents directory, or dies on error.
  
  =head2 users_data
  
    $data = File::HomeDir->users_data('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a data directory, or dies on error.
  
  =head2 users_desktop
  
    $docs = File::HomeDir->users_desktop('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a desktop directory, or dies on error.
  
  =head2 users_music
  
    $docs = File::HomeDir->users_music('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a music directory, or dies on error.
  
  =head2 users_pictures
  
    $docs = File::HomeDir->users_pictures('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a pictures directory, or dies on error.
  
  =head2 users_videos
  
    $docs = File::HomeDir->users_videos('foo');
  
  Returns the directory path as a string, C<undef> if that user
  does not have a videos directory, or dies on error.
  
  =head1 FUNCTIONS
  
  =head2 home
  
    use File::HomeDir;
    $home = home();
    $home = home('foo');
    $home = File::HomeDir::home();
    $home = File::HomeDir::home('foo');
  
  The C<home> function is exported by default and is provided for
  compatibility with legacy applications. In new applications, you should
  use the newer method-based interface above.
  
  Returns the directory path to a named user's home/profile directory.
  
  If provided no parameter, returns the directory path to the current user's
  home/profile directory.
  
  =head1 TO DO
  
  =over 4
  
  =item * Add more granularity to Unix, and add support to VMS and other
  esoteric platforms, so we can consider going core.
  
  =item * Add consistent support for users_* methods 
  
  =back
  
  =head1 SUPPORT
  
  This module is stored in an Open Repository at the following address.
  
  L<http://svn.ali.as/cpan/trunk/File-HomeDir>
  
  Write access to the repository is made available automatically to any
  published CPAN author, and to most other volunteers on request.
  
  If you are able to submit your bug report in the form of new (failing)
  unit tests, or can apply your fix directly instead of submitting a patch,
  you are B<strongly> encouraged to do so as the author currently maintains
  over 100 modules and it can take some time to deal with non-Critical bug
  reports or patches.
  
  This will guarantee that your issue will be addressed in the next
  release of the module.
  
  If you cannot provide a direct test or fix, or don't have time to do so,
  then regular bug reports are still accepted and appreciated via the CPAN
  bug tracker.
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-HomeDir>
  
  For other issues, for commercial enhancement or support, or to have your
  write access enabled for the repository, contact the author at the email
  address above.
  
  =head1 ACKNOWLEDGEMENTS
  
  The biggest acknowledgement goes to Chris Nandor, who wielded his
  legendary Mac-fu and turned my initial fairly ordinary Darwin
  implementation into something that actually worked properly everywhere,
  and then donated a Mac OS X license to allow it to be maintained properly.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  Chris Nandor E<lt>cnandor@cpan.orgE<gt>
  
  Stephen Steneker E<lt>stennie@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::ShareDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2012 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  Some parts copyright 2000 Sean M. Burke.
  
  Some parts copyright 2006 Chris Nandor.
  
  Some parts copyright 2006 Stephen Steneker.
  
  Some parts copyright 2009-2011 Jérôme Quelin.
  
  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
FILE_HOMEDIR

$fatpacked{"File/HomeDir/Darwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_DARWIN';
  package File::HomeDir::Darwin;
  
  use 5.008003;
  use strict;
  use warnings;
  use Cwd                 ();
  use Carp                ();
  use File::HomeDir::Unix ();
  
  use vars qw{$VERSION};
  use base "File::HomeDir::Unix";
  
  BEGIN
  {
      $VERSION = '1.006';
  }
  
  #####################################################################
  # Current User Methods
  
  sub _my_home
  {
      my ($class, $path) = @_;
      my $home = $class->my_home;
      return undef unless defined $home;
  
      my $folder = "$home/$path";
      unless (-d $folder)
      {
          # Make sure that symlinks resolve to directories.
          return undef unless -l $folder;
          my $dir = readlink $folder or return;
          return undef unless -d $dir;
      }
  
      return Cwd::abs_path($folder);
  }
  
  sub my_desktop
  {
      my $class = shift;
      $class->_my_home('Desktop');
  }
  
  sub my_documents
  {
      my $class = shift;
      $class->_my_home('Documents');
  }
  
  sub my_data
  {
      my $class = shift;
      $class->_my_home('Library/Application Support');
  }
  
  sub my_music
  {
      my $class = shift;
      $class->_my_home('Music');
  }
  
  sub my_pictures
  {
      my $class = shift;
      $class->_my_home('Pictures');
  }
  
  sub my_videos
  {
      my $class = shift;
      $class->_my_home('Movies');
  }
  
  #####################################################################
  # Arbitrary User Methods
  
  sub users_home
  {
      my $class = shift;
      my $home  = $class->SUPER::users_home(@_);
      return defined $home ? Cwd::abs_path($home) : undef;
  }
  
  sub users_desktop
  {
      my ($class, $name) = @_;
      return undef if $name eq 'root';
      $class->_to_user($class->my_desktop, $name);
  }
  
  sub users_documents
  {
      my ($class, $name) = @_;
      return undef if $name eq 'root';
      $class->_to_user($class->my_documents, $name);
  }
  
  sub users_data
  {
      my ($class, $name) = @_;
      $class->_to_user($class->my_data, $name)
        || $class->users_home($name);
  }
  
  # cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
  # there's really no other good way to do it at this time, that i know of -- pudge
  sub _to_user
  {
      my ($class, $path, $name) = @_;
      my $my_home    = $class->my_home;
      my $users_home = $class->users_home($name);
      defined $users_home or return undef;
      $path =~ s/^\Q$my_home/$users_home/;
      return $path;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Darwin - Find your home and other directories on Darwin (OS X)
  
  =head1 DESCRIPTION
  
  This module provides Mac OS X specific file path for determining
  common user directories in pure perl, by just using C<$ENV{HOME}>
  without Carbon nor Cocoa API calls. In normal usage this module will
  always be used via L<File::HomeDir>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;      # /Users/mylogin
    $desktop = File::HomeDir->my_desktop;   # /Users/mylogin/Desktop
    $docs    = File::HomeDir->my_documents; # /Users/mylogin/Documents
    $music   = File::HomeDir->my_music;     # /Users/mylogin/Music
    $pics    = File::HomeDir->my_pictures;  # /Users/mylogin/Pictures
    $videos  = File::HomeDir->my_videos;    # /Users/mylogin/Movies
    $data    = File::HomeDir->my_data;      # /Users/mylogin/Library/Application Support
  
  =head1 COPYRIGHT
  
  Copyright 2009 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  =cut
FILE_HOMEDIR_DARWIN

$fatpacked{"File/HomeDir/Darwin/Carbon.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_DARWIN_CARBON';
  package File::HomeDir::Darwin::Carbon;
  
  # Basic implementation for the Dawin family of operating systems.
  # This includes (most prominently) Mac OS X.
  
  use 5.008003;
  use strict;
  use warnings;
  use Cwd                   ();
  use Carp                  ();
  use File::HomeDir::Darwin ();
  
  use vars qw{$VERSION};
  
  # This is only a child class of the pure Perl darwin
  # class so that we can do homedir detection of all three
  # drivers at one via ->isa.
  use base "File::HomeDir::Darwin";
  
  BEGIN
  {
      $VERSION = '1.006';
  
      # Load early if in a forking environment and we have
      # prefork, or at run-time if not.
      local $@;                           ## no critic (Variables::RequireInitializationForLocalVars)
      eval "use prefork 'Mac::Files'";    ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
  }
  
  #####################################################################
  # Current User Methods
  
  ## no critic qw(UnusedPrivateSubroutines)
  sub _guess_determined_home
  {
      my $class = shift;
  
      require Mac::Files;
      my $home = $class->_find_folder(Mac::Files::kCurrentUserFolderType(),);
      $home ||= $class->SUPER::_guess_determined_home($@);
      return $home;
  }
  
  sub my_desktop
  {
      my $class = shift;
  
      require Mac::Files;
      $class->_find_folder(Mac::Files::kDesktopFolderType(),);
  }
  
  sub my_documents
  {
      my $class = shift;
  
      require Mac::Files;
      $class->_find_folder(Mac::Files::kDocumentsFolderType(),);
  }
  
  sub my_data
  {
      my $class = shift;
  
      require Mac::Files;
      $class->_find_folder(Mac::Files::kApplicationSupportFolderType(),);
  }
  
  sub my_music
  {
      my $class = shift;
  
      require Mac::Files;
      $class->_find_folder(Mac::Files::kMusicDocumentsFolderType(),);
  }
  
  sub my_pictures
  {
      my $class = shift;
  
      require Mac::Files;
      $class->_find_folder(Mac::Files::kPictureDocumentsFolderType(),);
  }
  
  sub my_videos
  {
      my $class = shift;
  
      require Mac::Files;
      $class->_find_folder(Mac::Files::kMovieDocumentsFolderType(),);
  }
  
  sub _find_folder
  {
      my $class = shift;
      my $name  = shift;
  
      require Mac::Files;
      my $folder = Mac::Files::FindFolder(Mac::Files::kUserDomain(), $name,);
      return undef unless defined $folder;
  
      unless (-d $folder)
      {
          # Make sure that symlinks resolve to directories.
          return undef unless -l $folder;
          my $dir = readlink $folder or return;
          return undef unless -d $dir;
      }
  
      return Cwd::abs_path($folder);
  }
  
  #####################################################################
  # Arbitrary User Methods
  
  sub users_home
  {
      my $class = shift;
      my $home  = $class->SUPER::users_home(@_);
      return defined $home ? Cwd::abs_path($home) : undef;
  }
  
  # in theory this can be done, but for now, let's cheat, since the
  # rest is Hard
  sub users_desktop
  {
      my ($class, $name) = @_;
      return undef if $name eq 'root';
      $class->_to_user($class->my_desktop, $name);
  }
  
  sub users_documents
  {
      my ($class, $name) = @_;
      return undef if $name eq 'root';
      $class->_to_user($class->my_documents, $name);
  }
  
  sub users_data
  {
      my ($class, $name) = @_;
      $class->_to_user($class->my_data, $name)
        || $class->users_home($name);
  }
  
  # cheap hack ... not entirely reliable, perhaps, but ... c'est la vie, since
  # there's really no other good way to do it at this time, that i know of -- pudge
  sub _to_user
  {
      my ($class, $path, $name) = @_;
      my $my_home    = $class->my_home;
      my $users_home = $class->users_home($name);
      defined $users_home or return undef;
      $path =~ s/^\Q$my_home/$users_home/;
      return $path;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Darwin - Find your home and other directories on Darwin (OS X)
  
  =head1 DESCRIPTION
  
  This module provides Darwin-specific implementations for determining
  common user directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  Note -- since this module requires Mac::Carbon and Mac::Carbon does
  not work with 64-bit perls, on such systems, File::HomeDir will try
  L<File::HomeDir::Darwin::Cocoa> and then fall back to the (pure Perl)
  L<File::HomeDir::Darwin>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
  
    # Find directories for the current user
    $home    = File::HomeDir->my_home;      # /Users/mylogin
    $desktop = File::HomeDir->my_desktop;   # /Users/mylogin/Desktop
    $docs    = File::HomeDir->my_documents; # /Users/mylogin/Documents
    $music   = File::HomeDir->my_music;     # /Users/mylogin/Music
    $pics    = File::HomeDir->my_pictures;  # /Users/mylogin/Pictures
    $videos  = File::HomeDir->my_videos;    # /Users/mylogin/Movies
    $data    = File::HomeDir->my_data;      # /Users/mylogin/Library/Application Support
  
  =head1 TODO
  
  =over 4
  
  =item * Test with Mac OS (versions 7, 8, 9)
  
  =item * Some better way for users_* ?
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright 2009 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  =cut
FILE_HOMEDIR_DARWIN_CARBON

$fatpacked{"File/HomeDir/Darwin/Cocoa.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_DARWIN_COCOA';
  package File::HomeDir::Darwin::Cocoa;
  
  use 5.008003;
  use strict;
  use warnings;
  use Cwd                   ();
  use Carp                  ();
  use File::HomeDir::Darwin ();
  
  use vars qw{$VERSION};
  use base "File::HomeDir::Darwin";
  
  BEGIN
  {
      $VERSION = '1.006';
  
      # Load early if in a forking environment and we have
      # prefork, or at run-time if not.
      local $@;                                     ## no critic (Variables::RequireInitializationForLocalVars)
      eval "use prefork 'Mac::SystemDirectory'";    ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
  }
  
  #####################################################################
  # Current User Methods
  
  ## no critic qw(UnusedPrivateSubroutines)
  sub _guess_determined_home
  {
      my $class = shift;
  
      require Mac::SystemDirectory;
      my $home = Mac::SystemDirectory::HomeDirectory();
      $home ||= $class->SUPER::_guess_determined_home($@);
      return $home;
  }
  
  # from 10.4
  sub my_desktop
  {
      my $class = shift;
  
      require Mac::SystemDirectory;
      eval { $class->_find_folder(Mac::SystemDirectory::NSDesktopDirectory()) }
        || $class->SUPER::my_desktop;
  }
  
  # from 10.2
  sub my_documents
  {
      my $class = shift;
  
      require Mac::SystemDirectory;
      eval { $class->_find_folder(Mac::SystemDirectory::NSDocumentDirectory()) }
        || $class->SUPER::my_documents;
  }
  
  # from 10.4
  sub my_data
  {
      my $class = shift;
  
      require Mac::SystemDirectory;
      eval { $class->_find_folder(Mac::SystemDirectory::NSApplicationSupportDirectory()) }
        || $class->SUPER::my_data;
  }
  
  # from 10.6
  sub my_music
  {
      my $class = shift;
  
      require Mac::SystemDirectory;
      eval { $class->_find_folder(Mac::SystemDirectory::NSMusicDirectory()) }
        || $class->SUPER::my_music;
  }
  
  # from 10.6
  sub my_pictures
  {
      my $class = shift;
  
      require Mac::SystemDirectory;
      eval { $class->_find_folder(Mac::SystemDirectory::NSPicturesDirectory()) }
        || $class->SUPER::my_pictures;
  }
  
  # from 10.6
  sub my_videos
  {
      my $class = shift;
  
      require Mac::SystemDirectory;
      eval { $class->_find_folder(Mac::SystemDirectory::NSMoviesDirectory()) }
        || $class->SUPER::my_videos;
  }
  
  sub _find_folder
  {
      my $class = shift;
      my $name  = shift;
  
      require Mac::SystemDirectory;
      my $folder = Mac::SystemDirectory::FindDirectory($name);
      return undef unless defined $folder;
  
      unless (-d $folder)
      {
          # Make sure that symlinks resolve to directories.
          return undef unless -l $folder;
          my $dir = readlink $folder or return;
          return undef unless -d $dir;
      }
  
      return Cwd::abs_path($folder);
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Darwin::Cocoa - Find your home and other directories on Darwin (OS X)
  
  =head1 DESCRIPTION
  
  This module provides Darwin-specific implementations for determining
  common user directories using Cocoa API through
  L<Mac::SystemDirectory>.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  Theoretically, this should return the same paths as both of the other
  Darwin drivers.
  
  Because this module requires L<Mac::SystemDirectory>, if the module
  is not installed, L<File::HomeDir> will fall back to L<File::HomeDir::Darwin>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;      # /Users/mylogin
    $desktop = File::HomeDir->my_desktop;   # /Users/mylogin/Desktop
    $docs    = File::HomeDir->my_documents; # /Users/mylogin/Documents
    $music   = File::HomeDir->my_music;     # /Users/mylogin/Music
    $pics    = File::HomeDir->my_pictures;  # /Users/mylogin/Pictures
    $videos  = File::HomeDir->my_videos;    # /Users/mylogin/Movies
    $data    = File::HomeDir->my_data;      # /Users/mylogin/Library/Application Support
  
  =head1 COPYRIGHT
  
  Copyright 2009 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  =cut
FILE_HOMEDIR_DARWIN_COCOA

$fatpacked{"File/HomeDir/Driver.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_DRIVER';
  package File::HomeDir::Driver;
  
  # Abstract base class that provides no functionality,
  # but confirms the class is a File::HomeDir driver class.
  
  use 5.008003;
  use strict;
  use warnings;
  use Carp ();
  
  use vars qw{$VERSION};
  
  BEGIN
  {
      $VERSION = '1.006';
  }
  
  sub my_home
  {
      Carp::croak("$_[0] does not implement compulsory method $_[1]");
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Driver - Base class for all File::HomeDir drivers
  
  =head1 DESCRIPTION
  
  This module is the base class for all L<File::HomeDir> drivers, and must
  be inherited from to identify a class as a driver.
  
  It is primarily provided as a convenience for this specific identification
  purpose, as L<File::HomeDir> supports the specification of custom drivers
  and an C<-E<gt>isa> check is used during the loading of the driver.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>
  
  =head1 COPYRIGHT
  
  Copyright 2009 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  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
FILE_HOMEDIR_DRIVER

$fatpacked{"File/HomeDir/FreeDesktop.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_FREEDESKTOP';
  package File::HomeDir::FreeDesktop;
  
  # Specific functionality for unixes running free desktops
  # compatible with (but not using) File-BaseDir-0.03
  
  # See POD at the end of the file for more documentation.
  
  use 5.008003;
  use strict;
  use warnings;
  use Carp                ();
  use File::Spec          ();
  use File::Which         ();
  use File::HomeDir::Unix ();
  
  use vars qw{$VERSION};
  use base "File::HomeDir::Unix";
  
  BEGIN
  {
      $VERSION = '1.006';
  }
  
  # xdg uses $ENV{XDG_CONFIG_HOME}/user-dirs.dirs to know where are the
  # various "my xxx" directories. That is a shell file. The official API
  # is the xdg-user-dir executable. It has no provision for assessing
  # the directories of a user that is different than the one we are
  # running under; the standard substitute user mechanisms are needed to
  # overcome this.
  
  my $xdgprog = File::Which::which('xdg-user-dir');
  
  sub _my
  {
      # No quoting because input is hard-coded and only comes from this module
      my $thingy = qx($xdgprog $_[1]);
      chomp $thingy;
      return $thingy;
  }
  
  # Simple stuff
  sub my_desktop   { shift->_my('DESKTOP') }
  sub my_documents { shift->_my('DOCUMENTS') }
  sub my_music     { shift->_my('MUSIC') }
  sub my_pictures  { shift->_my('PICTURES') }
  sub my_videos    { shift->_my('VIDEOS') }
  
  sub my_data
  {
      $ENV{XDG_DATA_HOME}
        or File::Spec->catdir(shift->my_home, qw{ .local share });
  }
  
  sub my_config
  {
      $ENV{XDG_CONFIG_HOME}
        or File::Spec->catdir(shift->my_home, qw{ .config });
  }
  
  # Custom locations (currently undocumented)
  sub my_download    { shift->_my('DOWNLOAD') }
  sub my_publicshare { shift->_my('PUBLICSHARE') }
  sub my_templates   { shift->_my('TEMPLATES') }
  
  sub my_cache
  {
      $ENV{XDG_CACHE_HOME}
        || File::Spec->catdir(shift->my_home, qw{ .cache });
  }
  
  #####################################################################
  # General User Methods
  
  sub users_desktop   { Carp::croak('The users_desktop method is not available on an XDG based system.'); }
  sub users_documents { Carp::croak('The users_documents method is not available on an XDG based system.'); }
  sub users_music     { Carp::croak('The users_music method is not available on an XDG based system.'); }
  sub users_pictures  { Carp::croak('The users_pictures method is not available on an XDG based system.'); }
  sub users_videos    { Carp::croak('The users_videos method is not available on an XDG based system.'); }
  sub users_data      { Carp::croak('The users_data method is not available on an XDG based system.'); }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::FreeDesktop - Find your home and other directories on FreeDesktop.org Unix
  
  =head1 DESCRIPTION
  
  This module provides implementations for determining common user
  directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  This module can operate only when the command C<xdg-user-dir> is available
  and executable, which is typically achieved by installed a package named
  C<xdg-user-dirs> or similar.
  
  One can find the latest spec at L<https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html>.
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home     = File::HomeDir->my_home;        # /home/mylogin
    $desktop  = File::HomeDir->my_desktop;
    $docs     = File::HomeDir->my_documents;
    $music    = File::HomeDir->my_music;
    $pics     = File::HomeDir->my_pictures;
    $videos   = File::HomeDir->my_videos;
    $data     = File::HomeDir->my_data;
    $config   = File::HomeDir->my_config;
    
    # Some undocumented ones, expect they don't work - use with caution
    $download    = File::HomeDir->my_download;
    $publicshare = File::HomeDir->my_publicshare;
    $templates   = File::HomeDir->my_templates;
    $cache       = File::HomeDir->my_cache;
  
  =head1 AUTHORS
  
  Jerome Quelin E<lt>jquellin@cpan.org<gt>
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2009 - 2011 Jerome Quelin.
  
  Some parts copyright 2010 Adam Kennedy.
  
  Some parts copyright 2017 - 2020 Jens Rehsack
  
  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
FILE_HOMEDIR_FREEDESKTOP

$fatpacked{"File/HomeDir/MacOS9.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_MACOS9';
  package File::HomeDir::MacOS9;
  
  # Half-assed implementation for the legacy Mac OS9 operating system.
  # Provided mainly to provide legacy compatibility. May be removed at
  # a later date.
  
  use 5.008003;
  use strict;
  use warnings;
  use Carp                  ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION};
  use base "File::HomeDir::Driver";
  
  BEGIN
  {
      $VERSION = '1.006';
  }
  
  # Load early if in a forking environment and we have
  # prefork, or at run-time if not.
  SCOPE:
  {
      ## no critic qw(RequireInitializationForLocalVars, RequireCheckingReturnValueOfEval)
      local $@;
      eval "use prefork 'Mac::Files'";
  }
  
  #####################################################################
  # Current User Methods
  
  sub my_home
  {
      my $class = shift;
  
      # Try for $ENV{HOME} if we have it
      if (defined $ENV{HOME})
      {
          return $ENV{HOME};
      }
  
      ### DESPERATION SETS IN
  
      # We could use the desktop
    SCOPE:
      {
          ## no critic qw(RequireInitializationForLocalVars, RequireCheckingReturnValueOfEval)
          local $@;
          eval {
              my $home = $class->my_desktop;
              return $home if $home and -d $home;
          };
      }
  
      # Desperation on any platform
    SCOPE:
      {
          # On some platforms getpwuid dies if called at all
          local $SIG{'__DIE__'} = '';
          my $home = (getpwuid($<))[7];
          return $home if $home and -d $home;
      }
  
      Carp::croak("Could not locate current user's home directory");
  }
  
  sub my_desktop
  {
      my $class = shift;
  
      # Find the desktop via Mac::Files
      local $SIG{'__DIE__'} = '';
      require Mac::Files;
      my $home = Mac::Files::FindFolder(Mac::Files::kOnSystemDisk(), Mac::Files::kDesktopFolderType(),);
      return $home if $home and -d $home;
  
      Carp::croak("Could not locate current user's desktop");
  }
  
  #####################################################################
  # General User Methods
  
  sub users_home
  {
      my ($class, $name) = @_;
  
    SCOPE:
      {
          # On some platforms getpwnam dies if called at all
          local $SIG{'__DIE__'} = '';
          my $home = (getpwnam($name))[7];
          return $home if defined $home and -d $home;
      }
  
      Carp::croak("Failed to find home directory for user '$name'");
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::MacOS9 - Find your home and other directories on legacy Macintosh systems
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;
    $desktop = File::HomeDir->my_desktop;
  
  =head1 DESCRIPTION
  
  This module provides implementations for determining common user
  directories on legacy Mac hosts. In normal usage this module will always be
  used via L<File::HomeDir>.
  
  This module is no longer actively maintained, and is included only for
  extreme back-compatibility.
  
  Only the C<my_home> and C<my_desktop> methods are supported.
  
  =head1 SUPPORT
  
  See the support section the main L<File::HomeDir> module.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  Some parts copyright 2000 Sean M. Burke.
  
  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
FILE_HOMEDIR_MACOS9

$fatpacked{"File/HomeDir/Test.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_TEST';
  package File::HomeDir::Test;
  
  use 5.008003;
  use strict;
  use warnings;
  use Carp                  ();
  use File::Spec            ();
  use File::Temp            ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION %DIR $ENABLED};
  use base "File::HomeDir::Driver";
  
  BEGIN
  {
      $VERSION = '1.006';
      %DIR     = ();
      $ENABLED = 0;
  }
  
  # Special magic use in test scripts
  sub import
  {
      my $class = shift;
      Carp::croak "Attempted to initialise File::HomeDir::Test trice" if %DIR;
  
      # Fill the test directories
      my $BASE = File::Temp::tempdir(CLEANUP => 1);
      %DIR = map { $_ => File::Spec->catdir($BASE, $_) } qw{
        my_home
        my_desktop
        my_documents
        my_data
        my_music
        my_pictures
        my_videos
      };
  
      # Hijack HOME to the home directory
      $ENV{HOME} = $DIR{my_home};    ## no critic qw(LocalizedPunctuationVars)
  
      # Make File::HomeDir load us instead of the native driver
      $File::HomeDir::IMPLEMENTED_BY =    # Prevent a warning
        $File::HomeDir::IMPLEMENTED_BY = 'File::HomeDir::Test';
  
      # Ready to go
      $ENABLED = 1;
  }
  
  #####################################################################
  # Current User Methods
  
  sub my_home
  {
      mkdir($DIR{my_home}, oct(755)) unless -d $DIR{my_home};
      return $DIR{my_home};
  }
  
  sub my_desktop
  {
      mkdir($DIR{my_desktop}, oct(755)) unless -d $DIR{my_desktop};
      return $DIR{my_desktop};
  }
  
  sub my_documents
  {
      mkdir($DIR{my_documents}, oct(755)) unless -f $DIR{my_documents};
      return $DIR{my_documents};
  }
  
  sub my_data
  {
      mkdir($DIR{my_data}, oct(755)) unless -d $DIR{my_data};
      return $DIR{my_data};
  }
  
  sub my_music
  {
      mkdir($DIR{my_music}, oct(755)) unless -d $DIR{my_music};
      return $DIR{my_music};
  }
  
  sub my_pictures
  {
      mkdir($DIR{my_pictures}, oct(755)) unless -d $DIR{my_pictures};
      return $DIR{my_pictures};
  }
  
  sub my_videos
  {
      mkdir($DIR{my_videos}, oct(755)) unless -d $DIR{my_videos};
      return $DIR{my_videos};
  }
  
  sub users_home
  {
      return undef;
  }
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Test - Prevent the accidental creation of user-owned files during testing
  
  =head1 SYNOPSIS
  
    use Test::More test => 1;
    use File::HomeDir::Test;
    use File::HomeDir;
  
  =head1 DESCRIPTION
  
  B<File::HomeDir::Test> is a L<File::HomeDir> driver intended for use in the test scripts
  of modules or applications that write files into user-owned directories.
  
  It is designed to prevent the pollution of user directories with files that are not part
  of the application install itself, but were created during testing. These files can leak
  state information from the tests into the run-time usage of an application, and on Unix
  systems also prevents tests (which may be executed as root via sudo) from writing files
  which cannot later be modified or removed by the regular user.
  
  =head1 SUPPORT
  
  See the support section of the main L<File::HomeDir> documentation.
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  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
FILE_HOMEDIR_TEST

$fatpacked{"File/HomeDir/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_UNIX';
  package File::HomeDir::Unix;
  
  # See POD at the end of the file for documentation
  
  use 5.008003;
  use strict;
  use warnings;
  use Carp                  ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION};
  use base "File::HomeDir::Driver";
  
  BEGIN
  {
      $VERSION = '1.006';
  }
  
  #####################################################################
  # Current User Methods
  
  sub my_home
  {
      my $class = shift;
      my $home  = $class->_guess_home(@_);
  
      # On Unix in general, a non-existent home means "no home"
      # For example, "nobody"-like users might use /nonexistent
      if (defined $home and not -d $home)
      {
          $home = undef;
      }
  
      return $home;
  }
  
  sub _guess_env_home
  {
      my $class = shift;
      if (exists $ENV{HOME} and defined $ENV{HOME} and length $ENV{HOME})
      {
          return $ENV{HOME};
      }
  
      # This is from the original code, but I'm guessing
      # it means "login directory" and exists on some Unixes.
      if (exists $ENV{LOGDIR} and $ENV{LOGDIR})
      {
          return $ENV{LOGDIR};
      }
  
      return;
  }
  
  sub _guess_determined_home
  {
      my $class = shift;
  
      # Light desperation on any (Unixish) platform
    SCOPE:
      {
          my $home = (getpwuid($<))[7];
          return $home if $home and -d $home;
      }
  
      return;
  }
  
  sub _guess_home
  {
      my $class = shift;
      my $home  = $class->_guess_env_home($@);
      $home ||= $class->_guess_determined_home($@);
      return $home;
  }
  
  # On unix by default, everything is under the same folder
  sub my_desktop
  {
      shift->my_home;
  }
  
  sub my_documents
  {
      shift->my_home;
  }
  
  sub my_data
  {
      shift->my_home;
  }
  
  sub my_music
  {
      shift->my_home;
  }
  
  sub my_pictures
  {
      shift->my_home;
  }
  
  sub my_videos
  {
      shift->my_home;
  }
  
  #####################################################################
  # General User Methods
  
  sub users_home
  {
      my ($class, $name) = @_;
  
      # IF and only if we have getpwuid support, and the
      # name of the user is our own, shortcut to my_home.
      # This is needed to handle HOME environment settings.
      if ($name eq getpwuid($<))
      {
          return $class->my_home;
      }
  
    SCOPE:
      {
          my $home = (getpwnam($name))[7];
          return $home if $home and -d $home;
      }
  
      return undef;
  }
  
  sub users_desktop
  {
      shift->users_home(@_);
  }
  
  sub users_documents
  {
      shift->users_home(@_);
  }
  
  sub users_data
  {
      shift->users_home(@_);
  }
  
  sub users_music
  {
      shift->users_home(@_);
  }
  
  sub users_pictures
  {
      shift->users_home(@_);
  }
  
  sub users_videos
  {
      shift->users_home(@_);
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Unix - Find your home and other directories on legacy Unix
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user
    $home    = File::HomeDir->my_home;        # /home/mylogin
    $desktop = File::HomeDir->my_desktop;     # All of these will... 
    $docs    = File::HomeDir->my_documents;   # ...default to home...
    $music   = File::HomeDir->my_music;       # ...directory
    $pics    = File::HomeDir->my_pictures;    #
    $videos  = File::HomeDir->my_videos;      #
    $data    = File::HomeDir->my_data;        # 
  
  =head1 DESCRIPTION
  
  This module provides implementations for determining common user
  directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  =head1 SUPPORT
  
  See the support section the main L<File::HomeDir> module.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  Some parts copyright 2000 Sean M. Burke.
  
  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
FILE_HOMEDIR_UNIX

$fatpacked{"File/HomeDir/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_HOMEDIR_WINDOWS';
  package File::HomeDir::Windows;
  
  # See POD at the end of the file for documentation
  
  use 5.008003;
  use strict;
  use warnings;
  use Carp                  ();
  use File::Spec            ();
  use File::HomeDir::Driver ();
  
  use vars qw{$VERSION};
  use base "File::HomeDir::Driver";
  
  BEGIN
  {
      $VERSION = '1.006';
  }
  
  sub CREATE () { 1 }
  
  #####################################################################
  # Current User Methods
  
  sub my_home
  {
      my $class = shift;
  
      # A lot of unix people and unix-derived tools rely on
      # the ability to overload HOME. We will support it too
      # so that they can replace raw HOME calls with File::HomeDir.
      if (exists $ENV{HOME} and defined $ENV{HOME} and length $ENV{HOME})
      {
          return $ENV{HOME};
      }
  
      # Do we have a user profile?
      if (exists $ENV{USERPROFILE} and $ENV{USERPROFILE})
      {
          return $ENV{USERPROFILE};
      }
  
      # Some Windows use something like $ENV{HOME}
      if (exists $ENV{HOMEDRIVE} and exists $ENV{HOMEPATH} and $ENV{HOMEDRIVE} and $ENV{HOMEPATH})
      {
          return File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '',);
      }
  
      return undef;
  }
  
  sub my_desktop
  {
      my $class = shift;
  
      # The most correct way to find the desktop
    SCOPE:
      {
          require Win32;
          my $dir = Win32::GetFolderPath(Win32::CSIDL_DESKTOP(), CREATE);
          return $dir if $dir and $class->_d($dir);
      }
  
      # MSWindows sets WINDIR, MS WinNT sets USERPROFILE.
      foreach my $e ('USERPROFILE', 'WINDIR')
      {
          next unless $ENV{$e};
          my $desktop = File::Spec->catdir($ENV{$e}, 'Desktop');
          return $desktop if $desktop and $class->_d($desktop);
      }
  
      # As a last resort, try some hard-wired values
      foreach my $fixed (
          # The reason there are both types of slash here is because
          # this set of paths has been kept from the original version
          # of File::HomeDir::Win32 (before it was rewritten).
          # I can only assume this is Cygwin-related stuff.
          "C:\\windows\\desktop",
          "C:\\win95\\desktop",
          "C:/win95/desktop",
          "C:/windows/desktop",
        )
      {
          return $fixed if $class->_d($fixed);
      }
  
      return undef;
  }
  
  sub my_documents
  {
      my $class = shift;
  
      # The most correct way to find my documents
    SCOPE:
      {
          require Win32;
          my $dir = Win32::GetFolderPath(Win32::CSIDL_PERSONAL(), CREATE);
          return $dir if $dir and $class->_d($dir);
      }
  
      return undef;
  }
  
  sub my_data
  {
      my $class = shift;
  
      # The most correct way to find my documents
    SCOPE:
      {
          require Win32;
          my $dir = Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA(), CREATE);
          return $dir if $dir and $class->_d($dir);
      }
  
      return undef;
  }
  
  sub my_music
  {
      my $class = shift;
  
      # The most correct way to find my music
    SCOPE:
      {
          require Win32;
          my $dir = Win32::GetFolderPath(Win32::CSIDL_MYMUSIC(), CREATE);
          return $dir if $dir and $class->_d($dir);
      }
  
      return undef;
  }
  
  sub my_pictures
  {
      my $class = shift;
  
      # The most correct way to find my pictures
    SCOPE:
      {
          require Win32;
          my $dir = Win32::GetFolderPath(Win32::CSIDL_MYPICTURES(), CREATE);
          return $dir if $dir and $class->_d($dir);
      }
  
      return undef;
  }
  
  sub my_videos
  {
      my $class = shift;
  
      # The most correct way to find my videos
    SCOPE:
      {
          require Win32;
          my $dir = Win32::GetFolderPath(Win32::CSIDL_MYVIDEO(), CREATE);
          return $dir if $dir and $class->_d($dir);
      }
  
      return undef;
  }
  
  # Special case version of -d
  sub _d
  {
      my $self = shift;
      my $path = shift;
  
      # Window can legally return a UNC path from GetFolderPath.
      # Not only is the meaning of -d complicated in this situation,
      # but even on a local network calling -d "\\\\cifs\\path" can
      # take several seconds. UNC can also do even weirder things,
      # like launching processes and such.
      # To avoid various crazy bugs caused by this, we do NOT attempt
      # to validate UNC paths at all so that the code that is calling
      # us has an opportunity to take special actions without our
      # blundering getting in the way.
      if ($path =~ /\\\\/)
      {
          return 1;
      }
  
      # Otherwise do a stat as normal
      return -d $path;
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  File::HomeDir::Windows - Find your home and other directories on Windows
  
  =head1 SYNOPSIS
  
    use File::HomeDir;
    
    # Find directories for the current user (eg. using Windows XP Professional)
    $home    = File::HomeDir->my_home;        # C:\Documents and Settings\mylogin
    $desktop = File::HomeDir->my_desktop;     # C:\Documents and Settings\mylogin\Desktop
    $docs    = File::HomeDir->my_documents;   # C:\Documents and Settings\mylogin\My Documents
    $music   = File::HomeDir->my_music;       # C:\Documents and Settings\mylogin\My Documents\My Music
    $pics    = File::HomeDir->my_pictures;    # C:\Documents and Settings\mylogin\My Documents\My Pictures
    $videos  = File::HomeDir->my_videos;      # C:\Documents and Settings\mylogin\My Documents\My Video
    $data    = File::HomeDir->my_data;        # C:\Documents and Settings\mylogin\Local Settings\Application Data
  
  =head1 DESCRIPTION
  
  This module provides Windows-specific implementations for determining
  common user directories.  In normal usage this module will always be
  used via L<File::HomeDir>.
  
  Internally this module will use L<Win32>::GetFolderPath to fetch the location
  of your directories. As a result of this, in certain unusual situations
  (usually found inside large organizations) the methods may return UNC paths
  such as C<\\cifs.local\home$>.
  
  If your application runs on Windows and you want to have it work comprehensively
  everywhere, you may need to implement your own handling for these paths as they
  can cause strange behaviour.
  
  For example, stat calls to UNC paths may work but block for several seconds, but
  opendir() may not be able to read any files (creating the appearance of an existing
  but empty directory).
  
  To avoid complicating the problem any further, in the rare situation that a UNC path
  is returned by C<GetFolderPath> the usual -d validation checks will B<not> be done.
  
  =head1 SUPPORT
  
  See the support section the main L<File::HomeDir> module.
  
  =head1 AUTHORS
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  Sean M. Burke E<lt>sburke@cpan.orgE<gt>
  
  =head1 SEE ALSO
  
  L<File::HomeDir>, L<File::HomeDir::Win32> (legacy)
  
  =head1 COPYRIGHT
  
  Copyright 2005 - 2011 Adam Kennedy.
  
  Copyright 2017 - 2020 Jens Rehsack
  
  Some parts copyright 2000 Sean M. Burke.
  
  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
FILE_HOMEDIR_WINDOWS

$fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH';
  package File::Which;
  
  use strict;
  use warnings;
  use base qw( Exporter );
  use File::Spec ();
  
  # ABSTRACT: Perl implementation of the which utility as an API
  our $VERSION = '1.27'; # VERSION
  
  
  our @EXPORT    = 'which';
  our @EXPORT_OK = 'where';
  
  use constant IS_VMS => ($^O eq 'VMS');
  use constant IS_MAC => ($^O eq 'MacOS');
  use constant IS_WIN => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');
  use constant IS_DOS => IS_WIN();
  use constant IS_CYG => ($^O eq 'cygwin' || $^O eq 'msys');
  
  our $IMPLICIT_CURRENT_DIR = IS_WIN || IS_VMS || IS_MAC;
  
  # For Win32 systems, stores the extensions used for
  # executable files
  # For others, the empty string is used
  # because 'perl' . '' eq 'perl' => easier
  my @PATHEXT = ('');
  if ( IS_WIN ) {
    # WinNT. PATHEXT might be set on Cygwin, but not used.
    if ( $ENV{PATHEXT} ) {
      push @PATHEXT, split /;/, $ENV{PATHEXT};
    } else {
      # Win9X or other: doesn't have PATHEXT, so needs hardcoded.
      push @PATHEXT, qw{.com .exe .bat};
    }
  } elsif ( IS_VMS ) {
    push @PATHEXT, qw{.exe .com};
  } elsif ( IS_CYG ) {
    # See this for more info
    # http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-exe
    push @PATHEXT, qw{.exe .com};
  }
  
  
  sub which {
    my ($exec) = @_;
  
    return undef unless defined $exec;
    return undef if $exec eq '';
  
    my $all = wantarray;  ## no critic (Freenode::Wantarray)
    my @results = ();
  
    # check for aliases first
    if ( IS_VMS ) {
      my $symbol = `SHOW SYMBOL $exec`;
      chomp($symbol);
      unless ( $? ) {
        return $symbol unless $all;
        push @results, $symbol;
      }
    }
    if ( IS_MAC ) {
      my @aliases = split /\,/, $ENV{Aliases};
      foreach my $alias ( @aliases ) {
        # This has not been tested!!
        # PPT which says MPW-Perl cannot resolve `Alias $alias`,
        # let's just hope it's fixed
        if ( lc($alias) eq lc($exec) ) {
          chomp(my $file = `Alias $alias`);
          last unless $file;  # if it failed, just go on the normal way
          return $file unless $all;
          push @results, $file;
          # we can stop this loop as if it finds more aliases matching,
          # it'll just be the same result anyway
          last;
        }
      }
    }
  
    return $exec  ## no critic (ValuesAndExpressions::ProhibitMixedBooleanOperators)
            if !IS_VMS and !IS_MAC and !IS_WIN and $exec =~ /\// and -f $exec and -x $exec;
  
    my @path;
    if($^O eq 'MSWin32') {
      # File::Spec (at least recent versions)
      # add the implicit . for you on MSWin32,
      # but we may or may not want to include
      # that.
      @path = split /;/, $ENV{PATH};
      s/"//g for @path;
      @path = grep length, @path;
    } else {
      @path = File::Spec->path;
    }
    if ( $IMPLICIT_CURRENT_DIR ) {
      unshift @path, File::Spec->curdir;
    }
  
    foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
      for my $ext ( @PATHEXT ) {
        my $file = $base.$ext;
  
        # We don't want dirs (as they are -x)
        next if -d $file;
  
        if (
          # Executable, normal case
          -x _
          or (
            # MacOS doesn't mark as executable so we check -e
            IS_MAC  ## no critic (ValuesAndExpressions::ProhibitMixedBooleanOperators)
            ||
            (
              ( IS_WIN or IS_CYG )
              and
              grep {   ## no critic (BuiltinFunctions::ProhibitBooleanGrep)
                $file =~ /$_\z/i
              } @PATHEXT[1..$#PATHEXT]
            )
            # DOSish systems don't pass -x on
            # non-exe/bat/com files. so we check -e.
            # However, we don't want to pass -e on files
            # that aren't in PATHEXT, like README.
            and -e _
          )
        ) {
          return $file unless $all;
          push @results, $file;
        }
      }
    }
  
    if ( $all ) {
      return @results;
    } else {
      return undef;
    }
  }
  
  
  sub where {
    # force wantarray
    my @res = which($_[0]);
    return @res;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  File::Which - Perl implementation of the which utility as an API
  
  =head1 VERSION
  
  version 1.27
  
  =head1 SYNOPSIS
  
   use File::Which;                  # exports which()
   use File::Which qw(which where);  # exports which() and where()
   
   my $exe_path = which 'perldoc';
   
   my @paths = where 'perl';
   # Or
   my @paths = which 'perl'; # an array forces search for all of them
  
  =head1 DESCRIPTION
  
  L<File::Which> finds the full or relative paths to executable programs on
  the system.  This is normally the function of C<which> utility.  C<which> is
  typically implemented as either a program or a built in shell command.  On
  some platforms, such as Microsoft Windows it is not provided as part of the
  core operating system.  This module provides a consistent API to this
  functionality regardless of the underlying platform.
  
  The focus of this module is correctness and portability.  As a consequence
  platforms where the current directory is implicitly part of the search path
  such as Microsoft Windows will find executables in the current directory,
  whereas on platforms such as UNIX where this is not the case executables
  in the current directory will only be found if the current directory is
  explicitly added to the path.
  
  If you need a portable C<which> on the command line in an environment that
  does not provide it, install L<App::pwhich> which provides a command line
  interface to this API.
  
  =head2 Implementations
  
  L<File::Which> searches the directories of the user's C<PATH> (the current
  implementation uses L<File::Spec#path> to determine the correct C<PATH>),
  looking for executable files having the name specified as a parameter to
  L</which>. Under Win32 systems, which do not have a notion of directly
  executable files, but uses special extensions such as C<.exe> and C<.bat>
  to identify them, C<File::Which> takes extra steps to assure that
  you will find the correct file (so for example, you might be searching for
  C<perl>, it'll try F<perl.exe>, F<perl.bat>, etc.)
  
  =head3 Linux, *BSD and other UNIXes
  
  There should not be any surprises here.  The current directory will not be
  searched unless it is explicitly added to the path.
  
  =head3 Modern Windows (including NT, XP, Vista, 7, 8, 10 etc)
  
  Windows NT has a special environment variable called C<PATHEXT>, which is used
  by the shell to look for executable files. Usually, it will contain a list in
  the form C<.EXE;.BAT;.COM;.JS;.VBS> etc. If C<File::Which> finds such an
  environment variable, it parses the list and uses it as the different
  extensions.
  
  =head3 Cygwin
  
  Cygwin provides a Unix-like environment for Microsoft Windows users.  In most
  ways it works like other Unix and Unix-like environments, but in a few key
  aspects it works like Windows.  As with other Unix environments, the current
  directory is not included in the search unless it is explicitly included in
  the search path.  Like on Windows, files with C<.EXE> or <.BAT> extensions will
  be discovered even if they are not part of the query.  C<.COM> or extensions
  specified using the C<PATHEXT> environment variable will NOT be discovered
  without the fully qualified name, however.
  
  =head3 Windows ME, 98, 95, MS-DOS, OS/2
  
  This set of operating systems don't have the C<PATHEXT> variable, and usually
  you will find executable files there with the extensions C<.exe>, C<.bat> and
  (less likely) C<.com>. C<File::Which> uses this hardcoded list if it's running
  under Win32 but does not find a C<PATHEXT> variable.
  
  As of 2015 none of these platforms are tested frequently (or perhaps ever),
  but the current maintainer is determined not to intentionally remove support
  for older operating systems.
  
  =head3 VMS
  
  Same case as Windows 9x: uses C<.exe> and C<.com> (in that order).
  
  As of 2015 the current maintainer does not test on VMS, and is in fact not
  certain it has ever been tested on VMS.  If this platform is important to you
  and you can help me verify and or support it on that platform please contact
  me.
  
  =head1 FUNCTIONS
  
  =head2 which
  
   my $path = which $short_exe_name;
   my @paths = which $short_exe_name;
  
  Exported by default.
  
  C<$short_exe_name> is the name used in the shell to call the program (for
  example, C<perl>).
  
  If it finds an executable with the name you specified, C<which()> will return
  the absolute path leading to this executable (for example, F</usr/bin/perl> or
  F<C:\Perl\Bin\perl.exe>).
  
  If it does I<not> find the executable, it returns C<undef>.
  
  If C<which()> is called in list context, it will return I<all> the
  matches.
  
  =head2 where
  
   my @paths = where $short_exe_name;
  
  Not exported by default.
  
  Same as L</which> in array context.  Similar to the C<where> csh
  built-in command or C<which -a> command for platforms that support the
  C<-a> option. Will return an array containing all the path names
  matching C<$short_exe_name>.
  
  =head1 GLOBALS
  
  =head2 $IMPLICIT_CURRENT_DIR
  
  True if the current directory is included in the search implicitly on
  whatever platform you are using.  Normally the default is reasonable,
  but on Windows the current directory is included implicitly for older
  shells like C<cmd.exe> and C<command.com>, but not for newer shells
  like PowerShell.  If you overrule this default, you should ALWAYS
  localize the variable to the tightest scope possible, since setting
  this variable from a module can affect other modules.  Thus on Windows
  you can get the correct result if the user is running either C<cmd.exe>
  or PowerShell on Windows you can do this:
  
   use File::Which qw( which );
   use Shell::Guess;
   
   my $path = do {
     my $is_power = Shell::Guess->running_shell->is_power;
     local $File::Which::IMPLICIT_CURRENT_DIR = !$is_power;
     which 'foo';
   };
  
  For a variety of reasons it is difficult to accurately compute the
  shell that a user is using, but L<Shell::Guess> makes a reasonable
  effort.
  
  =head1 CAVEATS
  
  This module has no non-core requirements for Perl 5.6.2 and better.
  
  This module is fully supported back to Perl 5.8.1.  It may work on 5.8.0.
  It should work on Perl 5.6.x and I may even test on 5.6.2.  I will accept
  patches to maintain compatibility for such older Perls, but you may
  need to fix it on 5.6.x / 5.8.0 and send me a patch.
  
  Not tested on VMS although there is platform specific code
  for those. Anyone who haves a second would be very kind to send me a
  report of how it went.
  
  =head1 SUPPORT
  
  Bugs should be reported via the GitHub issue tracker
  
  L<https://github.com/uperl/File-Which/issues>
  
  For other issues, contact the maintainer.
  
  =head1 SEE ALSO
  
  =over 4
  
  =item L<pwhich>, L<App::pwhich>
  
  Command line interface to this module.
  
  =item L<IPC::Cmd>
  
  Requires Perl 5.8.3.  Included as part of the Perl core as of 5.9.5.
  
  This module provides (among other things) a C<can_run> function, which is
  similar to C<which>.  It is a much heavier module since it does a lot more,
  and if you use C<can_run> it pulls in L<ExtUtils::MakeMaker>.  This combination
  may be overkill for applications which do not need L<IPC::Cmd>'s complicated
  interface for running programs, or do not need the memory overhead required
  for installing Perl modules.
  
  At least some older versions will find executables in the current directory,
  even if the current directory is not in the search path (which is the default
  on modern Unix).
  
  C<can_run> converts directory path name to the 8.3 version on Windows using
  C<Win32::GetShortPathName> in some cases.  This is frequently useful for tools
  that just need to run something using C<system> in scalar mode, but may be
  inconvenient for tools like L<App::pwhich> where user readability is a premium.
  Relying on C<Win32::GetShortPathName> to produce filenames without spaces
  is problematic, as 8.3 filenames can be turned off with tweaks to the
  registry (see L<https://technet.microsoft.com/en-us/library/cc959352.aspx>).
  
  =item L<Devel::CheckBin>
  
  Requires Perl 5.8.1.
  
  This module purports to "check that a command is available", but does not
  provide any documentation on how you might use it.
  
  This module also relies on L<ExtUtils::MakeMaker> so has the same overhead
  burdens as L<IPC::Cmd>.
  
  =back
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Per Einar Ellefsen <pereinar@cpan.org>
  
  =item *
  
  Adam Kennedy <adamk@cpan.org>
  
  =item *
  
  Graham Ollis <plicease@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2002 by Per Einar Ellefsen <pereinar@cpan.org>.
  
  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
FILE_WHICH

$fatpacked{"HTTP/Tinyish.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH';
  package HTTP::Tinyish;
  use strict;
  use warnings;
  use Carp ();
  
  our $VERSION = '0.18';
  
  our $PreferredBackend; # for tests
  our @Backends = map "HTTP::Tinyish::$_", qw( LWP HTTPTiny Curl Wget );
  my %configured;
  
  sub new {
      my($class, %attr) = @_;
      bless \%attr, $class;
  }
  
  for my $method (qw/get head put post delete mirror patch/) {
      no strict 'refs';
      eval <<"HERE";
      sub $method {
          my \$self = shift;
          \$self->_backend_for(\$_[0])->$method(\@_);
      }
  HERE
  }
  
  sub request {
      my $self = shift;
      $self->_backend_for($_[1])->request(@_);
  }
  
  sub _backend_for {
      my($self, $url) = @_;
  
      my($scheme) = $url =~ m!^(https?):!;
      Carp::croak "URL Scheme '$url' not supported." unless $scheme;
  
      for my $backend ($self->backends) {
          $self->configure_backend($backend) or next;
          if ($backend->supports($scheme)) {
              return $backend->new(%$self);
          }
      }
  
      Carp::croak "No backend configured for scheme $scheme";
  }
  
  sub backends {
      $PreferredBackend ? ($PreferredBackend) : @Backends;
  }
  
  sub configure_backend {
      my($self, $backend) = @_;
      unless (exists $configured{$backend}) {
          $configured{$backend} =
            eval { require_module($backend); $backend->configure };
      }
      $configured{$backend};
  }
  
  sub require_module {
      local $_ = shift;
      s!::!/!g;
      require "$_.pm";
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  HTTP::Tinyish - HTTP::Tiny compatible HTTP client wrappers
  
  =head1 SYNOPSIS
  
    my $http = HTTP::Tinyish->new(agent => "Mozilla/4.0");
  
    my $res = $http->get("http://www.cpan.org/");
    warn $res->{status};
  
    $http->post("http://example.com/post", {
        headers => { "Content-Type" => "application/x-www-form-urlencoded" },
        content => "foo=bar&baz=quux",
    });
  
    $http->mirror("http://www.cpan.org/modules/02packages.details.txt.gz", "./02packages.details.txt.gz");
  
  =head1 DESCRIPTION
  
  HTTP::Tinyish is a wrapper module for HTTP client modules
  L<LWP>, L<HTTP::Tiny> and HTTP client software C<curl> and C<wget>.
  
  It provides an API compatible to HTTP::Tiny, and the implementation
  has been extracted out of L<App::cpanminus>. This module can be useful
  in a restrictive environment where you need to be able to download
  CPAN modules without an HTTPS support in built-in HTTP library.
  
  =head1 BACKEND SELECTION
  
  Backends are searched in the order of: L<LWP>, L<HTTP::Tiny>, C<curl>
  and C<wget>. HTTP::Tinyish will auto-detect if the backend also
  supports HTTPS, and use the appropriate backend based on the given
  URL to the request methods.
  
  For example, if you only have HTTP::Tiny but without SSL related
  modules, it is possible that:
  
    my $http = HTTP::Tinyish->new;
  
    $http->get("http://example.com");  # uses HTTP::Tiny
    $http->get("https://example.com"); # uses curl
  
  =head1 COMPATIBILITIES
  
  All request related methods such as C<get>, C<post>, C<put>,
  C<delete>, C<request>, C<patch> and C<mirror> are supported.
  
  =head2 LWP
  
  =over 4
  
  =item *
  
  L<LWP> backend requires L<LWP> 5.802 or over to be functional, and L<LWP::Protocol::https> to send HTTPS requests.
  
  =item *
  
  C<mirror> method doesn't consider third options hash into account (i.e. you can't override the HTTP headers).
  
  =item *
  
  proxy is automatically detected from environment variables.
  
  =item *
  
  C<timeout>, C<max_redirect>, C<agent>, C<default_headers> and C<verify_SSL> are translated.
  
  =back
  
  =head2 HTTP::Tiny
  
  Because the actual HTTP::Tiny backend is used, all APIs are supported.
  
  =head2 Curl
  
  =over
  
  =item *
  
  This module has been tested with curl 7.22 and later.
  
  =item *
  
  HTTPS support is automatically detected by running C<curl --version> and see its protocol output.
  
  =item *
  
  C<timeout>, C<max_redirect>, C<agent>, C<default_headers> and C<verify_SSL> are supported.
  
  =back
  
  =head2 Wget
  
  =over 4
  
  =item *
  
  This module requires Wget 1.12 and later.
  
  =item *
  
  Wget prior to 1.15 doesn't support sending custom HTTP methods, so if you use C<< $http->put >> for example, you'll get an internal error response (599).
  
  =item *
  
  HTTPS support is automatically detected.
  
  =item *
  
  C<mirror()> method doesn't send C<If-Modified-Since> header to the server, which will result in full-download every time because C<wget> doesn't support C<--timestamping> combined with C<-O> option.
  
  =item *
  
  C<timeout>, C<max_redirect>, C<agent>, C<default_headers> and C<verify_SSL> are supported.
  
  =back
  
  =head1 SIMILAR MODULES
  
  =over 4
  
  =item *
  
  L<File::Fetch> - is core since 5.10. Has support for non-HTTP protocols such as ftp and git. Does not support HTTPS or basic authentication as of this writing.
  
  =item *
  
  L<Plient> - provides more complete runtime API, but seems only compatible on Unix environments. Does not support mirror() method.
  
  =back
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa
  
  =head1 COPYRIGHT
  
  Tatsuhiko Miyagawa, 2015-
  
  =head1 LICENSE
  
  This module is licensed under the same terms as Perl itself.
  
  =cut
  
HTTP_TINYISH

$fatpacked{"HTTP/Tinyish/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_BASE';
  package HTTP::Tinyish::Base;
  use strict;
  use warnings;
  
  for my $sub_name ( qw/get head put post delete patch/ ) {
      my $req_method = uc $sub_name;
      eval <<"HERE";
      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 parse_http_header {
      my($self, $header, $res) = @_;
  
      # it might have multiple headers in it because of redirects
      $header =~ s/.*^(HTTP\/\d(?:\.\d)?)/$1/ms;
  
      # grab the first chunk until the line break
      if ($header =~ /^(.*?\x0d?\x0a\x0d?\x0a)/) {
          $header = $1;
      }
  
      # parse into lines
      my @header = split /\x0d?\x0a/,$header;
      my $status_line = shift @header;
  
      # join folded lines
      my @out;
      for (@header) {
          if(/^[ \t]+/) {
              return -1 unless @out;
              $out[-1] .= $_;
          } else {
              push @out, $_;
          }
      }
  
      my($proto, $status, $reason) = split / /, $status_line, 3;
      return unless $proto and $proto =~ /^HTTP\/(\d+)(\.(\d+))?$/i;
  
      $res->{status} = $status;
      $res->{reason} = $reason;
      $res->{success} = $status =~ /^(?:2|304)/;
      $res->{protocol} = $proto;
  
      # import headers
      my $token = qr/[^][\x00-\x1f\x7f()<>@,;:\\"\/?={} \t]+/;
      my $k;
      for my $header (@out) {
          if ( $header =~ s/^($token): ?// ) {
              $k = lc $1;
          } elsif ( $header =~ /^\s+/) {
              # multiline header
          } else {
              return -1;
          }
  
          if (exists $res->{headers}{$k}) {
              $res->{headers}{$k} = [$res->{headers}{$k}]
                unless ref $res->{headers}{$k};
              push @{$res->{headers}{$k}}, $header;
          } else {
              $res->{headers}{$k} = $header;
          }
      }
  }
  
  sub internal_error {
      my($self, $url, $message) = @_;
  
      return {
          content => $message,
          headers => { "content-length" => length($message), "content-type" => "text/plain" },
          reason  => "Internal Exception",
          status  => 599,
          success => "",
          url     => $url,
      };
  }
  
  1;
HTTP_TINYISH_BASE

$fatpacked{"HTTP/Tinyish/Curl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_CURL';
  package HTTP::Tinyish::Curl;
  use strict;
  use warnings;
  use parent qw(HTTP::Tinyish::Base);
  
  use IPC::Run3 qw(run3);
  use File::Which qw(which);
  use File::Temp ();
  
  my %supports;
  my $curl;
  
  sub _slurp {
      open my $fh, "<", shift or die $!;
      local $/;
      <$fh>;
  }
  
  sub configure {
      my $class = shift;
  
      my %meta;
      $curl = which('curl');
  
      eval {
          run3([$curl, '--version'], \undef, \my $version, \my $error);
          if ($version =~ /^Protocols: (.*)/m) {
              my %protocols = map { $_ => 1 } split /\s/, $1;
              $supports{http}  = 1 if $protocols{http};
              $supports{https} = 1 if $protocols{https};
          }
  
          $meta{$curl} = $version;
      };
  
      \%meta;
  }
  
  sub supports { $supports{$_[1]} }
  
  sub new {
      my($class, %attr) = @_;
      bless \%attr, $class;
  }
  
  sub request {
      my($self, $method, $url, $opts) = @_;
      $opts ||= {};
  
      my(undef, $temp) = File::Temp::tempfile(UNLINK => 1);
  
      my($output, $error);
      eval {
          run3 [
              $curl,
              '-X', $method,
              ($method eq 'HEAD' ? ('--head') : ()),
              $self->build_options($url, $opts),
              '--dump-header', $temp,
              $url,
          ], \undef, \$output, \$error;
      };
  
      if ($@ or $?) {
          return $self->internal_error($url, $@ || $error);
      }
  
      my $res = { url => $url, content => $output };
      $self->parse_http_header( _slurp($temp), $res );
      $res;
  }
  
  sub mirror {
      my($self, $url, $file, $opts) = @_;
      $opts ||= {};
  
      my(undef, $temp) = File::Temp::tempfile(UNLINK => 1);
  
      my($output, $error);
      eval {
          run3 [
              $curl,
              $self->build_options($url, $opts),
              '-z', $file,
              '-o', $file,
              '--dump-header', $temp,
              '--remote-time',
              $url,
          ], \undef, \$output, \$error;
      };
  
      if ($@ or $?) {
          return $self->internal_error($url, $@ || $error);
      }
  
      my $res = { url => $url, content => $output };
      $self->parse_http_header( _slurp($temp), $res );
      $res;
  }
  
  sub build_options {
      my($self, $url, $opts) = @_;
  
      my @options = (
          '--silent',
          '--show-error',
          '--max-time', ($self->{timeout} || 60),
          '--user-agent', ($self->{agent} || "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),
      );
      if (my $max_redirect = exists $self->{max_redirect} ? $self->{max_redirect} : 5) {
          push @options, '--location', '--max-redirs', $max_redirect;
      }
  
      my %headers;
      if ($self->{default_headers}) {
          %headers = %{$self->{default_headers}};
      }
      if ($opts->{headers}) {
          %headers = (%headers, %{$opts->{headers}});
      }
      $self->_translate_headers(\%headers, \@options);
  
      unless ($self->{verify_SSL}) {
          push @options, '--insecure';
      }
  
      if ($opts->{content}) {
          my $content;
          if (ref $opts->{content} eq 'CODE') {
              while (my $chunk = $opts->{content}->()) {
                  $content .= $chunk;
              }
          } else {
              $content = $opts->{content};
          }
          push @options, '--data', $content;
      }
  
      @options;
  }
  
  sub _translate_headers {
      my($self, $headers, $options) = @_;
  
      for my $field (keys %$headers) {
          my $value = $headers->{$field};
          if (ref $value eq 'ARRAY') {
              push @$options, map { ('-H', "$field:$_") } @$value;
          } else {
              push @$options, '-H', "$field:$value";
          }
      }
  }
  
  1;
HTTP_TINYISH_CURL

$fatpacked{"HTTP/Tinyish/HTTPTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_HTTPTINY';
  package HTTP::Tinyish::HTTPTiny;
  use strict;
  use parent qw(HTTP::Tinyish::Base);
  use HTTP::Tiny;
  
  my %supports = (http => 1);
  
  sub configure {
      my %meta = ("HTTP::Tiny" => $HTTP::Tiny::VERSION);
  
      $supports{https} = HTTP::Tiny->can_ssl;
  
      \%meta;
  }
  
  sub supports { $supports{$_[1]} }
  
  sub new {
      my($class, %attrs) = @_;
      bless {
          tiny => HTTP::Tiny->new(%attrs),
      }, $class;
  }
  
  sub request {
      my $self = shift;
      $self->{tiny}->request(@_);
  }
  
  sub mirror {
      my $self = shift;
      $self->{tiny}->mirror(@_);
  }
  
  1;
  
HTTP_TINYISH_HTTPTINY

$fatpacked{"HTTP/Tinyish/LWP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_LWP';
  package HTTP::Tinyish::LWP;
  use strict;
  use parent qw(HTTP::Tinyish::Base);
  
  use LWP 5.802;
  use LWP::UserAgent;
  
  my %supports = (http => 1);
  
  sub configure {
      my %meta = (
          LWP => $LWP::VERSION,
      );
  
      if (eval { require LWP::Protocol::https; require Mozilla::CA; 1 }) {
          $supports{https} = 1;
          $meta{"LWP::Protocol::https"} = $LWP::Protocol::https::VERSION;
      }
  
      \%meta;
  }
  
  sub supports {
      $supports{$_[1]};
  }
  
  sub new {
      my($class, %attr) = @_;
  
      my $ua = LWP::UserAgent->new;
      
      bless {
          ua => $class->translate_lwp($ua, %attr),
      }, $class;
  }
  
  sub _headers_to_hashref {
      my($self, $hdrs) = @_;
  
      my %headers;
      for my $field ($hdrs->header_field_names) {
          $headers{lc $field} = $hdrs->header($field); # could be an array ref
      }
  
      \%headers;
  }
  
  sub request {
      my($self, $method, $url, $opts) = @_;
      $opts ||= {};
  
      my $req = HTTP::Request->new($method => $url);
  
      if ($opts->{headers}) {
          $req->header(%{$opts->{headers}});
      }
  
      if ($opts->{content}) {
          $req->content($opts->{content});
      }
  
      my $res = $self->{ua}->request($req);
  
      if ($self->is_internal_response($res)) {
          return $self->internal_error($url, $res->content);
      }
  
      return {
          url      => $url,
          content  => $res->decoded_content(charset => 'none'),
          success  => $res->is_success,
          status   => $res->code,
          reason   => $res->message,
          headers  => $self->_headers_to_hashref($res->headers),
          protocol => $res->protocol,
      };
  }
  
  sub mirror {
      my($self, $url, $file) = @_;
  
      # TODO support optional headers
      my $res = $self->{ua}->mirror($url, $file);
  
      if ($self->is_internal_response($res)) {
          return $self->internal_error($url, $res->content);
      }
  
      return {
          url      => $url,
          content  => $res->decoded_content,
          success  => $res->is_success || $res->code == 304,
          status   => $res->code,
          reason   => $res->message,
          headers  => $self->_headers_to_hashref($res->headers),
          protocol => $res->protocol,
      };
  }
  
  sub translate_lwp {
      my($class, $agent, %attr) = @_;
  
      $agent->parse_head(0);
      $agent->env_proxy;
      $agent->timeout(delete $attr{timeout} || 60);
      $agent->max_redirect(exists $attr{max_redirect} ? $attr{max_redirect} : 5);
      $agent->agent(delete $attr{agent} || "HTTP-Tinyish/$HTTP::Tinyish::VERSION");
  
      # LWP default is to verify, HTTP::Tiny isn't
      unless ($attr{verify_SSL}) {
          if ($agent->can("ssl_opts")) {
              $agent->ssl_opts(verify_hostname => 0);
          }
      }
  
      if ($attr{default_headers}) {
          $agent->default_headers( HTTP::Headers->new(%{$attr{default_headers}}) );
      }
  
      $agent;
  }
  
  sub is_internal_response {
      my($self, $res) = @_;
  
      $res->code == 500 &&
        ( $res->header('Client-Warning') || '' ) eq 'Internal response';
  }
  
  1;
HTTP_TINYISH_LWP

$fatpacked{"HTTP/Tinyish/Wget.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_WGET';
  package HTTP::Tinyish::Wget;
  use strict;
  use warnings;
  use parent qw(HTTP::Tinyish::Base);
  
  use IPC::Run3 qw(run3);
  use File::Which qw(which);
  
  my %supports;
  my $wget;
  my $method_supported;
  
  sub _run_wget {
      run3([$wget, @_], \undef, \my $out, \my $err);
      wantarray ? ($out, $err) : $out;
  }
  
  sub configure {
      my $class = shift;
      my %meta;
  
      $wget = which('wget');
  
      eval {
          local $ENV{LC_ALL} = 'en_US';
  
          $meta{$wget} = _run_wget('--version');
          unless ($meta{$wget} =~ /GNU Wget 1\.(\d+)/ and $1 >= 12) {
              die "Wget version is too old. $meta{$wget}";
          }
  
          my $config = $class->new(agent => __PACKAGE__);
          my @options = grep { $_ ne '--quiet' } $config->build_options("GET");
  
          my(undef, $err) = _run_wget(@options, 'https://');
          if ($err && $err =~ /HTTPS support not compiled/) {
              $supports{http} = 1;
          } elsif ($err && $err =~ /Invalid host/) {
              $supports{http} = $supports{https} = 1;
          }
  
          (undef, $err) = _run_wget('--method', 'GET', 'http://');
          if ($err && $err =~ /Invalid host/) {
              $method_supported = $meta{method_supported} = 1;
          }
  
      };
  
      \%meta;
  }
  
  sub supports { $supports{$_[1]} }
  
  sub new {
      my($class, %attr) = @_;
      bless \%attr, $class;
  }
  
  sub request {
      my($self, $method, $url, $opts) = @_;
      $opts ||= {};
  
      my($stdout, $stderr);
      eval {
          run3 [
              $wget,
              $self->build_options($method, $url, $opts),
              $url,
              '-O', '-',
          ], \undef, \$stdout, \$stderr;
      };
  
      # wget exit codes: (man wget)
      # 4   Network failure.
      # 5   SSL verification failure.
      # 6   Username/password authentication failure.
      # 7   Protocol errors.
      # 8   Server issued an error response.
      if ($@ or $? && ($? >> 8) <= 5) {
          return $self->internal_error($url, $@ || $stderr);
      }
  
      my $header = '';
      $stderr =~ s{^  (\S.*)$}{ $header .= $1."\n" }gem;
  
      my $res = { url => $url, content => $stdout };
      $self->parse_http_header($header, $res);
      $res;
  }
  
  sub mirror {
      my($self, $url, $file, $opts) = @_;
      $opts ||= {};
  
      # This doesn't send If-Modified-Since because -O and -N are mutually exclusive :(
      my($stdout, $stderr);
      eval {
          run3 [$wget, $self->build_options("GET", $url, $opts), $url, '-O', $file], \undef, \$stdout, \$stderr;
      };
  
      if ($@ or $?) {
          return $self->internal_error($url, $@ || $stderr);
      }
  
      $stderr =~ s/^  //gm;
  
      my $res = { url => $url, content => $stdout };
      $self->parse_http_header($stderr, $res);
      $res;
  }
  
  sub build_options {
      my($self, $method, $url, $opts) = @_;
  
      my @options = (
          '--retry-connrefused',
          '--server-response',
          '--timeout', ($self->{timeout} || 60),
          '--tries', 1,
          '--max-redirect', (exists $self->{max_redirect} ? $self->{max_redirect} : 5),
          '--user-agent', ($self->{agent} || "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),
      );
  
      if ($method_supported) {
          push @options, "--method", $method;
      } else {
          if ($method eq 'GET' or $method eq 'POST') {
              # OK
          } elsif ($method eq 'HEAD') {
              push @options, '--spider';
          } else {
              die "This version of wget doesn't support specifying HTTP method '$method'";
          }
      }
  
      if ($self->{agent}) {
          push @options, '--user-agent', $self->{agent};
      }
  
      my %headers;
      if ($self->{default_headers}) {
          %headers = %{$self->{default_headers}};
      }
      if ($opts->{headers}) {
          %headers = (%headers, %{$opts->{headers}});
      }
      $self->_translate_headers(\%headers, \@options);
  
      if ($supports{https} && !$self->{verify_SSL}) {
          push @options, '--no-check-certificate';
      }
  
      if ($opts->{content}) {
          my $content;
          if (ref $opts->{content} eq 'CODE') {
              while (my $chunk = $opts->{content}->()) {
                  $content .= $chunk;
              }
          } else {
              $content = $opts->{content};
          }
  
          if ($method_supported) {
              push @options, '--body-data', $content;
          } else {
              push @options, '--post-data', $content;
          }
      }
  
      @options;
  }
  
  sub _translate_headers {
      my($self, $headers, $options) = @_;
  
      for my $field (keys %$headers) {
          my $value = $headers->{$field};
          if (ref $value eq 'ARRAY') {
              # wget doesn't honor multiple header fields
              push @$options, '--header', "$field:" . join(",", @$value);
          } else {
              push @$options, '--header', "$field:$value";
          }
      }
  }
  
  1;
HTTP_TINYISH_WGET

$fatpacked{"IPC/Run3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3';
  package IPC::Run3;
  BEGIN { require 5.006_000; } # i.e. 5.6.0
  use strict;
  
  =head1 NAME
  
  IPC::Run3 - run a subprocess with input/ouput redirection
  
  =head1 VERSION
  
  version 0.048
  
  =cut
  
  our $VERSION = '0.048';
  
  =head1 SYNOPSIS
  
      use IPC::Run3;    # Exports run3() by default
  
      run3 \@cmd, \$in, \$out, \$err;
  
  =head1 DESCRIPTION
  
  This module allows you to run a subprocess and redirect stdin, stdout,
  and/or stderr to files and perl data structures.  It aims to satisfy 99% of the
  need for using C<system>, C<qx>, and C<open3>
  with a simple, extremely Perlish API.
  
  Speed, simplicity, and portability are paramount.  (That's speed of Perl code;
  which is often much slower than the kind of buffered I/O that this module uses
  to spool input to and output from the child command.)
  
  =cut
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw( run3 );
  our %EXPORT_TAGS = ( all => \@EXPORT );
  
  use constant debugging => $ENV{IPCRUN3DEBUG} || $ENV{IPCRUNDEBUG} || 0;
  use constant profiling => $ENV{IPCRUN3PROFILE} || $ENV{IPCRUNPROFILE} || 0;
  use constant is_win32  => 0 <= index $^O, "Win32";
  
  BEGIN {
     if ( is_win32 ) {
        eval "use Win32 qw( GetOSName ); use Win32::ShellQuote qw(quote_native); 1" or die $@;
     }
  }
  
  #use constant is_win2k => is_win32 && GetOSName() =~ /Win2000/i;
  #use constant is_winXP => is_win32 && GetOSName() =~ /WinXP/i;
  
  use Carp qw( croak );
  use File::Temp qw( tempfile );
  use POSIX qw( dup dup2 );
  
  # We cache the handles of our temp files in order to
  # keep from having to incur the (largish) overhead of File::Temp
  my %fh_cache;
  my $fh_cache_pid = $$;
  
  my $profiler;
  
  sub _profiler { $profiler } # test suite access
  
  BEGIN {
      if ( profiling ) {
          eval "use Time::HiRes qw( gettimeofday ); 1" or die $@;
          if ( $ENV{IPCRUN3PROFILE} =~ /\A\d+\z/ ) {
              require IPC::Run3::ProfPP;
              IPC::Run3::ProfPP->import;
              $profiler = IPC::Run3::ProfPP->new(Level => $ENV{IPCRUN3PROFILE});
          } else {
              my ( $dest, undef, $class ) =
                 reverse split /(=)/, $ENV{IPCRUN3PROFILE}, 2;
              $class = "IPC::Run3::ProfLogger"
                  unless defined $class && length $class;
              if ( not eval "require $class" ) {
                  my $e = $@;
                  $class = "IPC::Run3::$class";
                  eval "require IPC::Run3::$class" or die $e;
              }
              $profiler = $class->new( Destination => $dest );
          }
          $profiler->app_call( [ $0, @ARGV ], scalar gettimeofday() );
      }
  }
  
  
  END {
      $profiler->app_exit( scalar gettimeofday() ) if profiling;
  }
  
  sub _binmode {
      my ( $fh, $mode, $what ) = @_;
      # if $mode is not given, then default to ":raw", except on Windows,
      # where we default to ":crlf";
      # otherwise if a proper layer string was given, use that,
      # else use ":raw"
      my $layer = !$mode
         ? (is_win32 ? ":crlf" : ":raw")
         : ($mode =~ /^:/ ? $mode : ":raw");
      warn "binmode $what, $layer\n" if debugging >= 2;
  
      binmode $fh, ":raw" unless $layer eq ":raw";      # remove all layers first
      binmode $fh, $layer or croak "binmode $layer failed: $!";
  }
  
  sub _spool_data_to_child {
      my ( $type, $source, $binmode_it ) = @_;
  
      # If undef (not \undef) passed, they want the child to inherit
      # the parent's STDIN.
      return undef unless defined $source;
  
      my $fh;
      if ( ! $type ) {
          open $fh, "<", $source or croak "$!: $source";
         _binmode($fh, $binmode_it, "STDIN");
          warn "run3(): feeding file '$source' to child STDIN\n"
              if debugging >= 2;
      } elsif ( $type eq "FH" ) {
          $fh = $source;
          warn "run3(): feeding filehandle '$source' to child STDIN\n"
              if debugging >= 2;
      } else {
          $fh = $fh_cache{in} ||= tempfile;
          truncate $fh, 0;
          seek $fh, 0, 0;
         _binmode($fh, $binmode_it, "STDIN");
          my $seekit;
          if ( $type eq "SCALAR" ) {
  
              # When the run3()'s caller asks to feed an empty file
              # to the child's stdin, we want to pass a live file
              # descriptor to an empty file (like /dev/null) so that
              # they don't get surprised by invalid fd errors and get
              # normal EOF behaviors.
              return $fh unless defined $$source;  # \undef passed
  
              warn "run3(): feeding SCALAR to child STDIN",
                  debugging >= 3
                     ? ( ": '", $$source, "' (", length $$source, " chars)" )
                     : (),
                  "\n"
                  if debugging >= 2;
  
              $seekit = length $$source;
              print $fh $$source or die "$! writing to temp file";
  
          } elsif ( $type eq "ARRAY" ) {
              warn "run3(): feeding ARRAY to child STDIN",
                  debugging >= 3 ? ( ": '", @$source, "'" ) : (),
                  "\n"
              if debugging >= 2;
  
              print $fh @$source or die "$! writing to temp file";
              $seekit = grep length, @$source;
          } elsif ( $type eq "CODE" ) {
              warn "run3(): feeding output of CODE ref '$source' to child STDIN\n"
                  if debugging >= 2;
              my $parms = [];  # TODO: get these from $options
              while (1) {
                  my $data = $source->( @$parms );
                  last unless defined $data;
                  print $fh $data or die "$! writing to temp file";
                  $seekit = length $data;
              }
          }
  
          seek $fh, 0, 0 or croak "$! seeking on temp file for child's stdin"
              if $seekit;
      }
  
      croak "run3() can't redirect $type to child stdin"
          unless defined $fh;
  
      return $fh;
  }
  
  sub _fh_for_child_output {
      my ( $what, $type, $dest, $options ) = @_;
  
      my $fh;
      if ( $type eq "SCALAR" && $dest == \undef ) {
          warn "run3(): redirecting child $what to oblivion\n"
              if debugging >= 2;
  
          $fh = $fh_cache{nul} ||= do {
              open $fh, ">", File::Spec->devnull;
             $fh;
          };
      } elsif ( $type eq "FH" ) {
          $fh = $dest;
          warn "run3(): redirecting $what to filehandle '$dest'\n"
              if debugging >= 3;
      } elsif ( !$type ) {
          warn "run3(): feeding child $what to file '$dest'\n"
              if debugging >= 2;
  
          open $fh, $options->{"append_$what"} ? ">>" : ">", $dest
             or croak "$!: $dest";
      } else {
          warn "run3(): capturing child $what\n"
              if debugging >= 2;
  
          $fh = $fh_cache{$what} ||= tempfile;
          seek $fh, 0, 0;
          truncate $fh, 0;
      }
  
      my $binmode_it = $options->{"binmode_$what"};
      _binmode($fh, $binmode_it, uc $what);
  
      return $fh;
  }
  
  sub _read_child_output_fh {
      my ( $what, $type, $dest, $fh, $options ) = @_;
  
      return if $type eq "SCALAR" && $dest == \undef;
  
      seek $fh, 0, 0 or croak "$! seeking on temp file for child $what";
  
      if ( $type eq "SCALAR" ) {
          warn "run3(): reading child $what to SCALAR\n"
              if debugging >= 3;
  
          # two read()s are used instead of 1 so that the first will be
          # logged even it reads 0 bytes; the second won't.
          my $count = read $fh, $$dest, 10_000,
             $options->{"append_$what"} ? length $$dest : 0;
          while (1) {
              croak "$! reading child $what from temp file"
                  unless defined $count;
  
              last unless $count;
  
              warn "run3(): read $count bytes from child $what",
                  debugging >= 3 ? ( ": '", substr( $$dest, -$count ), "'" ) : (),
                  "\n"
                  if debugging >= 2;
  
              $count = read $fh, $$dest, 10_000, length $$dest;
          }
      } elsif ( $type eq "ARRAY" ) {
         if ($options->{"append_$what"}) {
             push @$dest, <$fh>;
         } else {
             @$dest = <$fh>;
         }
          if ( debugging >= 2 ) {
              my $count = 0;
              $count += length for @$dest;
              warn
                  "run3(): read ",
                  scalar @$dest,
                  " records, $count bytes from child $what",
                  debugging >= 3 ? ( ": '", @$dest, "'" ) : (),
                  "\n";
          }
      } elsif ( $type eq "CODE" ) {
          warn "run3(): capturing child $what to CODE ref\n"
              if debugging >= 3;
  
          local $_;
          while ( <$fh> ) {
              warn
                  "run3(): read ",
                  length,
                  " bytes from child $what",
                  debugging >= 3 ? ( ": '", $_, "'" ) : (),
                  "\n"
                  if debugging >= 2;
  
              $dest->( $_ );
          }
      } else {
          croak "run3() can't redirect child $what to a $type";
      }
  
  }
  
  sub _type {
      my ( $redir ) = @_;
  
      return "FH" if eval {
          local $SIG{'__DIE__'};
          $redir->isa("IO::Handle")
      };
  
      my $type = ref $redir;
      return $type eq "GLOB" ? "FH" : $type;
  }
  
  sub _max_fd {
      my $fd = dup(0);
      POSIX::close $fd;
      return $fd;
  }
  
  my $run_call_time;
  my $sys_call_time;
  my $sys_exit_time;
  
  sub run3 {
      $run_call_time = gettimeofday() if profiling;
  
      my $options = @_ && ref $_[-1] eq "HASH" ? pop : {};
  
      my ( $cmd, $stdin, $stdout, $stderr ) = @_;
  
      print STDERR "run3(): running ",
         join( " ", map "'$_'", ref $cmd ? @$cmd : $cmd ),
         "\n"
         if debugging;
  
      if ( ref $cmd ) {
          croak "run3(): empty command"     unless @$cmd;
          croak "run3(): undefined command" unless defined $cmd->[0];
          croak "run3(): command name ('')" unless length  $cmd->[0];
      } else {
          croak "run3(): missing command" unless @_;
          croak "run3(): undefined command" unless defined $cmd;
          croak "run3(): command ('')" unless length  $cmd;
      }
  
      foreach (qw/binmode_stdin binmode_stdout binmode_stderr/) {
         if (my $mode = $options->{$_}) {
             croak qq[option $_ must be a number or a proper layer string: "$mode"]
                unless $mode =~ /^(:|\d+$)/;
         }
      }
  
      my $in_type  = _type $stdin;
      my $out_type = _type $stdout;
      my $err_type = _type $stderr;
  
      if ($fh_cache_pid != $$) {
         # fork detected, close all cached filehandles and clear the cache
         close $_ foreach values %fh_cache;
         %fh_cache = ();
         $fh_cache_pid = $$;
      }
  
      # This routine proceeds in stages so that a failure in an early
      # stage prevents later stages from running, and thus from needing
      # cleanup.
  
      my $in_fh  = _spool_data_to_child $in_type, $stdin,
          $options->{binmode_stdin} if defined $stdin;
  
      my $out_fh = _fh_for_child_output "stdout", $out_type, $stdout,
          $options if defined $stdout;
  
      my $tie_err_to_out =
          defined $stderr && defined $stdout && $stderr eq $stdout;
  
      my $err_fh = $tie_err_to_out
          ? $out_fh
          : _fh_for_child_output "stderr", $err_type, $stderr,
              $options if defined $stderr;
  
      # this should make perl close these on exceptions
  #    local *STDIN_SAVE;
      local *STDOUT_SAVE;
      local *STDERR_SAVE;
  
      my $saved_fd0 = dup( 0 ) if defined $in_fh;
  
  #    open STDIN_SAVE,  "<&STDIN"#  or croak "run3(): $! saving STDIN"
  #        if defined $in_fh;
      open STDOUT_SAVE, ">&STDOUT" or croak "run3(): $! saving STDOUT"
          if defined $out_fh;
      open STDERR_SAVE, ">&STDERR" or croak "run3(): $! saving STDERR"
          if defined $err_fh;
  
      my $errno;
      my $ok = eval {
          # The open() call here seems to not force fd 0 in some cases;
          # I ran in to trouble when using this in VCP, not sure why.
          # the dup2() seems to work.
          dup2( fileno $in_fh, 0 )
  #        open STDIN,  "<&=" . fileno $in_fh
              or croak "run3(): $! redirecting STDIN"
              if defined $in_fh;
  
  #        close $in_fh or croak "$! closing STDIN temp file"
  #            if ref $stdin;
  
          open STDOUT, ">&" . fileno $out_fh
              or croak "run3(): $! redirecting STDOUT"
              if defined $out_fh;
  
          open STDERR, ">&" . fileno $err_fh
              or croak "run3(): $! redirecting STDERR"
              if defined $err_fh;
  
          $sys_call_time = gettimeofday() if profiling;
  
          my $r = ref $cmd
                ? system { $cmd->[0] } is_win32 ? quote_native( @$cmd ) : @$cmd
                : system $cmd;
  
         $errno = $!;              # save $!, because later failures will overwrite it
          $sys_exit_time = gettimeofday() if profiling;
          if ( debugging ) {
              my $err_fh = defined $err_fh ? \*STDERR_SAVE : \*STDERR;
             if ( defined $r && $r != -1 ) {
                print $err_fh "run3(): \$? is $?\n";
             } else {
                print $err_fh "run3(): \$? is $?, \$! is $errno\n";
             }
          }
  
          if (
              defined $r
              && ( $r == -1 || ( is_win32 && $r == 0xFF00 ) )
              && !$options->{return_if_system_error}
          ) {
              croak( $errno );
          }
  
          1;
      };
      my $x = $@;
  
      my @errs;
  
      if ( defined $saved_fd0 ) {
          dup2( $saved_fd0, 0 );
          POSIX::close( $saved_fd0 );
      }
  
  #    open STDIN,  "<&STDIN_SAVE"#  or push @errs, "run3(): $! restoring STDIN"
  #        if defined $in_fh;
      open STDOUT, ">&STDOUT_SAVE" or push @errs, "run3(): $! restoring STDOUT"
          if defined $out_fh;
      open STDERR, ">&STDERR_SAVE" or push @errs, "run3(): $! restoring STDERR"
          if defined $err_fh;
  
      croak join ", ", @errs if @errs;
  
      die $x unless $ok;
  
      _read_child_output_fh "stdout", $out_type, $stdout, $out_fh, $options
          if defined $out_fh && $out_type && $out_type ne "FH";
      _read_child_output_fh "stderr", $err_type, $stderr, $err_fh, $options
          if defined $err_fh && $err_type && $err_type ne "FH" && !$tie_err_to_out;
      $profiler->run_exit(
         $cmd,
         $run_call_time,
         $sys_call_time,
         $sys_exit_time,
         scalar gettimeofday()
      ) if profiling;
  
      $! = $errno;              # restore $! from system()
  
      return 1;
  }
  
  1;
  
  __END__
  
  =head2 C<< run3($cmd, $stdin, $stdout, $stderr, \%options) >>
  
  All parameters after C<$cmd> are optional.
  
  The parameters C<$stdin>, C<$stdout> and C<$stderr> indicate how the child's
  corresponding filehandle (C<STDIN>, C<STDOUT> and C<STDERR>, resp.) will be
  redirected.  Because the redirects come last, this allows C<STDOUT> and
  C<STDERR> to default to the parent's by just not specifying them -- a common
  use case.
  
  C<run3> throws an exception if the wrapped C<system> call returned -1 or
  anything went wrong with C<run3>'s processing of filehandles.  Otherwise it
  returns true.  It leaves C<$?> intact for inspection of exit and wait status.
  
  Note that a true return value from C<run3> doesn't mean that the command had a
  successful exit code. Hence you should always check C<$?>.
  
  See L</%options> for an option to handle the case of C<system> returning -1
  yourself.
  
  =head3 C<$cmd>
  
  Usually C<$cmd> will be an ARRAY reference and the child is invoked via
  
    system @$cmd;
  
  But C<$cmd> may also be a string in which case the child is invoked via
  
    system $cmd;
  
  (cf. L<perlfunc/system> for the difference and the pitfalls of using
  the latter form).
  
  =head3 C<$stdin>, C<$stdout>, C<$stderr>
  
  The parameters C<$stdin>, C<$stdout> and C<$stderr> can take one of the
  following forms:
  
  =over 4
  
  =item C<undef> (or not specified at all)
  
  The child inherits the corresponding filehandle from the parent.
  
    run3 \@cmd, $stdin;                   # child writes to same STDOUT and STDERR as parent
    run3 \@cmd, undef, $stdout, $stderr;  # child reads from same STDIN as parent
  
  =item C<\undef>
  
  The child's filehandle is redirected from or to the local equivalent of
  C</dev/null> (as returned by C<< File::Spec->devnull() >>).
  
    run3 \@cmd, \undef, $stdout, $stderr; # child reads from /dev/null
  
  =item a simple scalar
  
  The parameter is taken to be the name of a file to read from
  or write to. In the latter case, the file will be opened via
  
    open FH, ">", ...
  
  i.e. it is created if it doesn't exist and truncated otherwise.
  Note that the file is opened by the parent which will L<croak|Carp/croak>
  in case of failure.
  
    run3 \@cmd, \undef, "out.txt";        # child writes to file "out.txt"
  
  =item a filehandle (either a reference to a GLOB or an C<IO::Handle>)
  
  The filehandle is inherited by the child.
  
    open my $fh, ">", "out.txt";
    print $fh "prologue\n";
    ...
    run3 \@cmd, \undef, $fh;              # child writes to $fh
    ...
    print $fh "epilogue\n";
    close $fh;
  
  =item a SCALAR reference
  
  The referenced scalar is treated as a string to be read from or
  written to. In the latter case, the previous content of the string
  is overwritten.
  
    my $out;
    run3 \@cmd, \undef, \$out;           # child writes into string
    run3 \@cmd, \<<EOF;                  # child reads from string (can use "here" notation)
    Input
    to
    child
    EOF
  
  =item an ARRAY reference
  
  For C<$stdin>, the elements of C<@$stdin> are simply spooled to the child.
  
  For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
  is read line by line (as determined by the current setting of C<$/>)
  into C<@$stdout> or C<@$stderr>, resp. The previous content of the array
  is overwritten.
  
    my @lines;
    run3 \@cmd, \undef, \@lines;         # child writes into array
  
  =item a CODE reference
  
  For C<$stdin>, C<&$stdin> will be called repeatedly (with no arguments) and
  the return values are spooled to the child. C<&$stdin> must signal the end of
  input by returning C<undef>.
  
  For C<$stdout> or C<$stderr>, the child's corresponding file descriptor
  is read line by line (as determined by the current setting of C<$/>)
  and C<&$stdout> or C<&$stderr>, resp., is called with the contents of the line.
  Note that there's no end-of-file indication.
  
    my $i = 0;
    sub producer {
      return $i < 10 ? "line".$i++."\n" : undef;
    }
  
    run3 \@cmd, \&producer;              # child reads 10 lines
  
  Note that this form of redirecting the child's I/O doesn't imply
  any form of concurrency between parent and child - run3()'s method of
  operation is the same no matter which form of redirection you specify.
  
  =back
  
  If the same value is passed for C<$stdout> and C<$stderr>, then the child
  will write both C<STDOUT> and C<STDERR> to the same filehandle.
  In general, this means that
  
      run3 \@cmd, \undef, "foo.txt", "foo.txt";
      run3 \@cmd, \undef, \$both, \$both;
  
  will DWIM and pass a single file handle to the child for both C<STDOUT> and
  C<STDERR>, collecting all into file "foo.txt" or C<$both>.
  
  =head3 C<\%options>
  
  The last parameter, C<\%options>, must be a hash reference if present.
  
  Currently the following keys are supported:
  
  =over 4
  
  =item C<binmode_stdin>, C<binmode_stdout>, C<binmode_stderr>
  
  The value must a "layer" as described in L<perlfunc/binmode>.  If specified the
  corresponding parameter C<$stdin>, C<$stdout> or C<$stderr>, resp., operates
  with the given layer.
  
  For backward compatibility, a true value that doesn't start with ":"
  (e.g. a number) is interpreted as ":raw". If the value is false
  or not specified, the default is ":crlf" on Windows and ":raw" otherwise.
  
  Don't expect that values other than the built-in layers ":raw", ":crlf",
  and (on newer Perls) ":bytes", ":utf8", ":encoding(...)" will work.
  
  =item C<append_stdout>, C<append_stderr>
  
  If their value is true then the corresponding parameter C<$stdout> or
  C<$stderr>, resp., will append the child's output to the existing "contents" of
  the redirector. This only makes sense if the redirector is a simple scalar (the
  corresponding file is opened in append mode), a SCALAR reference (the output is
  appended to the previous contents of the string) or an ARRAY reference (the
  output is C<push>ed onto the previous contents of the array).
  
  =item C<return_if_system_error>
  
  If this is true C<run3> does B<not> throw an exception if C<system> returns -1
  (cf. L<perlfunc/system> for possible failure scenarios.), but returns true
  instead.  In this case C<$?> has the value -1 and C<$!> contains the errno of
  the failing C<system> call.
  
  =back
  
  =head1 HOW IT WORKS
  
  =over 4
  
  =item (1)
  
  For each redirector C<$stdin>, C<$stdout>, and C<$stderr>, C<run3()> furnishes
  a filehandle:
  
  =over 4
  
  =item *
  
  if the redirector already specifies a filehandle it just uses that
  
  =item *
  
  if the redirector specifies a filename, C<run3()> opens the file
  in the appropriate mode
  
  =item *
  
  in all other cases, C<run3()> opens a temporary file (using
  L<tempfile|Temp/tempfile>)
  
  =back
  
  =item (2)
  
  If C<run3()> opened a temporary file for C<$stdin> in step (1),
  it writes the data using the specified method (either
  from a string, an array or returned by a function) to the temporary file and rewinds it.
  
  =item (3)
  
  C<run3()> saves the parent's C<STDIN>, C<STDOUT> and C<STDERR> by duplicating
  them to new filehandles. It duplicates the filehandles from step (1)
  to C<STDIN>, C<STDOUT> and C<STDERR>, resp.
  
  =item (4)
  
  C<run3()> runs the child by invoking L<system|perlfunc/system> with C<$cmd> as
  specified above.
  
  =item (5)
  
  C<run3()> restores the parent's C<STDIN>, C<STDOUT> and C<STDERR> saved in step (3).
  
  =item (6)
  
  If C<run3()> opened a temporary file for C<$stdout> or C<$stderr> in step (1),
  it rewinds it and reads back its contents using the specified method (either to
  a string, an array or by calling a function).
  
  =item (7)
  
  C<run3()> closes all filehandles that it opened explicitly in step (1).
  
  =back
  
  Note that when using temporary files, C<run3()> tries to amortize the overhead
  by reusing them (i.e. it keeps them open and rewinds and truncates them
  before the next operation).
  
  =head1 LIMITATIONS
  
  Often uses intermediate files (determined by File::Temp, and thus by the
  File::Spec defaults and the TMPDIR env. variable) for speed, portability and
  simplicity.
  
  Use extreme caution when using C<run3> in a threaded environment if concurrent
  calls of C<run3> are possible. Most likely, I/O from different invocations will
  get mixed up. The reason is that in most thread implementations all threads in
  a process share the same STDIN/STDOUT/STDERR.  Known failures are Perl ithreads
  on Linux and Win32. Note that C<fork> on Win32 is emulated via Win32 threads
  and hence I/O mix up is possible between forked children here (C<run3> is "fork
  safe" on Unix, though).
  
  =head1 DEBUGGING
  
  To enable debugging use the IPCRUN3DEBUG environment variable to
  a non-zero integer value:
  
    $ IPCRUN3DEBUG=1 myapp
  
  =head1 PROFILING
  
  To enable profiling, set IPCRUN3PROFILE to a number to enable emitting profile
  information to STDERR (1 to get timestamps, 2 to get a summary report at the
  END of the program, 3 to get mini reports after each run) or to a filename to
  emit raw data to a file for later analysis.
  
  =head1 COMPARISON
  
  Here's how it stacks up to existing APIs:
  
  =head2 compared to C<system()>, C<qx''>, C<open "...|">, C<open "|...">
  
  =over
  
  =item *
  
  better: redirects more than one file descriptor
  
  =item *
  
  better: returns TRUE on success, FALSE on failure
  
  =item *
  
  better: throws an error if problems occur in the parent process (or the
  pre-exec child)
  
  =item *
  
  better: allows a very perlish interface to Perl data structures and subroutines
  
  =item *
  
  better: allows 1 word invocations to avoid the shell easily:
  
   run3 ["foo"];  # does not invoke shell
  
  =item *
  
  worse: does not return the exit code, leaves it in $?
  
  =back
  
  =head2 compared to C<open2()>, C<open3()>
  
  =over
  
  =item *
  
  better: no lengthy, error prone polling/select loop needed
  
  =item *
  
  better: hides OS dependencies
  
  =item *
  
  better: allows SCALAR, ARRAY, and CODE references to source and sink I/O
  
  =item *
  
  better: I/O parameter order is like C<open3()>  (not like C<open2()>).
  
  =item *
  
  worse: does not allow interaction with the subprocess
  
  =back
  
  =head2 compared to L<IPC::Run::run()|IPC::Run/run>
  
  =over
  
  =item *
  
  better: smaller, lower overhead, simpler, more portable
  
  =item *
  
  better: no select() loop portability issues
  
  =item *
  
  better: does not fall prey to Perl closure leaks
  
  =item *
  
  worse: does not allow interaction with the subprocess (which IPC::Run::run()
  allows by redirecting subroutines)
  
  =item *
  
  worse: lacks many features of C<IPC::Run::run()> (filters, pipes, redirects,
  pty support)
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>C<barries@slaysys.com>E<gt>
  
  Ricardo SIGNES E<lt>C<rjbs@cpan.org>E<gt> performed routine maintenance since
  2010, thanks to help from the following ticket and/or patch submitters: Jody
  Belka, Roderich Schupp, David Morel, Jeff Lavallee, and anonymous others.
  
  =cut
IPC_RUN3

$fatpacked{"IPC/Run3/ProfArrayBuffer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFARRAYBUFFER';
  package IPC::Run3::ProfArrayBuffer;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfArrayBuffer - Store profile events in RAM in an array
  
  =head1 SYNOPSIS
  
  =head1 DESCRIPTION
  
  =cut
  
  use strict;
  
  =head1 METHODS
  
  =over
  
  =item C<< IPC::Run3::ProfArrayBuffer->new() >>
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
  
      my $self = bless { @_ }, $class;
  
      $self->{Events} = [];
  
      return $self;
  }
  
  =item C<< $buffer->app_call(@events) >>
  
  =item C<< $buffer->app_exit(@events) >>
  
  =item C<< $buffer->run_exit(@events) >>
  
  The three above methods push the given events onto the stack of recorded
  events.
  
  =cut
  
  for my $subname ( qw(app_call app_exit run_exit) ) {
    no strict 'refs';
    *{$subname} = sub {
        push @{shift->{Events}}, [ $subname => @_ ];
    };
  }
  
  =item get_events
  
  Returns a list of all the events.  Each event is an ARRAY reference
  like:
  
     [ "app_call", 1.1, ... ];
  
  =cut
  
  sub get_events {
      my $self = shift;
      @{$self->{Events}};
  }
  
  =back
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
  Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFARRAYBUFFER

$fatpacked{"IPC/Run3/ProfLogReader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGREADER';
  package IPC::Run3::ProfLogReader;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfLogReader -  read and process a ProfLogger file
  
  =head1 SYNOPSIS
  
   use IPC::Run3::ProfLogReader;
  
   my $reader = IPC::Run3::ProfLogReader->new; ## use "run3.out"
   my $reader = IPC::Run3::ProfLogReader->new( Source => $fn );
  
   my $profiler = IPC::Run3::ProfPP;   ## For example
   my $reader   = IPC::Run3::ProfLogReader->new( ..., Handler => $p );
  
   $reader->read;
   $eaderr->read_all;
  
  =head1 DESCRIPTION
  
  Reads a log file.  Use the filename "-" to read from STDIN.
  
  =cut
  
  use strict;
  
  =head1 METHODS
  
  =head2 C<< IPC::Run3::ProfLogReader->new( ... ) >>
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
      my $self = bless { @_ }, $class;
      
      $self->{Source} = "run3.out"
          unless defined $self->{Source} && length $self->{Source};
  
      my $source = $self->{Source};
  
      if ( ref $source eq "GLOB" || UNIVERSAL::isa( $source, "IO::Handle" ) ) {
          $self->{FH} = $source;
      }
      elsif ( $source eq "-" ) {
          $self->{FH} = \*STDIN;
      }
      else {
          open PROFILE, "<$self->{Source}" or die "$!: $self->{Source}\n";
          $self->{FH} = *PROFILE{IO};
      }
      return $self;
  }
  
  
  =head2 C<< $reader->set_handler( $handler ) >>
  
  =cut
  
  sub set_handler { $_[0]->{Handler} = $_[1] }
  
  =head2 C<< $reader->get_handler() >>
  
  =cut
  
  sub get_handler { $_[0]->{Handler} }
  
  =head2 C<< $reader->read() >>
  
  =cut
  
  sub read {
      my $self = shift;
  
      my $fh = $self->{FH};
      my @ln = split / /, <$fh>;
  
      return 0 unless @ln;
      return 1 unless $self->{Handler};
  
      chomp $ln[-1];
  
      ## Ignore blank and comment lines.
      return 1 if @ln == 1 && ! length $ln[0] || 0 == index $ln[0], "#";
  
      if ( $ln[0] eq "\\app_call" ) {
          shift @ln;
          my @times = split /,/, pop @ln;
          $self->{Handler}->app_call(
              [
                  map {
                      s/\\\\/\\/g;
                      s/\\_/ /g;
                      $_;
                  } @ln
              ],
              @times
          );
      }
      elsif ( $ln[0] eq "\\app_exit" ) {
          shift @ln;
          $self->{Handler}->app_exit( pop @ln, @ln );
      }
      else {
          my @times = split /,/, pop @ln;
          $self->{Handler}->run_exit(
              [
                  map {
                      s/\\\\/\\/g;
                      s/\\_/ /g;
                      $_;
                  } @ln
              ],
              @times
          );
      }
  
      return 1;
  }
  
  
  =head2 C<< $reader->read_all() >>
  
  This method reads until there is nothing left to read, and then returns true.
  
  =cut
  
  sub read_all {
      my $self = shift;
  
      1 while $self->read;
  
      return 1;
  }
  
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
      Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFLOGREADER

$fatpacked{"IPC/Run3/ProfLogger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGGER';
  package IPC::Run3::ProfLogger;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfLogger - write profiling data to a log file
  
  =head1 SYNOPSIS
  
   use IPC::Run3::ProfLogger;
  
   my $logger = IPC::Run3::ProfLogger->new;  ## write to "run3.out"
   my $logger = IPC::Run3::ProfLogger->new( Destination => $fn );
  
   $logger->app_call( \@cmd, $time );
  
   $logger->run_exit( \@cmd1, @times1 );
   $logger->run_exit( \@cmd1, @times1 );
  
   $logger->app_exit( $time );
  
  =head1 DESCRIPTION
  
  Used by IPC::Run3 to write a profiling log file.  Does not
  generate reports or maintain statistics; its meant to have minimal
  overhead.
  
  Its API is compatible with a tiny subset of the other IPC::Run profiling
  classes.
  
  =cut
  
  use strict;
  
  =head1 METHODS
  
  =head2 C<< IPC::Run3::ProfLogger->new( ... ) >>
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
      my $self = bless { @_ }, $class;
      
      $self->{Destination} = "run3.out"
          unless defined $self->{Destination} && length $self->{Destination};
  
      open PROFILE, ">$self->{Destination}"
          or die "$!: $self->{Destination}\n";
      binmode PROFILE;
      $self->{FH} = *PROFILE{IO};
  
      $self->{times} = [];
      return $self;
  }
  
  =head2 C<< $logger->run_exit( ... ) >>
  
  =cut
  
  sub run_exit {
      my $self = shift;
      my $fh = $self->{FH};
      print( $fh
          join(
              " ",
              (
                  map {
                      my $s = $_;
                      $s =~ s/\\/\\\\/g;
                      $s =~ s/ /_/g;
                      $s;
                  } @{shift()}
              ),
              join(
                  ",",
                  @{$self->{times}},
                  @_,
              ),
          ),
          "\n"
      );
  }
  
  =head2 C<< $logger->app_exit( $arg ) >>
  
  =cut
  
  sub app_exit {
      my $self = shift;
      my $fh = $self->{FH};
      print $fh "\\app_exit ", shift, "\n";
  }
  
  =head2 C<< $logger->app_call( $t, @args) >>
  
  =cut
  
  sub app_call {
      my $self = shift;
      my $fh = $self->{FH};
      my $t = shift;
      print( $fh
          join(
              " ",
              "\\app_call",
              (
                  map {
                      my $s = $_;
                      $s =~ s/\\\\/\\/g;
                      $s =~ s/ /\\_/g;
                      $s;
                  } @_
              ),
              $t,
          ),
          "\n"
      );
  }
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
  Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFLOGGER

$fatpacked{"IPC/Run3/ProfPP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFPP';
  package IPC::Run3::ProfPP;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfPP - Generate reports from IPC::Run3 profiling data
  
  =head1 SYNOPSIS
  
  =head1 DESCRIPTION
  
  Used by IPC::Run3 and/or run3profpp to print out profiling reports for
  human readers.  Use other classes for extracting data in other ways.
  
  The output methods are plain text, override these (see the source for
  now) to provide other formats.
  
  This class generates reports on each run3_exit() and app_exit() call.
  
  =cut
  
  require IPC::Run3::ProfReporter;
  @ISA = qw( IPC::Run3::ProfReporter );
  
  use strict;
  use POSIX qw( floor );
  
  =head1 METHODS
  
  =head2 C<< IPC::Run3::ProfPP->new() >>
  
  Returns a new profile reporting object.
  
  =cut
  
  sub _emit { shift; warn @_ }
  
  sub _t {
      sprintf "%10.6f secs", @_;
  }
  
  sub _r {
      my ( $num, $denom ) = @_;
      return () unless $denom;
      sprintf "%10.6f", $num / $denom;
  }
  
  sub _pct {
      my ( $num, $denom ) = @_;
      return () unless $denom;
      sprintf  " (%3d%%)", floor( 100 * $num / $denom + 0.5 );
  }
  
  =head2 C<< $profpp->handle_app_call() >>
  
  =cut
  
  sub handle_app_call {
      my $self = shift;
      $self->_emit("IPC::Run3 parent: ",
          join( " ", @{$self->get_app_cmd} ),
          "\n",
      );
  
      $self->{NeedNL} = 1;
  }
  
  =head2 C<< $profpp->handle_app_exit() >>
  
  =cut
  
  sub handle_app_exit {
      my $self = shift;
  
      $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 1;
  
      $self->_emit( "IPC::Run3 total elapsed:             ",
          _t( $self->get_app_cumulative_time ),
          "\n");
      $self->_emit( "IPC::Run3 calls to run3():    ",
          sprintf( "%10d", $self->get_run_count ),
          "\n");
      $self->_emit( "IPC::Run3 total spent in run3():     ",
          _t( $self->get_run_cumulative_time ),
          _pct( $self->get_run_cumulative_time, $self->get_app_cumulative_time ),
          ", ",
          _r( $self->get_run_cumulative_time, $self->get_run_count ),
          " per call",
          "\n");
      my $exclusive = 
          $self->get_app_cumulative_time - $self->get_run_cumulative_time;
      $self->_emit( "IPC::Run3 total spent not in run3(): ",
          _t( $exclusive ),
          _pct( $exclusive, $self->get_app_cumulative_time ),
          "\n");
      $self->_emit( "IPC::Run3 total spent in children:   ",
          _t( $self->get_sys_cumulative_time ),
          _pct( $self->get_sys_cumulative_time, $self->get_app_cumulative_time ),
          ", ",
          _r( $self->get_sys_cumulative_time, $self->get_run_count ),
          " per call",
          "\n");
      my $overhead =
          $self->get_run_cumulative_time - $self->get_sys_cumulative_time;
      $self->_emit( "IPC::Run3 total overhead:            ",
          _t( $overhead ),
          _pct(
              $overhead,
              $self->get_sys_cumulative_time
          ),
          ", ",
          _r( $overhead, $self->get_run_count ),
          " per call",
          "\n");
  }
  
  =head2 C<< $profpp->handle_run_exit() >>
  
  =cut
  
  sub handle_run_exit {
      my $self = shift;
      my $overhead = $self->get_run_time - $self->get_sys_time;
  
      $self->_emit("\n") if $self->{NeedNL} && $self->{NeedNL} != 2;
      $self->{NeedNL} = 3;
  
      $self->_emit( "IPC::Run3 child: ",
          join( " ", @{$self->get_run_cmd} ),
          "\n");
      $self->_emit( "IPC::Run3 run3()  : ", _t( $self->get_run_time ), "\n",
           "IPC::Run3 child   : ", _t( $self->get_sys_time ), "\n",
           "IPC::Run3 overhead: ", _t( $overhead ),
               _pct( $overhead, $self->get_sys_time ),
               "\n");
  }
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
      Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
  
  =cut
  
  1;
IPC_RUN3_PROFPP

$fatpacked{"IPC/Run3/ProfReporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFREPORTER';
  package IPC::Run3::ProfReporter;
  
  $VERSION = 0.048;
  
  =head1 NAME
  
  IPC::Run3::ProfReporter - base class for handling profiling data
  
  =head1 SYNOPSIS
  
  =head1 DESCRIPTION
  
  See L<IPC::Run3::ProfPP|IPC::Run3::ProfPP> and for an example subclass.
  
  This class just notes and accumulates times; subclasses use methods like
  "handle_app_call", "handle_run_exit" and "handle_app_exit" to emit reports on
  it.  The default methods for these handlers are noops.
  
  If run from the command line, a reporter will be created and run on
  each logfile given as a command line parameter or on run3.out if none
  are given.
  
  This allows reports to be run like:
  
      perl -MIPC::Run3::ProfPP -e1
      perl -MIPC::Run3::ProfPP -e1 foo.out bar.out
  
  Use "-" to read from STDIN (the log file format is meant to be moderately
  greppable):
  
      grep "^cvs " run3.out perl -MIPC::Run3::ProfPP -e1 -
  
  Use --app to show only application level statistics (ie don't emit
  a report section for each command run).
  
  =cut
  
  use strict;
  
  my $loaded_by;
  
  sub import {
      $loaded_by = shift;
  }
  
  END {
      my @caller;
      for ( my $i = 0;; ++$i ) {
          my @c = caller $i;
          last unless @c;
          @caller = @c;
      }
  
      if ( $caller[0] eq "main"
          && $caller[1] eq "-e"
      ) {
          require IPC::Run3::ProfLogReader;
          require Getopt::Long;
          my ( $app, $run );
  
          Getopt::Long::GetOptions(
              "app" => \$app,
              "run" => \$run,
          );
  
          $app = 1, $run = 1 unless $app || $run;
  
          for ( @ARGV ? @ARGV : "" ) {
              my $r = IPC::Run3::ProfLogReader->new(
                  Source  => $_,
                  Handler => $loaded_by->new(
                      Source => $_,
                      app_report => $app,
                      run_report => $run,
                  ),
              );
              $r->read_all;
          }
      }
  }
  
  =head1 METHODS
  
  =over
  
  =item C<< IPC::Run3::ProfReporter->new >>
  
  Returns a new profile reporting object.
  
  =cut
  
  sub new {
      my $class = ref $_[0] ? ref shift : shift;
      my $self = bless { @_ }, $class;
      $self->{app_report} = 1, $self->{run_report} = 1
          unless $self->{app_report} || $self->{run_report};
  
      return $self;
  }
  
  =item C<< $reporter->handle_app_call( ... ) >>
  
  =item C<< $reporter->handle_app_exit( ... ) >>
  
  =item C<< $reporter->handle_run_exit( ... ) >>
  
  These methods are called by the handled events (see below).
  
  =cut
  
  sub handle_app_call {}
  sub handle_app_exit {}
  
  sub handle_run_exit {}
  
  =item C<< $reporter->app_call(\@cmd, $time) >>
  
  =item C<< $reporter->app_exit($time) >>
  
  =item C<< $reporter->run_exit(@times) >>
  
     $self->app_call( $time );
     my $time = $self->get_app_call_time;
  
  Sets the time (in floating point seconds) when the application, run3(),
  or system() was called or exited.  If no time parameter is passed, uses
  IPC::Run3's time routine.
  
  Use get_...() to retrieve these values (and _accum values, too).  This
  is a separate method to speed the execution time of the setters just a
  bit.
  
  =cut
  
  sub app_call {
      my $self = shift;
      ( $self->{app_cmd}, $self->{app_call_time} ) = @_;
      $self->handle_app_call if $self->{app_report};
  }
  
  sub app_exit {
      my $self = shift;
      $self->{app_exit_time} = shift;
      $self->handle_app_exit if $self->{app_report};
  }
  
  sub run_exit {
      my $self = shift;
      @{$self}{qw(
          run_cmd run_call_time sys_call_time sys_exit_time run_exit_time
      )} = @_;
  
      ++$self->{run_count};
      $self->{run_cumulative_time} += $self->get_run_time;
      $self->{sys_cumulative_time} += $self->get_sys_time;
      $self->handle_run_exit if $self->{run_report};
  }
  
  =item C<< $reporter->get_run_count() >>
  
  =item C<< $reporter->get_app_call_time() >>
  
  =item C<< $reporter->get_app_exit_time() >>
  
  =item C<< $reporter->get_app_cmd() >>
  
  =item C<< $reporter->get_app_time() >>
  
  =cut
  
  sub get_run_count     { shift->{run_count} }
  sub get_app_call_time { shift->{app_call_time} }
  sub get_app_exit_time { shift->{app_exit_time} }
  sub get_app_cmd       { shift->{app_cmd}       }
  sub get_app_time {
      my $self = shift;
      $self->get_app_exit_time - $self->get_app_call_time;
  }
  
  =item C<< $reporter->get_app_cumulative_time() >>
  
  =cut
  
  sub get_app_cumulative_time {
      my $self = shift;
      $self->get_app_exit_time - $self->get_app_call_time;
  }
  
  =item C<< $reporter->get_run_call_time() >>
  
  =item C<< $reporter->get_run_exit_time() >>
  
  =item C<< $reporter->get_run_time() >>
  
  =cut
  
  sub get_run_call_time { shift->{run_call_time} }
  sub get_run_exit_time { shift->{run_exit_time} }
  sub get_run_time {
      my $self = shift;
      $self->get_run_exit_time - $self->get_run_call_time;
  }
  
  =item C<< $reporter->get_run_cumulative_time() >>
  
  =cut
  
  sub get_run_cumulative_time { shift->{run_cumulative_time} }
  
  =item C<< $reporter->get_sys_call_time() >>
  
  =item C<< $reporter->get_sys_exit_time() >>
  
  =item C<< $reporter->get_sys_time() >>
  
  =cut
  
  sub get_sys_call_time { shift->{sys_call_time} }
  sub get_sys_exit_time { shift->{sys_exit_time} }
  sub get_sys_time {
      my $self = shift;
      $self->get_sys_exit_time - $self->get_sys_call_time;
  }
  
  =item C<< $reporter->get_sys_cumulative_time() >>
  
  =cut
  
  sub get_sys_cumulative_time { shift->{sys_cumulative_time} }
  
  =item C<< $reporter->get_run_cmd() >>
  
  =cut
  
  sub get_run_cmd { shift->{run_cmd} }
  
  =back
  
  =head1 LIMITATIONS
  
  =head1 COPYRIGHT
  
      Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
  
  =head1 LICENSE
  
  You may use this module under the terms of the BSD, Artistic, or GPL licenses,
  any version.
  
  =head1 AUTHOR
  
  Barrie Slaymaker <barries@slaysys.com>
  
  =cut
  
  1;
IPC_RUN3_PROFREPORTER

$fatpacked{"JSON.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON';
  package JSON;
  
  
  use strict;
  use Carp ();
  use Exporter;
  BEGIN { @JSON::ISA = 'Exporter' }
  
  @JSON::EXPORT = qw(from_json to_json jsonToObj objToJson encode_json decode_json);
  
  BEGIN {
      $JSON::VERSION = '4.10';
      $JSON::DEBUG   = 0 unless (defined $JSON::DEBUG);
      $JSON::DEBUG   = $ENV{ PERL_JSON_DEBUG } if exists $ENV{ PERL_JSON_DEBUG };
  }
  
  my %RequiredVersion = (
      'JSON::PP' => '2.27203',
      'JSON::XS' => '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 @PublicMethodsSince4_0 = qw/allow_tags/;
  my @PropertiesSince4_0 = qw/allow_tags/;
  
  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 $_ALLOW_UNSUPPORTED = 0;
  my $_UNIV_CONV_BLESSED = 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') {
          $backend = 'JSON::XS,JSON::PP';
      }
      elsif ($backend eq '0') {
          $backend = 'JSON::PP';
      }
      elsif ($backend eq '2') {
          $backend = 'JSON::XS';
      }
      $backend =~ s/\s+//g;
  
      my @backend_modules = split /,/, $backend;
      while(my $module = shift @backend_modules) {
          if ($module =~ /JSON::XS/) {
              _load_xs($module, @backend_modules ? $_INSTALL_DONT_DIE : 0);
          }
          elsif ($module =~ /JSON::PP/) {
              _load_pp($module);
          }
          elsif ($module =~ /JSON::backportPP/) {
              _load_pp($module);
          }
          else {
              Carp::croak "The value of environmental variable 'PERL_JSON_BACKEND' is invalid.";
          }
          last if $JSON::Backend;
      }
  }
  
  
  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->is_xs);
              }
              next;
          }
          elsif ($tag eq '-no_export') {
              $no_export++, next;
          }
          elsif ( $tag eq '-convert_blessed_universally' ) {
              my $org_encode = $JSON::Backend->can('encode');
              eval q|
                  require B;
                  local $^W;
                  no strict 'refs';
                  *{"${JSON::Backend}\::encode"} = sub {
                      # only works with Perl 5.18+
                      local *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
                                  ;
                      };
                      $org_encode->(@_);
                  };
              | 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 boolean {
      # might be called as method or as function, so pop() to get the last arg instead of shift() to get the first
      pop() ? $JSON::true : $JSON::false
  }
  
  sub null  { undef; }
  
  
  sub require_xs_version { $RequiredVersion{'JSON::XS'}; }
  
  sub backend {
      my $proto = shift;
      $JSON::Backend;
  }
  
  #*module = *backend;
  
  
  sub is_xs {
      return $_[0]->backend->is_xs;
  }
  
  
  sub is_pp {
      return $_[0]->backend->is_pp;
  }
  
  
  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 ($module, $opt) = @_;
  
      $JSON::DEBUG and Carp::carp "Load $module.";
      my $required_version = $RequiredVersion{$module} || '';
  
      eval qq|
          use $module $required_version ();
      |;
  
      if ($@) {
          if (defined $opt and $opt & $_INSTALL_DONT_DIE) {
              $JSON::DEBUG and Carp::carp "Can't load $module...($@)";
              return 0;
          }
          Carp::croak $@;
      }
      $JSON::BackendModuleXS = $module;
      return 1;
  }
  
  sub _load_xs {
      my ($module, $opt) = @_;
      __load_xs($module, $opt) or return;
  
      my $data = join("", <DATA>); # this code is from Jcode 2.xx.
      close(DATA);
      eval $data;
      JSON::Backend::XS->init($module);
  
      return 1;
  };
  
  
  sub __load_pp {
      my ($module, $opt) = @_;
  
      $JSON::DEBUG and Carp::carp "Load $module.";
      my $required_version = $RequiredVersion{$module} || '';
  
      eval qq| use $module $required_version () |;
  
      if ($@) {
          if ( $module eq 'JSON::PP' ) {
              $JSON::DEBUG and Carp::carp "Can't load $module ($@), so try to load JSON::backportPP";
              $module = 'JSON::backportPP';
              local $^W; # if PP installed but invalid version, backportPP redefines methods.
              eval qq| require $module |;
          }
          Carp::croak $@ if $@;
      }
      $JSON::BackendModulePP = $module;
      return 1;
  }
  
  sub _load_pp {
      my ($module, $opt) = @_;
      __load_pp($module, $opt);
  
      JSON::Backend::PP->init($module);
  };
  
  #
  # Helper classes for Backend Module (PP)
  #
  
  package JSON::Backend::PP;
  
  sub init {
      my ($class, $module) = @_;
  
      # name may vary, but the module should (always) be a JSON::PP
  
      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::is_bool"} = \&{"JSON::PP::is_bool"};
  
      $JSON::true  = ${"JSON::PP::true"};
      $JSON::false = ${"JSON::PP::false"};
  
      push @JSON::Backend::PP::ISA, 'JSON::PP';
      push @JSON::ISA, $class;
      $JSON::Backend = $class;
      $JSON::BackendModule = $module;
      my $version = ${"$class\::VERSION"} = $module->VERSION;
      $version =~ s/_//;
      if ($version < 3.99) {
          push @XSOnlyMethods, qw/allow_tags get_allow_tags/;
      } else {
          push @Properties, 'allow_tags';
      }
  
      for my $method (@XSOnlyMethods) {
          *{"JSON::$method"} = sub {
              Carp::carp("$method is not supported by $module $version.");
              $_[0];
          };
      }
  
      return 1;
  }
  
  sub is_xs { 0 };
  sub is_pp { 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;
  
  sub init {
      my ($class, $module) = @_;
  
      local $^W;
      no strict qw(refs);
      *{"JSON::decode_json"} = \&{"$module\::decode_json"};
      *{"JSON::encode_json"} = \&{"$module\::encode_json"};
      *{"JSON::is_bool"} = \&{"$module\::is_bool"};
  
      $JSON::true  = ${"$module\::true"};
      $JSON::false = ${"$module\::false"};
  
      push @JSON::Backend::XS::ISA, $module;
      push @JSON::ISA, $class;
      $JSON::Backend = $class;
      $JSON::BackendModule = $module;
      ${"$class\::VERSION"} = $module->VERSION;
  
      if ( $module->VERSION < 3 ) {
          eval 'package JSON::PP::Boolean';
          push @{"$module\::Boolean::ISA"}, qw(JSON::PP::Boolean);
      }
  
      for my $method (@PPOnlyMethods) {
          *{"JSON::$method"} = sub {
              Carp::carp("$method is not supported by $module.");
              $_[0];
          };
      }
  
      return 1;
  }
  
  sub is_xs { 1 };
  sub is_pp { 0 };
  
  sub support_by_pp {
      my ($class, @methods) = @_;
  
      JSON::__load_pp('JSON::PP');
  
      local $^W;
      no strict qw(refs);
  
      for my $method (@methods) {
          my $pp_method = JSON::PP->can($method) or next;
          *{"JSON::$method"} = sub {
              if (!$_[0]->isa('JSON::PP')) {
                  my $xs_self = $_[0];
                  my $pp_self = JSON::PP->new;
                  for (@Properties) {
                       my $getter = "get_$_";
                      $pp_self->$_($xs_self->$getter);
                  }
                  $_[0] = $pp_self;
              }
              $pp_method->(@_);
          };
      }
  
      $JSON::DEBUG and Carp::carp("set -support_by_pp mode.");
  }
  
  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
  
  =head1 DESCRIPTION
  
  This module is a thin wrapper for L<JSON::XS>-compatible modules with a few
  additional features. All the backend modules convert a Perl data structure
  to a JSON text and vice versa. This module uses L<JSON::XS> by default,
  and when JSON::XS is not available, falls back on L<JSON::PP>, which is
  in the Perl core since 5.14. If JSON::PP is not available either, this
  module then falls back on JSON::backportPP (which is actually JSON::PP
  in a different .pm file) bundled in the same distribution as this module.
  You can also explicitly specify to use L<Cpanel::JSON::XS>, a fork of
  JSON::XS by Reini Urban.
  
  All these backend modules have slight incompatibilities between them,
  including extra features that other modules don't support, but as long as you
  use only common features (most important ones are described below), migration
  from backend to backend should be reasonably easy. For details, see each
  backend module you use.
  
  =head1 CHOOSING BACKEND
  
  This module respects an environmental variable called C<PERL_JSON_BACKEND>
  when it decides a backend module to use. If this environmental variable is
  not set, it tries to load JSON::XS, and if JSON::XS is not available, it
  falls back on JSON::PP, and then JSON::backportPP if JSON::PP is not available
  either.
  
  If you always don't want it to fall back on pure perl modules, set the
  variable like this (C<export> may be C<setenv>, C<set> and the likes,
  depending on your environment):
  
    > export PERL_JSON_BACKEND=JSON::XS
  
  If you prefer Cpanel::JSON::XS to JSON::XS, then:
  
    > export PERL_JSON_BACKEND=Cpanel::JSON::XS,JSON::XS,JSON::PP
  
  You may also want to set this variable at the top of your test files, in order
  not to be bothered with incompatibilities between backends (you need to wrap
  this in C<BEGIN>, and set before actually C<use>-ing JSON module, as it decides
  its backend as soon as it's loaded):
  
    BEGIN { $ENV{PERL_JSON_BACKEND}='JSON::backportPP'; }
    use JSON;
  
  =head1 USING OPTIONAL FEATURES
  
  There are a few options you can set when you C<use> this module.
  These historical options are only kept for backward compatibility,
  and should not be used in a new application.
  
  =over
  
  =item -support_by_pp
  
     BEGIN { $ENV{PERL_JSON_BACKEND} = 'JSON::XS' }
     
     use JSON -support_by_pp;
     
     my $json = JSON->new;
     # escape_slash is for JSON::PP only.
     $json->allow_nonref->escape_slash->encode("/");
  
  With this option, this module loads its pure perl backend along with
  its XS backend (if available), and lets the XS backend to watch if you set
  a flag only JSON::PP supports. When you do, the internal JSON::XS object
  is replaced with a newly created JSON::PP object with the setting copied
  from the XS object, so that you can use JSON::PP flags (and its slower
  C<decode>/C<encode> methods) from then on. In other words, this is not
  something that allows you to hook JSON::XS to change its behavior while
  keeping its speed. JSON::XS and JSON::PP objects are quite different
  (JSON::XS object is a blessed scalar reference, while JSON::PP object is
  a blessed hash reference), and can't share their internals.
  
  To avoid needless overhead (by copying settings), you are advised not
  to use this option and just to use JSON::PP explicitly when you need
  JSON::PP features.
  
  =item -convert_blessed_universally
  
     use JSON -convert_blessed_universally;
  
     my $json = JSON->new->allow_nonref->convert_blessed;
     my $object = bless {foo => 'bar'}, 'Foo';
     $json->encode($object); # => {"foo":"bar"}
  
  JSON::XS-compatible backend modules don't encode blessed objects by
  default (except for their boolean values, which are typically blessed
  JSON::PP::Boolean objects). If you need to encode a data structure
  that may contain objects, you usually need to look into the structure
  and replace objects with alternative non-blessed values, or enable
  C<convert_blessed> and provide a C<TO_JSON> method for each object's
  (base) class that may be found in the structure, in order to let the
  methods replace the objects with whatever scalar values the methods
  return.
  
  If you need to serialise data structures that may contain arbitrary
  objects, it's probably better to use other serialisers (such as
  L<Sereal> or L<Storable> for example), but if you do want to use
  this module for that purpose, C<-convert_blessed_universally> option
  may help, which tweaks C<encode> method of the backend to install
  C<UNIVERSAL::TO_JSON> method (locally) before encoding, so that
  all the objects that don't have their own C<TO_JSON> method can
  fall back on the method in the C<UNIVERSAL> namespace. Note that you
  still need to enable C<convert_blessed> flag to actually encode
  objects in a data structure, and C<UNIVERSAL::TO_JSON> method
  installed by this option only converts blessed hash/array references
  into their unblessed clone (including private keys/values that are
  not supposed to be exposed). Other blessed references will be
  converted into null.
  
  This feature is experimental and may be removed in the future.
  
  =item -no_export
  
  When you don't want to import functional interfaces from a module, you
  usually supply C<()> to its C<use> statement.
  
      use JSON (); # no functional interfaces
  
  If you don't want to import functional interfaces, but you also want to
  use any of the above options, add C<-no_export> to the option list.
  
     # no functional interfaces, while JSON::PP support is enabled.
     use JSON -support_by_pp, -no_export;
  
  =back
  
  =head1 FUNCTIONAL INTERFACE
  
  This section is taken from JSON::XS. C<encode_json> and C<decode_json>
  are exported by default.
  
  This module also exports C<to_json> and C<from_json> for backward
  compatibility. These are slower, and may expect/generate different stuff
  from what C<encode_json> and C<decode_json> do, depending on their
  options. It's better just to use Object-Oriented interfaces than using
  these two functions.
  
  =head2 encode_json
  
      $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->new->utf8->encode($perl_scalar)
  
  Except being faster.
  
  =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. Croaks on error.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON->new->utf8->decode($json_text)
  
  Except being faster.
  
  =head2 to_json
  
     $json_text = to_json($perl_scalar[, $optional_hashref])
  
  Converts the given Perl data structure to a Unicode string by default.
  Croaks on error.
  
  Basically, this function call is functionally identical to:
  
     $json_text = JSON->new->encode($perl_scalar)
  
  Except being slower.
  
  You can pass an optional hash reference to modify its behavior, but
  that may change what C<to_json> expects/generates (see
  C<ENCODING/CODESET FLAG NOTES> for details).
  
     $json_text = to_json($perl_scalar, {utf8 => 1, pretty => 1})
     # => JSON->new->utf8(1)->pretty(1)->encode($perl_scalar)
  
  =head2 from_json
  
     $perl_scalar = from_json($json_text[, $optional_hashref])
  
  The opposite of C<to_json>: expects a Unicode string and tries
  to parse it, returning the resulting reference. Croaks on error.
  
  Basically, this function call is functionally identical to:
  
      $perl_scalar = JSON->new->decode($json_text)
  
  You can pass an optional hash reference to modify its behavior, but
  that may change what C<from_json> expects/generates (see
  C<ENCODING/CODESET FLAG NOTES> for details).
  
      $perl_scalar = from_json($json_text, {utf8 => 1})
      # => JSON->new->utf8(1)->decode($json_text)
  
  =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.
  
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
  
  =head1 COMMON OBJECT-ORIENTED INTERFACE
  
  This section is also taken from JSON::XS.
  
  The object oriented interface lets you configure your own encoding or
  decoding style, within the limits of supported formats.
  
  =head2 new
  
      $json = JSON->new
  
  Creates a new JSON::XS-compatible backend object that can be used to de/encode JSON
  strings. All boolean flags described below are by default I<disabled>
  (with the exception of C<allow_nonref>, which defaults to I<enabled> since
  version C<4.0>).
  
  The mutators for flags all return the backend 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 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->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
  
  =head2 latin1
  
      $json = $json->latin1([$enable])
      
      $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->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 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->new->encode ($object);
  
  Example, decode UTF-32LE-encoded JSON:
  
    use Encode;
    $object = JSON->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> (and in the future possibly more) flags in one call to
  generate the most readable (or most compact) form possible.
  
  =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, 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.
  
  =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. You will also
  most likely combine this setting with C<space_after>.
  
  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 any way. 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, 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.
  
  =head2 allow_nonref
  
      $json = $json->allow_nonref([$enable])
      
      $enabled = $json->get_allow_nonref
  
  Unlike other boolean options, this option is enabled by default beginning
  with version C<4.0>.
  
  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->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
  
  =head2 allow_unknown
  
      $json = $json->allow_unknown ([$enable])
      
      $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_blessed>.
  
  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.
  
  =head2 allow_blessed
  
      $json = $json->allow_blessed([$enable])
      
      $enabled = $json->get_allow_blessed
  
  See L<OBJECT SERIALISATION> for details.
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference that it cannot convert
  otherwise. Instead, a JSON C<null> value is encoded instead of the object.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object that it cannot convert
  otherwise.
  
  This setting has no effect on C<decode>.
  
  =head2 convert_blessed
  
      $json = $json->convert_blessed([$enable])
      
      $enabled = $json->get_convert_blessed
  
  See L<OBJECT SERIALISATION> for details.
  
  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.
  
  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.
  
  If C<$enable> is false (the default), then C<encode> will not consider
  this type of conversion.
  
  This setting has no effect on C<decode>.
  
  =head2 allow_tags (since version 3.0)
  
      $json = $json->allow_tags([$enable])
  
      $enabled = $json->get_allow_tags
  
  See L<OBJECT SERIALISATION> for details.
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<FREEZE> method on
  the object's class. If found, it will be used to serialise the object into
  a nonstandard tagged JSON value (that JSON decoders cannot decode).
  
  It also causes C<decode> to parse such tagged JSON values and deserialise
  them via a call to the C<THAW> method.
  
  If C<$enable> is false (the default), then C<encode> will not consider
  this type of conversion, and tagged JSON values will cause a parse error
  in C<decode>, as if tags were not part of the grammar.
  
  =head2 boolean_values (since version 4.0)
  
      $json->boolean_values([$false, $true])
  
      ($false,  $true) = $json->get_boolean_values
  
  By default, JSON booleans will be decoded as overloaded
  C<$JSON::false> and C<$JSON::true> objects.
  
  With this method you can specify your own boolean values for decoding -
  on decode, JSON C<false> will be decoded as a copy of C<$false>, and JSON
  C<true> will be decoded as C<$true> ("copy" here is the same thing as
  assigning a value to another variable, i.e. C<$copy = $false>).
  
  This is useful when you want to pass a decoded data structure directly
  to other serialisers like YAML, Data::MessagePack and so on.
  
  Note that this works only when you C<decode>. You can set incompatible
  boolean objects (like L<boolean>), but when you C<encode> a data structure
  with such boolean objects, you still need to enable C<convert_blessed>
  (and add a C<TO_JSON> method if necessary).
  
  Calling this method without any arguments will reset the booleans
  to their default values.
  
  C<get_boolean_values> will return both C<$false> and C<$true> values, or
  the empty list when they are set to the default.
  
  =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 is a reference to
  the newly-created hash. If the code references returns a single scalar
  (which need not be a reference), this value (or rather a copy of it) 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('[{}]');
     # returns 5
     $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 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.
  
  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.
  
  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> for more info on why this is useful.
  
  =head2 encode
  
      $json_text = $json->encode($perl_scalar)
  
  Converts the given Perl value or data structure to its JSON
  representation. Croaks on error.
  
  =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.
  
  =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.
  
  This is useful if your JSON texts are not delimited by an outer protocol
  and you need to know where the JSON text ends.
  
     JSON->new->decode_prefix ("[1] the tail")
     => ([1], 3)
  
  =head1 ADDITIONAL METHODS
  
  The following methods are for this module only.
  
  =head2 backend
  
      $backend = $json->backend
  
  Since 2.92, C<backend> method returns an abstract backend module used currently,
  which should be JSON::Backend::XS (which inherits JSON::XS or Cpanel::JSON::XS),
  or JSON::Backend::PP (which inherits JSON::PP), not to monkey-patch the actual
  backend module globally.
  
  If you need to know what is used actually, use C<isa>, instead of string comparison.
  
  =head2 is_xs
  
      $boolean = $json->is_xs
  
  Returns true if the backend inherits JSON::XS or Cpanel::JSON::XS.
  
  =head2 is_pp
  
      $boolean = $json->is_pp
  
  Returns true if the backend inherits JSON::PP.
  
  =head2 property
  
      $settings = $json->property()
  
  Returns a reference to a hash that holds all the common flag settings.
  
      $json = $json->property('utf8' => 1)
      $value = $json->property('utf8') # 1
  
  You can use this to get/set a value of a particular flag.
  
  =head2 boolean
  
      $boolean_object = JSON->boolean($scalar)
  
  Returns $JSON::true if $scalar contains a true value, $JSON::false otherwise.
  You can use this as a full-qualified function (C<JSON::boolean($scalar)>).
  
  =head1 INCREMENTAL PARSING
  
  This section is also taken from JSON::XS.
  
  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).
  
  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 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.
  
  =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 (other than
  whitespace) 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.
  
  That means you can only use this function to look at or manipulate text
  before or after complete JSON objects, not while the parser is in the
  middle of parsing a JSON object.
  
  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).
  
  =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 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
  occurred is removed.
  
  =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.
  
  =head1 MAPPING
  
  Most of this section is also taken from JSON::XS.
  
  This section describes how the backend modules map 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 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, this module 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, this module only guarantees precision up to but not including
  the least significant bit.
  
  =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.
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  =item shell-style comments (C<< # I<text> >>)
  
  As a nonstandard extension to the JSON syntax that is enabled by the
  C<relaxed> setting, shell-style comments are allowed. They can start
  anywhere outside strings and go till the end of the line.
  
  =item tagged values (C<< (I<tag>)I<value> >>).
  
  Another nonstandard extension to the JSON syntax, enabled with the
  C<allow_tags> setting, are tagged values. In this implementation, the
  I<tag> must be a perl package/class name encoded as a JSON string, and the
  I<value> must be a JSON array encoding optional constructor arguments.
  
  See L<OBJECT SERIALISATION>, below, for details.
  
  =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. This module can 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
  the same backend), 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.
  
     encode_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.
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON, but C<JSON::XS>
  allows various ways of handling objects. See L<OBJECT SERIALISATION>,
  below, for details.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: this module 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. Tell me
  if you need this capability (but don't forget to explain why it's needed
  :).
  
  Since version 2.91_01, JSON::PP uses a different number detection logic
  that converts a scalar that is possible to turn into a number safely.
  The new logic is slightly faster, and tends to help people who use older
  perl or who want to encode complicated data structure. However, this may
  results in a different JSON text from the one JSON::XS encodes (and
  thus may break tests that compare entire JSON texts). If you do
  need the previous behavior for better compatibility or for finer control,
  set PERL_JSON_PP_USE_B environmental variable to true before you
  C<use> JSON.
  
  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.
  
  JSON.pm backend modules trust what you pass to C<encode> method
  (or C<encode_json> function) is a clean, validated data structure with
  values that can be represented as valid JSON values only, because it's
  not from an external data source (as opposed to JSON texts you pass to
  C<decode> or C<decode_json>, which JSON backends consider tainted and
  don't trust). As JSON backends don't know exactly what you and consumers
  of your JSON texts want the unexpected values to be (you may want to
  convert them into null, or to stringify them with or without
  normalisation (string representation of infinities/NaN may vary
  depending on platforms), or to croak without conversion), you're advised
  to do what you and your consumers need before you encode, and also not
  to numify values that may start with values that look like a number
  (including infinities/NaN), without validating.
  
  =back
  
  =head2 OBJECT SERIALISATION
  
  As JSON cannot directly represent Perl objects, you have to choose between
  a pure JSON representation (without the ability to deserialise the object
  automatically again), and a nonstandard extension to the JSON syntax,
  tagged values.
  
  =head3 SERIALISATION
  
  What happens when this module encounters a Perl object depends on the
  C<allow_blessed>, C<convert_blessed> and C<allow_tags> settings, which
  are used in this order:
  
  =over 4
  
  =item 1. C<allow_tags> is enabled and the object has a C<FREEZE> method.
  
  In this case, C<JSON> creates a tagged JSON value, using a nonstandard
  extension to the JSON syntax.
  
  This works by invoking the C<FREEZE> method on the object, with the first
  argument being the object to serialise, and the second argument being the
  constant string C<JSON> to distinguish it from other serialisers.
  
  The C<FREEZE> method can return any number of values (i.e. zero or
  more). These values and the package/classname of the object will then be
  encoded as a tagged JSON value in the following format:
  
     ("classname")[FREEZE return values...]
  
  e.g.:
  
     ("URI")["http://www.google.com/"]
     ("MyDate")[2013,10,29]
     ("ImageData::JPEG")["Z3...VlCg=="]
  
  For example, the hypothetical C<My::Object> C<FREEZE> method might use the
  objects C<type> and C<id> members to encode the object:
  
     sub My::Object::FREEZE {
        my ($self, $serialiser) = @_;
  
        ($self->{type}, $self->{id})
     }
  
  =item 2. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.
  
  In this case, the C<TO_JSON> method of the object is invoked in scalar
  context. It must return a single scalar that can be directly encoded into
  JSON. This scalar replaces the object in the JSON text.
  
  For example, the following C<TO_JSON> method will convert all L<URI>
  objects to JSON strings when serialised. The fact that these values
  originally were L<URI> objects is lost.
  
     sub URI::TO_JSON {
        my ($uri) = @_;
        $uri->as_string
     }
  
  =item 3. C<allow_blessed> is enabled.
  
  The object will be serialised as a JSON null value.
  
  =item 4. none of the above
  
  If none of the settings are enabled or the respective methods are missing,
  this module throws an exception.
  
  =back
  
  =head3 DESERIALISATION
  
  For deserialisation there are only two cases to consider: either
  nonstandard tagging was used, in which case C<allow_tags> decides,
  or objects cannot be automatically be deserialised, in which
  case you can use postprocessing or the C<filter_json_object> or
  C<filter_json_single_key_object> callbacks to get some real objects our of
  your JSON.
  
  This section only considers the tagged value case: a tagged JSON object
  is encountered during decoding and C<allow_tags> is disabled, a parse
  error will result (as if tagged values were not part of the grammar).
  
  If C<allow_tags> is enabled, this module will look up the C<THAW> method
  of the package/classname used during serialisation (it will not attempt
  to load the package as a Perl module). If there is no such method, the
  decoding will fail with an error.
  
  Otherwise, the C<THAW> method is invoked with the classname as first
  argument, the constant string C<JSON> as second argument, and all the
  values from the JSON array (the values originally returned by the
  C<FREEZE> method) as remaining arguments.
  
  The method must then return the object. While technically you can return
  any Perl scalar, you might have to enable the C<allow_nonref> setting to
  make that work in all cases, so better return an actual blessed reference.
  
  As an example, let's implement a C<THAW> function that regenerates the
  C<My::Object> from the C<FREEZE> example earlier:
  
     sub My::Object::THAW {
        my ($class, $serialiser, $type, $id) = @_;
  
        $class->new (type => $type, id => $id)
     }
  
  
  =head1 ENCODING/CODESET FLAG NOTES
  
  This section is taken from JSON::XS.
  
  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 changes 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
  
  =head1 BACKWARD INCOMPATIBILITY
  
  Since version 2.90, stringification (and string comparison) for
  C<JSON::true> and C<JSON::false> has not been overloaded. It shouldn't
  matter as long as you treat them as boolean values, but a code that
  expects they are stringified as "true" or "false" doesn't work as
  you have expected any more.
  
      if (JSON::true eq 'true') {  # now fails
  
      print "The result is $JSON::true now."; # => The result is 1 now.
  
  And now these boolean values don't inherit JSON::Boolean, either.
  When you need to test a value is a JSON boolean value or not, use
  C<JSON::is_bool> function, instead of testing the value inherits
  a particular boolean class or not.
  
  =head1 BUGS
  
  Please report bugs on backend selection and additional features
  this module provides to RT or GitHub issues for this module:
  
  L<https://rt.cpan.org/Public/Dist/Display.html?Queue=JSON>
  
  L<https://github.com/makamaka/JSON/issues>
  
  As for bugs on a specific behavior, please report to the author
  of the backend module you are using.
  
  As for new features and requests to change common behaviors, please
  ask the author of JSON::XS (Marc Lehmann, E<lt>schmorp[at]schmorp.deE<gt>)
  first, by email (important!), to keep compatibility among JSON.pm
  backends.
  
  =head1 SEE ALSO
  
  L<JSON::XS>, L<Cpanel::JSON::XS>, L<JSON::PP> for backends.
  
  L<JSON::MaybeXS>, an alternative that prefers Cpanel::JSON::XS.
  
  C<RFC4627>(L<http://www.ietf.org/rfc/rfc4627.txt>)
  
  RFC7159 (L<http://www.ietf.org/rfc/rfc7159.txt>)
  
  RFC8259 (L<http://www.ietf.org/rfc/rfc8259.txt>)
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  JSON::XS was written by  Marc Lehmann E<lt>schmorp[at]schmorp.deE<gt>
  
  The release of this new version owes to the courtesy of Marc Lehmann.
  
  =head1 CURRENT MAINTAINER
  
  Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2005-2013 by Makamaka Hannyaharamitu
  
  Most of the documentation is taken from JSON::XS by Marc Lehmann
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
  
JSON

$fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'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.27203';
  
  @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 || '';
  }
  
  
  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"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'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{"JSON/backportPP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_BACKPORTPP';
  package # This is JSON::backportPP
      JSON::PP;
  
  # JSON-2.0
  
  use 5.005;
  use strict;
  
  use Exporter ();
  BEGIN { @JSON::backportPP::ISA = ('Exporter') }
  
  use overload ();
  use JSON::backportPP::Boolean;
  
  use Carp ();
  #use Devel::Peek;
  
  $JSON::backportPP::VERSION = '4.12';
  
  @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 P_ALLOW_TAGS           => 19;
  
  use constant OLD_PERL => $] < 5.008 ? 1 : 0;
  use constant USE_B => $ENV{PERL_JSON_PP_USE_B} || 0;
  use constant CORE_BOOL => defined &builtin::is_bool;
  
  my $invalid_char_re;
  
  BEGIN {
      $invalid_char_re = "[";
      for my $i (0 .. 0x01F, 0x22, 0x5c) { # '/' is ok
          $invalid_char_re .= quotemeta chr utf8::unicode_to_native($i);
      }
  
      $invalid_char_re = qr/$invalid_char_re]/;
  }
  
  BEGIN {
      if (USE_B) {
          require B;
      }
  }
  
  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
              allow_tags
      );
      my @pp_bit_properties = qw(
              allow_singlequote allow_bignum loose
              allow_barekey escape_slash as_nonblessed
      );
  
      # Perl version check, Unicode handling is enabled?
      # Helper module sets @JSON::PP::_properties.
      if ( OLD_PERL ) {
          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 $property_id = 'P_' . uc($name);
  
          eval qq/
              sub $name {
                  my \$enable = defined \$_[1] ? \$_[1] : 1;
  
                  if (\$enable) {
                      \$_[0]->{PROPS}->[$property_id] = 1;
                  }
                  else {
                      \$_[0]->{PROPS}->[$property_id] = 0;
                  }
  
                  \$_[0];
              }
  
              sub get_$name {
                  \$_[0]->{PROPS}->[$property_id] ? 1 : '';
              }
          /;
      }
  
  }
  
  
  
  # Functions
  
  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_length => 3,
      };
  
      $self->{PROPS}[P_ALLOW_NONREF] = 1;
  
      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)->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 boolean_values {
      my $self = shift;
      if (@_) {
          my ($false, $true) = @_;
          $self->{false} = $false;
          $self->{true} = $true;
          if (CORE_BOOL) {
              BEGIN { CORE_BOOL and warnings->unimport(qw(experimental::builtin)) }
              if (builtin::is_bool($true) && builtin::is_bool($false) && $true && !$false) {
                  $self->{core_bools} = !!1;
              }
              else {
                  delete $self->{core_bools};
              }
          }
      } else {
          delete $self->{false};
          delete $self->{true};
          delete $self->{core_bools};
      }
      return $self;
  }
  
  sub core_bools {
      my $self = shift;
      my $core_bools = defined $_[0] ? $_[0] : 1;
      if ($core_bools) {
          $self->{true} = !!1;
          $self->{false} = !!0;
          $self->{core_bools} = !!1;
      }
      else {
          $self->{true} = $JSON::PP::true;
          $self->{false} = $JSON::PP::false;
          $self->{core_bools} = !!0;
      }
      return $self;
  }
  
  sub get_core_bools {
      my $self = shift;
      return !!$self->{core_bools};
  }
  
  sub unblessed_bool {
      my $self = shift;
      return $self->core_bools(@_);
  }
  
  sub get_unblessed_bool {
      my $self = shift;
      return $self->get_core_bools(@_);
  }
  
  sub get_boolean_values {
      my $self = shift;
      if (exists $self->{true} and exists $self->{false}) {
          return @$self{qw/false true/};
      }
      return;
  }
  
  sub filter_json_object {
      if (defined $_[1] and ref $_[1] eq 'CODE') {
          $_[0]->{cb_object} = $_[1];
      } else {
          delete $_[0]->{cb_object};
      }
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
  
  sub filter_json_single_key_object {
      if (@_ == 1 or @_ > 3) {
          Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)");
      }
      if (defined $_[2] and ref $_[2] eq 'CODE') {
          $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
      } else {
          delete $_[0]->{cb_sk_object}->{$_[1]};
          delete $_[0]->{cb_sk_object} unless %{$_[0]->{cb_sk_object} || {}};
      }
      $_[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() instead.");
      $_[0]->allow_bignum;
  }
  
  ###############################
  
  ###
  ### 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 $allow_tags;
  
      my $depth;
      my $indent_count;
      my $keysort;
  
  
      sub PP_encode_json {
          my $self = shift;
          my $obj  = shift;
  
          $indent_count = 0;
          $depth        = 0;
  
          my $props = $self->{PROPS};
  
          ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
              $convert_blessed, $escape_slash, $bignum, $as_nonblessed, $allow_tags)
           = @{$props}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
                      P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED, P_ALLOW_TAGS];
  
          ($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 !$props->[ P_ALLOW_NONREF ]);
  
          my $str  = $self->object_to_json($obj);
  
          $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
  
          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 ( $allow_tags and $obj->can('FREEZE') ) {
                      my $obj_class = ref $obj || $obj;
                      $obj = bless $obj, $obj_class;
                      my @results = $obj->FREEZE('JSON');
                      if ( @results and ref $results[0] ) {
                          if ( refaddr( $obj ) eq refaddr( $results[0] ) ) {
                              encode_error( sprintf(
                                  "%s::FREEZE method returned same object as was passed instead of a new one",
                                  ref $obj
                              ) );
                          }
                      }
                      return '("'.$obj_class.'")['.join(',', @results).']';
                  }
  
                  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) );
  
                  if ($allow_blessed) {
                      return $self->blessed_to_json($obj) if ($as_nonblessed); # will be removed.
                      return 'null';
                  }
                  encode_error( sprintf("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)", $obj)
                  );
              }
              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, $self->string_to_json( $k )
                            .  $del
                            . ( ref $obj->{$k} ? $self->object_to_json( $obj->{$k} ) : $self->value_to_json( $obj->{$k} ) );
          }
  
          --$depth;
          $self->_down_indent() if ($indent);
  
          return '{}' unless @res;
          return '{' . $pre . 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, ref($v) ? $self->object_to_json($v) : $self->value_to_json($v);
          }
  
          --$depth;
          $self->_down_indent() if ($indent);
  
          return '[]' unless @res;
          return '[' . $pre . join( ",$pre", @res ) . $post . ']';
      }
  
      sub _looks_like_number {
          my $value = shift;
          if (USE_B) {
              my $b_obj = B::svref_2object(\$value);
              my $flags = $b_obj->FLAGS;
              return 1 if $flags & ( B::SVp_IOK() | B::SVp_NOK() ) and !( $flags & B::SVp_POK() );
              return;
          } else {
              no warnings 'numeric';
              # if the utf8 flag is on, it almost certainly started as a string
              return if utf8::is_utf8($value);
              # detect numbers
              # string & "" -> ""
              # number & "" -> 0 (with warning)
              # nan and inf can detect as numbers, so check with * 0
              return unless length((my $dummy = "") & $value);
              return unless 0 + $value eq $value;
              return 1 if $value * 0 == 0;
              return -1; # inf/nan
          }
      }
  
      sub value_to_json {
          my ($self, $value) = @_;
  
          return 'null' if(!defined $value);
  
          my $type = ref($value);
  
          if (!$type) {
              BEGIN { CORE_BOOL and warnings->unimport('experimental::builtin') }
              if (CORE_BOOL && builtin::is_bool($value)) {
                  return $value ? 'true' : 'false';
              }
              elsif (_looks_like_number($value)) {
                  return $value;
              }
              return $self->string_to_json($value);
          }
          elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
              return $$value == 1 ? 'true' : 'false';
          }
          else {
              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");
                  }
              }
  
          }
      }
  
  
      my %esc = (
          "\n" => '\n',
          "\r" => '\r',
          "\t" => '\t',
          "\f" => '\f',
          "\b" => '\b',
          "\"" => '\"',
          "\\" => '\\\\',
          "\'" => '\\\'',
      );
  
  
      sub string_to_json {
          my ($self, $arg) = @_;
  
          $arg =~ s/(["\\\n\r\t\f\b])/$esc{$1}/g;
          $arg =~ s/\//\\\//g if ($escape_slash);
  
          # On ASCII platforms, matches [\x00-\x08\x0b\x0e-\x1f]
          $arg =~ s/([^\n\t\c?[:^cntrl:][:^ascii:]])/'\\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 {
              chr($_) =~ /[[:ascii:]]/ ?
                  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    => "\b",
          t    => "\t",
          n    => "\n",
          f    => "\f",
          r    => "\r",
          '\\' => '\\',
          '"'  => '"',
          '/'  => '/',
      );
  
      my $text; # json data
      my $at;   # offset
      my $ch;   # first character
      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_bignum;   # using Math::BigInt/BigFloat
      my $singlequote;    # loosely quoting
      my $loose;          # 
      my $allow_barekey;  # bareKey
      my $allow_tags;
  
      my $alt_true;
      my $alt_false;
  
      sub _detect_utf_encoding {
          my $text = shift;
          my @octets = unpack('C4', $text);
          return 'unknown' unless defined $octets[3];
          return ( $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';
      }
  
      sub PP_decode_json {
          my ($self, $want_offset);
  
          ($self, $text, $want_offset) = @_;
  
          ($at, $ch, $depth) = (0, '', 0);
  
          if ( !defined $text or ref $text ) {
              decode_error("malformed JSON string, neither array, object, number, string or atom");
          }
  
          my $props = $self->{PROPS};
  
          ($utf8, $relaxed, $loose, $allow_bignum, $allow_barekey, $singlequote, $allow_tags)
              = @{$props}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE, P_ALLOW_TAGS];
  
          ($alt_true, $alt_false) = @$self{qw/true false/};
  
          if ( $utf8 ) {
              $encoding = _detect_utf_encoding($text);
              if ($encoding ne 'UTF-8' and $encoding ne 'unknown') {
                  require Encode;
                  Encode::from_to($text, $encoding, 'utf-8');
              } else {
                  utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
              }
          }
          else {
              utf8::encode( $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);
          }
  
          white(); # remove head white space
  
          decode_error("malformed JSON string, neither array, object, number, string or atom") unless defined $ch; # Is there a first character for JSON structure?
  
          my $result = value();
  
          if ( !$props->[ 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
  
          return ( $result, $consumed ) if $want_offset; # all right if decode_prefix
  
          decode_error("garbage after JSON object") if defined $ch;
  
          $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 tag()    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 $utf16;
          my $is_utf8;
  
          ($is_valid_utf8, $utf8_len) = ('', 0);
  
          my $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");
                              }
  
                              my $hex = hex( $u );
                              if ( chr $u =~ /[[:^ascii:]]/ ) {
                                  $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 ( $ch =~ /[[:^ascii:]]/ ) {
                          unless( $ch = is_valid_utf8($ch) ) {
                              $at -= 1;
                              decode_error("malformed UTF-8 character in JSON string");
                          }
                          else {
                              $at += $utf8_len - 1;
                          }
  
                          $is_utf8 = 1;
                      }
  
                      if (!$loose) {
                          if ($ch =~ $invalid_char_re)  { # '/' ok
                              if (!$relaxed or $ch ne "\t") {
                                  $at--;
                                  decode_error(sprintf "invalid character 0x%X"
                                     . " encountered while parsing JSON string",
                                     ord $ch);
                              }
                          }
                      }
  
                      $s .= $ch;
                  }
              }
          }
  
          decode_error("unexpected end of string while parsing JSON string");
      }
  
  
      sub white {
          while( defined $ch  ){
              if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){
                  next_chr();
              }
              elsif($relaxed and $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;
                  }
  
              }
          }
  
          $at-- if defined $ch and $ch ne '';
          decode_error(", or ] expected while parsing array");
      }
  
      sub tag {
          decode_error('malformed JSON string, neither array, object, number, string or atom') unless $allow_tags;
  
          next_chr();
          white();
  
          my $tag = value();
          return unless defined $tag;
          decode_error('malformed JSON string, (tag) must be a string') if ref $tag;
  
          white();
  
          if (!defined $ch or $ch ne ')') {
              decode_error(') expected after tag');
          }
  
          next_chr();
          white();
  
          my $val = value();
          return unless defined $val;
          decode_error('malformed JSON string, tag value must be an array') unless ref $val eq 'ARRAY';
  
          if (!eval { $tag->can('THAW') }) {
               decode_error('cannot decode perl-object (package does not exist)') if $@;
               decode_error('cannot decode perl-object (package does not have a THAW method)');
          }
          $tag->THAW('JSON', @$val);
      }
  
      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-- if defined $ch and $ch ne '';
          decode_error(", or } expected while parsing object/hash");
      }
  
  
      sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
          my $key;
          while($ch =~ /[\$\w[:^ascii:]]/){
              $key .= $ch;
              next_chr();
          }
          return $key;
      }
  
  
      sub word {
          my $word =  substr($text,$at-1,4);
  
          if($word eq 'true'){
              $at += 3;
              next_chr;
              return defined $alt_true ? $alt_true : $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 defined $alt_false ? $alt_false : $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;
          my $is_dec;
          my $is_exp;
  
          if($ch eq '-'){
              $n = '-';
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after initial minus)");
              }
          }
  
          # According to RFC4627, hex or oct digits are invalid.
          if($ch eq '0'){
              my $peek = substr($text,$at,1);
              if($peek =~ /^[0-9a-dfA-DF]/){ # e may be valid (exponential)
                  decode_error("malformed number (leading zero must not be followed by another digit)");
              }
              $n .= $ch;
              next_chr;
          }
  
          while(defined $ch and $ch =~ /\d/){
              $n .= $ch;
              next_chr;
          }
  
          if(defined $ch and $ch eq '.'){
              $n .= '.';
              $is_dec = 1;
  
              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;
              $is_exp = 1;
              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 ($is_dec or $is_exp) {
              if ($allow_bignum) {
                  require Math::BigFloat;
                  return Math::BigFloat->new($v);
              }
          } else {
              if (length $v > $max_intsize) {
                  if ($allow_bignum) { # from Adam Sussman
                      require Math::BigInt;
                      return Math::BigInt->new($v);
                  }
                  else {
                      return "$v";
                  }
              }
          }
  
          return $is_dec ? $v/1.0 : 0+$v;
      }
  
      # Compute how many bytes are in the longest legal official Unicode
      # character
      my $max_unicode_length = do {
        BEGIN { $] >= 5.006 and require warnings and warnings->unimport('utf8') }
        chr 0x10FFFF;
      };
      utf8::encode($max_unicode_length);
      $max_unicode_length = length $max_unicode_length;
  
      sub is_valid_utf8 {
  
          # Returns undef (setting $utf8_len to 0) unless the next bytes in $text
          # comprise a well-formed UTF-8 encoded character, in which case,
          # return those bytes, setting $utf8_len to their count.
  
          my $start_point = substr($text, $at - 1);
  
          # Look no further than the maximum number of bytes in a single
          # character
          my $limit = $max_unicode_length;
          $limit = length($start_point) if $limit > length($start_point);
  
          # Find the number of bytes comprising the first character in $text
          # (without having to know the details of its internal representation).
          # This loop will iterate just once on well-formed input.
          while ($limit > 0) {    # Until we succeed or exhaust the input
              my $copy = substr($start_point, 0, $limit);
  
              # decode() will return true if all bytes are valid; false
              # if any aren't.
              if (utf8::decode($copy)) {
  
                  # Is valid: get the first character, convert back to bytes,
                  # and return those bytes.
                  $copy = substr($copy, 0, 1);
                  utf8::encode($copy);
                  $utf8_len = length $copy;
                  return substr($start_point, 0, $utf8_len);
              }
  
              # If it didn't work, it could be that there is a full legal character
              # followed by a partial or malformed one.  Narrow the window and
              # try again.
              $limit--;
          }
  
          # Failed to find a legal UTF-8 character.
          $utf8_len = 0;
          return;
      }
  
  
      sub decode_error {
          my $error  = shift;
          my $no_rep = shift;
          my $str    = defined $text ? substr($text, $at) : '';
          my $mess   = '';
          my $type   = 'U*';
  
          if ( OLD_PERL ) {
              my $type   =  $] <  5.006           ? 'C*'
                          : utf8::is_utf8( $str ) ? 'U*' # 5.6
                          : 'C*'
                          ;
          }
  
          for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
              my $chr_c = chr($c);
              $mess .=  $chr_c eq '\\' ? '\\\\'
                      : $chr_c =~ /[[:print:]]/ ? $chr_c
                      : $chr_c eq '\a' ? '\a'
                      : $chr_c eq '\t' ? '\t'
                      : $chr_c eq '\n' ? '\n'
                      : $chr_c eq '\r' ? '\r'
                      : $chr_c eq '\f' ? '\f'
                      : 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 == 0) {
                  return $o;
              }
              elsif (@val == 1) {
                  return $val[0];
              }
              else {
                  Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar");
              }
          }
  
          my @val = $cb_object->($o) if ($cb_object);
          if (@val == 0) {
              return $o;
          }
          elsif (@val == 1) {
              return $val[0];
          }
          else {
              Carp::croak("filter_json_object callbacks must not return more than one scalar");
          }
      }
  
  
      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 ( !OLD_PERL ) {
          *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.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_pos} ) {
                  Carp::croak("incr_text cannot 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;
          };
          require B;
          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::PP::Boolean" };
  $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
  
  sub is_bool {
    if (blessed $_[0]) {
      return (
        $_[0]->isa("JSON::PP::Boolean")
        or $_[0]->isa("Types::Serialiser::BooleanBase")
        or $_[0]->isa("JSON::XS::Boolean")
      );
    }
    elsif (CORE_BOOL) {
      BEGIN { CORE_BOOL and warnings->unimport('experimental::builtin') }
      return builtin::is_bool($_[0]);
    }
    return !!0;
  }
  
  sub true  { $JSON::PP::true  }
  sub false { $JSON::PP::false }
  sub null  { undef; }
  
  ###############################
  
  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 constant INCR_M_TFN  => 6;
  use constant INCR_M_NUM  => 7;
  
  $JSON::backportPP::IncrParser::VERSION = '1.01';
  
  sub new {
      my ( $class ) = @_;
  
      bless {
          incr_nest    => 0,
          incr_text    => undef,
          incr_pos     => 0,
          incr_mode    => 0,
      }, $class;
  }
  
  
  sub incr_parse {
      my ( $self, $coder, $text ) = @_;
  
      $self->{incr_text} = '' unless ( defined $self->{incr_text} );
  
      if ( defined $text ) {
          $self->{incr_text} .= $text;
      }
  
      if ( defined wantarray ) {
          my $max_size = $coder->get_max_size;
          my $p = $self->{incr_pos};
          my @ret;
          {
              do {
                  unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) {
                      $self->_incr_parse( $coder );
  
                      if ( $max_size and $self->{incr_pos} > $max_size ) {
                          Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size");
                      }
                      unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) {
                          # as an optimisation, do not accumulate white space in the incr buffer
                          if ( $self->{incr_mode} == INCR_M_WS and $self->{incr_pos} ) {
                              $self->{incr_pos} = 0;
                              $self->{incr_text} = '';
                          }
                          last;
                      }
                  }
  
                  unless ( $coder->get_utf8 ) {
                      utf8::decode( $self->{incr_text} );
                  }
  
                  my ($obj, $offset) = $coder->PP_decode_json( $self->{incr_text}, 0x00000001 );
                  push @ret, $obj;
                  use bytes;
                  $self->{incr_text} = substr( $self->{incr_text}, $offset || 0 );
                  $self->{incr_pos} = 0;
                  $self->{incr_nest} = 0;
                  $self->{incr_mode} = 0;
                  last unless wantarray;
              } while ( wantarray );
          }
  
          if ( wantarray ) {
              return @ret;
          }
          else { # in scalar context
              return defined $ret[0] ? $ret[0] : undef;
          }
      }
  }
  
  
  sub _incr_parse {
      my ($self, $coder) = @_;
      my $text = $self->{incr_text};
      my $len = length $text;
      my $p = $self->{incr_pos};
  
  INCR_PARSE:
      while ( $len > $p ) {
          my $s = substr( $text, $p, 1 );
          last INCR_PARSE unless defined $s;
          my $mode = $self->{incr_mode};
  
          if ( $mode == INCR_M_WS ) {
              while ( $len > $p ) {
                  $s = substr( $text, $p, 1 );
                  last INCR_PARSE unless defined $s;
                  if ( ord($s) > ord " " ) {
                      if ( $s eq '#' ) {
                          $self->{incr_mode} = INCR_M_C0;
                          redo INCR_PARSE;
                      } else {
                          $self->{incr_mode} = INCR_M_JSON;
                          redo INCR_PARSE;
                      }
                  }
                  $p++;
              }
          } elsif ( $mode == INCR_M_BS ) {
              $p++;
              $self->{incr_mode} = INCR_M_STR;
              redo INCR_PARSE;
          } elsif ( $mode == INCR_M_C0 or $mode == INCR_M_C1 ) {
              while ( $len > $p ) {
                  $s = substr( $text, $p, 1 );
                  last INCR_PARSE unless defined $s;
                  if ( $s eq "\n" ) {
                      $self->{incr_mode} = $self->{incr_mode} == INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;
                      last;
                  }
                  $p++;
              }
              next;
          } elsif ( $mode == INCR_M_TFN ) {
              last INCR_PARSE if $p >= $len && $self->{incr_nest};
              while ( $len > $p ) {
                  $s = substr( $text, $p++, 1 );
                  next if defined $s and $s =~ /[rueals]/;
                  last;
              }
              $p--;
              $self->{incr_mode} = INCR_M_JSON;
  
              last INCR_PARSE unless $self->{incr_nest};
              redo INCR_PARSE;
          } elsif ( $mode == INCR_M_NUM ) {
              last INCR_PARSE if $p >= $len && $self->{incr_nest};
              while ( $len > $p ) {
                  $s = substr( $text, $p++, 1 );
                  next if defined $s and $s =~ /[0-9eE.+\-]/;
                  last;
              }
              $p--;
              $self->{incr_mode} = INCR_M_JSON;
  
              last INCR_PARSE unless $self->{incr_nest};
              redo INCR_PARSE;
          } elsif ( $mode == INCR_M_STR ) {
              while ( $len > $p ) {
                  $s = substr( $text, $p, 1 );
                  last INCR_PARSE unless defined $s;
                  if ( $s eq '"' ) {
                      $p++;
                      $self->{incr_mode} = INCR_M_JSON;
  
                      last INCR_PARSE unless $self->{incr_nest};
                      redo INCR_PARSE;
                  }
                  elsif ( $s eq '\\' ) {
                      $p++;
                      if ( !defined substr($text, $p, 1) ) {
                          $self->{incr_mode} = INCR_M_BS;
                          last INCR_PARSE;
                      }
                  }
                  $p++;
              }
          } elsif ( $mode == INCR_M_JSON ) {
              while ( $len > $p ) {
                  $s = substr( $text, $p++, 1 );
                  if ( $s eq "\x00" ) {
                      $p--;
                      last INCR_PARSE;
                  } elsif ( $s =~ /^[\t\n\r ]$/) {
                      if ( !$self->{incr_nest} ) {
                          $p--; # do not eat the whitespace, let the next round do it
                          last INCR_PARSE;
                      }
                      next;
                  } elsif ( $s eq 't' or $s eq 'f' or $s eq 'n' ) {
                      $self->{incr_mode} = INCR_M_TFN;
                      redo INCR_PARSE;
                  } elsif ( $s =~ /^[0-9\-]$/ ) {
                      $self->{incr_mode} = INCR_M_NUM;
                      redo INCR_PARSE;
                  } elsif ( $s eq '"' ) {
                      $self->{incr_mode} = INCR_M_STR;
                      redo INCR_PARSE;
                  } elsif ( $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?)');
                      }
                      next;
                  } elsif ( $s eq ']' or $s eq '}' ) {
                      if ( --$self->{incr_nest} <= 0 ) {
                          last INCR_PARSE;
                      }
                  } elsif ( $s eq '#' ) {
                      $self->{incr_mode} = INCR_M_C1;
                      redo INCR_PARSE;
                  }
              }
          }
      }
  
      $self->{incr_pos} = $p;
      $self->{incr_parsing} = $p ? 1 : 0; # for backward compatibility
  }
  
  
  sub incr_text {
      if ( $_[0]->{incr_pos} ) {
          Carp::croak("incr_text cannot 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_pos} );
      $self->{incr_pos}     = 0;
      $self->{incr_mode}    = 0;
      $self->{incr_nest}    = 0;
  }
  
  
  sub incr_reset {
      my $self = shift;
      $self->{incr_text}    = undef;
      $self->{incr_pos}     = 0;
      $self->{incr_mode}    = 0;
      $self->{incr_nest}    = 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
  
   $json = JSON::PP->new->ascii->pretty->allow_nonref;
   
   $pretty_printed_json_text = $json->encode( $perl_scalar );
   $perl_scalar = $json->decode( $json_text );
   
   # 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 DESCRIPTION
  
  JSON::PP is a pure perl JSON decoder/encoder, and (almost) compatible to much
  faster L<JSON::XS> written by Marc Lehmann in C. JSON::PP works as
  a fallback module when you use L<JSON> module without having
  installed JSON::XS.
  
  Because of this fallback feature of JSON.pm, JSON::PP tries not to
  be more JavaScript-friendly than JSON::XS (i.e. not to escape extra
  characters such as U+2028 and U+2029, etc),
  in order for you not to lose such JavaScript-friendliness silently
  when you use JSON.pm and install JSON::XS for speed or by accident.
  If you need JavaScript-friendly RFC7159-compliant pure perl module,
  try L<JSON::Tiny>, which is derived from L<Mojolicious> web
  framework and is also smaller and faster than JSON::PP.
  
  JSON::PP has been in the Perl core since Perl 5.14, mainly for
  CPAN toolchain modules to parse META.json.
  
  =head1 FUNCTIONAL INTERFACE
  
  This section is taken from JSON::XS almost verbatim. C<encode_json>
  and C<decode_json> are exported by default.
  
  =head2 encode_json
  
      $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::PP->new->utf8->encode($perl_scalar)
  
  Except being faster.
  
  =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. Croaks on error.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON::PP->new->utf8->decode($json_text)
  
  Except being faster.
  
  =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.
  
  On perl 5.36 and above, will also return true when given one of perl's
  standard boolean values, such as the result of a comparison.
  
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
  
  =head1 OBJECT-ORIENTED INTERFACE
  
  This section is also taken from JSON::XS.
  
  The object oriented interface lets you configure your own encoding or
  decoding style, within the limits of supported formats.
  
  =head2 new
  
      $json = JSON::PP->new
  
  Creates a new JSON::PP object that can be used to de/encode JSON
  strings. All boolean flags described below are by default I<disabled>
  (with the exception of C<allow_nonref>, which defaults to I<enabled> since
  version C<4.0>).
  
  The mutators for flags all return the JSON::PP 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 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::PP->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
  
  =head2 latin1
  
      $json = $json->latin1([$enable])
      
      $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::PP->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 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::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> (and in the future possibly more) flags in one call to
  generate the most readable (or most compact) form possible.
  
  =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, 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.
  
  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. You will also
  most likely combine this setting with C<space_after>.
  
  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...
    ]
  
  =item * C-style multiple-line '/* */'-comments (JSON::PP only)
  
  Whenever JSON allows whitespace, C-style multiple-line comments are additionally
  allowed. Everything between C</*> and C<*/> is a comment, after which
  more white-space and comments are allowed.
  
    [
       1, /* this comment not allowed in JSON */
          /* neither this one... */
    ]
  
  =item * C++-style one-line '//'-comments (JSON::PP only)
  
  Whenever JSON allows whitespace, C++-style one-line 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...
    ]
  
  =item * literal ASCII TAB characters in strings
  
  Literal ASCII TAB characters are now allowed in strings (and treated as
  C<\t>).
  
    [
       "Hello\tWorld",
       "Hello<TAB>World", # literal <TAB> would not normally be allowed
    ]
  
  =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, 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.
  
  =head2 allow_nonref
  
      $json = $json->allow_nonref([$enable])
      
      $enabled = $json->get_allow_nonref
  
  Unlike other boolean options, this opotion is enabled by default beginning
  with version C<4.0>.
  
  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 without enabled C<allow_nonref>,
  resulting in an error:
  
     JSON::PP->new->allow_nonref(0)->encode ("Hello, World!")
     => hash- or arrayref expected...
  
  =head2 allow_unknown
  
      $json = $json->allow_unknown([$enable])
      
      $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_blessed>.
  
  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.
  
  =head2 allow_blessed
  
      $json = $json->allow_blessed([$enable])
      
      $enabled = $json->get_allow_blessed
  
  See L<OBJECT SERIALISATION> for details.
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference that it cannot convert
  otherwise. Instead, a JSON C<null> value is encoded instead of the object.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object that it cannot convert
  otherwise.
  
  This setting has no effect on C<decode>.
  
  =head2 convert_blessed
  
      $json = $json->convert_blessed([$enable])
      
      $enabled = $json->get_convert_blessed
  
  See L<OBJECT SERIALISATION> for details.
  
  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.
  
  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.
  
  If C<$enable> is false (the default), then C<encode> will not consider
  this type of conversion.
  
  This setting has no effect on C<decode>.
  
  =head2 allow_tags
  
      $json = $json->allow_tags([$enable])
  
      $enabled = $json->get_allow_tags
  
  See L<OBJECT SERIALISATION> for details.
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<FREEZE> method on
  the object's class. If found, it will be used to serialise the object into
  a nonstandard tagged JSON value (that JSON decoders cannot decode).
  
  It also causes C<decode> to parse such tagged JSON values and deserialise
  them via a call to the C<THAW> method.
  
  If C<$enable> is false (the default), then C<encode> will not consider
  this type of conversion, and tagged JSON values will cause a parse error
  in C<decode>, as if tags were not part of the grammar.
  
  =head2 boolean_values
  
      $json->boolean_values([$false, $true])
  
      ($false,  $true) = $json->get_boolean_values
  
  By default, JSON booleans will be decoded as overloaded
  C<$JSON::PP::false> and C<$JSON::PP::true> objects.
  
  With this method you can specify your own boolean values for decoding -
  on decode, JSON C<false> will be decoded as a copy of C<$false>, and JSON
  C<true> will be decoded as C<$true> ("copy" here is the same thing as
  assigning a value to another variable, i.e. C<$copy = $false>).
  
  This is useful when you want to pass a decoded data structure directly
  to other serialisers like YAML, Data::MessagePack and so on.
  
  Note that this works only when you C<decode>. You can set incompatible
  boolean objects (like L<boolean>), but when you C<encode> a data structure
  with such boolean objects, you still need to enable C<convert_blessed>
  (and add a C<TO_JSON> method if necessary).
  
  Calling this method without any arguments will reset the booleans
  to their default values.
  
  C<get_boolean_values> will return both C<$false> and C<$true> values, or
  the empty list when they are set to the default.
  
  =head2 core_bools
  
      $json->core_bools([$enable]);
  
  If C<$enable> is true (or missing), then C<decode>, will produce standard
  perl boolean values. Equivalent to calling:
  
      $json->boolean_values(!!1, !!0)
  
  C<get_core_bools> will return true if this has been set. On perl 5.36, it will
  also return true if the boolean values have been set to perl's core booleans
  using the C<boolean_values> method.
  
  The methods C<unblessed_bool> and C<get_unblessed_bool> are provided as aliases
  for compatibility with L<Cpanel::JSON::XS>.
  
  =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 is a reference to
  the newly-created hash. If the code references returns a single scalar
  (which need not be a reference), this value (or rather a copy of it) 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('[{}]');
     # returns 5
     $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
  
  If C<$enable> is true (or missing), the string returned by C<encode> will
  be shrunk (i.e. downgraded if possible).
  
  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 false, then JSON::PP does nothing.
  
  =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.
  
  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.
  
  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> for more info on why this is useful.
  
  =head2 encode
  
      $json_text = $json->encode($perl_scalar)
  
  Converts the given Perl value or data structure to its JSON
  representation. Croaks on error.
  
  =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.
  
  =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.
  
  This is useful if your JSON texts are not delimited by an outer protocol
  and you need to know where the JSON text ends.
  
     JSON::PP->new->decode_prefix ("[1] the tail")
     => ([1], 3)
  
  =head1 FLAGS FOR JSON::PP ONLY
  
  The following flags and properties are for JSON::PP only. If you use
  any of these, you can't make your application run faster by replacing
  JSON::PP with JSON::XS. If you need these and also speed boost,
  you might want to try L<Cpanel::JSON::XS>, a fork of JSON::XS by
  Reini Urban, which supports some of these (with a different set of
  incompatibilities). Most of these historical flags are only kept
  for backward compatibility, and should not be used in a new application.
  
  =head2 allow_singlequote
  
      $json = $json->allow_singlequote([$enable])
      $enabled = $json->get_allow_singlequote
  
  If C<$enable> is true (or missing), then C<decode> will accept
  invalid JSON texts that contain strings that begin and end with
  single quotation marks. C<encode> will not be affected in any way.
  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.
  
      $json->allow_singlequote->decode(qq|{"foo":'bar'}|);
      $json->allow_singlequote->decode(qq|{'foo':"bar"}|);
      $json->allow_singlequote->decode(qq|{'foo':'bar'}|);
  
  =head2 allow_barekey
  
      $json = $json->allow_barekey([$enable])
      $enabled = $json->get_allow_barekey
  
  If C<$enable> is true (or missing), then C<decode> will accept
  invalid JSON texts that contain JSON objects whose names don't
  begin and end with quotation marks. C<encode> will not be affected
  in any way. 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.
  
      $json->allow_barekey->decode(qq|{foo:"bar"}|);
  
  =head2 allow_bignum
  
      $json = $json->allow_bignum([$enable])
      $enabled = $json->get_allow_bignum
  
  If C<$enable> is true (or missing), then C<decode> will convert
  big integers Perl cannot handle as integer into L<Math::BigInt>
  objects and convert floating numbers into L<Math::BigFloat>
  objects. C<encode> will convert C<Math::BigInt> and C<Math::BigFloat>
  objects into JSON numbers.
  
     $json->allow_nonref->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
  
  See also L<MAPPING>.
  
  =head2 loose
  
      $json = $json->loose([$enable])
      $enabled = $json->get_loose
  
  If C<$enable> is true (or missing), then C<decode> will accept
  invalid JSON texts that contain unescaped [\x00-\x1f\x22\x5c]
  characters. C<encode> will not be affected in any way.
  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.
  
      $json->loose->decode(qq|["abc
                                     def"]|);
  
  =head2 escape_slash
  
      $json = $json->escape_slash([$enable])
      $enabled = $json->get_escape_slash
  
  If C<$enable> is true (or missing), then C<encode> will explicitly
  escape I<slash> (solidus; C<U+002F>) characters to reduce the risk of
  XSS (cross site scripting) that may be caused by C<< </script> >>
  in a JSON text, with the cost of bloating the size of JSON texts.
  
  This option may be useful when you embed JSON in HTML, but embedding
  arbitrary JSON in HTML (by some HTML template toolkit or by string
  interpolation) is risky in general. You must escape necessary
  characters in correct order, depending on the context.
  
  C<decode> will not be affected in any way.
  
  =head2 indent_length
  
      $json = $json->indent_length($number_of_spaces)
      $length = $json->get_indent_length
  
  This option is only useful when you also enable C<indent> or C<pretty>.
  
  JSON::XS indents with three spaces when you C<encode> (if requested
  by C<indent> or C<pretty>), and the number cannot be changed.
  JSON::PP allows you to change/get the number of indent spaces with these
  mutator/accessor. The default number of spaces is three (the same as
  JSON::XS), and the acceptable range is from C<0> (no indentation;
  it'd be better to disable indentation by C<indent(0)>) to C<15>.
  
  =head2 sort_by
  
      $json = $json->sort_by($code_ref)
      $json = $json->sort_by($subroutine_name)
  
  If you just want to sort keys (names) in JSON objects when you
  C<encode>, enable C<canonical> option (see above) that allows you to
  sort object keys alphabetically.
  
  If you do need to sort non-alphabetically for whatever reasons,
  you can give a code reference (or a subroutine name) to C<sort_by>,
  then the argument will be passed to Perl's C<sort> built-in function.
  
  As the sorting is done in the JSON::PP scope, you usually need to
  prepend C<JSON::PP::> to the subroutine name, and the special variables
  C<$a> and C<$b> used in the subrontine used by C<sort> function.
  
  Example:
  
     my %ORDER = (id => 1, class => 2, name => 3);
     $json->sort_by(sub {
         ($ORDER{$JSON::PP::a} // 999) <=> ($ORDER{$JSON::PP::b} // 999)
         or $JSON::PP::a cmp $JSON::PP::b
     });
     print $json->encode([
         {name => 'CPAN', id => 1, href => 'http://cpan.org'}
     ]);
     # [{"id":1,"name":"CPAN","href":"http://cpan.org"}]
  
  Note that C<sort_by> affects all the plain hashes in the data structure.
  If you need finer control, C<tie> necessary hashes with a module that
  implements ordered hash (such as L<Hash::Ordered> and L<Tie::IxHash>).
  C<canonical> and C<sort_by> don't affect the key order in C<tie>d
  hashes.
  
     use Hash::Ordered;
     tie my %hash, 'Hash::Ordered',
         (name => 'CPAN', id => 1, href => 'http://cpan.org');
     print $json->encode([\%hash]);
     # [{"name":"CPAN","id":1,"href":"http://cpan.org"}] # order is kept
  
  =head1 INCREMENTAL PARSING
  
  This section is also taken from JSON::XS.
  
  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::PP 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.
  
  =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 (other than
  whitespace) 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::PP->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.
  
  That means you can only use this function to look at or manipulate text
  before or after complete JSON objects, not while the parser is in the
  middle of parsing a JSON object.
  
  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).
  
  =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 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
  occurred is removed.
  
  =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.
  
  =head1 MAPPING
  
  Most of this section is also taken from JSON::XS.
  
  This section describes how JSON::PP 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::PP 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, JSON::PP only guarantees precision up to but not including
  the least significant bit.
  
  When C<allow_bignum> is enabled, big integer values and any numeric
  values will be converted into L<Math::BigInt> and L<Math::BigFloat>
  objects respectively, without becoming string scalars or losing
  precision.
  
  =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::PP::is_bool> function.
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  =item shell-style comments (C<< # I<text> >>)
  
  As a nonstandard extension to the JSON syntax that is enabled by the
  C<relaxed> setting, shell-style comments are allowed. They can start
  anywhere outside strings and go till the end of the line.
  
  =item tagged values (C<< (I<tag>)I<value> >>).
  
  Another nonstandard extension to the JSON syntax, enabled with the
  C<allow_tags> setting, are tagged values. In this implementation, the
  I<tag> must be a perl package/class name encoded as a JSON string, and the
  I<value> must be a JSON array encoding optional constructor arguments.
  
  See L<OBJECT SERIALISATION>, below, for details.
  
  =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. JSON::PP can optionally sort the hash keys
  (determined by the I<canonical> flag and/or I<sort_by> property), so
  the same data structure will serialise to the same JSON text (given
  same settings and version of JSON::PP), 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::PP::false> and C<JSON::PP::true> to improve
  readability.
  
     to_json [\0, JSON::PP::true]      # yields [false,true]
  
  =item JSON::PP::true, JSON::PP::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 JSON::PP::null
  
  This special value becomes JSON null.
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON, but C<JSON::PP>
  allows various ways of handling objects. See L<OBJECT SERIALISATION>,
  below, for details.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: 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 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
                  # (but for older perls)
  
  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.
  
  Since version 2.91_01, JSON::PP uses a different number detection logic
  that converts a scalar that is possible to turn into a number safely.
  The new logic is slightly faster, and tends to help people who use older
  perl or who want to encode complicated data structure. However, this may
  results in a different JSON text from the one JSON::XS encodes (and
  thus may break tests that compare entire JSON texts). If you do
  need the previous behavior for compatibility or for finer control,
  set PERL_JSON_PP_USE_B environmental variable to true before you
  C<use> JSON::PP (or JSON.pm).
  
  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.
  
  JSON::PP (and JSON::XS) trusts what you pass to C<encode> method
  (or C<encode_json> function) is a clean, validated data structure with
  values that can be represented as valid JSON values only, because it's
  not from an external data source (as opposed to JSON texts you pass to
  C<decode> or C<decode_json>, which JSON::PP considers tainted and
  doesn't trust). As JSON::PP doesn't know exactly what you and consumers
  of your JSON texts want the unexpected values to be (you may want to
  convert them into null, or to stringify them with or without
  normalisation (string representation of infinities/NaN may vary
  depending on platforms), or to croak without conversion), you're advised
  to do what you and your consumers need before you encode, and also not
  to numify values that may start with values that look like a number
  (including infinities/NaN), without validating.
  
  =back
  
  =head2 OBJECT SERIALISATION
  
  As JSON cannot directly represent Perl objects, you have to choose between
  a pure JSON representation (without the ability to deserialise the object
  automatically again), and a nonstandard extension to the JSON syntax,
  tagged values.
  
  =head3 SERIALISATION
  
  What happens when C<JSON::PP> encounters a Perl object depends on the
  C<allow_blessed>, C<convert_blessed>, C<allow_tags> and C<allow_bignum>
  settings, which are used in this order:
  
  =over 4
  
  =item 1. C<allow_tags> is enabled and the object has a C<FREEZE> method.
  
  In this case, C<JSON::PP> creates a tagged JSON value, using a nonstandard
  extension to the JSON syntax.
  
  This works by invoking the C<FREEZE> method on the object, with the first
  argument being the object to serialise, and the second argument being the
  constant string C<JSON> to distinguish it from other serialisers.
  
  The C<FREEZE> method can return any number of values (i.e. zero or
  more). These values and the paclkage/classname of the object will then be
  encoded as a tagged JSON value in the following format:
  
     ("classname")[FREEZE return values...]
  
  e.g.:
  
     ("URI")["http://www.google.com/"]
     ("MyDate")[2013,10,29]
     ("ImageData::JPEG")["Z3...VlCg=="]
  
  For example, the hypothetical C<My::Object> C<FREEZE> method might use the
  objects C<type> and C<id> members to encode the object:
  
     sub My::Object::FREEZE {
        my ($self, $serialiser) = @_;
  
        ($self->{type}, $self->{id})
     }
  
  =item 2. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.
  
  In this case, the C<TO_JSON> method of the object is invoked in scalar
  context. It must return a single scalar that can be directly encoded into
  JSON. This scalar replaces the object in the JSON text.
  
  For example, the following C<TO_JSON> method will convert all L<URI>
  objects to JSON strings when serialised. The fact that these values
  originally were L<URI> objects is lost.
  
     sub URI::TO_JSON {
        my ($uri) = @_;
        $uri->as_string
     }
  
  =item 3. C<allow_bignum> is enabled and the object is a C<Math::BigInt> or C<Math::BigFloat>.
  
  The object will be serialised as a JSON number value.
  
  =item 4. C<allow_blessed> is enabled.
  
  The object will be serialised as a JSON null value.
  
  =item 5. none of the above
  
  If none of the settings are enabled or the respective methods are missing,
  C<JSON::PP> throws an exception.
  
  =back
  
  =head3 DESERIALISATION
  
  For deserialisation there are only two cases to consider: either
  nonstandard tagging was used, in which case C<allow_tags> decides,
  or objects cannot be automatically be deserialised, in which
  case you can use postprocessing or the C<filter_json_object> or
  C<filter_json_single_key_object> callbacks to get some real objects our of
  your JSON.
  
  This section only considers the tagged value case: a tagged JSON object
  is encountered during decoding and C<allow_tags> is disabled, a parse
  error will result (as if tagged values were not part of the grammar).
  
  If C<allow_tags> is enabled, C<JSON::PP> will look up the C<THAW> method
  of the package/classname used during serialisation (it will not attempt
  to load the package as a Perl module). If there is no such method, the
  decoding will fail with an error.
  
  Otherwise, the C<THAW> method is invoked with the classname as first
  argument, the constant string C<JSON> as second argument, and all the
  values from the JSON array (the values originally returned by the
  C<FREEZE> method) as remaining arguments.
  
  The method must then return the object. While technically you can return
  any Perl scalar, you might have to enable the C<allow_nonref> setting to
  make that work in all cases, so better return an actual blessed reference.
  
  As an example, let's implement a C<THAW> function that regenerates the
  C<My::Object> from the C<FREEZE> example earlier:
  
     sub My::Object::THAW {
        my ($class, $serialiser, $type, $id) = @_;
  
        $class->new (type => $type, id => $id)
     }
  
  
  =head1 ENCODING/CODESET FLAG NOTES
  
  This section is taken from JSON::XS.
  
  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 changes 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
  
  =head1 BUGS
  
  Please report bugs on a specific behavior of this module to RT or GitHub
  issues (preferred):
  
  L<https://github.com/makamaka/JSON-PP/issues>
  
  L<https://rt.cpan.org/Public/Dist/Display.html?Queue=JSON-PP>
  
  As for new features and requests to change common behaviors, please
  ask the author of JSON::XS (Marc Lehmann, E<lt>schmorp[at]schmorp.deE<gt>)
  first, by email (important!), to keep compatibility among JSON.pm backends.
  
  Generally speaking, if you need something special for you, you are advised
  to create a new module, maybe based on L<JSON::Tiny>, which is smaller and
  written in a much cleaner way than this module.
  
  =head1 SEE ALSO
  
  The F<json_pp> command line utility for quick experiments.
  
  L<JSON::XS>, L<Cpanel::JSON::XS>, and L<JSON::Tiny> for faster alternatives.
  L<JSON> and L<JSON::MaybeXS> for easy migration.
  
  L<JSON::backportPP::Compat5005> and L<JSON::backportPP::Compat5006> for older perl users.
  
  RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
  
  RFC7159 (L<http://www.ietf.org/rfc/rfc7159.txt>)
  
  RFC8259 (L<http://www.ietf.org/rfc/rfc8259.txt>)
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  =head1 CURRENT MAINTAINER
  
  Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2007-2016 by Makamaka Hannyaharamitu
  
  Most of the documentation is taken from JSON::XS by Marc Lehmann
  
  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"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_BACKPORTPP_BOOLEAN';
  package # This is JSON::backportPP
      JSON::PP::Boolean;
  
  use strict;
  require overload;
  local $^W;
  overload::unimport('overload', qw(0+ ++ -- fallback));
  overload::import('overload',
      "0+"     => sub { ${$_[0]} },
      "++"     => sub { $_[0] = ${$_[0]} + 1 },
      "--"     => sub { $_[0] = ${$_[0]} - 1 },
      fallback => 1,
  );
  
  $JSON::backportPP::Boolean::VERSION = '4.12';
  
  1;
  
  __END__
  
  =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.
  
  =head1 AUTHOR
  
  This idea is from L<JSON::XS::Boolean> written by Marc Lehmann <schmorp[at]schmorp.de>
  
  =head1 LICENSE
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
  
JSON_BACKPORTPP_BOOLEAN

$fatpacked{"JSON/backportPP/Compat5005.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'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"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'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{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META';
  use strict;
  package Parse::CPAN::Meta;
  # ABSTRACT: Parse META.yml and META.json CPAN metadata files
  our $VERSION = '1.4405'; # 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.4405
  
  =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<https://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<http://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta>
  
    git clone git://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta.git
  
  =head1 AUTHOR
  
  Adam Kennedy <adamk@cpan.org>
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Joshua ben Jore <jjore@cpan.org>
  
  =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{"Try/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TRY_TINY';
  package Try::Tiny; # git description: v0.30-11-g1b81d0a
  use 5.006;
  # ABSTRACT: Minimal try/catch with proper preservation of $@
  
  our $VERSION = '0.31';
  
  use strict;
  use warnings;
  
  use Exporter 5.57 'import';
  our @EXPORT = our @EXPORT_OK = qw(try catch finally);
  
  use Carp;
  $Carp::Internal{+__PACKAGE__}++;
  
  BEGIN {
    my $su = $INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname;
    my $sn = $INC{'Sub/Name.pm'} && eval { Sub::Name->VERSION(0.08) };
    unless ($su || $sn) {
      $su = eval { require Sub::Util; } && defined &Sub::Util::set_subname;
      unless ($su) {
        $sn = eval { require Sub::Name; Sub::Name->VERSION(0.08) };
      }
    }
  
    *_subname = $su ? \&Sub::Util::set_subname
              : $sn ? \&Sub::Name::subname
              : sub { $_[1] };
    *_HAS_SUBNAME = ($su || $sn) ? sub(){1} : sub(){0};
  }
  
  my %_finally_guards;
  
  # 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;
  
    # work around perl bug by explicitly initializing these, due to the likelyhood
    # this will be used in global destruction (perl rt#119311)
    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) {
  
      if ( ref($code_ref) eq 'Try::Tiny::Catch' ) {
        croak 'A try() may not be followed by multiple catch() blocks'
          if $catch;
        $catch = ${$code_ref};
      } elsif ( ref($code_ref) eq 'Try::Tiny::Finally' ) {
        push @finally, ${$code_ref};
      } else {
        croak(
          'try() encountered an unexpected argument ('
        . ( defined $code_ref ? $code_ref : 'undef' )
        . ') - perhaps a missing semi-colon before or'
        );
      }
    }
  
    # 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->();
  
    # name the blocks if we have Sub::Name installed
    _subname(caller().'::try {...} ' => $try)
      if _HAS_SUBNAME;
  
    # set up scope guards to invoke the finally blocks at the end.
    # this should really be a function scope lexical variable instead of
    # file scope + local but that causes issues with perls < 5.20 due to
    # perl rt#119311
    local $_finally_guards{guards} = [
      map Try::Tiny::ScopeGuard->_new($_),
      @finally
    ];
  
    # save the value of $@ so we can set $@ back to it in the beginning of the eval
    # and restore $@ after the eval finishes
    my $prev_error = $@;
  
    my ( @ret, $error );
  
    # failed will be true if the eval dies, because 1 will not be returned
    # from the eval body
    my $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 $failed to false
    };
  
    # preserve the current error and reset the original value of $@
    $error = $@;
    $@ = $prev_error;
  
    # at this point $failed contains a true value if the eval died, even if some
    # destructor overwrote $@ as the eval was unwinding.
    if ( $failed ) {
      # pass $error to the finally blocks
      push @$_, $error for @{$_finally_guards{guards}};
  
      # 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 ) = @_;
  
    croak 'Useless bare catch()' unless wantarray;
  
    _subname(caller().'::catch {...} ' => $block)
      if _HAS_SUBNAME;
    return (
      bless(\$block, 'Try::Tiny::Catch'),
      @rest,
    );
  }
  
  sub finally (&;@) {
    my ( $block, @rest ) = @_;
  
    croak 'Useless bare finally()' unless wantarray;
  
    _subname(caller().'::finally {...} ' => $block)
      if _HAS_SUBNAME;
    return (
      bless(\$block, 'Try::Tiny::Finally'),
      @rest,
    );
  }
  
  {
    package # hide from PAUSE
      Try::Tiny::ScopeGuard;
  
    use constant UNSTABLE_DOLLARAT => ("$]" < '5.013002') ? 1 : 0;
  
    sub _new {
      shift;
      bless [ @_ ];
    }
  
    sub DESTROY {
      my ($code, @args) = @{ $_[0] };
  
      local $@ if UNSTABLE_DOLLARAT;
      eval {
        $code->(@args);
        1;
      } or do {
        warn
          "Execution of finally() block $code resulted in an exception, which "
        . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. '
        . 'Your program will continue as if this event never took place. '
        . "Original exception text follows:\n\n"
        . (defined $@ ? $@ : '$@ left undefined...')
        . "\n"
        ;
      }
    }
  }
  
  __PACKAGE__
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Try::Tiny - Minimal try/catch with proper preservation of $@
  
  =head1 VERSION
  
  version 0.31
  
  =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.
  
  Note that adding a C<finally> block without a preceding C<catch> block
  suppresses any errors. This behaviour is consistent with using a standalone
  C<eval>, but it is not consistent with C<try>/C<finally> patterns found in
  other programming languages, such as Java, Python, Javascript or C#. If you
  learned the C<try>/C<finally> pattern from one of these languages, watch out for
  this.
  
  =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.
  
  Furthermore B<exceptions in C<finally> blocks are not trappable and are unable
  to influence the execution of your program>. This is due to limitation of
  C<DESTROY>-based scope guards, which C<finally> is implemented on top of. This
  may change in a future version of Try::Tiny.
  
  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,
  L<before Perl version 5.14.0|perl5140delta/"Exception Handling">
  C<$@> was clobbered at the beginning of the C<eval>, which
  also made 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 (the one
  available before entering the C<try> block) 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 (fixed in L<Perl 5.14.0|perl5140delta/"Exception Handling">) 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 ALTERNATE SYNTAX
  
  Using Perl 5.10 you can use L<perlsyn/"Switch statements"> (but please don't,
  because that syntax has since been deprecated because there was too much
  unexpected magical behaviour).
  
  =for stopwords topicalizer
  
  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
  argument list. 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!";
    }
    # OR
    sub parent_sub_with_catch {
      my $success = try {
        die;
        1;
      }
      catch {
        # do something with $_
        return undef; #see note
      };
      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.
  
  =for stopwords unhygienically
  
  =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 unhygienically 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
        }
      }
    }
  
  Note that this behavior was changed once again in
  L<Perl5 version 18|https://metacpan.org/module/perldelta#given-now-aliases-the-global-_>.
  However, since the entirety of lexical C<$_> is now L<considered experimental
  |https://metacpan.org/module/perldelta#Lexical-_-is-now-experimental>, it
  is unclear whether the new version 18 behavior is final.
  
  =back
  
  =head1 SEE ALSO
  
  =over 4
  
  =item L<Syntax::Keyword::Try>
  
  Only available on perls >= 5.14, with a slightly different syntax (e.g. no trailing C<;> because
  it's actually a keyword, not a sub, but this means you can C<return> and C<next> within it). Use
  L<Feature::Compat::Try> to automatically switch to the native C<try> syntax in newer perls (when
  available). See also L<Try Catch Exception Handling|perlsyn/Try-Catch-Exception-Handling>.
  
  =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://web.archive.org/web/20100628040134/http://nothingmuch.woobling.org/talks/takahashi.xul>
  
  Or read the source:
  
  L<http://web.archive.org/web/20100305133605/http://nothingmuch.woobling.org/talks/yapc_asia_2009/try_tiny.yml>
  
  =head1 SUPPORT
  
  Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Try-Tiny>
  (or L<bug-Try-Tiny@rt.cpan.org|mailto:bug-Try-Tiny@rt.cpan.org>).
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
  
  =item *
  
  Jesse Luehrs <doy@tozt.net>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =for stopwords Karen Etheridge Peter Rabbitson Ricardo Signes Mark Fowler Graham Knop Aristotle Pagaltzis Dagfinn Ilmari Mannsåker Lukas Mai Alex anaxagoras Andrew Yates awalker chromatic cm-perl David Lowe Glenn Hans Dieter Pearcey Jens Berthold Jonathan Yu Marc Mims Stosberg Pali Paul Howarth Rudolf Leermakers
  
  =over 4
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  Peter Rabbitson <ribasushi@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =item *
  
  Mark Fowler <mark@twoshortplanks.com>
  
  =item *
  
  Graham Knop <haarg@haarg.org>
  
  =item *
  
  Aristotle Pagaltzis <pagaltzis@gmx.de>
  
  =item *
  
  Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
  
  =item *
  
  Lukas Mai <l.mai@web.de>
  
  =item *
  
  Alex <alex@koban.(none)>
  
  =item *
  
  anaxagoras <walkeraj@gmail.com>
  
  =item *
  
  Andrew Yates <ayates@haddock.local>
  
  =item *
  
  awalker <awalker@sourcefire.com>
  
  =item *
  
  chromatic <chromatic@wgz.org>
  
  =item *
  
  cm-perl <cm-perl@users.noreply.github.com>
  
  =item *
  
  David Lowe <davidl@lokku.com>
  
  =item *
  
  Glenn Fowler <cebjyre@cpan.org>
  
  =item *
  
  Hans Dieter Pearcey <hdp@weftsoar.net>
  
  =item *
  
  Jens Berthold <jens@jebecs.de>
  
  =item *
  
  Jonathan Yu <JAWNSY@cpan.org>
  
  =item *
  
  Marc Mims <marc@questright.com>
  
  =item *
  
  Mark Stosberg <mark@stosberg.com>
  
  =item *
  
  Pali <pali@cpan.org>
  
  =item *
  
  Paul Howarth <paul@city-fan.org>
  
  =item *
  
  Rudolf Leermakers <rudolf@hatsuseno.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENCE
  
  This software is Copyright (c) 2009 by יובל קוג'מן (Yuval Kogman).
  
  This is free software, licensed under:
  
    The MIT (X11) License
  
  =cut
TRY_TINY

s/^  //mg for values %fatpacked;

my $class = 'FatPacked::'.(0+\%fatpacked);
no strict 'refs';
*{"${class}::files"} = sub { keys %{$_[0]} };

if ($] < 5.008) {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      my $pos = 0;
      my $last = length $fat;
      return (sub {
        return 0 if $pos == $last;
        my $next = (1 + index $fat, "\n", $pos) || $last;
        $_ .= substr $fat, $pos, $next - $pos;
        $pos = $next;
        return 1;
      });
    }
  };
}

else {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      open my $fh, '<', \$fat
        or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
      return $fh;
    }
    return;
  };
}

unshift @INC, bless \%fatpacked, $class;
  } # END OF FATPACK CODE

use strict;
use warnings;
use 5.010;

use App::Rakubrew;


my $app = App::Rakubrew->new(@ARGV);
$app->run_script();


__END__

=head1 NAME

rakubrew - Raku environment manager

=head1 SYNOPSIS

 rakubrew version          # or rakubrew current
 rakubrew versions         # or rakubrew list
 rakubrew global [version] # or rakubrew switch [<version>]
 rakubrew shell [--unset|<version>]
 rakubrew local [<version>]
 rakubrew nuke [<version>] # or rakubrew unregister [<version>]
 rakubrew rehash

 rakubrew available        # or rakubrew list-available
 rakubrew build [<backend>] [<tag>|<branch>|<sha-1>] [--configure-opts=<options>]
 rakubrew triple [<rakudo-version> [<nqp-version> [<moar-version>]]]
 rakubrew register <name> <path>
 rakubrew build-zef [<zef-version>]
 rakubrew download [<backend>] [<rakudo-version>]

 rakubrew exec <executable> [<executable-args>]
 rakubrew which <executable>
 rakubrew whence [--path] <executable>
 rakubrew mode [env|shim]
 rakubrew self-upgrade
 rakubrew init

 rakubrew test [<version>|all]

 rakubrew help [--verbose|<command>]
 rakubrew home
 rakubrew rakubrew-version


=head1 COMMAND: version

Usage: rakubrew version|current <version>

Show the currently active Rakudo version.

=head1 COMMAND: current

Usage: rakubrew version|current <version>

Show the currently active Rakudo version.

=head1 COMMAND: versions

Usage: rakubrew versions|list <version>

List all installed Rakudo installations.
The currently active Rakudo installation is marked with a star at the beginning
of the line.

=head1 COMMAND: list

Usage: rakubrew versions|list <version>

List all installed Rakudo installations.
The currently active Rakudo installation is marked with a star at the beginning
of the line.

=head1 COMMAND: global

Usage: rakubrew global|switch <version>

Show or set the globally configured Rakudo version.

=head1 COMMAND: switch

Usage: rakubrew global|switch <version>

Show or set the globally configured Rakudo version.

=head1 COMMAND: shell

Usage: rakubrew shell [--unset|<version>]

Show, set or unset the shell version.

=head1 COMMAND: local

Usage: rakubrew local [--unset|<version>]

Show, set or unset the local version.

=head1 COMMAND: nuke

Usage: rakubrew nuke|unregister [<version>]

Removes an installed or registered version. Versions built by rakubrew are
actually deleted, registered versions are only unregistered but not deleted.

=head1 COMMAND: unregister

Usage: rakubrew nuke|unregister [<version>]

Removes an installed or registered version. Versions built by rakubrew are
actually deleted, registered versions are only unregistered but not deleted.

=head1 COMMAND: rehash

Usage: rakubrew rehash

Regenerate all shims. Newly installed scripts will not work unless this is
called. This is only necessary in C<shim> mode.

=head1 COMMAND: available

Usage: rakubrew available|list-available

List all Rakudo versions that can be installed.
Installed versions will be marked with an asterisk at the beginning of the line.
Releases marked with a 'D' have a precompiled archive available and can be
downloaded and installed without compilation with the C<download> subcommand.

=head1 COMMAND: list-available

Usage: rakubrew available|list-available

List all Rakudo versions that can be installed.
Installed versions will be marked with an asterisk at the beginning of the line.
Releases marked with a 'D' have a precompiled archive available and can be
downloaded and installed without compilation with the C<download> subcommand.

=head1 COMMAND: build-rakudo

Usage: rakubrew build[-rakudo] [<backend>] [<tag>|<branch>|<sha-1>] [--configure-opts=<options>]

Download, compile and install a rakudo version.
Please note that this can take a while, be patient.

The arguments are:

=over

=item *

The backend

=over

=item *

C<moar-blead> is the moar and nqp backends at their main branch.

=item *

C<all> will build all backends.

=back

=item *

The version to build. Call C<available> to see a list of available
versions. When left empty the latest release is built.
It is also possible to specify a tag, branch name or commit sha to build.

=item *

Configure options.

=back

=head1 COMMAND: triple

Usage: rakubrew triple [<rakudo-version> [<nqp-version> [<moar-version>]]]

Build a specific set of Rakudo, NQP and MoarVM commits. If you don't specify a
version the latest one will be used.

=head1 COMMAND: register

Usage: rakubrew register <name> <path>

Register an externaly built / installed Rakudo version with rakubrew.

=head1 COMMAND: build-zef

Usage: rakubrew build-zef [<zef-version>]

Install Zef (at the given version) into the current Rakudo version.

=head1 COMMAND: download-rakudo

Usage: rakubrew download[-rakudo] [<backend>] [<rakudo-version>]

Download and install a precompiled release archive.

=head1 COMMAND: exec

Usage: rakubrew exec <executable> [<executable-args>]

Explicitly call an executable. You normally shouldn't need to do this.

=head1 COMMAND: which

Usage: rakubrew which <executable>

Show the full path of the executable.

=head1 COMMAND: whence

Usage: rakubrew whence [--path] <executable>

List all versions that contain the given executable. when C<--path> is given the
path of the executables is given instead.

=head1 COMMAND: mode

Usage: rakubrew mode [env|shim]

Show or set the mode of operation.

=head1 COMMAND: self-upgrade

Usage: rakubrew self-upgrade

Upgrade rakubrew itself.

=head1 COMMAND: init

Usage: rakubrew init

Show installation instructions.

=head1 COMMAND: test

Usage: rakubrew test [<version>|all]

Run Rakudo tests aka C<make test> in the current, given or all installed
versions.

=head1 COMMAND: help

Usage: rakubrew help [--verbose|<command>]

Display an overview of rakubrew commands.
Add a specific command to display instructions for that command.
Print the entire manual with the C<--verbose> flag.

=head1 COMMAND: home

Usage: rakubrew home

Display the currently configured rakubrew home directory.

=head1 COMMAND: rakubrew-version

Usage: rakubrew rakubrew-version

Display the version of this rakubrew installation and some other information
helpful for debugging. Include this information when you report a bug.

=cut
