#!/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{"CPAN/Common/Index.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX';
  use 5.008001;
  use strict;
  use warnings;
  
  package CPAN::Common::Index;
  # ABSTRACT: Common library for searching CPAN modules, authors and distributions
  
  our $VERSION = '0.010';
  
  use Carp ();
  
  use Class::Tiny;
  
  #--------------------------------------------------------------------------#
  # Document abstract methods
  #--------------------------------------------------------------------------#
  
  #pod =method search_packages (ABSTRACT)
  #pod
  #pod     $result = $index->search_packages( { package => "Moose" });
  #pod     @result = $index->search_packages( \%advanced_query );
  #pod
  #pod Searches the index for a package such as listed in the CPAN
  #pod F<02packages.details.txt> file.  The query must be provided as a hash
  #pod reference.  Valid keys are
  #pod
  #pod =for :list
  #pod * package -- a string, regular expression or code reference
  #pod * version -- a version number or code reference
  #pod * dist -- a string, regular expression or code reference
  #pod
  #pod If the query term is a string or version number, the query will be for an exact
  #pod match.  If a code reference, the code will be called with the value of the
  #pod field for each potential match.  It should return true if it matches.
  #pod
  #pod Not all backends will implement support for all fields or all types of queries.
  #pod If it does not implement either, it should "decline" the query with an empty
  #pod return.
  #pod
  #pod The return should be context aware, returning either a
  #pod single result or a list of results.
  #pod
  #pod The result must be formed as follows:
  #pod
  #pod     {
  #pod       package => 'MOOSE',
  #pod       version => '2.0802',
  #pod       uri     => "cpan:///distfile/ETHER/Moose-2.0802.tar.gz"
  #pod     }
  #pod
  #pod The C<uri> field should be a valid URI.  It may be a L<URI::cpan> or any other
  #pod URI.  (It is up to a client to do something useful with any given URI scheme.)
  #pod
  #pod =method search_authors (ABSTRACT)
  #pod
  #pod     $result = $index->search_authors( { id => "DAGOLDEN" });
  #pod     @result = $index->search_authors( \%advanced_query );
  #pod
  #pod Searches the index for author data such as from the CPAN F<01mailrc.txt> file.
  #pod The query must be provided as a hash reference.  Valid keys are
  #pod
  #pod =for :list
  #pod * id -- a string, regular expression or code reference
  #pod * fullname -- a string, regular expression or code reference
  #pod * email -- a string, regular expression or code reference
  #pod
  #pod If the query term is a string, the query will be for an exact match.  If a code
  #pod reference, the code will be called with the value of the field for each
  #pod potential match.  It should return true if it matches.
  #pod
  #pod Not all backends will implement support for all fields or all types of queries.
  #pod If it does not implement either, it should "decline" the query with an empty
  #pod return.
  #pod
  #pod The return should be context aware, returning either a single result or a list
  #pod of results.
  #pod
  #pod The result must be formed as follows:
  #pod
  #pod     {
  #pod         id       => 'DAGOLDEN',
  #pod         fullname => 'David Golden',
  #pod         email    => 'dagolden@cpan.org',
  #pod     }
  #pod
  #pod The C<email> field may not reflect an actual email address.  The 01mailrc file
  #pod on CPAN often shows "CENSORED" when email addresses are concealed.
  #pod
  #pod =cut
  
  #--------------------------------------------------------------------------#
  # stub methods
  #--------------------------------------------------------------------------#
  
  #pod =method index_age
  #pod
  #pod     $epoch = $index->index_age;
  #pod
  #pod Returns the modification time of the index in epoch seconds.  This may not make sense
  #pod for some backends.  By default it returns the current time.
  #pod
  #pod =cut
  
  sub index_age { time }
  
  #pod =method refresh_index
  #pod
  #pod     $index->refresh_index;
  #pod
  #pod This ensures the index source is up to date.  For example, a remote
  #pod mirror file would be re-downloaded.  By default, it does nothing.
  #pod
  #pod =cut
  
  sub refresh_index { 1 }
  
  #pod =method attributes
  #pod
  #pod Return attributes and default values as a hash reference.  By default
  #pod returns an empty hash reference.
  #pod
  #pod =cut
  
  sub attributes { {} }
  
  #pod =method validate_attributes
  #pod
  #pod     $self->validate_attributes;
  #pod
  #pod This is called by the constructor to validate any arguments.  Subclasses
  #pod should override the default one to perform validation.  It should not be
  #pod called by application code.  By default, it does nothing.
  #pod
  #pod =cut
  
  sub validate_attributes { 1 }
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Common::Index - Common library for searching CPAN modules, authors and distributions
  
  =head1 VERSION
  
  version 0.010
  
  =head1 SYNOPSIS
  
      use CPAN::Common::Index::Mux::Ordered;
      use Data::Dumper;
  
      $index = CPAN::Common::Index::Mux::Ordered->assemble(
          MetaDB => {},
          Mirror => { mirror => "http://cpan.cpantesters.org" },
      );
  
      $result = $index->search_packages( { package => "Moose" } );
  
      print Dumper($result);
  
      # {
      #   package => 'MOOSE',
      #   version => '2.0802',
      #   uri     => "cpan:///distfile/ETHER/Moose-2.0802.tar.gz"
      # }
  
  =head1 DESCRIPTION
  
  This module provides a common library for working with a variety of CPAN index
  services.  It is intentionally minimalist, trying to use as few non-core
  modules as possible.
  
  The C<CPAN::Common::Index> module is an abstract base class that defines a
  common API.  Individual backends deliver the API for a particular index.
  
  As shown in the SYNOPSIS, one interesting application is multiplexing -- using
  different index backends, querying each in turn, and returning the first
  result.
  
  =head1 METHODS
  
  =head2 search_packages (ABSTRACT)
  
      $result = $index->search_packages( { package => "Moose" });
      @result = $index->search_packages( \%advanced_query );
  
  Searches the index for a package such as listed in the CPAN
  F<02packages.details.txt> file.  The query must be provided as a hash
  reference.  Valid keys are
  
  =over 4
  
  =item *
  
  package -- a string, regular expression or code reference
  
  =item *
  
  version -- a version number or code reference
  
  =item *
  
  dist -- a string, regular expression or code reference
  
  =back
  
  If the query term is a string or version number, the query will be for an exact
  match.  If a code reference, the code will be called with the value of the
  field for each potential match.  It should return true if it matches.
  
  Not all backends will implement support for all fields or all types of queries.
  If it does not implement either, it should "decline" the query with an empty
  return.
  
  The return should be context aware, returning either a
  single result or a list of results.
  
  The result must be formed as follows:
  
      {
        package => 'MOOSE',
        version => '2.0802',
        uri     => "cpan:///distfile/ETHER/Moose-2.0802.tar.gz"
      }
  
  The C<uri> field should be a valid URI.  It may be a L<URI::cpan> or any other
  URI.  (It is up to a client to do something useful with any given URI scheme.)
  
  =head2 search_authors (ABSTRACT)
  
      $result = $index->search_authors( { id => "DAGOLDEN" });
      @result = $index->search_authors( \%advanced_query );
  
  Searches the index for author data such as from the CPAN F<01mailrc.txt> file.
  The query must be provided as a hash reference.  Valid keys are
  
  =over 4
  
  =item *
  
  id -- a string, regular expression or code reference
  
  =item *
  
  fullname -- a string, regular expression or code reference
  
  =item *
  
  email -- a string, regular expression or code reference
  
  =back
  
  If the query term is a string, the query will be for an exact match.  If a code
  reference, the code will be called with the value of the field for each
  potential match.  It should return true if it matches.
  
  Not all backends will implement support for all fields or all types of queries.
  If it does not implement either, it should "decline" the query with an empty
  return.
  
  The return should be context aware, returning either a single result or a list
  of results.
  
  The result must be formed as follows:
  
      {
          id       => 'DAGOLDEN',
          fullname => 'David Golden',
          email    => 'dagolden@cpan.org',
      }
  
  The C<email> field may not reflect an actual email address.  The 01mailrc file
  on CPAN often shows "CENSORED" when email addresses are concealed.
  
  =head2 index_age
  
      $epoch = $index->index_age;
  
  Returns the modification time of the index in epoch seconds.  This may not make sense
  for some backends.  By default it returns the current time.
  
  =head2 refresh_index
  
      $index->refresh_index;
  
  This ensures the index source is up to date.  For example, a remote
  mirror file would be re-downloaded.  By default, it does nothing.
  
  =head2 attributes
  
  Return attributes and default values as a hash reference.  By default
  returns an empty hash reference.
  
  =head2 validate_attributes
  
      $self->validate_attributes;
  
  This is called by the constructor to validate any arguments.  Subclasses
  should override the default one to perform validation.  It should not be
  called by application code.  By default, it does nothing.
  
  =for Pod::Coverage method_names_here
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<https://github.com/Perl-Toolchain-Gang/CPAN-Common-Index/issues>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/Perl-Toolchain-Gang/CPAN-Common-Index>
  
    git clone https://github.com/Perl-Toolchain-Gang/CPAN-Common-Index.git
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 CONTRIBUTORS
  
  =for stopwords David Golden Helmut Wollmersdorfer Kenichi Ishigaki Shoichi Kaji Tatsuhiko Miyagawa
  
  =over 4
  
  =item *
  
  David Golden <xdg@xdg.me>
  
  =item *
  
  Helmut Wollmersdorfer <helmut@wollmersdorfer.at>
  
  =item *
  
  Kenichi Ishigaki <ishigaki@cpan.org>
  
  =item *
  
  Shoichi Kaji <skaji@cpan.org>
  
  =item *
  
  Tatsuhiko Miyagawa <miyagawa@bulknews.net>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
CPAN_COMMON_INDEX

$fatpacked{"CPAN/Common/Index/LocalPackage.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_LOCALPACKAGE';
  use 5.008001;
  use strict;
  use warnings;
  
  package CPAN::Common::Index::LocalPackage;
  # ABSTRACT: Search index via custom local CPAN package flatfile
  
  our $VERSION = '0.010';
  
  use parent 'CPAN::Common::Index::Mirror';
  
  use Class::Tiny qw/source/;
  
  use Carp;
  use File::Basename ();
  use File::Copy ();
  use File::Spec;
  use File::stat ();
  
  #pod =attr source (REQUIRED)
  #pod
  #pod Path to a local file in the form of 02packages.details.txt.  It may
  #pod be compressed with a ".gz" suffix or it may be uncompressed.
  #pod
  #pod =attr cache
  #pod
  #pod Path to a local directory to store a (possibly uncompressed) copy
  #pod of the source index.  Defaults to a temporary directory if not
  #pod specified.
  #pod
  #pod =cut
  
  sub BUILD {
      my $self = shift;
  
      my $file = $self->source;
      if ( !defined $file ) {
          Carp::croak("'source' parameter must be provided");
      }
      elsif ( !-f $file ) {
          Carp::croak("index file '$file' does not exist");
      }
  
      return;
  }
  
  sub cached_package {
      my ($self) = @_;
      my $package = File::Spec->catfile(
          $self->cache, File::Basename::basename($self->source)
      );
      $package =~ s/\.gz$//;
      $self->refresh_index unless -r $package;
      return $package;
  }
  
  sub refresh_index {
      my ($self) = @_;
      my $source = $self->source;
      my $basename = File::Basename::basename($source);
      if ( $source =~ /\.gz$/ ) {
          Carp::croak "can't load gz source files without IO::Uncompress::Gunzip\n"
            unless $CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP;
          ( my $uncompressed = $basename ) =~ s/\.gz$//;
          $uncompressed = File::Spec->catfile( $self->cache, $uncompressed );
          if ( !-f $uncompressed
                or File::stat::stat($source)->mtime > File::stat::stat($uncompressed)->mtime ) {
              no warnings 'once';
              IO::Uncompress::Gunzip::gunzip( map { "$_" } $source, $uncompressed )
                or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n";
          }
      }
      else {
          my $dest = File::Spec->catfile( $self->cache, $basename );
          File::Copy::copy($source, $dest)
            if !-e $dest || File::stat::stat($source)->mtime > File::stat::stat($dest)->mtime;
      }
      return 1;
  }
  
  sub search_authors { return }; # this package handles packages only
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Common::Index::LocalPackage - Search index via custom local CPAN package flatfile
  
  =head1 VERSION
  
  version 0.010
  
  =head1 SYNOPSIS
  
    use CPAN::Common::Index::LocalPackage;
  
    $index = CPAN::Common::Index::LocalPackage->new(
      { source => "mypackages.details.txt" }
    );
  
  =head1 DESCRIPTION
  
  This module implements a CPAN::Common::Index that searches for packages in a local
  index file in the same form as the CPAN 02packages.details.txt file.
  
  There is no support for searching on authors.
  
  =head1 ATTRIBUTES
  
  =head2 source (REQUIRED)
  
  Path to a local file in the form of 02packages.details.txt.  It may
  be compressed with a ".gz" suffix or it may be uncompressed.
  
  =head2 cache
  
  Path to a local directory to store a (possibly uncompressed) copy
  of the source index.  Defaults to a temporary directory if not
  specified.
  
  =for Pod::Coverage attributes validate_attributes search_packages search_authors
  cached_package BUILD
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
CPAN_COMMON_INDEX_LOCALPACKAGE

$fatpacked{"CPAN/Common/Index/MetaDB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_METADB';
  use 5.008001;
  use strict;
  use warnings;
  
  package CPAN::Common::Index::MetaDB;
  # ABSTRACT: Search index via CPAN MetaDB
  
  our $VERSION = '0.010';
  
  use parent 'CPAN::Common::Index';
  
  use Class::Tiny qw/uri/;
  
  use Carp;
  use CPAN::Meta::YAML;
  use HTTP::Tiny;
  
  #pod =attr uri
  #pod
  #pod A URI for the endpoint of a CPAN MetaDB server. The
  #pod default is L<http://cpanmetadb.plackperl.org/v1.0/>.
  #pod
  #pod =cut
  
  sub BUILD {
      my $self = shift;
      my $uri  = $self->uri;
      $uri = "http://cpanmetadb.plackperl.org/v1.0/"
        unless defined $uri;
      # ensure URI ends in '/'
      $uri =~ s{/?$}{/};
      $self->uri($uri);
      return;
  }
  
  sub search_packages {
      my ( $self, $args ) = @_;
      Carp::croak("Argument to search_packages must be hash reference")
        unless ref $args eq 'HASH';
  
      # only support direct package query
      return
        unless keys %$args == 1 && exists $args->{package} && ref $args->{package} eq '';
  
      my $mod = $args->{package};
      my $res = HTTP::Tiny->new->get( $self->uri . "package/$mod" );
      return unless $res->{success};
  
      if ( my $yaml = CPAN::Meta::YAML->read_string( $res->{content} ) ) {
          my $meta = $yaml->[0];
          if ( $meta && $meta->{distfile} ) {
              my $file = $meta->{distfile};
              $file =~ s{^./../}{}; # strip leading
              return {
                  package => $mod,
                  version => $meta->{version},
                  uri     => "cpan:///distfile/$file",
              };
          }
      }
  
      return;
  }
  
  sub index_age { return time };    # pretend always current
  
  sub search_authors { return };    # not supported
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Common::Index::MetaDB - Search index via CPAN MetaDB
  
  =head1 VERSION
  
  version 0.010
  
  =head1 SYNOPSIS
  
    use CPAN::Common::Index::MetaDB;
  
    $index = CPAN::Common::Index::MetaDB->new;
  
  =head1 DESCRIPTION
  
  This module implements a CPAN::Common::Index that searches for packages against
  the same CPAN MetaDB API used by L<cpanminus>.
  
  There is no support for advanced package queries or searching authors.  It just
  takes a package name and returns the corresponding version and distribution.
  
  =head1 ATTRIBUTES
  
  =head2 uri
  
  A URI for the endpoint of a CPAN MetaDB server. The
  default is L<http://cpanmetadb.plackperl.org/v1.0/>.
  
  =for Pod::Coverage attributes validate_attributes search_packages search_authors BUILD
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
CPAN_COMMON_INDEX_METADB

$fatpacked{"CPAN/Common/Index/Mirror.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_MIRROR';
  use 5.008001;
  use strict;
  use warnings;
  
  package CPAN::Common::Index::Mirror;
  # ABSTRACT: Search index via CPAN mirror flatfiles
  
  our $VERSION = '0.010';
  
  use parent 'CPAN::Common::Index';
  
  use Class::Tiny qw/cache mirror/;
  
  use Carp;
  use CPAN::DistnameInfo;
  use File::Basename ();
  use File::Fetch;
  use File::Temp 0.19; # newdir
  use Search::Dict 1.07;
  use Tie::Handle::SkipHeader;
  use URI;
  
  our $HAS_IO_UNCOMPRESS_GUNZIP = eval { require IO::Uncompress::Gunzip };
  
  #pod =attr mirror
  #pod
  #pod URI to a CPAN mirror.  Defaults to C<http://www.cpan.org/>.
  #pod
  #pod =attr cache
  #pod
  #pod Path to a local directory to store copies of the source indices.  Defaults to a
  #pod temporary directory if not specified.
  #pod
  #pod =cut
  
  sub BUILD {
      my $self = shift;
  
      # cache directory needs to exist
      my $cache = $self->cache;
      $cache = File::Temp->newdir
        unless defined $cache;
      if ( !-d $cache ) {
          Carp::croak("Cache directory '$cache' does not exist");
      }
      $self->cache($cache);
  
      # ensure mirror URL ends in '/'
      my $mirror = $self->mirror;
      $mirror = "http://www.cpan.org/"
        unless defined $mirror;
      $mirror =~ s{/?$}{/};
      $self->mirror($mirror);
  
      return;
  }
  
  my %INDICES = (
      mailrc   => 'authors/01mailrc.txt.gz',
      packages => 'modules/02packages.details.txt.gz',
  );
  
  # XXX refactor out from subs below
  my %TEST_GENERATORS = (
      regexp_nocase => sub {
          my $arg = shift;
          my $re = ref $arg eq 'Regexp' ? $arg : qr/\A\Q$arg\E\z/i;
          return sub { $_[0] =~ $re };
      },
      regexp => sub {
          my $arg = shift;
          my $re = ref $arg eq 'Regexp' ? $arg : qr/\A\Q$arg\E\z/;
          return sub { $_[0] =~ $re };
      },
      version => sub {
          my $arg = shift;
          my $v   = version->parse($arg);
          return sub {
              eval { version->parse( $_[0] ) == $v };
          };
      },
  );
  
  my %QUERY_TYPES = (
      # package search
      package => 'regexp',
      version => 'version',
      dist    => 'regexp',
  
      # author search
      id       => 'regexp_nocase', # XXX need to add "alias " first
      fullname => 'regexp_nocase',
      email    => 'regexp_nocase',
  );
  
  sub cached_package {
      my ($self) = @_;
      my $package = File::Spec->catfile( $self->cache,
          File::Basename::basename( $INDICES{packages} ) );
      $package =~ s/\.gz$//;
      $self->refresh_index unless -r $package;
      return $package;
  }
  
  sub cached_mailrc {
      my ($self) = @_;
      my $mailrc =
        File::Spec->catfile( $self->cache, File::Basename::basename( $INDICES{mailrc} ) );
      $mailrc =~ s/\.gz$//;
      $self->refresh_index unless -r $mailrc;
      return $mailrc;
  }
  
  sub refresh_index {
      my ($self) = @_;
      for my $file ( values %INDICES ) {
          my $remote = URI->new_abs( $file, $self->mirror );
          $remote =~ s/\.gz$//
            unless $HAS_IO_UNCOMPRESS_GUNZIP;
          my $ff = File::Fetch->new( uri => $remote );
          my $where = $ff->fetch( to => $self->cache )
            or Carp::croak( $ff->error );
          if ($HAS_IO_UNCOMPRESS_GUNZIP) {
              ( my $uncompressed = $where ) =~ s/\.gz$//;
              no warnings 'once';
              IO::Uncompress::Gunzip::gunzip( $where, $uncompressed )
                or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n";
          }
      }
      return 1;
  }
  
  # epoch secs
  sub index_age {
      my ($self) = @_;
      my $package = $self->cached_package;
      return ( -r $package ? ( stat($package) )[9] : 0 ); # mtime if readable
  }
  
  sub search_packages {
      my ( $self, $args ) = @_;
      Carp::croak("Argument to search_packages must be hash reference")
        unless ref $args eq 'HASH';
  
      my $index_path = $self->cached_package;
      die "Can't read $index_path" unless -r $index_path;
  
      my $fh = IO::Handle->new;
      tie *$fh, 'Tie::Handle::SkipHeader', "<", $index_path
        or die "Can't tie $index_path: $!";
  
      # Convert scalars or regexps to subs
      my $rules;
      while ( my ( $k, $v ) = each %$args ) {
          $rules->{$k} = _rulify( $k, $v );
      }
  
      my @found;
      if ( $args->{package} and ref $args->{package} eq '' ) {
          # binary search 02packages on package
          my $pos = look $fh, $args->{package}, { xfrm => \&_xform_package, fold => 1 };
          return if $pos == -1;
          # loop over any case-insensitive matching lines
          LINE: while ( my $line = <$fh> ) {
              last unless $line =~ /\A\Q$args->{package}\E\s+/i;
              push @found, _match_package_line( $line, $rules );
          }
      }
      else {
          # iterate all lines looking for match
          LINE: while ( my $line = <$fh> ) {
              push @found, _match_package_line( $line, $rules );
          }
      }
      return wantarray ? @found : $found[0];
  }
  
  sub search_authors {
      my ( $self, $args ) = @_;
      Carp::croak("Argument to search_authors must be hash reference")
        unless ref $args eq 'HASH';
  
      my $index_path = $self->cached_mailrc;
      die "Can't read $index_path" unless -r $index_path;
      open my $fh, $index_path or die "Can't open $index_path: $!";
  
      # Convert scalars or regexps to subs
      my $rules;
      while ( my ( $k, $v ) = each %$args ) {
          $rules->{$k} = _rulify( $k, $v );
      }
  
      my @found;
      if ( $args->{id} and ref $args->{id} eq '' ) {
          # binary search mailrec on package
          my $pos = look $fh, $args->{id}, { xfrm => \&_xform_mailrc, fold => 1 };
          return if $pos == -1;
          my $line = <$fh>;
          push @found, _match_mailrc_line( $line, $rules );
      }
      else {
          # iterate all lines looking for match
          LINE: while ( my $line = <$fh> ) {
              push @found, _match_mailrc_line( $line, $rules );
          }
      }
      return wantarray ? @found : $found[0];
  }
  
  sub _rulify {
      my ( $key, $arg ) = @_;
      return $arg if ref($arg) eq 'CODE';
      return $TEST_GENERATORS{ $QUERY_TYPES{$key} }->($arg);
  }
  
  sub _xform_package {
      my @fields = split " ", $_[0], 2;
      return $fields[0];
  }
  
  sub _xform_mailrc {
      my @fields = split " ", $_[0], 3;
      return $fields[1];
  }
  
  sub _match_package_line {
      my ( $line, $rules ) = @_;
      return unless defined $line;
      my ( $mod, $version, $dist, $comment ) = split " ", $line, 4;
      if ( $rules->{package} ) {
          return unless $rules->{package}->($mod);
      }
      if ( $rules->{version} ) {
          return unless $rules->{version}->($version);
      }
      if ( $rules->{dist} ) {
          return unless $rules->{dist}->($dist);
      }
      $dist =~ s{\A./../}{};
      return {
          package => $mod,
          version => $version,
          uri     => "cpan:///distfile/$dist",
      };
  }
  
  sub _match_mailrc_line {
      my ( $line, $rules ) = @_;
      return unless defined $line;
      my ( $id,       $address ) = $line =~ m{\Aalias\s+(\S+)\s+"(.*)"};
      my ( $fullname, $email )   = $address =~ m{([^<]+)<([^>]+)>};
      $fullname =~ s/\s*$//;
      if ( $rules->{id} ) {
          return unless $rules->{id}->($id);
      }
      if ( $rules->{fullname} ) {
          return unless $rules->{fullname}->($fullname);
      }
      if ( $rules->{email} ) {
          return unless $rules->{email}->($email);
      }
      return {
          id       => $id,
          fullname => $fullname,
          email    => $email,
      };
  }
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Common::Index::Mirror - Search index via CPAN mirror flatfiles
  
  =head1 VERSION
  
  version 0.010
  
  =head1 SYNOPSIS
  
    use CPAN::Common::Index::Mirror;
  
    # default mirror is http://www.cpan.org/
    $index = CPAN::Common::Index::Mirror->new;
  
    # custom mirror
    $index = CPAN::Common::Index::Mirror->new(
      { mirror => "http://cpan.cpantesters.org" }
    );
  
  =head1 DESCRIPTION
  
  This module implements a CPAN::Common::Index that retrieves and searches
  02packages.details.txt and 01mailrc.txt indices.
  
  The default mirror is L<http://www.cpan.org/>.  This is a globally balanced
  fast mirror and is a great choice if you don't have a local fast mirror.
  
  =head1 ATTRIBUTES
  
  =head2 mirror
  
  URI to a CPAN mirror.  Defaults to C<http://www.cpan.org/>.
  
  =head2 cache
  
  Path to a local directory to store copies of the source indices.  Defaults to a
  temporary directory if not specified.
  
  =for Pod::Coverage attributes validate_attributes search_packages search_authors
  cached_package cached_mailrc BUILD
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
CPAN_COMMON_INDEX_MIRROR

$fatpacked{"CPAN/Common/Index/Mux/Ordered.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_MUX_ORDERED';
  use 5.008001;
  use strict;
  use warnings;
  
  package CPAN::Common::Index::Mux::Ordered;
  # ABSTRACT: Consult indices in order and return the first result
  
  our $VERSION = '0.010';
  
  use parent 'CPAN::Common::Index';
  
  use Class::Tiny qw/resolvers/;
  
  use Module::Load ();
  
  #pod =attr resolvers
  #pod
  #pod     An array reference of CPAN::Common::Index::* objects
  #pod
  #pod =cut
  
  sub BUILD {
      my $self = shift;
  
      my $resolvers = $self->resolvers;
      $resolvers = [] unless defined $resolvers;
      if ( ref $resolvers ne 'ARRAY' ) {
          Carp::croak("The 'resolvers' argument must be an array reference");
      }
      for my $r (@$resolvers) {
          if ( !eval { $r->isa("CPAN::Common::Index") } ) {
              Carp::croak("Resolver '$r' is not a CPAN::Common::Index object");
          }
      }
      $self->resolvers($resolvers);
  
      return;
  }
  
  #pod =method assemble
  #pod
  #pod     $index = CPAN::Common::Index::Mux::Ordered->assemble(
  #pod         MetaDB => {},
  #pod         Mirror => { mirror => "http://www.cpan.org" },
  #pod     );
  #pod
  #pod This class method provides a shorthand for constructing a multiplexer.
  #pod The arguments must be pairs of subclass suffixes and arguments.  For
  #pod example, "MetaDB" means to use "CPAN::Common::Index::MetaDB".  Empty
  #pod arguments must be given as an empty hash reference.
  #pod
  #pod =cut
  
  sub assemble {
      my ( $class, @backends ) = @_;
  
      my @resolvers;
  
      while (@backends) {
          my ( $subclass, $config ) = splice @backends, 0, 2;
          my $full_class = "CPAN::Common::Index::${subclass}";
          eval { Module::Load::load($full_class); 1 }
            or Carp::croak($@);
          my $object = $full_class->new($config);
          push @resolvers, $object;
      }
  
      return $class->new( { resolvers => \@resolvers } );
  }
  
  sub validate_attributes {
      my ($self) = @_;
      my $resolvers = $self->resolvers;
      return 1;
  }
  
  # have to think carefully about the sematics of regex search when indices
  # are stacked; only one result for any given package (or package/version)
  sub search_packages {
      my ( $self, $args ) = @_;
      Carp::croak("Argument to search_packages must be hash reference")
        unless ref $args eq 'HASH';
      my @found;
      if ( $args->{name} and ref $args->{name} eq '' ) {
          # looking for exact match, so we just want the first hit
          for my $source ( @{ $self->resolvers } ) {
              if ( my @result = $source->search_packages($args) ) {
                  # XXX double check against remaining $args
                  push @found, @result;
                  last;
              }
          }
      }
      else {
          # accumulate results from all resolvers
          my %seen;
          for my $source ( @{ $self->resolvers } ) {
              my @result = $source->search_packages($args);
              push @found, grep { !$seen{ $_->{package} }++ } @result;
          }
      }
      return wantarray ? @found : $found[0];
  }
  
  # have to think carefully about the sematics of regex search when indices
  # are stacked; only one result for any given package (or package/version)
  sub search_authors {
      my ( $self, $args ) = @_;
      Carp::croak("Argument to search_authors must be hash reference")
        unless ref $args eq 'HASH';
      my @found;
      if ( $args->{name} and ref $args->{name} eq '' ) {
          # looking for exact match, so we just want the first hit
          for my $source ( @{ $self->resolvers } ) {
              if ( my @result = $source->search_authors($args) ) {
                  # XXX double check against remaining $args
                  push @found, @result;
                  last;
              }
          }
      }
      else {
          # accumulate results from all resolvers
          my %seen;
          for my $source ( @{ $self->resolvers } ) {
              my @result = $source->search_authors($args);
              push @found, grep { !$seen{ $_->{package} }++ } @result;
          }
      }
      return wantarray ? @found : $found[0];
  }
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Common::Index::Mux::Ordered - Consult indices in order and return the first result
  
  =head1 VERSION
  
  version 0.010
  
  =head1 SYNOPSIS
  
      use CPAN::Common::Index::Mux::Ordered;
      use Data::Dumper;
  
      $index = CPAN::Common::Index::Mux::Ordered->assemble(
          MetaDB => {},
          Mirror => { mirror => "http://cpan.cpantesters.org" },
      );
  
  =head1 DESCRIPTION
  
  This module multiplexes multiple CPAN::Common::Index objects, returning
  results in order.
  
  For exact match queries, the first result is returned. For search queries,
  results from each index object are concatenated.
  
  =head1 ATTRIBUTES
  
  =head2 resolvers
  
      An array reference of CPAN::Common::Index::* objects
  
  =head1 METHODS
  
  =head2 assemble
  
      $index = CPAN::Common::Index::Mux::Ordered->assemble(
          MetaDB => {},
          Mirror => { mirror => "http://www.cpan.org" },
      );
  
  This class method provides a shorthand for constructing a multiplexer.
  The arguments must be pairs of subclass suffixes and arguments.  For
  example, "MetaDB" means to use "CPAN::Common::Index::MetaDB".  Empty
  arguments must be given as an empty hash reference.
  
  =for Pod::Coverage attributes validate_attributes search_packages search_authors BUILD
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
CPAN_COMMON_INDEX_MUX_ORDERED

$fatpacked{"CPAN/DistnameInfo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_DISTNAMEINFO';
  
  package CPAN::DistnameInfo;
  
  $VERSION = "0.12";
  use strict;
  
  sub distname_info {
    my $file = shift or return;
  
    my ($dist, $version) = $file =~ /^
      ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
       (?:
  	[A-Za-z](?=[^A-Za-z]|$)
  	|
  	\d(?=-)
       )(?<![._-][vV])
      )+)(.*)
    $/xs or return ($file,undef,undef);
  
    if ($dist =~ /-undef\z/ and ! length $version) {
      $dist =~ s/-undef\z//;
    }
  
    # Remove potential -withoutworldwriteables suffix
    $version =~ s/-withoutworldwriteables$//;
  
    if ($version =~ /^(-[Vv].*)-(\d.*)/) {
     
      # Catch names like Unicode-Collate-Standard-V3_1_1-0.1
      # where the V3_1_1 is part of the distname
      $dist .= $1;
      $version = $2;
    }
  
    if ($version =~ /(.+_.*)-(\d.*)/) {
        # Catch names like Task-Deprecations5_14-1.00.tar.gz where the 5_14 is
        # part of the distname. However, names like libao-perl_0.03-1.tar.gz
        # should still have 0.03-1 as their version.
        $dist .= $1;
        $version = $2;
    }
  
    # Normalize the Dist.pm-1.23 convention which CGI.pm and
    # a few others use.
    $dist =~ s{\.pm$}{};
  
    $version = $1
      if !length $version and $dist =~ s/-(\d+\w)$//;
  
    $version = $1 . $version
      if $version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;
  
    if ($version =~ /\d\.\d/) {
      $version =~ s/^[-_.]+//;
    }
    else {
      $version =~ s/^[-_]+//;
    }
  
    my $dev;
    if (length $version) {
      if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/) {
        $dev = 1 if (($1 > 6 and $1 & 1) or ($2 and $2 >= 50)) or $3;
      }
      elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/) {
        $dev = 1;
      }
    }
    else {
      $version = undef;
    }
  
    ($dist, $version, $dev);
  }
  
  sub new {
    my $class = shift;
    my $distfile = shift;
  
    $distfile =~ s,//+,/,g;
  
    my %info = ( pathname => $distfile );
  
    ($info{filename} = $distfile) =~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,,
      and $info{cpanid} = $6;
  
    if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i) { # support more ?
      $info{distvname} = $1;
      $info{extension} = $2;
    }
  
    @info{qw(dist version beta)} = distname_info($info{distvname});
    $info{maturity} = delete $info{beta} ? 'developer' : 'released';
  
    return bless \%info, $class;
  }
  
  sub dist      { shift->{dist} }
  sub version   { shift->{version} }
  sub maturity  { shift->{maturity} }
  sub filename  { shift->{filename} }
  sub cpanid    { shift->{cpanid} }
  sub distvname { shift->{distvname} }
  sub extension { shift->{extension} }
  sub pathname  { shift->{pathname} }
  
  sub properties { %{ $_[0] } }
  
  1;
  
  __END__
  
  =head1 NAME
  
  CPAN::DistnameInfo - Extract distribution name and version from a distribution filename
  
  =head1 SYNOPSIS
  
    my $pathname = "authors/id/G/GB/GBARR/CPAN-DistnameInfo-0.02.tar.gz";
  
    my $d = CPAN::DistnameInfo->new($pathname);
  
    my $dist      = $d->dist;      # "CPAN-DistnameInfo"
    my $version   = $d->version;   # "0.02"
    my $maturity  = $d->maturity;  # "released"
    my $filename  = $d->filename;  # "CPAN-DistnameInfo-0.02.tar.gz"
    my $cpanid    = $d->cpanid;    # "GBARR"
    my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02"
    my $extension = $d->extension; # "tar.gz"
    my $pathname  = $d->pathname;  # "authors/id/G/GB/GBARR/..."
  
    my %prop = $d->properties;
  
  =head1 DESCRIPTION
  
  Many online services that are centered around CPAN attempt to
  associate multiple uploads by extracting a distribution name from
  the filename of the upload. For most distributions this is easy as
  they have used ExtUtils::MakeMaker or Module::Build to create the
  distribution, which results in a uniform name. But sadly not all
  uploads are created in this way.
  
  C<CPAN::DistnameInfo> uses heuristics that have been learnt by
  L<http://search.cpan.org/> to extract the distribution name and
  version from filenames and also report if the version is to be
  treated as a developer release
  
  The constructor takes a single pathname, returning an object with the following methods
  
  =over
  
  =item cpanid
  
  If the path given looked like a CPAN authors directory path, then this will be the
  the CPAN id of the author.
  
  =item dist
  
  The name of the distribution
  
  =item distvname
  
  The file name with any suffix and leading directory names removed
  
  =item filename
  
  If the path given looked like a CPAN authors directory path, then this will be the
  path to the file relative to the detected CPAN author directory. Otherwise it is the path
  that was passed in.
  
  =item maturity
  
  The maturity of the distribution. This will be either C<released> or C<developer>
  
  =item extension
  
  The extension of the distribution, often used to denote the archive type (e.g. 'tar.gz')
  
  =item pathname
  
  The pathname that was passed to the constructor when creating the object.
  
  =item properties
  
  This will return a list of key-value pairs, suitable for assigning to a hash,
  for the known properties.
  
  =item version
  
  The extracted version
  
  =back
  
  =head1 AUTHOR
  
  Graham Barr <gbarr@pobox.com>
  
  =head1 COPYRIGHT 
  
  Copyright (c) 2003 Graham Barr. All rights reserved. This program is
  free software; you can redistribute it and/or modify it under the same
  terms as Perl itself.
  
  =cut
  
CPAN_DISTNAMEINFO

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

$fatpacked{"CPAN/Meta/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CHECK';
  package CPAN::Meta::Check;
  $CPAN::Meta::Check::VERSION = '0.014';
  use strict;
  use warnings;
  
  use base 'Exporter';
  our @EXPORT = qw//;
  our @EXPORT_OK = qw/check_requirements requirements_for verify_dependencies/;
  our %EXPORT_TAGS = (all => [ @EXPORT, @EXPORT_OK ] );
  
  use CPAN::Meta::Prereqs '2.132830';
  use CPAN::Meta::Requirements 2.121;
  use Module::Metadata 1.000023;
  
  sub _check_dep {
  	my ($reqs, $module, $dirs) = @_;
  
  	$module eq 'perl' and return ($reqs->accepts_module($module, $]) ? () : sprintf "Your Perl (%s) is not in the range '%s'", $], $reqs->requirements_for_module($module));
  
  	my $metadata = Module::Metadata->new_from_module($module, inc => $dirs);
  	return "Module '$module' is not installed" if not defined $metadata;
  
  	my $version = eval { $metadata->version };
  	return sprintf 'Installed version (%s) of %s is not in range \'%s\'',
  			(defined $version ? $version : 'undef'), $module, $reqs->requirements_for_module($module)
  		if not $reqs->accepts_module($module, $version || 0);
  	return;
  }
  
  sub _check_conflict {
  	my ($reqs, $module, $dirs) = @_;
  	my $metadata = Module::Metadata->new_from_module($module, inc => $dirs);
  	return if not defined $metadata;
  
  	my $version = eval { $metadata->version };
  	return sprintf 'Installed version (%s) of %s is in range \'%s\'',
  			(defined $version ? $version : 'undef'), $module, $reqs->requirements_for_module($module)
  		if $reqs->accepts_module($module, $version);
  	return;
  }
  
  sub requirements_for {
  	my ($meta, $phases, $type) = @_;
  	my $prereqs = ref($meta) eq 'CPAN::Meta' ? $meta->effective_prereqs : $meta;
  	return $prereqs->merged_requirements(ref($phases) ? $phases : [ $phases ], [ $type ]);
  }
  
  sub check_requirements {
  	my ($reqs, $type, $dirs) = @_;
  
  	return +{
  		map {
  			$_ => $type ne 'conflicts'
  				? scalar _check_dep($reqs, $_, $dirs)
  				: scalar _check_conflict($reqs, $_, $dirs)
  		} $reqs->required_modules
  	};
  }
  
  sub verify_dependencies {
  	my ($meta, $phases, $type, $dirs) = @_;
  	my $reqs = requirements_for($meta, $phases, $type);
  	my $issues = check_requirements($reqs, $type, $dirs);
  	return grep { defined } values %{ $issues };
  }
  
  1;
  
  #ABSTRACT: Verify requirements in a CPAN::Meta object
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::Check - Verify requirements in a CPAN::Meta object
  
  =head1 VERSION
  
  version 0.014
  
  =head1 SYNOPSIS
  
   warn "$_\n" for verify_dependencies($meta, [qw/runtime build test/], 'requires');
  
  =head1 DESCRIPTION
  
  This module verifies if requirements described in a CPAN::Meta object are present.
  
  =head1 FUNCTIONS
  
  =head2 check_requirements($reqs, $type, $incdirs)
  
  This function checks if all dependencies in C<$reqs> (a L<CPAN::Meta::Requirements|CPAN::Meta::Requirements> object) are met, taking into account that 'conflicts' dependencies have to be checked in reverse. It returns a hash with the modules as keys and any problems as values; the value for a successfully found module will be undef. Modules are searched for in C<@$incdirs>, defaulting to C<@INC>.
  
  =head2 verify_dependencies($meta, $phases, $types, $incdirs)
  
  Check all requirements in C<$meta> for phases C<$phases> and type C<$type>. Modules are searched for in C<@$incdirs>, defaulting to C<@INC>. C<$meta> should be a L<CPAN::Meta::Prereqs> or L<CPAN::Meta> object.
  
  =head2 requirements_for($meta, $phases, $types)
  
  B<< This function is deprecated and may be removed at some point in the future, please use CPAN::Meta::Prereqs->merged_requirements instead. >>
  
  This function returns a unified L<CPAN::Meta::Requirements|CPAN::Meta::Requirements> object for all C<$type> requirements for C<$phases>. C<$phases> may be either one (scalar) value or an arrayref of valid values as defined by the L<CPAN::Meta spec|CPAN::Meta::Spec>. C<$type> must be a relationship as defined by the same spec. C<$meta> should be a L<CPAN::Meta::Prereqs> or L<CPAN::Meta> object.
  
  =head1 SEE ALSO
  
  =over 4
  
  =item * L<Test::CheckDeps|Test::CheckDeps>
  
  =item * L<CPAN::Meta|CPAN::Meta>
  
  =for comment # vi:noet:sts=2:sw=2:ts=2
  
  =back
  
  =head1 AUTHOR
  
  Leon Timmermans <leont@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2012 by Leon Timmermans.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_CHECK

$fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Converter;
  # VERSION
  $CPAN::Meta::Converter::VERSION = '2.143240';
  #pod =head1 SYNOPSIS
  #pod
  #pod   my $struct = decode_json_file('META.json');
  #pod
  #pod   my $cmc = CPAN::Meta::Converter->new( $struct );
  #pod
  #pod   my $new_struct = $cmc->convert( version => "2" );
  #pod
  #pod =head1 DESCRIPTION
  #pod
  #pod This module converts CPAN Meta structures from one form to another.  The
  #pod primary use is to convert older structures to the most modern version of
  #pod the specification, but other transformations may be implemented in the
  #pod future as needed.  (E.g. stripping all custom fields or stripping all
  #pod optional fields.)
  #pod
  #pod =cut
  
  use CPAN::Meta::Validator;
  use CPAN::Meta::Requirements;
  use Parse::CPAN::Meta 1.4400 ();
  
  # 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 ()"; ## no critic
    if ( my $err = $@ ) {
      eval "use ExtUtils::MakeMaker::version" or die $err; ## 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} };
  
  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';
    no warnings 'redefine';
    local *UNIVERSAL::TO_JSON = sub { "$_[0]" };
  
    my $json = Parse::CPAN::Meta->json_backend()->new
        ->utf8
        ->allow_blessed
        ->convert_blessed;
    $json->decode($json->encode($ref))
  }
  
  my %known_specs = (
      '2'   => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
      '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
      '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
      '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
      '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
      '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
  );
  
  my @spec_list = sort { $a <=> $b } keys %known_specs;
  my ($LOWEST, $HIGHEST) = @spec_list[0,-1];
  
  #--------------------------------------------------------------------------#
  # converters
  #
  # called as $converter->($element, $field_name, $full_meta, $to_version)
  #
  # defined return value used for field
  # undef return value means field is skipped
  #--------------------------------------------------------------------------#
  
  sub _keep { $_[0] }
  
  sub _keep_or_one { defined($_[0]) ? $_[0] : 1 }
  
  sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 }
  
  sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" }
  
  sub _generated_by {
    my $gen = shift;
    my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>");
  
    return $sig unless defined $gen and length $gen;
    return $gen if $gen =~ /\Q$sig/;
    return "$gen, $sig";
  }
  
  sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] }
  
  sub _prefix_custom {
    my $key = shift;
    $key =~ s/^(?!x_)   # Unless it already starts with x_
               (?:x-?)? # Remove leading x- or x (if present)
             /x_/ix;    # and prepend x_
    return $key;
  }
  
  sub _ucfirst_custom {
    my $key = shift;
    $key = ucfirst $key unless $key =~ /[A-Z]/;
    return $key;
  }
  
  sub _no_prefix_ucfirst_custom {
    my $key = shift;
    $key =~ s/^x_//;
    return _ucfirst_custom($key);
  }
  
  sub _change_meta_spec {
    my ($element, undef, undef, $version) = @_;
    return {
      version => $version,
      url => $known_specs{$version},
    };
  }
  
  my @open_source = (
    'perl',
    'gpl',
    'apache',
    'artistic',
    'artistic_2',
    'lgpl',
    'bsd',
    'gpl',
    'mit',
    'mozilla',
    'open_source',
  );
  
  my %is_open_source = map {; $_ => 1 } @open_source;
  
  my @valid_licenses_1 = (
    @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};
    }
    else {
      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) {
        if (grep { !$is_open_source{ $license_downgrade_map{lc $_} || 'unknown' } } @$element) {
          return 'unknown';
        }
        else {
          return 'open_source';
        }
      }
      elsif ( @$element == 1 ) {
        return $license_downgrade_map{lc $element->[0]} || "unknown";
      }
    }
    elsif ( ! ref $element ) {
      return $license_downgrade_map{lc $element} || "unknown";
    }
    return "unknown";
  }
  
  my $no_index_spec_1_2 = {
    'file' => \&_listify,
    'dir' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_1_3 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_2 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _no_index_1_2 {
    my (undef, undef, $meta) = @_;
    my $no_index = $meta->{no_index} || $meta->{private};
    return unless $no_index;
  
    # cleanup wrong format
    if ( ! ref $no_index ) {
      my $item = $no_index;
      $no_index = { dir => [ $item ], file => [ $item ] };
    }
    elsif ( ref $no_index eq 'ARRAY' ) {
      my $list = $no_index;
      $no_index = { dir => [ @$list ], file => [ @$list ] };
    }
  
    # common mistake: files -> file
    if ( exists $no_index->{files} ) {
      $no_index->{file} = delete $no_index->{file};
    }
    # common mistake: modules -> module
    if ( exists $no_index->{modules} ) {
      $no_index->{module} = delete $no_index->{module};
    }
    return _convert($no_index, $no_index_spec_1_2);
  }
  
  sub _no_index_directory {
    my ($element, $key, $meta, $version) = @_;
    return unless $element;
  
    # cleanup wrong format
    if ( ! ref $element ) {
      my $item = $element;
      $element = { directory => [ $item ], file => [ $item ] };
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $list = $element;
      $element = { directory => [ @$list ], file => [ @$list ] };
    }
  
    if ( exists $element->{dir} ) {
      $element->{directory} = delete $element->{dir};
    }
    # common mistake: files -> file
    if ( exists $element->{files} ) {
      $element->{file} = delete $element->{file};
    }
    # common mistake: modules -> module
    if ( exists $element->{modules} ) {
      $element->{module} = delete $element->{module};
    }
    my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3;
    return _convert($element, $spec);
  }
  
  sub _is_module_name {
    my $mod = shift;
    return unless defined $mod && length $mod;
    return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$};
  }
  
  sub _clean_version {
    my ($element) = @_;
    return 0 if ! defined $element;
  
    $element =~ s{^\s*}{};
    $element =~ s{\s*$}{};
    $element =~ s{^\.}{0.};
  
    return 0 if ! length $element;
    return 0 if ( $element eq 'undef' || $element eq '<undef>' );
  
    my $v = eval { version->new($element) };
    # XXX check defined $v and not just $v because version objects leak memory
    # in boolean context -- dagolden, 2012-02-03
    if ( defined $v ) {
      return _is_qv($v) ? $v->normal : $element;
    }
    else {
      return 0;
    }
  }
  
  sub _bad_version_hook {
    my ($v) = @_;
    $v =~ s{[a-z]+$}{}; # strip trailing alphabetics
    my $vobj = eval { version->new($v) };
    return defined($vobj) ? $vobj : version->new(0); # or give up
  }
  
  sub _version_map {
    my ($element) = @_;
    return unless defined $element;
    if ( ref $element eq 'HASH' ) {
      # XXX turn this into CPAN::Meta::Requirements with bad version hook
      # and then turn it back into a hash
      my $new_map = CPAN::Meta::Requirements->new(
        { bad_version_hook => \&_bad_version_hook } # punt
      );
      while ( my ($k,$v) = each %$element ) {
        next unless _is_module_name($k);
        if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>'  ) {
          $v = 0;
        }
        # some weird, old META have bad yml with module => module
        # so check if value is like a module name and not like a version
        if ( _is_module_name($v) && ! version::is_lax($v) ) {
          $new_map->add_minimum($k => 0);
          $new_map->add_minimum($v => 0);
        }
        $new_map->add_string_requirement($k => $v);
      }
      return $new_map->as_string_hash;
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $hashref = { map { $_ => 0 } @$element };
      return _version_map($hashref); # cleanup any weird stuff
    }
    elsif ( ref $element eq '' && length $element ) {
      return { $element => 0 }
    }
    return;
  }
  
  sub _prereqs_from_1 {
    my (undef, undef, $meta) = @_;
    my $prereqs = {};
    for my $phase ( qw/build configure/ ) {
      my $key = "${phase}_requires";
      $prereqs->{$phase}{requires} = _version_map($meta->{$key})
        if $meta->{$key};
    }
    for my $rel ( qw/requires recommends conflicts/ ) {
      $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
        if $meta->{$rel};
    }
    return $prereqs;
  }
  
  my $prereqs_spec = {
    configure => \&_prereqs_rel,
    build     => \&_prereqs_rel,
    test      => \&_prereqs_rel,
    runtime   => \&_prereqs_rel,
    develop   => \&_prereqs_rel,
    ':custom'  => \&_prefix_custom,
  };
  
  my $relation_spec = {
    requires   => \&_version_map,
    recommends => \&_version_map,
    suggests   => \&_version_map,
    conflicts  => \&_version_map,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _cleanup_prereqs {
    my ($prereqs, $key, $meta, $to_version) = @_;
    return unless $prereqs && ref $prereqs eq 'HASH';
    return _convert( $prereqs, $prereqs_spec, $to_version );
  }
  
  sub _prereqs_rel {
    my ($relation, $key, $meta, $to_version) = @_;
    return unless $relation && ref $relation eq 'HASH';
    return _convert( $relation, $relation_spec, $to_version );
  }
  
  
  BEGIN {
    my @old_prereqs = qw(
      requires
      configure_requires
      recommends
      conflicts
    );
  
    for ( @old_prereqs ) {
      my $sub = "_get_$_";
      my ($phase,$type) = split qr/_/, $_;
      if ( ! defined $type ) {
        $type = $phase;
        $phase = 'runtime';
      }
      no strict 'refs';
      *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
    }
  }
  
  sub _get_build_requires {
    my ($data, $key, $meta) = @_;
  
    my $test_h  = _extract_prereqs($_[2]->{prereqs}, qw(test  requires)) || {};
    my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
  
    my $test_req  = CPAN::Meta::Requirements->from_string_hash($test_h);
    my $build_req = CPAN::Meta::Requirements->from_string_hash($build_h);
  
    $test_req->add_requirements($build_req)->as_string_hash;
  }
  
  sub _extract_prereqs {
    my ($prereqs, $phase, $type) = @_;
    return unless ref $prereqs eq 'HASH';
    return scalar _version_map($prereqs->{$phase}{$type});
  }
  
  sub _downgrade_optional_features {
    my (undef, undef, $meta) = @_;
    return unless exists $meta->{optional_features};
    my $origin = $meta->{optional_features};
    my $features = {};
    for my $name ( keys %$origin ) {
      $features->{$name} = {
        description => $origin->{$name}{description},
        requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),
        configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),
        build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),
        recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),
        conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),
      };
      for my $k (keys %{$features->{$name}} ) {
        delete $features->{$name}{$k} unless defined $features->{$name}{$k};
      }
    }
    return $features;
  }
  
  sub _upgrade_optional_features {
    my (undef, undef, $meta) = @_;
    return unless exists $meta->{optional_features};
    my $origin = $meta->{optional_features};
    my $features = {};
    for my $name ( keys %$origin ) {
      $features->{$name} = {
        description => $origin->{$name}{description},
        prereqs => _prereqs_from_1(undef, undef, $origin->{$name}),
      };
      delete $features->{$name}{prereqs}{configure};
    }
    return $features;
  }
  
  my $optional_features_2_spec = {
    description => \&_keep,
    prereqs => \&_cleanup_prereqs,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _feature_2 {
    my ($element, $key, $meta, $to_version) = @_;
    return unless $element && ref $element eq 'HASH';
    _convert( $element, $optional_features_2_spec, $to_version );
  }
  
  sub _cleanup_optional_features_2 {
    my ($element, $key, $meta, $to_version) = @_;
    return unless $element && ref $element eq 'HASH';
    my $new_data = {};
    for my $k ( keys %$element ) {
      $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version );
    }
    return unless keys %$new_data;
    return $new_data;
  }
  
  sub _optional_features_1_4 {
    my ($element) = @_;
    return unless $element;
    $element = _optional_features_as_map($element);
    for my $name ( keys %$element ) {
      for my $drop ( qw/requires_packages requires_os excluded_os/ ) {
        delete $element->{$name}{$drop};
      }
    }
    return $element;
  }
  
  sub _optional_features_as_map {
    my ($element) = @_;
    return unless $element;
    if ( ref $element eq 'ARRAY' ) {
      my %map;
      for my $feature ( @$element ) {
        my (@parts) = %$feature;
        $map{$parts[0]} = $parts[1];
      }
      $element = \%map;
    }
    return $element;
  }
  
  sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
  
  sub _url_or_drop {
    my ($element) = @_;
    return $element if _is_urlish($element);
    return;
  }
  
  sub _url_list {
    my ($element) = @_;
    return unless $element;
    $element = _listify( $element );
    $element = [ grep { _is_urlish($_) } @$element ];
    return unless @$element;
    return $element;
  }
  
  sub _author_list {
    my ($element) = @_;
    return [ 'unknown' ] unless $element;
    $element = _listify( $element );
    $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ];
    return [ 'unknown' ] unless @$element;
    return $element;
  }
  
  my $resource2_upgrade = {
    license    => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef },
    homepage   => \&_url_or_drop,
    bugtracker => sub {
      my ($item) = @_;
      return unless $item;
      if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
      elsif( _is_urlish($item) ) { return { web => $item } }
      else { return }
    },
    repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
    ':custom'  => \&_prefix_custom,
  };
  
  sub _upgrade_resources_2 {
    my (undef, undef, $meta, $version) = @_;
    return unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource2_upgrade);
  }
  
  my $bugtracker2_spec = {
    web => \&_url_or_drop,
    mailto => \&_keep,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _repo_type {
    my ($element, $key, $meta, $to_version) = @_;
    return $element if defined $element;
    return unless exists $meta->{url};
    my $repo_url = $meta->{url};
    for my $type ( qw/git svn/ ) {
      return $type if $repo_url =~ m{\A$type};
    }
    return;
  }
  
  my $repository2_spec = {
    web => \&_url_or_drop,
    url => \&_url_or_drop,
    type => \&_repo_type,
    ':custom'  => \&_prefix_custom,
  };
  
  my $resources2_cleanup = {
    license    => \&_url_list,
    homepage   => \&_url_or_drop,
    bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef },
    repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef },
    ':custom'  => \&_prefix_custom,
  };
  
  sub _cleanup_resources_2 {
    my ($resources, $key, $meta, $to_version) = @_;
    return unless $resources && ref $resources eq 'HASH';
    return _convert($resources, $resources2_cleanup, $to_version);
  }
  
  my $resource1_spec = {
    license    => \&_url_or_drop,
    homepage   => \&_url_or_drop,
    bugtracker => \&_url_or_drop,
    repository => \&_url_or_drop,
    ':custom'  => \&_keep,
  };
  
  sub _resources_1_3 {
    my (undef, undef, $meta, $version) = @_;
    return unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource1_spec);
  }
  
  *_resources_1_4 = *_resources_1_3;
  
  sub _resources_1_2 {
    my (undef, undef, $meta) = @_;
    my $resources = $meta->{resources} || {};
    if ( $meta->{license_url} && ! $resources->{license} ) {
      $resources->{license} = $meta->{license_url}
        if _is_urlish($meta->{license_url});
    }
    return unless keys %$resources;
    return _convert($resources, $resource1_spec);
  }
  
  my $resource_downgrade_spec = {
    license    => sub { return ref $_[0] ? $_[0]->[0] : $_[0] },
    homepage   => \&_url_or_drop,
    bugtracker => sub { return $_[0]->{web} },
    repository => sub { return $_[0]->{url} || $_[0]->{web} },
    ':custom'  => \&_no_prefix_ucfirst_custom,
  };
  
  sub _downgrade_resources {
    my (undef, undef, $meta, $version) = @_;
    return unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource_downgrade_spec);
  }
  
  sub _release_status {
    my ($element, undef, $meta) = @_;
    return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z};
    return _release_status_from_version(undef, undef, $meta);
  }
  
  sub _release_status_from_version {
    my (undef, undef, $meta) = @_;
    my $version = $meta->{version} || '';
    return ( $version =~ /_/ ) ? 'testing' : 'stable';
  }
  
  my $provides_spec = {
    file => \&_keep,
    version => \&_keep,
  };
  
  my $provides_spec_2 = {
    file => \&_keep,
    version => \&_keep,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _provides {
    my ($element, $key, $meta, $to_version) = @_;
    return unless defined $element && ref $element eq 'HASH';
    my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
    my $new_data = {};
    for my $k ( keys %$element ) {
      $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
      $new_data->{$k}{version} = _clean_version($element->{$k}{version})
        if exists $element->{$k}{version};
    }
    return $new_data;
  }
  
  sub _convert {
    my ($data, $spec, $to_version, $is_fragment) = @_;
  
    my $new_data = {};
    for my $key ( keys %$spec ) {
      next if $key eq ':custom' || $key eq ':drop';
      next unless my $fcn = $spec->{$key};
      if ( $is_fragment && $key eq 'generated_by' ) {
        $fcn = \&_keep;
      }
      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,
    },
  );
  
  # for a given field in a spec version, what fields will it feed
  # into in the *latest* spec (i.e. v2); meta-spec omitted because
  # we always expect a meta-spec to be generated
  my %fragments_generate = (
    '2' => {
      'abstract'            =>   'abstract',
      'author'              =>   'author',
      'generated_by'        =>   'generated_by',
      'license'             =>   'license',
      'name'                =>   'name',
      'version'             =>   'version',
      'dynamic_config'      =>   'dynamic_config',
      'release_status'      =>   'release_status',
      'keywords'            =>   'keywords',
      'no_index'            =>   'no_index',
      'optional_features'   =>   'optional_features',
      'provides'            =>   'provides',
      'resources'           =>   'resources',
      'description'         =>   'description',
      'prereqs'             =>   'prereqs',
    },
    '1.4' => {
      'abstract'            => 'abstract',
      'author'              => 'author',
      'generated_by'        => 'generated_by',
      'license'             => 'license',
      'name'                => 'name',
      'version'             => 'version',
      'build_requires'      => 'prereqs',
      'conflicts'           => 'prereqs',
      'distribution_type'   => 'distribution_type',
      'dynamic_config'      => 'dynamic_config',
      'keywords'            => 'keywords',
      'no_index'            => 'no_index',
      'optional_features'   => 'optional_features',
      'provides'            => 'provides',
      'recommends'          => 'prereqs',
      'requires'            => 'prereqs',
      'resources'           => 'resources',
      'configure_requires'  => 'prereqs',
    },
  );
  # this is not quite true but will work well enough
  # as 1.4 is a superset of earlier ones
  $fragments_generate{$_} = $fragments_generate{'1.4'} for qw/1.3 1.2 1.1 1.0/;
  
  #--------------------------------------------------------------------------#
  # Code
  #--------------------------------------------------------------------------#
  
  #pod =method new
  #pod
  #pod   my $cmc = CPAN::Meta::Converter->new( $struct );
  #pod
  #pod The constructor should be passed a valid metadata structure but invalid
  #pod structures are accepted.  If no meta-spec version is provided, version 1.0 will
  #pod be assumed.
  #pod
  #pod Optionally, you can provide a C<default_version> argument after C<$struct>:
  #pod
  #pod   my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" );
  #pod
  #pod This is only needed when converting a metadata fragment that does not include a
  #pod C<meta-spec> field.
  #pod
  #pod =cut
  
  sub new {
    my ($class,$data,%args) = @_;
  
    # create an attributes hash
    my $self = {
      'data'    => $data,
      'spec'    => _extract_spec_version($data, $args{default_version}),
    };
  
    # create the object
    return bless $self, $class;
  }
  
  sub _extract_spec_version {
      my ($data, $default) = @_;
      my $spec = $data->{'meta-spec'};
  
      # is meta-spec there and valid?
      return( $default || "1.0" ) unless defined $spec && ref $spec eq 'HASH'; # before meta-spec?
  
      # does the version key look like a valid version?
      my $v = $spec->{version};
      if ( defined $v && $v =~ /^\d+(?:\.\d+)?$/ ) {
          return $v if defined $v && grep { $v eq $_ } keys %known_specs; # known spec
          return $v+0 if defined $v && grep { $v == $_ } keys %known_specs; # 2.0 => 2
      }
  
      # otherwise, use heuristics: look for 1.x vs 2.0 fields
      return "2" if exists $data->{prereqs};
      return "1.4" if exists $data->{configure_requires};
      return( $default || "1.2" ); # when meta-spec was first defined
  }
  
  #pod =method convert
  #pod
  #pod   my $new_struct = $cmc->convert( version => "2" );
  #pod
  #pod Returns a new hash reference with the metadata converted to a different form.
  #pod C<convert> will die if any conversion/standardization still results in an
  #pod invalid structure.
  #pod
  #pod Valid parameters include:
  #pod
  #pod =over
  #pod
  #pod =item *
  #pod
  #pod C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
  #pod Defaults to the latest version of the CPAN Meta Spec.
  #pod
  #pod =back
  #pod
  #pod Conversion proceeds through each version in turn.  For example, a version 1.2
  #pod structure might be converted to 1.3 then 1.4 then finally to version 2. The
  #pod conversion process attempts to clean-up simple errors and standardize data.
  #pod For example, if C<author> is given as a scalar, it will converted to an array
  #pod reference containing the item. (Converting a structure to its own version will
  #pod also clean-up and standardize.)
  #pod
  #pod When data are cleaned and standardized, missing or invalid fields will be
  #pod replaced with sensible defaults when possible.  This may be lossy or imprecise.
  #pod For example, some badly structured META.yml files on CPAN have prerequisite
  #pod modules listed as both keys and values:
  #pod
  #pod   requires => { 'Foo::Bar' => 'Bam::Baz' }
  #pod
  #pod These would be split and each converted to a prerequisite with a minimum
  #pod version of zero.
  #pod
  #pod When some mandatory fields are missing or invalid, the conversion will attempt
  #pod to provide a sensible default or will fill them with a value of 'unknown'.  For
  #pod example a missing or unrecognized C<license> field will result in a C<license>
  #pod field of 'unknown'.  Fields that may get an 'unknown' include:
  #pod
  #pod =for :list
  #pod * abstract
  #pod * author
  #pod * license
  #pod
  #pod =cut
  
  sub convert {
    my ($self, %args) = @_;
    my $args = { %args };
  
    my $new_version = $args->{version} || $HIGHEST;
    my $is_fragment = $args->{is_fragment};
  
    my ($old_version) = $self->{spec};
    my $converted = _dclone($self->{data});
  
    if ( $old_version == $new_version ) {
      $converted = _convert( $converted, $cleanup{$old_version}, $old_version, $is_fragment );
      unless ( $args->{is_fragment} ) {
        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], $is_fragment );
        unless ( $args->{is_fragment} ) {
          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], $is_fragment );
        unless ( $args->{is_fragment} ) {
          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;
    }
  }
  
  #pod =method upgrade_fragment
  #pod
  #pod   my $new_struct = $cmc->upgrade_fragment;
  #pod
  #pod Returns a new hash reference with the metadata converted to the latest version
  #pod of the CPAN Meta Spec.  No validation is done on the result -- you must
  #pod validate after merging fragments into a complete metadata document.
  #pod
  #pod =cut
  
  sub upgrade_fragment {
    my ($self) = @_;
    my ($old_version) = $self->{spec};
    my %expected =
      map {; $_ => 1 }
      grep { defined }
      map { $fragments_generate{$old_version}{$_} }
      keys %{ $self->{data} };
    my $converted = $self->convert( version => $HIGHEST, is_fragment => 1 );
    for my $key ( keys %$converted ) {
      next if $key =~ /^x_/i || $key eq 'meta-spec';
      delete $converted->{$key} unless $expected{$key};
    }
    return $converted;
  }
  
  1;
  
  # ABSTRACT: Convert CPAN distribution metadata structures
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::Converter - Convert CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.143240
  
  =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.
  
  Optionally, you can provide a C<default_version> argument after C<$struct>:
  
    my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" );
  
  This is only needed when converting a metadata fragment that does not include a
  C<meta-spec> field.
  
  =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
  
  =head2 upgrade_fragment
  
    my $new_struct = $cmc->upgrade_fragment;
  
  Returns a new hash reference with the metadata converted to the latest version
  of the CPAN Meta Spec.  No validation is done on the result -- you must
  validate after merging fragments into a complete metadata document.
  
  =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__
  
  
  # vim: ts=2 sts=2 sw=2 et:
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;
  # VERSION
  $CPAN::Meta::Feature::VERSION = '2.143240';
  use CPAN::Meta::Prereqs;
  
  #pod =head1 DESCRIPTION
  #pod
  #pod A CPAN::Meta::Feature object describes an optional feature offered by a CPAN
  #pod distribution and specified in the distribution's F<META.json> (or F<META.yml>)
  #pod file.
  #pod
  #pod For the most part, this class will only be used when operating on the result of
  #pod the C<feature> or C<features> methods on a L<CPAN::Meta> object.
  #pod
  #pod =method new
  #pod
  #pod   my $feature = CPAN::Meta::Feature->new( $identifier => \%spec );
  #pod
  #pod This returns a new Feature object.  The C<%spec> argument to the constructor
  #pod should be the same as the value of the C<optional_feature> entry in the
  #pod distmeta.  It must contain entries for C<description> and C<prereqs>.
  #pod
  #pod =cut
  
  sub new {
    my ($class, $identifier, $spec) = @_;
  
    my %guts = (
      identifier  => $identifier,
      description => $spec->{description},
      prereqs     => CPAN::Meta::Prereqs->new($spec->{prereqs}),
    );
  
    bless \%guts => $class;
  }
  
  #pod =method identifier
  #pod
  #pod This method returns the feature's identifier.
  #pod
  #pod =cut
  
  sub identifier  { $_[0]{identifier}  }
  
  #pod =method description
  #pod
  #pod This method returns the feature's long description.
  #pod
  #pod =cut
  
  sub description { $_[0]{description} }
  
  #pod =method prereqs
  #pod
  #pod This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs>
  #pod object.
  #pod
  #pod =cut
  
  sub prereqs     { $_[0]{prereqs} }
  
  1;
  
  # ABSTRACT: an optional feature provided by a CPAN distribution
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
  
  =head1 VERSION
  
  version 2.143240
  
  =head1 DESCRIPTION
  
  A CPAN::Meta::Feature object describes an optional feature offered by a CPAN
  distribution and specified in the distribution's F<META.json> (or F<META.yml>)
  file.
  
  For the most part, this class will only be used when operating on the result of
  the C<feature> or C<features> methods on a L<CPAN::Meta> object.
  
  =head1 METHODS
  
  =head2 new
  
    my $feature = CPAN::Meta::Feature->new( $identifier => \%spec );
  
  This returns a new Feature object.  The C<%spec> argument to the constructor
  should be the same as the value of the C<optional_feature> entry in the
  distmeta.  It must contain entries for C<description> and C<prereqs>.
  
  =head2 identifier
  
  This method returns the feature's identifier.
  
  =head2 description
  
  This method returns the feature's long description.
  
  =head2 prereqs
  
  This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs>
  object.
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_FEATURE

$fatpacked{"CPAN/Meta/History.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_HISTORY';
  # vi:tw=72
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::History;
  # VERSION
  $CPAN::Meta::History::VERSION = '2.143240';
  1;
  
  # ABSTRACT: history of CPAN Meta Spec changes
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::History - history of CPAN Meta Spec changes
  
  =head1 VERSION
  
  version 2.143240
  
  =head1 DESCRIPTION
  
  The CPAN Meta Spec has gone through several iterations.  It was
  originally written in HTML and later revised into POD (though published
  in HTML generated from the POD).  Fields were added, removed or changed,
  sometimes by design and sometimes to reflect real-world usage after the
  fact.
  
  This document reconstructs the history of the CPAN Meta Spec based on
  change logs, repository commit messages and the published HTML files.
  In some cases, particularly prior to version 1.2, the exact version
  when certain fields were introduced or changed is inconsistent between
  sources.  When in doubt, the published HTML files for versions 1.0 to
  1.4 as they existed when version 2 was developed are used as the
  definitive source.
  
  Starting with version 2, the specification document is part of the
  CPAN-Meta distribution and will be published on CPAN as
  L<CPAN::Meta::Spec>.
  
  Going forward, specification version numbers will be integers and
  decimal portions will correspond to a release date for the CPAN::Meta
  library.
  
  =head1 HISTORY
  
  =head2 Version 2
  
  April 2010
  
  =over
  
  =item *
  
  Revised spec examples as perl data structures rather than YAML
  
  =item *
  
  Switched to JSON serialization from YAML
  
  =item *
  
  Specified allowed version number formats
  
  =item *
  
  Replaced 'requires', 'build_requires', 'configure_requires',
  'recommends' and 'conflicts' with new 'prereqs' data structure divided
  by I<phase> (configure, build, test, runtime, etc.) and I<relationship>
  (requires, recommends, suggests, conflicts)
  
  =item *
  
  Added support for 'develop' phase for requirements for maintaining
  a list of authoring tools
  
  =item *
  
  Changed 'license' to a list and revised the set of valid licenses
  
  =item *
  
  Made 'dynamic_config' mandatory to reduce confusion
  
  =item *
  
  Changed 'resources' subkey 'repository' to a hash that clarifies
  repository type, url for browsing and url for checkout
  
  =item *
  
  Changed 'resources' subkey 'bugtracker' to a hash for either web
  or mailto resource
  
  =item *
  
  Changed specification of 'optional_features':
  
  =over
  
  =item *
  
  Added formal specification and usage guide instead of just example
  
  =item *
  
  Changed to use new prereqs data structure instead of individual keys
  
  =back
  
  =item *
  
  Clarified intended use of 'author' as generalized contact list
  
  =item *
  
  Added 'release_status' field to indicate stable, testing or unstable
  status to provide hints to indexers
  
  =item *
  
  Added 'description' field for a longer description of the distribution
  
  =item *
  
  Formalized use of "x_" or "X_" for all custom keys not listed in the
  official spec
  
  =back
  
  =head2 Version 1.4
  
  June 2008
  
  =over
  
  =item *
  
  Noted explicit support for 'perl' in prerequisites
  
  =item *
  
  Added 'configure_requires' prerequisite type
  
  =item *
  
  Changed 'optional_features'
  
  =over
  
  =item *
  
  Example corrected to show map of maps instead of list of maps
  (though descriptive text said 'map' even in v1.3)
  
  =item *
  
  Removed 'requires_packages', 'requires_os' and 'excluded_os'
  as valid subkeys
  
  =back
  
  =back
  
  =head2 Version 1.3
  
  November 2006
  
  =over
  
  =item *
  
  Added 'no_index' subkey 'directory' and removed 'dir' to match actual
  usage in the wild
  
  =item *
  
  Added a 'repository' subkey to 'resources'
  
  =back
  
  =head2 Version 1.2
  
  August 2005
  
  =over
  
  =item *
  
  Re-wrote and restructured spec in POD syntax
  
  =item *
  
  Changed 'name' to be mandatory
  
  =item *
  
  Changed 'generated_by' to be mandatory
  
  =item *
  
  Changed 'license' to be mandatory
  
  =item *
  
  Added version range specifications for prerequisites
  
  =item *
  
  Added required 'abstract' field
  
  =item *
  
  Added required 'author' field
  
  =item *
  
  Added required 'meta-spec' field to define 'version' (and 'url') of the
  CPAN Meta Spec used for metadata
  
  =item *
  
  Added 'provides' field
  
  =item *
  
  Added 'no_index' field and deprecated 'private' field.  'no_index'
  subkeys include 'file', 'dir', 'package' and 'namespace'
  
  =item *
  
  Added 'keywords' field
  
  =item *
  
  Added 'resources' field with subkeys 'homepage', 'license', and
  'bugtracker'
  
  =item *
  
  Added 'optional_features' field as an alternate under 'recommends'.
  Includes 'description', 'requires', 'build_requires', 'conflicts',
  'requires_packages', 'requires_os' and 'excluded_os' as valid subkeys
  
  =item *
  
  Removed 'license_uri' field
  
  =back
  
  =head2 Version 1.1
  
  May 2003
  
  =over
  
  =item *
  
  Changed 'version' to be mandatory
  
  =item *
  
  Added 'private' field
  
  =item *
  
  Added 'license_uri' field
  
  =back
  
  =head2 Version 1.0
  
  March 2003
  
  =over
  
  =item *
  
  Original release (in HTML format only)
  
  =item *
  
  Included 'name', 'version', 'license', 'distribution_type', 'requires',
  'recommends', 'build_requires', 'conflicts', 'dynamic_config',
  'generated_by'
  
  =back
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_HISTORY

$fatpacked{"CPAN/Meta/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_MERGE';
  use strict;
  use warnings;
  
  package CPAN::Meta::Merge;
  # VERSION
  $CPAN::Meta::Merge::VERSION = '2.143240';
  use Carp qw/croak/;
  use Scalar::Util qw/blessed/;
  use CPAN::Meta::Converter;
  
  sub _identical {
    my ($left, $right, $path) = @_;
    croak sprintf "Can't merge attribute %s: '%s' does not equal '%s'", join('.', @{$path}), $left, $right unless $left eq $right;
    return $left;
  }
  
  sub _merge {
    my ($current, $next, $mergers, $path) = @_;
    for my $key (keys %{$next}) {
      if (not exists $current->{$key}) {
        $current->{$key} = $next->{$key};
      }
      elsif (my $merger = $mergers->{$key}) {
        $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]);
      }
      elsif ($merger = $mergers->{':default'}) {
        $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]);
      }
      else {
        croak sprintf "Can't merge unknown attribute '%s'", join '.', @{$path}, $key;
      }
    }
    return $current;
  }
  
  sub _uniq {
    my %seen = ();
    return grep { not $seen{$_}++ } @_;
  }
  
  sub _set_addition {
    my ($left, $right) = @_;
    return [ +_uniq(@{$left}, @{$right}) ];
  }
  
  sub _uniq_map {
    my ($left, $right, $path) = @_;
    for my $key (keys %{$right}) {
      if (not exists $left->{$key}) {
        $left->{$key} = $right->{$key};
      }
      else {
        croak 'Duplication of element ' . join '.', @{$path}, $key;
      }
    }
    return $left;
  }
  
  sub _improvize {
    my ($left, $right, $path) = @_;
    my ($name) = reverse @{$path};
    if ($name =~ /^x_/) {
      if (ref($left) eq 'ARRAY') {
        return _set_addition($left, $right, $path);
      }
      elsif (ref($left) eq 'HASH') {
        return _uniq_map($left, $right, $path);
      }
      else {
        return _identical($left, $right, $path);
      }
    }
    croak sprintf "Can't merge '%s'", join '.', @{$path};
  }
  
  sub _optional_features {
    my ($left, $right, $path) = @_;
  
    for my $key (keys %{$right}) {
      if (not exists $left->{$key}) {
        $left->{$key} = $right->{$key};
      }
      else {
        for my $subkey (keys %{ $right->{$key} }) {
          next if $subkey eq 'prereqs';
          if (not exists $left->{$key}{$subkey}) {
            $left->{$key}{$subkey} = $right->{$key}{$subkey};
          }
          else {
            Carp::croak "Cannot merge two optional_features named '$key' with different '$subkey' values"
              if do { no warnings 'uninitialized'; $left->{$key}{$subkey} ne $right->{$key}{$subkey} };
          }
        }
  
        require CPAN::Meta::Prereqs;
        $left->{$key}{prereqs} =
          CPAN::Meta::Prereqs->new($left->{$key}{prereqs})
            ->with_merged_prereqs(CPAN::Meta::Prereqs->new($right->{$key}{prereqs}))
            ->as_string_hash;
      }
    }
    return $left;
  }
  
  
  my %default = (
    abstract       => \&_identical,
    author         => \&_set_addition,
    dynamic_config => sub {
      my ($left, $right) = @_;
      return $left || $right;
    },
    generated_by => sub {
      my ($left, $right) = @_;
      return join ', ', _uniq(split(/, /, $left), split(/, /, $right));
    },
    license     => \&_set_addition,
    'meta-spec' => {
      version => \&_identical,
      url     => \&_identical
    },
    name              => \&_identical,
    release_status    => \&_identical,
    version           => \&_identical,
    description       => \&_identical,
    keywords          => \&_set_addition,
    no_index          => { map { ($_ => \&_set_addition) } qw/file directory package namespace/ },
    optional_features => \&_optional_features,
    prereqs           => sub {
      require CPAN::Meta::Prereqs;
      my ($left, $right) = map { CPAN::Meta::Prereqs->new($_) } @_[0,1];
      return $left->with_merged_prereqs($right)->as_string_hash;
    },
    provides  => \&_uniq_map,
    resources => {
      license    => \&_set_addition,
      homepage   => \&_identical,
      bugtracker => \&_uniq_map,
      repository => \&_uniq_map,
      ':default' => \&_improvize,
    },
    ':default' => \&_improvize,
  );
  
  sub new {
    my ($class, %arguments) = @_;
    croak 'default version required' if not exists $arguments{default_version};
    my %mapping = %default;
    my %extra = %{ $arguments{extra_mappings} || {} };
    for my $key (keys %extra) {
      if (ref($mapping{$key}) eq 'HASH') {
        $mapping{$key} = { %{ $mapping{$key} }, %{ $extra{$key} } };
      }
      else {
        $mapping{$key} = $extra{$key};
      }
    }
    return bless {
      default_version => $arguments{default_version},
      mapping => _coerce_mapping(\%mapping, []),
    }, $class;
  }
  
  my %coderef_for = (
    set_addition => \&_set_addition,
    uniq_map     => \&_uniq_map,
    identical    => \&_identical,
    improvize    => \&_improvize,
  );
  
  sub _coerce_mapping {
    my ($orig, $map_path) = @_;
    my %ret;
    for my $key (keys %{$orig}) {
      my $value = $orig->{$key};
      if (ref($orig->{$key}) eq 'CODE') {
        $ret{$key} = $value;
      }
      elsif (ref($value) eq 'HASH') {
        my $mapping = _coerce_mapping($value, [ @{$map_path}, $key ]);
        $ret{$key} = sub {
          my ($left, $right, $path) = @_;
          return _merge($left, $right, $mapping, [ @{$path} ]);
        };
      }
      elsif ($coderef_for{$value}) {
        $ret{$key} = $coderef_for{$value};
      }
      else {
        croak "Don't know what to do with " . join '.', @{$map_path}, $key;
      }
    }
    return \%ret;
  }
  
  sub merge {
    my ($self, @items) = @_;
    my $current = {};
    for my $next (@items) {
      if ( blessed($next) && $next->isa('CPAN::Meta') ) {
        $next = $next->as_struct;
      }
      elsif ( ref($next) eq 'HASH' ) {
        my $cmc = CPAN::Meta::Converter->new(
          $next, default_version => $self->{default_version}
        );
        $next = $cmc->upgrade_fragment;
      }
      else {
        croak "Don't know how to merge '$next'";
      }
      $current = _merge($current, $next, $self->{mapping}, []);
    }
    return $current;
  }
  
  1;
  
  # ABSTRACT: Merging CPAN Meta fragments
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::Merge - Merging CPAN Meta fragments
  
  =head1 VERSION
  
  version 2.143240
  
  =head1 SYNOPSIS
  
   my $merger = CPAN::Meta::Merge->new(default_version => "2");
   my $meta = $merger->merge($base, @additional);
  
  =head1 DESCRIPTION
  
  =head1 METHODS
  
  =head2 new
  
  This creates a CPAN::Meta::Merge object. It takes one mandatory named
  argument, C<version>, declaring the version of the meta-spec that must be
  used for the merge. It can optionally take an C<extra_mappings> argument
  that allows one to add additional merging functions for specific elements.
  
  =head2 merge(@fragments)
  
  Merge all C<@fragments> together. It will accept both CPAN::Meta objects and
  (possibly incomplete) hashrefs of metadata.
  
  =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_MERGE

$fatpacked{"CPAN/Meta/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_PREREQS';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Prereqs;
  # VERSION
  $CPAN::Meta::Prereqs::VERSION = '2.143240';
  #pod =head1 DESCRIPTION
  #pod
  #pod A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN
  #pod distribution or one of its optional features.  Each set of prereqs is
  #pod organized by phase and type, as described in L<CPAN::Meta::Prereqs>.
  #pod
  #pod =cut
  
  use Carp qw(confess);
  use Scalar::Util qw(blessed);
  use CPAN::Meta::Requirements 2.121;
  
  #pod =method new
  #pod
  #pod   my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec );
  #pod
  #pod This method returns a new set of Prereqs.  The input should look like the
  #pod contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning
  #pod something more or less like this:
  #pod
  #pod   my $prereq = CPAN::Meta::Prereqs->new({
  #pod     runtime => {
  #pod       requires => {
  #pod         'Some::Module' => '1.234',
  #pod         ...,
  #pod       },
  #pod       ...,
  #pod     },
  #pod     ...,
  #pod   });
  #pod
  #pod You can also construct an empty set of prereqs with:
  #pod
  #pod   my $prereqs = CPAN::Meta::Prereqs->new;
  #pod
  #pod This empty set of prereqs is useful for accumulating new prereqs before finally
  #pod dumping the whole set into a structure or string.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method requirements_for
  #pod
  #pod   my $requirements = $prereqs->requirements_for( $phase, $type );
  #pod
  #pod This method returns a L<CPAN::Meta::Requirements> object for the given
  #pod phase/type combination.  If no prerequisites are registered for that
  #pod combination, a new CPAN::Meta::Requirements object will be returned, and it may
  #pod be added to as needed.
  #pod
  #pod If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
  #pod be raised.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method with_merged_prereqs
  #pod
  #pod   my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
  #pod
  #pod   my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs );
  #pod
  #pod This method returns a new CPAN::Meta::Prereqs objects in which all the
  #pod other prerequisites given are merged into the current set.  This is primarily
  #pod provided for combining a distribution's core prereqs with the prereqs of one of
  #pod its optional features.
  #pod
  #pod The new prereqs object has no ties to the originals, and altering it further
  #pod will not alter them.
  #pod
  #pod =cut
  
  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);
  }
  
  #pod =method merged_requirements
  #pod
  #pod     my $new_reqs = $prereqs->merged_requirements( \@phases, \@types );
  #pod     my $new_reqs = $prereqs->merged_requirements( \@phases );
  #pod     my $new_reqs = $preerqs->merged_requirements();
  #pod
  #pod This method joins together all requirements across a number of phases
  #pod and types into a new L<CPAN::Meta::Requirements> object.  If arguments
  #pod are omitted, it defaults to "runtime", "build" and "test" for phases
  #pod and "requires" and "recommends" for types.
  #pod
  #pod =cut
  
  sub merged_requirements {
    my ($self, $phases, $types) = @_;
    $phases = [qw/runtime build test/] unless defined $phases;
    $types = [qw/requires recommends/] unless defined $types;
  
    confess "merged_requirements phases argument must be an arrayref"
      unless ref $phases eq 'ARRAY';
    confess "merged_requirements types argument must be an arrayref"
      unless ref $types eq 'ARRAY';
  
    my $req = CPAN::Meta::Requirements->new;
  
    for my $phase ( @$phases ) {
      unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) {
          confess "requested requirements for unknown phase: $phase";
      }
      for my $type ( @$types ) {
        unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) {
            confess "requested requirements for unknown type: $type";
        }
        $req->add_requirements( $self->requirements_for($phase, $type) );
      }
    }
  
    $req->finalize if $self->is_finalized;
  
    return $req;
  }
  
  
  #pod =method as_string_hash
  #pod
  #pod This method returns a hashref containing structures suitable for dumping into a
  #pod distmeta data structure.  It is made up of hashes and strings, only; there will
  #pod be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method is_finalized
  #pod
  #pod This method returns true if the set of prereqs has been marked "finalized," and
  #pod cannot be altered.
  #pod
  #pod =cut
  
  sub is_finalized { $_[0]{finalized} }
  
  #pod =method finalize
  #pod
  #pod Calling C<finalize> on a Prereqs object will close it for further modification.
  #pod Attempting to make any changes that would actually alter the prereqs will
  #pod result in an exception being thrown.
  #pod
  #pod =cut
  
  sub finalize {
    my ($self) = @_;
  
    $self->{finalized} = 1;
  
    for my $phase (keys %{ $self->{prereqs} }) {
      $_->finalize for values %{ $self->{prereqs}{$phase} };
    }
  }
  
  #pod =method clone
  #pod
  #pod   my $cloned_prereqs = $prereqs->clone;
  #pod
  #pod This method returns a Prereqs object that is identical to the original object,
  #pod but can be altered without affecting the original object.  Finalization does
  #pod not survive cloning, meaning that you may clone a finalized set of prereqs and
  #pod then modify the clone.
  #pod
  #pod =cut
  
  sub clone {
    my ($self) = @_;
  
    my $clone = (ref $self)->new( $self->as_string_hash );
  }
  
  1;
  
  # ABSTRACT: a set of distribution prerequisites by phase and type
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
  
  =head1 VERSION
  
  version 2.143240
  
  =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 merged_requirements
  
      my $new_reqs = $prereqs->merged_requirements( \@phases, \@types );
      my $new_reqs = $prereqs->merged_requirements( \@phases );
      my $new_reqs = $preerqs->merged_requirements();
  
  This method joins together all requirements across a number of phases
  and types into a new L<CPAN::Meta::Requirements> object.  If arguments
  are omitted, it defaults to "runtime", "build" and "test" for phases
  and "requires" and "recommends" for types.
  
  =head2 as_string_hash
  
  This method returns a hashref containing structures suitable for dumping into a
  distmeta data structure.  It is made up of hashes and strings, only; there will
  be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it.
  
  =head2 is_finalized
  
  This method returns true if the set of prereqs has been marked "finalized," and
  cannot be altered.
  
  =head2 finalize
  
  Calling C<finalize> on a Prereqs object will close it for further modification.
  Attempting to make any changes that would actually alter the prereqs will
  result in an exception being thrown.
  
  =head2 clone
  
    my $cloned_prereqs = $prereqs->clone;
  
  This method returns a Prereqs object that is identical to the original object,
  but can be altered without affecting the original object.  Finalization does
  not survive cloning, meaning that you may clone a finalized set of prereqs and
  then modify the clone.
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_PREREQS

$fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS';
  use strict;
  use warnings;
  package CPAN::Meta::Requirements;
  # ABSTRACT: a set of version requirements for a CPAN dist
  
  our $VERSION = '2.131';
  
  #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 ();
  
  # 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 ()"; ## no critic
    if ( my $err = $@ ) {
      eval "require ExtUtils::MakeMaker::version" or die $err; ## 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} };
  
  # construct once, reuse many times
  my $V0 = version->new(0);
  
  #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
  #pod   version string as first argument, and the module name as second
  #pod   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;
  }
  
  # safe if given an unblessed reference
  sub _isa_version {
    UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) && $_[0]->isa('version')
  }
  
  sub _version_object {
    my ($self, $module, $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 {
      if (not defined $version or $version eq '0') {
        $vobj = $V0;
      }
      elsif ( ref($version) eq 'version' || _isa_version($version) ) {
        $vobj = $version;
      }
      else {
        local $SIG{__WARN__} = sub { die "Invalid version: $_[0]" };
        $vobj = version->new($version);
      }
    };
  
    if ( my $err = $@ ) {
      my $hook = $self->{bad_version_hook};
      $vobj = eval { $hook->($version, $module) }
        if ref $hook eq 'CODE';
      unless (eval { $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(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( $name, $version );
  
        $self->__modify_entry_for($name, $method, $version);
  
        return $self;
      };
      
      no strict 'refs';
      *$to_add = $code;
    }
  }
  
  sub add_minimum {
    my ($self, $name, $version) = @_;
  
    if (not defined $version or $version eq '0') {
      return $self if $self->__entry_for($name);
      Carp::confess("can't add new requirements to finalized requirements")
        if $self->is_finalized;
  
      $self->{requirements}{ $name } =
        CPAN::Meta::Requirements::_Range::Range->with_minimum($V0);
    }
    else {
      $version = $self->_version_object( $name, $version );
  
      $self->__modify_entry_for($name, 'with_minimum', $version);
    }
    return $self;
  }
  
  #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( $module, $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   $req->add_string_requirement('Library::Foo' => v1.208);
  #pod
  #pod This method parses the passed in string and adds the appropriate requirement
  #pod for the given module.  A version can be a Perl "v-string".  It understands
  #pod version ranges as described in the L<CPAN::Meta::Spec/Version Ranges>. For
  #pod 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) = @_;
  
    unless ( defined $req && length $req ) {
      $req = 0;
      $self->_blank_carp($module);
    }
  
    my $magic = _find_magic_vstring( $req );
    if (length $magic) {
      $self->add_minimum($module => $magic);
      return;
    }
  
    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   my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts );
  #pod
  #pod This is an alternate constructor for a CPAN::Meta::Requirements
  #pod object. It takes a hash of module names and version requirement
  #pod strings and returns a new CPAN::Meta::Requirements object. As with
  #pod add_string_requirement, a version can be a Perl "v-string". Optionally,
  #pod you can supply a hash-reference of options, exactly as with the L</new>
  #pod method.
  #pod
  #pod =cut
  
  sub _blank_carp {
    my ($self, $module) = @_;
    Carp::carp("Undefined requirement for $module treated as '0'");
  }
  
  sub from_string_hash {
    my ($class, $hash, $options) = @_;
  
    my $self = $class->new($options);
  
    for my $module (keys %$hash) {
      my $req = $hash->{$module};
      unless ( defined $req && length $req ) {
        $req = 0;
        $class->_blank_carp($module);
      }
      $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.131
  
  =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 first argument, and the module name as second 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');
    $req->add_string_requirement('Library::Foo' => v1.208);
  
  This method parses the passed in string and adds the appropriate requirement
  for the given module.  A version can be a Perl "v-string".  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 );
    my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts );
  
  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. As with
  add_string_requirement, a version can be a Perl "v-string". Optionally,
  you can supply a hash-reference of options, exactly as with the L</new>
  method.
  
  =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 Ed J Karen Etheridge Leon Timmermans robario
  
  =over 4
  
  =item *
  
  Ed J <mohawk2@users.noreply.github.com>
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  Leon Timmermans <fawaka@gmail.com>
  
  =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';
  # XXX RULES FOR PATCHING THIS FILE XXX
  # Patches that fix typos or formatting are acceptable.  Patches
  # that change semantics are not acceptable without prior approval
  # by David Golden or Ricardo Signes.
  
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Spec;
  # VERSION
  $CPAN::Meta::Spec::VERSION = '2.143240';
  1;
  
  # ABSTRACT: specification for CPAN distribution metadata
  
  
  # vi:tw=72
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::Spec - specification for CPAN distribution metadata
  
  =head1 VERSION
  
  version 2.143240
  
  =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     => 'https://metacpan.org/pod/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.
  
  Note: when this field is true, post-configuration prerequisites are not
  guaranteed to bear any relation whatsoever to those stated in the metadata,
  and relying on them doing so is an error. See also
  L</Prerequisites for dynamically configured distributions> in the implementors'
  notes.
  
  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 or not prerequisites are exactly 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_0', '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.
  
  For the version 2 spec, either of these are recommended:
  
  =over 4
  
  =item *
  
  C<https://metacpan.org/pod/CPAN::Meta::Spec>
  
  =item *
  
  C<http://search.cpan.org/perldoc?CPAN::Meta::Spec>
  
  =back
  
  =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.  For example, L<LWP::UserAgent> is distributed as part
  of the distribution name "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. Note that this is a list of
  exclusions, and the spec does not define what to I<include> - see
  L</Indexing distributions a la PAUSE> in the implementors notes for more
  information.
  
  Valid subkeys are as follows:
  
  =over
  
  =item file
  
  A I<List> of relative paths to files.  Paths B<must be> specified with
  unix conventions.
  
  =item directory
  
  A I<List> of relative paths to directories.  Paths B<must be> specified
  with unix conventions.
  
  [ Note: previous editions of the spec had C<dir> instead of C<directory> ]
  
  =item package
  
  A I<List> of package names.
  
  =item namespace
  
  A I<List> of package namespaces, where anything below the namespace
  must be ignored, but I<not> the namespace itself.
  
  In the example above for C<no_index>, C<My::Module::Sample::Foo> would
  be ignored, but C<My::Module::Sample> would not.
  
  =back
  
  =head3 optional_features
  
  Example:
  
    optional_features => {
      sqlite => {
        description => 'Provides SQLite support',
        prereqs => {
          runtime => {
            requires => {
              'DBD::SQLite' => '1.25'
            }
          }
        }
      }
    }
  
  (Spec 2) [optional] {Map}
  
  This Map describes optional features with incremental prerequisites.
  Each key of the C<optional_features> Map is a String used to identify
  the feature and each value is a Map with additional information about
  the feature.  Valid subkeys include:
  
  =over
  
  =item description
  
  This is a String describing the feature.  Every optional feature
  should provide a description
  
  =item prereqs
  
  This entry is required and has the same structure as that of the
  C<L</prereqs>> key.  It provides a list of package requirements
  that must be satisfied for the feature to be supported or enabled.
  
  There is one crucial restriction:  the prereqs of an optional feature
  B<must not> include C<configure> phase prereqs.
  
  =back
  
  Consumers B<must not> include optional features as prerequisites without
  explicit instruction from users (whether via interactive prompting,
  a function parameter or a configuration value, etc. ).
  
  If an optional feature is used by a consumer to add additional
  prerequisites, the consumer should merge the optional feature
  prerequisites into those given by the C<prereqs> key using the same
  semantics.  See L</Merging and Resolving Prerequisites> for details on
  merging prerequisites.
  
  I<Suggestion for disuse:> Because there is currently no way for a
  distribution to specify a dependency on an optional feature of another
  dependency, the use of C<optional_feature> is discouraged.  Instead,
  create a separate, installable distribution that ensures the desired
  feature is available.  For example, if C<Foo::Bar> has a C<Baz> feature,
  release a separate C<Foo-Bar-Baz> distribution that satisfies
  requirements for the feature.
  
  =head3 prereqs
  
  Example:
  
    prereqs => {
      runtime => {
        requires => {
          'perl'          => '5.006',
          'File::Spec'    => '0.86',
          'JSON'          => '2.16',
        },
        recommends => {
          'JSON::XS'      => '2.26',
        },
        suggests => {
          'Archive::Tar'  => '0',
        },
      },
      build => {
        requires => {
          'Alien::SDL'    => '1.00',
        },
      },
      test => {
        recommends => {
          'Test::Deep'    => '0.10',
        },
      }
    }
  
  (Spec 2) [optional] {Map}
  
  This is a Map that describes all the prerequisites of the distribution.
  The keys are phases of activity, such as C<configure>, C<build>, C<test>
  or C<runtime>.  Values are Maps in which the keys name the type of
  prerequisite relationship such as C<requires>, C<recommends>, or
  C<suggests> and the value provides a set of prerequisite relations.  The
  set of relations B<must> be specified as a Map of package names to
  version ranges.
  
  The full definition for this field is given in the L</Prereq Spec>
  section.
  
  =head3 provides
  
  Example:
  
    provides => {
      'Foo::Bar' => {
        file    => 'lib/Foo/Bar.pm',
        version => '0.27_02',
      },
      'Foo::Bar::Blah' => {
        file    => 'lib/Foo/Bar/Blah.pm',
      },
      'Foo::Bar::Baz' => {
        file    => 'lib/Foo/Bar/Baz.pm',
        version => '0.3',
      },
    }
  
  (Spec 1.2) [optional] {Map}
  
  This describes all packages provided by this distribution.  This
  information is used by distribution and automation mechanisms like
  PAUSE, CPAN, metacpan.org and search.cpan.org to build indexes saying in
  which distribution various packages can be found.
  
  The keys of C<provides> are package names that can be found within
  the distribution.  If a package name key is provided, it must
  have a Map with the following valid subkeys:
  
  =over
  
  =item file
  
  This field is required.  It must contain a Unix-style relative file path
  from the root of the distribution directory to a file that contains or
  generates the package.  It may be given as C<META.yml> or C<META.json>
  to claim a package for indexing without needing a C<*.pm>.
  
  =item version
  
  If it exists, this field must contains a I<Version> String for the
  package.  If the package does not have a C<$VERSION>, this field must
  be omitted.
  
  =back
  
  =head3 resources
  
  Example:
  
    resources => {
      license     => [ 'http://dev.perl.org/licenses/' ],
      homepage    => 'http://sourceforge.net/projects/module-build',
      bugtracker  => {
        web    => 'http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta',
        mailto => 'meta-bugs@example.com',
      },
      repository  => {
        url  => 'git://github.com/dagolden/cpan-meta.git',
        web  => 'http://github.com/dagolden/cpan-meta',
        type => 'git',
      },
      x_twitter   => 'http://twitter.com/cpan_linked/',
    }
  
  (Spec 2) [optional] {Map}
  
  This field describes resources related to this distribution.
  
  Valid subkeys include:
  
  =over
  
  =item homepage
  
  The official home of this project on the web.
  
  =item license
  
  A List of I<URL>'s that relate to this distribution's license.  As with the
  top-level C<license> field, distribution documentation should be consulted
  to clarify the interpretation of multiple licenses provided here.
  
  =item bugtracker
  
  This entry describes the bug tracking system for this distribution.  It
  is a Map with the following valid keys:
  
    web    - a URL pointing to a web front-end for the bug tracker
    mailto - an email address to which bugs can be sent
  
  =item repository
  
  This entry describes the source control repository for this distribution.  It
  is a Map with the following valid keys:
  
    url  - a URL pointing to the repository itself
    web  - a URL pointing to a web front-end for the repository
    type - a lowercase string indicating the VCS used
  
  Because a url like C<http://myrepo.example.com/> is ambiguous as to
  type, producers should provide a C<type> whenever a C<url> key is given.
  The C<type> field should be the name of the most common program used
  to work with the repository, e.g. C<git>, C<svn>, C<cvs>, C<darcs>,
  C<bzr> or C<hg>.
  
  =back
  
  =head2 DEPRECATED FIELDS
  
  =head3 build_requires
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 configure_requires
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 conflicts
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 distribution_type
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  This field indicated 'module' or 'script' but was considered
  meaningless, since many distributions are hybrids of several kinds of
  things.
  
  =head3 license_uri
  
  I<(Deprecated in Spec 1.2)> [optional] {URL}
  
  Replaced by C<license> in C<resources>
  
  =head3 private
  
  I<(Deprecated in Spec 1.2)> [optional] {Map}
  
  This field has been renamed to L</"no_index">.
  
  =head3 recommends
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head3 requires
  
  I<(Deprecated in Spec 2)> [optional] {String}
  
  Replaced by C<prereqs>
  
  =head1 VERSION NUMBERS
  
  =head2 Version Formats
  
  This section defines the Version type, used by several fields in the
  CPAN Meta Spec.
  
  Version numbers must be treated as strings, not numbers.  For
  example, C<1.200> B<must not> be serialized as C<1.2>.  Version
  comparison should be delegated to the Perl L<version> module, version
  0.80 or newer.
  
  Unless otherwise specified, version numbers B<must> appear in one of two
  formats:
  
  =over
  
  =item Decimal versions
  
  Decimal versions are regular "decimal numbers", with some limitations.
  They B<must> be non-negative and B<must> begin and end with a digit.  A
  single underscore B<may> be included, but B<must> be between two digits.
  They B<must not> use exponential notation ("1.23e-2").
  
     version => '1.234'       # OK
     version => '1.23_04'     # OK
  
     version => '1.23_04_05'  # Illegal
     version => '1.'          # Illegal
     version => '.1'          # Illegal
  
  =item Dotted-integer versions
  
  Dotted-integer (also known as dotted-decimal) versions consist of
  positive integers separated by full stop characters (i.e. "dots",
  "periods" or "decimal points").  This are equivalent in format to Perl
  "v-strings", with some additional restrictions on form.  They must be
  given in "normal" form, which has a leading "v" character and at least
  three integer components.  To retain a one-to-one mapping with decimal
  versions, all components after the first B<should> be restricted to the
  range 0 to 999.  The final component B<may> be separated by an
  underscore character instead of a period.
  
     version => 'v1.2.3'      # OK
     version => 'v1.2_3'      # OK
     version => 'v1.2.3.4'    # OK
     version => 'v1.2.3_4'    # OK
     version => 'v2009.10.31' # OK
  
     version => 'v1.2'          # Illegal
     version => '1.2.3'         # Illegal
     version => 'v1.2_3_4'      # Illegal
     version => 'v1.2009.10.31' # Not recommended
  
  =back
  
  =head2 Version Ranges
  
  Some fields (prereq, optional_features) indicate the particular
  version(s) of some other module that may be required as a prerequisite.
  This section details the Version Range type used to provide this
  information.
  
  The simplest format for a Version Range is just the version
  number itself, e.g. C<2.4>.  This means that B<at least> version 2.4
  must be present.  To indicate that B<any> version of a prerequisite is
  okay, even if the prerequisite doesn't define a version at all, use
  the version C<0>.
  
  Alternatively, a version range B<may> use the operators E<lt> (less than),
  E<lt>= (less than or equal), E<gt> (greater than), E<gt>= (greater than
  or equal), == (equal), and != (not equal).  For example, the
  specification C<E<lt> 2.0> means that any version of the prerequisite
  less than 2.0 is suitable.
  
  For more complicated situations, version specifications B<may> be AND-ed
  together using commas.  The specification C<E<gt>= 1.2, != 1.5, E<lt>
  2.0> indicates a version that must be B<at least> 1.2, B<less than> 2.0,
  and B<not equal to> 1.5.
  
  =head1 PREREQUISITES
  
  =head2 Prereq Spec
  
  The C<prereqs> key in the top-level metadata and within
  C<optional_features> define the relationship between a distribution and
  other packages.  The prereq spec structure is a hierarchical data
  structure which divides prerequisites into I<Phases> of activity in the
  installation process and I<Relationships> that indicate how
  prerequisites should be resolved.
  
  For example, to specify that C<Data::Dumper> is C<required> during the
  C<test> phase, this entry would appear in the distribution metadata:
  
    prereqs => {
      test => {
        requires => {
          'Data::Dumper' => '2.00'
        }
      }
    }
  
  =head3 Phases
  
  Requirements for regular use must be listed in the C<runtime> phase.
  Other requirements should be listed in the earliest stage in which they
  are required and consumers must accumulate and satisfy requirements
  across phases before executing the activity. For example, C<build>
  requirements must also be available during the C<test> phase.
  
    before action       requirements that must be met
    ----------------    --------------------------------
    perl Build.PL       configure
    perl Makefile.PL
  
    make                configure, runtime, build
    Build
  
    make test           configure, runtime, build, test
    Build test
  
  Consumers that install the distribution must ensure that
  I<runtime> requirements are also installed and may install
  dependencies from other phases.
  
    after action        requirements that must be met
    ----------------    --------------------------------
    make install        runtime
    Build install
  
  =over
  
  =item configure
  
  The configure phase occurs before any dynamic configuration has been
  attempted.  Libraries required by the configure phase B<must> be
  available for use before the distribution building tool has been
  executed.
  
  =item build
  
  The build phase is when the distribution's source code is compiled (if
  necessary) and otherwise made ready for installation.
  
  =item test
  
  The test phase is when the distribution's automated test suite is run.
  Any library that is needed only for testing and not for subsequent use
  should be listed here.
  
  =item runtime
  
  The runtime phase refers not only to when the distribution's contents
  are installed, but also to its continued use.  Any library that is a
  prerequisite for regular use of this distribution should be indicated
  here.
  
  =item develop
  
  The develop phase's prereqs are libraries needed to work on the
  distribution's source code as its author does.  These tools might be
  needed to build a release tarball, to run author-only tests, or to
  perform other tasks related to developing new versions of the
  distribution.
  
  =back
  
  =head3 Relationships
  
  =over
  
  =item requires
  
  These dependencies B<must> be installed for proper completion of the
  phase.
  
  =item recommends
  
  Recommended dependencies are I<strongly> encouraged and should be
  satisfied except in resource constrained environments.
  
  =item suggests
  
  These dependencies are optional, but are suggested for enhanced operation
  of the described distribution.
  
  =item conflicts
  
  These libraries cannot be installed when the phase is in operation.
  This is a very rare situation, and the C<conflicts> relationship should
  be used with great caution, or not at all.
  
  =back
  
  =head2 Merging and Resolving Prerequisites
  
  Whenever metadata consumers merge prerequisites, either from different
  phases or from C<optional_features>, they should merged in a way which
  preserves the intended semantics of the prerequisite structure.  Generally,
  this means concatenating the version specifications using commas, as
  described in the L<Version Ranges> section.
  
  Another subtle error that can occur in resolving prerequisites comes from
  the way that modules in prerequisites are indexed to distribution files on
  CPAN.  When a module is deleted from a distribution, prerequisites calling
  for that module could indicate an older distribution should be installed,
  potentially overwriting files from a newer distribution.
  
  For example, as of Oct 31, 2009, the CPAN index file contained these
  module-distribution mappings:
  
    Class::MOP                   0.94  D/DR/DROLSKY/Class-MOP-0.94.tar.gz
    Class::MOP::Class            0.94  D/DR/DROLSKY/Class-MOP-0.94.tar.gz
    Class::MOP::Class::Immutable 0.04  S/ST/STEVAN/Class-MOP-0.36.tar.gz
  
  Consider the case where "Class::MOP" 0.94 is installed.  If a
  distribution specified "Class::MOP::Class::Immutable" as a prerequisite,
  it could result in Class-MOP-0.36.tar.gz being installed, overwriting
  any files from Class-MOP-0.94.tar.gz.
  
  Consumers of metadata B<should> test whether prerequisites would result
  in installed module files being "downgraded" to an older version and
  B<may> warn users or ignore the prerequisite that would cause such a
  result.
  
  =head1 SERIALIZATION
  
  Distribution metadata should be serialized (as a hashref) as
  JSON-encoded data and packaged with distributions as the file
  F<META.json>.
  
  In the past, the distribution metadata structure had been packed with
  distributions as F<META.yml>, a file in the YAML Tiny format (for which,
  see L<YAML::Tiny>).  Tools that consume distribution metadata from disk
  should be capable of loading F<META.yml>, but should prefer F<META.json>
  if both are found.
  
  =head1 NOTES FOR IMPLEMENTORS
  
  =head2 Extracting Version Numbers from Perl Modules
  
  To get the version number from a Perl module, consumers should use the
  C<< MM->parse_version($file) >> method provided by
  L<ExtUtils::MakeMaker> or L<Module::Metadata>.  For example, for the
  module given by C<$mod>, the version may be retrieved in one of the
  following ways:
  
    # via ExtUtils::MakeMaker
    my $file = MM->_installed_file_for_module($mod);
    my $version = MM->parse_version($file)
  
  The private C<_installed_file_for_module> method may be replaced with
  other methods for locating a module in C<@INC>.
  
    # via Module::Metadata
    my $info = Module::Metadata->new_from_module($mod);
    my $version = $info->version;
  
  If only a filename is available, the following approach may be used:
  
    # via Module::Build
    my $info = Module::Metadata->new_from_file($file);
    my $version = $info->version;
  
  =head2 Comparing Version Numbers
  
  The L<version> module provides the most reliable way to compare version
  numbers in all the various ways they might be provided or might exist
  within modules.  Given two strings containing version numbers, C<$v1> and
  C<$v2>, they should be converted to C<version> objects before using
  ordinary comparison operators.  For example:
  
    use version;
    if ( version->new($v1) <=> version->new($v2) ) {
      print "Versions are not equal\n";
    }
  
  If the only comparison needed is whether an installed module is of a
  sufficiently high version, a direct test may be done using the string
  form of C<eval> and the C<use> function.  For example, for module C<$mod>
  and version prerequisite C<$prereq>:
  
    if ( eval "use $mod $prereq (); 1" ) {
      print "Module $mod version is OK.\n";
    }
  
  If the values of C<$mod> and C<$prereq> have not been scrubbed, however,
  this presents security implications.
  
  =head2 Prerequisites for dynamically configured distributions
  
  When C<dynamic_config> is true, it is an error to presume that the
  prerequisites given in distribution metadata will have any relationship
  whatsoever to the actual prerequisites of the distribution.
  
  In practice, however, one can generally expect such prerequisites to be
  one of two things:
  
  =over 4
  
  =item *
  
  The minimum prerequisites for the distribution, to which dynamic configuration will only add items
  
  =item *
  
  Whatever the distribution configured with on the releaser's machine at release time
  
  =back
  
  The second case often turns out to have identical results to the first case,
  albeit only by accident.
  
  As such, consumers may use this data for informational analysis, but
  presenting it to the user as canonical or relying on it as such is
  invariably the height of folly.
  
  =head2 Indexing distributions a la PAUSE
  
  While no_index tells you what must be ignored when indexing, this spec holds
  no opinion on how you should get your initial candidate list of things to
  possibly index. For "normal" distributions you might consider simply indexing
  the contents of lib/, but there are many fascinating oddities on CPAN and
  many dists from the days when it was normal to put the main .pm file in the
  root of the distribution archive - so PAUSE currently indexes all .pm and .PL
  files that are not either (a) specifically excluded by no_index (b) in
  C<inc>, C<xt>, or C<t> directories, or common 'mistake' directories such as
  C<perl5>.
  
  Or: If you're trying to be PAUSE-like, make sure you skip C<inc>, C<xt> and
  C<t> as well as anything marked as no_index.
  
  Also remember: If the META file contains a provides field, you shouldn't be
  indexing anything in the first place - just use that.
  
  =head1 SEE ALSO
  
  =over 4
  
  =item *
  
  CPAN, L<http://www.cpan.org/>
  
  =item *
  
  JSON, L<http://json.org/>
  
  =item *
  
  YAML, L<http://www.yaml.org/>
  
  =item *
  
  L<CPAN>
  
  =item *
  
  L<CPANPLUS>
  
  =item *
  
  L<ExtUtils::MakeMaker>
  
  =item *
  
  L<Module::Build>
  
  =item *
  
  L<Module::Install>
  
  =back
  
  =head1 HISTORY
  
  Ken Williams wrote the original CPAN Meta Spec (also known as the
  "META.yml spec") in 2003 and maintained it through several revisions
  with input from various members of the community.  In 2005, Randy
  Sims redrafted it from HTML to POD for the version 1.2 release.  Ken
  continued to maintain the spec through version 1.4.
  
  In late 2009, David Golden organized the version 2 proposal review
  process.  David and Ricardo Signes drafted the final version 2 spec
  in April 2010 based on the version 1.4 spec and patches contributed
  during the proposal process.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_SPEC

$fatpacked{"CPAN/Meta/Validator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_VALIDATOR';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Validator;
  # VERSION
  $CPAN::Meta::Validator::VERSION = '2.143240';
  #pod =head1 SYNOPSIS
  #pod
  #pod   my $struct = decode_json_file('META.json');
  #pod
  #pod   my $cmv = CPAN::Meta::Validator->new( $struct );
  #pod
  #pod   unless ( $cmv->is_valid ) {
  #pod     my $msg = "Invalid META structure.  Errors found:\n";
  #pod     $msg .= join( "\n", $cmv->errors );
  #pod     die $msg;
  #pod   }
  #pod
  #pod =head1 DESCRIPTION
  #pod
  #pod This module validates a CPAN Meta structure against the version of the
  #pod the specification claimed in the C<meta-spec> field of the structure.
  #pod
  #pod =cut
  
  #--------------------------------------------------------------------------#
  # 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, list => { value => \&string } },
      'dynamic_config'      => { mandatory => 1, value => \&boolean },
      'generated_by'        => { mandatory => 1, value => \&string  },
      'license'             => { mandatory => 1, list => { 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'    => { list => { 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    => { list => { 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
  #--------------------------------------------------------------------------#
  
  #pod =method new
  #pod
  #pod   my $cmv = CPAN::Meta::Validator->new( $struct )
  #pod
  #pod The constructor must be passed a metadata structure.
  #pod
  #pod =cut
  
  sub new {
    my ($class,$data) = @_;
  
    # create an attributes hash
    my $self = {
      'data'    => $data,
      'spec'    => eval { $data->{'meta-spec'}{'version'} } || "1.0",
      'errors'  => undef,
    };
  
    # create the object
    return bless $self, $class;
  }
  
  #pod =method is_valid
  #pod
  #pod   if ( $cmv->is_valid ) {
  #pod     ...
  #pod   }
  #pod
  #pod Returns a boolean value indicating whether the metadata provided
  #pod is valid.
  #pod
  #pod =cut
  
  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;
  }
  
  #pod =method errors
  #pod
  #pod   warn( join "\n", $cmv->errors );
  #pod
  #pod Returns a list of errors seen during validation.
  #pod
  #pod =cut
  
  sub errors {
      my $self = shift;
      return ()   unless(defined $self->{errors});
      return @{$self->{errors}};
  }
  
  #pod =begin :internals
  #pod
  #pod =head2 Check Methods
  #pod
  #pod =over
  #pod
  #pod =item *
  #pod
  #pod check_map($spec,$data)
  #pod
  #pod Checks whether a map (or hash) part of the data structure conforms to the
  #pod appropriate specification definition.
  #pod
  #pod =item *
  #pod
  #pod check_list($spec,$data)
  #pod
  #pod Checks whether a list (or array) part of the data structure conforms to
  #pod the appropriate specification definition.
  #pod
  #pod =item *
  #pod
  #pod =back
  #pod
  #pod =cut
  
  my $spec_error = "Missing validation action in specification. "
    . "Must be one of 'map', 'list', 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});
              } 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});
              } else {
                  $self->_error( "$spec_error for ':key'" );
              }
  
  
          } else {
              $self->_error( "Unknown key, '$key', found in map structure" );
          }
          pop @{$self->{stack}};
      }
  }
  
  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 ($spec->{':key'}) {
              $self->check_map($spec,$value);
          } else {
            $self->_error( "$spec_error associated with '$self->{stack}[-2]'" );
          }
          pop @{$self->{stack}};
      }
  }
  
  #pod =head2 Validator Methods
  #pod
  #pod =over
  #pod
  #pod =item *
  #pod
  #pod header($self,$key,$value)
  #pod
  #pod Validates that the header is valid.
  #pod
  #pod Note: No longer used as we now read the data structure, not the file.
  #pod
  #pod =item *
  #pod
  #pod url($self,$key,$value)
  #pod
  #pod Validates that a given value is in an acceptable URL format
  #pod
  #pod =item *
  #pod
  #pod urlspec($self,$key,$value)
  #pod
  #pod Validates that the URL to a META specification is a known one.
  #pod
  #pod =item *
  #pod
  #pod string_or_undef($self,$key,$value)
  #pod
  #pod Validates that the value is either a string or an undef value. Bit of a
  #pod catchall function for parts of the data structure that are completely user
  #pod defined.
  #pod
  #pod =item *
  #pod
  #pod string($self,$key,$value)
  #pod
  #pod Validates that a string exists for the given key.
  #pod
  #pod =item *
  #pod
  #pod file($self,$key,$value)
  #pod
  #pod Validate that a file is passed for the given key. This may be made more
  #pod thorough in the future. For now it acts like \&string.
  #pod
  #pod =item *
  #pod
  #pod exversion($self,$key,$value)
  #pod
  #pod Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
  #pod
  #pod =item *
  #pod
  #pod version($self,$key,$value)
  #pod
  #pod Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
  #pod are both valid. A leading 'v' like 'v1.2.3' is also valid.
  #pod
  #pod =item *
  #pod
  #pod boolean($self,$key,$value)
  #pod
  #pod Validates for a boolean value. Currently these values are '1', '0', 'true',
  #pod 'false', however the latter 2 may be removed.
  #pod
  #pod =item *
  #pod
  #pod license($self,$key,$value)
  #pod
  #pod Validates that a value is given for the license. Returns 1 if an known license
  #pod type, or 2 if a value is given but the license type is not a recommended one.
  #pod
  #pod =item *
  #pod
  #pod custom_1($self,$key,$value)
  #pod
  #pod Validates that the given key is in CamelCase, to indicate a user defined
  #pod keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
  #pod of the spec, this was only explicitly stated for 'resources'.
  #pod
  #pod =item *
  #pod
  #pod custom_2($self,$key,$value)
  #pod
  #pod Validates that the given key begins with 'x_' or 'X_', to indicate a user
  #pod defined keyword and only has characters in the class [-_a-zA-Z]
  #pod
  #pod =item *
  #pod
  #pod identifier($self,$key,$value)
  #pod
  #pod Validates that key is in an acceptable format for the META specification,
  #pod for an identifier, i.e. any that matches the regular expression
  #pod qr/[a-z][a-z_]/i.
  #pod
  #pod =item *
  #pod
  #pod module($self,$key,$value)
  #pod
  #pod Validates that a given key is in an acceptable module name format, e.g.
  #pod 'Test::CPAN::Meta::Version'.
  #pod
  #pod =back
  #pod
  #pod =end :internals
  #pod
  #pod =cut
  
  sub header {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value && $value =~ /^--- #YAML:1.0/);
      }
      $self->_error( "file does not have a valid YAML header." );
      return 0;
  }
  
  sub release_status {
    my ($self,$key,$value) = @_;
    if(defined $value) {
      my $version = $self->{data}{version} || '';
      if ( $version =~ /_/ ) {
        return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
        $self->_error( "'$value' for '$key' is invalid for version '$version'" );
      }
      else {
        return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
        $self->_error( "'$value' for '$key' is invalid" );
      }
    }
    else {
      $self->_error( "'$key' is not defined" );
    }
    return 0;
  }
  
  # _uri_split taken from URI::Split by Gisle Aas, Copyright 2003
  sub _uri_split {
       return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
  }
  
  sub url {
      my ($self,$key,$value) = @_;
      if(defined $value) {
        my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
        unless ( defined $scheme && length $scheme ) {
          $self->_error( "'$value' for '$key' does not have a URL scheme" );
          return 0;
        }
        unless ( defined $auth && length $auth ) {
          $self->_error( "'$value' for '$key' does not have a URL authority" );
          return 0;
        }
        return 1;
      }
      $value ||= '';
      $self->_error( "'$value' for '$key' is not a valid URL." );
      return 0;
  }
  
  sub urlspec {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value && $known_specs{$self->{spec}} eq $value);
          if($value && $known_urls{$value}) {
              $self->_error( 'META specification URL does not match version' );
              return 0;
          }
      }
      $self->_error( 'Unknown META specification' );
      return 0;
  }
  
  sub anything { return 1 }
  
  sub string {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value || $value =~ /^0$/);
      }
      $self->_error( "value is an undefined string" );
      return 0;
  }
  
  sub string_or_undef {
      my ($self,$key,$value) = @_;
      return 1    unless(defined $value);
      return 1    if($value || $value =~ /^0$/);
      $self->_error( "No string defined for '$key'" );
      return 0;
  }
  
  sub file {
      my ($self,$key,$value) = @_;
      return 1    if(defined $value);
      $self->_error( "No file defined for '$key'" );
      return 0;
  }
  
  sub exversion {
      my ($self,$key,$value) = @_;
      if(defined $value && ($value || $value =~ /0/)) {
          my $pass = 1;
          for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
          return $pass;
      }
      $value = '<undef>'  unless(defined $value);
      $self->_error( "'$value' for '$key' is not a valid version." );
      return 0;
  }
  
  sub version {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 0    unless($value || $value =~ /0/);
          return 1    if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
      } else {
          $value = '<undef>';
      }
      $self->_error( "'$value' for '$key' is not a valid version." );
      return 0;
  }
  
  sub boolean {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value =~ /^(0|1|true|false)$/);
      } else {
          $value = '<undef>';
      }
      $self->_error( "'$value' for '$key' is not a boolean value." );
      return 0;
  }
  
  my %v1_licenses = (
      'perl'         => 'http://dev.perl.org/licenses/',
      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
      'apache'       => 'http://apache.org/licenses/LICENSE-2.0',
      'artistic'     => 'http://opensource.org/licenses/artistic-license.php',
      'artistic_2'   => 'http://opensource.org/licenses/artistic-license-2.0.php',
      'lgpl'         => 'http://www.opensource.org/licenses/lgpl-license.php',
      'bsd'          => 'http://www.opensource.org/licenses/bsd-license.php',
      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
      'mit'          => 'http://opensource.org/licenses/mit-license.php',
      'mozilla'      => 'http://opensource.org/licenses/mozilla1.1.php',
      'open_source'  => undef,
      'unrestricted' => undef,
      'restrictive'  => undef,
      'unknown'      => undef,
  );
  
  my %v2_licenses = map { $_ => 1 } qw(
    agpl_3
    apache_1_1
    apache_2_0
    artistic_1
    artistic_2
    bsd
    freebsd
    gfdl_1_2
    gfdl_1_3
    gpl_1
    gpl_2
    gpl_3
    lgpl_2_1
    lgpl_3_0
    mit
    mozilla_1_0
    mozilla_1_1
    openssl
    perl_5
    qpl_1_0
    ssleay
    sun
    zlib
    open_source
    restricted
    unrestricted
    unknown
  );
  
  sub license {
      my ($self,$key,$value) = @_;
      my $licenses = $self->{spec} < 2 ? \%v1_licenses : \%v2_licenses;
      if(defined $value) {
          return 1    if($value && exists $licenses->{$value});
      } else {
          $value = '<undef>';
      }
      $self->_error( "License '$value' is invalid" );
      return 0;
  }
  
  sub custom_1 {
      my ($self,$key) = @_;
      if(defined $key) {
          # a valid user defined key should be alphabetic
          # and contain at least one capital case letter.
          return 1    if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/);
      } else {
          $key = '<undef>';
      }
      $self->_error( "Custom resource '$key' must be in CamelCase." );
      return 0;
  }
  
  sub custom_2 {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^x_/i);  # user defined
      } else {
          $key = '<undef>';
      }
      $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." );
      return 0;
  }
  
  sub identifier {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^([a-z][_a-z]+)$/i);    # spec 2.0 defined
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal identifier." );
      return 0;
  }
  
  sub module {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal module name." );
      return 0;
  }
  
  my @valid_phases = qw/ configure build test runtime develop /;
  sub phase {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1 if( length $key && grep { $key eq $_ } @valid_phases );
          return 1 if $key =~ /x_/i;
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal phase." );
      return 0;
  }
  
  my @valid_relations = qw/ requires recommends suggests conflicts /;
  sub relation {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1 if( length $key && grep { $key eq $_ } @valid_relations );
          return 1 if $key =~ /x_/i;
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal prereq relationship." );
      return 0;
  }
  
  sub _error {
      my $self = shift;
      my $mess = shift;
  
      $mess .= ' ('.join(' -> ',@{$self->{stack}}).')'  if($self->{stack});
      $mess .= " [Validation: $self->{spec}]";
  
      push @{$self->{errors}}, $mess;
  }
  
  1;
  
  # ABSTRACT: validate CPAN distribution metadata structures
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::Validator - validate CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.143240
  
  =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 *
  
  =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_list custom_1 custom_2 exversion file
  identifier license module phase relation release_status string string_or_undef
  url urlspec version header check_map
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
CPAN_META_VALIDATOR

$fatpacked{"CPAN/Meta/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_YAML';
  use 5.008001; # sane UTF-8 support
  use strict;
  use warnings;
  package CPAN::Meta::YAML;
  $CPAN::Meta::YAML::VERSION = '0.011';
  BEGIN {
    $CPAN::Meta::YAML::AUTHORITY = 'cpan:ADAMK';
  }
  # git description: v1.59-TRIAL-1-g33d9cd2
  ; # original $VERSION removed by Doppelgaenger
  # XXX-INGY is 5.8.1 too old/broken for utf8?
  # XXX-XDG Lancaster consensus was that it was sufficient until
  # proven otherwise
  
  
  #####################################################################
  # The CPAN::Meta::YAML API.
  #
  # These are the currently documented API functions/methods and
  # exports:
  
  use Exporter;
  our @ISA       = qw{ Exporter  };
  our @EXPORT    = qw{ Load Dump };
  our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
  
  ###
  # Functional/Export API:
  
  sub Dump {
      return CPAN::Meta::YAML->new(@_)->_dump_string;
  }
  
  # XXX-INGY Returning last document seems a bad behavior.
  # XXX-XDG I think first would seem more natural, but I don't know
  # that it's worth changing now
  sub Load {
      my $self = CPAN::Meta::YAML->_load_string(@_);
      if ( wantarray ) {
          return @$self;
      } else {
          # To match YAML.pm, return the last document
          return $self->[-1];
      }
  }
  
  # XXX-INGY Do we really need freeze and thaw?
  # XXX-XDG I don't think so.  I'd support deprecating them.
  BEGIN {
      *freeze = \&Dump;
      *thaw   = \&Load;
  }
  
  sub DumpFile {
      my $file = shift;
      return CPAN::Meta::YAML->new(@_)->_dump_file($file);
  }
  
  sub LoadFile {
      my $file = shift;
      my $self = CPAN::Meta::YAML->_load_file($file);
      if ( wantarray ) {
          return @$self;
      } else {
          # Return only the last document to match YAML.pm,
          return $self->[-1];
      }
  }
  
  
  ###
  # Object Oriented API:
  
  # Create an empty CPAN::Meta::YAML object
  # XXX-INGY Why do we use ARRAY object?
  # NOTE: I get it now, but I think it's confusing and not needed.
  # Will change it on a branch later, for review.
  #
  # XXX-XDG I don't support changing it yet.  It's a very well-documented
  # "API" of CPAN::Meta::YAML.  I'd support deprecating it, but Adam suggested
  # we not change it until YAML.pm's own OO API is established so that
  # users only have one API change to digest, not two
  sub new {
      my $class = shift;
      bless [ @_ ], $class;
  }
  
  # XXX-INGY It probably doesn't matter, and it's probably too late to
  # change, but 'read/write' are the wrong names. Read and Write
  # are actions that take data from storage to memory
  # characters/strings. These take the data to/from storage to native
  # Perl objects, which the terms dump and load are meant. As long as
  # this is a legacy quirk to CPAN::Meta::YAML it's ok, but I'd prefer not
  # to add new {read,write}_* methods to this API.
  
  sub read_string {
      my $self = shift;
      $self->_load_string(@_);
  }
  
  sub write_string {
      my $self = shift;
      $self->_dump_string(@_);
  }
  
  sub read {
      my $self = shift;
      $self->_load_file(@_);
  }
  
  sub write {
      my $self = shift;
      $self->_dump_file(@_);
  }
  
  
  
  
  #####################################################################
  # Constants
  
  # Printed form of the unprintable characters in the lowest range
  # of ASCII characters, listed by ASCII ordinal position.
  my @UNPRINTABLE = qw(
      0    x01  x02  x03  x04  x05  x06  a
      b    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 = (
      0 => "\x00", z => "\x00", N    => "\x85",
      a => "\x07", b => "\x08", t    => "\x09",
      n => "\x0a", v => "\x0b", f    => "\x0c",
      r => "\x0d", e => "\x1b", '\\' => '\\',
  );
  
  # XXX-INGY
  # I(ngy) need to decide if these values should be quoted in
  # CPAN::Meta::YAML or not. Probably yes.
  
  # These 3 values have special meaning when unquoted and using the
  # default YAML schema. They need quotes if they are strings.
  my %QUOTE = map { $_ => 1 } qw{
      null true false
  };
  
  # 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.
  # qr/\"((?:\\.|[^\"])*)\"/
  my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
  my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
  # unquoted re gets trailing space that needs to be stripped
  my $re_capture_unquoted_key  = qr/([^:]+(?::+\S[^:]*)*)(?=\s*\:(?:\s+|$))/;
  my $re_trailing_comment      = qr/(?:\s+\#.*)?/;
  my $re_key_value_separator   = qr/\s*:(?:\s+(?:\#.*)?|$)/;
  
  
  
  
  
  #####################################################################
  # CPAN::Meta::YAML Implementation.
  #
  # These are the private methods that do all the work. They may change
  # at any time.
  
  
  ###
  # Loader functions:
  
  # Create an object from a file
  sub _load_file {
      my $class = ref $_[0] ? ref shift : shift;
  
      # Check the file
      my $file = shift or $class->_error( 'You did not specify a file name' );
      $class->_error( "File '$file' does not exist" )
          unless -e $file;
      $class->_error( "'$file' is a directory, not a file" )
          unless -f _;
      $class->_error( "Insufficient permissions to read '$file'" )
          unless -r _;
  
      # Open unbuffered with strict UTF-8 decoding and no translation layers
      open( my $fh, "<:unix:encoding(UTF-8)", $file );
      unless ( $fh ) {
          $class->_error("Failed to open file '$file': $!");
      }
  
      # flock if available (or warn if not possible for OS-specific reasons)
      if ( _can_flock() ) {
          flock( $fh, Fcntl::LOCK_SH() )
              or warn "Couldn't lock '$file' for reading: $!";
      }
  
      # slurp the contents
      my $contents = eval {
          use warnings FATAL => 'utf8';
          local $/;
          <$fh>
      };
      if ( my $err = $@ ) {
          $class->_error("Error reading from file '$file': $err");
      }
  
      # close the file (release the lock)
      unless ( close $fh ) {
          $class->_error("Failed to close file '$file': $!");
      }
  
      $class->_load_string( $contents );
  }
  
  # Create an object from a string
  sub _load_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";
          }
  
          # Check if Perl has it marked as characters, but it's internally
          # inconsistent.  E.g. maybe latin1 got read on a :utf8 layer
          if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
              die \<<'...';
  Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
  Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
  ...
          }
  
          # Ensure Unicode character semantics, even for 0x80-0xff
          utf8::upgrade($string);
  
          # Check for and strip any leading UTF-8 BOM
          $string =~ s/^\x{FEFF}//;
  
          # Check for some special cases
          return $self unless length $string;
  
          # Split the file into lines
          my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
                  split /(?:\015{1,2}\012|\015|\012)/, $string;
  
          # Strip the initial YAML header
          @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
  
          # A nibbling parser
          my $in_document = 0;
          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->_load_scalar( "$1", [ undef ], \@lines );
                      next;
                  }
                  $in_document = 1;
              }
  
              if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
                  # A naked document
                  push @$self, undef;
                  while ( @lines and $lines[0] !~ /^---/ ) {
                      shift @lines;
                  }
                  $in_document = 0;
  
              # XXX The final '-+$' is to look for -- which ends up being an
              # error later.
              } elsif ( ! $in_document && @$self ) {
                  # only the first document can be explicit
                  die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
              } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
                  # An array at the root
                  my $document = [ ];
                  push @$self, $document;
                  $self->_load_array( $document, [ 0 ], \@lines );
  
              } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
                  # A hash at the root
                  my $document = { };
                  push @$self, $document;
                  $self->_load_hash( $document, [ length($1) ], \@lines );
  
              } else {
                  # Shouldn't get here.  @lines have whitespace-only lines
                  # stripped, and previous match is a line with any
                  # non-whitespace.  So this clause should only be reachable via
                  # a perlbug where \s is not symmetric with \S
  
                  # uncoverable statement
                  die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
              }
          }
      };
      if ( ref $@ eq 'SCALAR' ) {
          $self->_error(${$@});
      } elsif ( $@ ) {
          $self->_error($@);
      }
  
      return $self;
  }
  
  sub _unquote_single {
      my ($self, $string) = @_;
      return '' unless length $string;
      $string =~ s/\'\'/\'/g;
      return $string;
  }
  
  sub _unquote_double {
      my ($self, $string) = @_;
      return '' unless length $string;
      $string =~ s/\\"/"/g;
      $string =~
          s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
           {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
      return $string;
  }
  
  # Load a YAML scalar string to the actual Perl scalar
  sub _load_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 =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
          return $self->_unquote_single($1);
      }
  
      # Double quote.
      if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
          return $self->_unquote_double($1);
      }
  
      # 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 !~ /^[>|]/ ) {
          die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'"
              if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
                  $string =~ /:(?:\s|$)/;
          $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;
  }
  
  # Load an array
  sub _load_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->_load_hash( $array->[-1], [ @$indent, $indent2 ], $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->_load_array(
                          $array->[-1], [ @$indent, $indent2 ], $lines
                      );
                  }
  
              } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
                  push @$array, { };
                  $self->_load_hash(
                      $array->[-1], [ @$indent, length("$1") ], $lines
                  );
  
              } else {
                  die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
              }
  
          } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
              # Array entry with a value
              shift @$lines;
              push @$array, $self->_load_scalar(
                  "$2", [ @$indent, undef ], $lines
              );
  
          } 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;
  }
  
  # Load a hash
  sub _load_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]'";
          }
  
          # Find the key
          my $key;
  
          # Quoted keys
          if ( $lines->[0] =~
              s/^\s*$re_capture_single_quoted$re_key_value_separator//
          ) {
              $key = $self->_unquote_single($1);
          }
          elsif ( $lines->[0] =~
              s/^\s*$re_capture_double_quoted$re_key_value_separator//
          ) {
              $key = $self->_unquote_double($1);
          }
          elsif ( $lines->[0] =~
              s/^\s*$re_capture_unquoted_key$re_key_value_separator//
          ) {
              $key = $1;
              $key =~ s/\s+$//;
          }
          elsif ( $lines->[0] =~ /^\s*\?/ ) {
              die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
          }
          else {
              die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
          }
  
          # Do we have a value?
          if ( length $lines->[0] ) {
              # Yes
              $hash->{$key} = $self->_load_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->_load_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->_load_hash(
                          $hash->{$key}, [ @$indent, length($1) ], $lines
                      );
                  }
              }
          }
      }
  
      return 1;
  }
  
  
  ###
  # Dumper functions:
  
  # Save an object to a file
  sub _dump_file {
      my $self = shift;
  
      require Fcntl;
  
      # Check the file
      my $file = shift or $self->_error( 'You did not specify a file name' );
  
      my $fh;
      # flock if available (or warn if not possible for OS-specific reasons)
      if ( _can_flock() ) {
          # Open without truncation (truncate comes after lock)
          my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
          sysopen( $fh, $file, $flags );
          unless ( $fh ) {
              $self->_error("Failed to open file '$file' for writing: $!");
          }
  
          # Use no translation and strict UTF-8
          binmode( $fh, ":raw:encoding(UTF-8)");
  
          flock( $fh, Fcntl::LOCK_EX() )
              or warn "Couldn't lock '$file' for reading: $!";
  
          # truncate and spew contents
          truncate $fh, 0;
          seek $fh, 0, 0;
      }
      else {
          open $fh, ">:unix:encoding(UTF-8)", $file;
      }
  
      # serialize and spew to the handle
      print {$fh} $self->_dump_string;
  
      # close the file (release the lock)
      unless ( close $fh ) {
          $self->_error("Failed to close file '$file': $!");
      }
  
      return 1;
  }
  
  # Save an object to a string
  sub _dump_string {
      my $self = shift;
      return '' unless ref $self && @$self;
  
      # Iterate over the documents
      my $indent = 0;
      my @lines  = ();
  
      eval {
          foreach my $cursor ( @$self ) {
              push @lines, '---';
  
              # An empty document
              if ( ! defined $cursor ) {
                  # Do nothing
  
              # A scalar document
              } elsif ( ! ref $cursor ) {
                  $lines[-1] .= ' ' . $self->_dump_scalar( $cursor );
  
              # A list at the root
              } elsif ( ref $cursor eq 'ARRAY' ) {
                  unless ( @$cursor ) {
                      $lines[-1] .= ' []';
                      next;
                  }
                  push @lines, $self->_dump_array( $cursor, $indent, {} );
  
              # A hash at the root
              } elsif ( ref $cursor eq 'HASH' ) {
                  unless ( %$cursor ) {
                      $lines[-1] .= ' {}';
                      next;
                  }
                  push @lines, $self->_dump_hash( $cursor, $indent, {} );
  
              } else {
                  die \("Cannot serialize " . ref($cursor));
              }
          }
      };
      if ( ref $@ eq 'SCALAR' ) {
          $self->_error(${$@});
      } elsif ( $@ ) {
          $self->_error($@);
      }
  
      join '', map { "$_\n" } @lines;
  }
  
  sub _has_internal_string_value {
      my $value = shift;
      my $b_obj = B::svref_2object(\$value);  # for round trip problem
      return $b_obj->FLAGS & B::SVf_POK();
  }
  
  sub _dump_scalar {
      my $string = $_[1];
      my $is_key = $_[2];
      # Check this before checking length or it winds up looking like a string!
      my $has_string_flag = _has_internal_string_value($string);
      return '~'  unless defined $string;
      return "''" unless length  $string;
      if (Scalar::Util::looks_like_number($string)) {
          # keys and values that have been used as strings get quoted
          if ( $is_key || $has_string_flag ) {
              return qq['$string'];
          }
          else {
              return $string;
          }
      }
      if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) {
          $string =~ s/\\/\\\\/g;
          $string =~ s/"/\\"/g;
          $string =~ s/\n/\\n/g;
          $string =~ s/[\x85]/\\N/g;
          $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
          $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;
          return qq|"$string"|;
      }
      if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or
          $QUOTE{$string}
      ) {
          return "'$string'";
      }
      return $string;
  }
  
  sub _dump_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->_dump_scalar( $el );
              push @lines, $line;
  
          } elsif ( $type eq 'ARRAY' ) {
              if ( @$el ) {
                  push @lines, $line;
                  push @lines, $self->_dump_array( $el, $indent + 1, $seen );
              } else {
                  $line .= ' []';
                  push @lines, $line;
              }
  
          } elsif ( $type eq 'HASH' ) {
              if ( keys %$el ) {
                  push @lines, $line;
                  push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
              } else {
                  $line .= ' {}';
                  push @lines, $line;
              }
  
          } else {
              die \"CPAN::Meta::YAML does not support $type references";
          }
      }
  
      @lines;
  }
  
  sub _dump_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) . $self->_dump_scalar($name, 1) . ":";
          my $type = ref $el;
          if ( ! $type ) {
              $line .= ' ' . $self->_dump_scalar( $el );
              push @lines, $line;
  
          } elsif ( $type eq 'ARRAY' ) {
              if ( @$el ) {
                  push @lines, $line;
                  push @lines, $self->_dump_array( $el, $indent + 1, $seen );
              } else {
                  $line .= ' []';
                  push @lines, $line;
              }
  
          } elsif ( $type eq 'HASH' ) {
              if ( keys %$el ) {
                  push @lines, $line;
                  push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
              } else {
                  $line .= ' {}';
                  push @lines, $line;
              }
  
          } else {
              die \"CPAN::Meta::YAML does not support $type references";
          }
      }
  
      @lines;
  }
  
  
  
  #####################################################################
  # DEPRECATED API methods:
  
  # Error storage (DEPRECATED as of 1.57)
  our $errstr    = '';
  
  # Set error
  sub _error {
      require Carp;
      $errstr = $_[1];
      $errstr =~ s/ at \S+ line \d+.*//;
      Carp::croak( $errstr );
  }
  
  # Retrieve error
  my $errstr_warned;
  sub errstr {
      require Carp;
      Carp::carp( "CPAN::Meta::YAML->errstr and \$CPAN::Meta::YAML::errstr is deprecated" )
          unless $errstr_warned++;
      $errstr;
  }
  
  
  
  
  #####################################################################
  # Helper functions. Possibly not needed.
  
  
  # Use to detect nv or iv
  use B;
  
  # XXX-INGY Is flock CPAN::Meta::YAML's responsibility?
  # Some platforms can't flock :-(
  # XXX-XDG I think it is.  When reading and writing files, we ought
  # to be locking whenever possible.  People (foolishly) use YAML
  # files for things like session storage, which has race issues.
  my $HAS_FLOCK;
  sub _can_flock {
      if ( defined $HAS_FLOCK ) {
          return $HAS_FLOCK;
      }
      else {
          require Config;
          my $c = \%Config::Config;
          $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/;
          require Fcntl if $HAS_FLOCK;
          return $HAS_FLOCK;
      }
  }
  
  
  # XXX-INGY Is this core in 5.8.1? Can we remove this?
  # XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this
  #####################################################################
  # Use Scalar::Util if possible, otherwise emulate it
  
  BEGIN {
      local $@;
      if ( eval { require Scalar::Util }
        && $Scalar::Util::VERSION
        && eval($Scalar::Util::VERSION) >= 1.18
      ) {
          *refaddr = *Scalar::Util::refaddr;
      }
      else {
          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 { no warnings 'portable'; hex $1 };
      bless $_[0], $pkg if defined $pkg;
      $i;
  }
  END_PERL
      }
  }
  
  
  
  
  1;
  
  # XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong
  # but leaving grey area stuff up here.
  #
  # I would like to change Read/Write to Load/Dump below without
  # changing the actual API names.
  #
  # It might be better to put Load/Dump API in the SYNOPSIS instead of the
  # dubious OO API.
  #
  # null and bool explanations may be outdated.
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  CPAN::Meta::YAML - Read and write a subset of YAML for CPAN Meta files
  
  =head1 VERSION
  
  version 0.011
  
  =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<https://rt.cpan.org/Public/Dist/Display.html?Name=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<https://github.com/dagolden/CPAN-Meta-YAML/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-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{"Capture/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CAPTURE_TINY';
  use 5.006;
  use strict;
  use warnings;
  package Capture::Tiny;
  # ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs
  our $VERSION = '0.48';
  use Carp ();
  use Exporter ();
  use IO::Handle ();
  use File::Spec ();
  use File::Temp qw/tempfile tmpnam/;
  use Scalar::Util qw/reftype blessed/;
  # Get PerlIO or fake it
  BEGIN {
    local $@;
    eval { require PerlIO; PerlIO->can('get_layers') }
      or *PerlIO::get_layers = sub { return () };
  }
  
  #--------------------------------------------------------------------------#
  # create API subroutines and export them
  # [do STDOUT flag, do STDERR flag, do merge flag, do tee flag]
  #--------------------------------------------------------------------------#
  
  my %api = (
    capture         => [1,1,0,0],
    capture_stdout  => [1,0,0,0],
    capture_stderr  => [0,1,0,0],
    capture_merged  => [1,1,1,0],
    tee             => [1,1,0,1],
    tee_stdout      => [1,0,0,1],
    tee_stderr      => [0,1,0,1],
    tee_merged      => [1,1,1,1],
  );
  
  for my $sub ( keys %api ) {
    my $args = join q{, }, @{$api{$sub}};
    eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
  }
  
  our @ISA = qw/Exporter/;
  our @EXPORT_OK = keys %api;
  our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
  
  #--------------------------------------------------------------------------#
  # constants and fixtures
  #--------------------------------------------------------------------------#
  
  my $IS_WIN32 = $^O eq 'MSWin32';
  
  ##our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
  ##
  ##my $DEBUGFH;
  ##open $DEBUGFH, "> DEBUG" if $DEBUG;
  ##
  ##*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
  
  our $TIMEOUT = 30;
  
  #--------------------------------------------------------------------------#
  # command to tee output -- the argument is a filename that must
  # be opened to signal that the process is ready to receive input.
  # This is annoying, but seems to be the best that can be done
  # as a simple, portable IPC technique
  #--------------------------------------------------------------------------#
  my @cmd = ($^X, '-C0', '-e', <<'HERE');
  use Fcntl;
  $SIG{HUP}=sub{exit};
  if ( my $fn=shift ) {
      sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!;
      print {$fh} $$;
      close $fh;
  }
  my $buf; while (sysread(STDIN, $buf, 2048)) {
      syswrite(STDOUT, $buf); syswrite(STDERR, $buf);
  }
  HERE
  
  #--------------------------------------------------------------------------#
  # filehandle manipulation
  #--------------------------------------------------------------------------#
  
  sub _relayer {
    my ($fh, $apply_layers) = @_;
    # _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
  
    # eliminate pseudo-layers
    binmode( $fh, ":raw" );
    # strip off real layers until only :unix is left
    while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
        binmode( $fh, ":pop" );
    }
    # apply other layers
    my @to_apply = @$apply_layers;
    shift @to_apply; # eliminate initial :unix
    # _debug("# applying layers  (unix @to_apply) to @{[fileno $fh]}\n");
    binmode($fh, ":" . join(":",@to_apply));
  }
  
  sub _name {
    my $glob = shift;
    no strict 'refs'; ## no critic
    return *{$glob}{NAME};
  }
  
  sub _open {
    open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
    # _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
  }
  
  sub _close {
    # _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' )  . " on " . fileno( $_[0] ) . "\n" );
    close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
  }
  
  my %dup; # cache this so STDIN stays fd0
  my %proxy_count;
  sub _proxy_std {
    my %proxies;
    if ( ! defined fileno STDIN ) {
      $proxy_count{stdin}++;
      if (defined $dup{stdin}) {
        _open \*STDIN, "<&=" . fileno($dup{stdin});
        # _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
      }
      else {
        _open \*STDIN, "<" . File::Spec->devnull;
        # _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
        _open $dup{stdin} = IO::Handle->new, "<&=STDIN";
      }
      $proxies{stdin} = \*STDIN;
      binmode(STDIN, ':utf8') if $] >= 5.008; ## no critic
    }
    if ( ! defined fileno STDOUT ) {
      $proxy_count{stdout}++;
      if (defined $dup{stdout}) {
        _open \*STDOUT, ">&=" . fileno($dup{stdout});
        # _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
      }
      else {
        _open \*STDOUT, ">" . File::Spec->devnull;
         # _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
        _open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
      }
      $proxies{stdout} = \*STDOUT;
      binmode(STDOUT, ':utf8') if $] >= 5.008; ## no critic
    }
    if ( ! defined fileno STDERR ) {
      $proxy_count{stderr}++;
      if (defined $dup{stderr}) {
        _open \*STDERR, ">&=" . fileno($dup{stderr});
         # _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
      }
      else {
        _open \*STDERR, ">" . File::Spec->devnull;
         # _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
        _open $dup{stderr} = IO::Handle->new, ">&=STDERR";
      }
      $proxies{stderr} = \*STDERR;
      binmode(STDERR, ':utf8') if $] >= 5.008; ## no critic
    }
    return %proxies;
  }
  
  sub _unproxy {
    my (%proxies) = @_;
    # _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
    for my $p ( keys %proxies ) {
      $proxy_count{$p}--;
      # _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
      if ( ! $proxy_count{$p} ) {
        _close $proxies{$p};
        _close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
        delete $dup{$p};
      }
    }
  }
  
  sub _copy_std {
    my %handles;
    for my $h ( qw/stdout stderr stdin/ ) {
      next if $h eq 'stdin' && ! $IS_WIN32; # WIN32 hangs on tee without STDIN copied
      my $redir = $h eq 'stdin' ? "<&" : ">&";
      _open $handles{$h} = IO::Handle->new(), $redir . uc($h); # ">&STDOUT" or "<&STDIN"
    }
    return \%handles;
  }
  
  # In some cases we open all (prior to forking) and in others we only open
  # the output handles (setting up redirection)
  sub _open_std {
    my ($handles) = @_;
    _open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin};
    _open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout};
    _open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr};
  }
  
  #--------------------------------------------------------------------------#
  # private subs
  #--------------------------------------------------------------------------#
  
  sub _start_tee {
    my ($which, $stash) = @_; # $which is "stdout" or "stderr"
    # setup pipes
    $stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
    pipe $stash->{reader}{$which}, $stash->{tee}{$which};
    # _debug( "# pipe for $which\: " .  _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
    select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
    # setup desired redirection for parent and child
    $stash->{new}{$which} = $stash->{tee}{$which};
    $stash->{child}{$which} = {
      stdin   => $stash->{reader}{$which},
      stdout  => $stash->{old}{$which},
      stderr  => $stash->{capture}{$which},
    };
    # flag file is used to signal the child is ready
    $stash->{flag_files}{$which} = scalar( tmpnam() ) . $$;
    # execute @cmd as a separate process
    if ( $IS_WIN32 ) {
      my $old_eval_err=$@;
      undef $@;
  
      eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
      # _debug( "# Win32API::File loaded\n") unless $@;
      my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
      # _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE();
      my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
      # _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n"));
      _open_std( $stash->{child}{$which} );
      $stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
      # not restoring std here as it all gets redirected again shortly anyway
      $@=$old_eval_err;
    }
    else { # use fork
      _fork_exec( $which, $stash );
    }
  }
  
  sub _fork_exec {
    my ($which, $stash) = @_; # $which is "stdout" or "stderr"
    my $pid = fork;
    if ( not defined $pid ) {
      Carp::confess "Couldn't fork(): $!";
    }
    elsif ($pid == 0) { # child
      # _debug( "# in child process ...\n" );
      untie *STDIN; untie *STDOUT; untie *STDERR;
      _close $stash->{tee}{$which};
      # _debug( "# redirecting handles in child ...\n" );
      _open_std( $stash->{child}{$which} );
      # _debug( "# calling exec on command ...\n" );
      exec @cmd, $stash->{flag_files}{$which};
    }
    $stash->{pid}{$which} = $pid
  }
  
  my $have_usleep = eval "use Time::HiRes 'usleep'; 1";
  sub _files_exist {
    return 1 if @_ == grep { -f } @_;
    Time::HiRes::usleep(1000) if $have_usleep;
    return 0;
  }
  
  sub _wait_for_tees {
    my ($stash) = @_;
    my $start = time;
    my @files = values %{$stash->{flag_files}};
    my $timeout = defined $ENV{PERL_CAPTURE_TINY_TIMEOUT}
                ? $ENV{PERL_CAPTURE_TINY_TIMEOUT} : $TIMEOUT;
    1 until _files_exist(@files) || ($timeout && (time - $start > $timeout));
    Carp::confess "Timed out waiting for subprocesses to start" if ! _files_exist(@files);
    unlink $_ for @files;
  }
  
  sub _kill_tees {
    my ($stash) = @_;
    if ( $IS_WIN32 ) {
      # _debug( "# closing handles\n");
      close($_) for values %{ $stash->{tee} };
      # _debug( "# waiting for subprocesses to finish\n");
      my $start = time;
      1 until wait == -1 || (time - $start > 30);
    }
    else {
      _close $_ for values %{ $stash->{tee} };
      waitpid $_, 0 for values %{ $stash->{pid} };
    }
  }
  
  sub _slurp {
    my ($name, $stash) = @_;
    my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
    # _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
    seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
    my $text = do { local $/; scalar readline $fh };
    return defined($text) ? $text : "";
  }
  
  #--------------------------------------------------------------------------#
  # _capture_tee() -- generic main sub for capturing or teeing
  #--------------------------------------------------------------------------#
  
  sub _capture_tee {
    # _debug( "# starting _capture_tee with (@_)...\n" );
    my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
    my %do = ($do_stdout ? (stdout => 1) : (),  $do_stderr ? (stderr => 1) : ());
    Carp::confess("Custom capture options must be given as key/value pairs\n")
      unless @opts % 2 == 0;
    my $stash = { capture => { @opts } };
    for ( keys %{$stash->{capture}} ) {
      my $fh = $stash->{capture}{$_};
      Carp::confess "Custom handle for $_ must be seekable\n"
        unless ref($fh) eq 'GLOB' || (blessed($fh) && $fh->isa("IO::Seekable"));
    }
    # save existing filehandles and setup captures
    local *CT_ORIG_STDIN  = *STDIN ;
    local *CT_ORIG_STDOUT = *STDOUT;
    local *CT_ORIG_STDERR = *STDERR;
    # find initial layers
    my %layers = (
      stdin   => [PerlIO::get_layers(\*STDIN) ],
      stdout  => [PerlIO::get_layers(\*STDOUT, output => 1)],
      stderr  => [PerlIO::get_layers(\*STDERR, output => 1)],
    );
    # _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
    # get layers from underlying glob of tied filehandles if we can
    # (this only works for things that work like Tie::StdHandle)
    $layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
      if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
    $layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
      if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
    # _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
    # bypass scalar filehandles and tied handles
    # localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
    my %localize;
    $localize{stdin}++,  local(*STDIN)
      if grep { $_ eq 'scalar' } @{$layers{stdin}};
    $localize{stdout}++, local(*STDOUT)
      if $do_stdout && grep { $_ eq 'scalar' } @{$layers{stdout}};
    $localize{stderr}++, local(*STDERR)
      if ($do_stderr || $do_merge) && grep { $_ eq 'scalar' } @{$layers{stderr}};
    $localize{stdin}++, local(*STDIN), _open( \*STDIN, "<&=0")
      if tied *STDIN && $] >= 5.008;
    $localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
      if $do_stdout && tied *STDOUT && $] >= 5.008;
    $localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
      if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
    # _debug( "# localized $_\n" ) for keys %localize;
    # proxy any closed/localized handles so we don't use fds 0, 1 or 2
    my %proxy_std = _proxy_std();
    # _debug( "# proxy std: @{ [%proxy_std] }\n" );
    # update layers after any proxying
    $layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
    $layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
    # _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
    # store old handles and setup handles for capture
    $stash->{old} = _copy_std();
    $stash->{new} = { %{$stash->{old}} }; # default to originals
    for ( keys %do ) {
      $stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
      seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
      $stash->{pos}{$_} = tell $stash->{capture}{$_};
      # _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
      _start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
    }
    _wait_for_tees( $stash ) if $do_tee;
    # finalize redirection
    $stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
    # _debug( "# redirecting in parent ...\n" );
    _open_std( $stash->{new} );
    # execute user provided code
    my ($exit_code, $inner_error, $outer_error, $orig_pid, @result);
    {
      $orig_pid = $$;
      local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
      # _debug( "# finalizing layers ...\n" );
      _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
      _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
      # _debug( "# running code $code ...\n" );
      my $old_eval_err=$@;
      undef $@;
      eval { @result = $code->(); $inner_error = $@ };
      $exit_code = $?; # save this for later
      $outer_error = $@; # save this for later
      STDOUT->flush if $do_stdout;
      STDERR->flush if $do_stderr;
      $@ = $old_eval_err;
    }
    # restore prior filehandles and shut down tees
    # _debug( "# restoring filehandles ...\n" );
    _open_std( $stash->{old} );
    _close( $_ ) for values %{$stash->{old}}; # don't leak fds
    # shouldn't need relayering originals, but see rt.perl.org #114404
    _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
    _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
    _unproxy( %proxy_std );
    # _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
    _kill_tees( $stash ) if $do_tee;
    # return captured output, but shortcut in void context
    # unless we have to echo output to tied/scalar handles;
    my %got;
    if ( $orig_pid == $$ and ( defined wantarray or ($do_tee && keys %localize) ) ) {
      for ( keys %do ) {
        _relayer($stash->{capture}{$_}, $layers{$_});
        $got{$_} = _slurp($_, $stash);
        # _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
      }
      print CT_ORIG_STDOUT $got{stdout}
        if $do_stdout && $do_tee && $localize{stdout};
      print CT_ORIG_STDERR $got{stderr}
        if $do_stderr && $do_tee && $localize{stderr};
    }
    $? = $exit_code;
    $@ = $inner_error if $inner_error;
    die $outer_error if $outer_error;
    # _debug( "# ending _capture_tee with (@_)...\n" );
    return unless defined wantarray;
    my @return;
    push @return, $got{stdout} if $do_stdout;
    push @return, $got{stderr} if $do_stderr && ! $do_merge;
    push @return, @result;
    return wantarray ? @return : $return[0];
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Capture::Tiny - Capture STDOUT and STDERR from Perl, XS or external programs
  
  =head1 VERSION
  
  version 0.48
  
  =head1 SYNOPSIS
  
    use Capture::Tiny ':all';
  
    # capture from external command
  
    ($stdout, $stderr, $exit) = capture {
      system( $cmd, @args );
    };
  
    # capture from arbitrary code (Perl or external)
  
    ($stdout, $stderr, @result) = capture {
      # your code here
    };
  
    # capture partial or merged output
  
    $stdout = capture_stdout { ... };
    $stderr = capture_stderr { ... };
    $merged = capture_merged { ... };
  
    # tee output
  
    ($stdout, $stderr) = tee {
      # your code here
    };
  
    $stdout = tee_stdout { ... };
    $stderr = tee_stderr { ... };
    $merged = tee_merged { ... };
  
  =head1 DESCRIPTION
  
  Capture::Tiny provides a simple, portable way to capture almost anything sent
  to STDOUT or STDERR, regardless of whether it comes from Perl, from XS code or
  from an external program.  Optionally, output can be teed so that it is
  captured while being passed through to the original filehandles.  Yes, it even
  works on Windows (usually).  Stop guessing which of a dozen capturing modules
  to use in any particular situation and just use this one.
  
  =head1 USAGE
  
  The following functions are available.  None are exported by default.
  
  =head2 capture
  
    ($stdout, $stderr, @result) = capture \&code;
    $stdout = capture \&code;
  
  The C<capture> function takes a code reference and returns what is sent to
  STDOUT and STDERR as well as any return values from the code reference.  In
  scalar context, it returns only STDOUT.  If no output was received for a
  filehandle, it returns an empty string for that filehandle.  Regardless of calling
  context, all output is captured -- nothing is passed to the existing filehandles.
  
  It is prototyped to take a subroutine reference as an argument. Thus, it
  can be called in block form:
  
    ($stdout, $stderr) = capture {
      # your code here ...
    };
  
  Note that the coderef is evaluated in list context.  If you wish to force
  scalar context on the return value, you must use the C<scalar> keyword.
  
    ($stdout, $stderr, $count) = capture {
      my @list = qw/one two three/;
      return scalar @list; # $count will be 3
    };
  
  Also note that within the coderef, the C<@_> variable will be empty.  So don't
  use arguments from a surrounding subroutine without copying them to an array
  first:
  
    sub wont_work {
      my ($stdout, $stderr) = capture { do_stuff( @_ ) };    # WRONG
      ...
    }
  
    sub will_work {
      my @args = @_;
      my ($stdout, $stderr) = capture { do_stuff( @args ) }; # RIGHT
      ...
    }
  
  Captures are normally done to an anonymous temporary filehandle.  To
  capture via a named file (e.g. to externally monitor a long-running capture),
  provide custom filehandles as a trailing list of option pairs:
  
    my $out_fh = IO::File->new("out.txt", "w+");
    my $err_fh = IO::File->new("out.txt", "w+");
    capture { ... } stdout => $out_fh, stderr => $err_fh;
  
  The filehandles must be read/write and seekable.  Modifying the files or
  filehandles during a capture operation will give unpredictable results.
  Existing IO layers on them may be changed by the capture.
  
  When called in void context, C<capture> saves memory and time by
  not reading back from the capture handles.
  
  =head2 capture_stdout
  
    ($stdout, @result) = capture_stdout \&code;
    $stdout = capture_stdout \&code;
  
  The C<capture_stdout> function works just like C<capture> except only
  STDOUT is captured.  STDERR is not captured.
  
  =head2 capture_stderr
  
    ($stderr, @result) = capture_stderr \&code;
    $stderr = capture_stderr \&code;
  
  The C<capture_stderr> function works just like C<capture> except only
  STDERR is captured.  STDOUT is not captured.
  
  =head2 capture_merged
  
    ($merged, @result) = capture_merged \&code;
    $merged = capture_merged \&code;
  
  The C<capture_merged> function works just like C<capture> except STDOUT and
  STDERR are merged. (Technically, STDERR is redirected to the same capturing
  handle as STDOUT before executing the function.)
  
  Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
  properly ordered due to buffering.
  
  =head2 tee
  
    ($stdout, $stderr, @result) = tee \&code;
    $stdout = tee \&code;
  
  The C<tee> function works just like C<capture>, except that output is captured
  as well as passed on to the original STDOUT and STDERR.
  
  When called in void context, C<tee> saves memory and time by
  not reading back from the capture handles, except when the
  original STDOUT OR STDERR were tied or opened to a scalar
  handle.
  
  =head2 tee_stdout
  
    ($stdout, @result) = tee_stdout \&code;
    $stdout = tee_stdout \&code;
  
  The C<tee_stdout> function works just like C<tee> except only
  STDOUT is teed.  STDERR is not teed (output goes to STDERR as usual).
  
  =head2 tee_stderr
  
    ($stderr, @result) = tee_stderr \&code;
    $stderr = tee_stderr \&code;
  
  The C<tee_stderr> function works just like C<tee> except only
  STDERR is teed.  STDOUT is not teed (output goes to STDOUT as usual).
  
  =head2 tee_merged
  
    ($merged, @result) = tee_merged \&code;
    $merged = tee_merged \&code;
  
  The C<tee_merged> function works just like C<capture_merged> except that output
  is captured as well as passed on to STDOUT.
  
  Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
  properly ordered due to buffering.
  
  =head1 LIMITATIONS
  
  =head2 Portability
  
  Portability is a goal, not a guarantee.  C<tee> requires fork, except on
  Windows where C<system(1, @cmd)> is used instead.  Not tested on any
  particularly esoteric platforms yet.  See the
  L<CPAN Testers Matrix|http://matrix.cpantesters.org/?dist=Capture-Tiny>
  for test result by platform.
  
  =head2 PerlIO layers
  
  Capture::Tiny does its best to preserve PerlIO layers such as ':utf8' or
  ':crlf' when capturing (only for Perl 5.8.1+) .  Layers should be applied to
  STDOUT or STDERR I<before> the call to C<capture> or C<tee>.  This may not work
  for tied filehandles (see below).
  
  =head2 Modifying filehandles before capturing
  
  Generally speaking, you should do little or no manipulation of the standard IO
  filehandles prior to using Capture::Tiny.  In particular, closing, reopening,
  localizing or tying standard filehandles prior to capture may cause a variety of
  unexpected, undesirable and/or unreliable behaviors, as described below.
  Capture::Tiny does its best to compensate for these situations, but the
  results may not be what you desire.
  
  =head3 Closed filehandles
  
  Capture::Tiny will work even if STDIN, STDOUT or STDERR have been previously
  closed.  However, since they will be reopened to capture or tee output, any
  code within the captured block that depends on finding them closed will, of
  course, not find them to be closed.  If they started closed, Capture::Tiny will
  close them again when the capture block finishes.
  
  Note that this reopening will happen even for STDIN or a filehandle not being
  captured to ensure that the filehandle used for capture is not opened to file
  descriptor 0, as this causes problems on various platforms.
  
  Prior to Perl 5.12, closed STDIN combined with PERL_UNICODE=D leaks filehandles
  and also breaks tee() for undiagnosed reasons.  So don't do that.
  
  =head3 Localized filehandles
  
  If code localizes any of Perl's standard filehandles before capturing, the capture
  will affect the localized filehandles and not the original ones.  External system
  calls are not affected by localizing a filehandle in Perl and will continue
  to send output to the original filehandles (which will thus not be captured).
  
  =head3 Scalar filehandles
  
  If STDOUT or STDERR are reopened to scalar filehandles prior to the call to
  C<capture> or C<tee>, then Capture::Tiny will override the output filehandle for
  the duration of the C<capture> or C<tee> call and then, for C<tee>, send captured
  output to the output filehandle after the capture is complete.  (Requires Perl
  5.8)
  
  Capture::Tiny attempts to preserve the semantics of STDIN opened to a scalar
  reference, but note that external processes will not be able to read from such
  a handle.  Capture::Tiny tries to ensure that external processes will read from
  the null device instead, but this is not guaranteed.
  
  =head3 Tied output filehandles
  
  If STDOUT or STDERR are tied prior to the call to C<capture> or C<tee>, then
  Capture::Tiny will attempt to override the tie for the duration of the
  C<capture> or C<tee> call and then send captured output to the tied filehandle after
  the capture is complete.  (Requires Perl 5.8)
  
  Capture::Tiny may not succeed resending UTF-8 encoded data to a tied
  STDOUT or STDERR filehandle.  Characters may appear as bytes.  If the tied filehandle
  is based on L<Tie::StdHandle>, then Capture::Tiny will attempt to determine
  appropriate layers like C<:utf8> from the underlying filehandle and do the right
  thing.
  
  =head3 Tied input filehandle
  
  Capture::Tiny attempts to preserve the semantics of tied STDIN, but this
  requires Perl 5.8 and is not entirely predictable.  External processes
  will not be able to read from such a handle.
  
  Unless having STDIN tied is crucial, it may be safest to localize STDIN when
  capturing:
  
    my ($out, $err) = do { local *STDIN; capture { ... } };
  
  =head2 Modifying filehandles during a capture
  
  Attempting to modify STDIN, STDOUT or STDERR I<during> C<capture> or C<tee> is
  almost certainly going to cause problems.  Don't do that.
  
  =head3 Forking inside a capture
  
  Forks aren't portable.  The behavior of filehandles during a fork is even
  less so.  If Capture::Tiny detects that a fork has occurred within a
  capture, it will shortcut in the child process and return empty strings for
  captures.  Other problems may occur in the child or parent, as well.
  Forking in a capture block is not recommended.
  
  =head3 Using threads
  
  Filehandles are global.  Mixing up I/O and captures in different threads
  without coordination is going to cause problems.  Besides, threads are
  officially discouraged.
  
  =head3 Dropping privileges during a capture
  
  If you drop privileges during a capture, temporary files created to
  facilitate the capture may not be cleaned up afterwards.
  
  =head2 No support for Perl 5.8.0
  
  It's just too buggy when it comes to layers and UTF-8.  Perl 5.8.1 or later
  is recommended.
  
  =head2 Limited support for Perl 5.6
  
  Perl 5.6 predates PerlIO.  UTF-8 data may not be captured correctly.
  
  =head1 ENVIRONMENT
  
  =head2 PERL_CAPTURE_TINY_TIMEOUT
  
  Capture::Tiny uses subprocesses internally for C<tee>.  By default,
  Capture::Tiny will timeout with an error if such subprocesses are not ready to
  receive data within 30 seconds (or whatever is the value of
  C<$Capture::Tiny::TIMEOUT>).  An alternate timeout may be specified by setting
  the C<PERL_CAPTURE_TINY_TIMEOUT> environment variable.  Setting it to zero will
  disable timeouts.  B<NOTE>, this does not timeout the code reference being
  captured -- this only prevents Capture::Tiny itself from hanging your process
  waiting for its child processes to be ready to proceed.
  
  =head1 SEE ALSO
  
  This module was inspired by L<IO::CaptureOutput>, which provides
  similar functionality without the ability to tee output and with more
  complicated code and API.  L<IO::CaptureOutput> does not handle layers
  or most of the unusual cases described in the L</Limitations> section and
  I no longer recommend it.
  
  There are many other CPAN modules that provide some sort of output capture,
  albeit with various limitations that make them appropriate only in particular
  circumstances.  I'm probably missing some.  The long list is provided to show
  why I felt Capture::Tiny was necessary.
  
  =over 4
  
  =item *
  
  L<IO::Capture>
  
  =item *
  
  L<IO::Capture::Extended>
  
  =item *
  
  L<IO::CaptureOutput>
  
  =item *
  
  L<IPC::Capture>
  
  =item *
  
  L<IPC::Cmd>
  
  =item *
  
  L<IPC::Open2>
  
  =item *
  
  L<IPC::Open3>
  
  =item *
  
  L<IPC::Open3::Simple>
  
  =item *
  
  L<IPC::Open3::Utils>
  
  =item *
  
  L<IPC::Run>
  
  =item *
  
  L<IPC::Run::SafeHandles>
  
  =item *
  
  L<IPC::Run::Simple>
  
  =item *
  
  L<IPC::Run3>
  
  =item *
  
  L<IPC::System::Simple>
  
  =item *
  
  L<Tee>
  
  =item *
  
  L<IO::Tee>
  
  =item *
  
  L<File::Tee>
  
  =item *
  
  L<Filter::Handle>
  
  =item *
  
  L<Tie::STDERR>
  
  =item *
  
  L<Tie::STDOUT>
  
  =item *
  
  L<Test::Output>
  
  =back
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<https://github.com/dagolden/Capture-Tiny/issues>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/dagolden/Capture-Tiny>
  
    git clone https://github.com/dagolden/Capture-Tiny.git
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 CONTRIBUTORS
  
  =for stopwords Dagfinn Ilmari Mannsåker David E. Wheeler fecundf Graham Knop Peter Rabbitson
  
  =over 4
  
  =item *
  
  Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
  
  =item *
  
  David E. Wheeler <david@justatheory.com>
  
  =item *
  
  fecundf <not.com+github@gmail.com>
  
  =item *
  
  Graham Knop <haarg@haarg.org>
  
  =item *
  
  Peter Rabbitson <ribasushi@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2009 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
CAPTURE_TINY

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

$fatpacked{"Carton/Builder.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_BUILDER';
  package Carton::Builder;
  use strict;
  use Class::Tiny {
      mirror => undef,
      index  => undef,
      cascade => sub { 1 },
      without => sub { [] },
      cpanfile => undef,
  };
  
  sub effective_mirrors {
      my $self = shift;
  
      # push default CPAN mirror always, as a fallback
      # TODO don't pass fallback if --cached is set?
  
      my @mirrors = ($self->mirror);
      push @mirrors, Carton::Mirror->default if $self->custom_mirror;
      push @mirrors, Carton::Mirror->new('http://backpan.perl.org/');
  
      @mirrors;
  }
  
  sub custom_mirror {
      my $self = shift;
      ! $self->mirror->is_default;
  }
  
  sub bundle {
      my($self, $path, $cache_path, $snapshot) = @_;
  
      for my $dist ($snapshot->distributions) {
          my $source = $path->child("cache/authors/id/" . $dist->pathname);
          my $target = $cache_path->child("authors/id/" . $dist->pathname);
  
          if ($source->exists) {
              warn "Copying ", $dist->pathname, "\n";
              $target->parent->mkpath;
              $source->copy($target) or warn "$target: $!";
          } else {
              warn "Couldn't find @{[ $dist->pathname ]}\n";
          }
      }
  
      my $has_io_gzip = eval { require IO::Compress::Gzip; 1 };
  
      my $ext   = $has_io_gzip ? ".txt.gz" : ".txt";
      my $index = $cache_path->child("modules/02packages.details$ext");
      $index->parent->mkpath;
  
      warn "Writing $index\n";
  
      my $out = $index->openw;
      if ($has_io_gzip) {
          $out = IO::Compress::Gzip->new($out)
            or die "gzip failed: $IO::Compress::Gzip::GzipError";
      }
  
      $snapshot->index->write($out);
      close $out;
  
      unless ($has_io_gzip) {
          unlink "$index.gz";
          !system 'gzip', $index
            or die "Running gzip command failed: $!";
      }
  }
  
  sub install {
      my($self, $path) = @_;
  
      $self->run_install(
          "-L", $path,
          (map { ("--mirror", $_->url) } $self->effective_mirrors),
          ( $self->index ? ("--mirror-index", $self->index) : () ),
          ( $self->cascade ? "--cascade-search" : () ),
          ( $self->custom_mirror ? "--mirror-only" : () ),
          "--save-dists", "$path/cache",
          $self->groups,
          "--cpanfile", $self->cpanfile,
          "--installdeps", $self->cpanfile->dirname,
      ) or die "Installing modules failed\n";
  }
  
  sub groups {
      my $self = shift;
  
      # TODO support --without test (don't need test on deployment)
      my @options = ('--with-all-features', '--with-develop');
  
      for my $group (@{$self->without}) {
          push @options, '--without-develop' if $group eq 'develop';
          push @options, "--without-feature=$group";
      }
  
      return @options;
  }
  
  sub update {
      my($self, $path, @modules) = @_;
  
      $self->run_install(
          "-L", $path,
          (map { ("--mirror", $_->url) } $self->effective_mirrors),
          ( $self->custom_mirror ? "--mirror-only" : () ),
          "--save-dists", "$path/cache",
          @modules
      ) or die "Updating modules failed\n";
  }
  
  sub run_install {
      my($self, @args) = @_;
  
      require Menlo::CLI::Compat;
      local $ENV{PERL_CPANM_OPT};
  
      my $cli = Menlo::CLI::Compat->new;
      $cli->parse_options("--quiet", "--notest", @args);
      $cli->run;
  
      !$cli->status;
  }
  
  1;
CARTON_BUILDER

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

$fatpacked{"Carton/CPANfile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_CPANFILE';
  package Carton::CPANfile;
  use Path::Tiny ();
  use Module::CPANfile;
  
  use overload q{""} => sub { $_[0]->stringify }, fallback => 1;
  
  use subs 'path';
  
  use Class::Tiny {
      path => undef,
      _cpanfile => undef,
      requirements => sub { $_[0]->_build_requirements },
  };
  
  sub stringify { shift->path->stringify(@_) }
  sub dirname   { shift->path->dirname(@_) }
  sub prereqs   { shift->_cpanfile->prereqs(@_) }
  sub required_modules { shift->requirements->required_modules(@_) }
  sub requirements_for_module { shift->requirements->requirements_for_module(@_) }
  
  sub path {
      my $self = shift;
      if (@_) {
          $self->{path} = Path::Tiny->new($_[0]);
      } else {
          $self->{path};
      }
  }
  
  sub load {
      my $self = shift;
      $self->_cpanfile( Module::CPANfile->load($self->path) );
  }
  
  sub _build_requirements {
      my $self = shift;
      my $reqs = CPAN::Meta::Requirements->new;
      $reqs->add_requirements($self->prereqs->requirements_for($_, 'requires'))
          for qw( configure build runtime test develop );
      $reqs->clear_requirement('perl');
      $reqs;
  }
  
  1;
CARTON_CPANFILE

$fatpacked{"Carton/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_DEPENDENCY';
  package Carton::Dependency;
  use strict;
  use Class::Tiny {
      module => undef,
      requirement => undef,
      dist => undef,
  };
  
  sub requirements { shift->dist->requirements(@_) }
  
  sub distname {
      my $self = shift;
      $self->dist->name;
  }
  
  sub version {
      my $self = shift;
      $self->dist->version_for($self->module);
  }
  
  1;
CARTON_DEPENDENCY

$fatpacked{"Carton/Dist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_DIST';
  package Carton::Dist;
  use strict;
  use Class::Tiny {
      name => undef,
      pathname => undef,
      provides => sub { +{} },
      requirements => sub { $_[0]->_build_requirements },
  };
  
  use CPAN::Meta;
  
  sub add_string_requirement  { shift->requirements->add_string_requirement(@_) }
  sub required_modules        { shift->requirements->required_modules(@_) }
  sub requirements_for_module { shift->requirements->requirements_for_module(@_) }
  
  sub is_core { 0 }
  
  sub distfile {
      my $self = shift;
      $self->pathname;
  }
  
  sub _build_requirements {
      CPAN::Meta::Requirements->new;
  }
  
  sub provides_module {
      my($self, $module) = @_;
      exists $self->provides->{$module};
  }
  
  sub version_for {
      my($self, $module) = @_;
      $self->provides->{$module}{version};
  }
  
  1;
CARTON_DIST

$fatpacked{"Carton/Dist/Core.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_DIST_CORE';
  package Carton::Dist::Core;
  use strict;
  use parent 'Carton::Dist';
  
  use Class::Tiny qw( module_version );
  
  sub BUILDARGS {
      my($class, %args) = @_;
  
      # TODO represent dual-life
      $args{name} =~ s/::/-/g;
  
      \%args;
  }
  
  sub is_core { 1 }
  
  sub version_for {
      my($self, $module) = @_;
      $self->module_version;
  }
  
  1;
CARTON_DIST_CORE

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

$fatpacked{"Carton/Error.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_ERROR';
  package Carton::Error;
  use strict;
  use overload '""' => sub { $_[0]->error };
  use Carp;
  
  sub throw {
      my($class, @args) = @_;
      die $class->new(@args);
  }
  
  sub rethrow {
      die $_[0];
  }
  
  sub new {
      my($class, %args) = @_;
      bless \%args, $class;
  }
  
  sub error {
      $_[0]->{error} || ref $_[0];
  }
  
  package Carton::Error::CommandNotFound;
  use parent 'Carton::Error';
  
  package Carton::Error::CommandExit;
  use parent 'Carton::Error';
  sub code { $_[0]->{code} }
  
  package Carton::Error::CPANfileNotFound;
  use parent 'Carton::Error';
  
  package Carton::Error::SnapshotParseError;
  use parent 'Carton::Error';
  sub path { $_[0]->{path} }
  
  package Carton::Error::SnapshotNotFound;
  use parent 'Carton::Error';
  sub path { $_[0]->{path} }
  
  1;
CARTON_ERROR

$fatpacked{"Carton/Index.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_INDEX';
  package Carton::Index;
  use strict;
  use Class::Tiny {
      _packages => sub { +{} },
      generator => sub { require Carton; "Carton $Carton::VERSION" },
  };
  
  sub add_package {
      my($self, $package) = @_;
      $self->_packages->{$package->name} = $package; # XXX ||=
  }
  
  sub count {
      my $self = shift;
      scalar keys %{$self->_packages};
  }
  
  sub packages {
      my $self = shift;
      sort { lc $a->name cmp lc $b->name } values %{$self->_packages};
  }
  
  sub write {
      my($self, $fh) = @_;
  
      print $fh <<EOF;
  File:         02packages.details.txt
  URL:          http://www.perl.com/CPAN/modules/02packages.details.txt
  Description:  Package names found in cpanfile.snapshot
  Columns:      package name, version, path
  Intended-For: Automated fetch routines, namespace documentation.
  Written-By:   @{[ $self->generator ]}
  Line-Count:   @{[ $self->count ]}
  Last-Updated: @{[ scalar localtime ]}
  
  EOF
      for my $p ($self->packages) {
          print $fh $self->_format_line($p->name, $p->version_format, $p->pathname);
      }
  }
  
  sub _format_line {
      my($self, @row) = @_;
  
      # from PAUSE::mldistwatch::rewrite02
      my $one = 30;
      my $two = 8;
  
      if (length $row[0] > $one) {
          $one += 8 - length $row[1];
          $two = length $row[1];
      }
  
      sprintf "%-${one}s %${two}s  %s\n", @row;
  }
  
  sub pad {
      my($str, $len, $left) = @_;
  
      my $howmany = $len - length($str);
      return $str if $howmany <= 0;
  
      my $pad = " " x $howmany;
      return $left ? "$pad$str" : "$str$pad";
  }
  
  
  1;
CARTON_INDEX

$fatpacked{"Carton/Mirror.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_MIRROR';
  package Carton::Mirror;
  use strict;
  use Class::Tiny qw( url );
  
  our $DefaultMirror = 'http://cpan.metacpan.org/';
  
  sub BUILDARGS {
      my($class, $url) = @_;
      return { url => $url };
  }
  
  sub default {
      my $class = shift;
      $class->new($DefaultMirror);
  }
  
  sub is_default {
      my $self = shift;
      $self->url eq $DefaultMirror;
  }
  
  1;
  
CARTON_MIRROR

$fatpacked{"Carton/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CARTON_PACKAGE';
  package Carton::Package;
  use strict;
  use Class::Tiny qw( name version pathname );
  
  sub BUILDARGS {
      my($class, @args) = @_;
      return { name => $args[0], version => $args[1], pathname => $args[2] };
  }
  
  sub version_format {
      my $self = shift;
      defined $self->version ? $self->version : 'undef';
  }
  
  1;
  
  
CARTON_PACKAGE

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

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

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

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

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

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

$fatpacked{"Class/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_TINY';
  use 5.006;
  use strict;
  no strict 'refs';
  use warnings;
  
  package Class::Tiny;
  # ABSTRACT: Minimalist class construction
  
  our $VERSION = '1.006';
  
  use Carp ();
  
  # load as .pm to hide from min version scanners
  require( $] >= 5.010 ? "mro.pm" : "MRO/Compat.pm" ); ## no critic:
  
  my %CLASS_ATTRIBUTES;
  
  sub import {
      my $class = shift;
      my $pkg   = caller;
      $class->prepare_class($pkg);
      $class->create_attributes( $pkg, @_ ) if @_;
  }
  
  sub prepare_class {
      my ( $class, $pkg ) = @_;
      @{"${pkg}::ISA"} = "Class::Tiny::Object" unless @{"${pkg}::ISA"};
  }
  
  # adapted from Object::Tiny and Object::Tiny::RW
  sub create_attributes {
      my ( $class, $pkg, @spec ) = @_;
      my %defaults = map { ref $_ eq 'HASH' ? %$_ : ( $_ => undef ) } @spec;
      my @attr = grep {
          defined and !ref and /^[^\W\d]\w*$/s
            or Carp::croak "Invalid accessor name '$_'"
      } keys %defaults;
      $CLASS_ATTRIBUTES{$pkg}{$_} = $defaults{$_} for @attr;
      $class->_gen_accessor( $pkg, $_ ) for grep { !*{"$pkg\::$_"}{CODE} } @attr;
      Carp::croak("Failed to generate attributes for $pkg: $@\n") if $@;
  }
  
  sub _gen_accessor {
      my ( $class, $pkg, $name ) = @_;
      my $outer_default = $CLASS_ATTRIBUTES{$pkg}{$name};
  
      my $sub =
        $class->__gen_sub_body( $name, defined($outer_default), ref($outer_default) );
  
      # default = outer_default avoids "won't stay shared" bug
      eval "package $pkg; my \$default=\$outer_default; $sub"; ## no critic
      Carp::croak("Failed to generate attributes for $pkg: $@\n") if $@;
  }
  
  # NOTE: overriding __gen_sub_body in a subclass of Class::Tiny is risky and
  # could break if the internals of Class::Tiny need to change for any
  # reason.  That said, I currently see no reason why this would be likely to
  # change.
  #
  # The generated sub body should assume that a '$default' variable will be
  # in scope (i.e. when the sub is evaluated) with any default value/coderef
  sub __gen_sub_body {
      my ( $self, $name, $has_default, $default_type ) = @_;
  
      if ( $has_default && $default_type eq 'CODE' ) {
          return << "HERE";
  sub $name {
      return (
            ( \@_ == 1 && exists \$_[0]{$name} )
          ? ( \$_[0]{$name} )
          : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default->( \$_[0] ) )
      );
  }
  HERE
      }
      elsif ($has_default) {
          return << "HERE";
  sub $name {
      return (
            ( \@_ == 1 && exists \$_[0]{$name} )
          ? ( \$_[0]{$name} )
          : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default )
      );
  }
  HERE
      }
      else {
          return << "HERE";
  sub $name {
      return \@_ == 1 ? \$_[0]{$name} : ( \$_[0]{$name} =  \$_[1] );
  }
  HERE
      }
  }
  
  sub get_all_attributes_for {
      my ( $class, $pkg ) = @_;
      my %attr =
        map { $_ => undef }
        map { keys %{ $CLASS_ATTRIBUTES{$_} || {} } } @{ mro::get_linear_isa($pkg) };
      return keys %attr;
  }
  
  sub get_all_attribute_defaults_for {
      my ( $class, $pkg ) = @_;
      my $defaults = {};
      for my $p ( reverse @{ mro::get_linear_isa($pkg) } ) {
          while ( my ( $k, $v ) = each %{ $CLASS_ATTRIBUTES{$p} || {} } ) {
              $defaults->{$k} = $v;
          }
      }
      return $defaults;
  }
  
  package Class::Tiny::Object;
  # ABSTRACT: Base class for classes built with Class::Tiny
  
  our $VERSION = '1.006';
  
  my ( %HAS_BUILDARGS, %BUILD_CACHE, %DEMOLISH_CACHE, %ATTR_CACHE );
  
  my $_PRECACHE = sub {
      no warnings 'once'; # needed to avoid downstream warnings
      my ($class) = @_;
      my $linear_isa =
        @{"$class\::ISA"} == 1 && ${"$class\::ISA"}[0] eq "Class::Tiny::Object"
        ? [$class]
        : mro::get_linear_isa($class);
      $DEMOLISH_CACHE{$class} = [
          map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
          map { "$_\::DEMOLISH" } @$linear_isa
      ];
      $BUILD_CACHE{$class} = [
          map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
          map { "$_\::BUILD" } reverse @$linear_isa
      ];
      $HAS_BUILDARGS{$class} = $class->can("BUILDARGS");
      return $ATTR_CACHE{$class} =
        { map { $_ => 1 } Class::Tiny->get_all_attributes_for($class) };
  };
  
  sub new {
      my $class = shift;
      my $valid_attrs = $ATTR_CACHE{$class} || $_PRECACHE->($class);
  
      # handle hash ref or key/value arguments
      my $args;
      if ( $HAS_BUILDARGS{$class} ) {
          $args = $class->BUILDARGS(@_);
      }
      else {
          if ( @_ == 1 && ref $_[0] ) {
              my %copy = eval { %{ $_[0] } }; # try shallow copy
              Carp::croak("Argument to $class->new() could not be dereferenced as a hash") if $@;
              $args = \%copy;
          }
          elsif ( @_ % 2 == 0 ) {
              $args = {@_};
          }
          else {
              Carp::croak("$class->new() got an odd number of elements");
          }
      }
  
      # create object and invoke BUILD (unless we were given __no_BUILD__)
      my $self =
        bless { map { $_ => $args->{$_} } grep { exists $valid_attrs->{$_} } keys %$args },
        $class;
      $self->BUILDALL($args) if !delete $args->{__no_BUILD__} && @{ $BUILD_CACHE{$class} };
  
      return $self;
  }
  
  sub BUILDALL { $_->(@_) for @{ $BUILD_CACHE{ ref $_[0] } } }
  
  # Adapted from Moo and its dependencies
  require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};
  
  sub DESTROY {
      my $self  = shift;
      my $class = ref $self;
      my $in_global_destruction =
        defined ${^GLOBAL_PHASE}
        ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
        : Devel::GlobalDestruction::in_global_destruction();
      for my $demolisher ( @{ $DEMOLISH_CACHE{$class} } ) {
          my $e = do {
              local ( $?, $@ );
              eval { $demolisher->( $self, $in_global_destruction ) };
              $@;
          };
          no warnings 'misc'; # avoid (in cleanup) warnings
          die $e if $e;       # rethrow
      }
  }
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Class::Tiny - Minimalist class construction
  
  =head1 VERSION
  
  version 1.006
  
  =head1 SYNOPSIS
  
  In F<Person.pm>:
  
    package Person;
  
    use Class::Tiny qw( name );
  
    1;
  
  In F<Employee.pm>:
  
    package Employee;
    use parent 'Person';
  
    use Class::Tiny qw( ssn ), {
      timestamp => sub { time }   # attribute with default
    };
  
    1;
  
  In F<example.pl>:
  
    use Employee;
  
    my $obj = Employee->new( name => "Larry", ssn => "111-22-3333" );
  
    # unknown attributes are ignored
    my $obj = Employee->new( name => "Larry", OS => "Linux" );
    # $obj->{OS} does not exist
  
  =head1 DESCRIPTION
  
  This module offers a minimalist class construction kit in around 120 lines of
  code.  Here is a list of features:
  
  =over 4
  
  =item *
  
  defines attributes via import arguments
  
  =item *
  
  generates read-write accessors
  
  =item *
  
  supports lazy attribute defaults
  
  =item *
  
  supports custom accessors
  
  =item *
  
  superclass provides a standard C<new> constructor
  
  =item *
  
  C<new> takes a hash reference or list of key/value pairs
  
  =item *
  
  C<new> supports providing C<BUILDARGS> to customize constructor options
  
  =item *
  
  C<new> calls C<BUILD> for each class from parent to child
  
  =item *
  
  superclass provides a C<DESTROY> method
  
  =item *
  
  C<DESTROY> calls C<DEMOLISH> for each class from child to parent
  
  =back
  
  Multiple-inheritance is possible, with superclass order determined via
  L<mro::get_linear_isa|mro/Functions>.
  
  It uses no non-core modules for any recent Perl. On Perls older than v5.10 it
  requires L<MRO::Compat>. On Perls older than v5.14, it requires
  L<Devel::GlobalDestruction>.
  
  =head1 USAGE
  
  =head2 Defining attributes
  
  Define attributes as a list of import arguments:
  
      package Foo::Bar;
  
      use Class::Tiny qw(
          name
          id
          height
          weight
      );
  
  For each attribute, a read-write accessor is created unless a subroutine of that
  name already exists:
  
      $obj->name;               # getter
      $obj->name( "John Doe" ); # setter
  
  Attribute names must be valid subroutine identifiers or an exception will
  be thrown.
  
  You can specify lazy defaults by defining attributes with a hash reference.
  Keys define attribute names and values are constants or code references that
  will be evaluated when the attribute is first accessed if no value has been
  set.  The object is passed as an argument to a code reference.
  
      package Foo::WithDefaults;
  
      use Class::Tiny qw/name id/, {
          title     => 'Peon',
          skills    => sub { [] },
          hire_date => sub { $_[0]->_build_hire_date },
      };
  
  When subclassing, if multiple accessors of the same name exist in different
  classes, any default (or lack of default) is determined by standard
  method resolution order.
  
  To make your own custom accessors, just pre-declare the method name before
  loading Class::Tiny:
  
      package Foo::Bar;
  
      use subs 'id';
  
      use Class::Tiny qw( name id );
  
      sub id { ... }
  
  Even if you pre-declare a method name, you must include it in the attribute
  list for Class::Tiny to register it as a valid attribute.
  
  If you set a default for a custom accessor, your accessor will need to retrieve
  the default and do something with it:
  
      package Foo::Bar;
  
      use subs 'id';
  
      use Class::Tiny qw( name ), { id => sub { int(rand(2*31)) } };
  
      sub id {
          my $self = shift;
          if (@_) {
              return $self->{id} = shift;
          }
          elsif ( exists $self->{id} ) {
              return $self->{id};
          }
          else {
              my $defaults =
                  Class::Tiny->get_all_attribute_defaults_for( ref $self );
              return $self->{id} = $defaults->{id}->();
          }
      }
  
  =head2 Class::Tiny::Object is your base class
  
  If your class B<does not> already inherit from some class, then
  Class::Tiny::Object will be added to your C<@ISA> to provide C<new> and
  C<DESTROY>.
  
  If your class B<does> inherit from something, then no additional inheritance is
  set up.  If the parent subclasses Class::Tiny::Object, then all is well.  If
  not, then you'll get accessors set up but no constructor or destructor. Don't
  do that unless you really have a special need for it.
  
  Define subclasses as normal.  It's best to define them with L<base>, L<parent>
  or L<superclass> before defining attributes with Class::Tiny so the C<@ISA>
  array is already populated at compile-time:
  
      package Foo::Bar::More;
  
      use parent 'Foo::Bar';
  
      use Class::Tiny qw( shoe_size );
  
  =head2 Object construction
  
  If your class inherits from Class::Tiny::Object (as it should if you followed
  the advice above), it provides the C<new> constructor for you.
  
  Objects can be created with attributes given as a hash reference or as a list
  of key/value pairs:
  
      $obj = Foo::Bar->new( name => "David" );
  
      $obj = Foo::Bar->new( { name => "David" } );
  
  If a reference is passed as a single argument, it must be able to be
  dereferenced as a hash or an exception is thrown.
  
  Unknown attributes in the constructor arguments will be ignored.  Prior to
  version 1.000, unknown attributes were an error, but this made it harder for
  people to cleanly subclass Class::Tiny classes so this feature was removed.
  
  You can define a C<BUILDARGS> method to change how arguments to new are
  handled.  It will receive the constructor arguments as they were provided and
  must return a hash reference of key/value pairs (or else throw an
  exception).
  
      sub BUILDARGS {
         my $class = shift;
         my $name = shift || "John Doe";
         return { name => $name };
       };
  
       Foo::Bar->new( "David" );
       Foo::Bar->new(); # "John Doe"
  
  Unknown attributes returned from C<BUILDARGS> will be ignored.
  
  =head2 BUILD
  
  If your class or any superclass defines a C<BUILD> method, it will be called
  by the constructor from the furthest parent class down to the child class after
  the object has been created.
  
  It is passed the constructor arguments as a hash reference.  The return value
  is ignored.  Use C<BUILD> for validation, checking required attributes or
  setting default values that depend on other attributes.
  
      sub BUILD {
          my ($self, $args) = @_;
  
          for my $req ( qw/name age/ ) {
              croak "$req attribute required" unless defined $self->$req;
          }
  
          croak "Age must be non-negative" if $self->age < 0;
  
          $self->msg( "Hello " . $self->name );
      }
  
  The argument reference is a copy, so deleting elements won't affect data in the
  original (but changes will be passed to other BUILD methods in C<@ISA>).
  
  =head2 DEMOLISH
  
  Class::Tiny provides a C<DESTROY> method.  If your class or any superclass
  defines a C<DEMOLISH> method, they will be called from the child class to the
  furthest parent class during object destruction.  It is provided a single
  boolean argument indicating whether Perl is in global destruction.  Return
  values and errors are ignored.
  
      sub DEMOLISH {
          my ($self, $global_destruct) = @_;
          $self->cleanup();
      }
  
  =head2 Introspection and internals
  
  You can retrieve an unsorted list of valid attributes known to Class::Tiny
  for a class and its superclasses with the C<get_all_attributes_for> class
  method.
  
      my @attrs = Class::Tiny->get_all_attributes_for("Employee");
      # returns qw/name ssn timestamp/
  
  Likewise, a hash reference of all valid attributes and default values (or code
  references) may be retrieved with the C<get_all_attribute_defaults_for> class
  method.  Any attributes without a default will be C<undef>.
  
      my $def = Class::Tiny->get_all_attribute_defaults_for("Employee");
      # returns {
      #   name => undef,
      #   ssn => undef
      #   timestamp => $coderef
      # }
  
  The C<import> method uses two class methods, C<prepare_class> and
  C<create_attributes> to set up the C<@ISA> array and attributes.  Anyone
  attempting to extend Class::Tiny itself should use these instead of mocking up
  a call to C<import>.
  
  When the first object is created, linearized C<@ISA>, the valid attribute list
  and various subroutine references are cached for speed.  Ensure that all
  inheritance and methods are in place before creating objects. (You don't want
  to be changing that once you create objects anyway, right?)
  
  =for Pod::Coverage new get_all_attributes_for get_all_attribute_defaults_for
  prepare_class create_attributes
  
  =head1 RATIONALE
  
  =head2 Why this instead of Object::Tiny or Class::Accessor or something else?
  
  I wanted something so simple that it could potentially be used by core Perl
  modules I help maintain (or hope to write), most of which either use
  L<Class::Struct> or roll-their-own OO framework each time.
  
  L<Object::Tiny> and L<Object::Tiny::RW> were close to what I wanted, but
  lacking some features I deemed necessary, and their maintainers have an even
  more strict philosophy against feature creep than I have.
  
  I also considered L<Class::Accessor>, which has been around a long time and is
  heavily used, but it, too, lacked features I wanted and did things in ways I
  considered poor design.
  
  I looked for something else on CPAN, but after checking a dozen class creators
  I realized I could implement exactly what I wanted faster than I could search
  CPAN for something merely sufficient.
  
  In general, compared to most things on CPAN (other than Object::Tiny),
  Class::Tiny is smaller in implementation and simpler in API.
  
  Specifically, here is how Class::Tiny ("C::T") compares to Object::Tiny
  ("O::T") and Class::Accessor ("C::A"):
  
   FEATURE                            C::T    O::T      C::A
   --------------------------------------------------------------
   attributes defined via import      yes     yes       no
   read/write accessors               yes     no        yes
   lazy attribute defaults            yes     no        no
   provides new                       yes     yes       yes
   provides DESTROY                   yes     no        no
   new takes either hashref or list   yes     no (list) no (hash)
   Moo(se)-like BUILD/DEMOLISH        yes     no        no
   Moo(se)-like BUILDARGS             yes     no        no
   no extraneous methods via @ISA     yes     yes       no
  
  =head2 Why this instead of Moose or Moo?
  
  L<Moose> and L<Moo> are both excellent OO frameworks.  Moose offers a powerful
  meta-object protocol (MOP), but is slow to start up and has about 30 non-core
  dependencies including XS modules.  Moo is faster to start up and has about 10
  pure Perl dependencies but provides no true MOP, relying instead on its ability
  to transparently upgrade Moo to Moose when Moose's full feature set is
  required.
  
  By contrast, Class::Tiny has no MOP and has B<zero> non-core dependencies for
  Perls in the L<support window|perlpolicy>.  It has far less code, less
  complexity and no learning curve. If you don't need or can't afford what Moo or
  Moose offer, this is intended to be a reasonable fallback.
  
  That said, Class::Tiny offers Moose-like conventions for things like C<BUILD>
  and C<DEMOLISH> for some minimal interoperability and an easier upgrade path.
  
  =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/Class-Tiny/issues>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/dagolden/Class-Tiny>
  
    git clone https://github.com/dagolden/Class-Tiny.git
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 CONTRIBUTORS
  
  =for stopwords Dagfinn Ilmari Mannsåker David Golden Gelu Lupas Karen Etheridge Olivier Mengué Toby Inkster
  
  =over 4
  
  =item *
  
  Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
  
  =item *
  
  David Golden <xdg@xdg.me>
  
  =item *
  
  Gelu Lupas <gelu@devnull.ro>
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  Olivier Mengué <dolmen@cpan.org>
  
  =item *
  
  Toby Inkster <tobyink@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2013 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
CLASS_TINY

$fatpacked{"ExtUtils/Command.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_COMMAND';
  package ExtUtils::Command;
  
  use 5.00503;
  use strict;
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  @ISA       = qw(Exporter);
  @EXPORT    = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod
                  dos2unix);
  $VERSION = '7.36';
  $VERSION =~ tr/_//d;
  
  my $Is_VMS   = $^O eq 'VMS';
  my $Is_VMS_mode = $Is_VMS;
  my $Is_VMS_noefs = $Is_VMS;
  my $Is_Win32 = $^O eq 'MSWin32';
  
  if( $Is_VMS ) {
      my $vms_unix_rpt;
      my $vms_efs;
      my $vms_case;
  
      if (eval { local $SIG{__DIE__};
                 local @INC = @INC;
                 pop @INC if $INC[-1] eq '.';
                 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_mode = 0 if $vms_unix_rpt;
      $Is_VMS_noefs = 0 if ($vms_efs);
  }
  
  
  =head1 NAME
  
  ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
  
  =head1 SYNOPSIS
  
    perl -MExtUtils::Command -e cat files... > destination
    perl -MExtUtils::Command -e mv source... destination
    perl -MExtUtils::Command -e cp source... destination
    perl -MExtUtils::Command -e touch files...
    perl -MExtUtils::Command -e rm_f files...
    perl -MExtUtils::Command -e rm_rf directories...
    perl -MExtUtils::Command -e mkpath directories...
    perl -MExtUtils::Command -e eqtime source destination
    perl -MExtUtils::Command -e test_f file
    perl -MExtUtils::Command -e test_d directory
    perl -MExtUtils::Command -e chmod mode files...
    ...
  
  =head1 DESCRIPTION
  
  The module is used to replace common UNIX commands.  In all cases the
  functions work from @ARGV rather than taking arguments.  This makes
  them easier to deal with in Makefiles.  Call them like this:
  
    perl -MExtUtils::Command -e some_command some files to work on
  
  and I<NOT> like this:
  
    perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
  
  For that use L<Shell::Command>.
  
  Filenames with * and ? will be glob expanded.
  
  
  =head2 FUNCTIONS
  
  =over 4
  
  =cut
  
  # VMS uses % instead of ? to mean "one character"
  my $wild_regex = $Is_VMS ? '*%' : '*?';
  sub expand_wildcards
  {
   @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
  }
  
  
  =item cat
  
      cat file ...
  
  Concatenates all files mentioned on command line to STDOUT.
  
  =cut
  
  sub cat ()
  {
   expand_wildcards();
   print while (<>);
  }
  
  =item eqtime
  
      eqtime source destination
  
  Sets modified time of destination to that of source.
  
  =cut
  
  sub eqtime
  {
   my ($src,$dst) = @ARGV;
   local @ARGV = ($dst);  touch();  # in case $dst doesn't exist
   utime((stat($src))[8,9],$dst);
  }
  
  =item rm_rf
  
      rm_rf files or directories ...
  
  Removes files and directories - recursively (even if readonly)
  
  =cut
  
  sub rm_rf
  {
   expand_wildcards();
   require File::Path;
   File::Path::rmtree([grep -e $_,@ARGV],0,0);
  }
  
  =item rm_f
  
      rm_f file ...
  
  Removes files (even if readonly)
  
  =cut
  
  sub rm_f {
      expand_wildcards();
  
      foreach my $file (@ARGV) {
          next unless -f $file;
  
          next if _unlink($file);
  
          chmod(0777, $file);
  
          next if _unlink($file);
  
          require Carp;
          Carp::carp("Cannot delete $file: $!");
      }
  }
  
  sub _unlink {
      my $files_unlinked = 0;
      foreach my $file (@_) {
          my $delete_count = 0;
          $delete_count++ while unlink $file;
          $files_unlinked++ if $delete_count;
      }
      return $files_unlinked;
  }
  
  
  =item touch
  
      touch file ...
  
  Makes files exist, with current timestamp
  
  =cut
  
  sub touch {
      my $t    = time;
      expand_wildcards();
      foreach my $file (@ARGV) {
          open(FILE,">>$file") || die "Cannot write $file:$!";
          close(FILE);
          utime($t,$t,$file);
      }
  }
  
  =item mv
  
      mv source_file destination_file
      mv source_file source_file destination_dir
  
  Moves source to destination.  Multiple sources are allowed if
  destination is an existing directory.
  
  Returns true if all moves succeeded, false otherwise.
  
  =cut
  
  sub mv {
      expand_wildcards();
      my @src = @ARGV;
      my $dst = pop @src;
  
      if (@src > 1 && ! -d $dst) {
          require Carp;
          Carp::croak("Too many arguments");
      }
  
      require File::Copy;
      my $nok = 0;
      foreach my $src (@src) {
          $nok ||= !File::Copy::move($src,$dst);
      }
      return !$nok;
  }
  
  =item cp
  
      cp source_file destination_file
      cp source_file source_file destination_dir
  
  Copies sources to the destination.  Multiple sources are allowed if
  destination is an existing directory.
  
  Returns true if all copies succeeded, false otherwise.
  
  =cut
  
  sub cp {
      expand_wildcards();
      my @src = @ARGV;
      my $dst = pop @src;
  
      if (@src > 1 && ! -d $dst) {
          require Carp;
          Carp::croak("Too many arguments");
      }
  
      require File::Copy;
      my $nok = 0;
      foreach my $src (@src) {
          $nok ||= !File::Copy::copy($src,$dst);
  
          # Win32 does not update the mod time of a copied file, just the
          # created time which make does not look at.
          utime(time, time, $dst) if $Is_Win32;
      }
      return $nok;
  }
  
  =item chmod
  
      chmod mode files ...
  
  Sets UNIX like permissions 'mode' on all the files.  e.g. 0666
  
  =cut
  
  sub chmod {
      local @ARGV = @ARGV;
      my $mode = shift(@ARGV);
      expand_wildcards();
  
      if( $Is_VMS_mode && $Is_VMS_noefs) {
          require File::Spec;
          foreach my $idx (0..$#ARGV) {
              my $path = $ARGV[$idx];
              next unless -d $path;
  
              # chmod 0777, [.foo.bar] doesn't work on VMS, you have to do
              # chmod 0777, [.foo]bar.dir
              my @dirs = File::Spec->splitdir( $path );
              $dirs[-1] .= '.dir';
              $path = File::Spec->catfile(@dirs);
  
              $ARGV[$idx] = $path;
          }
      }
  
      chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
  }
  
  =item mkpath
  
      mkpath directory ...
  
  Creates directories, including any parent directories.
  
  =cut
  
  sub mkpath
  {
   expand_wildcards();
   require File::Path;
   File::Path::mkpath([@ARGV],0,0777);
  }
  
  =item test_f
  
      test_f file
  
  Tests if a file exists.  I<Exits> with 0 if it does, 1 if it does not (ie.
  shell's idea of true and false).
  
  =cut
  
  sub test_f
  {
   exit(-f $ARGV[0] ? 0 : 1);
  }
  
  =item test_d
  
      test_d directory
  
  Tests if a directory exists.  I<Exits> with 0 if it does, 1 if it does
  not (ie. shell's idea of true and false).
  
  =cut
  
  sub test_d
  {
   exit(-d $ARGV[0] ? 0 : 1);
  }
  
  =item dos2unix
  
      dos2unix files or dirs ...
  
  Converts DOS and OS/2 linefeeds to Unix style recursively.
  
  =cut
  
  sub dos2unix {
      require File::Find;
      File::Find::find(sub {
          return if -d;
          return unless -w _;
          return unless -r _;
          return if -B _;
  
          local $\;
  
  	my $orig = $_;
  	my $temp = '.dos2unix_tmp';
  	open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
  	open TEMP, ">$temp" or
  	    do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
          binmode ORIG; binmode TEMP;
          while (my $line = <ORIG>) {
              $line =~ s/\015\012/\012/g;
              print TEMP $line;
          }
  	close ORIG;
  	close TEMP;
  	rename $temp, $orig;
  
      }, @ARGV);
  }
  
  =back
  
  =head1 SEE ALSO
  
  Shell::Command which is these same functions but take arguments normally.
  
  
  =head1 AUTHOR
  
  Nick Ing-Simmons C<ni-s@cpan.org>
  
  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
  
EXTUTILS_COMMAND

$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.36';
  $VERSION =~ tr/_//d;
  
  my $Is_VMS = $^O eq 'VMS';
  
  sub mtime {
    no warnings 'redefine';
    local $@;
    *mtime = (eval { require Time::HiRes } && defined &Time::HiRes::stat)
      ? sub { (Time::HiRes::stat($_[0]))[9] }
      : sub { (             stat($_[0]))[9] }
    ;
    goto &mtime;
  }
  
  =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 separated
                          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;
      my $time = gmtime($ENV{SOURCE_DATE_EPOCH} || time);
      $pod = sprintf <<'POD', scalar($time), $type, $name, $name;
   =head2 %s: C<%s> L<%s|%s>
  
   =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/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_CONFIG';
  package ExtUtils::Config;
  $ExtUtils::Config::VERSION = '0.008';
  use strict;
  use warnings;
  use Config;
  use Data::Dumper ();
  
  sub new {
  	my ($pack, $args) = @_;
  	return bless {
  		values => ($args ? { %$args } : {}),
  	}, $pack;
  }
  
  sub get {
  	my ($self, $key) = @_;
  	return exists $self->{values}{$key} ? $self->{values}{$key} : $Config{$key};
  }
  
  sub exists {
  	my ($self, $key) = @_;
  	return exists $self->{values}{$key} || exists $Config{$key};
  }
  
  sub values_set {
  	my $self = shift;
  	return { %{$self->{values}} };
  }
  
  sub all_config {
  	my $self = shift;
  	return { %Config, %{ $self->{values}} };
  }
  
  sub serialize {
  	my $self = shift;
  	return $self->{serialized} ||= Data::Dumper->new([$self->values_set])->Terse(1)->Sortkeys(1)->Dump;
  }
  
  1;
  
  # ABSTRACT: A wrapper for perl's configuration
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  ExtUtils::Config - A wrapper for perl's configuration
  
  =head1 VERSION
  
  version 0.008
  
  =head1 SYNOPSIS
  
   my $config = ExtUtils::Config->new();
   $config->get('installsitelib');
  
  =head1 DESCRIPTION
  
  ExtUtils::Config is an abstraction around the %Config hash. By itself it is not a particularly interesting module by any measure, however it ties together a family of modern toolchain modules.
  
  =head1 METHODS
  
  =head2 new(\%config)
  
  Create a new ExtUtils::Config object. The values in C<\%config> are used to initialize the object.
  
  =head2 get($key)
  
  Get the value of C<$key>. If not overridden it will return the value in %Config.
  
  =head2 exists($key)
  
  Tests for the existence of $key.
  
  =head2 values_set()
  
  Get a hashref of all overridden values.
  
  =head2 all_config()
  
  Get a hashref of the complete configuration, including overrides.
  
  =head2 serialize()
  
  This method serializes the object to some kind of string.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2006 by Ken Williams, Leon Timmermans.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
EXTUTILS_CONFIG

$fatpacked{"ExtUtils/Helpers.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS';
  package ExtUtils::Helpers;
  $ExtUtils::Helpers::VERSION = '0.026';
  use strict;
  use warnings FATAL => 'all';
  use Exporter 5.57 'import';
  
  use Config;
  use File::Basename qw/basename/;
  use File::Spec::Functions qw/splitpath canonpath abs2rel splitdir/;
  use Text::ParseWords 3.24 ();
  
  our @EXPORT_OK = qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;
  
  BEGIN {
  	my %impl_for = ( MSWin32 => 'Windows', VMS => 'VMS');
  	my $package = 'ExtUtils::Helpers::' . ($impl_for{$^O} || 'Unix');
  	my $impl = $impl_for{$^O} || 'Unix';
  	require "ExtUtils/Helpers/$impl.pm";
  	"ExtUtils::Helpers::$impl"->import();
  }
  
  sub split_like_shell {
  	my ($string) = @_;
  
  	return if not defined $string;
  	$string =~ s/^\s+|\s+$//g;
  	return if not length $string;
  
  	return Text::ParseWords::shellwords($string);
  }
  
  sub man1_pagename {
  	my $filename = shift;
  	return basename($filename).".$Config{man1ext}";
  }
  
  my %separator = (
  	MSWin32 => '.',
  	VMS => '__',
  	os2 => '.',
  	cygwin => '.',
  );
  my $separator = $separator{$^O} || '::';
  
  sub man3_pagename {
  	my ($filename, $base) = @_;
  	$base ||= 'lib';
  	my ($vols, $dirs, $file) = splitpath(canonpath(abs2rel($filename, $base)));
  	$file = basename($file, qw/.pm .pod/);
  	my @dirs = grep { length } splitdir($dirs);
  	return join $separator, @dirs, "$file.$Config{man3ext}";
  }
  
  1;
  
  # ABSTRACT: Various portability utilities for module builders
  
  __END__
  
  =pod
  
  =encoding utf-8
  
  =head1 NAME
  
  ExtUtils::Helpers - Various portability utilities for module builders
  
  =head1 VERSION
  
  version 0.026
  
  =head1 SYNOPSIS
  
   use ExtUtils::Helpers qw/make_executable split_like_shell/;
  
   unshift @ARGV, split_like_shell($ENV{PROGRAM_OPTS});
   write_script_to('Build');
   make_executable('Build');
  
  =head1 DESCRIPTION
  
  This module provides various portable helper functions for module building modules.
  
  =head1 FUNCTIONS
  
  =head2 make_executable($filename)
  
  This makes a perl script executable.
  
  =head2 split_like_shell($string)
  
  This function splits a string the same way as the local platform does.
  
  =head2 detildefy($path)
  
  This function substitutes a tilde at the start of a path with the users homedir in an appropriate manner.
  
  =head2 man1_pagename($filename)
  
  Returns the man page filename for a script.
  
  =head2 man3_pagename($filename, $basedir)
  
  Returns the man page filename for a Perl library.
  
  =head1 ACKNOWLEDGEMENTS
  
  Olivier Mengué and Christian Walde made C<make_executable> work on Windows.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
EXTUTILS_HELPERS

$fatpacked{"ExtUtils/Helpers/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_UNIX';
  package ExtUtils::Helpers::Unix;
  $ExtUtils::Helpers::Unix::VERSION = '0.026';
  use strict;
  use warnings FATAL => 'all';
  
  use Exporter 5.57 'import';
  our @EXPORT = qw/make_executable detildefy/;
  
  use Carp qw/croak/;
  use Config;
  
  my $layer = $] >= 5.008001 ? ":raw" : "";
  
  sub make_executable {
  	my $filename = shift;
  	my $current_mode = (stat $filename)[2] + 0;
  	if (-T $filename) {
  		open my $fh, "<$layer", $filename;
  		my @lines = <$fh>;
  		if (@lines and $lines[0] =~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms) {
  			open my $out, ">$layer", "$filename.new" or croak "Couldn't open $filename.new: $!";
  			print $out @lines;
  			close $out;
  			rename $filename, "$filename.bak" or croak "Couldn't rename $filename to $filename.bak";
  			rename "$filename.new", $filename or croak "Couldn't rename $filename.new to $filename";
  			unlink "$filename.bak";
  		}
  	}
  	chmod $current_mode | oct(111), $filename;
  	return;
  }
  
  sub detildefy {
  	my $value = shift;
  	# tilde with optional username
  	for ($value) {
  		s{ ^ ~ (?= /|$)}          [ $ENV{HOME} || (getpwuid $>)[7] ]ex or # tilde without user name
  		s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex;        # tilde with user name
  	}
  	return $value;
  }
  
  1;
  
  # ABSTRACT: Unix specific helper bits
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  ExtUtils::Helpers::Unix - Unix specific helper bits
  
  =head1 VERSION
  
  version 0.026
  
  =for Pod::Coverage make_executable
  split_like_shell
  detildefy
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
EXTUTILS_HELPERS_UNIX

$fatpacked{"ExtUtils/Helpers/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_VMS';
  package ExtUtils::Helpers::VMS;
  $ExtUtils::Helpers::VMS::VERSION = '0.026';
  use strict;
  use warnings FATAL => 'all';
  
  use Exporter 5.57 'import';
  our @EXPORT = qw/make_executable detildefy/;
  
  use File::Copy qw/copy/;
  
  sub make_executable {
  	my $filename = shift;
  	my $batchname = "$filename.com";
  	copy($filename, $batchname);
  	ExtUtils::Helpers::Unix::make_executable($batchname);
  	return;
  }
  
  sub detildefy {
  	my $arg = shift;
  
  	# Apparently double ~ are not translated.
  	return $arg if ($arg =~ /^~~/);
  
  	# Apparently ~ followed by whitespace are not translated.
  	return $arg if ($arg =~ /^~ /);
  
  	if ($arg =~ /^~/) {
  		my $spec = $arg;
  
  		# Remove the tilde
  		$spec =~ s/^~//;
  
  		# Remove any slash following the tilde if present.
  		$spec =~ s#^/##;
  
  		# break up the paths for the merge
  		my $home = VMS::Filespec::unixify($ENV{HOME});
  
  		# In the default VMS mode, the trailing slash is present.
  		# In Unix report mode it is not.  The parsing logic assumes that
  		# it is present.
  		$home .= '/' unless $home =~ m#/$#;
  
  		# Trivial case of just ~ by it self
  		if ($spec eq '') {
  			$home =~ s#/$##;
  			return $home;
  		}
  
  		my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
  		if ($hdir eq '') {
  			 # Someone has tampered with $ENV{HOME}
  			 # So hfile is probably the directory since this should be
  			 # a path.
  			 $hdir = $hfile;
  		}
  
  		my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
  
  		my @hdirs = File::Spec::Unix->splitdir($hdir);
  		my @dirs = File::Spec::Unix->splitdir($dir);
  
  		unless ($arg =~ m#^~/#) {
  			# There is a home directory after the tilde, but it will already
  			# be present in in @hdirs so we need to remove it by from @dirs.
  
  			shift @dirs;
  		}
  		my $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
  
  		$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
  	}
  	return $arg;
  }
  
  # ABSTRACT: VMS specific helper bits
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  ExtUtils::Helpers::VMS - VMS specific helper bits
  
  =head1 VERSION
  
  version 0.026
  
  =for Pod::Coverage make_executable
  detildefy
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
EXTUTILS_HELPERS_VMS

$fatpacked{"ExtUtils/Helpers/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_WINDOWS';
  package ExtUtils::Helpers::Windows;
  $ExtUtils::Helpers::Windows::VERSION = '0.026';
  use strict;
  use warnings FATAL => 'all';
  
  use Exporter 5.57 'import';
  our @EXPORT = qw/make_executable detildefy/;
  
  use Config;
  use Carp qw/carp croak/;
  use ExtUtils::PL2Bat 'pl2bat';
  
  sub make_executable {
  	my $script = shift;
  	if (-T $script && $script !~ / \. (?:bat|cmd) $ /x) {
  		pl2bat(in => $script, update => 1);
  	}
  	return;
  }
  
  sub detildefy {
  	my $value = shift;
  	$value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if $ENV{USERPROFILE};
  	return $value;
  }
  
  1;
  
  # ABSTRACT: Windows specific helper bits
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  ExtUtils::Helpers::Windows - Windows specific helper bits
  
  =head1 VERSION
  
  version 0.026
  
  =for Pod::Coverage make_executable
  split_like_shell
  detildefy
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
EXTUTILS_HELPERS_WINDOWS

$fatpacked{"ExtUtils/Install.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALL';
  package ExtUtils::Install;
  use strict;
  
  use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config);
  
  use AutoSplit;
  use Carp ();
  use Config qw(%Config);
  use Cwd qw(cwd);
  use Exporter;
  use ExtUtils::Packlist;
  use File::Basename qw(dirname);
  use File::Compare qw(compare);
  use File::Copy;
  use File::Find qw(find);
  use File::Path;
  use File::Spec;
  
  
  @ISA = ('Exporter');
  @EXPORT = ('install','uninstall','pm_to_blib', 'install_default');
  
  =pod
  
  =head1 NAME
  
  ExtUtils::Install - install files from here to there
  
  =head1 SYNOPSIS
  
    use ExtUtils::Install;
  
    install({ 'blib/lib' => 'some/install/dir' } );
  
    uninstall($packlist);
  
    pm_to_blib({ 'lib/Foo/Bar.pm' => 'blib/lib/Foo/Bar.pm' });
  
  =head1 VERSION
  
  2.06
  
  =cut
  
  $VERSION = '2.06';  # <-- do not forget to update the POD section just above this line!
  $VERSION = eval $VERSION;
  
  =pod
  
  =head1 DESCRIPTION
  
  Handles the installing and uninstalling of perl modules, scripts, man
  pages, etc...
  
  Both install() and uninstall() are specific to the way
  ExtUtils::MakeMaker handles the installation and deinstallation of
  perl modules. They are not designed as general purpose tools.
  
  On some operating systems such as Win32 installation may not be possible
  until after a reboot has occurred. This can have varying consequences:
  removing an old DLL does not impact programs using the new one, but if
  a new DLL cannot be installed properly until reboot then anything
  depending on it must wait. The package variable
  
    $ExtUtils::Install::MUST_REBOOT
  
  is used to store this status.
  
  If this variable is true then such an operation has occurred and
  anything depending on this module cannot proceed until a reboot
  has occurred.
  
  If this value is defined but false then such an operation has
  ocurred, but should not impact later operations.
  
  =over
  
  =begin _private
  
  =item _chmod($$;$)
  
  Wrapper to chmod() for debugging and error trapping.
  
  =item _warnonce(@)
  
  Warns about something only once.
  
  =item _choke(@)
  
  Dies with a special message.
  
  =back
  
  =end _private
  
  =cut
  
  my $Is_VMS     = $^O eq 'VMS';
  my $Is_MacPerl = $^O eq 'MacOS';
  my $Is_Win32   = $^O eq 'MSWin32';
  my $Is_cygwin  = $^O eq 'cygwin';
  my $CanMoveAtBoot = ($Is_Win32 || $Is_cygwin);
  
  
  my $Inc_uninstall_warn_handler;
  
  # install relative to here
  
  my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
  my $INSTALL_QUIET = $ENV{PERL_INSTALL_QUIET};
  
  my $Curdir = File::Spec->curdir;
  my $Updir  = File::Spec->updir;
  
  sub _estr(@) {
      return join "\n",'!' x 72,@_,'!' x 72,'';
  }
  
  {my %warned;
  sub _warnonce(@) {
      my $first=shift;
      my $msg=_estr "WARNING: $first",@_;
      warn $msg unless $warned{$msg}++;
  }}
  
  sub _choke(@) {
      my $first=shift;
      my $msg=_estr "ERROR: $first",@_;
      Carp::croak($msg);
  }
  
  
  sub _chmod($$;$) {
      my ( $mode, $item, $verbose )=@_;
      $verbose ||= 0;
      if (chmod $mode, $item) {
          printf "chmod(0%o, %s)\n",$mode, $item if $verbose > 1;
      } else {
          my $err="$!";
          _warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n",
                    $mode, $item, $err
              if -e $item;
      }
  }
  
  =begin _private
  
  =over
  
  =item _move_file_at_boot( $file, $target, $moan  )
  
  OS-Specific, Win32/Cygwin
  
  Schedules a file to be moved/renamed/deleted at next boot.
  $file should be a filespec of an existing file
  $target should be a ref to an array if the file is to be deleted
  otherwise it should be a filespec for a rename. If the file is existing
  it will be replaced.
  
  Sets $MUST_REBOOT to 0 to indicate a deletion operation has occurred
  and sets it to 1 to indicate that a move operation has been requested.
  
  returns 1 on success, on failure if $moan is false errors are fatal.
  If $moan is true then returns 0 on error and warns instead of dies.
  
  =end _private
  
  =cut
  
  {
      my $Has_Win32API_File;
      sub _move_file_at_boot { #XXX OS-SPECIFIC
          my ( $file, $target, $moan  )= @_;
          Carp::confess("Panic: Can't _move_file_at_boot on this platform!")
               unless $CanMoveAtBoot;
  
          my $descr= ref $target
                      ? "'$file' for deletion"
                      : "'$file' for installation as '$target'";
  
          # *note* CanMoveAtBoot is only incidentally the same condition as below
          # this needs not hold true in the future.
          $Has_Win32API_File = ($Is_Win32 || $Is_cygwin)
              ? (eval {require Win32API::File; 1} || 0)
              : 0 unless defined $Has_Win32API_File;
          if ( ! $Has_Win32API_File ) {
  
              my @msg=(
                  "Cannot schedule $descr at reboot.",
                  "Try installing Win32API::File to allow operations on locked files",
                  "to be scheduled during reboot. Or try to perform the operation by",
                  "hand yourself. (You may need to close other perl processes first)"
              );
              if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
              return 0;
          }
          my $opts= Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();
          $opts= $opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()
              unless ref $target;
  
          _chmod( 0666, $file );
          _chmod( 0666, $target ) unless ref $target;
  
          if (Win32API::File::MoveFileEx( $file, $target, $opts )) {
              $MUST_REBOOT ||= ref $target ? 0 : 1;
              return 1;
          } else {
              my @msg=(
                  "MoveFileEx $descr at reboot failed: $^E",
                  "You may try to perform the operation by hand yourself. ",
                  "(You may need to close other perl processes first).",
              );
              if ( $moan ) { _warnonce(@msg) } else { _choke(@msg) }
          }
          return 0;
      }
  }
  
  
  =begin _private
  
  
  =item _unlink_or_rename( $file, $tryhard, $installing )
  
  OS-Specific, Win32/Cygwin
  
  Tries to get a file out of the way by unlinking it or renaming it. On
  some OS'es (Win32 based) DLL files can end up locked such that they can
  be renamed but not deleted. Likewise sometimes a file can be locked such
  that it cant even be renamed or changed except at reboot. To handle
  these cases this routine finds a tempfile name that it can either rename
  the file out of the way or use as a proxy for the install so that the
  rename can happen later (at reboot).
  
    $file : the file to remove.
    $tryhard : should advanced tricks be used for deletion
    $installing : we are not merely deleting but we want to overwrite
  
  When $tryhard is not true if the unlink fails its fatal. When $tryhard
  is true then the file is attempted to be renamed. The renamed file is
  then scheduled for deletion. If the rename fails then $installing
  governs what happens. If it is false the failure is fatal. If it is true
  then an attempt is made to schedule installation at boot using a
  temporary file to hold the new file. If this fails then a fatal error is
  thrown, if it succeeds it returns the temporary file name (which will be
  a derivative of the original in the same directory) so that the caller can
  use it to install under. In all other cases of success returns $file.
  On failure throws a fatal error.
  
  =end _private
  
  =cut
  
  
  
  sub _unlink_or_rename { #XXX OS-SPECIFIC
      my ( $file, $tryhard, $installing )= @_;
  
      # this chmod was originally unconditional. However, its not needed on
      # POSIXy systems since permission to unlink a file is specified by the
      # directory rather than the file; and in fact it screwed up hard- and
      # symlinked files. Keep it for other platforms in case its still
      # needed there.
      if ($^O =~ /^(dos|os2|MSWin32|VMS)$/) {
          _chmod( 0666, $file );
      }
      my $unlink_count = 0;
      while (unlink $file) { $unlink_count++; }
      return $file if $unlink_count > 0;
      my $error="$!";
  
      _choke("Cannot unlink '$file': $!")
            unless $CanMoveAtBoot && $tryhard;
  
      my $tmp= "AAA";
      ++$tmp while -e "$file.$tmp";
      $tmp= "$file.$tmp";
  
      warn "WARNING: Unable to unlink '$file': $error\n",
           "Going to try to rename it to '$tmp'.\n";
  
      if ( rename $file, $tmp ) {
          warn "Rename successful. Scheduling '$tmp'\nfor deletion at reboot.\n";
          # when $installing we can set $moan to true.
          # IOW, if we cant delete the renamed file at reboot its
          # not the end of the world. The other cases are more serious
          # and need to be fatal.
          _move_file_at_boot( $tmp, [], $installing );
          return $file;
      } elsif ( $installing ) {
          _warnonce("Rename failed: $!. Scheduling '$tmp'\nfor".
               " installation as '$file' at reboot.\n");
          _move_file_at_boot( $tmp, $file );
          return $tmp;
      } else {
          _choke("Rename failed:$!", "Cannot proceed.");
      }
  
  }
  
  
  =pod
  
  =back
  
  =head2 Functions
  
  =begin _private
  
  =over
  
  =item _get_install_skip
  
  Handles loading the INSTALL.SKIP file. Returns an array of patterns to use.
  
  =cut
  
  
  
  sub _get_install_skip {
      my ( $skip, $verbose )= @_;
      if ($ENV{EU_INSTALL_IGNORE_SKIP}) {
          print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n"
              if $verbose>2;
          return [];
      }
      if ( ! defined $skip ) {
          print "Looking for install skip list\n"
              if $verbose>2;
          for my $file ( 'INSTALL.SKIP', $ENV{EU_INSTALL_SITE_SKIPFILE} ) {
              next unless $file;
              print "\tChecking for $file\n"
                  if $verbose>2;
              if (-e $file) {
                  $skip= $file;
                  last;
              }
          }
      }
      if ($skip && !ref $skip) {
          print "Reading skip patterns from '$skip'.\n"
              if $verbose;
          if (open my $fh,$skip ) {
              my @patterns;
              while (<$fh>) {
                  chomp;
                  next if /^\s*(?:#|$)/;
                  print "\tSkip pattern: $_\n" if $verbose>3;
                  push @patterns, $_;
              }
              $skip= \@patterns;
          } else {
              warn "Can't read skip file:'$skip':$!\n";
              $skip=[];
          }
      } elsif ( UNIVERSAL::isa($skip,'ARRAY') ) {
          print "Using array for skip list\n"
              if $verbose>2;
      } elsif ($verbose) {
          print "No skip list found.\n"
              if $verbose>1;
          $skip= [];
      }
      warn "Got @{[0+@$skip]} skip patterns.\n"
          if $verbose>3;
      return $skip
  }
  
  =pod
  
  =item _have_write_access
  
  Abstract a -w check that tries to use POSIX::access() if possible.
  
  =cut
  
  {
      my  $has_posix;
      sub _have_write_access {
          my $dir=shift;
          unless (defined $has_posix) {
              $has_posix= (!$Is_cygwin && !$Is_Win32
               && eval 'local $^W; require POSIX; 1') || 0;
          }
          if ($has_posix) {
              return POSIX::access($dir, POSIX::W_OK());
          } else {
              return -w $dir;
          }
      }
  }
  
  =pod
  
  =item _can_write_dir(C<$dir>)
  
  Checks whether a given directory is writable, taking account
  the possibility that the directory might not exist and would have to
  be created first.
  
  Returns a list, containing: C<($writable, $determined_by, @create)>
  
  C<$writable> says whether the directory is (hypothetically) writable
  
  C<$determined_by> is the directory the status was determined from. It will be
  either the C<$dir>, or one of its parents.
  
  C<@create> is a list of directories that would probably have to be created
  to make the requested directory. It may not actually be correct on
  relative paths with C<..> in them. But for our purposes it should work ok
  
  =cut
  
  
  sub _can_write_dir {
      my $dir=shift;
      return
          unless defined $dir and length $dir;
  
      my ($vol, $dirs, $file) = File::Spec->splitpath($dir,1);
      my @dirs = File::Spec->splitdir($dirs);
      unshift @dirs, File::Spec->curdir
          unless File::Spec->file_name_is_absolute($dir);
  
      my $path='';
      my @make;
      while (@dirs) {
          if ($Is_VMS) {
              $dir = File::Spec->catdir($vol,@dirs);
          }
          else {
              $dir = File::Spec->catdir(@dirs);
              $dir = File::Spec->catpath($vol,$dir,'')
                      if defined $vol and length $vol;
          }
          next if ( $dir eq $path );
          if ( ! -e $dir ) {
              unshift @make,$dir;
              next;
          }
          if ( _have_write_access($dir) ) {
              return 1,$dir,@make
          } else {
              return 0,$dir,@make
          }
      } continue {
          pop @dirs;
      }
      return 0;
  }
  
  =pod
  
  =item _mkpath($dir,$show,$mode,$verbose,$dry_run)
  
  Wrapper around File::Path::mkpath() to handle errors.
  
  If $verbose is true and >1 then additional diagnostics will be produced, also
  this will force $show to true.
  
  If $dry_run is true then the directory will not be created but a check will be
  made to see whether it would be possible to write to the directory, or that
  it would be possible to create the directory.
  
  If $dry_run is not true dies if the directory can not be created or is not
  writable.
  
  =cut
  
  sub _mkpath {
      my ($dir,$show,$mode,$verbose,$dry_run)=@_;
      if ( $verbose && $verbose > 1 && ! -d $dir) {
          $show= 1;
          printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode;
      }
      if (!$dry_run) {
          if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) {
              _choke("Can't create '$dir'","$@");
          }
  
      }
      my ($can,$root,@make)=_can_write_dir($dir);
      if (!$can) {
          my @msg=(
              "Can't create '$dir'",
              $root ? "Do not have write permissions on '$root'"
                    : "Unknown Error"
          );
          if ($dry_run) {
              _warnonce @msg;
          } else {
              _choke @msg;
          }
      } elsif ($show and $dry_run) {
          print "$_\n" for @make;
      }
  
  }
  
  =pod
  
  =item _copy($from,$to,$verbose,$dry_run)
  
  Wrapper around File::Copy::copy to handle errors.
  
  If $verbose is true and >1 then additional diagnostics will be emitted.
  
  If $dry_run is true then the copy will not actually occur.
  
  Dies if the copy fails.
  
  =cut
  
  
  sub _copy {
      my ( $from, $to, $verbose, $dry_run)=@_;
      if ($verbose && $verbose>1) {
          printf "copy(%s,%s)\n", $from, $to;
      }
      if (!$dry_run) {
          File::Copy::copy($from,$to)
              or Carp::croak( _estr "ERROR: Cannot copy '$from' to '$to': $!" );
      }
  }
  
  =pod
  
  =item _chdir($from)
  
  Wrapper around chdir to catch errors.
  
  If not called in void context returns the cwd from before the chdir.
  
  dies on error.
  
  =cut
  
  sub _chdir {
      my ($dir)= @_;
      my $ret;
      if (defined wantarray) {
          $ret= cwd;
      }
      chdir $dir
          or _choke("Couldn't chdir to '$dir': $!");
      return $ret;
  }
  
  =pod
  
  =back
  
  =end _private
  
  =over
  
  =item B<install>
  
      # deprecated forms
      install(\%from_to);
      install(\%from_to, $verbose, $dry_run, $uninstall_shadows,
                  $skip, $always_copy, \%result);
  
      # recommended form as of 1.47
      install([
          from_to => \%from_to,
          verbose => 1,
          dry_run => 0,
          uninstall_shadows => 1,
          skip => undef,
          always_copy => 1,
          result => \%install_results,
      ]);
  
  
  Copies each directory tree of %from_to to its corresponding value
  preserving timestamps and permissions.
  
  There are two keys with a special meaning in the hash: "read" and
  "write".  These contain packlist files.  After the copying is done,
  install() will write the list of target files to $from_to{write}. If
  $from_to{read} is given the contents of this file will be merged into
  the written file. The read and the written file may be identical, but
  on AFS it is quite likely that people are installing to a different
  directory than the one where the files later appear.
  
  If $verbose is true, will print out each file removed.  Default is
  false.  This is "make install VERBINST=1". $verbose values going
  up to 5 show increasingly more diagnostics output.
  
  If $dry_run is true it will only print what it was going to do
  without actually doing it.  Default is false.
  
  If $uninstall_shadows is true any differing versions throughout @INC
  will be uninstalled.  This is "make install UNINST=1"
  
  As of 1.37_02 install() supports the use of a list of patterns to filter out
  files that shouldn't be installed. If $skip is omitted or undefined then
  install will try to read the list from INSTALL.SKIP in the CWD. This file is
  a list of regular expressions and is just like the MANIFEST.SKIP file used
  by L<ExtUtils::Manifest>.
  
  A default site INSTALL.SKIP may be provided by setting then environment
  variable EU_INSTALL_SITE_SKIPFILE, this will only be used when there isn't a
  distribution specific INSTALL.SKIP. If the environment variable
  EU_INSTALL_IGNORE_SKIP is true then no install file filtering will be
  performed.
  
  If $skip is undefined then the skip file will be autodetected and used if it
  is found. If $skip is a reference to an array then it is assumed the array
  contains the list of patterns, if $skip is a true non reference it is
  assumed to be the filename holding the list of patterns, any other value of
  $skip is taken to mean that no install filtering should occur.
  
  B<Changes As of Version 1.47>
  
  As of version 1.47 the following additions were made to the install interface.
  Note that the new argument style and use of the %result hash is recommended.
  
  The $always_copy parameter which when true causes files to be updated
  regardless as to whether they have changed, if it is defined but false then
  copies are made only if the files have changed, if it is undefined then the
  value of the environment variable EU_INSTALL_ALWAYS_COPY is used as default.
  
  The %result hash will be populated with the various keys/subhashes reflecting
  the install. Currently these keys and their structure are:
  
      install             => { $target    => $source },
      install_fail        => { $target    => $source },
      install_unchanged   => { $target    => $source },
  
      install_filtered    => { $source    => $pattern },
  
      uninstall           => { $uninstalled => $source },
      uninstall_fail      => { $uninstalled => $source },
  
  where C<$source> is the filespec of the file being installed. C<$target> is where
  it is being installed to, and C<$uninstalled> is any shadow file that is in C<@INC>
  or C<$ENV{PERL5LIB}> or other standard locations, and C<$pattern> is the pattern that
  caused a source file to be skipped. In future more keys will be added, such as to
  show created directories, however this requires changes in other modules and must
  therefore wait.
  
  These keys will be populated before any exceptions are thrown should there be an
  error.
  
  Note that all updates of the %result are additive, the hash will not be
  cleared before use, thus allowing status results of many installs to be easily
  aggregated.
  
  B<NEW ARGUMENT STYLE>
  
  If there is only one argument and it is a reference to an array then
  the array is assumed to contain a list of key-value pairs specifying
  the options. In this case the option "from_to" is mandatory. This style
  means that you do not have to supply a cryptic list of arguments and can
  use a self documenting argument list that is easier to understand.
  
  This is now the recommended interface to install().
  
  B<RETURN>
  
  If all actions were successful install will return a hashref of the results
  as described above for the $result parameter. If any action is a failure
  then install will die, therefore it is recommended to pass in the $result
  parameter instead of using the return value. If the result parameter is
  provided then the returned hashref will be the passed in hashref.
  
  =cut
  
  sub install { #XXX OS-SPECIFIC
      my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result) = @_;
      if (@_==1 and eval { 1+@$from_to }) {
          my %opts        = @$from_to;
          $from_to        = $opts{from_to}
                              or Carp::confess("from_to is a mandatory parameter");
          $verbose        = $opts{verbose};
          $dry_run        = $opts{dry_run};
          $uninstall_shadows  = $opts{uninstall_shadows};
          $skip           = $opts{skip};
          $always_copy    = $opts{always_copy};
          $result         = $opts{result};
      }
  
      $result ||= {};
      $verbose ||= 0;
      $dry_run  ||= 0;
  
      $skip= _get_install_skip($skip,$verbose);
      $always_copy =  $ENV{EU_INSTALL_ALWAYS_COPY}
                   || $ENV{EU_ALWAYS_COPY}
                   || 0
          unless defined $always_copy;
  
      my(%from_to) = %$from_to;
      my(%pack, $dir, %warned);
      my($packlist) = ExtUtils::Packlist->new();
  
      local(*DIR);
      for (qw/read write/) {
          $pack{$_}=$from_to{$_};
          delete $from_to{$_};
      }
      my $tmpfile = install_rooted_file($pack{"read"});
      $packlist->read($tmpfile) if (-f $tmpfile);
      my $cwd = cwd();
      my @found_files;
      my %check_dirs;
  
      MOD_INSTALL: foreach my $source (sort keys %from_to) {
          #copy the tree to the target directory without altering
          #timestamp and permission and remember for the .packlist
          #file. The packlist file contains the absolute paths of the
          #install locations. AFS users may call this a bug. We'll have
          #to reconsider how to add the means to satisfy AFS users also.
  
          #October 1997: we want to install .pm files into archlib if
          #there are any files in arch. So we depend on having ./blib/arch
          #hardcoded here.
  
          my $targetroot = install_rooted_dir($from_to{$source});
  
          my $blib_lib  = File::Spec->catdir('blib', 'lib');
          my $blib_arch = File::Spec->catdir('blib', 'arch');
          if ($source eq $blib_lib and
              exists $from_to{$blib_arch} and
              directory_not_empty($blib_arch)
          ){
              $targetroot = install_rooted_dir($from_to{$blib_arch});
              print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n";
          }
  
          next unless -d $source;
          _chdir($source);
          # 5.5.3's File::Find missing no_chdir option
          # XXX OS-SPECIFIC
          # File::Find seems to always be Unixy except on MacPerl :(
          my $current_directory= $Is_MacPerl ? $Curdir : '.';
          find(sub {
              my ($mode,$size,$atime,$mtime) = (stat)[2,7,8,9];
  
              return if !-f _;
              my $origfile = $_;
  
              return if $origfile eq ".exists";
              my $targetdir  = File::Spec->catdir($targetroot, $File::Find::dir);
              my $targetfile = File::Spec->catfile($targetdir, $origfile);
              my $sourcedir  = File::Spec->catdir($source, $File::Find::dir);
              my $sourcefile = File::Spec->catfile($sourcedir, $origfile);
  
              for my $pat (@$skip) {
                  if ( $sourcefile=~/$pat/ ) {
                      print "Skipping $targetfile (filtered)\n"
                          if $verbose>1;
                      $result->{install_filtered}{$sourcefile} = $pat;
                      return;
                  }
              }
              # we have to do this for back compat with old File::Finds
              # and because the target is relative
              my $save_cwd = _chdir($cwd);
              my $diff = 0;
              # XXX: I wonder how useful this logic is actually -- demerphq
              if ( $always_copy or !-f $targetfile or -s $targetfile != $size) {
                  $diff++;
              } else {
                  # we might not need to copy this file
                  $diff = compare($sourcefile, $targetfile);
              }
              $check_dirs{$targetdir}++
                  unless -w $targetfile;
  
              push @found_files,
                  [ $diff, $File::Find::dir, $origfile,
                    $mode, $size, $atime, $mtime,
                    $targetdir, $targetfile, $sourcedir, $sourcefile,
  
                  ];
              #restore the original directory we were in when File::Find
              #called us so that it doesn't get horribly confused.
              _chdir($save_cwd);
          }, $current_directory );
          _chdir($cwd);
      }
      foreach my $targetdir (sort keys %check_dirs) {
          _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
      }
      foreach my $found (@found_files) {
          my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime,
              $targetdir, $targetfile, $sourcedir, $sourcefile)= @$found;
  
          my $realtarget= $targetfile;
          if ($diff) {
              eval {
                  if (-f $targetfile) {
                      print "_unlink_or_rename($targetfile)\n" if $verbose>1;
                      $targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
                          unless $dry_run;
                  } elsif ( ! -d $targetdir ) {
                      _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
                  }
                  print "Installing $targetfile\n";
  
                  _copy( $sourcefile, $targetfile, $verbose, $dry_run, );
  
  
                  #XXX OS-SPECIFIC
                  print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
                  utime($atime,$mtime + $Is_VMS,$targetfile) unless $dry_run>1;
  
  
                  $mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
                  $mode = $mode | 0222
                      if $realtarget ne $targetfile;
                  _chmod( $mode, $targetfile, $verbose );
                  $result->{install}{$targetfile} = $sourcefile;
                  1
              } or do {
                  $result->{install_fail}{$targetfile} = $sourcefile;
                  die $@;
              };
          } else {
              $result->{install_unchanged}{$targetfile} = $sourcefile;
              print "Skipping $targetfile (unchanged)\n" if $verbose;
          }
  
          if ( $uninstall_shadows ) {
              inc_uninstall($sourcefile,$ffd, $verbose,
                            $dry_run,
                            $realtarget ne $targetfile ? $realtarget : "",
                            $result);
          }
  
          # Record the full pathname.
          $packlist->{$targetfile}++;
      }
  
      if ($pack{'write'}) {
          $dir = install_rooted_dir(dirname($pack{'write'}));
          _mkpath( $dir, 0, 0755, $verbose, $dry_run );
          print "Writing $pack{'write'}\n" if $verbose;
          $packlist->write(install_rooted_file($pack{'write'})) unless $dry_run;
      }
  
      _do_cleanup($verbose);
      return $result;
  }
  
  =begin _private
  
  =item _do_cleanup
  
  Standardize finish event for after another instruction has occurred.
  Handles converting $MUST_REBOOT to a die for instance.
  
  =end _private
  
  =cut
  
  sub _do_cleanup {
      my ($verbose) = @_;
      if ($MUST_REBOOT) {
          die _estr "Operation not completed! ",
              "You must reboot to complete the installation.",
              "Sorry.";
      } elsif (defined $MUST_REBOOT & $verbose) {
          warn _estr "Installation will be completed at the next reboot.\n",
               "However it is not necessary to reboot immediately.\n";
      }
  }
  
  =begin _undocumented
  
  =item install_rooted_file( $file )
  
  Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT
  is defined.
  
  =item install_rooted_dir( $dir )
  
  Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT
  is defined.
  
  =end _undocumented
  
  =cut
  
  
  sub install_rooted_file {
      if (defined $INSTALL_ROOT) {
          File::Spec->catfile($INSTALL_ROOT, $_[0]);
      } else {
          $_[0];
      }
  }
  
  
  sub install_rooted_dir {
      if (defined $INSTALL_ROOT) {
          File::Spec->catdir($INSTALL_ROOT, $_[0]);
      } else {
          $_[0];
      }
  }
  
  =begin _undocumented
  
  =item forceunlink( $file, $tryhard )
  
  Tries to delete a file. If $tryhard is true then we will use whatever
  devious tricks we can to delete the file. Currently this only applies to
  Win32 in that it will try to use Win32API::File to schedule a delete at
  reboot. A wrapper for _unlink_or_rename().
  
  =end _undocumented
  
  =cut
  
  
  sub forceunlink {
      my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC
      _unlink_or_rename( $file, $tryhard, not("installing") );
  }
  
  =begin _undocumented
  
  =item directory_not_empty( $dir )
  
  Returns 1 if there is an .exists file somewhere in a directory tree.
  Returns 0 if there is not.
  
  =end _undocumented
  
  =cut
  
  sub directory_not_empty ($) {
    my($dir) = @_;
    my $files = 0;
    find(sub {
             return if $_ eq ".exists";
             if (-f) {
               $File::Find::prune++;
               $files = 1;
             }
         }, $dir);
    return $files;
  }
  
  =pod
  
  =item B<install_default> I<DISCOURAGED>
  
      install_default();
      install_default($fullext);
  
  Calls install() with arguments to copy a module from blib/ to the
  default site installation location.
  
  $fullext is the name of the module converted to a directory
  (ie. Foo::Bar would be Foo/Bar).  If $fullext is not specified, it
  will attempt to read it from @ARGV.
  
  This is primarily useful for install scripts.
  
  B<NOTE> This function is not really useful because of the hard-coded
  install location with no way to control site vs core vs vendor
  directories and the strange way in which the module name is given.
  Consider its use discouraged.
  
  =cut
  
  sub install_default {
    @_ < 2 or Carp::croak("install_default should be called with 0 or 1 argument");
    my $FULLEXT = @_ ? shift : $ARGV[0];
    defined $FULLEXT or die "Do not know to where to write install log";
    my $INST_LIB = File::Spec->catdir($Curdir,"blib","lib");
    my $INST_ARCHLIB = File::Spec->catdir($Curdir,"blib","arch");
    my $INST_BIN = File::Spec->catdir($Curdir,'blib','bin');
    my $INST_SCRIPT = File::Spec->catdir($Curdir,'blib','script');
    my $INST_MAN1DIR = File::Spec->catdir($Curdir,'blib','man1');
    my $INST_MAN3DIR = File::Spec->catdir($Curdir,'blib','man3');
  
    my @INST_HTML;
    if($Config{installhtmldir}) {
        my $INST_HTMLDIR = File::Spec->catdir($Curdir,'blib','html');
        @INST_HTML = ($INST_HTMLDIR => $Config{installhtmldir});
    }
  
    install({
             read => "$Config{sitearchexp}/auto/$FULLEXT/.packlist",
             write => "$Config{installsitearch}/auto/$FULLEXT/.packlist",
             $INST_LIB => (directory_not_empty($INST_ARCHLIB)) ?
                           $Config{installsitearch} :
                           $Config{installsitelib},
             $INST_ARCHLIB => $Config{installsitearch},
             $INST_BIN => $Config{installbin} ,
             $INST_SCRIPT => $Config{installscript},
             $INST_MAN1DIR => $Config{installman1dir},
             $INST_MAN3DIR => $Config{installman3dir},
         @INST_HTML,
            },1,0,0);
  }
  
  
  =item B<uninstall>
  
      uninstall($packlist_file);
      uninstall($packlist_file, $verbose, $dont_execute);
  
  Removes the files listed in a $packlist_file.
  
  If $verbose is true, will print out each file removed.  Default is
  false.
  
  If $dont_execute is true it will only print what it was going to do
  without actually doing it.  Default is false.
  
  =cut
  
  sub uninstall {
      my($fil,$verbose,$dry_run) = @_;
      $verbose ||= 0;
      $dry_run  ||= 0;
  
      die _estr "ERROR: no packlist file found: '$fil'"
          unless -f $fil;
      # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
      # require $my_req; # Hairy, but for the first
      my ($packlist) = ExtUtils::Packlist->new($fil);
      foreach (sort(keys(%$packlist))) {
          chomp;
          print "unlink $_\n" if $verbose;
          forceunlink($_,'tryhard') unless $dry_run;
      }
      print "unlink $fil\n" if $verbose;
      forceunlink($fil, 'tryhard') unless $dry_run;
      _do_cleanup($verbose);
  }
  
  =begin _undocumented
  
  =item inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results)
  
  Remove shadowed files. If $ignore is true then it is assumed to hold
  a filename to ignore. This is used to prevent spurious warnings from
  occurring when doing an install at reboot.
  
  We now only die when failing to remove a file that has precedence over
  our own, when our install has precedence we only warn.
  
  $results is assumed to contain a hashref which will have the keys
  'uninstall' and 'uninstall_fail' populated with  keys for the files
  removed and values of the source files they would shadow.
  
  =end _undocumented
  
  =cut
  
  sub inc_uninstall {
      my($filepath,$libdir,$verbose,$dry_run,$ignore,$results) = @_;
      my($dir);
      $ignore||="";
      my $file = (File::Spec->splitpath($filepath))[2];
      my %seen_dir = ();
  
      my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'}
        ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
  
      my @dirs=( @PERL_ENV_LIB,
                 @INC,
                 @Config{qw(archlibexp
                            privlibexp
                            sitearchexp
                            sitelibexp)});
  
      #warn join "\n","---",@dirs,"---";
      my $seen_ours;
      foreach $dir ( @dirs ) {
          my $canonpath = $Is_VMS ? $dir : File::Spec->canonpath($dir);
          next if $canonpath eq $Curdir;
          next if $seen_dir{$canonpath}++;
          my $targetfile = File::Spec->catfile($canonpath,$libdir,$file);
          next unless -f $targetfile;
  
          # The reason why we compare file's contents is, that we cannot
          # know, which is the file we just installed (AFS). So we leave
          # an identical file in place
          my $diff = 0;
          if ( -f $targetfile && -s _ == -s $filepath) {
              # We have a good chance, we can skip this one
              $diff = compare($filepath,$targetfile);
          } else {
              $diff++;
          }
          print "#$file and $targetfile differ\n" if $diff && $verbose > 1;
  
          if (!$diff or $targetfile eq $ignore) {
              $seen_ours = 1;
              next;
          }
          if ($dry_run) {
              $results->{uninstall}{$targetfile} = $filepath;
              if ($verbose) {
                  $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();
                  $libdir =~ s|^\./||s ; # That's just cosmetics, no need to port. It looks prettier.
                  $Inc_uninstall_warn_handler->add(
                                       File::Spec->catfile($libdir, $file),
                                       $targetfile
                                      );
              }
              # if not verbose, we just say nothing
          } else {
              print "Unlinking $targetfile (shadowing?)\n" if $verbose;
              eval {
                  die "Fake die for testing"
                      if $ExtUtils::Install::Testing and
                         ucase(File::Spec->canonpath($ExtUtils::Install::Testing)) eq ucase($targetfile);
                  forceunlink($targetfile,'tryhard');
                  $results->{uninstall}{$targetfile} = $filepath;
                  1;
              } or do {
                  $results->{fail_uninstall}{$targetfile} = $filepath;
                  if ($seen_ours) {
                      warn "Failed to remove probably harmless shadow file '$targetfile'\n";
                  } else {
                      die "$@\n";
                  }
              };
          }
      }
  }
  
  =begin _undocumented
  
  =item run_filter($cmd,$src,$dest)
  
  Filter $src using $cmd into $dest.
  
  =end _undocumented
  
  =cut
  
  sub run_filter {
      my ($cmd, $src, $dest) = @_;
      local(*CMD, *SRC);
      open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
      open(SRC, $src)           || die "Cannot open $src: $!";
      my $buf;
      my $sz = 1024;
      while (my $len = sysread(SRC, $buf, $sz)) {
          syswrite(CMD, $buf, $len);
      }
      close SRC;
      close CMD or die "Filter command '$cmd' failed for $src";
  }
  
  =pod
  
  =item B<pm_to_blib>
  
      pm_to_blib(\%from_to);
      pm_to_blib(\%from_to, $autosplit_dir);
      pm_to_blib(\%from_to, $autosplit_dir, $filter_cmd);
  
  Copies each key of %from_to to its corresponding value efficiently.
  If an $autosplit_dir is provided, all .pm files will be autosplit into it.
  Any destination directories are created.
  
  $filter_cmd is an optional shell command to run each .pm file through
  prior to splitting and copying.  Input is the contents of the module,
  output the new module contents.
  
  You can have an environment variable PERL_INSTALL_ROOT set which will
  be prepended as a directory to each installed file (and directory).
  
  By default verbose output is generated, setting the PERL_INSTALL_QUIET
  environment variable will silence this output.
  
  =cut
  
  sub pm_to_blib {
      my($fromto,$autodir,$pm_filter) = @_;
  
      _mkpath($autodir,0,0755) if defined $autodir;
      while(my($from, $to) = each %$fromto) {
          if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
              print "Skip $to (unchanged)\n" unless $INSTALL_QUIET;
              next;
          }
  
          # When a pm_filter is defined, we need to pre-process the source first
          # to determine whether it has changed or not.  Therefore, only perform
          # the comparison check when there's no filter to be ran.
          #    -- RAM, 03/01/2001
  
          my $need_filtering = defined $pm_filter && length $pm_filter &&
                               $from =~ /\.pm$/;
  
          if (!$need_filtering && 0 == compare($from,$to)) {
              print "Skip $to (unchanged)\n" unless $INSTALL_QUIET;
              next;
          }
          if (-f $to){
              # we wont try hard here. its too likely to mess things up.
              forceunlink($to);
          } else {
              _mkpath(dirname($to),0,0755);
          }
          if ($need_filtering) {
              run_filter($pm_filter, $from, $to);
              print "$pm_filter <$from >$to\n";
          } else {
              _copy( $from, $to );
              print "cp $from $to\n" unless $INSTALL_QUIET;
          }
          my($mode,$atime,$mtime) = (stat $from)[2,8,9];
          utime($atime,$mtime+$Is_VMS,$to);
          _chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$to);
          next unless $from =~ /\.pm$/;
          _autosplit($to,$autodir) if defined $autodir;
      }
  }
  
  
  =begin _private
  
  =item _autosplit
  
  From 1.0307 back, AutoSplit will sometimes leave an open filehandle to
  the file being split.  This causes problems on systems with mandatory
  locking (ie. Windows).  So we wrap it and close the filehandle.
  
  =end _private
  
  =cut
  
  sub _autosplit { #XXX OS-SPECIFIC
      my $retval = autosplit(@_);
      close *AutoSplit::IN if defined *AutoSplit::IN{IO};
  
      return $retval;
  }
  
  
  package ExtUtils::Install::Warn;
  
  sub new { bless {}, shift }
  
  sub add {
      my($self,$file,$targetfile) = @_;
      push @{$self->{$file}}, $targetfile;
  }
  
  sub DESTROY {
      unless(defined $INSTALL_ROOT) {
          my $self = shift;
          my($file,$i,$plural);
          foreach $file (sort keys %$self) {
              $plural = @{$self->{$file}} > 1 ? "s" : "";
              print "## Differing version$plural of $file found. You might like to\n";
              for (0..$#{$self->{$file}}) {
                  print "rm ", $self->{$file}[$_], "\n";
                  $i++;
              }
          }
          $plural = $i>1 ? "all those files" : "this file";
          my $inst = (_invokant() eq 'ExtUtils::MakeMaker')
                   ? ( $Config::Config{make} || 'make' ).' install'
                       . ( $Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1' )
                   : './Build install uninst=1';
          print "## Running '$inst' will unlink $plural for you.\n";
      }
  }
  
  =begin _private
  
  =item _invokant
  
  Does a heuristic on the stack to see who called us for more intelligent
  error messages. Currently assumes we will be called only by Module::Build
  or by ExtUtils::MakeMaker.
  
  =end _private
  
  =cut
  
  sub _invokant {
      my @stack;
      my $frame = 0;
      while (my $file = (caller($frame++))[1]) {
          push @stack, (File::Spec->splitpath($file))[2];
      }
  
      my $builder;
      my $top = pop @stack;
      if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})) {
          $builder = 'Module::Build';
      } else {
          $builder = 'ExtUtils::MakeMaker';
      }
      return $builder;
  }
  
  =pod
  
  =back
  
  =head1 ENVIRONMENT
  
  =over 4
  
  =item B<PERL_INSTALL_ROOT>
  
  Will be prepended to each install path.
  
  =item B<EU_INSTALL_IGNORE_SKIP>
  
  Will prevent the automatic use of INSTALL.SKIP as the install skip file.
  
  =item B<EU_INSTALL_SITE_SKIPFILE>
  
  If there is no INSTALL.SKIP file in the make directory then this value
  can be used to provide a default.
  
  =item B<EU_INSTALL_ALWAYS_COPY>
  
  If this environment variable is true then normal install processes will
  always overwrite older identical files during the install process.
  
  Note that the alias EU_ALWAYS_COPY will be supported if EU_INSTALL_ALWAYS_COPY
  is not defined until at least the 1.50 release. Please ensure you use the
  correct EU_INSTALL_ALWAYS_COPY.
  
  =back
  
  =head1 AUTHOR
  
  Original author lost in the mists of time.  Probably the same as Makemaker.
  
  Production release currently maintained by demerphq C<yves at cpan.org>,
  extensive changes by Michael G. Schwern.
  
  Send bug reports via http://rt.cpan.org/.  Please send your
  generated Makefile along with your report.
  
  =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
  
  1;
EXTUTILS_INSTALL

$fatpacked{"ExtUtils/InstallPaths.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLPATHS';
  package ExtUtils::InstallPaths;
  $ExtUtils::InstallPaths::VERSION = '0.012';
  use 5.006;
  use strict;
  use warnings;
  
  use File::Spec ();
  use Carp ();
  use ExtUtils::Config 0.002;
  
  my %complex_accessors = map { $_ => 1 } qw/prefix_relpaths install_sets/;
  my %hash_accessors = map { $_ => 1 } qw/install_path install_base_relpaths original_prefix /;
  
  my %defaults = (
  	installdirs     => 'site',
  	install_base    => undef,
  	prefix          => undef,
  	verbose         => 0,
  	create_packlist => 1,
  	dist_name       => undef,
  	module_name     => undef,
  	destdir         => undef,
  	install_path    => sub { {} },
  	install_sets    => \&_default_install_sets,
  	original_prefix => \&_default_original_prefix,
  	install_base_relpaths => \&_default_base_relpaths,
  	prefix_relpaths => \&_default_prefix_relpaths,
  );
  
  sub _merge_shallow {
  	my ($name, $filter) = @_;
  	return sub {
  		my ($override, $config) = @_;
  		my $defaults = $defaults{$name}->($config);
  		$filter->($_) for grep $filter, values %$override;
  		return { %$defaults, %$override };
  	}
  }
  
  sub _merge_deep {
  	my ($name, $filter) = @_;
  	return sub {
  		my ($override, $config) = @_;
  		my $defaults = $defaults{$name}->($config);
  		my $pair_for = sub {
  			my $key = shift;
  			my %override = %{ $override->{$key} || {} };
  			$filter && $filter->($_) for values %override;
  			return $key => { %{ $defaults->{$key} }, %override };
  		};
  		return { map { $pair_for->($_) } keys %$defaults };
  	}
  }
  
  my %allowed_installdir = map { $_ => 1 } qw/core site vendor/;
  my $must_be_relative = sub { Carp::croak('Value must be a relative path') if File::Spec->file_name_is_absolute($_[0]) };
  my %deep_filter = map { $_ => $must_be_relative } qw/install_base_relpaths prefix_relpaths/;
  my %filter = (
  	installdirs => sub {
  		my $value = shift;
  		$value = 'core', Carp::carp('Perhaps you meant installdirs to be "core" rather than "perl"?') if $value eq 'perl';
  		Carp::croak('installdirs must be one of "core", "site", or "vendor"') if not $allowed_installdir{$value};
  		return $value;
  	},
  	(map { $_ => _merge_shallow($_, $deep_filter{$_}) } qw/original_prefix install_base_relpaths/),
  	(map { $_ => _merge_deep($_, $deep_filter{$_}) } qw/install_sets prefix_relpaths/),
  );
  
  sub new {
  	my ($class, %args) = @_;
  	my $config = $args{config} || ExtUtils::Config->new;
  	my %self = (
  		config => $config,
  		map { $_ => exists $args{$_} ? $filter{$_} ? $filter{$_}->($args{$_}, $config) : $args{$_} : ref $defaults{$_} ? $defaults{$_}->($config) : $defaults{$_} } keys %defaults,
  	);
  	$self{module_name} ||= do { my $module_name = $self{dist_name}; $module_name =~ s/-/::/g; $module_name } if defined $self{dist_name};
  	return bless \%self, $class;
  }
  
  for my $attribute (keys %defaults) {
  	no strict qw/refs/;
  	*{$attribute} = $hash_accessors{$attribute} ? 
  	sub {
  		my ($self, $key) = @_;
  		Carp::confess("$attribute needs key") if not defined $key;
  		return $self->{$attribute}{$key};
  	} :
  	$complex_accessors{$attribute} ?
  	sub {
  		my ($self, $installdirs, $key) = @_;
  		Carp::confess("$attribute needs installdir") if not defined $installdirs;
  		Carp::confess("$attribute needs key") if not defined $key;
  		return $self->{$attribute}{$installdirs}{$key};
  	} :
  	sub {
  		my $self = shift;
  		return $self->{$attribute};
  	};
  }
  
  my $script = $] > 5.008000 ? 'script' : 'bin';
  my @install_sets_keys = qw/lib arch bin script bindoc libdoc binhtml libhtml/;
  my @install_sets_tail = ('bin', $script, qw/man1dir man3dir html1dir html3dir/);
  my %install_sets_values = (
  	core   => [ qw/privlib archlib /, @install_sets_tail ],
  	site   => [ map { "site$_" } qw/lib arch/, @install_sets_tail ],
  	vendor => [ map { "vendor$_" } qw/lib arch/, @install_sets_tail ],
  );
  
  sub _default_install_sets {
  	my $c = shift;
  
  	my %ret;
  	for my $installdir (qw/core site vendor/) {
  		@{$ret{$installdir}}{@install_sets_keys} = map { $c->get("install$_") } @{ $install_sets_values{$installdir} };
  	}
  	return \%ret;
  }
  
  sub _default_base_relpaths {
  	my $config = shift;
  	return {
  		lib     => ['lib', 'perl5'],
  		arch    => ['lib', 'perl5', $config->get('archname')],
  		bin     => ['bin'],
  		script  => ['bin'],
  		bindoc  => ['man', 'man1'],
  		libdoc  => ['man', 'man3'],
  		binhtml => ['html'],
  		libhtml => ['html'],
  	};
  }
  
  my %common_prefix_relpaths = (
  	bin        => ['bin'],
  	script     => ['bin'],
  	bindoc     => ['man', 'man1'],
  	libdoc     => ['man', 'man3'],
  	binhtml    => ['html'],
  	libhtml    => ['html'],
  );
  
  sub _default_prefix_relpaths {
  	my $c = shift;
  
  	my @libstyle = $c->get('installstyle') ?  File::Spec->splitdir($c->get('installstyle')) : qw(lib perl5);
  	my $arch     = $c->get('archname');
  	my $version  = $c->get('version');
  
  	return {
  		core => {
  			lib        => [@libstyle],
  			arch       => [@libstyle, $version, $arch],
  			%common_prefix_relpaths,
  		},
  		vendor => {
  			lib        => [@libstyle],
  			arch       => [@libstyle, $version, $arch],
  			%common_prefix_relpaths,
  		},
  		site => {
  			lib        => [@libstyle, 'site_perl'],
  			arch       => [@libstyle, 'site_perl', $version, $arch],
  			%common_prefix_relpaths,
  		},
  	};
  }
  
  sub _default_original_prefix {
  	my $c = shift;
  
  	my %ret = (
  		core   => $c->get('installprefixexp'),
  		site   => $c->get('siteprefixexp'),
  		vendor => $c->get('usevendorprefix') ? $c->get('vendorprefixexp') : '',
  	);
  
  	return \%ret;
  }
  
  sub _log_verbose {
  	my $self = shift;
  	print @_ if $self->verbose;
  	return;
  }
  
  # Given a file type, will return true if the file type would normally
  # be installed when neither install-base nor prefix has been set.
  # I.e. it will be true only if the path is set from Config.pm or
  # set explicitly by the user via install-path.
  sub is_default_installable {
  	my $self = shift;
  	my $type = shift;
  	my $installable = $self->install_destination($type) && ( $self->install_path($type) || $self->install_sets($self->installdirs, $type));
  	return $installable ? 1 : 0;
  }
  
  sub _prefixify_default {
  	my $self = shift;
  	my $type = shift;
  	my $rprefix = shift;
  
  	my $default = $self->prefix_relpaths($self->installdirs, $type);
  	if( !$default ) {
  		$self->_log_verbose("    no default install location for type '$type', using prefix '$rprefix'.\n");
  		return $rprefix;
  	} else {
  		return File::Spec->catdir(@{$default});
  	}
  }
  
  # Translated from ExtUtils::MM_Unix::prefixify()
  sub _prefixify_novms {
  	my($self, $path, $sprefix, $type) = @_;
  
  	my $rprefix = $self->prefix;
  	$rprefix .= '/' if $sprefix =~ m{/$};
  
  	$self->_log_verbose("  prefixify $path from $sprefix to $rprefix\n") if defined $path && length $path;
  
  	if (not defined $path or length $path == 0 ) {
  		$self->_log_verbose("  no path to prefixify, falling back to default.\n");
  		return $self->_prefixify_default( $type, $rprefix );
  	} elsif( !File::Spec->file_name_is_absolute($path) ) {
  		$self->_log_verbose("    path is relative, not prefixifying.\n");
  	} elsif( $path !~ s{^\Q$sprefix\E\b}{}s ) {
  		$self->_log_verbose("    cannot prefixify, falling back to default.\n");
  		return $self->_prefixify_default( $type, $rprefix );
  	}
  
  	$self->_log_verbose("    now $path in $rprefix\n");
  
  	return $path;
  }
  
  sub _catprefix_vms {
  	my ($self, $rprefix, $default) = @_;
  
  	my ($rvol, $rdirs) = File::Spec->splitpath($rprefix);
  	if ($rvol) {
  		return File::Spec->catpath($rvol, File::Spec->catdir($rdirs, $default), '');
  	}
  	else {
  		return File::Spec->catdir($rdirs, $default);
  	}
  }
  sub _prefixify_vms {
  	my($self, $path, $sprefix, $type) = @_;
  	my $rprefix = $self->prefix;
  
  	return '' unless defined $path;
  
  	$self->_log_verbose("  prefixify $path from $sprefix to $rprefix\n");
  
  	require VMS::Filespec;
  	# Translate $(PERLPREFIX) to a real path.
  	$rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
  	$sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
  
  	$self->_log_verbose("  rprefix translated to $rprefix\n  sprefix translated to $sprefix\n");
  
  	if (length($path) == 0 ) {
  		$self->_log_verbose("  no path to prefixify.\n")
  	}
  	elsif (!File::Spec->file_name_is_absolute($path)) {
  		$self->_log_verbose("	path is relative, not prefixifying.\n");
  	}
  	elsif ($sprefix eq $rprefix) {
  		$self->_log_verbose("  no new prefix.\n");
  	}
  	else {
  		my ($path_vol, $path_dirs) = File::Spec->splitpath( $path );
  		my $vms_prefix = $self->config->get('vms_prefix');
  		if ($path_vol eq $vms_prefix.':') {
  			$self->_log_verbose("  $vms_prefix: seen\n");
  
  			$path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
  			$path = $self->_catprefix_vms($rprefix, $path_dirs);
  		}
  		else {
  			$self->_log_verbose("	cannot prefixify.\n");
  			return File::Spec->catdir($self->prefix_relpaths($self->installdirs, $type));
  		}
  	}
  
  	$self->_log_verbose("	now $path\n");
  
  	return $path;
  }
  
  BEGIN { *_prefixify = $^O eq 'VMS' ? \&_prefixify_vms : \&_prefixify_novms }
  
  # Translated from ExtUtils::MM_Any::init_INSTALL_from_PREFIX
  sub prefix_relative {
  	my ($self, $installdirs, $type) = @_;
  
  	my $relpath = $self->install_sets($installdirs, $type);
  
  	return $self->_prefixify($relpath, $self->original_prefix($installdirs), $type);
  }
  
  sub install_destination {
  	my ($self, $type) = @_;
  
  	return $self->install_path($type) if $self->install_path($type);
  
  	if ( $self->install_base ) {
  		my $relpath = $self->install_base_relpaths($type);
  		return $relpath ? File::Spec->catdir($self->install_base, @{$relpath}) : undef;
  	}
  
  	if ( $self->prefix ) {
  		my $relpath = $self->prefix_relative($self->installdirs, $type);
  		return $relpath ? File::Spec->catdir($self->prefix, $relpath) : undef;
  	}
  	return $self->install_sets($self->installdirs, $type);
  }
  
  sub install_types {
  	my $self = shift;
  
  	my %types = ( %{ $self->{install_path} }, 
  		  $self->install_base ?  %{ $self->{install_base_relpaths} }
  		: $self->prefix ? %{ $self->{prefix_relpaths}{ $self->installdirs } }
  		: %{ $self->{install_sets}{ $self->installdirs } });
  
  	return sort keys %types;
  }
  
  sub install_map {
  	my ($self, $dirs) = @_;
  
  	my %localdir_for;
  	if ($dirs && %$dirs) {
  		%localdir_for = %$dirs;
  	}
  	else {
  		foreach my $type ($self->install_types) {
  			$localdir_for{$type} = File::Spec->catdir('blib', $type);
  		}
  	}
  
  	my (%map, @skipping);
  	foreach my $type (keys %localdir_for) {
  		next if not -e $localdir_for{$type};
  		if (my $dest = $self->install_destination($type)) {
  			$map{$localdir_for{$type}} = $dest;
  		} else {
  			push @skipping, $type;
  		}
  	}
  
  	warn "WARNING: Can't figure out install path for types: @skipping\nFiles will not be installed.\n" if @skipping;
  
  	# Write the packlist into the same place as ExtUtils::MakeMaker.
  	if ($self->create_packlist and my $module_name = $self->module_name) {
  		my $archdir = $self->install_destination('arch');
  		my @ext = split /::/, $module_name;
  		$map{write} = File::Spec->catfile($archdir, 'auto', @ext, '.packlist');
  	}
  
  	# Handle destdir
  	if (length(my $destdir = $self->destdir || '')) {
  		foreach (keys %map) {
  			# Need to remove volume from $map{$_} using splitpath, or else
  			# we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
  			# VMS will always have the file separate than the path.
  			my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 0 );
  
  			# catdir needs a list of directories, or it will create something
  			# crazy like volume:[Foo.Bar.volume.Baz.Quux]
  			my @dirs = File::Spec->splitdir($path);
  
  			# First merge the directories
  			$path = File::Spec->catdir($destdir, @dirs);
  
  			# Then put the file back on if there is one.
  			if ($file ne '') {
  			    $map{$_} = File::Spec->catfile($path, $file)
  			} else {
  			    $map{$_} = $path;
  			}
  		}
  	}
  
  	$map{read} = '';  # To keep ExtUtils::Install quiet
  
  	return \%map;
  }
  
  1;
  
  # ABSTRACT: Build.PL install path logic made easy
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  ExtUtils::InstallPaths - Build.PL install path logic made easy
  
  =head1 VERSION
  
  version 0.012
  
  =head1 SYNOPSIS
  
   use ExtUtils::InstallPaths;
   use ExtUtils::Install 'install';
   GetOptions(\my %opt, 'install_base=s', 'install_path=s%', 'installdirs=s', 'destdir=s', 'prefix=s', 'uninst:1', 'verbose:1');
   my $paths = ExtUtils::InstallPaths->new(%opt, dist_name => $dist_name);
   install($paths->install_map, $opt{verbose}, 0, $opt{uninst});
  
  =head1 DESCRIPTION
  
  This module tries to make install path resolution as easy as possible.
  
  When you want to install a module, it needs to figure out where to install things. The nutshell version of how this works is that default installation locations are determined from L<ExtUtils::Config>, and they may be individually overridden by using the C<install_path> attribute. An C<install_base> attribute lets you specify an alternative installation root like F</home/foo> and C<prefix> does something similar in a rather different (and more complicated) way. C<destdir> lets you specify a temporary installation directory like F</tmp/install> in case you want to create bundled-up installable packages.
  
  The following types are supported by default.
  
  =over 4
  
  =item * lib
  
  Usually pure-Perl module files ending in F<.pm> or F<.pod>.
  
  =item * arch
  
  "Architecture-dependent" module files, usually produced by compiling XS, L<Inline>, or similar code.
  
  =item * script
  
  Programs written in pure Perl.  In order to improve reuse, you may want to make these as small as possible - put the code into modules whenever possible.
  
  =item * bin
  
  "Architecture-dependent" executable programs, i.e. compiled C code or something.  Pretty rare to see this in a perl distribution, but it happens.
  
  =item * bindoc
  
  Documentation for the stuff in C<script> and C<bin>.  Usually generated from the POD in those files.  Under Unix, these are manual pages belonging to the 'man1' category. Unless explicitly set, this is only available on platforms supporting manpages.
  
  =item * libdoc
  
  Documentation for the stuff in C<lib> and C<arch>.  This is usually generated from the POD in F<.pm> and F<.pod> files.  Under Unix, these are manual pages belonging to the 'man3' category. Unless explicitly set, this is only available on platforms supporting manpages.
  
  =item * binhtml
  
  This is the same as C<bindoc> above, but applies to HTML documents. Unless explicitly set, this is only available when perl was configured to do so.
  
  =item * libhtml
  
  This is the same as C<libdoc> above, but applies to HTML documents. Unless explicitly set, this is only available when perl was configured to do so.
  
  =back
  
  =head1 ATTRIBUTES
  
  =head2 installdirs
  
  The default destinations for these installable things come from entries in your system's configuration. You can select from three different sets of default locations by setting the C<installdirs> parameter as follows:
  
                            'installdirs' set to:
                     core          site                vendor
  
                uses the following defaults from ExtUtils::Config:
  
    lib     => installprivlib  installsitelib      installvendorlib
    arch    => installarchlib  installsitearch     installvendorarch
    script  => installscript   installsitescript   installvendorscript
    bin     => installbin      installsitebin      installvendorbin
    bindoc  => installman1dir  installsiteman1dir  installvendorman1dir
    libdoc  => installman3dir  installsiteman3dir  installvendorman3dir
    binhtml => installhtml1dir installsitehtml1dir installvendorhtml1dir [*]
    libhtml => installhtml3dir installsitehtml3dir installvendorhtml3dir [*]
  
    * Under some OS (eg. MSWin32) the destination for HTML documents is determined by the C<Config.pm> entry C<installhtmldir>.
  
  The default value of C<installdirs> is "site".
  
  =head2 install_base
  
  You can also set the whole bunch of installation paths by supplying the C<install_base> parameter to point to a directory on your system.  For instance, if you set C<install_base> to "/home/ken" on a Linux system, you'll install as follows:
  
    lib     => /home/ken/lib/perl5
    arch    => /home/ken/lib/perl5/i386-linux
    script  => /home/ken/bin
    bin     => /home/ken/bin
    bindoc  => /home/ken/man/man1
    libdoc  => /home/ken/man/man3
    binhtml => /home/ken/html
    libhtml => /home/ken/html
  
  =head2 prefix
  
  This sets a prefix, identical to ExtUtils::MakeMaker's PREFIX option. This does something similar to C<install_base> in a much more complicated way.
  
  =head2 config()
  
  The L<ExtUtils::Config|ExtUtils::Config> object used for this object.
  
  =head2 verbose
  
  The verbosity of ExtUtils::InstallPaths. It defaults to 0
  
  =head2 create_packlist
  
  Together with C<module_name> this controls whether a packlist will be added; it defaults to 1.
  
  =head2 dist_name
  
  The name of the current module.
  
  =head2 module_name
  
  The name of the main module of the package. This is required for packlist creation, but in the future it may be replaced by dist_name. It defaults to C<dist_name =~ s/-/::/gr> if dist_name is set.
  
  =head2 destdir
  
  If you want to install everything into a temporary directory first (for instance, if you want to create a directory tree that a package manager like C<rpm> or C<dpkg> could create a package from), you can use the C<destdir> parameter. E.g. Setting C<destdir> to C<"/tmp/foo"> will effectively install to "/tmp/foo/$sitelib", "/tmp/foo/$sitearch", and the like, except that it will use C<File::Spec> to make the pathnames work correctly on whatever platform you're installing on.
  
  =head1 METHODS
  
  =head2 new
  
  Create a new ExtUtils::InstallPaths object. B<All attributes are valid arguments> to the constructor, as well as this:
  
  =over 4
  
  =item * install_path
  
  This must be a hashref with the type as keys and the destination as values.
  
  =item * install_base_relpaths
  
  This must be a hashref with types as keys and a path relative to the install_base as value.
  
  =item * prefix_relpaths
  
  This must be a hashref any of these three keys: core, vendor, site. Each of the values mush be a hashref with types as keys and a path relative to the prefix as value. You probably want to make these three hashrefs identical.
  
  =item * original_prefix
  
  This must be a hashref with the legal installdirs values as keys and the prefix directories as values.
  
  =item * install_sets
  
  This mush be a hashref with the legal installdirs are keys, and the values being hashrefs with types as keys and locations as values.
  
  =back
  
  =head2 install_map()
  
  Return a map suitable for use with L<ExtUtils::Install>. B<In most cases, this is the only method you'll need>.
  
  =head2 install_destination($type)
  
  Returns the destination of a certain type.
  
  =head2 install_types()
  
  Return a list of all supported install types in the current configuration.
  
  =head2 is_default_installable($type)
  
  Given a file type, will return true if the file type would normally be installed when neither install-base nor prefix has been set.  I.e. it will be true only if the path is set from the configuration object or set explicitly by the user via install_path.
  
  =head2 install_path($type)
  
  Gets the install path for a certain type.
  
  =head2 install_sets($installdirs, $type)
  
  Get the path for a certain C<$type> with a certain C<$installdirs>.
  
  =head2 install_base_relpaths($type, $relpath)
  
  Get the relative paths for use with install_base for a certain type.
  
  =head2 prefix_relative($installdirs, $type)
  
  Gets the path of a certain C<$type> and C<$installdirs> relative to the prefix.
  
  =head2 prefix_relpaths($install_dirs, $type)
  
  Get the default relative path to use in case the config install paths cannot be prefixified. You do not want to use this to get any relative path, but may require it to set it for custom types.
  
  =head2 original_prefix($installdirs)
  
  Get the original prefix for a certain type of $installdirs.
  
  =head1 SEE ALSO
  
  =over 4
  
  =item * L<Build.PL spec|http://github.com/dagolden/cpan-api-buildpl/blob/master/lib/CPAN/API/BuildPL.pm>
  
  =back
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Ken Williams <kwilliams@cpan.org>
  
  =item *
  
  Leon Timmermans <leont@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2011 by Ken Williams, Leon Timmermans.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
EXTUTILS_INSTALLPATHS

$fatpacked{"ExtUtils/Installed.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLED';
  package ExtUtils::Installed;
  
  use 5.00503;
  use strict;
  #use warnings; # XXX requires 5.6
  use Carp qw();
  use ExtUtils::Packlist;
  use ExtUtils::MakeMaker;
  use Config;
  use File::Find;
  use File::Basename;
  use File::Spec;
  
  my $Is_VMS = $^O eq 'VMS';
  my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);
  
  require VMS::Filespec if $Is_VMS;
  
  use vars qw($VERSION);
  $VERSION = '2.06';
  $VERSION = eval $VERSION;
  
  sub _is_prefix {
      my ($self, $path, $prefix) = @_;
      return unless defined $prefix && defined $path;
  
      if( $Is_VMS ) {
          $prefix = VMS::Filespec::unixify($prefix);
          $path   = VMS::Filespec::unixify($path);
      }
  
      # Unix path normalization.
      $prefix = File::Spec->canonpath($prefix);
  
      return 1 if substr($path, 0, length($prefix)) eq $prefix;
  
      if ($DOSISH) {
          $path =~ s|\\|/|g;
          $prefix =~ s|\\|/|g;
          return 1 if $path =~ m{^\Q$prefix\E}i;
      }
      return(0);
  }
  
  sub _is_doc {
      my ($self, $path) = @_;
  
      my $man1dir = $self->{':private:'}{Config}{man1direxp};
      my $man3dir = $self->{':private:'}{Config}{man3direxp};
      return(($man1dir && $self->_is_prefix($path, $man1dir))
             ||
             ($man3dir && $self->_is_prefix($path, $man3dir))
             ? 1 : 0)
  }
  
  sub _is_type {
      my ($self, $path, $type) = @_;
      return 1 if $type eq "all";
  
      return($self->_is_doc($path)) if $type eq "doc";
      my $conf= $self->{':private:'}{Config};
      if ($type eq "prog") {
          return($self->_is_prefix($path, $conf->{prefix} || $conf->{prefixexp})
                 && !($self->_is_doc($path)) ? 1 : 0);
      }
      return(0);
  }
  
  sub _is_under {
      my ($self, $path, @under) = @_;
      $under[0] = "" if (! @under);
      foreach my $dir (@under) {
          return(1) if ($self->_is_prefix($path, $dir));
      }
  
      return(0);
  }
  
  sub _fix_dirs {
      my ($self, @dirs)= @_;
      # File::Find does not know how to deal with VMS filepaths.
      if( $Is_VMS ) {
          $_ = VMS::Filespec::unixify($_)
              for @dirs;
      }
  
      if ($DOSISH) {
          s|\\|/|g for @dirs;
      }
      return wantarray ? @dirs : $dirs[0];
  }
  
  sub _make_entry {
      my ($self, $module, $packlist_file, $modfile)= @_;
  
      my $data= {
          module => $module,
          packlist => scalar(ExtUtils::Packlist->new($packlist_file)),
          packlist_file => $packlist_file,
      };
  
      if (!$modfile) {
          $data->{version} = $self->{':private:'}{Config}{version};
      } else {
          $data->{modfile} = $modfile;
          # Find the top-level module file in @INC
          $data->{version} = '';
          foreach my $dir (@{$self->{':private:'}{INC}}) {
              my $p = File::Spec->catfile($dir, $modfile);
              if (-r $p) {
                  $module = _module_name($p, $module) if $Is_VMS;
  
                  $data->{version} = MM->parse_version($p);
                  $data->{version_from} = $p;
                  $data->{packlist_valid} = exists $data->{packlist}{$p};
                  last;
              }
          }
      }
      $self->{$module}= $data;
  }
  
  our $INSTALLED;
  sub new {
      my ($class) = shift(@_);
      $class = ref($class) || $class;
  
      my %args = @_;
  
      return $INSTALLED if $INSTALLED and ($args{default_get} || $args{default});
  
      my $self = bless {}, $class;
  
      $INSTALLED= $self if $args{default_set} || $args{default};
  
  
      if ($args{config_override}) {
          eval {
              $self->{':private:'}{Config} = { %{$args{config_override}} };
          } or Carp::croak(
              "The 'config_override' parameter must be a hash reference."
          );
      }
      else {
          $self->{':private:'}{Config} = \%Config;
      }
  
      for my $tuple ([inc_override => INC => [ @INC ] ],
                     [ extra_libs => EXTRA => [] ])
      {
          my ($arg,$key,$val)=@$tuple;
          if ( $args{$arg} ) {
              eval {
                  $self->{':private:'}{$key} = [ @{$args{$arg}} ];
              } or Carp::croak(
                  "The '$arg' parameter must be an array reference."
              );
          }
          elsif ($val) {
              $self->{':private:'}{$key} = $val;
          }
      }
      {
          my %dupe;
          @{$self->{':private:'}{LIBDIRS}} =
              grep { $_ ne '.' || ! $args{skip_cwd} }
              grep { -e $_ && !$dupe{$_}++ }
              @{$self->{':private:'}{EXTRA}}, @{$self->{':private:'}{INC}};
      }
  
      my @dirs= $self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}});
  
      # Read the core packlist
      my $archlib = $self->_fix_dirs($self->{':private:'}{Config}{archlibexp});
      $self->_make_entry("Perl",File::Spec->catfile($archlib, '.packlist'));
  
      my $root;
      # Read the module packlists
      my $sub = sub {
          # Only process module .packlists
          return if $_ ne ".packlist" || $File::Find::dir eq $archlib;
  
          # Hack of the leading bits of the paths & convert to a module name
          my $module = $File::Find::name;
          my $found = $module =~ s!^.*?/auto/(.*)/.packlist!$1!s
              or do {
              # warn "Woah! \$_=$_\n\$module=$module\n\$File::Find::dir=$File::Find::dir\n",
              #    join ("\n",@dirs);
              return;
          };
  
          my $modfile = "$module.pm";
          $module =~ s!/!::!g;
  
          return if $self->{$module}; #shadowing?
          $self->_make_entry($module,$File::Find::name,$modfile);
      };
      while (@dirs) {
          $root= shift @dirs;
          next if !-d $root;
          find($sub,$root);
      }
  
      return $self;
  }
  
  # VMS's non-case preserving file-system means the package name can't
  # be reconstructed from the filename.
  sub _module_name {
      my($file, $orig_module) = @_;
  
      my $module = '';
      if (open PACKFH, $file) {
          while (<PACKFH>) {
              if (/package\s+(\S+)\s*;/) {
                  my $pack = $1;
                  # Make a sanity check, that lower case $module
                  # is identical to lowercase $pack before
                  # accepting it
                  if (lc($pack) eq lc($orig_module)) {
                      $module = $pack;
                      last;
                  }
              }
          }
          close PACKFH;
      }
  
      print STDERR "Couldn't figure out the package name for $file\n"
        unless $module;
  
      return $module;
  }
  
  sub modules {
      my ($self) = @_;
      $self= $self->new(default=>1) if !ref $self;
  
      # Bug/feature of sort in scalar context requires this.
      return wantarray
          ? sort grep { not /^:private:$/ } keys %$self
          : grep { not /^:private:$/ } keys %$self;
  }
  
  sub files {
      my ($self, $module, $type, @under) = @_;
      $self= $self->new(default=>1) if !ref $self;
  
      # Validate arguments
      Carp::croak("$module is not installed") if (! exists($self->{$module}));
      $type = "all" if (! defined($type));
      Carp::croak('type must be "all", "prog" or "doc"')
          if ($type ne "all" && $type ne "prog" && $type ne "doc");
  
      my (@files);
      foreach my $file (keys(%{$self->{$module}{packlist}})) {
          push(@files, $file)
            if ($self->_is_type($file, $type) &&
                $self->_is_under($file, @under));
      }
      return(@files);
  }
  
  sub directories {
      my ($self, $module, $type, @under) = @_;
      $self= $self->new(default=>1) if !ref $self;
      my (%dirs);
      foreach my $file ($self->files($module, $type, @under)) {
          $dirs{dirname($file)}++;
      }
      return sort keys %dirs;
  }
  
  sub directory_tree {
      my ($self, $module, $type, @under) = @_;
      $self= $self->new(default=>1) if !ref $self;
      my (%dirs);
      foreach my $dir ($self->directories($module, $type, @under)) {
          $dirs{$dir}++;
          my ($last) = ("");
          while ($last ne $dir) {
              $last = $dir;
              $dir = dirname($dir);
              last if !$self->_is_under($dir, @under);
              $dirs{$dir}++;
          }
      }
      return(sort(keys(%dirs)));
  }
  
  sub validate {
      my ($self, $module, $remove) = @_;
      $self= $self->new(default=>1) if !ref $self;
      Carp::croak("$module is not installed") if (! exists($self->{$module}));
      return($self->{$module}{packlist}->validate($remove));
  }
  
  sub packlist {
      my ($self, $module) = @_;
      $self= $self->new(default=>1) if !ref $self;
      Carp::croak("$module is not installed") if (! exists($self->{$module}));
      return($self->{$module}{packlist});
  }
  
  sub version {
      my ($self, $module) = @_;
      $self= $self->new(default=>1) if !ref $self;
      Carp::croak("$module is not installed") if (! exists($self->{$module}));
      return($self->{$module}{version});
  }
  
  sub debug_dump {
      my ($self, $module) = @_;
      $self= $self->new(default=>1) if !ref $self;
      local $self->{":private:"}{Config};
      require Data::Dumper;
      print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump();
  }
  
  
  1;
  
  __END__
  
  =head1 NAME
  
  ExtUtils::Installed - Inventory management of installed modules
  
  =head1 SYNOPSIS
  
     use ExtUtils::Installed;
     my ($inst) = ExtUtils::Installed->new( skip_cwd => 1 );
     my (@modules) = $inst->modules();
     my (@missing) = $inst->validate("DBI");
     my $all_files = $inst->files("DBI");
     my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
     my $all_dirs = $inst->directories("DBI");
     my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
     my $packlist = $inst->packlist("DBI");
  
  =head1 DESCRIPTION
  
  ExtUtils::Installed  provides a standard way to find out what core and module
  files have been installed.  It uses the information stored in .packlist files
  created during installation to provide this information.  In addition it
  provides facilities to classify the installed files and to extract directory
  information from the .packlist files.
  
  =head1 USAGE
  
  The new() function searches for all the installed .packlists on the system, and
  stores their contents. The .packlists can be queried with the functions
  described below. Where it searches by default is determined by the settings found
  in C<%Config::Config>, and what the value is of the PERL5LIB environment variable.
  
  =head1 METHODS
  
  Unless specified otherwise all method can be called as class methods, or as object
  methods. If called as class methods then the "default" object will be used, and if
  necessary created using the current processes %Config and @INC.  See the
  'default' option to new() for details.
  
  
  =over 4
  
  =item new()
  
  This takes optional named parameters. Without parameters, this
  searches for all the installed .packlists on the system using
  information from C<%Config::Config> and the default module search
  paths C<@INC>. The packlists are read using the
  L<ExtUtils::Packlist> module.
  
  If the named parameter C<skip_cwd> is true, the current directory C<.> will
  be stripped from C<@INC> before searching for .packlists.  This keeps
  ExtUtils::Installed from finding modules installed in other perls that
  happen to be located below the current directory.
  
  If the named parameter C<config_override> is specified,
  it should be a reference to a hash which contains all information
  usually found in C<%Config::Config>. For example, you can obtain
  the configuration information for a separate perl installation and
  pass that in.
  
      my $yoda_cfg  = get_fake_config('yoda');
      my $yoda_inst =
                 ExtUtils::Installed->new(config_override=>$yoda_cfg);
  
  Similarly, the parameter C<inc_override> may be a reference to an
  array which is used in place of the default module search paths
  from C<@INC>.
  
      use Config;
      my @dirs = split(/\Q$Config{path_sep}\E/, $ENV{PERL5LIB});
      my $p5libs = ExtUtils::Installed->new(inc_override=>\@dirs);
  
  B<Note>: You probably do not want to use these options alone, almost always
  you will want to set both together.
  
  The parameter C<extra_libs> can be used to specify B<additional> paths to
  search for installed modules. For instance
  
      my $installed =
               ExtUtils::Installed->new(extra_libs=>["/my/lib/path"]);
  
  This should only be necessary if F</my/lib/path> is not in PERL5LIB.
  
  Finally there is the 'default', and the related 'default_get' and 'default_set'
  options. These options control the "default" object which is provided by the
  class interface to the methods. Setting C<default_get> to true tells the constructor
  to return the default object if it is defined. Setting C<default_set> to true tells
  the constructor to make the default object the constructed object. Setting the
  C<default> option is like setting both to true. This is used primarily internally
  and probably isn't interesting to any real user.
  
  =item modules()
  
  This returns a list of the names of all the installed modules.  The perl 'core'
  is given the special name 'Perl'.
  
  =item files()
  
  This takes one mandatory parameter, the name of a module.  It returns a list of
  all the filenames from the package.  To obtain a list of core perl files, use
  the module name 'Perl'.  Additional parameters are allowed.  The first is one
  of the strings "prog", "doc" or "all", to select either just program files,
  just manual files or all files.  The remaining parameters are a list of
  directories. The filenames returned will be restricted to those under the
  specified directories.
  
  =item directories()
  
  This takes one mandatory parameter, the name of a module.  It returns a list of
  all the directories from the package.  Additional parameters are allowed.  The
  first is one of the strings "prog", "doc" or "all", to select either just
  program directories, just manual directories or all directories.  The remaining
  parameters are a list of directories. The directories returned will be
  restricted to those under the specified directories.  This method returns only
  the leaf directories that contain files from the specified module.
  
  =item directory_tree()
  
  This is identical in operation to directories(), except that it includes all the
  intermediate directories back up to the specified directories.
  
  =item validate()
  
  This takes one mandatory parameter, the name of a module.  It checks that all
  the files listed in the modules .packlist actually exist, and returns a list of
  any missing files.  If an optional second argument which evaluates to true is
  given any missing files will be removed from the .packlist
  
  =item packlist()
  
  This returns the ExtUtils::Packlist object for the specified module.
  
  =item version()
  
  This returns the version number for the specified module.
  
  =back
  
  =head1 EXAMPLE
  
  See the example in L<ExtUtils::Packlist>.
  
  =head1 AUTHOR
  
  Alan Burlison <Alan.Burlison@uk.sun.com>
  
  =cut
EXTUTILS_INSTALLED

$fatpacked{"ExtUtils/Liblist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_LIBLIST';
  package ExtUtils::Liblist;
  
  use strict;
  
  our $VERSION = '7.36';
  $VERSION =~ tr/_//d;
  
  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 my $dir_fh, $_[0];
    my @out = grep /$rex/, readdir $dir_fh;
    closedir $dir_fh;
    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.36';
  $VERSION =~ tr/_//d;
  
  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
  
      require Text::ParseWords;
  
      my ( @searchpath );    # from "-L/path" entries in $potential_libs
      my ( @libpath ) = Text::ParseWords::quotewords( '\s+', 0, $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;
  
      if ( $^O eq 'darwin' or $^O eq 'next' )  {
          # 'escape' Mach-O ld -framework and -F flags, so they aren't dropped later on
          $potential_libs =~ s/(^|\s)(-(?:weak_|reexport_|lazy_)?framework)\s+(\S+)/$1-Wl,$2 -Wl,$3/g;
          $potential_libs =~ s/(^|\s)(-F)\s*(\S+)/$1-Wl,$2 -Wl,$3/g;
      }
  
      foreach my $thislib ( Text::ParseWords::quotewords( '\s+', 0, $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 );
              $thislib = qq{"$thislib"} if $thislib =~ / /; # protect spaces if there
              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 = sort 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.36';
  $VERSION =~ tr/_//d;
  
  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.36';
  $VERSION =~ tr/_//d;
  
  use ExtUtils::MakeMaker::Config;
  require ExtUtils::MM_Unix;
  our @ISA = qw(ExtUtils::MM_Unix);
  
  =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;
      join "\n", $self->xs_dlsyms_iterator(\%attribs);
  }
  
  =head3 xs_dlsyms_ext
  
  On AIX, is C<.exp>.
  
  =cut
  
  sub xs_dlsyms_ext {
      '.exp';
  }
  
  sub xs_dlsyms_arg {
      my($self, $file) = @_;
      my $arg = qq{-bE:${file}};
      $arg = '-Wl,'.$arg if $Config{lddlflags} =~ /-Wl,-bE:/;
      return $arg;
  }
  
  sub init_others {
      my $self = shift;
      $self->SUPER::init_others;
      # perl "hints" add -bE:$(BASEEXT).exp to LDDLFLAGS. strip that out
      # so right value can be added by xs_make_dynamic_lib to work for XSMULTI
      $self->{LDDLFLAGS} ||= $Config{lddlflags};
      $self->{LDDLFLAGS} =~ s#(\s*)\S*\Q$(BASEEXT)\E\S*(\s*)#$1$2#;
      return;
  }
  
  =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.36';
  $VERSION =~ tr/_//d;
  
  use Carp;
  use File::Spec;
  use File::Basename;
  BEGIN { our @ISA = qw(File::Spec); }
  
  # We need $Verbose
  use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562);
  
  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 $Updir   = __PACKAGE__->updir;
  
  my $METASPEC_URL = 'https://metacpan.org/pod/CPAN::Meta::Spec';
  my $METASPEC_V = 2;
  
  =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
  
  my %maketype2true;
  # undocumented - so t/cd.t can still do its thing
  sub _clear_maketype_cache { %maketype2true = () }
  
  sub is_make_type {
      my($self, $type) = @_;
      return $maketype2true{$type} if defined $maketype2true{$type};
      (undef, undef, my $make_basename) = $self->splitpath($self->make);
      return $maketype2true{$type} = 1
          if $make_basename =~ /\b$type\b/i; # executable's filename
      return $maketype2true{$type} = 0
          if $make_basename =~ /\b[gdn]make\b/i; # Never fall through for dmake/nmake/gmake
      # 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 $maketype2true{$type} = 1
          if $type eq 'gmake' and $minus_v =~ /GNU make/i;
      return $maketype2true{$type} = 1
          if $type eq 'bsdmake'
        and $minus_v =~ /^usage: make \[-BeikNnqrstWwX\]/im;
      $maketype2true{$type} = 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 make_type
  
  Returns a suitable string describing the type of makefile being written.
  
  =cut
  
  # override if this isn't suitable!
  sub make_type { return 'Unix-style'; }
  
  
  =head3 stashmeta
  
      my @recipelines = $MM->stashmeta($text, $file);
  
  Generates a set of C<@recipelines> which will result in the literal
  C<$text> ending up in literal C<$file> when the recipe is executed. Call
  it once, with all the text you want in C<$file>. Make macros will not
  be expanded, so the locations will be fixed at configure-time, not
  at build-time.
  
  =cut
  
  sub stashmeta {
      my($self, $text, $file) = @_;
      $self->echo($text, $file, { allow_variables => 0, append => 0 });
  }
  
  
  =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 = join '', 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';
  
  Dollar signs in the $perl_code will be protected from make using the
  C<quote_literal> method, unless they are recognised as being a make
  variable, C<$(varname)>, in which case they will be left for make
  to expand. 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 _xs_list_basenames {
      my ($self) = @_;
      map { (my $b = $_) =~ s/\.xs$//; $b } sort keys %{ $self->{XS} };
  }
  
  sub blibdirs_target {
      my $self = shift;
  
      my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib
                                             autodir archautodir
                                             bin script
                                             man1dir man3dir
                                            );
      if ($self->{XSMULTI}) {
          for my $ext ($self->_xs_list_basenames) {
              my ($v, $d, $f) = File::Spec->splitpath($ext);
              my @d = File::Spec->splitdir($d);
              shift @d if $d[0] eq 'lib';
              push @dirs, $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f);
  	}
      }
  
      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
      push @files, map {
  	my $file = $_;
  	map { $file.$_ } $self->{OBJ_EXT}, qw(.def _def.old .bs .bso .exp .base);
      } $self->_xs_list_basenames;
      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 xs_dlsyms_arg
  
  Returns command-line arg(s) to linker for file listing dlsyms to export.
  Defaults to returning empty string, can be overridden by e.g. AIX.
  
  =cut
  
  sub xs_dlsyms_arg {
      return '';
  }
  
  =head3 xs_dlsyms_ext
  
  Returns file-extension for C<xs_make_dlsyms> method's output file,
  including any "." character.
  
  =cut
  
  sub xs_dlsyms_ext {
      die "Pure virtual method";
  }
  
  =head3 xs_dlsyms_extra
  
  Returns any extra text to be prepended to the C<$extra> argument of
  C<xs_make_dlsyms>.
  
  =cut
  
  sub xs_dlsyms_extra {
      '';
  }
  
  =head3 xs_dlsyms_iterator
  
  Iterates over necessary shared objects, calling C<xs_make_dlsyms> method
  for each with appropriate arguments.
  
  =cut
  
  sub xs_dlsyms_iterator {
      my ($self, $attribs) = @_;
      if ($self->{XSMULTI}) {
          my @m;
          for my $ext ($self->_xs_list_basenames) {
              my @parts = File::Spec->splitdir($ext);
              shift @parts if $parts[0] eq 'lib';
              my $name = join '::', @parts;
              push @m, $self->xs_make_dlsyms(
                  $attribs,
                  $ext . $self->xs_dlsyms_ext,
                  "$ext.xs",
                  $name,
                  $parts[-1],
                  {}, [], {}, [],
                  $self->xs_dlsyms_extra . q!, 'FILE' => ! . neatvalue($ext),
              );
          }
          return join "\n", @m;
      } else {
          return $self->xs_make_dlsyms(
              $attribs,
              $self->{BASEEXT} . $self->xs_dlsyms_ext,
              'Makefile.PL',
              $self->{NAME},
              $self->{DLBASE},
              $attribs->{DL_FUNCS} || $self->{DL_FUNCS} || {},
              $attribs->{FUNCLIST} || $self->{FUNCLIST} || [],
              $attribs->{IMPORTS} || $self->{IMPORTS} || {},
              $attribs->{DL_VARS} || $self->{DL_VARS} || [],
              $self->xs_dlsyms_extra,
          );
      }
  }
  
  =head3 xs_make_dlsyms
  
      $self->xs_make_dlsyms(
          \%attribs, # hashref from %attribs in caller
          "$self->{BASEEXT}.def", # output file for Makefile target
          'Makefile.PL', # dependency
          $self->{NAME}, # shared object's "name"
          $self->{DLBASE}, # last ::-separated part of name
          $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}, # various params
          $attribs{FUNCLIST} || $self->{FUNCLIST} || [],
          $attribs{IMPORTS} || $self->{IMPORTS} || {},
          $attribs{DL_VARS} || $self->{DL_VARS} || [],
          # optional extra param that will be added as param to Mksymlists
      );
  
  Utility method that returns Makefile snippet to call C<Mksymlists>.
  
  =cut
  
  sub xs_make_dlsyms {
      my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_;
      my @m = (
       "\n$target: $dep\n",
       q!	$(PERLRUN) -MExtUtils::Mksymlists \\
       -e "Mksymlists('NAME'=>\"!, $name,
       q!\", 'DLBASE' => '!,$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)
      );
      push @m, $extra if defined $extra;
      push @m, qq!);"\n!;
      join '', @m;
  }
  
  =head3 dynamic (o)
  
  Defines the dynamic target.
  
  =cut
  
  sub dynamic {
  # --- Dynamic Loading Sections ---
  
      my($self) = shift;
      '
  dynamic :: $(FIRST_MAKEFILE) config $(INST_BOOT) $(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 config $dependencies
  END
  
      my @man_cmds;
      foreach my $section (qw(1 3)) {
          my $pods = $self->{"MAN${section}PODS"};
          my $p2m = sprintf <<'CMD', $section, "$]" > 5.008 ? " -u" : "";
  	$(NOECHO) $(POD2MAN) --section=%s --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;
  }
  
  {
      my $has_cpan_meta;
      sub _has_cpan_meta {
          return $has_cpan_meta if defined $has_cpan_meta;
          return $has_cpan_meta = !!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} || {},
      );
  
      my $meta = $self->_fix_metadata_before_conversion( $metadata );
  
      my @write_metayml = $self->stashmeta(
        $meta->as_string({version => "1.4"}), 'META_new.yml'
      );
      my @write_metajson = $self->stashmeta(
        $meta->as_string({version => "2.0"}), '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
  
      $mm->_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 ( $self, $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 $validator2 = CPAN::Meta::Validator->new( $metadata );
      my @errors;
      push @errors, $validator2->errors if !$validator2->is_valid;
      my $validator14 = CPAN::Meta::Validator->new(
          {
              %$metadata,
              'meta-spec' => { version => 1.4 },
          }
      );
      push @errors, $validator14->errors if !$validator14->is_valid;
      # fix non-camelcase custom resource keys (only other trick we know)
      for my $error ( @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 !$validator14->custom_1( $new_key );
  
          # copy to new key if that worked
          $metadata->{resources}{$new_key} = $metadata->{resources}{$key}
            if $validator14->custom_1( $new_key );
  
          # and delete old one in any case
          delete $metadata->{resources}{$key};
      }
  
      # 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 => $METASPEC_V } ) }      ||
          !eval { $meta->as_string }
      ) {
          $meta = bless $metadata, 'CPAN::Meta';
      }
  
      my $now_license = $meta->as_struct({ version => 2 })->{license};
      if ($self->{LICENSE} and $self->{LICENSE} ne 'unknown' and
          @{$now_license} == 1 and $now_license->[0] eq 'unknown'
      ) {
          warn "Invalid LICENSE value '$self->{LICENSE}' ignored\n";
      }
  
      $meta;
  }
  
  
  =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_hashref = $mm->metafile_data(\%meta_add, \%meta_merge);
  
  Returns the data which MakeMaker turns into the META.yml file 
  and the META.json file. It is always in version 2.0 of the format.
  
  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) = @_;
  
      $meta_add ||= {};
      $meta_merge ||= {};
  
      my $version = _normalize_version($self->{VERSION});
      my $release_status = ($version =~ /_/) ? 'unstable' : 'stable';
      my %meta = (
          # required
          abstract     => $self->{ABSTRACT} || 'unknown',
          author       => defined($self->{AUTHOR}) ? $self->{AUTHOR} : ['unknown'],
          dynamic_config => 1,
          generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION",
          license      => [ $self->{LICENSE} || 'unknown' ],
          'meta-spec'  => {
              url         => $METASPEC_URL,
              version     => $METASPEC_V,
          },
          name         => $self->{DISTNAME},
          release_status => $release_status,
          version      => $version,
  
          # optional
          no_index     => { directory => [qw(t inc)] },
      );
      $self->_add_requirements_to_meta(\%meta);
  
      if (!eval { require JSON::PP; require CPAN::Meta::Converter; CPAN::Meta::Converter->VERSION(2.141170) }) {
        return \%meta;
      }
  
      # needs to be based on the original version
      my $v1_add = _metaspec_version($meta_add) !~ /^2/;
  
      my ($add_v, $merge_v) = map _metaspec_version($_), $meta_add, $meta_merge;
      for my $frag ($meta_add, $meta_merge) {
          my $def_v = $frag == $meta_add ? $merge_v : $add_v;
          $frag = CPAN::Meta::Converter->new($frag, default_version => $def_v)->upgrade_fragment;
      }
  
      # if we upgraded a 1.x _ADD fragment, we gave it a prereqs key that
      # will override all prereqs, which is more than the user asked for;
      # instead, we'll go inside the prereqs and override all those
      while( my($key, $val) = each %$meta_add ) {
          if ($v1_add and $key eq 'prereqs') {
              $meta{$key}{$_} = $val->{$_} for keys %$val;
          } elsif ($key ne 'meta-spec') {
              $meta{$key} = $val;
          }
      }
  
      while( my($key, $val) = each %$meta_merge ) {
          next if $key eq 'meta-spec';
          $self->_hash_merge(\%meta, $key, $val);
      }
  
      return \%meta;
  }
  
  
  =begin private
  
  =cut
  
  sub _add_requirements_to_meta {
      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.
      $meta->{prereqs}{configure}{requires} = $self->{ARGS}{CONFIGURE_REQUIRES}
          ? $self->{CONFIGURE_REQUIRES}
          : { 'ExtUtils::MakeMaker' => 0, };
      $meta->{prereqs}{build}{requires} = $self->{ARGS}{BUILD_REQUIRES}
          ? $self->{BUILD_REQUIRES}
          : { 'ExtUtils::MakeMaker' => 0, };
      $meta->{prereqs}{test}{requires} = $self->{TEST_REQUIRES}
          if $self->{ARGS}{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};
  }
  
  # spec version of given fragment - if not given, assume 1.4
  sub _metaspec_version {
    my ( $meta ) = @_;
    return $meta->{'meta-spec'}->{version}
      if defined $meta->{'meta-spec'}
         and defined $meta->{'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};
  }
  
  # Adapted from Module::Build::Base
  sub _normalize_version {
    my ($version) = @_;
    $version = 0 unless defined $version;
  
    if ( ref $version eq 'version' ) { # version objects
      $version = $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 die "Could not add META.yml to MANIFEST: ${'@'}"
  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 die "Could not add META.json to MANIFEST: ${'@'}"
  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 ) {
          $mymeta = $self->metafile_data(
              $self->{META_ADD}   || {},
              $self->{META_MERGE} || {},
          );
          $v2 = 0;
      }
  
      # Overwrite the non-configure dependency hashes
      $self->_add_requirements_to_meta($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();
  
      my $meta_obj = $self->_fix_metadata_before_conversion( $mymeta );
  
      $meta_obj->save( 'MYMETA.json', { version => "2.0" } );
      $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 = sort keys %f; }
      { my(%d) = map { ($_ => 1) } @dirs;   @dirs  = sort 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 :: 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;
      my @m = <<'EOF';
  # so clean is forced to complete before realclean_subdirs runs
  realclean_subdirs : clean
  EOF
      return join '', @m, "\t\$(NOECHO) \$(NOOP)\n" unless @{$self->{DIR}};
      foreach my $dir (@{$self->{DIR}}) {
          foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) {
              my $subrclean .= $self->oneliner(_sprintf562 <<'CODE', $dir, $makefile);
  chdir '%1$s';  system '$(MAKE) $(USEMAKEFILE) %2$s realclean' if -f '%2$s';
  CODE
              push @m, "\t- $subrclean\n";
          }
      }
      return join '', @m;
  }
  
  
  =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 die "Could not add SIGNATURE to MANIFEST: ${'@'}"
  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 : distmeta
  	$(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 pure_all subdirs clean_subdirs makemakerdflt manifypods realclean_subdirs subdirs_dynamic subdirs_pure_nolink subdirs_static subdirs-test_dynamic subdirs-test_static test_dynamic test_static
  
  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} ||=
                  ($thing =~ /^man.dir$/ and not $Config{lc $key})
                  ? 'none'
                  : $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->{XSMULTI}) && @{$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. Equivalent to
  
    my $tests = $mm->find_tests_recursive_in('t');
  
  =cut
  
  sub find_tests_recursive {
      my $self = shift;
      return $self->find_tests_recursive_in('t');
  }
  
  =head3 find_tests_recursive_in
  
    my $tests = $mm->find_tests_recursive_in($dir);
  
  Returns a string suitable for feeding to the shell to return all
  tests in $dir recursively.
  
  =cut
  
  sub find_tests_recursive_in {
      my($self, $dir) = @_;
      return '' unless -d $dir;
  
      require File::Find;
  
      my $base_depth = grep { $_ ne '' } File::Spec->splitdir( (File::Spec->splitpath($dir))[1] );
      my %depths;
  
      my $wanted = sub {
          return unless m!\.t$!;
          my ($volume,$directories,$file) =
              File::Spec->splitpath( $File::Find::name  );
          my $depth = grep { $_ ne '' } File::Spec->splitdir( $directories );
          $depth -= $base_depth;
          $depths{ $depth } = 1;
      };
  
      File::Find::find( $wanted, $dir );
  
      return join ' ',
          map { $dir . '/*' x $_ . '.t' }
          sort { $a <=> $b }
          keys %depths;
  }
  
  =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
  and base-level F<README.pod> from installation.
  
  =cut
  
  sub libscan {
      my($self,$path) = @_;
  
      if ($path =~ m<^README\.pod$>i) {
          warn "WARNING: Older versions of ExtUtils::MakeMaker may errantly install $path as part of this distribution. It is recommended to avoid using this path in CPAN modules.\n"
            unless $ENV{PERL_CORE};
          return '';
      }
  
      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 '';
  }
  
  =head3 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 {
      "";
  }
  
  =head3 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 {
      "";
  }
  
  =head3 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 {
      "";
  }
  
  =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 include 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 _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.36';
  $VERSION =~ tr/_//d;
  
  
  =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
  
  =cut
  
  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.36';
  $VERSION =~ tr/_//d;
  
  
  =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/(dll\.)?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);
      return '' unless $s;
      return $s unless %{$self->{XS}};
  
      # do an ephemeral rebase so the new DLL fits to the current rebase map
      $s .= "\t/bin/find \$\(INST_ARCHLIB\)/auto -xdev -name \\*.$self->{DLEXT} | /bin/rebase -sOT -" if (( $Config{myarchname} eq 'i686-cygwin' ) and not ( exists $ENV{CYGPORT_PACKAGE_VERSION} ));
      $s;
  }
  
  =item install
  
  Rebase dll's with the global rebase database after installation.
  
  =cut
  
  sub install {
      my($self, %attribs) = @_;
      my $s = ExtUtils::MM_Unix::install($self, %attribs);
      return '' unless $s;
      return $s unless %{$self->{XS}};
  
      my $INSTALLDIRS = $self->{INSTALLDIRS};
      my $INSTALLLIB = $self->{"INSTALL". ($INSTALLDIRS eq 'perl' ? 'ARCHLIB' : uc($INSTALLDIRS)."ARCH")};
      my $dop = "\$\(DESTDIR\)$INSTALLLIB/auto/";
      my $dll = "$dop/$self->{FULLEXT}/$self->{BASEEXT}.$self->{DLEXT}";
      $s =~ s|^(pure_install :: pure_\$\(INSTALLDIRS\)_install\n\t)\$\(NOECHO\) \$\(NOOP\)\n|$1\$(CHMOD) \$(PERM_RWX) $dll\n\t/bin/find $dop -xdev -name \\*.$self->{DLEXT} \| /bin/rebase -sOT -\n|m if (( $Config{myarchname} eq 'i686-cygwin') and not ( exists $ENV{CYGPORT_PACKAGE_VERSION} ));
      $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.36';
  $VERSION =~ tr/_//d;
  
  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;
  }
  
  =item xs_static_lib_is_xs
  
  =cut
  
  sub xs_static_lib_is_xs {
      return 1;
  }
  
  =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.36';
  $VERSION =~ tr/_//d;
  
  
  =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 Overridden 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.36';
  $VERSION =~ tr/_//d;
  
  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.36';
  $VERSION =~ tr/_//d;
  
  require ExtUtils::MM_Win32;
  our @ISA = qw(ExtUtils::MM_Win32);
  
  use ExtUtils::MakeMaker qw(&neatvalue &_sprintf562);
  
  $ENV{EMXSHELL} = 'sh'; # to run `commands`
  
  my $BORLAND  = $Config{'cc'} =~ /\bbcc/i;
  my $GCC      = $Config{'cc'} =~ /\bgcc/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 static_lib_pure_cmd
  
  Defines how to run the archive utility
  
  =cut
  
  sub static_lib_pure_cmd {
      my ($self, $src) = @_;
      $src =~ s/(\$\(\w+)(\))/$1:^"+"$2/g if $BORLAND;
      sprintf qq{\t\$(AR) %s\n}, ($BORLAND ? '$@ ' . $src
                            : ($GCC ? '-ru $@ ' . $src
                                    : '-type library -o $@ ' . $src));
  }
  
  =item xs_static_lib_is_xs
  
  =cut
  
  sub xs_static_lib_is_xs {
      return 1;
  }
  
  =item dynamic_lib
  
  Override of utility methods for OS-specific work.
  
  =cut
  
  sub xs_make_dynamic_lib {
      my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_;
      my @m;
      # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc
      if ($to =~ /^\$/) {
          if ($self->{NLM_SHORT_NAME}) {
              # deal with shortnames
              my $newto = q{$(INST_AUTODIR)\\$(NLM_SHORT_NAME).$(DLEXT)};
              push @m, "$to: $newto\n\n";
              $to = $newto;
          }
      } else {
          my ($v, $d, $f) = File::Spec->splitpath($to);
          # relies on $f having a literal "." in it, unlike for $(OBJ_EXT)
          if ($f =~ /[^\.]{9}\./) {
              # 9+ chars before '.', need to shorten
              $f = substr $f, 0, 8;
          }
          my $newto = File::Spec->catpath($v, $d, $f);
          push @m, "$to: $newto\n\n";
          $to = $newto;
      }
      # bits below should be in dlsyms, not here
      #                                   1    2      3       4
      push @m, _sprintf562 <<'MAKE_FRAG', $to, $from, $todir, $exportlist;
  # Create xdc data for an MT safe NLM in case of mpk build
  %1$s: %2$s $(MYEXTLIB) $(BOOTSTRAP) %3$s$(DFSEP).exists
  	$(NOECHO) $(ECHO) Export boot_$(BOOT_SYMBOL) > %4$s
  	$(NOECHO) $(ECHO) $(BASE_IMPORT) >> %4$s
  	$(NOECHO) $(ECHO) Import @$(PERL_INC)\perl.imp >> %4$s
  MAKE_FRAG
      if ( $self->{CCFLAGS} =~ m/ -DMPK_ON /) {
          (my $xdc = $exportlist) =~ s#def\z#xdc#;
          $xdc = '$(BASEEXT).xdc';
          push @m, sprintf <<'MAKE_FRAG', $xdc, $exportlist;
  	$(MPKTOOL) $(XDCFLAGS) %s
  	$(NOECHO) $(ECHO) xdcdata $(BASEEXT).xdc >> %s
  MAKE_FRAG
      }
      # Reconstruct the X.Y.Z version.
      my $version = join '.', map { sprintf "%d", $_ }
                                "$]" =~ /(\d)\.(\d{3})(\d{2})/;
      push @m, sprintf <<'EOF', $from, $version, $to, $exportlist;
  	$(LD) $(LDFLAGS) %s -desc "Perl %s Extension ($(BASEEXT))  XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION) -o %s $(MYEXTLIB) $(PERL_INC)\Main.lib -commandfile %s
  	$(CHMOD) 755 $@
  EOF
      join '', @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.36';
  $VERSION =~ tr/_//d;
  
  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) = @_;
      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";
  	foreach my $name (sort keys %{$self->{IMPORTS}}) {
  	    my $exp = $self->{IMPORTS}->{$name};
  	    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: $!, \$?=$?";
      }
      return '' if $self->{SKIPHASH}{'dynamic'};
      $self->xs_dlsyms_iterator(\%attribs);
  }
  
  sub xs_dlsyms_ext {
      '.def';
  }
  
  sub xs_dlsyms_extra {
      join '', map { qq{, "$_" => "\$($_)"} } qw(VERSION DISTNAME INSTALLDIRS);
  }
  
  sub static_lib_pure_cmd {
      my($self) = @_;
      my $old = $self->SUPER::static_lib_pure_cmd;
      return $old unless $self->{IMPORTS} && %{$self->{IMPORTS}};
      $old . <<'EOC';
  	$(AR) $(AR_STATIC_ARGS) "$@" tmp_imp/*
  	$(RANLIB) "$@"
  EOC
  }
  
  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');
  }
  
  =item xs_static_lib_is_xs
  
  =cut
  
  sub xs_static_lib_is_xs {
      return 1;
  }
  
  =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.36';
  $VERSION =~ tr/_//d;
  
  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.36';
  $VERSION =~ tr/_//d;
  
  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);
  
  our %Config_Override;
  
  use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562);
  
  # If we make $VERSION an our variable parse_version() breaks
  use vars qw($VERSION);
  $VERSION = '7.36';
  $VERSION =~ tr/_//d;
  
  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/;
      if ( $^O eq 'darwin' && $^X eq '/usr/bin/perl' ) {
        my @osvers = split /\./, $Config{osvers};
        $Is{ApplCor} = ( $osvers[0] >= 18 );
      }
  }
  
  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
  
    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 $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 ( $Is{ApplCor} ) {
          $flags =~ s/"-I(\$\(PERL_INC\))"/-iwithsysroot "$1"/;
      }
  
      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
  };
      }
  
      my $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*.s') : '';
      push @m, sprintf <<'EOF', $command, $flags, $m_o;
  
  .c.s :
  	%s -S %s $*.c %s
  EOF
  
      my @exts = qw(c cpp cxx cc);
      push @exts, 'C' if !$Is{OS2} and !$Is{Win32} and !$Is{Dos}; #Case-specific
      $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*$(OBJ_EXT)') : '';
      my $dbgout = $self->dbgoutflag;
      for my $ext (@exts) {
  	push @m, "\n.$ext\$(OBJ_EXT) :\n\t$command $flags "
              .($dbgout?"$dbgout ":'')
              ."\$*.$ext" . ( $m_o ? " $m_o" : '' ) . "\n";
      }
      return join "", @m;
  }
  
  
  =item xs_obj_opt
  
  Takes the object file as an argument, and returns the portion of compile
  command-line that will output to the specified object file.
  
  =cut
  
  sub xs_obj_opt {
      my ($self, $output_file) = @_;
      "-o $output_file";
  }
  
  =item dbgoutflag
  
  Returns a CC flag that tells the CC to emit a separate debugging symbol file
  when compiling an object file.
  
  =cut
  
  sub dbgoutflag {
      '';
  }
  
  =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)';
      }
  
      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)
  
  Sets SHELL if needed, then defines a couple of constants in the Makefile
  that are imported from %Config.
  
  =cut
  
  sub const_config {
  # --- Constants Sections ---
  
      my($self) = shift;
      my @m = $self->specify_shell(); # Usually returns empty string
      push @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};
          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(sort @{$self->{C}})."
  O_FILES  = ".$self->wraplist(sort @{$self->{O_FILES}})."
  H_FILES  = ".$self->wraplist(sort @{$self->{H}})."
  MAN1PODS = ".$self->wraplist(sort keys %{$self->{MAN1PODS}})."
  MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})."
  ";
  
      push @m, q{
  SDKROOT := $(shell xcrun --show-sdk-path)
  PERL_SYSROOT = $(SDKROOT)
  } if $Is{ApplCor} && $self->{'PERL_INC'} =~ m!^/System/Library/Perl/!;
  
      push @m, q{
  # Where is the Config information that we are using/depend on
  CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_SYSROOT)$(PERL_INCDEP)$(DFSEP)config.h
  } if $Is{ApplCor};
  
      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 $self->catfile( $self->{PERL_INC}, 'config.h' ) && !$Is{ApplCor};
  
      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(map $self->quote_dep($_), sort keys %{$self->{PM}})."\n";
  
      join('',@m);
  }
  
  
  =item depend (o)
  
  Same as macro for the depend attribute.
  
  =cut
  
  sub depend {
      my($self,%attribs) = @_;
      my(@m,$key,$val);
      for my $key (sort keys %attribs){
  	my $val = $attribs{$key};
  	next unless defined $key and defined $val;
  	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 sprintf "ci :\n\t%s\n", $self->oneliner(<<'EOF', [qw(-MExtUtils::Manifest=maniread)]);
  @all = sort keys %{ maniread() };
  print(qq{Executing $(CI) @all\n});
  system(qq{$(CI) @all}) == 0 or die $!;
  print(qq{Executing $(RCS_LABEL) ...\n});
  system(qq{$(RCS_LABEL) @all}) == 0 or die $!;
  EOF
  }
  
  =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 "\nBOOTSTRAP =\n" unless $self->has_link_code();
      my @exts;
      if ($self->{XSMULTI}) {
  	@exts = $self->_xs_list_basenames;
      } else {
  	@exts = '$(BASEEXT)';
      }
      return join "\n",
          "BOOTSTRAP = @{[map { qq{$_.bs} } @exts]}\n",
          map { $self->_xs_make_bs($_) } @exts;
  }
  
  sub _xs_make_bs {
      my ($self, $basename) = @_;
      my ($v, $d, $f) = File::Spec->splitpath($basename);
      my @d = File::Spec->splitdir($d);
      shift @d if $self->{XSMULTI} and $d[0] eq 'lib';
      my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f);
      $instdir = '$(INST_ARCHAUTODIR)' if $basename eq '$(BASEEXT)';
      my $instfile = $self->catfile($instdir, "$f.bs");
      my $exists = "$instdir\$(DFSEP).exists"; # match blibdirs_target
      #                                 1          2          3
      return _sprintf562 <<'MAKE_FRAG', $basename, $instfile, $exists;
  # 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.
  %1$s.bs : $(FIRST_MAKEFILE) $(BOOTDEP)
  	$(NOECHO) $(ECHO) "Running Mkbootstrap for %1$s ($(BSLOADLIBS))"
  	$(NOECHO) $(PERLRUN) \
  		"-MExtUtils::Mkbootstrap" \
  		-e "Mkbootstrap('%1$s','$(BSLOADLIBS)');"
  	$(NOECHO) $(TOUCH) "%1$s.bs"
  	$(CHMOD) $(PERM_RW) "%1$s.bs"
  
  %2$s : %1$s.bs %3$s
  	$(NOECHO) $(RM_RF) %2$s
  	- $(CP_NONEMPTY) %1$s.bs %2$s $(PERM_RW)
  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 @m = $self->xs_dynamic_lib_macros(\%attribs);
      my @libs;
      my $dlsyms_ext = eval { $self->xs_dlsyms_ext };
      if ($self->{XSMULTI}) {
          my @exts = $self->_xs_list_basenames;
          for my $ext (@exts) {
              my ($v, $d, $f) = File::Spec->splitpath($ext);
              my @d = File::Spec->splitdir($d);
              shift @d if $d[0] eq 'lib';
              my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f);
  
              # Dynamic library names may need special handling.
              eval { require DynaLoader };
              if (defined &DynaLoader::mod2fname) {
                  $f = &DynaLoader::mod2fname([@d, $f]);
              }
  
              my $instfile = $self->catfile($instdir, "$f.\$(DLEXT)");
              my $objfile = $self->_xsbuild_value('xs', $ext, 'OBJECT');
              $objfile = "$ext\$(OBJ_EXT)" unless defined $objfile;
              my $ldfrom = $self->_xsbuild_value('xs', $ext, 'LDFROM');
              $ldfrom = $objfile unless defined $ldfrom;
              my $exportlist = "$ext.def";
              my @libchunk = ($objfile, $instfile, $instdir, $ldfrom, $exportlist);
              push @libchunk, $dlsyms_ext ? $ext.$dlsyms_ext : undef;
              push @libs, \@libchunk;
          }
      } else {
          my @libchunk = qw($(OBJECT) $(INST_DYNAMIC) $(INST_ARCHAUTODIR) $(LDFROM) $(EXPORT_LIST));
          push @libchunk, $dlsyms_ext ? '$(BASEEXT)'.$dlsyms_ext : undef;
          @libs = (\@libchunk);
      }
      push @m, map { $self->xs_make_dynamic_lib(\%attribs, @$_); } @libs;
  
      return join("\n",@m);
  }
  
  =item xs_dynamic_lib_macros
  
  Defines the macros for the C<dynamic_lib> section.
  
  =cut
  
  sub xs_dynamic_lib_macros {
      my ($self, $attribs) = @_;
      my $otherldflags = $attribs->{OTHERLDFLAGS} || "";
      my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || "";
      my $armaybe = $self->_xs_armaybe($attribs);
      my $ld_opt = $Is{OS2} ? '$(OPTIMIZE) ' : ''; # Useful on other systems too?
      my $ld_fix = $Is{OS2} ? '|| ( $(RM_F) $@ && sh -c false )' : '';
      sprintf <<'EOF', $armaybe, $ld_opt.$otherldflags, $inst_dynamic_dep, $ld_fix;
  # This section creates the dynamically loadable objects from relevant
  # objects and possibly $(MYEXTLIB).
  ARMAYBE = %s
  OTHERLDFLAGS = %s
  INST_DYNAMIC_DEP = %s
  INST_DYNAMIC_FIX = %s
  EOF
  }
  
  sub _xs_armaybe {
      my ($self, $attribs) = @_;
      my $armaybe = $attribs->{ARMAYBE} || $self->{ARMAYBE} || ":";
      $armaybe = 'ar' if ($Is{OSF} and $armaybe eq ':');
      $armaybe;
  }
  
  =item xs_make_dynamic_lib
  
  Defines the recipes for the C<dynamic_lib> section.
  
  =cut
  
  sub xs_make_dynamic_lib {
      my ($self, $attribs, $object, $to, $todir, $ldfrom, $exportlist, $dlsyms) = @_;
      $exportlist = '' if $exportlist ne '$(EXPORT_LIST)';
      my $armaybe = $self->_xs_armaybe($attribs);
      my @m = sprintf '%s : %s $(MYEXTLIB) %s$(DFSEP).exists %s $(PERL_ARCHIVEDEP) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) %s'."\n", $to, $object, $todir, $exportlist, ($dlsyms || '');
      my $dlsyms_arg = $self->xs_dlsyms_arg($dlsyms);
      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) \$\@\n");
  
      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, $dlsyms_arg, $ldfrom, $self->xs_obj_opt('$@'), $libs, $exportlist;
  	%s$(LD) %s $(LDDLFLAGS) %s %s $(OTHERLDFLAGS) %s $(MYEXTLIB) \
  	  $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) %s \
  	  $(INST_DYNAMIC_FIX)
  	$(CHMOD) $(PERM_RWX) $@
  MAKE
      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){
          my ($abs, $use_dir);
          if ($self->file_name_is_absolute($name)) {     # /foo/bar
              $abs = $name;
          } elsif ($self->canonpath($name) eq
                   $self->canonpath(basename($name))) {  # foo
              $use_dir = 1;
          } else {                                            # foo/bar
              $abs = $self->catfile($Curdir, $name);
          }
          foreach my $dir ($use_dir ? @$dirs : 1){
              next unless defined $dir; # $self->{PERL_SRC} may be undefined
  
              $abs = $self->catfile($dir, $name)
                  if $use_dir;
  
              print "Checking $abs\n" if ($trace >= 2);
              next unless $self->maybe_command($abs);
              print "Executing $abs\n" if ($trace >= 2);
  
              my $val;
              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 ( $origcmd, $arg ) = split ' ', $line, 2;
      (my $cmd = $origcmd) =~ s!^.*/!!;
  
      # Now look (in reverse) for interpreter in absolute PATH (unless perl).
      my $interpreter;
      if ( defined $ENV{PERL_MM_SHEBANG} && $ENV{PERL_MM_SHEBANG} eq "relocatable" ) {
          $interpreter = "/usr/bin/env perl";
      }
      elsif ( $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) {
              my $maybefile = $self->catfile($dir,$cmd);
              if ( $self->maybe_command($maybefile) ) {
                  warn "Ignoring $interpreter in $file\n"
                      if $Verbose && $interpreter;
                  $interpreter = $maybefile;
              }
          }
  
          # If the shebang is absolute and exists in PATH, but was not
          # the first one found, leave it alone if it's actually the
          # same file as first one.  This avoids packages built on
          # merged-/usr systems with /usr/bin before /bin in the path
          # breaking when installed on systems without merged /usr
          if ($origcmd ne $interpreter and $self->file_name_is_absolute($origcmd)) {
              my $origdir = dirname($origcmd);
              if ($self->maybe_command($origcmd) && grep { $_ eq $origdir } @absdirs) {
                  my ($odev, $oino) = stat $origcmd;
                  my ($idev, $iino) = stat $interpreter;
                  if ($odev == $idev && $oino == $iino) {
                      warn "$origcmd is the same as $interpreter, leaving alone"
                          if $Verbose;
                      $interpreter = $origcmd;
                  }
              }
          }
      }
  
      # 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) or
              ( $name =~ m/^README\.pod$/i ) # don't manify top-level README.pod
          ) {
  	    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;
  	    if ($self->{XSMULTI} and $inst =~ /\.xs\z/) {
  		my($base); ($base = $path) =~ s/\.xs\z//;
  		$self->{XS}{$path} = "$base.c";
  		push @{$self->{C}}, "$base.c";
  		push @{$self->{O_FILES}}, "$base$self->{OBJ_EXT}";
  	    } else {
  		$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};
  
      # `dmake` can fail for image (aka, executable) names which start with double-quotes
      # * push quote inward by at least one character (or the drive prefix, if present)
      # * including any initial directory separator preserves the `file_name_is_absolute` property
      $self->{FULLPERL} =~ s/^"(\S(:\\|:)?)/$1"/ if $self->is_make_type('dmake');
  
      # 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};
  
      # `dmake` can fail for image (aka, executable) names which start with double-quotes
      # * push quote inward by at least one character (or the drive prefix, if present)
      # * including any initial directory separator preserves the `file_name_is_absolute` property
      $self->{PERL} =~ s/^"(\S(:\\|:)?)/$1"/ if $self->is_make_type('dmake');
  
      # 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};
  
      # Make sure perl can find itself before it's installed.
      my $lib_paths = $self->{UNINSTALLED_PERL} || $self->{PERL_CORE}
          ? ( $self->{PERL_ARCHLIB} && $self->{PERL_LIB} && $self->{PERL_ARCHLIB} ne $self->{PERL_LIB} ) ?
              q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} : q{ "-I$(PERL_LIB)"}
          : undef;
      my $inst_lib_paths = $self->{INST_ARCHLIB} ne $self->{INST_LIB}
          ? 'RUN)'.$perlflags.' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"'
          : 'RUN)'.$perlflags.' "-I$(INST_LIB)"';
      # How do we run perl?
      foreach my $perl (qw(PERL FULLPERL ABSPERL)) {
          my $run  = $perl.'RUN';
  
          $self->{$run}  = qq{\$($perl)};
          $self->{$run} .= $lib_paths if $lib_paths;
  
          $self->{$perl.'RUNINST'} = '$('.$perl.$inst_lib_paths;
      }
  
      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');
  	if ($self->{XSMULTI}) {
  	    my @exts = $self->_xs_list_basenames;
  	    my (@statics, @dynamics, @boots);
  	    for my $ext (@exts) {
  		my ($v, $d, $f) = File::Spec->splitpath($ext);
  		my @d = File::Spec->splitdir($d);
  		shift @d if defined $d[0] and $d[0] eq 'lib';
  		my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f);
  		my $instfile = $self->catfile($instdir, $f);
  		push @statics, "$instfile\$(LIB_EXT)";
  
                  # Dynamic library names may need special handling.
                  my $dynfile = $instfile;
                  eval { require DynaLoader };
                  if (defined &DynaLoader::mod2fname) {
                      $dynfile = $self->catfile($instdir, &DynaLoader::mod2fname([@d, $f]));
                  }
  
  		push @dynamics, "$dynfile.\$(DLEXT)";
  		push @boots, "$instfile.bs";
  	    }
  	    $self->{INST_STATIC} = join ' ', @statics;
  	    $self->{INST_DYNAMIC} = join ' ', @dynamics;
  	    $self->{INST_BOOT} = join ' ', @boots;
  	}
      } 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 = sort @{$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   = sort 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.
      my @froms = sort keys %fromto;
      for my $from (@froms) {
          #                              1      2
          push @m, _sprintf562 <<'MAKE', $from, $fromto{$from};
  %2$s : %1$s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
  	$(NOECHO) $(RM_F) %2$s
  	$(CP) %1$s %2$s
  	$(FIXIN) %2$s
  	-$(NOECHO) $(CHMOD) $(PERM_RWX) %2$s
  
  MAKE
  
      }
  
      join "", @m;
  }
  
  =item linkext (o)
  
  Defines the linkext target which in turn defines the LINKTYPE.
  
  =cut
  
  # LINKTYPE => static or dynamic or ''
  sub linkext {
      my($self, %attribs) = @_;
      my $linktype = $attribs{LINKTYPE};
      $linktype = $self->{LINKTYPE} unless defined $linktype;
      if (defined $linktype and $linktype eq '') {
          warn "Warning: LINKTYPE set to '', no longer necessary\n";
      }
      $linktype = '$(LINKTYPE)' unless defined $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 {
      #  $self
      my(undef, $dir, $regex) = @_;
      opendir(my $dh, defined($dir) ? $dir : ".")
          or return;
      my @ls = readdir $dh;
      closedir $dh;
      @ls = grep(/$regex/, @ls) if defined $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;
      foreach my $key (sort keys %attribs) {
  	my $val = $attribs{$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)};
      s/^(.*)/"-I$1"/ for @{$perlinc || []};
      my(@m);
      push @m, "
  # --- MakeMaker makeaperl section ---
  MAP_TARGET    = $target
  FULLPERL      = $self->{FULLPERL}
  MAP_PERLINC   = @{$perlinc || []}
  ";
      return join '', @m if $self->{PARENT};
  
      my($dir) = join ":", @{$self->{DIR}};
  
      unless ($self->{MAKEAPERL}) {
  	push @m, q{
  $(MAP_TARGET) :: $(MAKE_APERL_FILE)
  	$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
  
  $(MAKE_APERL_FILE) : static $(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){
  		my $arg = $_; # avoid lvalue aliasing
  		if ( $arg =~ /(^.*?=)(.*['\s].*)/ ) {
  			$arg = $1 . $self->quote_literal($2);
  		}
  		push @m, " \\\n\t\t$arg";
  	}
  	push @m, "\n";
  
  	return join '', @m;
      }
  
      my $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...
      my $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 $staticlib21 = $self->_find_static_libs($searchdirs);
      # We trust that what has been handed in as argument, will be buildable
      $static = [] unless $static;
      @$staticlib21{@{$static}} = (1) x @{$static};
  
      $extra = [] unless $extra && ref $extra eq 'ARRAY';
      for (sort keys %$staticlib21) {
  	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
      my @map_static = reverse sort keys %$staticlib21;
      push @m, "
  MAP_LINKCMD   = $linkcmd
  MAP_STATIC    = ", join(" \\\n\t", map { qq{"$_"} } @map_static), "
  MAP_STATICDEP = ", join(' ', map { $self->quote_dep($_) } @map_static), "
  
  MAP_PRELIBS   = $Config{perllibs} $Config{cryptlib}
  ";
  
      my $lperl;
      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 <<EOF unless -f $lperl || defined($self->{PERL_SRC});
  Warning: $libperl not found
  If you're going to build a static perl binary, make sure perl is installed
  otherwise ignore this warning
  EOF
      }
  
      # SUNOS ld does not take the full path to a shared library
      my $llibperl = $libperl ? '$(MAP_LIBPERL)' : '-lperl';
      my $libperl_dep = $self->quote_dep($libperl);
  
      push @m, "
  MAP_LIBPERL = $libperl
  MAP_LIBPERLDEP = $libperl_dep
  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";
      }
  
      my $ldfrom = $self->{XSMULTI} ? '' : '$(LDFROM)';
      #                             1     2                        3        4
      push @m, _sprintf562 <<'EOF', $tmp, $ldfrom, $self->xs_obj_opt('$@'), $makefilename;
  $(MAP_TARGET) :: %1$s/perlmain$(OBJ_EXT) $(MAP_LIBPERLDEP) $(MAP_STATICDEP) $(INST_ARCHAUTODIR)/extralibs.all
  	$(MAP_LINKCMD) %2$s $(OPTIMIZE) %1$s/perlmain$(OBJ_EXT) %3$s $(MAP_STATIC) "$(LLIBPERL)" `cat $(INST_ARCHAUTODIR)/extralibs.all` $(MAP_PRELIBS)
  	$(NOECHO) $(ECHO) "To install the new '$(MAP_TARGET)' binary, call"
  	$(NOECHO) $(ECHO) "    $(MAKE) $(USEMAKEFILE) %4$s inst_perl MAP_TARGET=$(MAP_TARGET)"
  	$(NOECHO) $(ECHO) "    $(MAKE) $(USEMAKEFILE) %4$s map_clean"
  
  %1$s/perlmain\$(OBJ_EXT): %1$s/perlmain.c
  EOF
      push @m, "\t".$self->cd($tmp, qq[$cccmd "-I\$(PERL_INC)" perlmain.c])."\n";
  
      my $maybe_DynaLoader = $Config{usedl} ? 'q(DynaLoader)' : '';
      push @m, _sprintf562 <<'EOF', $tmp, $makefilename, $maybe_DynaLoader;
  
  %1$s/perlmain.c: %2$s
  	$(NOECHO) $(ECHO) Writing $@
  	$(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \
  		-e "writemain(grep(s#.*/auto/##s, @ARGV), %3$s)" $(MAP_STATIC) > $@t
  	$(MV) $@t $@
  
  EOF
      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;
  }
  
  # utility method
  sub _find_static_libs {
      my ($self, $searchdirs) = @_;
      # don't use File::Spec here because on Win32 F::F still uses "/"
      my $installed_version = join('/',
  	'auto', $self->{FULLEXT}, "$self->{BASEEXT}$self->{LIB_EXT}"
      );
      my %staticlib21;
      require File::Find;
      File::Find::find(sub {
  	if ($File::Find::name =~ m{/auto/share\z}) {
  	    # in a subdir of auto/share, prune because e.g.
  	    # Alien::pkgconfig uses File::ShareDir to put .a files
  	    # there. do not want
  	    $File::Find::prune = 1;
  	    return;
  	}
  
  	return unless m/\Q$self->{LIB_EXT}\E$/;
  
  	return unless -f 'extralibs.ld'; # this checks is a "proper" XS installation
  
          # 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:\Q$installed_version\E\z:;
  	return if !$self->xs_static_lib_is_xs($_);
  	use Cwd 'cwd';
  	$staticlib21{cwd() . "/" . $_}++;
      }, grep( -d $_, map { $self->catdir($_, 'auto') } @{$searchdirs || []}) );
      return \%staticlib21;
  }
  
  =item xs_static_lib_is_xs (o)
  
  Called by a utility method of makeaperl. Checks whether a given file
  is an XS library by seeing whether it defines any symbols starting
  with C<boot_>.
  
  =cut
  
  sub xs_static_lib_is_xs {
      my ($self, $libfile) = @_;
      my $devnull = File::Spec->devnull;
      return `nm $libfile 2>$devnull` =~ /\bboot_/;
  }
  
  =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': $!";
      binmode $fh;
      my $inpod = 0;
      my $pod_encoding;
      my $package = $self->{DISTNAME};
      $package =~ s/-/::/g;
      while (<$fh>) {
          $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
          next if !$inpod;
          s#\r*\n\z##; # handle CRLF input
  
          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. The variables like C<PASTHRU_DEFINE> are used in each
  level, and passed downwards on the command-line with e.g. the value of
  that level's DEFINE. Example:
  
      # Level 0 has DEFINE = -Dfunky
      # This code will define level 0's PASTHRU=PASTHRU_DEFINE="$(DEFINE)
      #     $(PASTHRU_DEFINE)"
      # Level 0's $(CCCMD) will include macros $(DEFINE) and $(PASTHRU_DEFINE)
      # So will level 1's, so when level 1 compiles, it will get right values
      # And so ad infinitum
  
  =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)) {
          # default to the make var
          my $val = qq{\$($key)};
          # expand within perl if given since need to use quote_literal
          # since INC might include space-protecting ""!
          chomp($val = $self->{$key}) if defined $self->{$key};
          $val .= " \$(PASTHRU_$key)";
          my $quoted = $self->quote_literal($val);
          push @pasthru, qq{PASTHRU_$key=$quoted};
      }
  
      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->quote_literal($_) => $self->quote_literal($self->{PM}->{$_})) } sort keys %{$self->{PM}});
  
      $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds;
      $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n};
  
      return $r;
  }
  
  # 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(', ',@{ ref $self->{AUTHOR} eq 'ARRAY' ? $self->{AUTHOR} : [ $self->{AUTHOR} || '']});
      $author =~ s/</&lt;/g;
      $author =~ s/>/&gt;/g;
  
      my $ppd_file = "$self->{DISTNAME}.ppd";
  
      my @ppd_chunks = qq(<SOFTPKG NAME="$self->{DISTNAME}" VERSION="$self->{VERSION}">\n);
  
      push @ppd_chunks, sprintf <<'PPD_HTML', $abstract, $author;
      <ABSTRACT>%s</ABSTRACT>
      <AUTHOR>%s</AUTHOR>
  PPD_HTML
  
      push @ppd_chunks, "    <IMPLEMENTATION>\n";
      if ( $self->{MIN_PERL_VERSION} ) {
          my $min_perl_version = $self->_ppd_version($self->{MIN_PERL_VERSION});
          push @ppd_chunks, 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;
          push @ppd_chunks, 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}";
      }
      push @ppd_chunks, sprintf <<'PPD_OUT', $archname;
          <ARCHITECTURE NAME="%s" />
  PPD_OUT
  
      if ($self->{PPM_INSTALL_SCRIPT}) {
          if ($self->{PPM_INSTALL_EXEC}) {
              push @ppd_chunks, sprintf qq{        <INSTALL EXEC="%s">%s</INSTALL>\n},
                    $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT};
          }
          else {
              push @ppd_chunks, sprintf qq{        <INSTALL>%s</INSTALL>\n},
                    $self->{PPM_INSTALL_SCRIPT};
          }
      }
  
      if ($self->{PPM_UNINSTALL_SCRIPT}) {
          if ($self->{PPM_UNINSTALL_EXEC}) {
              push @ppd_chunks, sprintf qq{        <UNINSTALL EXEC="%s">%s</UNINSTALL>\n},
                    $self->{PPM_UNINSTALL_EXEC}, $self->{PPM_UNINSTALL_SCRIPT};
          }
          else {
              push @ppd_chunks, sprintf qq{        <UNINSTALL>%s</UNINSTALL>\n},
                    $self->{PPM_UNINSTALL_SCRIPT};
          }
      }
  
      my ($bin_location) = $self->{BINARY_LOCATION} || '';
      $bin_location =~ s/\\/\\\\/g;
  
      push @ppd_chunks, sprintf <<'PPD_XML', $bin_location;
          <CODEBASE HREF="%s" />
      </IMPLEMENTATION>
  </SOFTPKG>
  PPD_XML
  
      my @ppd_cmds = $self->stashmeta(join('', @ppd_chunks), $ppd_file);
  
      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 $targets = $pl_files->{$plfile};
          my $list =
              ref($targets) eq 'HASH'  ? [ sort keys %$targets ] :
              ref($targets) eq 'ARRAY' ? $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';
              }
  
              my $extra_inputs = '';
              if( ref($targets) eq 'HASH' ) {
                  my $inputs = ref($targets->{$target})
                      ? $targets->{$target}
                      : [$targets->{$target}];
  
                  for my $input (@$inputs) {
                      if( $Is{VMS} ) {
                          $input = vmsify($self->eliminate_macros($input));
                      }
                      $extra_inputs .= ' '.$input;
                  }
              }
  
              $m .= <<MAKE_FRAG;
  
  pure_all :: $target
  	\$(NOECHO) \$(NOOP)
  
  $target :: $plfile $pm_dep $extra_inputs
  	\$($perlrun) $plfile $target $extra_inputs
  MAKE_FRAG
  
          }
      }
  
      return $m;
  }
  
  =item specify_shell
  
  Specify SHELL if needed - not done on Unix.
  
  =cut
  
  sub specify_shell {
    return '';
  }
  
  =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)
  ';
  }
  
  sub static_lib {
      my($self) = @_;
      return '' unless $self->has_link_code;
      my(@m);
      my @libs;
      if ($self->{XSMULTI}) {
  	for my $ext ($self->_xs_list_basenames) {
  	    my ($v, $d, $f) = File::Spec->splitpath($ext);
  	    my @d = File::Spec->splitdir($d);
  	    shift @d if $d[0] eq 'lib';
  	    my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f);
  	    my $instfile = $self->catfile($instdir, "$f\$(LIB_EXT)");
  	    my $objfile = "$ext\$(OBJ_EXT)";
  	    push @libs, [ $objfile, $instfile, $instdir ];
  	}
      } else {
  	@libs = ([ qw($(OBJECT) $(INST_STATIC) $(INST_ARCHAUTODIR)) ]);
      }
      push @m, map { $self->xs_make_static_lib(@$_); } @libs;
      join "\n", @m;
  }
  
  =item xs_make_static_lib
  
  Defines the recipes for the C<static_lib> section.
  
  =cut
  
  sub xs_make_static_lib {
      my ($self, $from, $to, $todir) = @_;
      my @m = sprintf '%s: %s $(MYEXTLIB) %s$(DFSEP).exists'."\n", $to, $from, $todir;
      push @m, "\t\$(RM_F) \"\$\@\"\n";
      push @m, $self->static_lib_fixtures;
      push @m, $self->static_lib_pure_cmd($from);
      push @m, "\t\$(CHMOD) \$(PERM_RWX) \$\@\n";
      push @m, $self->static_lib_closures($todir);
      join '', @m;
  }
  
  =item static_lib_closures
  
  Records C<$(EXTRALIBS)> in F<extralibs.ld> and F<$(PERL_SRC)/ext.libs>.
  
  =cut
  
  sub static_lib_closures {
      my ($self, $todir) = @_;
      my @m = sprintf <<'MAKE_FRAG', $todir;
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > %s$(DFSEP)extralibs.ld
  MAKE_FRAG
      # Old mechanism - still available:
      push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)$(DFSEP)ext.libs
  MAKE_FRAG
      @m;
  }
  
  =item static_lib_fixtures
  
  Handles copying C<$(MYEXTLIB)> as starter for final static library that
  then gets added to.
  
  =cut
  
  sub static_lib_fixtures {
      my ($self) = @_;
      # If this extension has its own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      return unless $self->{MYEXTLIB};
      "\t\$(CP) \$(MYEXTLIB) \"\$\@\"\n";
  }
  
  =item static_lib_pure_cmd
  
  Defines how to run the archive utility.
  
  =cut
  
  sub static_lib_pure_cmd {
      my ($self, $from) = @_;
      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';
      }
      sprintf <<'MAKE_FRAG', $ar, $from;
  	$(%s) $(AR_STATIC_ARGS) "$@" %s
  	$(RANLIB) "$@"
  MAKE_FRAG
  }
  
  =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, <<'EOF';
  
  # The default clean, realclean and test targets in this Makefile
  # have automatically been given entries for each subdir.
  
  EOF
      } else {
  	push(@m, "\n# none")
      }
      join('',@m);
  }
  
  =item test (o)
  
  Defines the test targets.
  
  =cut
  
  sub test {
      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;
      my $default_testtype = $Config{usedl} ? 'dynamic' : 'static';
      push @m, <<EOF;
  TEST_VERBOSE=0
  TEST_TYPE=test_\$(LINKTYPE)
  TEST_FILE = test.pl
  TEST_FILES = $tests
  TESTDB_SW = -d
  
  testdb :: testdb_\$(LINKTYPE)
  	\$(NOECHO) \$(NOOP)
  
  test :: \$(TEST_TYPE)
  	\$(NOECHO) \$(NOOP)
  
  # Occasionally we may face this degenerate target:
  test_ : test_$default_testtype
  	\$(NOECHO) \$(NOOP)
  
  EOF
  
      for my $linktype (qw(dynamic static)) {
          my $directdeps = join ' ', grep !$self->{SKIPHASH}{$_}, $linktype, "pure_all"; # no depend on a linktype if SKIPped
          push @m, "subdirs-test_$linktype :: $directdeps\n";
          foreach my $dir (@{ $self->{DIR} }) {
              my $test = $self->cd($dir, "\$(MAKE) test_$linktype \$(PASTHRU)");
              push @m, "\t\$(NOECHO) $test\n";
          }
          push @m, "\n";
          if ($tests or -f "test.pl") {
              for my $testspec ([ '', '' ], [ 'db', ' $(TESTDB_SW)' ]) {
                  my ($db, $switch) = @$testspec;
                  my ($command, $deps);
                  # if testdb, build all but don't test all
                  $deps = $db eq 'db' ? $directdeps : "subdirs-test_$linktype";
                  if ($linktype eq 'static' and $self->needs_linking) {
                      my $target = File::Spec->rel2abs('$(MAP_TARGET)');
                      $command = qq{"$target" \$(MAP_PERLINC)};
                      $deps .= ' $(MAP_TARGET)';
                  } else {
                      $command = '$(FULLPERLRUN)' . $switch;
                  }
                  push @m, "test${db}_$linktype :: $deps\n";
                  if ($db eq 'db') {
                      push @m, $self->test_via_script($command, '$(TEST_FILE)')
                  } else {
                      push @m, $self->test_via_script($command, '$(TEST_FILE)')
                          if -f "test.pl";
                      push @m, $self->test_via_harness($command, '$(TEST_FILES)')
                          if $tests;
                  }
                  push @m, "\n";
              }
          } else {
              push @m, _sprintf562 <<'EOF', $linktype;
  testdb_%1$s test_%1$s :: subdirs-test_%1$s
  	$(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.'
  
  EOF
          }
      }
  
      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   = $self->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 {
                  $typemap = vmsify($typemap) if $Is{VMS};
                  push(@tmdeps, $typemap);
              }
          }
      }
      push(@tmdeps, "typemap") if -f "typemap";
      # absolutised because with deep-located typemaps, eg "lib/XS/typemap",
      # if xsubpp is called from top level with
      #     $(XSUBPP) ... -typemap "lib/XS/typemap" "lib/XS/Test.xs"
      # it says:
      #     Can't find lib/XS/type map in (fulldir)/lib/XS
      # because ExtUtils::ParseXS::process_file chdir's to .xs file's
      # location. This is the only way to get all specified typemaps used,
      # wherever located.
      my @tmargs = map { '-typemap '.$self->quote_literal(File::Spec->rel2abs($_)) } @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, sprintf <<'EOF';
  pure_all :: config pm_to_blib subdirs linkext
  	$(NOECHO) $(NOOP)
  
  	$(NOECHO) $(NOOP)
  
  subdirs :: $(MYEXTLIB)
  	$(NOECHO) $(NOOP)
  
  config :: $(FIRST_MAKEFILE) blibdirs
  	$(NOECHO) $(NOOP)
  EOF
  
      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 = gmtime($ENV{SOURCE_DATE_EPOCH} || time);
      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 was
  originally only intended for broken make implementations, but is now
  necessary for per-XS file under C<XSMULTI>, since each XS file might
  have an individual C<$(VERSION)>.
  
  =cut
  
  sub xs_o {
      my ($self) = @_;
      return '' unless $self->needs_linking();
      my $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*$(OBJ_EXT)') : '';
      my $dbgout = $self->dbgoutflag;
      $dbgout = $dbgout ? "$dbgout " : '';
      my $frag = '';
      # dmake makes noise about ambiguous rule
      $frag .= sprintf <<'EOF', $dbgout, $m_o unless $self->is_make_type('dmake');
  .xs$(OBJ_EXT) :
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc
  	$(MV) $*.xsc $*.c
  	$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) %s$*.c %s
  EOF
      if ($self->{XSMULTI}) {
  	for my $ext ($self->_xs_list_basenames) {
  	    my $pmfile = "$ext.pm";
  	    croak "$ext.xs has no matching $pmfile: $!" unless -f $pmfile;
  	    my $version = $self->parse_version($pmfile);
  	    my $cccmd = $self->{CONST_CCCMD};
  	    $cccmd =~ s/^\s*CCCMD\s*=\s*//;
  	    $cccmd =~ s/\$\(DEFINE_VERSION\)/-DVERSION=\\"$version\\"/;
  	    $cccmd =~ s/\$\(XS_DEFINE_VERSION\)/-DXS_VERSION=\\"$version\\"/;
              $self->_xsbuild_replace_macro($cccmd, 'xs', $ext, 'INC');
              my $define = '$(DEFINE)';
              $self->_xsbuild_replace_macro($define, 'xs', $ext, 'DEFINE');
              #                             1     2       3     4        5
              $frag .= _sprintf562 <<'EOF', $ext, $cccmd, $m_o, $define, $dbgout;
  
  %1$s$(OBJ_EXT): %1$s.xs
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc
  	$(MV) $*.xsc $*.c
  	%2$s $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) %4$s %5$s$*.c %3$s
  EOF
  	}
      }
      $frag =~ s/"-I(\$\(PERL_INC\))"/-iwithsysroot "$1"/sg if $Is{ApplCor};
      $frag;
  }
  
  # param gets modified
  sub _xsbuild_replace_macro {
      my ($self, undef, $xstype, $ext, $varname) = @_;
      my $value = $self->_xsbuild_value($xstype, $ext, $varname);
      return unless defined $value;
      $_[1] =~ s/\$\($varname\)/$value/;
  }
  
  sub _xsbuild_value {
      my ($self, $xstype, $ext, $varname) = @_;
      return $self->{XSBUILD}{$xstype}{$ext}{$varname}
          if $self->{XSBUILD}{$xstype}{$ext}{$varname};
      return $self->{XSBUILD}{$xstype}{all}{$varname}
          if $self->{XSBUILD}{$xstype}{all}{$varname};
      ();
  }
  
  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.36';
  $VERSION =~ tr/_//d;
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  
  use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562);
  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)
  
  The list of macro definitions to be passed through must be specified using
  the /MACRO qualifier and must not add another /DEFINE qualifier.  We prepend
  our own comma here to the contents of $(PASTHRU_DEFINE) because it is often
  empty and a comma always present in CCFLAGS would generate a missing
  qualifier value error.
  
  =cut
  
  sub pasthru {
      my($self) = shift;
      my $pasthru = $self->SUPER::pasthru;
      $pasthru =~ s|(PASTHRU\s*=\s*)|$1/MACRO=(|;
      $pasthru =~ s|\n\z|)\n|m;
      $pasthru =~ s|/defi?n?e?=\(?([^\),]+)\)?|,$1|ig;
  
      return $pasthru;
  }
  
  
  =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_ARCHLIBDEP
              PERL_INC PERL_SRC ],
                          (map { 'INSTALL'.$_ } $self->installvars),
                          (map { 'DESTINSTALL'.$_ } $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;
              # PASTHRU_DEFINE will have its own comma
  	    $quals .= "/${type}ine=(" . join(',',@terms) . ($type eq 'Def' ? '$(PASTHRU_DEFINE)' : '') . ')';
  	}
      }
  
      $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 /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT)
  
  .cpp$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT)
  
  .cxx$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT)
  
  ';
  }
  
  =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_NAME).xsc
  	$(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c
  ';
  }
  
  =item xs_o (override)
  
  Use MM[SK] macros, and VMS command line for C compiler.
  
  =cut
  
  sub xs_o {
      my ($self) = @_;
      return '' unless $self->needs_linking();
      my $frag = '
  .xs$(OBJ_EXT) :
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).xsc
  	$(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT)
  ';
      if ($self->{XSMULTI}) {
  	for my $ext ($self->_xs_list_basenames) {
  	    my $version = $self->parse_version("$ext.pm");
  	    my $ccflags = $self->{CCFLAGS};
  	    $ccflags =~ s/\$\(DEFINE_VERSION\)/\"VERSION_MACRO=\\"\"$version\\"\"/;
  	    $ccflags =~ s/\$\(XS_DEFINE_VERSION\)/\"XS_VERSION_MACRO=\\"\"$version\\"\"/;
  	    $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'INC');
  	    $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'DEFINE');
  
  	    $frag .= _sprintf562 <<'EOF', $ext, $ccflags;
  
  %1$s$(OBJ_EXT) : %1$s.xs
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs > $(MMS$TARGET_NAME).xsc
  	$(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c
  	$(CC)%2$s$(OPTIMIZE) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT)
  EOF
  	}
      }
      $frag;
  }
  
  =item _xsbuild_replace_macro (override)
  
  There is no simple replacement possible since a qualifier and all its
  subqualifiers must be considered together, so we use our own utility
  routine for the replacement.
  
  =cut
  
  sub _xsbuild_replace_macro {
      my ($self, undef, $xstype, $ext, $varname) = @_;
      my $value = $self->_xsbuild_value($xstype, $ext, $varname);
      return unless defined $value;
      $_[1] = _vms_replace_qualifier($self, $_[1], $value, $varname);
  }
  
  =item _xsbuild_value (override)
  
  Convert the extension spec to Unix format, as that's what will
  match what's in the XSBUILD data structure.
  
  =cut
  
  sub _xsbuild_value {
      my ($self, $xstype, $ext, $varname) = @_;
      $ext = unixify($ext);
      return $self->SUPER::_xsbuild_value($xstype, $ext, $varname);
  }
  
  sub _vms_replace_qualifier {
      my ($self, $flags, $newflag, $macro) = @_;
      my $qual_type;
      my $type_suffix;
      my $quote_subquals = 0;
      my @subquals_new = split /\s+/, $newflag;
  
      if ($macro eq 'DEFINE') {
          $qual_type = 'Def';
          $type_suffix = 'ine';
          map { $_ =~ s/^-D// } @subquals_new;
          $quote_subquals = 1;
      }
      elsif ($macro eq 'INC') {
          $qual_type = 'Inc';
          $type_suffix = 'lude';
          map { $_ =~ s/^-I//; $_ = $self->fixpath($_) } @subquals_new;
      }
  
      my @subquals = ();
      while ($flags =~ m:/${qual_type}\S{0,4}=([^/]+):ig) {
          my $term = $1;
          $term =~ s/\"//g;
          $term =~ s:^\((.+)\)$:$1:;
          push @subquals, split /,/, $term;
      }
      for my $new (@subquals_new) {
          my ($sq_new, $sqval_new) = split /=/, $new;
          my $replaced_old = 0;
          for my $old (@subquals) {
              my ($sq, $sqval) = split /=/, $old;
              if ($sq_new eq $sq) {
                  $old = $sq_new;
                  $old .= '=' . $sqval_new if defined($sqval_new) and length($sqval_new);
                  $replaced_old = 1;
                  last;
              }
          }
          push @subquals, $new unless $replaced_old;
      }
  
      if (@subquals) {
          $flags =~ s:/${qual_type}\S{0,4}=[^/]+::ig;
          # add quotes if requested but not for unexpanded macros
          map { $_ = qq/"$_"/ if $_ !~ m/^\$\(/ } @subquals if $quote_subquals;
          $flags .= "/${qual_type}$type_suffix=(" . join(',',@subquals) . ')';
      }
  
      return $flags;
  }
  
  
  sub xs_dlsyms_ext {
      '.opt';
  }
  
  =item dlsyms (override)
  
  Create VMS linker options files specifying universal symbols for this
  extension's shareable image(s), and listing other shareable images or
  libraries to which it should be linked.
  
  =cut
  
  sub dlsyms {
      my ($self, %attribs) = @_;
      return '' unless $self->needs_linking;
      $self->xs_dlsyms_iterator;
  }
  
  sub xs_make_dlsyms {
      my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_;
      my @m;
      my $instloc;
      if ($self->{XSMULTI}) {
  	my ($v, $d, $f) = File::Spec->splitpath($target);
  	my @d = File::Spec->splitdir($d);
  	shift @d if $d[0] eq 'lib';
  	$instloc = $self->catfile('$(INST_ARCHLIB)', 'auto', @d, $f);
  	push @m,"\ndynamic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n"
  	  unless $self->{SKIPHASH}{'dynamic'};
  	push @m,"\nstatic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n"
  	  unless $self->{SKIPHASH}{'static'};
  	push @m, "\n", sprintf <<'EOF', $instloc, $target;
  %s : %s
  	$(CP) $(MMS$SOURCE) $(MMS$TARGET)
  EOF
      }
      else {
  	push @m,"\ndynamic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n"
  	  unless $self->{SKIPHASH}{'dynamic'};
  	push @m,"\nstatic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n"
  	  unless $self->{SKIPHASH}{'static'};
  	push @m, "\n", sprintf <<'EOF', $target;
  $(INST_ARCHAUTODIR)$(BASEEXT).opt : %s
  	$(CP) $(MMS$SOURCE) $(MMS$TARGET)
  EOF
      }
      push @m,
       "\n$target : $dep\n\t",
       q!$(PERLRUN) -MExtUtils::Mksymlists -e "Mksymlists('NAME'=>'!, $name,
       q!', 'DLBASE' => '!,$dlbase,
       q!', 'DL_FUNCS' => !,neatvalue($funcs),
       q!, 'FUNCLIST' => !,neatvalue($funclist),
       q!, 'IMPORTS' => !,neatvalue($imports),
       q!, 'DL_VARS' => !, neatvalue($vars);
      push @m, $extra if defined $extra;
      push @m, qq!);"\n\t!;
      # Can't use dlbase as it's been through mod2fname.
      my $olb_base = basename($target, '.opt');
      if ($self->{XSMULTI}) {
          # We've been passed everything but the kitchen sink -- and the location of the
          # static library we're using to build the dynamic library -- so concoct that
          # location from what we do have.
          my $olb_dir = $self->catdir(dirname($instloc), $olb_base);
          push @m, qq!\$(PERL) -e "print ""${olb_dir}${olb_base}\$(LIB_EXT)/Include=!;
          push @m, ($Config{d_vms_case_sensitive_symbols} ? uc($olb_base) : $olb_base);
          push @m, '\n' . $olb_dir . $olb_base . '$(LIB_EXT)/Library\n"";" >>$(MMS$TARGET)',"\n";
      }
      else {
          push @m, qq!\$(PERL) -e "print ""\$(INST_ARCHAUTODIR)${olb_base}\$(LIB_EXT)/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_ARCHAUTODIR)' . $olb_base . '$(LIB_EXT)/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 xs_obj_opt
  
  Override to fixup -o flags.
  
  =cut
  
  sub xs_obj_opt {
      my ($self, $output_file) = @_;
      "/OBJECT=$output_file";
  }
  
  =item dynamic_lib (override)
  
  Use VMS Link command.
  
  =cut
  
  sub xs_dynamic_lib_macros {
      my ($self, $attribs) = @_;
      my $otherldflags = $attribs->{OTHERLDFLAGS} || "";
      my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || "";
      sprintf <<'EOF', $otherldflags, $inst_dynamic_dep;
  # This section creates the dynamically loadable objects from relevant
  # objects and possibly $(MYEXTLIB).
  OTHERLDFLAGS = %s
  INST_DYNAMIC_DEP = %s
  EOF
  }
  
  sub xs_make_dynamic_lib {
      my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_;
      my $shr = $Config{'dbgprefix'} . 'PerlShr';
      $exportlist =~ s/.def$/.opt/;  # it's a linker options file
      #                    1    2       3            4     5
      _sprintf562 <<'EOF', $to, $todir, $exportlist, $shr, "$shr Sys\$Share:$shr.$Config{'dlext'}";
  %1$s : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt %2$s$(DFSEP).exists %3$s $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  	If F$TrnLNm("%4$s").eqs."" Then Define/NoLog/User %5$s
  	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) %3$s/Option,$(PERL_INC)perlshr_attr.opt/Option
  EOF
  }
  
  =item xs_make_static_lib (override)
  
  Use VMS commands to manipulate object library.
  
  =cut
  
  sub xs_make_static_lib {
      my ($self, $object, $to, $todir) = @_;
  
      my @objects;
      if ($self->{XSMULTI}) {
          # The extension name should be the main object file name minus file type.
          my $lib = $object;
          $lib =~ s/\$\(OBJ_EXT\)\z//;
          my $override = $self->_xsbuild_value('xs', $lib, 'OBJECT');
          $object = $override if defined $override;
          @objects = map { $self->fixpath($_,0) } split /(?<!\^)\s+/, $object;
      }
      else {
          push @objects, $object;
      }
  
      my @m;
      for my $obj (@objects) {
          push(@m, sprintf "\n%s : %s\$(DFSEP).exists", $obj, $todir);
      }
      push(@m, sprintf "\n\n%s : %s \$(MYEXTLIB)\n", $to, (join ' ', @objects));
  
      # 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}) {
          for my $obj (@objects) {
              push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) ' . $obj,"\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 static_lib_pure_cmd (override)
  
  Use VMS commands to manipulate object library.
  
  =cut
  
  sub static_lib_pure_cmd {
      my ($self, $from) = @_;
  
      sprintf <<'MAKE_FRAG', $from;
  	If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
  	Library/Object/Replace $(MMS$TARGET) %s
  MAKE_FRAG
  }
  
  =item xs_static_lib_is_xs
  
  =cut
  
  sub xs_static_lib_is_xs {
      return 1;
  }
  
  =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),sort 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) || $a cmp $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)
  
  Ensure 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+$}{};
  
      my @cmds = split /\n/, $cmd;
      $cmd = join " \n\t  -e ", map $self->quote_literal($_), @cmds;
      $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, it's 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 = $self->{$macro};
                  # Don't unixify if there is unescaped whitespace
                  $macro = unixify($macro) unless ($macro =~ /(?<!\^)\s/);
                  $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;
  }
  
  
  =item make_type (override)
  
  Returns a suitable string describing the type of makefile being written.
  
  =cut
  
  sub make_type { "$Config{make}-style"; }
  
  
  =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.36';
  $VERSION =~ tr/_//d;
  
  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 _sprintf562);
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  our $VERSION = '7.36';
  $VERSION =~ tr/_//d;
  
  $ENV{EMXSHELL} = 'sh'; # to run `commands`
  
  my ( $BORLAND, $GCC, $MSVC ) = _identify_compiler_environment( \%Config );
  
  sub _identify_compiler_environment {
  	my ( $config ) = @_;
  
  	my $BORLAND = $config->{cc} =~ /\bbcc/i ? 1 : 0;
  	my $GCC     = $config->{cc} =~ /\bgcc\b/i ? 1 : 0;
  	my $MSVC    = $config->{cc} =~ /\b(?:cl|icl)/i ? 1 : 0; # MSVC can come as clarm.exe, icl=Intel C
  
  	return ( $BORLAND, $GCC, $MSVC );
  }
  
  
  =head2 Overridden methods
  
  =over 4
  
  =item B<dlsyms>
  
  =cut
  
  sub dlsyms {
      my($self,%attribs) = @_;
      return '' if $self->{SKIPHASH}{'dynamic'};
      $self->xs_dlsyms_iterator(\%attribs);
  }
  
  =item xs_dlsyms_ext
  
  On Win32, is C<.def>.
  
  =cut
  
  sub xs_dlsyms_ext {
      '.def';
  }
  
  =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) -I$self->{PERL_SRC}\\cpan\\ExtUtils-PL2Bat\\lib $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 specify_shell
  
  Set SHELL to $ENV{COMSPEC} only if make is type 'gmake'.
  
  =cut
  
  sub specify_shell {
      my $self = shift;
      return '' unless $self->is_make_type('gmake');
      "\nSHELL = $ENV{COMSPEC}\n";
  }
  
  =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_pure_cmd
  
  Defines how to run the archive utility
  
  =cut
  
  sub static_lib_pure_cmd {
      my ($self, $from) = @_;
      $from =~ s/(\$\(\w+)(\))/$1:^"+"$2/g if $BORLAND;
      sprintf qq{\t\$(AR) %s\n}, ($BORLAND ? '$@ ' . $from
                            : ($GCC ? '-ru $@ ' . $from
                                    : '-out:$@ ' . $from));
  }
  
  =item dynamic_lib
  
  Methods are overridden here: not dynamic_lib itself, but the utility
  ones that do the OS-specific work.
  
  =cut
  
  sub xs_make_dynamic_lib {
      my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_;
      my @m = sprintf '%s : %s $(MYEXTLIB) %s$(DFSEP).exists %s $(PERL_ARCHIVEDEP) $(INST_DYNAMIC_DEP)'."\n", $to, $from, $todir, $exportlist;
      if ($GCC) {
        # per https://rt.cpan.org/Ticket/Display.html?id=78395 no longer
        # uses dlltool - relies on post 2002 MinGW
        #                             1            2
        push @m, _sprintf562 <<'EOF', $exportlist, $ldfrom;
  	$(LD) %1$s -o $@ $(LDDLFLAGS) %2$s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -Wl,--enable-auto-image-base
  EOF
      } elsif ($BORLAND) {
        my $ldargs = $self->is_make_type('dmake')
            ? q{"$(PERL_ARCHIVE:s,/,\,)" $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),}
            : q{"$(subst /,\,$(PERL_ARCHIVE))" $(subst /,\,$(LDLOADLIBS)) $(subst /,\,$(MYEXTLIB)),};
        my $subbed;
        if ($exportlist eq '$(EXPORT_LIST)') {
            $subbed = $self->is_make_type('dmake')
                ? q{$(EXPORT_LIST:s,/,\,)}
                : q{$(subst /,\,$(EXPORT_LIST))};
        } else {
              # in XSMULTI, exportlist is per-XS, so have to sub in perl not make
            ($subbed = $exportlist) =~ s#/#\\#g;
        }
        push @m, sprintf <<'EOF', $ldfrom, $ldargs . $subbed;
          $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) %s,$@,,%s,$(RESFILES)
  EOF
      } else {	# VC
        push @m, sprintf <<'EOF', $ldfrom, $exportlist;
  	$(LD) -out:$@ $(LDDLFLAGS) %s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:%s
  EOF
        # 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, "\n\t\$(CHMOD) \$(PERM_RWX) \$\@\n";
  
      join '', @m;
  }
  
  sub xs_dynamic_lib_macros {
      my ($self, $attribs) = @_;
      my $otherldflags = $attribs->{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
      my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || "";
      sprintf <<'EOF', $otherldflags, $inst_dynamic_dep;
  # This section creates the dynamically loadable objects from relevant
  # objects and possibly $(MYEXTLIB).
  OTHERLDFLAGS = %s
  INST_DYNAMIC_DEP = %s
  EOF
  }
  
  =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_obj_opt
  
  Override to fixup -o flags for MSVC.
  
  =cut
  
  sub xs_obj_opt {
      my ($self, $output_file) = @_;
      ($MSVC ? "/Fo" : "-o ") . $output_file;
  }
  
  
  =item pasthru
  
  All we send is -nologo to nmake to prevent it from printing its damned
  banner.
  
  =cut
  
  sub pasthru {
      my($self) = shift;
      my $old = $self->SUPER::pasthru;
      return $old unless $self->is_make_type('nmake');
      $old =~ s/(PASTHRU\s*=\s*)/$1 -nologo /;
      $old;
  }
  
  
  =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#]/; # hash because gmake 4.2.1
  
      # 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 dbgoutflag
  
  Returns a CC flag that tells the CC to emit a separate debugging symbol file
  when compiling an object file.
  
  =cut
  
  sub dbgoutflag {
      $MSVC ? '-Fd$(*).pdb' : '';
  }
  
  =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}
  };
  
  }
  
  =item make_type
  
  Returns a suitable string describing the type of makefile being written.
  
  =cut
  
  sub make_type {
      my ($self) = @_;
      my $make = $self->make;
      $make = +( File::Spec->splitpath( $make ) )[-1];
      $make =~ s!\.exe$!!i;
      if ( $make =~ m![^A-Z0-9]!i ) {
        ($make) = grep { m!make!i } split m![^A-Z0-9]!i, $make;
      }
      return "$make-style";
  }
  
  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.36';
  $VERSION =~ tr/_//d;
  
  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.
  
  =over 4
  
  
  =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.36';
  $VERSION =~ tr/_//d;
  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 Encode::find_encoding('locale')->name eq '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.36';
  $VERSION =~ tr/_//d;
  
  # 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 &os_unsupported);
  our @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists
                      &WriteEmptyMakefile &open_for_writing &write_file_via_tmp
                      &_sprintf562);
  
  # 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';
  our $UNDER_CORE = $ENV{PERL_CORE}; # needs to be our
  
  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.
  
  
  # 5.6.2 can't do sprintf "%1$s" - this can only do %s
  sub _sprintf562 {
      my ($format, @args) = @_;
      for (my $i = 1; $i <= @args; $i++) {
          $format =~ s#%$i\$s#$args[$i-1]#g;
      }
      $format;
  }
  
  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',
   XSBUILD            => '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) = @_;
  
      foreach my $key (sort keys %$att) {
          my $val = $att->{$key};
          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 os_unsupported {
      die "OS unsupported\n";
  }
  
  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 PUREPERL_ONLY
      SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS
      XSBUILD XSMULTI 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 _has_cpan_meta_requirements {
      return eval {
        require CPAN::Meta::Requirements;
        CPAN::Meta::Requirements->VERSION(2.130);
        require B; # CMR requires this, for core we have to too.
      };
  }
  
  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
      my %key2cmr;
      for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) {
          $self->{$key}      ||= {};
          if (_has_cpan_meta_requirements) {
              my $cmr = CPAN::Meta::Requirements->from_string_hash(
                  $self->{$key},
                  {
                    bad_version_hook => sub {
                      #no warnings 'numeric'; # module doesn't use warnings
                      my $fallback;
                      if ( $_[0] =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) {
                        $fallback = sprintf "%f", $_[0];
                      } else {
                        ($fallback) = $_[0] ? ($_[0] =~ /^([0-9.]+)/) : 0;
                        $fallback += 0;
                        carp "Unparsable version '$_[0]' for prerequisite $_[1] treated as $fallback";
                      }
                      version->new($fallback);
                    },
                  },
              );
              $self->{$key} = $cmr->as_string_hash;
              $key2cmr{$key} = $cmr;
          } else {
              for my $module (sort keys %{ $self->{$key} }) {
                  my $version = $self->{$key}->{$module};
                  my $fallback = 0;
                  if (!defined($version) or !length($version)) {
                      carp "Undefined requirement for $module treated as '0' (CPAN::Meta::Requirements not available)";
                  }
                  elsif ($version =~ /^\d+(?:\.\d+(?:_\d+)*)?$/) {
                      next;
                  }
                  else {
                      if ( $version =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) {
                        $fallback = sprintf "%f", $version;
                      } else {
                        ($fallback) = $version ? ($version =~ /^([0-9.]+)/) : 0;
                        $fallback += 0;
                        carp "Unparsable version '$version' for prerequisite $module treated as $fallback (CPAN::Meta::Requirements not available)";
                      }
                  }
                  $self->{$key}->{$module} = $fallback;
              }
          }
      }
  
      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" && ! $UNDER_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 %prereq2version;
      my $cmr;
      if (_has_cpan_meta_requirements) {
          $cmr = CPAN::Meta::Requirements->new;
          for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) {
              $cmr->add_requirements($key2cmr{$key}) if $key2cmr{$key};
          }
          foreach my $prereq ($cmr->required_modules) {
              $prereq2version{$prereq} = $cmr->requirements_for_module($prereq);
          }
      } else {
          for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) {
              next unless my $module2version = $self->{$key};
              $prereq2version{$_} = $module2version->{$_} for keys %$module2version;
          }
      }
      foreach my $prereq (sort keys %prereq2version) {
          my $required_version = $prereq2version{$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';
            if ( !eval { version->new( $pr_version ); 1 } ) {
              #no warnings 'numeric'; # module doesn't use warnings
              my $fallback;
              if ( $pr_version =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) {
                $fallback = sprintf '%f', $pr_version;
              } else {
                ($fallback) = $pr_version ? ($pr_version =~ /^([0-9.]+)/) : 0;
                $fallback += 0;
                carp "Unparsable version '$pr_version' for installed prerequisite $prereq treated as $fallback";
              }
              $pr_version = $fallback;
            }
          }
  
          # 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 $UNDER_CORE;
  
              $unsatisfied{$prereq} = 'not installed';
          }
          elsif (
              $cmr
                  ? !$cmr->accepts_module($prereq, $pr_version)
                  : $required_version > $pr_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 $UNDER_CORE;
  
              $unsatisfied{$prereq} = $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";
          }
      }
  
      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$/ and $self->is_make_type('dmake');
                  $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 AR FULL_AR CC CCFLAGS
                                  OPTIMIZE LD LDDLFLAGS LDFLAGS PERL_ARCHLIB DESTDIR)) {
                  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 @args = @ARGV;
      @args = map { Encode::decode(locale => $_) } @args if $CAN_DECODE;
      my($argv) = neatvalue(\@args);
      $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 = @_;
      $att{DIR} = [] unless $att{DIR}; # don't recurse by default
      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 :
  
  manifypods :
  
  subdirs :
  
  dynamic :
  
  static :
  
  clean :
  
  install :
  
  makemakerdflt :
  
  test :
  
  test_dynamic :
  
  test_static :
  
  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($@, $!);
      print "Processing hints file $hint_file\n" if $Verbose;
  
      # 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) = @_;
      local $SIG{__WARN__} = sub {
          # can't use 'no warnings redefined', 5.6 only
          warn @_ unless $_[0] =~ /^Subroutine .* redefined/
      };
      foreach my $method (@Overridable) {
          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(@_);
              };
          }
      }
  }
  
  sub skipcheck {
      my($self) = shift;
      my($section) = @_;
      return 'skipped' if $section eq 'metafile' && $UNDER_CORE;
      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 '';
  }
  
  # returns filehandle, dies on fail. :raw so no :crlf
  sub open_for_writing {
      my ($file) = @_;
      open my $fh ,">", $file or die "Unable to open $file: $!";
      my @layers = ':raw';
      push @layers, join ' ', ':encoding(locale)' if $CAN_DECODE;
      binmode $fh, join ' ', @layers;
      $fh;
  }
  
  sub flush {
      my $self = shift;
  
      my $finalname = $self->{MAKEFILE};
      printf "Generating a %s %s\n", $self->make_type, $finalname if $Verbose || !$self->{PARENT};
      print "Writing $finalname for $self->{NAME}\n" if $Verbose || !$self->{PARENT};
  
      unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ());
  
      write_file_via_tmp($finalname, $self->{RESULT});
  
      # Write MYMETA.yml to communicate metadata up to the CPAN clients
      print "Writing MYMETA.yml and MYMETA.json\n"
        if !$self->{NO_MYMETA} and $self->write_mymeta( $self->mymeta );
  
      # save memory
      if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) {
          my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE);
          delete $self->{$_} for grep !$keep{$_}, keys %$self;
      }
  
      system("$Config::Config{eunicefix} $finalname")
        if $Config::Config{eunicefix} ne ":";
  
      return;
  }
  
  sub write_file_via_tmp {
      my ($finalname, $contents) = @_;
      my $fh = open_for_writing("MakeMaker.tmp");
      die "write_file_via_tmp: 2nd arg must be ref" unless ref $contents;
      for my $chunk (@$contents) {
          my $to_write = $chunk;
          utf8::encode $to_write if !$CAN_DECODE && "$]" > 5.008;
          print $fh "$to_write\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 if !$Is_VMS;
      return;
  }
  
  # This is a rename for OS's where the target must be unlinked first.
  sub _rename {
      my($src, $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;
  }
  
  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";
          }
      }
      # added here as selfdocument is not overridable
      push @m, <<'EOF';
  
  # here so even if top_targets is overridden, these will still be defined
  # gmake will silently still work if any are .PHONY-ed but nmake won't
  EOF
      push @m, join "\n", map "$_ ::\n\t\$(NOECHO) \$(NOOP)\n",
          # config is so manifypods won't puke if no subdirs
          grep !$self->{SKIPHASH}{$_},
          qw(static dynamic config);
      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.
  
  You can also organize your tests within subdirectories in the F<t/> directory.
  To do so, use the F<test> directive in your I<Makefile.PL>. For example, if you
  had tests in:
  
      t/foo
      t/foo/bar
  
  You could tell make to run tests in both of those directories with the
  following directives:
  
      test => {TESTS => 't/*/*.t t/*/*/*.t'}
      test => {TESTS => 't/foo/*.t t/foo/bar/*.t'}
  
  The first will run all test files in all first-level subdirectories and all
  subdirectories they contain. The second will run tests in only the F<t/foo>
  and F<t/foo/bar>.
  
  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.55_03 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
  
  Available in version 6.30_02 and above.
  
  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. Note that if you do not set
  this, the value of INSTALLVENDORLIB will be used, which is probably not
  what you want.
  
  =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
  
  Available in version 6.30_02 and above.
  
  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
  
  Available in version 6.8305 and above.
  
  When this is set to C<1>, C<OBJECT> will be automagically derived from
  C<O_FILES>.
  
  =item MAKE
  
  Available in version 6.30_01 and above.
  
  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
  
  Available in version 6.57_02 and above.
  
  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
  
  Available in version 6.7501 and above.
  
  When true, suppresses the writing of C<packlist> files for installs.
  
  Defaults to false.
  
  =item NO_PERLLOCAL
  
  Available in version 6.7501 and above.
  
  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. If it contains
  spaces or other shell metacharacters, it needs to be quoted in a way
  that protects them, since this value is intended to be inserted in a
  shell command line in the Makefile. E.g.:
  
    # Perl executable lives in "C:/Program Files/Perl/bin"
    # Normally you don't need to set this yourself!
    $ perl Makefile.PL PERL='"C:/Program Files/Perl/bin/perl.exe" -w'
  
  =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
  
  Available in version 6.51_01 and above.
  
  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.  This basename is actually a build
  target, and there is an intention, but not a requirement, that the *.PL file
  make the file passed to to 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'}
  
      PL_FILES => {'foo.PL' => 'foo.c'}
  
  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
  
  If an output file depends on extra input files beside the script itself,
  a hash ref can be used in version 7.36 and above:
  
      PL_FILES => { 'foo.PL' => {
          'foo.out' => 'foo.in',
          'bar.out' => [qw(bar1.in bar2.in)],
      }
  
  In this case the extra input files will be passed to the program after
  the target file:
  
     perl foo.PL foo.out foo.in
     perl foo.PL bar.out bar1.in bar2.in
  
  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).  The argument
  passed to the .PL is set up as a target to build in the Makefile.  In other
  sections such as C<postamble> you can specify a dependency on the
  filename/argument that the .PL is supposed (or will have, now that that is
  is a dependency) to generate.  Note the file to be generated will still be
  generated and the .PL will still run even without an explicit dependency created
  by you, since the C<all> target still depends on running all eligible to run.PL
  files.
  
  =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.
  You could use:
  
    PM_FILTER => 'perl -ne "print unless /^\\#/"',
  
  to remove all the leading comments on the fly during the build.  In order
  to be as portable as possible, please consider using a Perl one-liner
  rather than Unix (or other) utilities, as above.  The # is escaped for
  the Makefile, since what is going to be generated will then be:
  
    PM_FILTER = perl -ne "print unless /^\#/"
  
  Without the \ before the #, we'd have the start of a Makefile comment,
  and the macro would be incorrectly defined.
  
  You will almost certainly be better off using the C<PL_FILES> system,
  instead. See above, or the L<ExtUtils::MakeMaker::FAQ> entry.
  
  =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
  
  Available in version 6.8502 and above.
  
  Name of the executable used to run C<PPM_UNINSTALL_SCRIPT> below. (e.g. perl)
  
  =item PPM_UNINSTALL_SCRIPT
  
  Available in version 6.8502 and above.
  
  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.
  The versions given may be a Perl v-string (see L<version>) or a range
  (see L<CPAN::Meta::Requirements>).
  
  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
  
  Available in version 6.18 and above.
  
  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 XSBUILD
  
  Available in version 7.12 and above.
  
  Hashref with options controlling the operation of C<XSMULTI>:
  
    {
      xs => {
          all => {
              # options applying to all .xs files for this distribution
          },
          'lib/Class/Name/File' => { # specifically for this file
              DEFINE => '-Dfunktastic', # defines for only this file
              INC => "-I$funkyliblocation", # include flags for only this file
              # OBJECT => 'lib/Class/Name/File$(OBJ_EXT)', # default
              LDFROM => "lib/Class/Name/File\$(OBJ_EXT) $otherfile\$(OBJ_EXT)", # what's linked
          },
      },
    }
  
  Note C<xs> is the file-extension. More possibilities may arise in the
  future. Note that object names are specified without their XS extension.
  
  C<LDFROM> defaults to the same as C<OBJECT>. C<OBJECT> defaults to,
  for C<XSMULTI>, just the XS filename with the extension replaced with
  the compiler-specific object-file extension.
  
  The distinction between C<OBJECT> and C<LDFROM>: C<OBJECT> is the make
  target, so make will try to build it. However, C<LDFROM> is what will
  actually be linked together to make the shared object or static library
  (SO/SL), so if you override it, make sure it includes what you want to
  make the final SO/SL, almost certainly including the XS basename with
  C<$(OBJ_EXT)> appended.
  
  =item XSMULTI
  
  Available in version 7.12 and above.
  
  When this is set to C<1>, multiple XS files may be placed under F<lib/>
  next to their corresponding C<*.pm> files (this is essential for compiling
  with the correct C<VERSION> values). This feature should be considered
  experimental, and details of it may change.
  
  This feature was inspired by, and small portions of code copied from,
  L<ExtUtils::MakeMaker::BigHelper>. Hopefully this feature will render
  that module mainly obsolete.
  
  =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}
  
  This is supported since 6.76
  
  =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 agreed
  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 these
  files to see what prerequisites must be fulfilled before building or testing
  the distribution.  If you wish 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.
  
  =item os_unsupported
  
    os_unsupported();
    os_unsupported if $^O eq 'MSWin32';
  
  The C<os_unsupported()> function provides a way to correctly exit your
  C<Makefile.PL> before calling C<WriteMakefile>. It is essentially a
  C<die> with the message "OS unsupported".
  
  This is supported since 7.26
  
  =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.36';
  $VERSION =~ tr/_//d;
  
  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.36";
  $VERSION =~ tr/_//d;
  
  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 &GetConsoleCP) {
  		    require Win32;
                      # manually "import" it since Win32->import refuses
  		    *GetConsoleCP = sub { &Win32::GetConsoleCP } if defined &Win32::GetConsoleCP;
  		}
  		unless (defined &GetConsoleCP) {
  		    require Win32::API;
  		    Win32::API->Import('kernel32', 'int GetConsoleCP()');
  		}
  		if (defined &GetConsoleCP) {
  		    my $cp = GetConsoleCP();
  		    $ENCODING_LOCALE = "cp$cp" if $cp;
  		}
  	    };
  	}
  
  	unless ($ENCODING_CONSOLE_IN) {
              # only test one since set together
              unless (defined &GetInputCP) {
                  eval {
                      require Win32;
                      eval {
                          local $SIG{__WARN__} = sub {} if ( "$]" < 5.014 ); # suppress deprecation warning for inherited AUTOLOAD of Win32::GetConsoleCP()
                          Win32::GetConsoleCP();
                      };
                      # manually "import" it since Win32->import refuses
                      *GetInputCP = sub { &Win32::GetConsoleCP } if defined &Win32::GetConsoleCP;
                      *GetOutputCP = sub { &Win32::GetConsoleOutputCP } if defined &Win32::GetConsoleOutputCP;
                  };
                  unless (defined &GetInputCP) {
                      eval {
                          # try Win32::Console module for codepage to use
                          require Win32::Console;
                          *GetInputCP = sub { &Win32::Console::InputCP }
                              if defined &Win32::Console::InputCP;
                          *GetOutputCP = sub { &Win32::Console::OutputCP }
                              if defined &Win32::Console::OutputCP;
                      };
                  }
                  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;
      }
  
      # Workaround of Encode < v2.71 for "cp65000" and "cp65001"
      # The "cp65000" and "cp65001" aliases were added in [Encode v2.71](https://github.com/dankogai/p5-encode/commit/7874bd95aa10967a3b5dbae333d16bcd703ac6c6)
      # via commit <https://github.com/dankogai/p5-encode/commit/84b9c1101d5251d37e226f80d1c6781718779047>.
      # This will avoid test failures for Win32 machines using the UTF-7 or UTF-8 code pages.
      $ENCODING_LOCALE = 'UTF-7' if $ENCODING_LOCALE && lc($ENCODING_LOCALE) eq "cp65000";
      $ENCODING_LOCALE = 'utf-8-strict' if $ENCODING_LOCALE && lc($ENCODING_LOCALE) eq "cp65001";
  
      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 (sort 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 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
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.006001;
  use strict;
  
  use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
  
  $VERSION = '7.36';
  $VERSION =~ tr/_//d;
  $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.36';
  $VERSION =~ tr/_//d;
  
  #--------------------------------------------------------------------------#
  # 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.006001;
  use strict;
  
  use Config;
  use vars qw($VERSION $CLASS @ISA $LAX $STRICT);
  $VERSION = '7.36';
  $VERSION =~ tr/_//d;
  $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 ( "$]" >= 5.008_001 ) {
  	    $tvalue = _find_magic_vstring($value);
  	    $value = $tvalue if length $tvalue;
  	}
  	elsif ( "$]" >= 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 0.8;
  use Carp;
  use strict;
  use warnings;
  
  our $VERSION = '1.70';
  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 VERSION
  
  version 1.70
  
  =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, follow_fast => 1},
  	 $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>
  
  Currently maintained by the Perl Toolchain Gang.
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 1996- by Andreas Koenig.
  
  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
  
  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.36';
  $VERSION =~ tr/_//d;
  
  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 || (defined $DynaLoader::bscode && length $DynaLoader::bscode)){
  	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";
  	if (@all) {
  	    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
  
    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.36';
  $VERSION =~ tr/_//d;
  
  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'} !~ /\bgcc/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/Packlist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_PACKLIST';
  package ExtUtils::Packlist;
  
  use 5.00503;
  use strict;
  use Carp qw();
  use Config;
  use vars qw($VERSION $Relocations);
  $VERSION = '2.06';
  $VERSION = eval $VERSION;
  
  # Used for generating filehandle globs.  IO::File might not be available!
  my $fhname = "FH1";
  
  =begin _undocumented
  
  =over
  
  =item mkfh()
  
  Make a filehandle. Same kind of idea as Symbol::gensym().
  
  =cut
  
  sub mkfh()
  {
  no strict;
  local $^W;
  my $fh = \*{$fhname++};
  use strict;
  return($fh);
  }
  
  =item __find_relocations
  
  Works out what absolute paths in the configuration have been located at run
  time relative to $^X, and generates a regexp that matches them
  
  =back
  
  =end _undocumented
  
  =cut
  
  sub __find_relocations
  {
      my %paths;
      while (my ($raw_key, $raw_val) = each %Config) {
  	my $exp_key = $raw_key . "exp";
  	next unless exists $Config{$exp_key};
  	next unless $raw_val =~ m!\.\.\./!;
  	$paths{$Config{$exp_key}}++;
      }
      # Longest prefixes go first in the alternatives
      my $alternations = join "|", map {quotemeta $_}
      sort {length $b <=> length $a} keys %paths;
      qr/^($alternations)/o;
  }
  
  sub new($$)
  {
  my ($class, $packfile) = @_;
  $class = ref($class) || $class;
  my %self;
  tie(%self, $class, $packfile);
  return(bless(\%self, $class));
  }
  
  sub TIEHASH
  {
  my ($class, $packfile) = @_;
  my $self = { packfile => $packfile };
  bless($self, $class);
  $self->read($packfile) if (defined($packfile) && -f $packfile);
  return($self);
  }
  
  sub STORE
  {
  $_[0]->{data}->{$_[1]} = $_[2];
  }
  
  sub FETCH
  {
  return($_[0]->{data}->{$_[1]});
  }
  
  sub FIRSTKEY
  {
  my $reset = scalar(keys(%{$_[0]->{data}}));
  return(each(%{$_[0]->{data}}));
  }
  
  sub NEXTKEY
  {
  return(each(%{$_[0]->{data}}));
  }
  
  sub EXISTS
  {
  return(exists($_[0]->{data}->{$_[1]}));
  }
  
  sub DELETE
  {
  return(delete($_[0]->{data}->{$_[1]}));
  }
  
  sub CLEAR
  {
  %{$_[0]->{data}} = ();
  }
  
  sub DESTROY
  {
  }
  
  sub read($;$)
  {
  my ($self, $packfile) = @_;
  $self = tied(%$self) || $self;
  
  if (defined($packfile)) { $self->{packfile} = $packfile; }
  else { $packfile = $self->{packfile}; }
  Carp::croak("No packlist filename specified") if (! defined($packfile));
  my $fh = mkfh();
  open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!");
  $self->{data} = {};
  my ($line);
  while (defined($line = <$fh>))
     {
     chomp $line;
     my ($key, $data) = $line;
     if ($key =~ /^(.*?)( \w+=.*)$/)
        {
        $key = $1;
        $data = { map { split('=', $_) } split(' ', $2)};
  
        if ($Config{userelocatableinc} && $data->{relocate_as})
        {
  	  require File::Spec;
  	  require Cwd;
  	  my ($vol, $dir) = File::Spec->splitpath($packfile);
  	  my $newpath = File::Spec->catpath($vol, $dir, $data->{relocate_as});
  	  $key = Cwd::realpath($newpath);
        }
           }
     $key =~ s!/\./!/!g;   # Some .packlists have spurious '/./' bits in the paths
        $self->{data}->{$key} = $data;
        }
  close($fh);
  }
  
  sub write($;$)
  {
  my ($self, $packfile) = @_;
  $self = tied(%$self) || $self;
  if (defined($packfile)) { $self->{packfile} = $packfile; }
  else { $packfile = $self->{packfile}; }
  Carp::croak("No packlist filename specified") if (! defined($packfile));
  my $fh = mkfh();
  open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
  foreach my $key (sort(keys(%{$self->{data}})))
     {
         my $data = $self->{data}->{$key};
         if ($Config{userelocatableinc}) {
  	   $Relocations ||= __find_relocations();
  	   if ($packfile =~ $Relocations) {
  	       # We are writing into a subdirectory of a run-time relocated
  	       # path. Figure out if the this file is also within a subdir.
  	       my $prefix = $1;
  	       if (File::Spec->no_upwards(File::Spec->abs2rel($key, $prefix)))
  	       {
  		   # The relocated path is within the found prefix
  		   my $packfile_prefix;
  		   (undef, $packfile_prefix)
  		       = File::Spec->splitpath($packfile);
  
  		   my $relocate_as
  		       = File::Spec->abs2rel($key, $packfile_prefix);
  
  		   if (!ref $data) {
  		       $data = {};
  		   }
  		   $data->{relocate_as} = $relocate_as;
  	       }
  	   }
         }
     print $fh ("$key");
     if (ref($data))
        {
        foreach my $k (sort(keys(%$data)))
           {
           print $fh (" $k=$data->{$k}");
           }
        }
     print $fh ("\n");
     }
  close($fh);
  }
  
  sub validate($;$)
  {
  my ($self, $remove) = @_;
  $self = tied(%$self) || $self;
  my @missing;
  foreach my $key (sort(keys(%{$self->{data}})))
     {
     if (! -e $key)
        {
        push(@missing, $key);
        delete($self->{data}{$key}) if ($remove);
        }
     }
  return(@missing);
  }
  
  sub packlist_file($)
  {
  my ($self) = @_;
  $self = tied(%$self) || $self;
  return($self->{packfile});
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  ExtUtils::Packlist - manage .packlist files
  
  =head1 SYNOPSIS
  
     use ExtUtils::Packlist;
     my ($pl) = ExtUtils::Packlist->new('.packlist');
     $pl->read('/an/old/.packlist');
     my @missing_files = $pl->validate();
     $pl->write('/a/new/.packlist');
  
     $pl->{'/some/file/name'}++;
        or
     $pl->{'/some/other/file/name'} = { type => 'file',
                                        from => '/some/file' };
  
  =head1 DESCRIPTION
  
  ExtUtils::Packlist provides a standard way to manage .packlist files.
  Functions are provided to read and write .packlist files.  The original
  .packlist format is a simple list of absolute pathnames, one per line.  In
  addition, this package supports an extended format, where as well as a filename
  each line may contain a list of attributes in the form of a space separated
  list of key=value pairs.  This is used by the installperl script to
  differentiate between files and links, for example.
  
  =head1 USAGE
  
  The hash reference returned by the new() function can be used to examine and
  modify the contents of the .packlist.  Items may be added/deleted from the
  .packlist by modifying the hash.  If the value associated with a hash key is a
  scalar, the entry written to the .packlist by any subsequent write() will be a
  simple filename.  If the value is a hash, the entry written will be the
  filename followed by the key=value pairs from the hash.  Reading back the
  .packlist will recreate the original entries.
  
  =head1 FUNCTIONS
  
  =over 4
  
  =item new()
  
  This takes an optional parameter, the name of a .packlist.  If the file exists,
  it will be opened and the contents of the file will be read.  The new() method
  returns a reference to a hash.  This hash holds an entry for each line in the
  .packlist.  In the case of old-style .packlists, the value associated with each
  key is undef.  In the case of new-style .packlists, the value associated with
  each key is a hash containing the key=value pairs following the filename in the
  .packlist.
  
  =item read()
  
  This takes an optional parameter, the name of the .packlist to be read.  If
  no file is specified, the .packlist specified to new() will be read.  If the
  .packlist does not exist, Carp::croak will be called.
  
  =item write()
  
  This takes an optional parameter, the name of the .packlist to be written.  If
  no file is specified, the .packlist specified to new() will be overwritten.
  
  =item validate()
  
  This checks that every file listed in the .packlist actually exists.  If an
  argument which evaluates to true is given, any missing files will be removed
  from the internal hash.  The return value is a list of the missing files, which
  will be empty if they all exist.
  
  =item packlist_file()
  
  This returns the name of the associated .packlist file
  
  =back
  
  =head1 EXAMPLE
  
  Here's C<modrm>, a little utility to cleanly remove an installed module.
  
      #!/usr/local/bin/perl -w
  
      use strict;
      use IO::Dir;
      use ExtUtils::Packlist;
      use ExtUtils::Installed;
  
      sub emptydir($) {
  	my ($dir) = @_;
  	my $dh = IO::Dir->new($dir) || return(0);
  	my @count = $dh->read();
  	$dh->close();
  	return(@count == 2 ? 1 : 0);
      }
  
      # Find all the installed packages
      print("Finding all installed modules...\n");
      my $installed = ExtUtils::Installed->new();
  
      foreach my $module (grep(!/^Perl$/, $installed->modules())) {
         my $version = $installed->version($module) || "???";
         print("Found module $module Version $version\n");
         print("Do you want to delete $module? [n] ");
         my $r = <STDIN>; chomp($r);
         if ($r && $r =~ /^y/i) {
  	  # Remove all the files
  	  foreach my $file (sort($installed->files($module))) {
  	     print("rm $file\n");
  	     unlink($file);
  	  }
  	  my $pf = $installed->packlist($module)->packlist_file();
  	  print("rm $pf\n");
  	  unlink($pf);
  	  foreach my $dir (sort($installed->directory_tree($module))) {
  	     if (emptydir($dir)) {
  		print("rmdir $dir\n");
  		rmdir($dir);
  	     }
  	  }
         }
      }
  
  =head1 AUTHOR
  
  Alan Burlison <Alan.Burlison@uk.sun.com>
  
  =cut
EXTUTILS_PACKLIST

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

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

$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY';
  # vim: ts=4 sts=4 sw=4 et:
  package HTTP::Tiny;
  use strict;
  use warnings;
  # ABSTRACT: A small, simple, correct HTTP/1.1 client
  
  our $VERSION = '0.076';
  
  sub _croak { require Carp; Carp::croak(@_) }
  
  #pod =method new
  #pod
  #pod     $http = HTTP::Tiny->new( %attributes );
  #pod
  #pod This constructor returns a new HTTP::Tiny object.  Valid attributes include:
  #pod
  #pod =for :list
  #pod * C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If
  #pod   C<agent> — ends in a space character, the default user-agent string is
  #pod   appended.
  #pod * C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class
  #pod   that supports the C<add> and C<cookie_header> methods
  #pod * C<default_headers> — A hashref of default headers to apply to requests
  #pod * C<local_address> — The local IP address to bind to
  #pod * C<keep_alive> — Whether to reuse the last connection (if for the same
  #pod   scheme, host and port) (defaults to 1)
  #pod * C<max_redirect> — Maximum number of redirects allowed (defaults to 5)
  #pod * C<max_size> — Maximum response size in bytes (only when not using a data
  #pod   callback).  If defined, responses larger than this will return an
  #pod   exception.
  #pod * C<http_proxy> — URL of a proxy server to use for HTTP connections
  #pod   (default is C<$ENV{http_proxy}> — if set)
  #pod * C<https_proxy> — URL of a proxy server to use for HTTPS connections
  #pod   (default is C<$ENV{https_proxy}> — if set)
  #pod * C<proxy> — URL of a generic proxy server for both HTTP and HTTPS
  #pod   connections (default is C<$ENV{all_proxy}> — if set)
  #pod * C<no_proxy> — List of domain suffixes that should not be proxied.  Must
  #pod   be a comma-separated string or an array reference. (default is
  #pod   C<$ENV{no_proxy}> —)
  #pod * C<timeout> — Request timeout in seconds (default is 60) If a socket open,
  #pod   read or write takes longer than the timeout, an exception is thrown.
  #pod * C<verify_SSL> — A boolean that indicates whether to validate the SSL
  #pod   certificate of an C<https> — connection (default is false)
  #pod * C<SSL_options> — A hashref of C<SSL_*> — options to pass through to
  #pod   L<IO::Socket::SSL>
  #pod
  #pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
  #pod prevent getting the corresponding proxies from the environment.
  #pod
  #pod Exceptions from C<max_size>, C<timeout> or other errors will result in a
  #pod pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
  #pod content field in the response will contain the text of the exception.
  #pod
  #pod The C<keep_alive> parameter enables a persistent connection, but only to a
  #pod single destination scheme, host and port.  Also, if any connection-relevant
  #pod attributes are modified, or if the process ID or thread ID change, the
  #pod persistent connection will be dropped.  If you want persistent connections
  #pod across multiple destinations, use multiple HTTP::Tiny objects.
  #pod
  #pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
  #pod
  #pod =cut
  
  my @attributes;
  BEGIN {
      @attributes = qw(
          cookie_jar default_headers http_proxy https_proxy keep_alive
          local_address max_redirect max_size proxy no_proxy
          SSL_options verify_SSL
      );
      my %persist_ok = map {; $_ => 1 } qw(
          cookie_jar default_headers max_redirect max_size
      );
      no strict 'refs';
      no warnings 'uninitialized';
      for my $accessor ( @attributes ) {
          *{$accessor} = sub {
              @_ > 1
                  ? do {
                      delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
                      $_[0]->{$accessor} = $_[1]
                  }
                  : $_[0]->{$accessor};
          };
      }
  }
  
  sub agent {
      my($self, $agent) = @_;
      if( @_ > 1 ){
          $self->{agent} =
              (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
      }
      return $self->{agent};
  }
  
  sub timeout {
      my ($self, $timeout) = @_;
      if ( @_ > 1 ) {
          $self->{timeout} = $timeout;
          if ($self->{handle}) {
              $self->{handle}->timeout($timeout);
          }
      }
      return $self->{timeout};
  }
  
  sub new {
      my($class, %args) = @_;
  
      my $self = {
          max_redirect => 5,
          timeout      => defined $args{timeout} ? $args{timeout} : 60,
          keep_alive   => 1,
          verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
          no_proxy     => $ENV{no_proxy},
      };
  
      bless $self, $class;
  
      $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
  
      for my $key ( @attributes ) {
          $self->{$key} = $args{$key} if exists $args{$key}
      }
  
      $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
  
      $self->_set_proxies;
  
      return $self;
  }
  
  sub _set_proxies {
      my ($self) = @_;
  
      # get proxies from %ENV only if not provided; explicit undef will disable
      # getting proxies from the environment
  
      # generic proxy
      if (! exists $self->{proxy} ) {
          $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
      }
  
      if ( defined $self->{proxy} ) {
          $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
      }
      else {
          delete $self->{proxy};
      }
  
      # http proxy
      if (! exists $self->{http_proxy} ) {
          # under CGI, bypass HTTP_PROXY as request sets it from Proxy header
          local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD};
          $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
      }
  
      if ( defined $self->{http_proxy} ) {
          $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
          $self->{_has_proxy}{http} = 1;
      }
      else {
          delete $self->{http_proxy};
      }
  
      # https proxy
      if (! exists $self->{https_proxy} ) {
          $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
      }
  
      if ( $self->{https_proxy} ) {
          $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
          $self->{_has_proxy}{https} = 1;
      }
      else {
          delete $self->{https_proxy};
      }
  
      # Split no_proxy to array reference if not provided as such
      unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
          $self->{no_proxy} =
              (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
      }
  
      return;
  }
  
  #pod =method get|head|put|post|delete
  #pod
  #pod     $response = $http->get($url);
  #pod     $response = $http->get($url, \%options);
  #pod     $response = $http->head($url);
  #pod
  #pod These methods are shorthand for calling C<request()> for the given method.  The
  #pod URL must have unsafe characters escaped and international domain names encoded.
  #pod See C<request()> for valid options and a description of the response.
  #pod
  #pod The C<success> field of the response will be true if the status code is 2XX.
  #pod
  #pod =cut
  
  for my $sub_name ( qw/get head put post delete/ ) {
      my $req_method = uc $sub_name;
      no strict 'refs';
      eval <<"HERE"; ## no critic
      sub $sub_name {
          my (\$self, \$url, \$args) = \@_;
          \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
          or _croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
          return \$self->request('$req_method', \$url, \$args || {});
      }
  HERE
  }
  
  #pod =method post_form
  #pod
  #pod     $response = $http->post_form($url, $form_data);
  #pod     $response = $http->post_form($url, $form_data, \%options);
  #pod
  #pod This method executes a C<POST> request and sends the key/value pairs from a
  #pod form data hash or array reference to the given URL with a C<content-type> of
  #pod C<application/x-www-form-urlencoded>.  If data is provided as an array
  #pod reference, the order is preserved; if provided as a hash reference, the terms
  #pod are sorted on key and value for consistency.  See documentation for the
  #pod C<www_form_urlencode> method for details on the encoding.
  #pod
  #pod The URL must have unsafe characters escaped and international domain names
  #pod encoded.  See C<request()> for valid options and a description of the response.
  #pod Any C<content-type> header or content in the options hashref will be ignored.
  #pod
  #pod The C<success> field of the response will be true if the status code is 2XX.
  #pod
  #pod =cut
  
  sub post_form {
      my ($self, $url, $data, $args) = @_;
      (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
          or _croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
  
      my $headers = {};
      while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
          $headers->{lc $key} = $value;
      }
      delete $args->{headers};
  
      return $self->request('POST', $url, {
              %$args,
              content => $self->www_form_urlencode($data),
              headers => {
                  %$headers,
                  'content-type' => 'application/x-www-form-urlencoded'
              },
          }
      );
  }
  
  #pod =method mirror
  #pod
  #pod     $response = $http->mirror($url, $file, \%options)
  #pod     if ( $response->{success} ) {
  #pod         print "$file is up to date\n";
  #pod     }
  #pod
  #pod Executes a C<GET> request for the URL and saves the response body to the file
  #pod name provided.  The URL must have unsafe characters escaped and international
  #pod domain names encoded.  If the file already exists, the request will include an
  #pod C<If-Modified-Since> header with the modification timestamp of the file.  You
  #pod may specify a different C<If-Modified-Since> header yourself in the C<<
  #pod $options->{headers} >> hash.
  #pod
  #pod The C<success> field of the response will be true if the status code is 2XX
  #pod or if the status code is 304 (unmodified).
  #pod
  #pod If the file was modified and the server response includes a properly
  #pod formatted C<Last-Modified> header, the file modification time will
  #pod be updated accordingly.
  #pod
  #pod =cut
  
  sub mirror {
      my ($self, $url, $file, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or _croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
  
      if ( exists $args->{headers} ) {
          my $headers = {};
          while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
              $headers->{lc $key} = $value;
          }
          $args->{headers} = $headers;
      }
  
      if ( -e $file and my $mtime = (stat($file))[9] ) {
          $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
      }
      my $tempfile = $file . int(rand(2**31));
  
      require Fcntl;
      sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
         or _croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
      binmode $fh;
      $args->{data_callback} = sub { print {$fh} $_[0] };
      my $response = $self->request('GET', $url, $args);
      close $fh
          or _croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
  
      if ( $response->{success} ) {
          rename $tempfile, $file
              or _croak(qq/Error replacing $file with $tempfile: $!\n/);
          my $lm = $response->{headers}{'last-modified'};
          if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
              utime $mtime, $mtime, $file;
          }
      }
      $response->{success} ||= $response->{status} eq '304';
      unlink $tempfile;
      return $response;
  }
  
  #pod =method request
  #pod
  #pod     $response = $http->request($method, $url);
  #pod     $response = $http->request($method, $url, \%options);
  #pod
  #pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
  #pod 'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
  #pod international domain names encoded.
  #pod
  #pod B<NOTE>: Method names are B<case-sensitive> per the HTTP/1.1 specification.
  #pod Don't use C<get> when you really want C<GET>.  See L<LIMITATIONS> for
  #pod how this applies to redirection.
  #pod
  #pod If the URL includes a "user:password" stanza, they will be used for Basic-style
  #pod authorization headers.  (Authorization headers will not be included in a
  #pod redirected request.) For example:
  #pod
  #pod     $http->request('GET', 'http://Aladdin:open sesame@example.com/');
  #pod
  #pod If the "user:password" stanza contains reserved characters, they must
  #pod be percent-escaped:
  #pod
  #pod     $http->request('GET', 'http://john%40example.com:password@example.com/');
  #pod
  #pod A hashref of options may be appended to modify the request.
  #pod
  #pod Valid options are:
  #pod
  #pod =for :list
  #pod * C<headers> —
  #pod     A hashref containing headers to include with the request.  If the value for
  #pod     a header is an array reference, the header will be output multiple times with
  #pod     each value in the array.  These headers over-write any default headers.
  #pod * C<content> —
  #pod     A scalar to include as the body of the request OR a code reference
  #pod     that will be called iteratively to produce the body of the request
  #pod * C<trailer_callback> —
  #pod     A code reference that will be called if it exists to provide a hashref
  #pod     of trailing headers (only used with chunked transfer-encoding)
  #pod * C<data_callback> —
  #pod     A code reference that will be called for each chunks of the response
  #pod     body received.
  #pod * C<peer> —
  #pod     Override host resolution and force all connections to go only to a
  #pod     specific peer address, regardless of the URL of the request.  This will
  #pod     include any redirections!  This options should be used with extreme
  #pod     caution (e.g. debugging or very special circumstances). It can be given as
  #pod     either a scalar or a code reference that will receive the hostname and
  #pod     whose response will be taken as the address.
  #pod
  #pod The C<Host> header is generated from the URL in accordance with RFC 2616.  It
  #pod is a fatal error to specify C<Host> in the C<headers> option.  Other headers
  #pod may be ignored or overwritten if necessary for transport compliance.
  #pod
  #pod If the C<content> option is a code reference, it will be called iteratively
  #pod to provide the content body of the request.  It should return the empty
  #pod string or undef when the iterator is exhausted.
  #pod
  #pod If the C<content> option is the empty string, no C<content-type> or
  #pod C<content-length> headers will be generated.
  #pod
  #pod If the C<data_callback> option is provided, it will be called iteratively until
  #pod the entire response body is received.  The first argument will be a string
  #pod containing a chunk of the response body, the second argument will be the
  #pod in-progress response hash reference, as described below.  (This allows
  #pod customizing the action of the callback based on the C<status> or C<headers>
  #pod received prior to the content body.)
  #pod
  #pod The C<request> method returns a hashref containing the response.  The hashref
  #pod will have the following keys:
  #pod
  #pod =for :list
  #pod * C<success> —
  #pod     Boolean indicating whether the operation returned a 2XX status code
  #pod * C<url> —
  #pod     URL that provided the response. This is the URL of the request unless
  #pod     there were redirections, in which case it is the last URL queried
  #pod     in a redirection chain
  #pod * C<status> —
  #pod     The HTTP status code of the response
  #pod * C<reason> —
  #pod     The response phrase returned by the server
  #pod * C<content> —
  #pod     The body of the response.  If the response does not have any content
  #pod     or if a data callback is provided to consume the response body,
  #pod     this will be the empty string
  #pod * C<headers> —
  #pod     A hashref of header fields.  All header field names will be normalized
  #pod     to be lower case. If a header is repeated, the value will be an arrayref;
  #pod     it will otherwise be a scalar string containing the value
  #pod * C<protocol> -
  #pod     If this field exists, it is the protocol of the response
  #pod     such as HTTP/1.0 or HTTP/1.1
  #pod * C<redirects>
  #pod     If this field exists, it is an arrayref of response hash references from
  #pod     redirects in the same order that redirections occurred.  If it does
  #pod     not exist, then no redirections occurred.
  #pod
  #pod On an exception during the execution of the request, the C<status> field will
  #pod contain 599, and the C<content> field will contain the text of the exception.
  #pod
  #pod =cut
  
  my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
  
  sub request {
      my ($self, $method, $url, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or _croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
      $args ||= {}; # we keep some state in this during _request
  
      # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
      my $response;
      for ( 0 .. 1 ) {
          $response = eval { $self->_request($method, $url, $args) };
          last unless $@ && $idempotent{$method}
              && $@ =~ m{^(?:Socket closed|Unexpected end)};
      }
  
      if (my $e = $@) {
          # maybe we got a response hash thrown from somewhere deep
          if ( ref $e eq 'HASH' && exists $e->{status} ) {
              $e->{redirects} = delete $args->{_redirects} if @{ $args->{_redirects} || []};
              return $e;
          }
  
          # otherwise, stringify it
          $e = "$e";
          $response = {
              url     => $url,
              success => q{},
              status  => 599,
              reason  => 'Internal Exception',
              content => $e,
              headers => {
                  'content-type'   => 'text/plain',
                  'content-length' => length $e,
              },
              ( @{$args->{_redirects} || []} ? (redirects => delete $args->{_redirects}) : () ),
          };
      }
      return $response;
  }
  
  #pod =method www_form_urlencode
  #pod
  #pod     $params = $http->www_form_urlencode( $data );
  #pod     $response = $http->get("http://example.com/query?$params");
  #pod
  #pod This method converts the key/value pairs from a data hash or array reference
  #pod into a C<x-www-form-urlencoded> string.  The keys and values from the data
  #pod reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
  #pod array reference, the key will be repeated with each of the values of the array
  #pod reference.  If data is provided as a hash reference, the key/value pairs in the
  #pod resulting string will be sorted by key and value for consistent ordering.
  #pod
  #pod =cut
  
  sub www_form_urlencode {
      my ($self, $data) = @_;
      (@_ == 2 && ref $data)
          or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
      (ref $data eq 'HASH' || ref $data eq 'ARRAY')
          or _croak("form data must be a hash or array reference\n");
  
      my @params = ref $data eq 'HASH' ? %$data : @$data;
      @params % 2 == 0
          or _croak("form data reference must have an even number of terms\n");
  
      my @terms;
      while( @params ) {
          my ($key, $value) = splice(@params, 0, 2);
          if ( ref $value eq 'ARRAY' ) {
              unshift @params, map { $key => $_ } @$value;
          }
          else {
              push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
          }
      }
  
      return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
  }
  
  #pod =method can_ssl
  #pod
  #pod     $ok         = HTTP::Tiny->can_ssl;
  #pod     ($ok, $why) = HTTP::Tiny->can_ssl;
  #pod     ($ok, $why) = $http->can_ssl;
  #pod
  #pod Indicates if SSL support is available.  When called as a class object, it
  #pod checks for the correct version of L<Net::SSLeay> and L<IO::Socket::SSL>.
  #pod When called as an object methods, if C<SSL_verify> is true or if C<SSL_verify_mode>
  #pod is set in C<SSL_options>, it checks that a CA file is available.
  #pod
  #pod In scalar context, returns a boolean indicating if SSL is available.
  #pod In list context, returns the boolean and a (possibly multi-line) string of
  #pod errors indicating why SSL isn't available.
  #pod
  #pod =cut
  
  sub can_ssl {
      my ($self) = @_;
  
      my($ok, $reason) = (1, '');
  
      # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
      local @INC = @INC;
      pop @INC if $INC[-1] eq '.';
      unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
          $ok = 0;
          $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
      }
  
      # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
      unless (eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}) {
          $ok = 0;
          $reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/;
      }
  
      # If an object, check that SSL config lets us get a CA if necessary
      if ( ref($self) && ( $self->{verify_SSL} || $self->{SSL_options}{SSL_verify_mode} ) ) {
          my $handle = HTTP::Tiny::Handle->new(
              SSL_options => $self->{SSL_options},
              verify_SSL  => $self->{verify_SSL},
          );
          unless ( eval { $handle->_find_CA_file; 1 } ) {
              $ok = 0;
              $reason .= "$@";
          }
      }
  
      wantarray ? ($ok, $reason) : $ok;
  }
  
  #pod =method connected
  #pod
  #pod     $host = $http->connected;
  #pod     ($host, $port) = $http->connected;
  #pod
  #pod Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
  #pod option.
  #pod
  #pod In scalar context, returns the peer host and port, joined with a colon, or
  #pod C<undef> (if no peer is connected).
  #pod In list context, returns the peer host and port or an empty list (if no peer
  #pod is connected).
  #pod
  #pod B<Note>: This method cannot reliably be used to discover whether the remote
  #pod host has closed its end of the socket.
  #pod
  #pod =cut
  
  sub connected {
      my ($self) = @_;
  
      # If a socket exists...
      if ($self->{handle} && $self->{handle}{fh}) {
          my $socket = $self->{handle}{fh};
  
          # ...and is connected, return the peer host and port.
          if ($socket->connected) {
              return wantarray
                  ? ($socket->peerhost, $socket->peerport)
                  : join(':', $socket->peerhost, $socket->peerport);
          }
      }
      return;
  }
  
  #--------------------------------------------------------------------------#
  # private methods
  #--------------------------------------------------------------------------#
  
  my %DefaultPort = (
      http => 80,
      https => 443,
  );
  
  sub _agent {
      my $class = ref($_[0]) || $_[0];
      (my $default_agent = $class) =~ s{::}{-}g;
      return $default_agent . "/" . $class->VERSION;
  }
  
  sub _request {
      my ($self, $method, $url, $args) = @_;
  
      my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
  
      my $request = {
          method    => $method,
          scheme    => $scheme,
          host      => $host,
          port      => $port,
          host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
          uri       => $path_query,
          headers   => {},
      };
  
      my $peer = $args->{peer} || $host;
  
      # Allow 'peer' to be a coderef.
      if ('CODE' eq ref $peer) {
          $peer = $peer->($host);
      }
  
      # We remove the cached handle so it is not reused in the case of redirect.
      # If all is well, it will be recached at the end of _request.  We only
      # reuse for the same scheme, host and port
      my $handle = delete $self->{handle};
      if ( $handle ) {
          unless ( $handle->can_reuse( $scheme, $host, $port, $peer ) ) {
              $handle->close;
              undef $handle;
          }
      }
      $handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer );
  
      $self->_prepare_headers_and_cb($request, $args, $url, $auth);
      $handle->write_request($request);
  
      my $response;
      do { $response = $handle->read_response_header }
          until (substr($response->{status},0,1) ne '1');
  
      $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
      my @redir_args = $self->_maybe_redirect($request, $response, $args);
  
      my $known_message_length;
      if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
          # response has no message body
          $known_message_length = 1;
      }
      else {
          # Ignore any data callbacks during redirection.
          my $cb_args = @redir_args ? +{} : $args;
          my $data_cb = $self->_prepare_data_cb($response, $cb_args);
          $known_message_length = $handle->read_body($data_cb, $response);
      }
  
      if ( $self->{keep_alive}
          && $known_message_length
          && $response->{protocol} eq 'HTTP/1.1'
          && ($response->{headers}{connection} || '') ne 'close'
      ) {
          $self->{handle} = $handle;
      }
      else {
          $handle->close;
      }
  
      $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
      $response->{url} = $url;
  
      # Push the current response onto the stack of redirects if redirecting.
      if (@redir_args) {
          push @{$args->{_redirects}}, $response;
          return $self->_request(@redir_args, $args);
      }
  
      # Copy the stack of redirects into the response before returning.
      $response->{redirects} = delete $args->{_redirects}
        if @{$args->{_redirects}};
      return $response;
  }
  
  sub _open_handle {
      my ($self, $request, $scheme, $host, $port, $peer) = @_;
  
      my $handle  = HTTP::Tiny::Handle->new(
          timeout         => $self->{timeout},
          SSL_options     => $self->{SSL_options},
          verify_SSL      => $self->{verify_SSL},
          local_address   => $self->{local_address},
          keep_alive      => $self->{keep_alive}
      );
  
      if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
          return $self->_proxy_connect( $request, $handle );
      }
      else {
          return $handle->connect($scheme, $host, $port, $peer);
      }
  }
  
  sub _proxy_connect {
      my ($self, $request, $handle) = @_;
  
      my @proxy_vars;
      if ( $request->{scheme} eq 'https' ) {
          _croak(qq{No https_proxy defined}) unless $self->{https_proxy};
          @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
          if ( $proxy_vars[0] eq 'https' ) {
              _croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
          }
      }
      else {
          _croak(qq{No http_proxy defined}) unless $self->{http_proxy};
          @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
      }
  
      my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
  
      if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
          $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
      }
  
      $handle->connect($p_scheme, $p_host, $p_port, $p_host);
  
      if ($request->{scheme} eq 'https') {
          $self->_create_proxy_tunnel( $request, $handle );
      }
      else {
          # non-tunneled proxy requires absolute URI
          $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
      }
  
      return $handle;
  }
  
  sub _split_proxy {
      my ($self, $type, $proxy) = @_;
  
      my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
  
      unless(
          defined($scheme) && length($scheme) && length($host) && length($port)
          && $path_query eq '/'
      ) {
          _croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
      }
  
      return ($scheme, $host, $port, $auth);
  }
  
  sub _create_proxy_tunnel {
      my ($self, $request, $handle) = @_;
  
      $handle->_assert_ssl;
  
      my $agent = exists($request->{headers}{'user-agent'})
          ? $request->{headers}{'user-agent'} : $self->{agent};
  
      my $connect_request = {
          method    => 'CONNECT',
          uri       => "$request->{host}:$request->{port}",
          headers   => {
              host => "$request->{host}:$request->{port}",
              'user-agent' => $agent,
          }
      };
  
      if ( $request->{headers}{'proxy-authorization'} ) {
          $connect_request->{headers}{'proxy-authorization'} =
              delete $request->{headers}{'proxy-authorization'};
      }
  
      $handle->write_request($connect_request);
      my $response;
      do { $response = $handle->read_response_header }
          until (substr($response->{status},0,1) ne '1');
  
      # if CONNECT failed, throw the response so it will be
      # returned from the original request() method;
      unless (substr($response->{status},0,1) eq '2') {
          die $response;
      }
  
      # tunnel established, so start SSL handshake
      $handle->start_ssl( $request->{host} );
  
      return;
  }
  
  sub _prepare_headers_and_cb {
      my ($self, $request, $args, $url, $auth) = @_;
  
      for ($self->{default_headers}, $args->{headers}) {
          next unless defined;
          while (my ($k, $v) = each %$_) {
              $request->{headers}{lc $k} = $v;
              $request->{header_case}{lc $k} = $k;
          }
      }
  
      if (exists $request->{headers}{'host'}) {
          die(qq/The 'Host' header must not be provided as header option\n/);
      }
  
      $request->{headers}{'host'}         = $request->{host_port};
      $request->{headers}{'user-agent'} ||= $self->{agent};
      $request->{headers}{'connection'}   = "close"
          unless $self->{keep_alive};
  
      if ( defined $args->{content} ) {
          if (ref $args->{content} eq 'CODE') {
              $request->{headers}{'content-type'} ||= "application/octet-stream";
              $request->{headers}{'transfer-encoding'} = 'chunked'
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = $args->{content};
          }
          elsif ( length $args->{content} ) {
              my $content = $args->{content};
              if ( $] ge '5.008' ) {
                  utf8::downgrade($content, 1)
                      or die(qq/Wide character in request message body\n/);
              }
              $request->{headers}{'content-type'} ||= "application/octet-stream";
              $request->{headers}{'content-length'} = length $content
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = sub { substr $content, 0, length $content, '' };
          }
          $request->{trailer_cb} = $args->{trailer_callback}
              if ref $args->{trailer_callback} eq 'CODE';
      }
  
      ### If we have a cookie jar, then maybe add relevant cookies
      if ( $self->{cookie_jar} ) {
          my $cookies = $self->cookie_jar->cookie_header( $url );
          $request->{headers}{cookie} = $cookies if length $cookies;
      }
  
      # if we have Basic auth parameters, add them
      if ( length $auth && ! defined $request->{headers}{authorization} ) {
          $self->_add_basic_auth_header( $request, 'authorization' => $auth );
      }
  
      return;
  }
  
  sub _add_basic_auth_header {
      my ($self, $request, $header, $auth) = @_;
      require MIME::Base64;
      $request->{headers}{$header} =
          "Basic " . MIME::Base64::encode_base64($auth, "");
      return;
  }
  
  sub _prepare_data_cb {
      my ($self, $response, $args) = @_;
      my $data_cb = $args->{data_callback};
      $response->{content} = '';
  
      if (!$data_cb || $response->{status} !~ /^2/) {
          if (defined $self->{max_size}) {
              $data_cb = sub {
                  $_[1]->{content} .= $_[0];
                  die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
                    if length $_[1]->{content} > $self->{max_size};
              };
          }
          else {
              $data_cb = sub { $_[1]->{content} .= $_[0] };
          }
      }
      return $data_cb;
  }
  
  sub _update_cookie_jar {
      my ($self, $url, $response) = @_;
  
      my $cookies = $response->{headers}->{'set-cookie'};
      return unless defined $cookies;
  
      my @cookies = ref $cookies ? @$cookies : $cookies;
  
      $self->cookie_jar->add( $url, $_ ) for @cookies;
  
      return;
  }
  
  sub _validate_cookie_jar {
      my ($class, $jar) = @_;
  
      # duck typing
      for my $method ( qw/add cookie_header/ ) {
          _croak(qq/Cookie jar must provide the '$method' method\n/)
              unless ref($jar) && ref($jar)->can($method);
      }
  
      return;
  }
  
  sub _maybe_redirect {
      my ($self, $request, $response, $args) = @_;
      my $headers = $response->{headers};
      my ($status, $method) = ($response->{status}, $request->{method});
      $args->{_redirects} ||= [];
  
      if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))
          and $headers->{location}
          and @{$args->{_redirects}} < $self->{max_redirect}
      ) {
          my $location = ($headers->{location} =~ /^\//)
              ? "$request->{scheme}://$request->{host_port}$headers->{location}"
              : $headers->{location} ;
          return (($status eq '303' ? 'GET' : $method), $location);
      }
      return;
  }
  
  sub _split_url {
      my $url = pop;
  
      # URI regex adapted from the URI module
      my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
        or die(qq/Cannot parse URL: '$url'\n/);
  
      $scheme     = lc $scheme;
      $path_query = "/$path_query" unless $path_query =~ m<\A/>;
  
      my $auth = '';
      if ( (my $i = index $host, '@') != -1 ) {
          # user:pass@host
          $auth = substr $host, 0, $i, ''; # take up to the @ for auth
          substr $host, 0, 1, '';          # knock the @ off the host
  
          # userinfo might be percent escaped, so recover real auth info
          $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
      }
      my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
               : $scheme eq 'http'                  ? 80
               : $scheme eq 'https'                 ? 443
               : undef;
  
      return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
  }
  
  # Date conversions adapted from HTTP::Date
  my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
  my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
  sub _http_date {
      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
      return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
          substr($DoW,$wday*4,3),
          $mday, substr($MoY,$mon*4,3), $year+1900,
          $hour, $min, $sec
      );
  }
  
  sub _parse_http_date {
      my ($self, $str) = @_;
      require Time::Local;
      my @tl_parts;
      if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
          @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
      }
      return eval {
          my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
          $t < 0 ? undef : $t;
      };
  }
  
  # URI escaping adapted from URI::Escape
  # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
  # perl 5.6 ready UTF-8 encoding adapted from JSON::PP
  my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
  $escapes{' '}="+";
  my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
  
  sub _uri_escape {
      my ($self, $str) = @_;
      if ( $] ge '5.008' ) {
          utf8::encode($str);
      }
      else {
          $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
              if ( length $str == do { use bytes; length $str } );
          $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
      }
      $str =~ s/($unsafe_char)/$escapes{$1}/g;
      return $str;
  }
  
  package
      HTTP::Tiny::Handle; # hide from PAUSE/indexers
  use strict;
  use warnings;
  
  use Errno      qw[EINTR EPIPE];
  use IO::Socket qw[SOCK_STREAM];
  use Socket     qw[SOL_SOCKET SO_KEEPALIVE];
  
  # PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old
  # behavior if someone is unable to boostrap CPAN from a new perl install; it is
  # not intended for general, per-client use and may be removed in the future
  my $SOCKET_CLASS =
      $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
      eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' :
      'IO::Socket::INET';
  
  sub BUFSIZE () { 32768 } ## no critic
  
  my $Printable = sub {
      local $_ = shift;
      s/\r/\\r/g;
      s/\n/\\n/g;
      s/\t/\\t/g;
      s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
      $_;
  };
  
  my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
  my $Field_Content = qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;
  
  sub new {
      my ($class, %args) = @_;
      return bless {
          rbuf             => '',
          timeout          => 60,
          max_line_size    => 16384,
          max_header_lines => 64,
          verify_SSL       => 0,
          SSL_options      => {},
          %args
      }, $class;
  }
  
  sub timeout {
      my ($self, $timeout) = @_;
      if ( @_ > 1 ) {
          $self->{timeout} = $timeout;
          if ( $self->{fh} && $self->{fh}->can('timeout') ) {
              $self->{fh}->timeout($timeout);
          }
      }
      return $self->{timeout};
  }
  
  sub connect {
      @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n");
      my ($self, $scheme, $host, $port, $peer) = @_;
  
      if ( $scheme eq 'https' ) {
          $self->_assert_ssl;
      }
      elsif ( $scheme ne 'http' ) {
        die(qq/Unsupported URL scheme '$scheme'\n/);
      }
      $self->{fh} = $SOCKET_CLASS->new(
          PeerHost  => $peer,
          PeerPort  => $port,
          $self->{local_address} ?
              ( LocalAddr => $self->{local_address} ) : (),
          Proto     => 'tcp',
          Type      => SOCK_STREAM,
          Timeout   => $self->{timeout},
      ) or die(qq/Could not connect to '$host:$port': $@\n/);
  
      binmode($self->{fh})
        or die(qq/Could not binmode() socket: '$!'\n/);
  
      if ( $self->{keep_alive} ) {
          unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) {
              CORE::close($self->{fh});
              die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/);
          }
      }
  
      $self->start_ssl($host) if $scheme eq 'https';
  
      $self->{scheme} = $scheme;
      $self->{host} = $host;
      $self->{peer} = $peer;
      $self->{port} = $port;
      $self->{pid} = $$;
      $self->{tid} = _get_tid();
  
      return $self;
  }
  
  sub start_ssl {
      my ($self, $host) = @_;
  
      # As this might be used via CONNECT after an SSL session
      # to a proxy, we shut down any existing SSL before attempting
      # the handshake
      if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
          unless ( $self->{fh}->stop_SSL ) {
              my $ssl_err = IO::Socket::SSL->errstr;
              die(qq/Error halting prior SSL connection: $ssl_err/);
          }
      }
  
      my $ssl_args = $self->_ssl_args($host);
      IO::Socket::SSL->start_SSL(
          $self->{fh},
          %$ssl_args,
          SSL_create_ctx_callback => sub {
              my $ctx = shift;
              Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
          },
      );
  
      unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
          my $ssl_err = IO::Socket::SSL->errstr;
          die(qq/SSL connection failed for $host: $ssl_err\n/);
      }
  }
  
  sub close {
      @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
      my ($self) = @_;
      CORE::close($self->{fh})
        or die(qq/Could not close socket: '$!'\n/);
  }
  
  sub write {
      @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
      my ($self, $buf) = @_;
  
      if ( $] ge '5.008' ) {
          utf8::downgrade($buf, 1)
              or die(qq/Wide character in write()\n/);
      }
  
      my $len = length $buf;
      my $off = 0;
  
      local $SIG{PIPE} = 'IGNORE';
  
      while () {
          $self->can_write
            or die(qq/Timed out while waiting for socket to become ready for writing\n/);
          my $r = syswrite($self->{fh}, $buf, $len, $off);
          if (defined $r) {
              $len -= $r;
              $off += $r;
              last unless $len > 0;
          }
          elsif ($! == EPIPE) {
              die(qq/Socket closed by remote server: $!\n/);
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not write to SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not write to socket: '$!'\n/);
              }
  
          }
      }
      return $off;
  }
  
  sub read {
      @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
      my ($self, $len, $allow_partial) = @_;
  
      my $buf  = '';
      my $got = length $self->{rbuf};
  
      if ($got) {
          my $take = ($got < $len) ? $got : $len;
          $buf  = substr($self->{rbuf}, 0, $take, '');
          $len -= $take;
      }
  
      while ($len > 0) {
          $self->can_read
            or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
          my $r = sysread($self->{fh}, $buf, $len, length $buf);
          if (defined $r) {
              last unless $r;
              $len -= $r;
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not read from SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not read from socket: '$!'\n/);
              }
          }
      }
      if ($len && !$allow_partial) {
          die(qq/Unexpected end of stream\n/);
      }
      return $buf;
  }
  
  sub readline {
      @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
      my ($self) = @_;
  
      while () {
          if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
              return $1;
          }
          if (length $self->{rbuf} >= $self->{max_line_size}) {
              die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
          }
          $self->can_read
            or die(qq/Timed out while waiting for socket to become ready for reading\n/);
          my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
          if (defined $r) {
              last unless $r;
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not read from SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not read from socket: '$!'\n/);
              }
          }
      }
      die(qq/Unexpected end of stream while looking for line\n/);
  }
  
  sub read_header_lines {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
      my ($self, $headers) = @_;
      $headers ||= {};
      my $lines   = 0;
      my $val;
  
      while () {
           my $line = $self->readline;
  
           if (++$lines >= $self->{max_header_lines}) {
               die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
           }
           elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
               my ($field_name) = lc $1;
               if (exists $headers->{$field_name}) {
                   for ($headers->{$field_name}) {
                       $_ = [$_] unless ref $_ eq "ARRAY";
                       push @$_, $2;
                       $val = \$_->[-1];
                   }
               }
               else {
                   $val = \($headers->{$field_name} = $2);
               }
           }
           elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
               $val
                 or die(qq/Unexpected header continuation line\n/);
               next unless length $1;
               $$val .= ' ' if length $$val;
               $$val .= $1;
           }
           elsif ($line =~ /\A \x0D?\x0A \z/x) {
              last;
           }
           else {
              die(q/Malformed header line: / . $Printable->($line) . "\n");
           }
      }
      return $headers;
  }
  
  sub write_request {
      @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
      my($self, $request) = @_;
      $self->write_request_header(@{$request}{qw/method uri headers header_case/});
      $self->write_body($request) if $request->{cb};
      return;
  }
  
  # Standard request header names/case from HTTP/1.1 RFCs
  my @rfc_request_headers = qw(
    Accept Accept-Charset Accept-Encoding Accept-Language Authorization
    Cache-Control Connection Content-Length Expect From Host
    If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
    Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer
    Transfer-Encoding Upgrade User-Agent Via
  );
  
  my @other_request_headers = qw(
    Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin
    X-XSS-Protection
  );
  
  my %HeaderCase = map { lc($_) => $_ } @rfc_request_headers, @other_request_headers;
  
  # to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
  # combine writes.
  sub write_header_lines {
      (@_ >= 2 && @_ <= 4 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ . "\n");
      my($self, $headers, $header_case, $prefix_data) = @_;
      $header_case ||= {};
  
      my $buf = (defined $prefix_data ? $prefix_data : '');
  
      # Per RFC, control fields should be listed first
      my %seen;
      for my $k ( qw/host cache-control expect max-forwards pragma range te/ ) {
          next unless exists $headers->{$k};
          $seen{$k}++;
          my $field_name = $HeaderCase{$k};
          my $v = $headers->{$k};
          for (ref $v eq 'ARRAY' ? @$v : $v) {
              $_ = '' unless defined $_;
              $buf .= "$field_name: $_\x0D\x0A";
          }
      }
  
      # Other headers sent in arbitrary order
      while (my ($k, $v) = each %$headers) {
          my $field_name = lc $k;
          next if $seen{$field_name};
          if (exists $HeaderCase{$field_name}) {
              $field_name = $HeaderCase{$field_name};
          }
          else {
              if (exists $header_case->{$field_name}) {
                  $field_name = $header_case->{$field_name};
              }
              else {
                  $field_name =~ s/\b(\w)/\u$1/g;
              }
              $field_name =~ /\A $Token+ \z/xo
                or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
              $HeaderCase{lc $field_name} = $field_name;
          }
          for (ref $v eq 'ARRAY' ? @$v : $v) {
              # unwrap a field value if pre-wrapped by user
              s/\x0D?\x0A\s+/ /g;
              die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n")
                unless $_ eq '' || /\A $Field_Content \z/xo;
              $_ = '' unless defined $_;
              $buf .= "$field_name: $_\x0D\x0A";
          }
      }
      $buf .= "\x0D\x0A";
      return $self->write($buf);
  }
  
  # return value indicates whether message length was defined; this is generally
  # true unless there was no content-length header and we just read until EOF.
  # Other message length errors are thrown as exceptions
  sub read_body {
      @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
      my ($self, $cb, $response) = @_;
      my $te = $response->{headers}{'transfer-encoding'} || '';
      my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
      return $chunked
          ? $self->read_chunked_body($cb, $response)
          : $self->read_content_body($cb, $response);
  }
  
  sub write_body {
      @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
      my ($self, $request) = @_;
      if ($request->{headers}{'content-length'}) {
          return $self->write_content_body($request);
      }
      else {
          return $self->write_chunked_body($request);
      }
  }
  
  sub read_content_body {
      @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
      my ($self, $cb, $response, $content_length) = @_;
      $content_length ||= $response->{headers}{'content-length'};
  
      if ( defined $content_length ) {
          my $len = $content_length;
          while ($len > 0) {
              my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
              $cb->($self->read($read, 0), $response);
              $len -= $read;
          }
          return length($self->{rbuf}) == 0;
      }
  
      my $chunk;
      $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
  
      return;
  }
  
  sub write_content_body {
      @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
      my ($self, $request) = @_;
  
      my ($len, $content_length) = (0, $request->{headers}{'content-length'});
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or die(qq/Wide character in write_content()\n/);
          }
  
          $len += $self->write($data);
      }
  
      $len == $content_length
        or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
  
      return $len;
  }
  
  sub read_chunked_body {
      @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
      my ($self, $cb, $response) = @_;
  
      while () {
          my $head = $self->readline;
  
          $head =~ /\A ([A-Fa-f0-9]+)/x
            or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
  
          my $len = hex($1)
            or last;
  
          $self->read_content_body($cb, $response, $len);
  
          $self->read(2) eq "\x0D\x0A"
            or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
      }
      $self->read_header_lines($response->{headers});
      return 1;
  }
  
  sub write_chunked_body {
      @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
      my ($self, $request) = @_;
  
      my $len = 0;
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or die(qq/Wide character in write_chunked_body()\n/);
          }
  
          $len += length $data;
  
          my $chunk  = sprintf '%X', length $data;
             $chunk .= "\x0D\x0A";
             $chunk .= $data;
             $chunk .= "\x0D\x0A";
  
          $self->write($chunk);
      }
      $self->write("0\x0D\x0A");
      if ( ref $request->{trailer_cb} eq 'CODE' ) {
          $self->write_header_lines($request->{trailer_cb}->())
      }
      else {
          $self->write("\x0D\x0A");
      }
      return $len;
  }
  
  sub read_response_header {
      @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
      my ($self) = @_;
  
      my $line = $self->readline;
  
      $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
        or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
  
      my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
  
      die (qq/Unsupported HTTP protocol: $protocol\n/)
          unless $version =~ /0*1\.0*[01]/;
  
      return {
          status       => $status,
          reason       => $reason,
          headers      => $self->read_header_lines,
          protocol     => $protocol,
      };
  }
  
  sub write_request_header {
      @_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n");
      my ($self, $method, $request_uri, $headers, $header_case) = @_;
  
      return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A");
  }
  
  sub _do_timeout {
      my ($self, $type, $timeout) = @_;
      $timeout = $self->{timeout}
          unless defined $timeout && $timeout >= 0;
  
      my $fd = fileno $self->{fh};
      defined $fd && $fd >= 0
        or die(qq/select(2): 'Bad file descriptor'\n/);
  
      my $initial = time;
      my $pending = $timeout;
      my $nfound;
  
      vec(my $fdset = '', $fd, 1) = 1;
  
      while () {
          $nfound = ($type eq 'read')
              ? select($fdset, undef, undef, $pending)
              : select(undef, $fdset, undef, $pending) ;
          if ($nfound == -1) {
              $! == EINTR
                or die(qq/select(2): '$!'\n/);
              redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
              $nfound = 0;
          }
          last;
      }
      $! = 0;
      return $nfound;
  }
  
  sub can_read {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
      my $self = shift;
      if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
          return 1 if $self->{fh}->pending;
      }
      return $self->_do_timeout('read', @_)
  }
  
  sub can_write {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
      my $self = shift;
      return $self->_do_timeout('write', @_)
  }
  
  sub _assert_ssl {
      my($ok, $reason) = HTTP::Tiny->can_ssl();
      die $reason unless $ok;
  }
  
  sub can_reuse {
      my ($self,$scheme,$host,$port,$peer) = @_;
      return 0 if
          $self->{pid} != $$
          || $self->{tid} != _get_tid()
          || length($self->{rbuf})
          || $scheme ne $self->{scheme}
          || $host ne $self->{host}
          || $port ne $self->{port}
          || $peer ne $self->{peer}
          || eval { $self->can_read(0) }
          || $@ ;
          return 1;
  }
  
  # Try to find a CA bundle to validate the SSL cert,
  # prefer Mozilla::CA or fallback to a system file
  sub _find_CA_file {
      my $self = shift();
  
      my $ca_file =
        defined( $self->{SSL_options}->{SSL_ca_file} )
        ? $self->{SSL_options}->{SSL_ca_file}
        : $ENV{SSL_CERT_FILE};
  
      if ( defined $ca_file ) {
          unless ( -r $ca_file ) {
              die qq/SSL_ca_file '$ca_file' not found or not readable\n/;
          }
          return $ca_file;
      }
  
      local @INC = @INC;
      pop @INC if $INC[-1] eq '.';
      return Mozilla::CA::SSL_ca_file()
          if eval { require Mozilla::CA; 1 };
  
      # cert list copied from golang src/crypto/x509/root_unix.go
      foreach my $ca_bundle (
          "/etc/ssl/certs/ca-certificates.crt",     # Debian/Ubuntu/Gentoo etc.
          "/etc/pki/tls/certs/ca-bundle.crt",       # Fedora/RHEL
          "/etc/ssl/ca-bundle.pem",                 # OpenSUSE
          "/etc/openssl/certs/ca-certificates.crt", # NetBSD
          "/etc/ssl/cert.pem",                      # OpenBSD
          "/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly
          "/etc/pki/tls/cacert.pem",                # OpenELEC
          "/etc/certs/ca-certificates.crt",         # Solaris 11.2+
      ) {
          return $ca_bundle if -e $ca_bundle;
      }
  
      die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
        . qq/Try installing Mozilla::CA from CPAN\n/;
  }
  
  # for thread safety, we need to know thread id if threads are loaded
  sub _get_tid {
      no warnings 'reserved'; # for 'threads'
      return threads->can("tid") ? threads->tid : 0;
  }
  
  sub _ssl_args {
      my ($self, $host) = @_;
  
      my %ssl_args;
  
      # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
      # added until IO::Socket::SSL 1.84
      if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
          $ssl_args{SSL_hostname} = $host,          # Sane SNI support
      }
  
      if ($self->{verify_SSL}) {
          $ssl_args{SSL_verifycn_scheme}  = 'http'; # enable CN validation
          $ssl_args{SSL_verifycn_name}    = $host;  # set validation hostname
          $ssl_args{SSL_verify_mode}      = 0x01;   # enable cert validation
          $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
      }
      else {
          $ssl_args{SSL_verifycn_scheme}  = 'none'; # disable CN validation
          $ssl_args{SSL_verify_mode}      = 0x00;   # disable cert validation
      }
  
      # user options override settings from verify_SSL
      for my $k ( keys %{$self->{SSL_options}} ) {
          $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
      }
  
      return \%ssl_args;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  HTTP::Tiny - A small, simple, correct HTTP/1.1 client
  
  =head1 VERSION
  
  version 0.076
  
  =head1 SYNOPSIS
  
      use HTTP::Tiny;
  
      my $response = HTTP::Tiny->new->get('http://example.com/');
  
      die "Failed!\n" unless $response->{success};
  
      print "$response->{status} $response->{reason}\n";
  
      while (my ($k, $v) = each %{$response->{headers}}) {
          for (ref $v eq 'ARRAY' ? @$v : $v) {
              print "$k: $_\n";
          }
      }
  
      print $response->{content} if length $response->{content};
  
  =head1 DESCRIPTION
  
  This is a very simple HTTP/1.1 client, designed for doing simple
  requests without the overhead of a large framework like L<LWP::UserAgent>.
  
  It is more correct and more complete than L<HTTP::Lite>.  It supports
  proxies and redirection.  It also correctly resumes after EINTR.
  
  If L<IO::Socket::IP> 0.25 or later is installed, HTTP::Tiny will use it instead
  of L<IO::Socket::INET> for transparent support for both IPv4 and IPv6.
  
  Cookie support requires L<HTTP::CookieJar> or an equivalent class.
  
  =head1 METHODS
  
  =head2 new
  
      $http = HTTP::Tiny->new( %attributes );
  
  This constructor returns a new HTTP::Tiny object.  Valid attributes include:
  
  =over 4
  
  =item *
  
  C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended.
  
  =item *
  
  C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods
  
  =item *
  
  C<default_headers> — A hashref of default headers to apply to requests
  
  =item *
  
  C<local_address> — The local IP address to bind to
  
  =item *
  
  C<keep_alive> — Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
  
  =item *
  
  C<max_redirect> — Maximum number of redirects allowed (defaults to 5)
  
  =item *
  
  C<max_size> — Maximum response size in bytes (only when not using a data callback).  If defined, responses larger than this will return an exception.
  
  =item *
  
  C<http_proxy> — URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set)
  
  =item *
  
  C<https_proxy> — URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set)
  
  =item *
  
  C<proxy> — URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set)
  
  =item *
  
  C<no_proxy> — List of domain suffixes that should not be proxied.  Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —)
  
  =item *
  
  C<timeout> — Request timeout in seconds (default is 60) If a socket open, read or write takes longer than the timeout, an exception is thrown.
  
  =item *
  
  C<verify_SSL> — A boolean that indicates whether to validate the SSL certificate of an C<https> — connection (default is false)
  
  =item *
  
  C<SSL_options> — A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>
  
  =back
  
  Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
  prevent getting the corresponding proxies from the environment.
  
  Exceptions from C<max_size>, C<timeout> or other errors will result in a
  pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
  content field in the response will contain the text of the exception.
  
  The C<keep_alive> parameter enables a persistent connection, but only to a
  single destination scheme, host and port.  Also, if any connection-relevant
  attributes are modified, or if the process ID or thread ID change, the
  persistent connection will be dropped.  If you want persistent connections
  across multiple destinations, use multiple HTTP::Tiny objects.
  
  See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
  
  =head2 get|head|put|post|delete
  
      $response = $http->get($url);
      $response = $http->get($url, \%options);
      $response = $http->head($url);
  
  These methods are shorthand for calling C<request()> for the given method.  The
  URL must have unsafe characters escaped and international domain names encoded.
  See C<request()> for valid options and a description of the response.
  
  The C<success> field of the response will be true if the status code is 2XX.
  
  =head2 post_form
  
      $response = $http->post_form($url, $form_data);
      $response = $http->post_form($url, $form_data, \%options);
  
  This method executes a C<POST> request and sends the key/value pairs from a
  form data hash or array reference to the given URL with a C<content-type> of
  C<application/x-www-form-urlencoded>.  If data is provided as an array
  reference, the order is preserved; if provided as a hash reference, the terms
  are sorted on key and value for consistency.  See documentation for the
  C<www_form_urlencode> method for details on the encoding.
  
  The URL must have unsafe characters escaped and international domain names
  encoded.  See C<request()> for valid options and a description of the response.
  Any C<content-type> header or content in the options hashref will be ignored.
  
  The C<success> field of the response will be true if the status code is 2XX.
  
  =head2 mirror
  
      $response = $http->mirror($url, $file, \%options)
      if ( $response->{success} ) {
          print "$file is up to date\n";
      }
  
  Executes a C<GET> request for the URL and saves the response body to the file
  name provided.  The URL must have unsafe characters escaped and international
  domain names encoded.  If the file already exists, the request will include an
  C<If-Modified-Since> header with the modification timestamp of the file.  You
  may specify a different C<If-Modified-Since> header yourself in the C<<
  $options->{headers} >> hash.
  
  The C<success> field of the response will be true if the status code is 2XX
  or if the status code is 304 (unmodified).
  
  If the file was modified and the server response includes a properly
  formatted C<Last-Modified> header, the file modification time will
  be updated accordingly.
  
  =head2 request
  
      $response = $http->request($method, $url);
      $response = $http->request($method, $url, \%options);
  
  Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
  'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
  international domain names encoded.
  
  B<NOTE>: Method names are B<case-sensitive> per the HTTP/1.1 specification.
  Don't use C<get> when you really want C<GET>.  See L<LIMITATIONS> for
  how this applies to redirection.
  
  If the URL includes a "user:password" stanza, they will be used for Basic-style
  authorization headers.  (Authorization headers will not be included in a
  redirected request.) For example:
  
      $http->request('GET', 'http://Aladdin:open sesame@example.com/');
  
  If the "user:password" stanza contains reserved characters, they must
  be percent-escaped:
  
      $http->request('GET', 'http://john%40example.com:password@example.com/');
  
  A hashref of options may be appended to modify the request.
  
  Valid options are:
  
  =over 4
  
  =item *
  
  C<headers> — A hashref containing headers to include with the request.  If the value for a header is an array reference, the header will be output multiple times with each value in the array.  These headers over-write any default headers.
  
  =item *
  
  C<content> — A scalar to include as the body of the request OR a code reference that will be called iteratively to produce the body of the request
  
  =item *
  
  C<trailer_callback> — A code reference that will be called if it exists to provide a hashref of trailing headers (only used with chunked transfer-encoding)
  
  =item *
  
  C<data_callback> — A code reference that will be called for each chunks of the response body received.
  
  =item *
  
  C<peer> — Override host resolution and force all connections to go only to a specific peer address, regardless of the URL of the request.  This will include any redirections!  This options should be used with extreme caution (e.g. debugging or very special circumstances). It can be given as either a scalar or a code reference that will receive the hostname and whose response will be taken as the address.
  
  =back
  
  The C<Host> header is generated from the URL in accordance with RFC 2616.  It
  is a fatal error to specify C<Host> in the C<headers> option.  Other headers
  may be ignored or overwritten if necessary for transport compliance.
  
  If the C<content> option is a code reference, it will be called iteratively
  to provide the content body of the request.  It should return the empty
  string or undef when the iterator is exhausted.
  
  If the C<content> option is the empty string, no C<content-type> or
  C<content-length> headers will be generated.
  
  If the C<data_callback> option is provided, it will be called iteratively until
  the entire response body is received.  The first argument will be a string
  containing a chunk of the response body, the second argument will be the
  in-progress response hash reference, as described below.  (This allows
  customizing the action of the callback based on the C<status> or C<headers>
  received prior to the content body.)
  
  The C<request> method returns a hashref containing the response.  The hashref
  will have the following keys:
  
  =over 4
  
  =item *
  
  C<success> — Boolean indicating whether the operation returned a 2XX status code
  
  =item *
  
  C<url> — URL that provided the response. This is the URL of the request unless there were redirections, in which case it is the last URL queried in a redirection chain
  
  =item *
  
  C<status> — The HTTP status code of the response
  
  =item *
  
  C<reason> — The response phrase returned by the server
  
  =item *
  
  C<content> — The body of the response.  If the response does not have any content or if a data callback is provided to consume the response body, this will be the empty string
  
  =item *
  
  C<headers> — A hashref of header fields.  All header field names will be normalized to be lower case. If a header is repeated, the value will be an arrayref; it will otherwise be a scalar string containing the value
  
  =item *
  
  C<protocol> - If this field exists, it is the protocol of the response such as HTTP/1.0 or HTTP/1.1
  
  =item *
  
  C<redirects> If this field exists, it is an arrayref of response hash references from redirects in the same order that redirections occurred.  If it does not exist, then no redirections occurred.
  
  =back
  
  On an exception during the execution of the request, the C<status> field will
  contain 599, and the C<content> field will contain the text of the exception.
  
  =head2 www_form_urlencode
  
      $params = $http->www_form_urlencode( $data );
      $response = $http->get("http://example.com/query?$params");
  
  This method converts the key/value pairs from a data hash or array reference
  into a C<x-www-form-urlencoded> string.  The keys and values from the data
  reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
  array reference, the key will be repeated with each of the values of the array
  reference.  If data is provided as a hash reference, the key/value pairs in the
  resulting string will be sorted by key and value for consistent ordering.
  
  =head2 can_ssl
  
      $ok         = HTTP::Tiny->can_ssl;
      ($ok, $why) = HTTP::Tiny->can_ssl;
      ($ok, $why) = $http->can_ssl;
  
  Indicates if SSL support is available.  When called as a class object, it
  checks for the correct version of L<Net::SSLeay> and L<IO::Socket::SSL>.
  When called as an object methods, if C<SSL_verify> is true or if C<SSL_verify_mode>
  is set in C<SSL_options>, it checks that a CA file is available.
  
  In scalar context, returns a boolean indicating if SSL is available.
  In list context, returns the boolean and a (possibly multi-line) string of
  errors indicating why SSL isn't available.
  
  =head2 connected
  
      $host = $http->connected;
      ($host, $port) = $http->connected;
  
  Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
  option.
  
  In scalar context, returns the peer host and port, joined with a colon, or
  C<undef> (if no peer is connected).
  In list context, returns the peer host and port or an empty list (if no peer
  is connected).
  
  B<Note>: This method cannot reliably be used to discover whether the remote
  host has closed its end of the socket.
  
  =for Pod::Coverage SSL_options
  agent
  cookie_jar
  default_headers
  http_proxy
  https_proxy
  keep_alive
  local_address
  max_redirect
  max_size
  no_proxy
  proxy
  timeout
  verify_SSL
  
  =head1 SSL SUPPORT
  
  Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
  greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
  thrown if new enough versions of these modules are not installed or if the SSL
  encryption fails. You can also use C<HTTP::Tiny::can_ssl()> utility function
  that returns boolean to see if the required modules are installed.
  
  An C<https> connection may be made via an C<http> proxy that supports the CONNECT
  command (i.e. RFC 2817).  You may not proxy C<https> via a proxy that itself
  requires C<https> to communicate.
  
  SSL provides two distinct capabilities:
  
  =over 4
  
  =item *
  
  Encrypted communication channel
  
  =item *
  
  Verification of server identity
  
  =back
  
  B<By default, HTTP::Tiny does not verify server identity>.
  
  Server identity verification is controversial and potentially tricky because it
  depends on a (usually paid) third-party Certificate Authority (CA) trust model
  to validate a certificate as legitimate.  This discriminates against servers
  with self-signed certificates or certificates signed by free, community-driven
  CA's such as L<CAcert.org|http://cacert.org>.
  
  By default, HTTP::Tiny does not make any assumptions about your trust model,
  threat level or risk tolerance.  It just aims to give you an encrypted channel
  when you need one.
  
  Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
  that an SSL connection has a valid SSL certificate corresponding to the host
  name of the connection and that the SSL certificate has been verified by a CA.
  Assuming you trust the CA, this will protect against a L<man-in-the-middle
  attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
  concerned about security, you should enable this option.
  
  Certificate verification requires a file containing trusted CA certificates.
  
  If the environment variable C<SSL_CERT_FILE> is present, HTTP::Tiny
  will try to find a CA certificate file in that location.
  
  If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
  included with it as a source of trusted CA's.  (This means you trust Mozilla,
  the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
  toolchain used to install it, and your operating system security, right?)
  
  If that module is not available, then HTTP::Tiny will search several
  system-specific default locations for a CA certificate file:
  
  =over 4
  
  =item *
  
  /etc/ssl/certs/ca-certificates.crt
  
  =item *
  
  /etc/pki/tls/certs/ca-bundle.crt
  
  =item *
  
  /etc/ssl/ca-bundle.pem
  
  =back
  
  An exception will be raised if C<verify_SSL> is true and no CA certificate file
  is available.
  
  If you desire complete control over SSL connections, the C<SSL_options> attribute
  lets you provide a hash reference that will be passed through to
  C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
  example, to provide your own trusted CA file:
  
      SSL_options => {
          SSL_ca_file => $file_path,
      }
  
  The C<SSL_options> attribute could also be used for such things as providing a
  client certificate for authentication to a server or controlling the choice of
  cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
  details.
  
  =head1 PROXY SUPPORT
  
  HTTP::Tiny can proxy both C<http> and C<https> requests.  Only Basic proxy
  authorization is supported and it must be provided as part of the proxy URL:
  C<http://user:pass@proxy.example.com/>.
  
  HTTP::Tiny supports the following proxy environment variables:
  
  =over 4
  
  =item *
  
  http_proxy or HTTP_PROXY
  
  =item *
  
  https_proxy or HTTPS_PROXY
  
  =item *
  
  all_proxy or ALL_PROXY
  
  =back
  
  If the C<REQUEST_METHOD> environment variable is set, then this might be a CGI
  process and C<HTTP_PROXY> would be set from the C<Proxy:> header, which is a
  security risk.  If C<REQUEST_METHOD> is set, C<HTTP_PROXY> (the upper case
  variant only) is ignored.
  
  Tunnelling C<https> over an C<http> proxy using the CONNECT method is
  supported.  If your proxy uses C<https> itself, you can not tunnel C<https>
  over it.
  
  Be warned that proxying an C<https> connection opens you to the risk of a
  man-in-the-middle attack by the proxy server.
  
  The C<no_proxy> environment variable is supported in the format of a
  comma-separated list of domain extensions proxy should not be used for.
  
  Proxy arguments passed to C<new> will override their corresponding
  environment variables.
  
  =head1 LIMITATIONS
  
  HTTP::Tiny is I<conditionally compliant> with the
  L<HTTP/1.1 specifications|http://www.w3.org/Protocols/>:
  
  =over 4
  
  =item *
  
  "Message Syntax and Routing" [RFC7230]
  
  =item *
  
  "Semantics and Content" [RFC7231]
  
  =item *
  
  "Conditional Requests" [RFC7232]
  
  =item *
  
  "Range Requests" [RFC7233]
  
  =item *
  
  "Caching" [RFC7234]
  
  =item *
  
  "Authentication" [RFC7235]
  
  =back
  
  It attempts to meet all "MUST" requirements of the specification, but does not
  implement all "SHOULD" requirements.  (Note: it was developed against the
  earlier RFC 2616 specification and may not yet meet the revised RFC 7230-7235
  spec.)
  
  Some particular limitations of note include:
  
  =over
  
  =item *
  
  HTTP::Tiny focuses on correct transport.  Users are responsible for ensuring
  that user-defined headers and content are compliant with the HTTP/1.1
  specification.
  
  =item *
  
  Users must ensure that URLs are properly escaped for unsafe characters and that
  international domain names are properly encoded to ASCII. See L<URI::Escape>,
  L<URI::_punycode> and L<Net::IDN::Encode>.
  
  =item *
  
  Redirection is very strict against the specification.  Redirection is only
  automatic for response codes 301, 302, 307 and 308 if the request method is
  'GET' or 'HEAD'.  Response code 303 is always converted into a 'GET'
  redirection, as mandated by the specification.  There is no automatic support
  for status 305 ("Use proxy") redirections.
  
  =item *
  
  There is no provision for delaying a request body using an C<Expect> header.
  Unexpected C<1XX> responses are silently ignored as per the specification.
  
  =item *
  
  Only 'chunked' C<Transfer-Encoding> is supported.
  
  =item *
  
  There is no support for a Request-URI of '*' for the 'OPTIONS' request.
  
  =item *
  
  Headers mentioned in the RFCs and some other, well-known headers are
  generated with their canonical case.  Other headers are sent in the
  case provided by the user.  Except for control headers (which are sent first),
  headers are sent in arbitrary order.
  
  =back
  
  Despite the limitations listed above, HTTP::Tiny is considered
  feature-complete.  New feature requests should be directed to
  L<HTTP::Tiny::UA>.
  
  =head1 SEE ALSO
  
  =over 4
  
  =item *
  
  L<HTTP::Tiny::UA> - Higher level UA features for HTTP::Tiny
  
  =item *
  
  L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility
  
  =item *
  
  L<HTTP::Tiny::Mech> - Wrap L<WWW::Mechanize> instance in HTTP::Tiny compatible interface
  
  =item *
  
  L<IO::Socket::IP> - Required for IPv6 support
  
  =item *
  
  L<IO::Socket::SSL> - Required for SSL support
  
  =item *
  
  L<LWP::UserAgent> - If HTTP::Tiny isn't enough for you, this is the "standard" way to do things
  
  =item *
  
  L<Mozilla::CA> - Required if you want to validate SSL certificates
  
  =item *
  
  L<Net::SSLeay> - Required for SSL support
  
  =back
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<https://github.com/chansen/p5-http-tiny/issues>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/chansen/p5-http-tiny>
  
    git clone https://github.com/chansen/p5-http-tiny.git
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Christian Hansen <chansen@cpan.org>
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =for stopwords Alan Gardner Alessandro Ghedini A. Sinan Unur Brad Gilbert brian m. carlson Chris Nehren Weyl Claes Jakobsson Clinton Gormley Craig Berry David Golden Mitchell Dean Pearce Edward Zborowski Felipe Gasper James Raspass Jeremy Mates Jess Robinson Karen Etheridge Lukas Eklund Martin J. Evans Martin-Louis Bright Mike Doherty Nicolas Rochelemagne Olaf Alders Olivier Mengué Petr Písař Serguei Trouchelle Shoichi Kaji SkyMarshal Sören Kornetzki Steve Grazzini Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook
  
  =over 4
  
  =item *
  
  Alan Gardner <gardner@pythian.com>
  
  =item *
  
  Alessandro Ghedini <al3xbio@gmail.com>
  
  =item *
  
  A. Sinan Unur <nanis@cpan.org>
  
  =item *
  
  Brad Gilbert <bgills@cpan.org>
  
  =item *
  
  brian m. carlson <sandals@crustytoothpaste.net>
  
  =item *
  
  Chris Nehren <apeiron@cpan.org>
  
  =item *
  
  Chris Weyl <cweyl@alumni.drew.edu>
  
  =item *
  
  Claes Jakobsson <claes@surfar.nu>
  
  =item *
  
  Clinton Gormley <clint@traveljury.com>
  
  =item *
  
  Craig A. Berry <craigberry@mac.com>
  
  =item *
  
  Craig Berry <cberry@cpan.org>
  
  =item *
  
  David Golden <xdg@xdg.me>
  
  =item *
  
  David Mitchell <davem@iabyn.com>
  
  =item *
  
  Dean Pearce <pearce@pythian.com>
  
  =item *
  
  Edward Zborowski <ed@rubensteintech.com>
  
  =item *
  
  Felipe Gasper <felipe@felipegasper.com>
  
  =item *
  
  James Raspass <jraspass@gmail.com>
  
  =item *
  
  Jeremy Mates <jmates@cpan.org>
  
  =item *
  
  Jess Robinson <castaway@desert-island.me.uk>
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  Lukas Eklund <leklund@gmail.com>
  
  =item *
  
  Martin J. Evans <mjegh@ntlworld.com>
  
  =item *
  
  Martin-Louis Bright <mlbright@gmail.com>
  
  =item *
  
  Mike Doherty <doherty@cpan.org>
  
  =item *
  
  Nicolas Rochelemagne <rochelemagne@cpanel.net>
  
  =item *
  
  Olaf Alders <olaf@wundersolutions.com>
  
  =item *
  
  Olivier Mengué <dolmen@cpan.org>
  
  =item *
  
  Petr Písař <ppisar@redhat.com>
  
  =item *
  
  Serguei Trouchelle <stro@cpan.org>
  
  =item *
  
  Shoichi Kaji <skaji@cpan.org>
  
  =item *
  
  SkyMarshal <skymarshal1729@gmail.com>
  
  =item *
  
  Sören Kornetzki <soeren.kornetzki@delti.com>
  
  =item *
  
  Steve Grazzini <steve.grazzini@grantstreet.com>
  
  =item *
  
  Syohei YOSHIDA <syohex@gmail.com>
  
  =item *
  
  Tatsuhiko Miyagawa <miyagawa@bulknews.net>
  
  =item *
  
  Tom Hukins <tom@eborcom.com>
  
  =item *
  
  Tony Cook <tony@develop-help.com>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2018 by Christian Hansen.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
HTTP_TINY

$fatpacked{"HTTP/Tinyish.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH';
  package HTTP::Tinyish;
  use strict;
  use warnings;
  use Carp ();
  
  our $VERSION = '0.15';
  
  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/) {
      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: C<LWP>, L<HTTP::Tiny>, L<Curl>
  and L<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> 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/ ) {
      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 = (
          '--location',
          '--silent',
          '--max-time', ($self->{timeout} || 60),
          '--max-redirs', ($self->{max_redirect} || 5),
          '--user-agent', ($self->{agent} || "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),
      );
  
      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(delete $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', ($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{"IO/Socket/IP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IO_SOCKET_IP';
  #  You may distribute under the terms of either the GNU General Public License
  #  or the Artistic License (the same terms as Perl itself)
  #
  #  (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk
  
  package IO::Socket::IP;
  # $VERSION needs to be set before  use base 'IO::Socket'
  #  - https://rt.cpan.org/Ticket/Display.html?id=92107
  BEGIN {
     $VERSION = '0.39';
  }
  
  use strict;
  use warnings;
  use base qw( IO::Socket );
  
  use Carp;
  
  use Socket 1.97 qw(
     getaddrinfo getnameinfo
     sockaddr_family
     AF_INET
     AI_PASSIVE
     IPPROTO_TCP IPPROTO_UDP
     IPPROTO_IPV6 IPV6_V6ONLY
     NI_DGRAM NI_NUMERICHOST NI_NUMERICSERV NIx_NOHOST NIx_NOSERV
     SO_REUSEADDR SO_REUSEPORT SO_BROADCAST SO_ERROR
     SOCK_DGRAM SOCK_STREAM
     SOL_SOCKET
  );
  my $AF_INET6 = eval { Socket::AF_INET6() }; # may not be defined
  my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0;
  use POSIX qw( dup2 );
  use Errno qw( EINVAL EINPROGRESS EISCONN ENOTCONN ETIMEDOUT EWOULDBLOCK EOPNOTSUPP );
  
  use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" );
  
  # At least one OS (Android) is known not to have getprotobyname()
  use constant HAVE_GETPROTOBYNAME => defined eval { getprotobyname( "tcp" ) };
  
  my $IPv6_re = do {
     # translation of RFC 3986 3.2.2 ABNF to re
     my $IPv4address = do {
        my $dec_octet = q<(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])>;
        qq<$dec_octet(?: \\. $dec_octet){3}>;
     };
     my $IPv6address = do {
        my $h16  = qq<[0-9A-Fa-f]{1,4}>;
        my $ls32 = qq<(?: $h16 : $h16 | $IPv4address)>;
        qq<(?:
                                              (?: $h16 : ){6} $ls32
           |                               :: (?: $h16 : ){5} $ls32
           | (?:                   $h16 )? :: (?: $h16 : ){4} $ls32
           | (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32
           | (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32
           | (?: (?: $h16 : ){0,3} $h16 )? ::     $h16 :      $ls32
           | (?: (?: $h16 : ){0,4} $h16 )? ::                 $ls32
           | (?: (?: $h16 : ){0,5} $h16 )? ::                 $h16
           | (?: (?: $h16 : ){0,6} $h16 )? ::
        )>
     };
     qr<$IPv6address>xo;
  };
  
  =head1 NAME
  
  C<IO::Socket::IP> - Family-neutral IP socket supporting both IPv4 and IPv6
  
  =head1 SYNOPSIS
  
   use IO::Socket::IP;
  
   my $sock = IO::Socket::IP->new(
      PeerHost => "www.google.com",
      PeerPort => "http",
      Type     => SOCK_STREAM,
   ) or die "Cannot construct socket - $@";
  
   my $familyname = ( $sock->sockdomain == PF_INET6 ) ? "IPv6" :
                    ( $sock->sockdomain == PF_INET  ) ? "IPv4" :
                                                        "unknown";
  
   printf "Connected to google via %s\n", $familyname;
  
  =head1 DESCRIPTION
  
  This module provides a protocol-independent way to use IPv4 and IPv6 sockets,
  intended as a replacement for L<IO::Socket::INET>. Most constructor arguments
  and methods are provided in a backward-compatible way. For a list of known
  differences, see the C<IO::Socket::INET> INCOMPATIBILITES section below.
  
  It uses the C<getaddrinfo(3)> function to convert hostnames and service names
  or port numbers into sets of possible addresses to connect to or listen on.
  This allows it to work for IPv6 where the system supports it, while still
  falling back to IPv4-only on systems which don't.
  
  =head1 REPLACING C<IO::Socket> DEFAULT BEHAVIOUR
  
  By placing C<-register> in the import list, L<IO::Socket> uses
  C<IO::Socket::IP> rather than C<IO::Socket::INET> as the class that handles
  C<PF_INET>.  C<IO::Socket> will also use C<IO::Socket::IP> rather than
  C<IO::Socket::INET6> to handle C<PF_INET6>, provided that the C<AF_INET6>
  constant is available.
  
  Changing C<IO::Socket>'s default behaviour means that calling the
  C<IO::Socket> constructor with either C<PF_INET> or C<PF_INET6> as the
  C<Domain> parameter will yield an C<IO::Socket::IP> object.
  
   use IO::Socket::IP -register;
  
   my $sock = IO::Socket->new(
      Domain    => PF_INET6,
      LocalHost => "::1",
      Listen    => 1,
   ) or die "Cannot create socket - $@\n";
  
   print "Created a socket of type " . ref($sock) . "\n";
  
  Note that C<-register> is a global setting that applies to the entire program;
  it cannot be applied only for certain callers, removed, or limited by lexical
  scope.
  
  =cut
  
  sub import
  {
     my $pkg = shift;
     my @symbols;
  
     foreach ( @_ ) {
        if( $_ eq "-register" ) {
           IO::Socket::IP::_ForINET->register_domain( AF_INET );
           IO::Socket::IP::_ForINET6->register_domain( $AF_INET6 ) if defined $AF_INET6;
        }
        else {
           push @symbols, $_;
        }
     }
  
     @_ = ( $pkg, @symbols );
     goto &IO::Socket::import;
  }
  
  # Convenient capability test function
  {
     my $can_disable_v6only;
     sub CAN_DISABLE_V6ONLY
     {
        return $can_disable_v6only if defined $can_disable_v6only;
  
        socket my $testsock, Socket::PF_INET6(), SOCK_STREAM, 0 or
           die "Cannot socket(PF_INET6) - $!";
  
        if( setsockopt $testsock, IPPROTO_IPV6, IPV6_V6ONLY, 0 ) {
           return $can_disable_v6only = 1;
        }
        elsif( $! == EINVAL || $! == EOPNOTSUPP ) {
           return $can_disable_v6only = 0;
        }
        else {
           die "Cannot setsockopt() - $!";
        }
     }
  }
  
  =head1 CONSTRUCTORS
  
  =cut
  
  =head2 $sock = IO::Socket::IP->new( %args )
  
  Creates a new C<IO::Socket::IP> object, containing a newly created socket
  handle according to the named arguments passed. The recognised arguments are:
  
  =over 8
  
  =item PeerHost => STRING
  
  =item PeerService => STRING
  
  Hostname and service name for the peer to C<connect()> to. The service name
  may be given as a port number, as a decimal string.
  
  =item PeerAddr => STRING
  
  =item PeerPort => STRING
  
  For symmetry with the accessor methods and compatibility with
  C<IO::Socket::INET>, these are accepted as synonyms for C<PeerHost> and
  C<PeerService> respectively.
  
  =item PeerAddrInfo => ARRAY
  
  Alternate form of specifying the peer to C<connect()> to. This should be an
  array of the form returned by C<Socket::getaddrinfo>.
  
  This parameter takes precedence over the C<Peer*>, C<Family>, C<Type> and
  C<Proto> arguments.
  
  =item LocalHost => STRING
  
  =item LocalService => STRING
  
  Hostname and service name for the local address to C<bind()> to.
  
  =item LocalAddr => STRING
  
  =item LocalPort => STRING
  
  For symmetry with the accessor methods and compatibility with
  C<IO::Socket::INET>, these are accepted as synonyms for C<LocalHost> and
  C<LocalService> respectively.
  
  =item LocalAddrInfo => ARRAY
  
  Alternate form of specifying the local address to C<bind()> to. This should be
  an array of the form returned by C<Socket::getaddrinfo>.
  
  This parameter takes precedence over the C<Local*>, C<Family>, C<Type> and
  C<Proto> arguments.
  
  =item Family => INT
  
  The address family to pass to C<getaddrinfo> (e.g. C<AF_INET>, C<AF_INET6>).
  Normally this will be left undefined, and C<getaddrinfo> will search using any
  address family supported by the system.
  
  =item Type => INT
  
  The socket type to pass to C<getaddrinfo> (e.g. C<SOCK_STREAM>,
  C<SOCK_DGRAM>). Normally defined by the caller; if left undefined
  C<getaddrinfo> may attempt to infer the type from the service name.
  
  =item Proto => STRING or INT
  
  The IP protocol to use for the socket (e.g. C<'tcp'>, C<IPPROTO_TCP>,
  C<'udp'>,C<IPPROTO_UDP>). Normally this will be left undefined, and either
  C<getaddrinfo> or the kernel will choose an appropriate value. May be given
  either in string name or numeric form.
  
  =item GetAddrInfoFlags => INT
  
  More flags to pass to the C<getaddrinfo()> function. If not supplied, a
  default of C<AI_ADDRCONFIG> will be used.
  
  These flags will be combined with C<AI_PASSIVE> if the C<Listen> argument is
  given. For more information see the documentation about C<getaddrinfo()> in
  the L<Socket> module.
  
  =item Listen => INT
  
  If defined, puts the socket into listening mode where new connections can be
  accepted using the C<accept> method. The value given is used as the
  C<listen(2)> queue size.
  
  =item ReuseAddr => BOOL
  
  If true, set the C<SO_REUSEADDR> sockopt
  
  =item ReusePort => BOOL
  
  If true, set the C<SO_REUSEPORT> sockopt (not all OSes implement this sockopt)
  
  =item Broadcast => BOOL
  
  If true, set the C<SO_BROADCAST> sockopt
  
  =item Sockopts => ARRAY
  
  An optional array of other socket options to apply after the three listed
  above. The value is an ARRAY containing 2- or 3-element ARRAYrefs. Each inner
  array relates to a single option, giving the level and option name, and an
  optional value. If the value element is missing, it will be given the value of
  a platform-sized integer 1 constant (i.e. suitable to enable most of the
  common boolean options).
  
  For example, both options given below are equivalent to setting C<ReuseAddr>.
  
   Sockopts => [
      [ SOL_SOCKET, SO_REUSEADDR ],
      [ SOL_SOCKET, SO_REUSEADDR, pack( "i", 1 ) ],
   ]
  
  =item V6Only => BOOL
  
  If defined, set the C<IPV6_V6ONLY> sockopt when creating C<PF_INET6> sockets
  to the given value. If true, a listening-mode socket will only listen on the
  C<AF_INET6> addresses; if false it will also accept connections from
  C<AF_INET> addresses.
  
  If not defined, the socket option will not be changed, and default value set
  by the operating system will apply. For repeatable behaviour across platforms
  it is recommended this value always be defined for listening-mode sockets.
  
  Note that not all platforms support disabling this option. Some, at least
  OpenBSD and MirBSD, will fail with C<EINVAL> if you attempt to disable it.
  To determine whether it is possible to disable, you may use the class method
  
   if( IO::Socket::IP->CAN_DISABLE_V6ONLY ) {
      ...
   }
   else {
      ...
   }
  
  If your platform does not support disabling this option but you still want to
  listen for both C<AF_INET> and C<AF_INET6> connections you will have to create
  two listening sockets, one bound to each protocol.
  
  =item MultiHomed
  
  This C<IO::Socket::INET>-style argument is ignored, except if it is defined
  but false. See the C<IO::Socket::INET> INCOMPATIBILITES section below.
  
  However, the behaviour it enables is always performed by C<IO::Socket::IP>.
  
  =item Blocking => BOOL
  
  If defined but false, the socket will be set to non-blocking mode. Otherwise
  it will default to blocking mode. See the NON-BLOCKING section below for more
  detail.
  
  =item Timeout => NUM
  
  If defined, gives a maximum time in seconds to block per C<connect()> call
  when in blocking mode. If missing, no timeout is applied other than that
  provided by the underlying operating system. When in non-blocking mode this
  parameter is ignored.
  
  Note that if the hostname resolves to multiple address candidates, the same
  timeout will apply to each connection attempt individually, rather than to the
  operation as a whole. Further note that the timeout does not apply to the
  initial hostname resolve operation, if connecting by hostname.
  
  This behviour is copied inspired by C<IO::Socket::INET>; for more fine grained
  control over connection timeouts, consider performing a nonblocking connect
  directly.
  
  =back
  
  If neither C<Type> nor C<Proto> hints are provided, a default of
  C<SOCK_STREAM> and C<IPPROTO_TCP> respectively will be set, to maintain
  compatibility with C<IO::Socket::INET>. Other named arguments that are not
  recognised are ignored.
  
  If neither C<Family> nor any hosts or addresses are passed, nor any
  C<*AddrInfo>, then the constructor has no information on which to decide a
  socket family to create. In this case, it performs a C<getaddinfo> call with
  the C<AI_ADDRCONFIG> flag, no host name, and a service name of C<"0">, and
  uses the family of the first returned result.
  
  If the constructor fails, it will set C<$@> to an appropriate error message;
  this may be from C<$!> or it may be some other string; not every failure
  necessarily has an associated C<errno> value.
  
  =head2 $sock = IO::Socket::IP->new( $peeraddr )
  
  As a special case, if the constructor is passed a single argument (as
  opposed to an even-sized list of key/value pairs), it is taken to be the value
  of the C<PeerAddr> parameter. This is parsed in the same way, according to the
  behaviour given in the C<PeerHost> AND C<LocalHost> PARSING section below.
  
  =cut
  
  sub new
  {
     my $class = shift;
     my %arg = (@_ == 1) ? (PeerHost => $_[0]) : @_;
     return $class->SUPER::new(%arg);
  }
  
  # IO::Socket may call this one; neaten up the arguments from IO::Socket::INET
  # before calling our real _configure method
  sub configure
  {
     my $self = shift;
     my ( $arg ) = @_;
  
     $arg->{PeerHost} = delete $arg->{PeerAddr}
        if exists $arg->{PeerAddr} && !exists $arg->{PeerHost};
  
     $arg->{PeerService} = delete $arg->{PeerPort}
        if exists $arg->{PeerPort} && !exists $arg->{PeerService};
  
     $arg->{LocalHost} = delete $arg->{LocalAddr}
        if exists $arg->{LocalAddr} && !exists $arg->{LocalHost};
  
     $arg->{LocalService} = delete $arg->{LocalPort}
        if exists $arg->{LocalPort} && !exists $arg->{LocalService};
  
     for my $type (qw(Peer Local)) {
        my $host    = $type . 'Host';
        my $service = $type . 'Service';
  
        if( defined $arg->{$host} ) {
           ( $arg->{$host}, my $s ) = $self->split_addr( $arg->{$host} );
           # IO::Socket::INET compat - *Host parsed port always takes precedence
           $arg->{$service} = $s if defined $s;
        }
     }
  
     $self->_io_socket_ip__configure( $arg );
  }
  
  # Avoid simply calling it _configure, as some subclasses of IO::Socket::INET on CPAN already take that
  sub _io_socket_ip__configure
  {
     my $self = shift;
     my ( $arg ) = @_;
  
     my %hints;
     my @localinfos;
     my @peerinfos;
  
     my $listenqueue = $arg->{Listen};
     if( defined $listenqueue and
         ( defined $arg->{PeerHost} || defined $arg->{PeerService} || defined $arg->{PeerAddrInfo} ) ) {
        croak "Cannot Listen with a peer address";
     }
  
     if( defined $arg->{GetAddrInfoFlags} ) {
        $hints{flags} = $arg->{GetAddrInfoFlags};
     }
     else {
        $hints{flags} = $AI_ADDRCONFIG;
     }
  
     if( defined( my $family = $arg->{Family} ) ) {
        $hints{family} = $family;
     }
  
     if( defined( my $type = $arg->{Type} ) ) {
        $hints{socktype} = $type;
     }
  
     if( defined( my $proto = $arg->{Proto} ) ) {
        unless( $proto =~ m/^\d+$/ ) {
           my $protonum = HAVE_GETPROTOBYNAME
              ? getprotobyname( $proto )
              : eval { Socket->${\"IPPROTO_\U$proto"}() };
           defined $protonum or croak "Unrecognised protocol $proto";
           $proto = $protonum;
        }
  
        $hints{protocol} = $proto;
     }
  
     # To maintain compatibility with IO::Socket::INET, imply a default of
     # SOCK_STREAM + IPPROTO_TCP if neither hint is given
     if( !defined $hints{socktype} and !defined $hints{protocol} ) {
        $hints{socktype} = SOCK_STREAM;
        $hints{protocol} = IPPROTO_TCP;
     }
  
     # Some OSes (NetBSD) don't seem to like just a protocol hint without a
     # socktype hint as well. We'll set a couple of common ones
     if( !defined $hints{socktype} and defined $hints{protocol} ) {
        $hints{socktype} = SOCK_STREAM if $hints{protocol} == IPPROTO_TCP;
        $hints{socktype} = SOCK_DGRAM  if $hints{protocol} == IPPROTO_UDP;
     }
  
     if( my $info = $arg->{LocalAddrInfo} ) {
        ref $info eq "ARRAY" or croak "Expected 'LocalAddrInfo' to be an ARRAY ref";
        @localinfos = @$info;
     }
     elsif( defined $arg->{LocalHost} or
            defined $arg->{LocalService} or
            HAVE_MSWIN32 and $arg->{Listen} ) {
        # Either may be undef
        my $host = $arg->{LocalHost};
        my $service = $arg->{LocalService};
  
        unless ( defined $host or defined $service ) {
           $service = 0;
        }
  
        local $1; # Placate a taint-related bug; [perl #67962]
        defined $service and $service =~ s/\((\d+)\)$// and
           my $fallback_port = $1;
  
        my %localhints = %hints;
        $localhints{flags} |= AI_PASSIVE;
        ( my $err, @localinfos ) = getaddrinfo( $host, $service, \%localhints );
  
        if( $err and defined $fallback_port ) {
           ( $err, @localinfos ) = getaddrinfo( $host, $fallback_port, \%localhints );
        }
  
        if( $err ) {
           $@ = "$err";
           $! = EINVAL;
           return;
        }
     }
  
     if( my $info = $arg->{PeerAddrInfo} ) {
        ref $info eq "ARRAY" or croak "Expected 'PeerAddrInfo' to be an ARRAY ref";
        @peerinfos = @$info;
     }
     elsif( defined $arg->{PeerHost} or defined $arg->{PeerService} ) {
        defined( my $host = $arg->{PeerHost} ) or
           croak "Expected 'PeerHost'";
        defined( my $service = $arg->{PeerService} ) or
           croak "Expected 'PeerService'";
  
        local $1; # Placate a taint-related bug; [perl #67962]
        defined $service and $service =~ s/\((\d+)\)$// and
           my $fallback_port = $1;
  
        ( my $err, @peerinfos ) = getaddrinfo( $host, $service, \%hints );
  
        if( $err and defined $fallback_port ) {
           ( $err, @peerinfos ) = getaddrinfo( $host, $fallback_port, \%hints );
        }
  
        if( $err ) {
           $@ = "$err";
           $! = EINVAL;
           return;
        }
     }
  
     my $INT_1 = pack "i", 1;
  
     my @sockopts_enabled;
     push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEADDR, $INT_1 ] if $arg->{ReuseAddr};
     push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEPORT, $INT_1 ] if $arg->{ReusePort};
     push @sockopts_enabled, [ SOL_SOCKET, SO_BROADCAST, $INT_1 ] if $arg->{Broadcast};
  
     if( my $sockopts = $arg->{Sockopts} ) {
        ref $sockopts eq "ARRAY" or croak "Expected 'Sockopts' to be an ARRAY ref";
        foreach ( @$sockopts ) {
           ref $_ eq "ARRAY" or croak "Bad Sockopts item - expected ARRAYref";
           @$_ >= 2 and @$_ <= 3 or
              croak "Bad Sockopts item - expected 2 or 3 elements";
  
           my ( $level, $optname, $value ) = @$_;
           # TODO: consider more sanity checking on argument values
  
           defined $value or $value = $INT_1;
           push @sockopts_enabled, [ $level, $optname, $value ];
        }
     }
  
     my $blocking = $arg->{Blocking};
     defined $blocking or $blocking = 1;
  
     my $v6only = $arg->{V6Only};
  
     # IO::Socket::INET defines this key. IO::Socket::IP always implements the
     # behaviour it requests, so we can ignore it, unless the caller is for some
     # reason asking to disable it.
     if( defined $arg->{MultiHomed} and !$arg->{MultiHomed} ) {
        croak "Cannot disable the MultiHomed parameter";
     }
  
     my @infos;
     foreach my $local ( @localinfos ? @localinfos : {} ) {
        foreach my $peer ( @peerinfos ? @peerinfos : {} ) {
           next if defined $local->{family}   and defined $peer->{family}   and
              $local->{family} != $peer->{family};
           next if defined $local->{socktype} and defined $peer->{socktype} and
              $local->{socktype} != $peer->{socktype};
           next if defined $local->{protocol} and defined $peer->{protocol} and
              $local->{protocol} != $peer->{protocol};
  
           my $family   = $local->{family}   || $peer->{family}   or next;
           my $socktype = $local->{socktype} || $peer->{socktype} or next;
           my $protocol = $local->{protocol} || $peer->{protocol} || 0;
  
           push @infos, {
              family    => $family,
              socktype  => $socktype,
              protocol  => $protocol,
              localaddr => $local->{addr},
              peeraddr  => $peer->{addr},
           };
        }
     }
  
     if( !@infos ) {
        # If there was a Family hint then create a plain unbound, unconnected socket
        if( defined $hints{family} ) {
           @infos = ( {
              family   => $hints{family},
              socktype => $hints{socktype},
              protocol => $hints{protocol},
           } );
        }
        # If there wasn't, use getaddrinfo()'s AI_ADDRCONFIG side-effect to guess a
        # suitable family first.
        else {
           ( my $err, @infos ) = getaddrinfo( "", "0", \%hints );
           if( $err ) {
              $@ = "$err";
              $! = EINVAL;
              return;
           }
  
           # We'll take all the @infos anyway, because some OSes (HPUX) are known to
           # ignore the AI_ADDRCONFIG hint and return AF_INET6 even if they don't
           # support them
        }
     }
  
     # In the nonblocking case, caller will be calling ->setup multiple times.
     # Store configuration in the object for the ->setup method
     # Yes, these are messy. Sorry, I can't help that...
  
     ${*$self}{io_socket_ip_infos} = \@infos;
  
     ${*$self}{io_socket_ip_idx} = -1;
  
     ${*$self}{io_socket_ip_sockopts} = \@sockopts_enabled;
     ${*$self}{io_socket_ip_v6only} = $v6only;
     ${*$self}{io_socket_ip_listenqueue} = $listenqueue;
     ${*$self}{io_socket_ip_blocking} = $blocking;
  
     ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ];
  
     # ->setup is allowed to return false in nonblocking mode
     $self->setup or !$blocking or return undef;
  
     return $self;
  }
  
  sub setup
  {
     my $self = shift;
  
     while(1) {
        ${*$self}{io_socket_ip_idx}++;
        last if ${*$self}{io_socket_ip_idx} >= @{ ${*$self}{io_socket_ip_infos} };
  
        my $info = ${*$self}{io_socket_ip_infos}->[${*$self}{io_socket_ip_idx}];
  
        $self->socket( @{$info}{qw( family socktype protocol )} ) or
           ( ${*$self}{io_socket_ip_errors}[2] = $!, next );
  
        $self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking};
  
        foreach my $sockopt ( @{ ${*$self}{io_socket_ip_sockopts} } ) {
           my ( $level, $optname, $value ) = @$sockopt;
           $self->setsockopt( $level, $optname, $value ) or ( $@ = "$!", return undef );
        }
  
        if( defined ${*$self}{io_socket_ip_v6only} and defined $AF_INET6 and $info->{family} == $AF_INET6 ) {
           my $v6only = ${*$self}{io_socket_ip_v6only};
           $self->setsockopt( IPPROTO_IPV6, IPV6_V6ONLY, pack "i", $v6only ) or ( $@ = "$!", return undef );
        }
  
        if( defined( my $addr = $info->{localaddr} ) ) {
           $self->bind( $addr ) or
              ( ${*$self}{io_socket_ip_errors}[1] = $!, next );
        }
  
        if( defined( my $listenqueue = ${*$self}{io_socket_ip_listenqueue} ) ) {
           $self->listen( $listenqueue ) or ( $@ = "$!", return undef );
        }
  
        if( defined( my $addr = $info->{peeraddr} ) ) {
           if( $self->connect( $addr ) ) {
              $! = 0;
              return 1;
           }
  
           if( $! == EINPROGRESS or $! == EWOULDBLOCK ) {
              ${*$self}{io_socket_ip_connect_in_progress} = 1;
              return 0;
           }
  
           # If connect failed but we have no system error there must be an error
           # at the application layer, like a bad certificate with
           # IO::Socket::SSL.
           # In this case don't continue IP based multi-homing because the problem
           # cannot be solved at the IP layer.
           return 0 if ! $!;
  
           ${*$self}{io_socket_ip_errors}[0] = $!;
           next;
        }
  
        return 1;
     }
  
     # Pick the most appropriate error, stringified
     $! = ( grep defined, @{ ${*$self}{io_socket_ip_errors}} )[0];
     $@ = "$!";
     return undef;
  }
  
  sub connect :method
  {
     my $self = shift;
  
     # It seems that IO::Socket hides EINPROGRESS errors, making them look like
     # a success. This is annoying here.
     # Instead of putting up with its frankly-irritating intentional breakage of
     # useful APIs I'm just going to end-run around it and call core's connect()
     # directly
  
     if( @_ ) {
        my ( $addr ) = @_;
  
        # Annoyingly IO::Socket's connect() is where the timeout logic is
        # implemented, so we'll have to reinvent it here
        my $timeout = ${*$self}{'io_socket_timeout'};
  
        return connect( $self, $addr ) unless defined $timeout;
  
        my $was_blocking = $self->blocking( 0 );
  
        my $err = defined connect( $self, $addr ) ? 0 : $!+0;
  
        if( !$err ) {
           # All happy
           $self->blocking( $was_blocking );
           return 1;
        }
        elsif( not( $err == EINPROGRESS or $err == EWOULDBLOCK ) ) {
           # Failed for some other reason
           $self->blocking( $was_blocking );
           return undef;
        }
        elsif( !$was_blocking ) {
           # We shouldn't block anyway
           return undef;
        }
  
        my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
        if( !select( undef, $vec, $vec, $timeout ) ) {
           $self->blocking( $was_blocking );
           $! = ETIMEDOUT;
           return undef;
        }
  
        # Hoist the error by connect()ing a second time
        $err = $self->getsockopt( SOL_SOCKET, SO_ERROR );
        $err = 0 if $err == EISCONN; # Some OSes give EISCONN
  
        $self->blocking( $was_blocking );
  
        $! = $err, return undef if $err;
        return 1;
     }
  
     return 1 if !${*$self}{io_socket_ip_connect_in_progress};
  
     # See if a connect attempt has just failed with an error
     if( my $errno = $self->getsockopt( SOL_SOCKET, SO_ERROR ) ) {
        delete ${*$self}{io_socket_ip_connect_in_progress};
        ${*$self}{io_socket_ip_errors}[0] = $! = $errno;
        return $self->setup;
     }
  
     # No error, so either connect is still in progress, or has completed
     # successfully. We can tell by trying to connect() again; either it will
     # succeed or we'll get EISCONN (connected successfully), or EALREADY
     # (still in progress). This even works on MSWin32.
     my $addr = ${*$self}{io_socket_ip_infos}[${*$self}{io_socket_ip_idx}]{peeraddr};
  
     if( connect( $self, $addr ) or $! == EISCONN ) {
        delete ${*$self}{io_socket_ip_connect_in_progress};
        $! = 0;
        return 1;
     }
     else {
        $! = EINPROGRESS;
        return 0;
     }
  }
  
  sub connected
  {
     my $self = shift;
     return defined $self->fileno &&
            !${*$self}{io_socket_ip_connect_in_progress} &&
            defined getpeername( $self ); # ->peername caches, we need to detect disconnection
  }
  
  =head1 METHODS
  
  As well as the following methods, this class inherits all the methods in
  L<IO::Socket> and L<IO::Handle>.
  
  =cut
  
  sub _get_host_service
  {
     my $self = shift;
     my ( $addr, $flags, $xflags ) = @_;
  
     defined $addr or
        $! = ENOTCONN, return;
  
     $flags |= NI_DGRAM if $self->socktype == SOCK_DGRAM;
  
     my ( $err, $host, $service ) = getnameinfo( $addr, $flags, $xflags || 0 );
     croak "getnameinfo - $err" if $err;
  
     return ( $host, $service );
  }
  
  sub _unpack_sockaddr
  {
     my ( $addr ) = @_;
     my $family = sockaddr_family $addr;
  
     if( $family == AF_INET ) {
        return ( Socket::unpack_sockaddr_in( $addr ) )[1];
     }
     elsif( defined $AF_INET6 and $family == $AF_INET6 ) {
        return ( Socket::unpack_sockaddr_in6( $addr ) )[1];
     }
     else {
        croak "Unrecognised address family $family";
     }
  }
  
  =head2 ( $host, $service ) = $sock->sockhost_service( $numeric )
  
  Returns the hostname and service name of the local address (that is, the
  socket address given by the C<sockname> method).
  
  If C<$numeric> is true, these will be given in numeric form rather than being
  resolved into names.
  
  The following four convenience wrappers may be used to obtain one of the two
  values returned here. If both host and service names are required, this method
  is preferable to the following wrappers, because it will call
  C<getnameinfo(3)> only once.
  
  =cut
  
  sub sockhost_service
  {
     my $self = shift;
     my ( $numeric ) = @_;
  
     $self->_get_host_service( $self->sockname, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 );
  }
  
  =head2 $addr = $sock->sockhost
  
  Return the numeric form of the local address as a textual representation
  
  =head2 $port = $sock->sockport
  
  Return the numeric form of the local port number
  
  =head2 $host = $sock->sockhostname
  
  Return the resolved name of the local address
  
  =head2 $service = $sock->sockservice
  
  Return the resolved name of the local port number
  
  =cut
  
  sub sockhost { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
  sub sockport { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICSERV, NIx_NOHOST ) )[1] }
  
  sub sockhostname { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOSERV ) )[0] }
  sub sockservice  { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOHOST ) )[1] }
  
  =head2 $addr = $sock->sockaddr
  
  Return the local address as a binary octet string
  
  =cut
  
  sub sockaddr { my $self = shift; _unpack_sockaddr $self->sockname }
  
  =head2 ( $host, $service ) = $sock->peerhost_service( $numeric )
  
  Returns the hostname and service name of the peer address (that is, the
  socket address given by the C<peername> method), similar to the
  C<sockhost_service> method.
  
  The following four convenience wrappers may be used to obtain one of the two
  values returned here. If both host and service names are required, this method
  is preferable to the following wrappers, because it will call
  C<getnameinfo(3)> only once.
  
  =cut
  
  sub peerhost_service
  {
     my $self = shift;
     my ( $numeric ) = @_;
  
     $self->_get_host_service( $self->peername, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 );
  }
  
  =head2 $addr = $sock->peerhost
  
  Return the numeric form of the peer address as a textual representation
  
  =head2 $port = $sock->peerport
  
  Return the numeric form of the peer port number
  
  =head2 $host = $sock->peerhostname
  
  Return the resolved name of the peer address
  
  =head2 $service = $sock->peerservice
  
  Return the resolved name of the peer port number
  
  =cut
  
  sub peerhost { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICHOST, NIx_NOSERV ) )[0] }
  sub peerport { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICSERV, NIx_NOHOST ) )[1] }
  
  sub peerhostname { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOSERV ) )[0] }
  sub peerservice  { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOHOST ) )[1] }
  
  =head2 $addr = $peer->peeraddr
  
  Return the peer address as a binary octet string
  
  =cut
  
  sub peeraddr { my $self = shift; _unpack_sockaddr $self->peername }
  
  # This unbelievably dodgy hack works around the bug that IO::Socket doesn't do
  # it
  #    https://rt.cpan.org/Ticket/Display.html?id=61577
  sub accept
  {
     my $self = shift;
     my ( $new, $peer ) = $self->SUPER::accept( @_ ) or return;
  
     ${*$new}{$_} = ${*$self}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );
  
     return wantarray ? ( $new, $peer )
                      : $new;
  }
  
  # This second unbelievably dodgy hack guarantees that $self->fileno doesn't
  # change, which is useful during nonblocking connect
  sub socket :method
  {
     my $self = shift;
     return $self->SUPER::socket(@_) if not defined $self->fileno;
  
     # I hate core prototypes sometimes...
     socket( my $tmph, $_[0], $_[1], $_[2] ) or return undef;
  
     dup2( $tmph->fileno, $self->fileno ) or die "Unable to dup2 $tmph onto $self - $!";
  }
  
  # Versions of IO::Socket before 1.35 may leave socktype undef if from, say, an
  #   ->fdopen call. In this case we'll apply a fix
  BEGIN {
     if( eval($IO::Socket::VERSION) < 1.35 ) {
        *socktype = sub {
           my $self = shift;
           my $type = $self->SUPER::socktype;
           if( !defined $type ) {
              $type = $self->sockopt( Socket::SO_TYPE() );
           }
           return $type;
        };
     }
  }
  
  =head2 $inet = $sock->as_inet
  
  Returns a new L<IO::Socket::INET> instance wrapping the same filehandle. This
  may be useful in cases where it is required, for backward-compatibility, to
  have a real object of C<IO::Socket::INET> type instead of C<IO::Socket::IP>.
  The new object will wrap the same underlying socket filehandle as the
  original, so care should be taken not to continue to use both objects
  concurrently. Ideally the original C<$sock> should be discarded after this
  method is called.
  
  This method checks that the socket domain is C<PF_INET> and will throw an
  exception if it isn't.
  
  =cut
  
  sub as_inet
  {
     my $self = shift;
     croak "Cannot downgrade a non-PF_INET socket to IO::Socket::INET" unless $self->sockdomain == AF_INET;
     return IO::Socket::INET->new_from_fd( $self->fileno, "r+" );
  }
  
  =head1 NON-BLOCKING
  
  If the constructor is passed a defined but false value for the C<Blocking>
  argument then the socket is put into non-blocking mode. When in non-blocking
  mode, the socket will not be set up by the time the constructor returns,
  because the underlying C<connect(2)> syscall would otherwise have to block.
  
  The non-blocking behaviour is an extension of the C<IO::Socket::INET> API,
  unique to C<IO::Socket::IP>, because the former does not support multi-homed
  non-blocking connect.
  
  When using non-blocking mode, the caller must repeatedly check for
  writeability on the filehandle (for instance using C<select> or C<IO::Poll>).
  Each time the filehandle is ready to write, the C<connect> method must be
  called, with no arguments. Note that some operating systems, most notably
  C<MSWin32> do not report a C<connect()> failure using write-ready; so you must
  also C<select()> for exceptional status.
  
  While C<connect> returns false, the value of C<$!> indicates whether it should
  be tried again (by being set to the value C<EINPROGRESS>, or C<EWOULDBLOCK> on
  MSWin32), or whether a permanent error has occurred (e.g. C<ECONNREFUSED>).
  
  Once the socket has been connected to the peer, C<connect> will return true
  and the socket will now be ready to use.
  
  Note that calls to the platform's underlying C<getaddrinfo(3)> function may
  block. If C<IO::Socket::IP> has to perform this lookup, the constructor will
  block even when in non-blocking mode.
  
  To avoid this blocking behaviour, the caller should pass in the result of such
  a lookup using the C<PeerAddrInfo> or C<LocalAddrInfo> arguments. This can be
  achieved by using L<Net::LibAsyncNS>, or the C<getaddrinfo(3)> function can be
  called in a child process.
  
   use IO::Socket::IP;
   use Errno qw( EINPROGRESS EWOULDBLOCK );
  
   my @peeraddrinfo = ... # Caller must obtain the getaddinfo result here
  
   my $socket = IO::Socket::IP->new(
      PeerAddrInfo => \@peeraddrinfo,
      Blocking     => 0,
   ) or die "Cannot construct socket - $@";
  
   while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) {
      my $wvec = '';
      vec( $wvec, fileno $socket, 1 ) = 1;
      my $evec = '';
      vec( $evec, fileno $socket, 1 ) = 1;
  
      select( undef, $wvec, $evec, undef ) or die "Cannot select - $!";
   }
  
   die "Cannot connect - $!" if $!;
  
   ...
  
  The example above uses C<select()>, but any similar mechanism should work
  analogously. C<IO::Socket::IP> takes care when creating new socket filehandles
  to preserve the actual file descriptor number, so such techniques as C<poll>
  or C<epoll> should be transparent to its reallocation of a different socket
  underneath, perhaps in order to switch protocol family between C<PF_INET> and
  C<PF_INET6>.
  
  For another example using C<IO::Poll> and C<Net::LibAsyncNS>, see the
  F<examples/nonblocking_libasyncns.pl> file in the module distribution.
  
  =cut
  
  =head1 C<PeerHost> AND C<LocalHost> PARSING
  
  To support the C<IO::Socket::INET> API, the host and port information may be
  passed in a single string rather than as two separate arguments.
  
  If either C<LocalHost> or C<PeerHost> (or their C<...Addr> synonyms) have any
  of the following special forms then special parsing is applied.
  
  The value of the C<...Host> argument will be split to give both the hostname
  and port (or service name):
  
   hostname.example.org:http    # Host name
   192.0.2.1:80                 # IPv4 address
   [2001:db8::1]:80             # IPv6 address
  
  In each case, the port or service name (e.g. C<80>) is passed as the
  C<LocalService> or C<PeerService> argument.
  
  Either of C<LocalService> or C<PeerService> (or their C<...Port> synonyms) can
  be either a service name, a decimal number, or a string containing both a
  service name and number, in a form such as
  
   http(80)
  
  In this case, the name (C<http>) will be tried first, but if the resolver does
  not understand it then the port number (C<80>) will be used instead.
  
  If the C<...Host> argument is in this special form and the corresponding
  C<...Service> or C<...Port> argument is also defined, the one parsed from
  the C<...Host> argument will take precedence and the other will be ignored.
  
  =head2 ( $host, $port ) = IO::Socket::IP->split_addr( $addr )
  
  Utility method that provides the parsing functionality described above.
  Returns a 2-element list, containing either the split hostname and port
  description if it could be parsed, or the given address and C<undef> if it was
  not recognised.
  
   IO::Socket::IP->split_addr( "hostname:http" )
                                # ( "hostname",  "http" )
  
   IO::Socket::IP->split_addr( "192.0.2.1:80" )
                                # ( "192.0.2.1", "80"   )
  
   IO::Socket::IP->split_addr( "[2001:db8::1]:80" )
                                # ( "2001:db8::1", "80" )
  
   IO::Socket::IP->split_addr( "something.else" )
                                # ( "something.else", undef )
  
  =cut
  
  sub split_addr
  {
     shift;
     my ( $addr ) = @_;
  
     local ( $1, $2 ); # Placate a taint-related bug; [perl #67962]
     if( $addr =~ m/\A\[($IPv6_re)\](?::([^\s:]*))?\z/ or
         $addr =~ m/\A([^\s:]*):([^\s:]*)\z/ ) {
        return ( $1, $2 ) if defined $2 and length $2;
        return ( $1, undef );
     }
  
     return ( $addr, undef );
  }
  
  =head2 $addr = IO::Socket::IP->join_addr( $host, $port )
  
  Utility method that performs the reverse of C<split_addr>, returning a string
  formed by joining the specified host address and port number. The host address
  will be wrapped in C<[]> brackets if required (because it is a raw IPv6
  numeric address).
  
  This can be especially useful when combined with the C<sockhost_service> or
  C<peerhost_service> methods.
  
   say "Connected to ", IO::Socket::IP->join_addr( $sock->peerhost_service );
  
  =cut
  
  sub join_addr
  {
     shift;
     my ( $host, $port ) = @_;
  
     $host = "[$host]" if $host =~ m/:/;
  
     return join ":", $host, $port if defined $port;
     return $host;
  }
  
  # Since IO::Socket->new( Domain => ... ) will delete the Domain parameter
  # before calling ->configure, we need to keep track of which it was
  
  package # hide from indexer
     IO::Socket::IP::_ForINET;
  use base qw( IO::Socket::IP );
  
  sub configure
  {
     # This is evil
     my $self = shift;
     my ( $arg ) = @_;
  
     bless $self, "IO::Socket::IP";
     $self->configure( { %$arg, Family => Socket::AF_INET() } );
  }
  
  package # hide from indexer
     IO::Socket::IP::_ForINET6;
  use base qw( IO::Socket::IP );
  
  sub configure
  {
     # This is evil
     my $self = shift;
     my ( $arg ) = @_;
  
     bless $self, "IO::Socket::IP";
     $self->configure( { %$arg, Family => Socket::AF_INET6() } );
  }
  
  =head1 C<IO::Socket::INET> INCOMPATIBILITES
  
  =over 4
  
  =item *
  
  The behaviour enabled by C<MultiHomed> is in fact implemented by
  C<IO::Socket::IP> as it is required to correctly support searching for a
  useable address from the results of the C<getaddrinfo(3)> call. The
  constructor will ignore the value of this argument, except if it is defined
  but false. An exception is thrown in this case, because that would request it
  disable the C<getaddrinfo(3)> search behaviour in the first place.
  
  =item *
  
  C<IO::Socket::IP> implements both the C<Blocking> and C<Timeout> parameters,
  but it implements the interaction of both in a different way.
  
  In C<::INET>, supplying a timeout overrides the non-blocking behaviour,
  meaning that the C<connect()> operation will still block despite that the
  caller asked for a non-blocking socket. This is not explicitly specified in
  its documentation, nor does this author believe that is a useful behaviour -
  it appears to come from a quirk of implementation.
  
  In C<::IP> therefore, the C<Blocking> parameter takes precedence - if a
  non-blocking socket is requested, no operation will block. The C<Timeout>
  parameter here simply defines the maximum time that a blocking C<connect()>
  call will wait, if it blocks at all.
  
  In order to specifically obtain the "blocking connect then non-blocking send
  and receive" behaviour of specifying this combination of options to C<::INET>
  when using C<::IP>, perform first a blocking connect, then afterwards turn the
  socket into nonblocking mode.
  
   my $sock = IO::Socket::IP->new(
      PeerHost => $peer,
      Timeout => 20,
   ) or die "Cannot connect - $@";
  
   $sock->blocking( 0 );
  
  This code will behave identically under both C<IO::Socket::INET> and
  C<IO::Socket::IP>.
  
  =back
  
  =cut
  
  =head1 TODO
  
  =over 4
  
  =item *
  
  Investigate whether C<POSIX::dup2> upsets BSD's C<kqueue> watchers, and if so,
  consider what possible workarounds might be applied.
  
  =back
  
  =head1 AUTHOR
  
  Paul Evans <leonerd@leonerd.org.uk>
  
  =cut
  
  0x55AA;
IO_SOCKET_IP

$fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP';
  package JSON::PP;
  
  # JSON-2.0
  
  use 5.005;
  use strict;
  
  use Exporter ();
  BEGIN { @JSON::PP::ISA = ('Exporter') }
  
  use overload ();
  use JSON::PP::Boolean;
  
  use Carp ();
  #use Devel::Peek;
  
  $JSON::PP::VERSION = '4.02';
  
  @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;
  
  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::PP::Compat5006' : 'JSON::PP::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;
          return ($false, $true);
      } else {
          delete $self->{false};
          delete $self->{true};
          return;
      }
  }
  
  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
  
          unless ($ascii or $latin1 or $utf8) {
              utf8::upgrade($str);
          }
  
          if ($props->[ 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 ( $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) {
              if (_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/([\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;   # 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::upgrade( $text );
              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");
                              }
  
                              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 ) {
                          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 =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
                              if (!$relaxed or $ch ne "\t") {
                                  $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 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 =~ /[^\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 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;
      }
  
  
      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   = '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() ?
              $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 == 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 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 { blessed $_[0] and ( $_[0]->isa("JSON::PP::Boolean") or $_[0]->isa("Types::Serialiser::BooleanBase") or $_[0]->isa("JSON::XS::Boolean") ); }
  
  sub true  { $JSON::PP::true  }
  sub false { $JSON::PP::false }
  sub null  { undef; }
  
  ###############################
  
  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;
  use constant INCR_M_TFN  => 6;
  use constant INCR_M_NUM  => 7;
  
  $JSON::PP::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 ) {
          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;
      }
  
      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;
                      }
                  }
  
                  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) > 0x20 ) {
                      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 ) {
              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 ) {
              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 eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20" ) {
                      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 VERSION
  
      4.02
  
  =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.
  
  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 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::PP::Compat5005> and L<JSON::PP::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_PP

$fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN';
  package JSON::PP::Boolean;
  
  use strict;
  require overload;
  local $^W;
  overload::import('overload',
      "0+"     => sub { ${$_[0]} },
      "++"     => sub { $_[0] = ${$_[0]} + 1 },
      "--"     => sub { $_[0] = ${$_[0]} - 1 },
      fallback => 1,
  );
  
  $JSON::PP::Boolean::VERSION = '4.02';
  
  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_PP_BOOLEAN

$fatpacked{"Menlo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO';
  package Menlo;
  our $VERSION = "1.9019";
  
  1;
  
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  Menlo - A CPAN client
  
  =head1 DESCRIPTION
  
  Menlo is a backend for I<cpanm 2.0>, developed with the goal to
  replace L<cpanm> internals with a set of modules that are more
  flexible, extensible and easier to use.
  
  =head1 COMPATIBILITY
  
  Menlo is developed within L<cpanminus> git repository at C<Menlo>
  subdirectory at L<https://github.com/miyagawa/cpanminus>
  
  Menlo::CLI::Compat started off as a copy of App::cpanminus::script,
  but will go under a big refactoring to extract all the bits out of
  it. Hopefully the end result will be just a shim and translation layer
  to interpret command line options.
  
  =head1 MOTIVATION
  
  cpanm has been a popular choice of CPAN package installer for many
  developers, because it is lightweight, fast, and requires no
  configuration in most environments.
  
  Meanwhile, the way cpanm has been implemented (one God class, and all
  modules are packaged in one script with fatpacker) makes it difficult
  to extend, or modify the behaviors at a runtime, unless you decide to
  fork the code or monkeypatch its hidden backend class.
  
  cpanm also has no scriptable API or hook points, which means if you
  want to write a tool that works with cpanm, you basically have to work
  around its behavior by writing a shell wrapper, or parsing the output
  of its standard out or a build log file.
  
  Menlo will keep the best aspects of cpanm, which is dependencies free,
  configuration free, lightweight and fast to install CPAN modules. At
  the same time, it's impelmented as a standard perl module, available
  on CPAN, and you can extend its behavior by either using its modular
  interfaces, or writing plugins to hook into its behaviors.
  
  =head1 FAQ
  
  =over 4
  
  =item Dependencies free? I see many prerequisites in Menlo.
  
  Menlo is a set of libraries and uses non-core CPAN modules as its
  dependencies. App-cpanminus distribution embeds Menlo and all of its
  runtime dependencies into a fatpacked binary, so that you can install
  App-cpanminus or Menlo without having any CPAN client to begin with.
  
  =item Is Menlo a new name for cpanm?
  
  Right now it's just a library name, but I'm comfortable calling this a
  new package name for cpanm 2's backend.
  
  =back
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
  
  =head1 COPYRIGHT
  
  2010- Tatsuhiko Miyagawa
  
  =head1 LICENSE
  
  This software is licensed under the same terms as Perl.
  
  =head1 SEE ALSO
  
  L<cpanm>
  
  =cut
MENLO

$fatpacked{"Menlo/Builder/Static.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_BUILDER_STATIC';
  package Menlo::Builder::Static;
  use strict;
  use warnings;
  
  use CPAN::Meta;
  use ExtUtils::Config 0.003;
  use ExtUtils::Helpers 0.020 qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;
  use ExtUtils::Install qw/pm_to_blib install/;
  use ExtUtils::InstallPaths 0.002;
  use File::Basename qw/dirname/;
  use File::Find ();
  use File::Path qw/mkpath/;
  use File::Spec::Functions qw/catfile catdir rel2abs abs2rel splitdir curdir/;
  use Getopt::Long 2.36 qw/GetOptionsFromArray/;
  
  sub new {
      my($class, %args) = @_;
      bless {
          meta => $args{meta},
      }, $class;
  }
  
  sub meta {
      my $self = shift;
      $self->{meta};
  }
  
  sub manify {
  	my ($input_file, $output_file, $section, $opts) = @_;
  	return if -e $output_file && -M $input_file <= -M $output_file;
  	my $dirname = dirname($output_file);
  	mkpath($dirname, $opts->{verbose}) if not -d $dirname;
  	require Pod::Man;
  	Pod::Man->new(section => $section)->parse_from_file($input_file, $output_file);
  	print "Manifying $output_file\n" if $opts->{verbose} && $opts->{verbose} > 0;
  	return;
  }
  
  sub find {
  	my ($pattern, $dir) = @_;
  	my @ret;
  	File::Find::find(sub { push @ret, $File::Find::name if /$pattern/ && -f }, $dir) if -d $dir;
  	return @ret;
  }
  
  my %actions = (
  	build => sub {
  		my %opt = @_;
  		my %modules = map { $_ => catfile('blib', $_) } find(qr/\.p(?:m|od)$/, 'lib');
  		my %scripts = map { $_ => catfile('blib', $_) } find(qr//, 'script');
  		my %shared  = map { $_ => catfile(qw/blib lib auto share dist/, $opt{meta}->name, abs2rel($_, 'share')) } find(qr//, 'share');
  		pm_to_blib({ %modules, %scripts, %shared }, catdir(qw/blib lib auto/));
  		make_executable($_) for values %scripts;
  		mkpath(catdir(qw/blib arch/), $opt{verbose});
  
  		if ($opt{install_paths}->install_destination('bindoc') && $opt{install_paths}->is_default_installable('bindoc')) {
  			manify($_, catfile('blib', 'bindoc', man1_pagename($_)), $opt{config}->get('man1ext'), \%opt) for keys %scripts;
  		}
  		if ($opt{install_paths}->install_destination('libdoc') && $opt{install_paths}->is_default_installable('libdoc')) {
  			manify($_, catfile('blib', 'libdoc', man3_pagename($_)), $opt{config}->get('man3ext'), \%opt) for keys %modules;
  		}
                  1;
  	},
  	test => sub {
  		my %opt = @_;
  		die "Must run `./Build build` first\n" if not -d 'blib';
  		require TAP::Harness::Env;
  		my %test_args = (
  			(verbosity => $opt{verbose}) x!! exists $opt{verbose},
  			(jobs => $opt{jobs}) x!! exists $opt{jobs},
  			(color => 1) x !!-t STDOUT,
  			lib => [ map { rel2abs(catdir(qw/blib/, $_)) } qw/arch lib/ ],
  		);
  		my $tester = TAP::Harness::Env->create(\%test_args);
  		$tester->runtests(sort +find(qr/\.t$/, 't'))->has_errors and return;
                  1;
  	},
  	install => sub {
  		my %opt = @_;
  		die "Must run `./Build build` first\n" if not -d 'blib';
  		install($opt{install_paths}->install_map, @opt{qw/verbose dry_run uninst/});
                  1;
  	},
  );
  
  sub build {
  	my $self = shift;
  	my $action = @_ && $_[0] =~ /\A\w+\z/ ? shift @_ : 'build';
  	die "No such action '$action'\n" if not $actions{$action};
  	my %opt;
  	GetOptionsFromArray([@$_], \%opt, qw/install_base=s install_path=s% installdirs=s destdir=s prefix=s config=s% uninst:1 verbose:1 dry_run:1 pureperl-only:1 create_packlist=i jobs=i/) for ($self->{env}, $self->{configure_args}, \@_);
  	$_ = detildefy($_) for grep { defined } @opt{qw/install_base destdir prefix/}, values %{ $opt{install_path} };
  	@opt{ 'config', 'meta' } = (ExtUtils::Config->new($opt{config}), $self->meta);
  	$actions{$action}->(%opt, install_paths => ExtUtils::InstallPaths->new(%opt, dist_name => $opt{meta}->name));
  }
  
  sub configure {
  	my $self = shift;   
  	$self->{env} = defined $ENV{PERL_MB_OPT} ? [split_like_shell($ENV{PERL_MB_OPT})] : [];
          $self->{configure_args} = [@_];
  	$self->meta->save(@$_) for ['MYMETA.json'], [ 'MYMETA.yml' => { version => 1.4 } ];
  }
  
  1;
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2011 by Leon Timmermans, David Golden.
  
  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
MENLO_BUILDER_STATIC

$fatpacked{"Menlo/CLI/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_CLI_COMPAT';
  package Menlo::CLI::Compat;
  use strict;
  use Config;
  use Cwd ();
  use Menlo;
  use Menlo::Dependency;
  use Menlo::Util qw(WIN32);
  use File::Basename ();
  use File::Find ();
  use File::Path ();
  use File::Spec ();
  use File::Copy ();
  use File::Temp ();
  use File::Which qw(which);
  use Getopt::Long ();
  use Symbol ();
  use version ();
  
  use constant BAD_TAR => ($^O eq 'solaris' || $^O eq 'hpux');
  use constant CAN_SYMLINK => eval { symlink("", ""); 1 };
  
  our $VERSION = '1.9022';
  
  if ($INC{"App/FatPacker/Trace.pm"}) {
      require version::vpp;
  }
  
  sub qs($) {
      Menlo::Util::shell_quote($_[0]);
  }
  
  sub determine_home {
      my $class = shift;
  
      my $homedir = $ENV{HOME}
        || eval { require File::HomeDir; File::HomeDir->my_home }
        || join('', @ENV{qw(HOMEDRIVE HOMEPATH)}); # Win32
  
      if (WIN32) {
          require Win32; # no fatpack
          $homedir = Win32::GetShortPathName($homedir);
      }
  
      return "$homedir/.cpanm";
  }
  
  sub new {
      my $class = shift;
  
      my $self = bless {
          name => "Menlo",
          home => $class->determine_home,
          cmd  => 'install',
          seen => {},
          notest => undef,
          test_only => undef,
          installdeps => undef,
          force => undef,
          sudo => undef,
          make  => undef,
          verbose => undef,
          quiet => undef,
          interactive => undef,
          log => undef,
          mirrors => [],
          mirror_only => undef,
          mirror_index => undef,
          cpanmetadb => "http://cpanmetadb.plackperl.org/v1.0/",
          perl => $^X,
          argv => [],
          local_lib => undef,
          self_contained => undef,
          exclude_vendor => undef,
          prompt_timeout => 0,
          prompt => undef,
          configure_timeout => 60,
          build_timeout => 3600,
          test_timeout => 1800,
          try_lwp => 1,
          try_wget => 1,
          try_curl => 1,
          uninstall_shadows => ($] < 5.012),
          skip_installed => 1,
          skip_satisfied => 0,
          static_install => 1,
          auto_cleanup => 7, # days
          pod2man => 1,
          installed_dists => 0,
          install_types => ['requires'],
          with_develop => 0,
          with_configure => 0,
          showdeps => 0,
          scandeps => 0,
          scandeps_tree => [],
          format   => 'tree',
          save_dists => undef,
          skip_configure => 0,
          verify => 0,
          report_perl_version => !$class->maybe_ci,
          build_args => {},
          features => {},
          pure_perl => 0,
          cpanfile_path => 'cpanfile',
          @_,
      }, $class;
  
      $self;
  }
  
  sub env {
      my($self, $key) = @_;
      $ENV{"PERL_CPANM_" . $key};
  }
  
  sub maybe_ci {
      my $class = shift;
      grep $ENV{$_}, qw( TRAVIS CI AUTOMATED_TESTING AUTHOR_TESTING );
  }
  
  sub install_type_handlers {
      my $self = shift;
  
      my @handlers;
      for my $type (qw( recommends suggests )) {
          push @handlers, "with-$type" => sub {
              my %uniq;
              $self->{install_types} = [ grep !$uniq{$_}++, @{$self->{install_types}}, $type ];
          };
          push @handlers, "without-$type" => sub {
              $self->{install_types} = [ grep $_ ne $type, @{$self->{install_types}} ];
          };
      }
  
      @handlers;
  }
  
  sub build_args_handlers {
      my $self = shift;
  
      my @handlers;
      for my $phase (qw( configure build test install )) {
          push @handlers, "$phase-args=s" => \($self->{build_args}{$phase});
      }
  
      @handlers;
  }
  
  sub parse_options {
      my $self = shift;
  
      local @ARGV = @{$self->{argv}};
      push @ARGV, grep length, split /\s+/, $self->env('OPT');
      push @ARGV, @_;
  
      Getopt::Long::Configure("bundling");
      Getopt::Long::GetOptions(
          'f|force'   => sub { $self->{skip_installed} = 0; $self->{force} = 1 },
          'n|notest!' => \$self->{notest},
          'test-only' => sub { $self->{notest} = 0; $self->{skip_installed} = 0; $self->{test_only} = 1 },
          'S|sudo!'   => \$self->{sudo},
          'v|verbose' => \$self->{verbose},
          'verify!'   => \$self->{verify},
          'q|quiet!'  => \$self->{quiet},
          'h|help'    => sub { $self->{action} = 'show_help' },
          'V|version' => sub { $self->{action} = 'show_version' },
          'perl=s'    => sub {
              $self->diag("--perl is deprecated since it's known to be fragile in figuring out dependencies. Run `$_[1] -S cpanm` instead.\n", 1);
              $self->{perl} = $_[1];
          },
          'l|local-lib=s' => sub { $self->{local_lib} = $self->maybe_abs($_[1]) },
          'L|local-lib-contained=s' => sub {
              $self->{local_lib} = $self->maybe_abs($_[1]);
              $self->{self_contained} = 1;
              $self->{pod2man} = undef;
          },
          'self-contained!' => \$self->{self_contained},
          'exclude-vendor!' => \$self->{exclude_vendor},
          'mirror=s@' => $self->{mirrors},
          'mirror-only!' => \$self->{mirror_only},
          'mirror-index=s' => sub { $self->{mirror_index} = $self->maybe_abs($_[1]) },
          'M|from=s' => sub {
              $self->{mirrors}     = [$_[1]];
              $self->{mirror_only} = 1;
          },
          'cpanmetadb=s'    => \$self->{cpanmetadb},
          'cascade-search!' => \$self->{cascade_search},
          'prompt!'   => \$self->{prompt},
          'installdeps' => \$self->{installdeps},
          'skip-installed!' => \$self->{skip_installed},
          'skip-satisfied!' => \$self->{skip_satisfied},
          'reinstall'    => sub { $self->{skip_installed} = 0 },
          'interactive!' => \$self->{interactive},
          'i|install'    => sub { $self->{cmd} = 'install' },
          'info'         => sub { $self->{cmd} = 'info' },
          'look'         => sub { $self->{cmd} = 'look'; $self->{skip_installed} = 0 },
          'U|uninstall'  => sub { $self->{cmd} = 'uninstall' },
          'self-upgrade' => sub { $self->{action} = 'self_upgrade' },
          'uninst-shadows!'  => \$self->{uninstall_shadows},
          'lwp!'    => \$self->{try_lwp},
          'wget!'   => \$self->{try_wget},
          'curl!'   => \$self->{try_curl},
          'auto-cleanup=s' => \$self->{auto_cleanup},
          'man-pages!' => \$self->{pod2man},
          'scandeps'   => \$self->{scandeps},
          'showdeps'   => sub { $self->{showdeps} = 1; $self->{skip_installed} = 0 },
          'format=s'   => \$self->{format},
          'save-dists=s' => sub {
              $self->{save_dists} = $self->maybe_abs($_[1]);
          },
          'skip-configure!' => \$self->{skip_configure},
          'static-install!' => \$self->{static_install},
          'dev!'       => \$self->{dev_release},
          'metacpan!'  => \$self->{metacpan},
          'report-perl-version!' => \$self->{report_perl_version},
          'configure-timeout=i' => \$self->{configure_timeout},
          'build-timeout=i' => \$self->{build_timeout},
          'test-timeout=i' => \$self->{test_timeout},
          'with-develop' => \$self->{with_develop},
          'without-develop' => sub { $self->{with_develop} = 0 },
          'with-configure' => \$self->{with_configure},
          'without-configure' => sub { $self->{with_configure} = 0 },
          'with-feature=s' => sub { $self->{features}{$_[1]} = 1 },
          'without-feature=s' => sub { $self->{features}{$_[1]} = 0 },
          'with-all-features' => sub { $self->{features}{__all} = 1 },
          'pp|pureperl!' => \$self->{pure_perl},
          "cpanfile=s" => \$self->{cpanfile_path},
          $self->install_type_handlers,
          $self->build_args_handlers,
      );
  
      if (!@ARGV && $0 ne '-' && !-t STDIN){ # e.g. # cpanm < author/requires.cpanm
          push @ARGV, $self->load_argv_from_fh(\*STDIN);
          $self->{load_from_stdin} = 1;
      }
  
      $self->{argv} = \@ARGV;
  }
  
  sub check_upgrade {
      my $self = shift;
      my $install_base = $ENV{PERL_LOCAL_LIB_ROOT} ? $self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}) : $Config{installsitebin};
      if ($0 eq '-') {
          # run from curl, that's fine
          return;
      } elsif ($0 !~ /^$install_base/) {
          if ($0 =~ m!perlbrew/bin!) {
              die <<DIE;
  It appears your cpanm executable was installed via `perlbrew install-cpanm`.
  cpanm --self-upgrade won't upgrade the version of cpanm you're running.
  
  Run the following command to get it upgraded.
  
    perlbrew install-cpanm
  
  DIE
          } else {
              die <<DIE;
  You are running cpanm from the path where your current perl won't install executables to.
  Because of that, cpanm --self-upgrade won't upgrade the version of cpanm you're running.
  
    cpanm path   : $0
    Install path : $Config{installsitebin}
  
  It means you either installed cpanm globally with system perl, or use distro packages such
  as rpm or apt-get, and you have to use them again to upgrade cpanm.
  DIE
          }
      }
  }
  
  sub check_libs {
      my $self = shift;
      return if $self->{_checked}++;
      $self->bootstrap_local_lib;
  }
  
  sub setup_verify {
      my $self = shift;
  
      my $has_modules = eval { require Module::Signature; require Digest::SHA; 1 };
      $self->{cpansign} = which('cpansign');
  
      unless ($has_modules && $self->{cpansign}) {
          warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";
          $self->{verify} = 0;
      }
  }
  
  sub parse_module_args {
      my($self, $module) = @_;
  
      # Plack@1.2 -> Plack~"==1.2"
      # BUT don't expand @ in git URLs
      $module =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;
  
      # Plack~1.20, DBI~"> 1.0, <= 2.0"
      if ($module =~ /\~[v\d\._,\!<>= ]+$/) {
          return split '~', $module, 2;
      } else {
          return $module, undef;
      }
  }
  
  sub run {
      my $self = shift;
  
      my $code;
      eval {
          $code = ($self->_doit == 0);
      }; if (my $e = $@) {
          warn $e;
          $code = 1;
      }
  
      $self->{status} = $code;
  }
  
  sub status {
      $_[0]->{status};
  }
  
  sub _doit {
      my $self = shift;
  
      $self->setup_home;
      $self->init_tools;
      $self->setup_verify if $self->{verify};
  
      if (my $action = $self->{action}) {
          $self->$action() and return 1;
      }
  
      return $self->show_help(1)
          unless @{$self->{argv}} or $self->{load_from_stdin};
  
      $self->configure_mirrors;
  
      my $cwd = Cwd::cwd;
  
      my @fail;
      for my $module (@{$self->{argv}}) {
          if ($module =~ s/\.pm$//i) {
              my ($volume, $dirs, $file) = File::Spec->splitpath($module);
              $module = join '::', grep { $_ } File::Spec->splitdir($dirs), $file;
          }
          ($module, my $version) = $self->parse_module_args($module);
  
          $self->chdir($cwd);
          if ($self->{cmd} eq 'uninstall') {
              $self->uninstall_module($module)
                or push @fail, $module;
          } else {
              $self->install_module($module, 0, $version)
                  or push @fail, $module;
          }
      }
  
      if ($self->{base} && $self->{auto_cleanup}) {
          $self->cleanup_workdirs;
      }
  
      if ($self->{installed_dists}) {
          my $dists = $self->{installed_dists} > 1 ? "distributions" : "distribution";
          $self->diag("$self->{installed_dists} $dists installed\n", 1);
      }
  
      if ($self->{scandeps}) {
          $self->dump_scandeps();
      }
      # Workaround for older File::Temp's
      # where creating a tempdir with an implicit $PWD
      # causes tempdir non-cleanup if $PWD changes
      # as paths are stored internally without being resolved
      # absolutely.
      # https://rt.cpan.org/Public/Bug/Display.html?id=44924
      $self->chdir($cwd);
  
      return !@fail;
  }
  
  sub setup_home {
      my $self = shift;
  
      $self->{home} = $self->env('HOME') if $self->env('HOME');
  
      unless (_writable($self->{home})) {
          die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n";
      }
  
      $self->{base} = "$self->{home}/work/" . time . ".$$";
      File::Path::mkpath([ $self->{base} ], 0, 0777);
  
      # native path because we use shell redirect
      $self->{log} = File::Spec->catfile($self->{base}, "build.log");
      my $final_log = "$self->{home}/build.log";
  
      { open my $out, ">$self->{log}" or die "$self->{log}: $!" }
  
      if (CAN_SYMLINK) {
          my $build_link = "$self->{home}/latest-build";
          unlink $build_link;
          symlink $self->{base}, $build_link;
  
          unlink $final_log;
          symlink $self->{log}, $final_log;
      } else {
          my $log = $self->{log}; my $home = $self->{home};
          $self->{at_exit} = sub {
              my $self = shift;
              my $temp_log = "$home/build.log." . time . ".$$";
              File::Copy::copy($log, $temp_log)
                  && unlink($final_log);
              rename($temp_log, $final_log);
          }
      }
  
      $self->chat("cpanm ($self->{name}) $Menlo::VERSION on perl $] built for $Config{archname}\n" .
                  "Work directory is $self->{base}\n");
  }
  
  sub search_mirror_index_local {
      my ($self, $local, $module, $version) = @_;
      require CPAN::Common::Index::LocalPackage;
      my $index = CPAN::Common::Index::LocalPackage->new({ source => $local });
      $self->search_common($index, { package => $module }, $version);
  }
  
  sub search_mirror_index {
      my ($self, $mirror, $module, $version) = @_;
      require Menlo::Index::Mirror;
      my $index = Menlo::Index::Mirror->new({
          mirror => $mirror,
          cache => $self->source_for($mirror),
          fetcher => sub { $self->mirror(@_) },
      });
      $self->search_common($index, { package => $module }, $version);
  }
  
  sub search_common {
      my($self, $index, $search_args, $want_version) = @_;
  
      $index->refresh_index;
  
      my $found = $index->search_packages($search_args);
      $found = $self->cpan_module_common($found) if $found;
  
      return $found unless $self->{cascade_search};
  
      if ($found) {
          if ($self->satisfy_version($found->{module}, $found->{module_version}, $want_version)) {
              return $found;
          } else {
              $self->chat("Found $found->{module} $found->{module_version} which doesn't satisfy $want_version.\n");
          }
      }
      
      return;
  }
  
  sub with_version_range {
      my($self, $version) = @_;
      defined($version) && $version =~ /(?:<|!=|==)/;
  }
  
  sub search_metacpan {
      my($self, $module, $version, $dev_release) = @_;
  
      require Menlo::Index::MetaCPAN;
      $self->chat("Searching $module ($version) on metacpan ...\n");
  
      my $index = Menlo::Index::MetaCPAN->new({ include_dev => $self->{dev_release} });
      my $pkg = $self->search_common($index, { package => $module, version_range => $version }, $version);
      return $pkg if $pkg;
  
      $self->diag_fail("Finding $module ($version) on metacpan failed.");
      return;
  }
  
  sub search_database {
      my($self, $module, $version) = @_;
  
      my $found;
  
      if ($self->{dev_release} or $self->{metacpan}) {
          $found = $self->search_metacpan($module, $version, $self->{dev_release})   and return $found;
          $found = $self->search_cpanmetadb($module, $version, $self->{dev_release}) and return $found;
      } else {
          $found = $self->search_cpanmetadb($module, $version) and return $found;
          $found = $self->search_metacpan($module, $version)   and return $found;
      }
  }
  
  sub search_cpanmetadb {
      my($self, $module, $version, $dev_release) = @_;
  
      require Menlo::Index::MetaDB;
      $self->chat("Searching $module ($version) on cpanmetadb ...\n");
  
      my $args = { package => $module };
      if ($self->with_version_range($version)) {
          $args->{version_range} = $version;
      }
  
      my $index = Menlo::Index::MetaDB->new({ uri => $self->{cpanmetadb} });
      my $pkg = $self->search_common($index, $args, $version);
      return $pkg if $pkg;
  
      $self->diag_fail("Finding $module on cpanmetadb failed.");
      return;
  }
  
  sub search_module {
      my($self, $module, $version) = @_;
  
      if ($self->{mirror_index}) {
          $self->mask_output( chat => "Searching $module on mirror index $self->{mirror_index} ...\n" );
          my $pkg = $self->search_mirror_index_local($self->{mirror_index}, $module, $version);
          return $pkg if $pkg;
  
          unless ($self->{cascade_search}) {
             $self->mask_output( diag_fail => "Finding $module ($version) on mirror index $self->{mirror_index} failed." );
             return;
          }
      }
  
      unless ($self->{mirror_only}) {
          my $found = $self->search_database($module, $version);
          return $found if $found;
      }
  
      MIRROR: for my $mirror (@{ $self->{mirrors} }) {
          $self->mask_output( chat => "Searching $module on mirror $mirror ...\n" );
  
          my $pkg = $self->search_mirror_index($mirror, $module, $version);
          return $pkg if $pkg;
  
          $self->mask_output( diag_fail => "Finding $module ($version) on mirror $mirror failed." );
      }
  
      return;
  }
  
  sub source_for {
      my($self, $mirror) = @_;
      $mirror =~ s/[^\w\.\-]+/%/g;
  
      my $dir = "$self->{home}/sources/$mirror";
      File::Path::mkpath([ $dir ], 0, 0777);
  
      return $dir;
  }
  
  sub load_argv_from_fh {
      my($self, $fh) = @_;
  
      my @argv;
      while(defined(my $line = <$fh>)){
          chomp $line;
          $line =~ s/#.+$//; # comment
          $line =~ s/^\s+//; # trim spaces
          $line =~ s/\s+$//; # trim spaces
  
          push @argv, split ' ', $line if $line;
      }
      return @argv;
  }
  
  sub show_version {
      my $self = shift;
  
      print "cpanm ($self->{name}) version $VERSION ($0)\n";
      print "perl version $] ($^X)\n\n";
  
      print "  \%Config:\n";
      for my $key (qw( archname installsitelib installsitebin installman1dir installman3dir
                       sitearchexp sitelibexp vendorarch vendorlibexp archlibexp privlibexp )) {
          print "    $key=$Config{$key}\n" if $Config{$key};
      }
  
      print "  \%ENV:\n";
      for my $key (grep /^PERL/, sort keys %ENV) {
          print "    $key=$ENV{$key}\n";
      }
  
      print "  \@INC:\n";
      for my $inc (@INC) {
          print "    $inc\n" unless ref($inc) eq 'CODE';
      }
  
      return 1;
  }
  
  sub show_help {
      my $self = shift;
  
      if ($_[0]) {
          print <<USAGE;
  Usage: cpanm [options] Module [...]
  
  Try `cpanm --help` or `man cpanm` for more options.
  USAGE
          return;
      }
  
      print <<HELP;
  Usage: cpanm [options] Module [...]
  
  Options:
    -v,--verbose              Turns on chatty output
    -q,--quiet                Turns off the most output
    --interactive             Turns on interactive configure (required for Task:: modules)
    -f,--force                force install
    -n,--notest               Do not run unit tests
    --test-only               Run tests only, do not install
    -S,--sudo                 sudo to run install commands
    --installdeps             Only install dependencies
    --showdeps                Only display direct dependencies
    --reinstall               Reinstall the distribution even if you already have the latest version installed
    --mirror                  Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
    --mirror-only             Use the mirror's index file instead of the CPAN Meta DB
    -M,--from                 Use only this mirror base URL and its index file
    --prompt                  Prompt when configure/build/test fails
    -l,--local-lib            Specify the install base to install modules
    -L,--local-lib-contained  Specify the install base to install all non-core modules
    --self-contained          Install all non-core modules, even if they're already installed.
    --auto-cleanup            Number of days that cpanm's work directories expire in. Defaults to 7
  
  Commands:
    --self-upgrade            upgrades itself
    --info                    Displays distribution info on CPAN
    --look                    Opens the distribution with your SHELL
    -U,--uninstall            Uninstalls the modules (EXPERIMENTAL)
    -V,--version              Displays software version
  
  Examples:
  
    cpanm Test::More                                          # install Test::More
    cpanm MIYAGAWA/Plack-0.99_05.tar.gz                       # full distribution path
    cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz           # install from URL
    cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz            # install from a local file
    cpanm --interactive Task::Kensho                          # Configure interactively
    cpanm .                                                   # install from local directory
    cpanm --installdeps .                                     # install all the deps for the current directory
    cpanm -L extlib Plack                                     # install Plack and all non-core deps into extlib
    cpanm --mirror http://cpan.cpantesters.org/ DBI           # use the fast-syncing mirror
    cpanm -M https://cpan.metacpan.org App::perlbrew          # use only this secure mirror and its index
  
  You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc:
  
    export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org"
  
  Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options.
  
  HELP
  
      return 1;
  }
  
  sub _writable {
      my $dir = shift;
      my @dir = File::Spec->splitdir($dir);
      while (@dir) {
          $dir = File::Spec->catdir(@dir);
          if (-e $dir) {
              return -w _;
          }
          pop @dir;
      }
  
      return;
  }
  
  sub maybe_abs {
      my($self, $lib) = @_;
      if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)) {
          return $lib;
      } else {
          return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(), $lib));
      }
  }
  
  sub local_lib_target {
      my($self, $root) = @_;
      # local::lib 1.008025 changed the order of PERL_LOCAL_LIB_ROOT
      (grep { $_ ne '' } split /\Q$Config{path_sep}/, $root)[0];
  }
  
  sub bootstrap_local_lib {
      my $self = shift;
  
      # If -l is specified, use that.
      if ($self->{local_lib}) {
          return $self->setup_local_lib($self->{local_lib});
      }
  
      # PERL_LOCAL_LIB_ROOT is defined. Run as local::lib mode without overwriting ENV
      if ($ENV{PERL_LOCAL_LIB_ROOT} && $ENV{PERL_MM_OPT}) {
          return $self->setup_local_lib($self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}), 1);
      }
  
      # root, locally-installed perl or --sudo: don't care about install_base
      return if $self->{sudo} or (_writable($Config{installsitelib}) and _writable($Config{installsitebin}));
  
      # local::lib is configured in the shell -- yay
      if ($ENV{PERL_MM_OPT} and ($ENV{MODULEBUILDRC} or $ENV{PERL_MB_OPT})) {
          return;
      }
  
      $self->setup_local_lib;
  
      $self->diag(<<DIAG, 1);
  !
  ! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5
  ! To turn off this warning, you have to do one of the following:
  !   - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin})
  !   - Configure local::lib in your existing shell to set PERL_MM_OPT etc.
  !   - Install local::lib by running the following commands
  !
  !         cpanm --local-lib=~/perl5 local::lib && eval \$(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
  !
  DIAG
      sleep 2;
  }
  
  sub upgrade_toolchain {
      my($self, $config_deps) = @_;
  
      my %deps = map { $_->module => $_ } @$config_deps;
  
      # M::B 0.38 and EUMM 6.58 for MYMETA
      # EU::Install 1.46 for local::lib
      my $reqs = CPAN::Meta::Requirements->from_string_hash({
          'Module::Build' => '0.38',
          'ExtUtils::MakeMaker' => '6.58',
          'ExtUtils::Install' => '1.46',
      });
  
      if ($deps{"ExtUtils::MakeMaker"}) {
          $deps{"ExtUtils::MakeMaker"}->merge_with($reqs);
      } elsif ($deps{"Module::Build"}) {
          $deps{"Module::Build"}->merge_with($reqs);
          $deps{"ExtUtils::Install"} ||= Menlo::Dependency->new("ExtUtils::Install", 0, 'configure');
          $deps{"ExtUtils::Install"}->merge_with($reqs);
      }
  
      @$config_deps = values %deps;
  }
  
  sub _core_only_inc {
      my($self, $base) = @_;
      require local::lib;
      (
          local::lib->resolve_path(local::lib->install_base_arch_path($base)),
          local::lib->resolve_path(local::lib->install_base_perl_path($base)),
          (!$self->{exclude_vendor} ? grep {$_} @Config{qw(vendorarch vendorlibexp)} : ()),
          @Config{qw(archlibexp privlibexp)},
      );
  }
  
  sub _setup_local_lib_env {
      my($self, $base) = @_;
  
      $self->diag(<<WARN, 1) if $base =~ /\s/;
  WARNING: Your lib directory name ($base) contains a space in it. It's known to cause issues with perl builder tools such as local::lib and MakeMaker. You're recommended to rename your directory.
  WARN
  
      local $SIG{__WARN__} = sub { }; # catch 'Attempting to write ...'
      local::lib->setup_env_hash_for($base, 0);
  }
  
  sub setup_local_lib {
      my($self, $base, $no_env) = @_;
      $base = undef if $base eq '_';
  
      require local::lib;
      {
          local $0 = 'cpanm'; # so curl/wget | perl works
          $base ||= "~/perl5";
          $base = local::lib->resolve_path($base);
          if ($self->{self_contained}) {
              my @inc = $self->_core_only_inc($base);
              $self->{search_inc} = [ @inc ];
          } else {
              $self->{search_inc} = [
                  local::lib->install_base_arch_path($base),
                  local::lib->install_base_perl_path($base),
                  @INC,
              ];
          }
          $self->_setup_local_lib_env($base) unless $no_env;
          $self->{local_lib} = $base;
      }
  }
  
  sub prompt_bool {
      my($self, $mess, $def) = @_;
  
      my $val = $self->prompt($mess, $def);
      return lc $val eq 'y';
  }
  
  sub prompt {
      my($self, $mess, $def) = @_;
  
      my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
      my $dispdef = defined $def ? "[$def] " : " ";
      $def = defined $def ? $def : "";
  
      if (!$self->{prompt} || (!$isa_tty && eof STDIN)) {
          return $def;
      }
  
      local $|=1;
      local $\;
      my $ans;
      eval {
          local $SIG{ALRM} = sub { undef $ans; die "alarm\n" };
          print STDOUT "$mess $dispdef";
          alarm $self->{prompt_timeout} if $self->{prompt_timeout};
          $ans = <STDIN>;
          alarm 0;
      };
      if ( defined $ans ) {
          chomp $ans;
      } else { # user hit ctrl-D or alarm timeout
          print STDOUT "\n";
      }
  
      return (!defined $ans || $ans eq '') ? $def : $ans;
  }
  
  sub diag_ok {
      my($self, $msg) = @_;
      chomp $msg;
      $msg ||= "OK";
      if ($self->{in_progress}) {
          $self->_diag("$msg\n");
          $self->{in_progress} = 0;
      }
      $self->log("-> $msg\n");
  }
  
  sub diag_fail {
      my($self, $msg, $always) = @_;
      chomp $msg;
      if ($self->{in_progress}) {
          $self->_diag("FAIL\n");
          $self->{in_progress} = 0;
      }
  
      if ($msg) {
          $self->_diag("! $msg\n", $always, 1);
          $self->log("-> FAIL $msg\n");
      }
  }
  
  sub diag_progress {
      my($self, $msg) = @_;
      chomp $msg;
      $self->{in_progress} = 1;
      $self->_diag("$msg ... ");
      $self->log("$msg\n");
  }
  
  sub _diag {
      my($self, $msg, $always, $error) = @_;
      my $fh = $error ? *STDERR : *STDOUT;
      print {$fh} $msg if $always or $self->{verbose} or !$self->{quiet};
  }
  
  sub diag {
      my($self, $msg, $always) = @_;
      $self->_diag($msg, $always);
      $self->log($msg);
  }
  
  sub chat {
      my $self = shift;
      print STDERR @_ if $self->{verbose};
      $self->log(@_);
  }
  
  sub mask_output {
      my $self = shift;
      my $method = shift;
      $self->$method( $self->mask_uri_passwords(@_) );
  }
  
  sub log {
      my $self = shift;
      open my $out, ">>$self->{log}";
      print $out @_;
  }
  
  sub run_command {
      my($self, $cmd) = @_;
  
      # TODO move to a more appropriate runner method
      if (ref $cmd eq 'CODE') {
          if ($self->{verbose}) {
              return $cmd->();
          } else {
              require Capture::Tiny;
              open my $logfh, ">>", $self->{log};
              my $ret;
              Capture::Tiny::capture(sub { $ret = $cmd->() }, stdout => $logfh, stderr => $logfh);
              return $ret;
          }
      }
  
      if (WIN32) {
          $cmd = Menlo::Util::shell_quote(@$cmd) if ref $cmd eq 'ARRAY';
          unless ($self->{verbose}) {
              $cmd .= " >> " . Menlo::Util::shell_quote($self->{log}) . " 2>&1";
          }
          !system $cmd;
      } else {
          my $pid = fork;
          if ($pid) {
              waitpid $pid, 0;
              return !$?;
          } else {
              $self->run_exec($cmd);
          }
      }
  }
  
  sub run_exec {
      my($self, $cmd) = @_;
  
      if (ref $cmd eq 'ARRAY') {
          unless ($self->{verbose}) {
              open my $logfh, ">>", $self->{log};
              open STDERR, '>&', $logfh;
              open STDOUT, '>&', $logfh;
              close $logfh;
          }
          exec @$cmd;
      } else {
          unless ($self->{verbose}) {
              $cmd .= " >> " . Menlo::Util::shell_quote($self->{log}) . " 2>&1";
          }
          exec $cmd;
      }
  }
  
  sub run_timeout {
      my($self, $cmd, $timeout) = @_;
  
      return $self->run_command($cmd) if ref($cmd) eq 'CODE' || WIN32 || $self->{verbose} || !$timeout;
  
      my $pid = fork;
      if ($pid) {
          eval {
              local $SIG{ALRM} = sub { die "alarm\n" };
              alarm $timeout;
              waitpid $pid, 0;
              alarm 0;
          };
          if ($@ && $@ eq "alarm\n") {
              $self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");
              local $SIG{TERM} = 'IGNORE';
              kill TERM => 0;
              waitpid $pid, 0;
              return;
          }
          return !$?;
      } elsif ($pid == 0) {
          $self->run_exec($cmd);
      } else {
          $self->chat("! fork failed: falling back to system()\n");
          $self->run_command($cmd);
      }
  }
  
  sub append_args {
      my($self, $cmd, $phase) = @_;
  
      return $cmd if ref $cmd ne 'ARRAY';
      
      if (my $args = $self->{build_args}{$phase}) {
          $cmd = join ' ', Menlo::Util::shell_quote(@$cmd), $args;
      }
  
      $cmd;
  }
  
  sub _use_unsafe_inc {
      my($self, $dist) = @_;
  
      # if it's set in the env (i.e. user's shell), just use that
      if (exists $ENV{PERL_USE_UNSAFE_INC}) {
          return $ENV{PERL_USE_UNSAFE_INC};
      }
  
      # it's set in CPAN Meta, prefer what the author says
      if (exists $dist->{meta}{x_use_unsafe_inc}) {
          $self->chat("Distribution opts in x_use_unsafe_inc: $dist->{meta}{x_use_unsafe_inc}\n");
          return $dist->{meta}{x_use_unsafe_inc};
      }
  
      # otherwise set to 1 as a default to allow for old modules
      return 1;
  }
  
  sub configure {
      my($self, $cmd, $dist, $depth) = @_;
  
      # trick AutoInstall
      local $ENV{PERL5_CPAN_IS_RUNNING} = local $ENV{PERL5_CPANPLUS_IS_RUNNING} = $$;
  
      # e.g. skip CPAN configuration on local::lib
      local $ENV{PERL5_CPANM_IS_RUNNING} = $$;
  
      my $use_default = !$self->{interactive};
      local $ENV{PERL_MM_USE_DEFAULT} = $use_default;
  
      local $ENV{PERL_MM_OPT} = $ENV{PERL_MM_OPT};
      local $ENV{PERL_MB_OPT} = $ENV{PERL_MB_OPT};
  
      # skip man page generation
      unless ($self->{pod2man}) {
          $ENV{PERL_MM_OPT} .= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";
          $ENV{PERL_MB_OPT} .= " --config installman1dir= --config installsiteman1dir= --config installman3dir= --config installsiteman3dir=";
      }
  
      # Lancaster Consensus
      if ($self->{pure_perl}) {
          $ENV{PERL_MM_OPT} .= " PUREPERL_ONLY=1";
          $ENV{PERL_MB_OPT} .= " --pureperl-only";
      }
  
      local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);
  
      $cmd = $self->append_args($cmd, 'configure') if $depth == 0;
  
      local $self->{verbose} = $self->{verbose} || $self->{interactive};
      $self->run_timeout($cmd, $self->{configure_timeout});
  }
  
  sub build {
      my($self, $cmd, $distname, $dist, $depth) = @_;
  
      local $ENV{PERL_MM_USE_DEFAULT} = !$self->{interactive};
  
      local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);
  
      $cmd = $self->append_args($cmd, 'build') if $depth == 0;
  
      return 1 if $self->run_timeout($cmd, $self->{build_timeout});
      while (1) {
          my $ans = lc $self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
          return                                              if $ans eq 's';
          return $self->build($cmd, $distname, $dist, $depth) if $ans eq 'r';
          $self->show_build_log                               if $ans eq 'e';
          $self->look                                         if $ans eq 'l';
      }
  }
  
  sub test {
      my($self, $cmd, $distname, $dist, $depth) = @_;
      return 1 if $self->{notest};
  
      # https://rt.cpan.org/Ticket/Display.html?id=48965#txn-1013385
      local $ENV{PERL_MM_USE_DEFAULT} = !$self->{interactive};
  
      # https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md
      local $ENV{NONINTERACTIVE_TESTING} = !$self->{interactive};
  
      local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);
  
      $cmd = $self->append_args($cmd, 'test') if $depth == 0;
  
      return 1 if $self->run_timeout($cmd, $self->{test_timeout});
      if ($self->{force}) {
          $self->diag_fail("Testing $distname failed but installing it anyway.");
          return 1;
      } else {
          $self->diag_fail;
          while (1) {
              my $ans = lc $self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?", "s");
              return                                             if $ans eq 's';
              return $self->test($cmd, $distname, $dist, $depth) if $ans eq 'r';
              return 1                                           if $ans eq 'f';
              $self->show_build_log                              if $ans eq 'e';
              $self->look                                        if $ans eq 'l';
          }
      }
  }
  
  sub install {
      my($self, $cmd, $uninst_opts, $dist, $depth) = @_;
  
      if ($depth == 0 && $self->{test_only}) {
          return 1;
      }
  
      return $self->run_command($cmd) if ref $cmd eq 'CODE';
  
      local $ENV{PERL_USE_UNSAFE_INC} = $self->_use_unsafe_inc($dist);
  
      if ($self->{sudo}) {
          unshift @$cmd, "sudo";
      }
  
      if ($self->{uninstall_shadows} && !$ENV{PERL_MM_OPT}) {
          push @$cmd, @$uninst_opts;
      }
  
      $cmd = $self->append_args($cmd, 'install') if $depth == 0;
  
      $self->run_command($cmd);
  }
  
  sub look {
      my $self = shift;
  
      my $shell = $ENV{SHELL};
      $shell  ||= $ENV{COMSPEC} if WIN32;
      if ($shell) {
          my $cwd = Cwd::cwd;
          $self->diag("Entering $cwd with $shell\n");
          system $shell;
      } else {
          $self->diag_fail("You don't seem to have a SHELL :/");
      }
  }
  
  sub show_build_log {
      my $self = shift;
  
      my @pagers = (
          $ENV{PAGER},
          (WIN32 ? () : ('less')),
          'more'
      );
      my $pager;
      while (@pagers) {
          $pager = shift @pagers;
          next unless $pager;
          $pager = which($pager);
          next unless $pager;
          last;
      }
  
      if ($pager) {
          if (WIN32) {
              system "@{[ qs $pager ]} < @{[ qs $self->{log}]}";
          } else {
              system $pager, $self->{log};
          }
      }
      else {
          $self->diag_fail("You don't seem to have a PAGER :/");
      }
  }
  
  sub chdir {
      my $self = shift;
      Cwd::chdir(File::Spec->canonpath($_[0])) or die "$_[0]: $!";
  }
  
  sub configure_mirrors {
      my $self = shift;
      unless (@{$self->{mirrors}}) {
          $self->{mirrors} = [ 'http://www.cpan.org' ];
      }
      for (@{$self->{mirrors}}) {
          s!^/!file:///!;
          s!/$!!;
      }
  }
  
  sub self_upgrade {
      my $self = shift;
      $self->check_upgrade;
      $self->{argv} = [ 'Menlo' ];
      return; # continue
  }
  
  sub install_module {
      my($self, $module, $depth, $version, $dep) = @_;
  
      $self->check_libs;
  
      if ($self->{seen}{$module}++) {
          # TODO: circular dependencies
          $self->chat("Already tried $module. Skipping.\n");
          return 1;
      }
  
      if ($self->{skip_satisfied}) {
          my($ok, $local) = $self->check_module($module, $version || 0);
          if ($ok) {
              $self->diag("You have $module ($local)\n", 1);
              return 1;
          }
      }
  
      my $dist = $self->resolve_name($module, $version, $dep);
      unless ($dist) {
          my $what = $module . ($version ? " ($version)" : "");
          $self->diag_fail("Couldn't find module or a distribution $what", 1);
          return;
      }
  
      if ($dist->{distvname} && $self->{seen}{$dist->{distvname}}++) {
          $self->chat("Already tried $dist->{distvname}. Skipping.\n");
          return 1;
      }
  
      if ($self->{cmd} eq 'info') {
          print $self->format_dist($dist), "\n";
          return 1;
      }
  
      $dist->{depth} = $depth; # ugly hack
  
      if ($dist->{module}) {
          unless ($self->satisfy_version($dist->{module}, $dist->{module_version}, $version)) {
              $self->diag("Found $dist->{module} $dist->{module_version} which doesn't satisfy $version.\n", 1);
              return;
          }
  
          # If a version is requested, it has to be the exact same version, otherwise, check as if
          # it is the minimum version you need.
          my $cmp = $version ? "==" : "";
          my $requirement = $dist->{module_version} ? "$cmp$dist->{module_version}" : 0;
          my($ok, $local) = $self->check_module($dist->{module}, $requirement);
          if ($self->{skip_installed} && $ok) {
              $self->diag("$dist->{module} is up to date. ($local)\n", 1);
              return 1;
          }
      }
  
      if ($dist->{dist} eq 'perl'){
          $self->diag("skipping $dist->{pathname}\n");
          return 1;
      }
  
      $self->diag("--> Working on $module\n");
  
      $dist->{dir} ||= $self->fetch_module($dist);
  
      unless ($dist->{dir}) {
          $self->diag_fail("Failed to fetch distribution $dist->{distvname}", 1);
          return;
      }
  
      $self->chat("Entering $dist->{dir}\n");
      $self->chdir($self->{base});
      $self->chdir($dist->{dir});
  
      if ($self->{cmd} eq 'look') {
          $self->look;
          return 1;
      }
  
      return $self->build_stuff($module, $dist, $depth);
  }
  
  sub uninstall_search_path {
      my $self = shift;
  
      $self->{local_lib}
          ? (local::lib->install_base_arch_path($self->{local_lib}),
             local::lib->install_base_perl_path($self->{local_lib}))
          : @Config{qw(installsitearch installsitelib)};
  }
  
  sub uninstall_module {
      my ($self, $module) = @_;
  
      $self->check_libs;
  
      my @inc = $self->uninstall_search_path;
  
      my($metadata, $packlist) = $self->packlists_containing($module, \@inc);
      unless ($packlist) {
          $self->diag_fail(<<DIAG, 1);
  $module is not found in the following directories and can't be uninstalled.
  
  @{[ join("  \n", map "  $_", @inc) ]}
  
  DIAG
          return;
      }
  
      my @uninst_files = $self->uninstall_target($metadata, $packlist);
  
      $self->ask_permission($module, \@uninst_files) or return;
      $self->uninstall_files(@uninst_files, $packlist);
  
      $self->diag("Successfully uninstalled $module\n", 1);
  
      return 1;
  }
  
  sub packlists_containing {
      my($self, $module, $inc) = @_;
  
      require Module::Metadata;
      my $metadata = Module::Metadata->new_from_module($module, inc => $inc)
          or return;
  
      my $packlist;
      my $wanted = sub {
          return unless $_ eq '.packlist' && -f $_;
          for my $file ($self->unpack_packlist($File::Find::name)) {
              $packlist ||= $File::Find::name if $file eq $metadata->filename;
          }
      };
  
      {
          require File::pushd;
          my $pushd = File::pushd::pushd();
          my @search = grep -d $_, map File::Spec->catdir($_, 'auto'), @$inc;
          File::Find::find($wanted, @search);
      }
  
      return $metadata, $packlist;
  }
  
  sub uninstall_target {
      my($self, $metadata, $packlist) = @_;
  
      # If the module has a shadow install, or uses local::lib, then you can't just remove
      # all files in .packlist since it might have shadows in there
      if ($self->has_shadow_install($metadata) or $self->{local_lib}) {
          grep $self->should_unlink($_), $self->unpack_packlist($packlist);
      } else {
          $self->unpack_packlist($packlist);
      }
  }
  
  sub has_shadow_install {
      my($self, $metadata) = @_;
  
      # check if you have the module in site_perl *and* perl
      my @shadow = grep defined, map Module::Metadata->new_from_module($metadata->name, inc => [$_]), @INC;
      @shadow >= 2;
  }
  
  sub should_unlink {
      my($self, $file) = @_;
  
      # If local::lib is used, everything under the directory can be safely removed
      # Otherwise, bin and man files might be shared with the shadows i.e. site_perl vs perl
      # This is not 100% safe to keep the script there hoping to work with older version of .pm
      # files in the shadow, but there's nothing you can do about it.
      if ($self->{local_lib}) {
          $file =~ /^\Q$self->{local_lib}\E/;
      } else {
          !(grep $file =~ /^\Q$_\E/, @Config{qw(installbin installscript installman1dir installman3dir)});
      }
  }
  
  sub ask_permission {
      my ($self, $module, $files) = @_;
  
      $self->diag("$module contains the following files:\n\n");
      for my $file (@$files) {
          $self->diag("  $file\n");
      }
      $self->diag("\n");
  
      return 'force uninstall' if $self->{force};
      local $self->{prompt} = 1;
      return $self->prompt_bool("Are you sure you want to uninstall $module?", 'y');
  }
  
  sub unpack_packlist {
      my ($self, $packlist) = @_;
      open my $fh, '<', $packlist or die "$packlist: $!";
      map { chomp; $_ } <$fh>;
  }
  
  sub uninstall_files {
      my ($self, @files) = @_;
  
      $self->diag("\n");
  
      for my $file (@files) {
          $self->diag("Unlink: $file\n");
          unlink $file or $self->diag_fail("$!: $file");
      }
  
      $self->diag("\n");
  
      return 1;
  }
  
  sub format_dist {
      my($self, $dist) = @_;
  
      # TODO support --dist-format?
      return "$dist->{cpanid}/$dist->{filename}";
  }
  
  sub trim {
      local $_ = shift;
      tr/\n/ /d;
      s/^\s*|\s*$//g;
      $_;
  }
  
  sub fetch_module {
      my($self, $dist) = @_;
  
      $self->chdir($self->{base});
  
      for my $uri (@{$dist->{uris}}) {
          $self->mask_output( diag_progress => "Fetching $uri" );
  
          # Ugh, $dist->{filename} can contain sub directory
          my $filename = $dist->{filename} || $uri;
          my $name = File::Basename::basename($filename);
  
          my $cancelled;
          my $fetch = sub {
              my $file;
              eval {
                  local $SIG{INT} = sub { $cancelled = 1; die "SIGINT\n" };
                  $self->mirror($uri, $name);
                  $file = $name if -e $name;
              };
              $self->diag("ERROR: " . trim("$@") . "\n", 1) if $@ && $@ ne "SIGINT\n";
              return $file;
          };
  
          my($try, $file);
          while ($try++ < 3) {
              $file = $fetch->();
              last if $cancelled or $file;
              $self->mask_output( diag_fail => "Download $uri failed. Retrying ... ");
          }
  
          if ($cancelled) {
              $self->diag_fail("Download cancelled.");
              return;
          }
  
          unless ($file) {
              $self->mask_output( diag_fail => "Failed to download $uri");
              next;
          }
  
          $self->diag_ok;
          $dist->{local_path} = File::Spec->rel2abs($name);
  
          my $dir = $self->unpack($file, $uri, $dist);
          next unless $dir; # unpack failed
  
          if (my $save = $self->{save_dists}) {
              # Only distros retrieved from CPAN have a pathname set
              my $path = $dist->{pathname} ? "$save/authors/id/$dist->{pathname}"
                                           : "$save/vendor/$file";
              $self->chat("Copying $name to $path\n");
              File::Path::mkpath([ File::Basename::dirname($path) ], 0, 0777);
              File::Copy::copy($file, $path) or warn $!;
          }
  
          return $dist, $dir;
      }
  }
  
  sub unpack {
      my($self, $file, $uri, $dist) = @_;
  
      if ($self->{verify}) {
          $self->verify_archive($file, $uri, $dist) or return;
      }
  
      $self->chat("Unpacking $file\n");
      my $dir = $file =~ /\.zip/i ? $self->unzip($file) : $self->untar($file);
      unless ($dir) {
          $self->diag_fail("Failed to unpack $file: no directory");
      }
      return $dir;
  }
  
  sub verify_checksums_signature {
      my($self, $chk_file) = @_;
  
      require Module::Signature; # no fatpack
  
      $self->chat("Verifying the signature of CHECKSUMS\n");
  
      my $rv = eval {
          local $SIG{__WARN__} = sub {}; # suppress warnings
          my $v = Module::Signature::_verify($chk_file);
          $v == Module::Signature::SIGNATURE_OK();
      };
      if ($rv) {
          $self->chat("Verified OK!\n");
      } else {
          $self->diag_fail("Verifying CHECKSUMS signature failed: $rv\n");
          return;
      }
  
      return 1;
  }
  
  sub verify_archive {
      my($self, $file, $uri, $dist) = @_;
  
      unless ($dist->{cpanid}) {
          $self->chat("Archive '$file' does not seem to be from PAUSE. Skip verification.\n");
          return 1;
      }
  
      (my $mirror = $uri) =~ s!/authors/id.*$!!;
  
      (my $chksum_uri = $uri) =~ s!/[^/]*$!/CHECKSUMS!;
      my $chk_file = $self->source_for($mirror) . "/$dist->{cpanid}.CHECKSUMS";
      $self->mask_output( diag_progress => "Fetching $chksum_uri" );
      $self->mirror($chksum_uri, $chk_file);
  
      unless (-e $chk_file) {
          $self->diag_fail("Fetching $chksum_uri failed.\n");
          return;
      }
  
      $self->diag_ok;
      $self->verify_checksums_signature($chk_file) or return;
      $self->verify_checksum($file, $chk_file);
  }
  
  sub verify_checksum {
      my($self, $file, $chk_file) = @_;
  
      $self->chat("Verifying the SHA1 for $file\n");
  
      open my $fh, "<$chk_file" or die "$chk_file: $!";
      my $data = join '', <$fh>;
      $data =~ s/\015?\012/\n/g;
  
      require Safe; # no fatpack
      my $chksum = Safe->new->reval($data);
  
      if (!ref $chksum or ref $chksum ne 'HASH') {
          $self->diag_fail("! Checksum file downloaded from $chk_file is broken.\n");
          return;
      }
  
      if (my $sha = $chksum->{$file}{sha256}) {
          my $hex = $self->sha_for(256, $file);
          if ($hex eq $sha) {
              $self->chat("Checksum for $file: Verified!\n");
          } else {
              $self->diag_fail("Checksum mismatch for $file\n");
              return;
          }
      } else {
          $self->chat("Checksum for $file not found in CHECKSUMS.\n");
          return;
      }
  }
  
  sub sha_for {
      my($self, $alg, $file) = @_;
  
      require Digest::SHA; # no fatpack
  
      open my $fh, "<", $file or die "$file: $!";
      my $dg = Digest::SHA->new($alg);
      my($data);
      while (read($fh, $data, 4096)) {
          $dg->add($data);
      }
  
      return $dg->hexdigest;
  }
  
  sub verify_signature {
      my($self, $dist) = @_;
  
      $self->diag_progress("Verifying the SIGNATURE file");
      my $out = `@{[ qs $self->{cpansign} ]} -v --skip 2>&1`;
      $self->log($out);
  
      if ($out =~ /Signature verified OK/) {
          $self->diag_ok("Verified OK");
          return 1;
      } else {
          $self->diag_fail("SIGNATURE verification for $dist->{filename} failed\n");
          return;
      }
  }
  
  sub resolve_name {
      my($self, $module, $version, $dep) = @_;
  
      if ($dep && $dep->url) {
          if ($dep->url =~ m!authors/id/(.*)!) {
              return $self->cpan_dist($1, $dep->url);
          } else {
              return { uris => [ $dep->url ] };
          }
      }
  
      if ($dep && $dep->dist) {
          return $self->cpan_dist($dep->dist, undef, $dep->mirror);
      }
  
      # Git
      if ($module =~ /(?:^git:|\.git(?:@.+)?$)/) {
          return $self->git_uri($module);
      }
  
      # URL
      if ($module =~ /^(ftp|https?|file):/) {
          if ($module =~ m!authors/id/(.*)!) {
              return $self->cpan_dist($1, $module);
          } else {
              return { uris => [ $module ] };
          }
      }
  
      # Directory
      if ($module =~ m!^[\./]! && -d $module) {
          return {
              source => 'local',
              dir => Cwd::abs_path($module),
          };
      }
  
      # File
      if (-f $module) {
          return {
              source => 'local',
              uris => [ "file://" . Cwd::abs_path($module) ],
          };
      }
  
      # cpan URI
      if ($module =~ s!^cpan:///distfile/!!) {
          return $self->cpan_dist($module);
      }
  
      # PAUSEID/foo
      # P/PA/PAUSEID/foo
      if ($module =~ m!^(?:[A-Z]/[A-Z]{2}/)?([A-Z]{2}[\-A-Z0-9]*/.*)$!) {
          return $self->cpan_dist($1);
      }
  
      # Module name
      return $self->search_module($module, $version);
  }
  
  sub cpan_module_common {
      my($self, $match) = @_;
  
      (my $distfile = $match->{uri}) =~ s!^cpan:///distfile/!!;
  
      my $mirrors = $self->{mirrors};
      if ($match->{download_uri}) {
          (my $mirror = $match->{download_uri}) =~ s!/authors/id/.*$!!;
          $mirrors = [$mirror];
      }
  
      local $self->{mirrors} = $mirrors;
      return $self->cpan_module($match->{package}, $distfile, $match->{version});
  }
  
  sub cpan_module {
      my($self, $module, $dist_file, $version) = @_;
  
      my $dist = $self->cpan_dist($dist_file);
      $dist->{module} = $module;
      $dist->{module_version} = $version if $version && $version ne 'undef';
  
      return $dist;
  }
  
  sub cpan_dist {
      my($self, $dist, $url, $mirror) = @_;
  
      # strip trailing slash
      $mirror =~ s!/$!! if $mirror;
  
      $dist =~ s!^([A-Z]{2})!substr($1,0,1)."/".substr($1,0,2)."/".$1!e;
  
      require CPAN::DistnameInfo;
      my $d = CPAN::DistnameInfo->new($dist);
  
      if ($url) {
          $url = [ $url ] unless ref $url eq 'ARRAY';
      } else {
          my $id = $d->cpanid;
          my $fn = substr($id, 0, 1) . "/" . substr($id, 0, 2) . "/" . $id . "/" . $d->filename;
  
          my @mirrors = $mirror ? ($mirror) : @{$self->{mirrors}};
          my @urls    = map "$_/authors/id/$fn", @mirrors;
  
          $url = \@urls,
      }
  
      return {
          $d->properties,
          source  => 'cpan',
          uris    => $url,
      };
  }
  
  sub git_uri {
      my ($self, $uri) = @_;
  
      # similar to http://www.pip-installer.org/en/latest/logic.html#vcs-support
      # git URL has to end with .git when you need to use pin @ commit/tag/branch
  
      ($uri, my $commitish) = split /(?<=\.git)@/i, $uri, 2;
  
      my $dir = File::Temp::tempdir(CLEANUP => 1);
  
      $self->mask_output( diag_progress => "Cloning $uri" );
      $self->run_command([ 'git', 'clone', $uri, $dir ]);
  
      unless (-e "$dir/.git") {
          $self->diag_fail("Failed cloning git repository $uri", 1);
          return;
      }
  
      if ($commitish) {
          require File::pushd;
          my $dir = File::pushd::pushd($dir);
  
          unless ($self->run_command([ 'git', 'checkout', $commitish ])) {
              $self->diag_fail("Failed to checkout '$commitish' in git repository $uri\n");
              return;
          }
      }
  
      $self->diag_ok;
  
      return {
          source => 'local',
          dir    => $dir,
      };
  }
  
  sub core_version_for {
      my($self, $module) = @_;
  
      require Module::CoreList; # no fatpack
      unless (exists $Module::CoreList::version{$]+0}) {
          die sprintf("Module::CoreList %s (loaded from %s) doesn't seem to have entries for perl $]. " .
                      "You're strongly recommended to upgrade Module::CoreList from CPAN.\n",
                      $Module::CoreList::VERSION, $INC{"Module/CoreList.pm"});
      }
  
      unless (exists $Module::CoreList::version{$]+0}{$module}) {
          return -1;
      }
  
      return $Module::CoreList::version{$]+0}{$module};
  }
  
  sub search_inc {
      my $self = shift;
      $self->{search_inc} ||= do {
          # strip lib/ and fatlib/ from search path when booted from dev
          if (defined $::Bin) {
              [grep !/^\Q$::Bin\E\/..\/(?:fat)?lib$/, @INC]
          } else {
              [@INC]
          }
      };
  }
  
  sub check_module {
      my($self, $mod, $want_ver) = @_;
  
      require Module::Metadata;
      my $meta = Module::Metadata->new_from_module($mod, inc => $self->search_inc)
          or return 0, undef;
  
      my $version = $meta->version;
  
      # When -L is in use, the version loaded from 'perl' library path
      # might be newer than (or actually wasn't core at) the version
      # that is shipped with the current perl
      if ($self->{self_contained} && $self->loaded_from_perl_lib($meta)) {
          $version = $self->core_version_for($mod);
          return 0, undef if $version && $version == -1;
      }
  
      $self->{local_versions}{$mod} = $version;
  
      if ($self->is_deprecated($meta)){
          return 0, $version;
      } elsif ($self->satisfy_version($mod, $version, $want_ver)) {
          return 1, ($version || 'undef');
      } else {
          return 0, $version;
      }
  }
  
  sub satisfy_version {
      my($self, $mod, $version, $want_ver) = @_;
  
      $want_ver = '0' unless defined($want_ver) && length($want_ver);
  
      require CPAN::Meta::Requirements;
      my $requirements = CPAN::Meta::Requirements->new;
      $requirements->add_string_requirement($mod, $want_ver);
      $requirements->accepts_module($mod, $version);
  }
  
  sub unsatisfy_how {
      my($self, $ver, $want_ver) = @_;
  
      if ($want_ver =~ /^[v0-9\.\_]+$/) {
          return "$ver < $want_ver";
      } else {
          return "$ver doesn't satisfy $want_ver";
      }
  }
  
  sub is_deprecated {
      my($self, $meta) = @_;
  
      my $deprecated = eval {
          require Module::CoreList; # no fatpack
          Module::CoreList::is_deprecated($meta->{module});
      };
  
      return $deprecated && $self->loaded_from_perl_lib($meta);
  }
  
  sub loaded_from_perl_lib {
      my($self, $meta) = @_;
  
      require Config;
      my @dirs = qw(archlibexp privlibexp);
      if ($self->{self_contained} && ! $self->{exclude_vendor} && $Config{vendorarch}) {
          unshift @dirs, qw(vendorarch vendorlibexp);
      }
      for my $dir (@dirs) {
          my $confdir = $Config{$dir};
          if ($confdir eq substr($meta->filename, 0, length($confdir))) {
              return 1;
          }
      }
  
      return;
  }
  
  sub should_install {
      my($self, $mod, $ver) = @_;
  
      $self->chat("Checking if you have $mod $ver ... ");
      my($ok, $local) = $self->check_module($mod, $ver);
  
      if ($ok)       { $self->chat("Yes ($local)\n") }
      elsif ($local) { $self->chat("No (" . $self->unsatisfy_how($local, $ver) . ")\n") }
      else           { $self->chat("No\n") }
  
      return $mod unless $ok;
      return;
  }
  
  sub check_perl_version {
      my($self, $version) = @_;
      require CPAN::Meta::Requirements;
      my $req = CPAN::Meta::Requirements->from_string_hash({ perl => $version });
      $req->accepts_module(perl => $]);
  }
  
  sub install_deps {
      my($self, $dir, $depth, @deps) = @_;
  
      my(@install, %seen, @fail);
      for my $dep (@deps) {
          next if $seen{$dep->module};
          if ($dep->module eq 'perl') {
              if ($dep->is_requirement && !$self->check_perl_version($dep->version)) {
                  $self->diag("Needs perl @{[$dep->version]}, you have $]\n");
                  push @fail, 'perl';
              }
          } elsif ($self->should_install($dep->module, $dep->version)) {
              push @install, $dep;
              $seen{$dep->module} = 1;
          }
      }
  
      if (@install) {
          $self->diag("==> Found dependencies: " . join(", ",  map $_->module, @install) . "\n");
      }
  
      for my $dep (@install) {
          $self->install_module($dep->module, $depth + 1, $dep->version, $dep);
      }
  
      $self->chdir($self->{base});
      $self->chdir($dir) if $dir;
  
      if ($self->{scandeps}) {
          return 1; # Don't check if dependencies are installed, since with --scandeps they aren't
      }
      my @not_ok = $self->unsatisfied_deps(@deps);
      if (@not_ok) {
          return 0, \@not_ok;
      } else {
          return 1;
      }
  }
  
  sub unsatisfied_deps {
      my($self, @deps) = @_;
  
      require CPAN::Meta::Check;
      require CPAN::Meta::Requirements;
  
      my $reqs = CPAN::Meta::Requirements->new;
      for my $dep (grep $_->is_requirement, @deps) {
          $reqs->add_string_requirement($dep->module => $dep->requires_version || '0');
      }
  
      my $ret = CPAN::Meta::Check::check_requirements($reqs, 'requires', $self->{search_inc});
      grep defined, values %$ret;
  }
  
  sub install_deps_bailout {
      my($self, $target, $dir, $depth, @deps) = @_;
  
      my($ok, $fail) = $self->install_deps($dir, $depth, @deps);
      if (!$ok) {
          $self->diag_fail("Installing the dependencies failed: " . join(", ", @$fail), 1);
          unless ($self->prompt_bool("Do you want to continue building $target anyway?", "n")) {
              $self->diag_fail("Bailing out the installation for $target.", 1);
              return;
          }
      }
  
      return 1;
  }
  
  sub build_stuff {
      my($self, $stuff, $dist, $depth) = @_;
  
      if ($self->{verify} && -e 'SIGNATURE') {
          $self->verify_signature($dist) or return;
      }
  
      require CPAN::Meta;
  
      my($meta_file) = grep -f, qw(META.json META.yml);
      if ($meta_file) {
          $self->chat("Checking configure dependencies from $meta_file\n");
          $dist->{cpanmeta} = eval { CPAN::Meta->load_file($meta_file) };
      } elsif ($dist->{dist} && $dist->{version}) {
          $self->chat("META.yml/json not found. Creating skeleton for it.\n");
          $dist->{cpanmeta} = CPAN::Meta->new({ name => $dist->{dist}, version => $dist->{version} });
      }
  
      $dist->{meta} = $dist->{cpanmeta} ? $dist->{cpanmeta}->as_struct : {};
  
      if ($self->opts_in_static_install($dist->{cpanmeta})) {
          $dist->{static_install} = 1;
      }
  
      my @config_deps;
  
      if ($dist->{cpanmeta}) {
          push @config_deps, Menlo::Dependency->from_prereqs(
              $dist->{cpanmeta}->effective_prereqs, ['configure'], $self->{install_types},
          );
      }
  
      if (-e 'Build.PL' && !@config_deps) {
          push @config_deps, Menlo::Dependency->from_versions(
              { 'Module::Build' => '0.38' }, 'configure',
          );
      }
  
      $self->merge_with_cpanfile($dist, \@config_deps);
  
      $self->upgrade_toolchain(\@config_deps);
  
      my $target = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};
  
      unless ($self->skip_configure($dist, $depth)) {
          $self->install_deps_bailout($target, $dist->{dir}, $depth, @config_deps)
            or return;
      }
  
      $self->diag_progress("Configuring $target");
  
      my $configure_state = $self->configure_this($dist, $depth);
      $self->diag_ok($configure_state->{configured_ok} ? "OK" : "N/A");
  
      if ($dist->{cpanmeta} && $dist->{source} eq 'cpan') {
          $dist->{provides} = $dist->{cpanmeta}{provides} || $self->extract_packages($dist->{cpanmeta}, ".");
      }
  
      # install direct 'test' dependencies for --installdeps, even with --notest
      # TODO: remove build dependencies for static install
      my $deps_only = $self->deps_only($depth);
      $dist->{want_phases} = $self->{notest} && !$self->deps_only($depth)
                           ? [qw( build runtime )] : [qw( build test runtime )];
  
      push @{$dist->{want_phases}}, 'develop' if $self->{with_develop} && $depth == 0;
      push @{$dist->{want_phases}}, 'configure' if $self->{with_configure} && $depth == 0;
  
      my @deps = $self->find_prereqs($dist);
      my $module_name = $self->find_module_name($configure_state) || $dist->{meta}{name};
      $module_name =~ s/-/::/g;
  
      if ($self->{showdeps}) {
          for my $dep (@config_deps, @deps) {
              print $dep->module, ($dep->version ? ("~".$dep->version) : ""), "\n";
          }
          return 1;
      }
  
      my $distname = $dist->{meta}{name} ? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;
  
      my $walkup;
      if ($self->{scandeps}) {
          $walkup = $self->scandeps_append_child($dist);
      }
  
      $self->install_deps_bailout($distname, $dist->{dir}, $depth, @deps)
          or return;
  
      if ($self->{scandeps}) {
          unless ($configure_state->{configured_ok}) {
              my $diag = <<DIAG;
  ! Configuring $distname failed. See $self->{log} for details.
  ! You might have to install the following modules first to get --scandeps working correctly.
  DIAG
              if (@config_deps) {
                  my @tree = @{$self->{scandeps_tree}};
                  $diag .= "!\n" . join("", map "! * $_->[0]{module}\n", @tree[0..$#tree-1]) if @tree;
              }
              $self->diag("!\n$diag!\n", 1);
          }
          $walkup->();
          return 1;
      }
  
      if ($self->{installdeps} && $depth == 0) {
          if ($configure_state->{configured_ok}) {
              $self->diag("<== Installed dependencies for $stuff. Finishing.\n");
              return 1;
          } else {
              $self->diag("! Configuring $distname failed. See $self->{log} for details.\n", 1);
              return;
          }
      }
  
      my $installed;
      if ($configure_state->{static_install}) {
          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
          $self->build(sub { $configure_state->{static_install}->build }, $distname, $dist, $depth) &&
          $self->test(sub { $configure_state->{static_install}->build("test") }, $distname, $dist, $depth) &&
          $self->install(sub { $configure_state->{static_install}->build("install") }, [], $dist, $depth) &&
          $installed++;
      } elsif ($configure_state->{use_module_build} && -e 'Build' && -f _) {
          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
          $self->build([ $self->{perl}, "./Build" ], $distname, $dist, $depth) &&
          $self->test([ $self->{perl}, "./Build", "test" ], $distname, $dist, $depth) &&
          $self->install([ $self->{perl}, "./Build", "install" ], [ "--uninst", 1 ], $dist, $depth) &&
          $installed++;
      } elsif ($self->{make} && -e 'Makefile') {
          $self->diag_progress("Building " . ($self->{notest} ? "" : "and testing ") . $distname);
          $self->build([ $self->{make} ], $distname, $dist, $depth) &&
          $self->test([ $self->{make}, "test" ], $distname, $dist, $depth) &&
          $self->install([ $self->{make}, "install" ], [ "UNINST=1" ], $dist, $depth) &&
          $installed++;
      } else {
          my $why;
          my $configure_failed = $configure_state->{configured} && !$configure_state->{configured_ok};
          if ($configure_failed) { $why = "Configure failed for $distname." }
          elsif ($self->{make})  { $why = "The distribution doesn't have a proper Makefile.PL/Build.PL" }
          else                   { $why = "Can't configure the distribution. You probably need to have 'make'." }
  
          $self->diag_fail("$why See $self->{log} for details.", 1);
          return;
      }
  
      if ($installed && $self->{test_only}) {
          $self->diag_ok;
          $self->diag("Successfully tested $distname\n", 1);
      } elsif ($installed) {
          my $local   = $self->{local_versions}{$dist->{module} || ''};
          my $version = $dist->{module_version} || $dist->{meta}{version} || $dist->{version};
          my $reinstall = $local && ($local eq $version);
          my $action  = $local && !$reinstall
                      ? $self->is_downgrade($version, $local)
                          ? "downgraded"
                          : "upgraded"
                      : undef;
  
          my $how = $reinstall ? "reinstalled $distname"
                  : $local     ? "installed $distname ($action from $local)"
                               : "installed $distname" ;
          my $msg = "Successfully $how";
          $self->diag_ok;
          $self->diag("$msg\n", 1);
          $self->{installed_dists}++;
          $self->save_meta($stuff, $dist, $module_name, \@config_deps, \@deps);
          return 1;
      } else {
          my $what = $self->{test_only} ? "Testing" : "Installing";
          $self->diag_fail("$what $stuff failed. See $self->{log} for details. Retry with --force to force install it.", 1);
          return;
      }
  }
  
  sub is_downgrade {
      my($self, $va, $vb) = @_;
      eval { version::->new($va) < $vb };
  }
  
  sub opts_in_static_install {
      my($self, $meta) = @_;
  
      return if !$self->{static_install};
  
      # --sudo requires running a separate shell to prevent persistent configuration
      # uninstall-shadows (default on < 5.12) is not supported in BuildPL spec, yet.
      return if $self->{sudo} or $self->{uninstall_shadows};
  
      return $meta->{x_static_install} && $meta->{x_static_install} == 1;
  }
  
  sub skip_configure {
      my($self, $dist, $depth) = @_;
  
      return 1 if $self->{skip_configure};
      return 1 if $dist->{static_install};
      return 1 if $self->no_dynamic_config($dist->{meta}) && $self->deps_only($depth);
  
      return;
  }
  
  sub no_dynamic_config {
      my($self, $meta) = @_;
      exists $meta->{dynamic_config} && $meta->{dynamic_config} == 0;
  }
  
  sub deps_only {
      my($self, $depth) = @_;
      ($self->{installdeps} && $depth == 0)
        or $self->{showdeps}
        or $self->{scandeps};
  }
  
  sub perl_requirements {
      my($self, @requires) = @_;
  
      my @perl;
      for my $requires (grep defined, @requires) {
          if (exists $requires->{perl}) {
              push @perl, Menlo::Dependency->new(perl => $requires->{perl});
          }
      }
  
      return @perl;
  }
  
  sub configure_this {
      my($self, $dist, $depth) = @_;
  
      my $deps_only = $self->deps_only($depth);
      if (-e $self->{cpanfile_path} && $deps_only) {
          require Module::CPANfile;
          $dist->{cpanfile} = eval { Module::CPANfile->load($self->{cpanfile_path}) };
          $self->diag_fail($@, 1) if $@;
  
          $self->{cpanfile_global} ||= $dist->{cpanfile};
  
          return {
              configured       => 1,
              configured_ok    => !!$dist->{cpanfile},
              use_module_build => 0,
          };
      }
  
      if ($self->{skip_configure}) {
          my $eumm = -e 'Makefile';
          my $mb   = -e 'Build' && -f _;
          return {
              configured => 1,
              configured_ok => $eumm || $mb,
              use_module_build => $mb,
          };
      }
  
      if ($deps_only && $self->no_dynamic_config($dist->{meta})) {
          return {
              configured => 1,
              configured_ok => exists $dist->{meta}{prereqs},
              use_module_build => 0,
          };
      }
  
      my $state = {};
  
      my $try_static = sub {
          if ($dist->{static_install}) {
              $self->chat("Distribution opts in x_static_install: $dist->{meta}{x_static_install}\n");
              $self->static_install_configure($state, $dist, $depth);
          }
      };
  
      my $try_eumm = sub {
          if (-e 'Makefile.PL') {
              $self->chat("Running Makefile.PL\n");
  
              # NOTE: according to Devel::CheckLib, most XS modules exit
              # with 0 even if header files are missing, to avoid receiving
              # tons of FAIL reports in such cases. So exit code can't be
              # trusted if it went well.
              if ($self->configure([ $self->{perl}, "Makefile.PL" ], $dist, $depth)) {
                  $state->{configured_ok} = -e 'Makefile';
              }
              $state->{configured}++;
          }
      };
  
      my $try_mb = sub {
          if (-e 'Build.PL') {
              $self->chat("Running Build.PL\n");
              if ($self->configure([ $self->{perl}, "Build.PL" ], $dist, $depth)) {
                  $state->{configured_ok} = -e 'Build' && -f _;
              }
              $state->{use_module_build}++;
              $state->{configured}++;
          }
      };
  
      for my $try ($try_static, $try_mb, $try_eumm) {
          $try->();
          last if $state->{configured_ok};
      }
  
      unless ($state->{configured_ok}) {
          while (1) {
              my $ans = lc $self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?", "s");
              last                                        if $ans eq 's';
              return $self->configure_this($dist, $depth) if $ans eq 'r';
              $self->show_build_log                       if $ans eq 'e';
              $self->look                                 if $ans eq 'l';
          }
      }
  
      return $state;
  }
  
  sub static_install_configure {
      my($self, $state, $dist, $depth) = @_;
  
      my $args = $depth == 0 ? $self->{build_args}{configure} : [];
  
      require Menlo::Builder::Static;
      my $builder = Menlo::Builder::Static->new(meta => $dist->{cpanmeta});
      $self->configure(sub { $builder->configure($args || []) }, $dist, $depth);
  
      $state->{configured_ok} = 1;
      $state->{static_install} = $builder;
      $state->{configured}++;
  }
  
  sub find_module_name {
      my($self, $state) = @_;
  
      return unless $state->{configured_ok};
  
      if ($state->{use_module_build} &&
          -e "_build/build_params") {
          my $params = do { open my $in, "_build/build_params"; eval(join "", <$in>) };
          return eval { $params->[2]{module_name} } || undef;
      } elsif (-e "Makefile") {
          open my $mf, "Makefile";
          while (<$mf>) {
              if (/^\#\s+NAME\s+=>\s+(.*)/) {
                  return eval($1);
              }
          }
      }
  
      return;
  }
  
  sub list_files {
      my $self = shift;
  
      if (-e 'MANIFEST') {
          require ExtUtils::Manifest;
          my $manifest = eval { ExtUtils::Manifest::manifind() } || {};
          return sort { lc $a cmp lc $b } keys %$manifest;
      } else {
          require File::Find;
          my @files;
          my $finder = sub {
              my $name = $File::Find::name;
              $name =~ s!\.[/\\]!!;
              push @files, $name;
          };
          File::Find::find($finder, ".");
          return sort { lc $a cmp lc $b } @files;
      }
  }
  
  sub extract_packages {
      my($self, $meta, $dir) = @_;
  
      my $try = sub {
          my $file = shift;
          return 0 if $file =~ m!^(?:x?t|inc|local|perl5|fatlib|_build)/!;
          return 1 unless $meta->{no_index};
          return 0 if grep { $file =~ m!^$_/! } @{$meta->{no_index}{directory} || []};
          return 0 if grep { $file eq $_ } @{$meta->{no_index}{file} || []};
          return 1;
      };
  
      require Parse::PMFile;
  
      my @files = grep { /\.pm(?:\.PL)?$/ && $try->($_) } $self->list_files;
  
      my $provides = { };
  
      for my $file (@files) {
          my $parser = Parse::PMFile->new($meta, { UNSAFE => 1, ALLOW_DEV_VERSION => 1 });
          my $packages = $parser->parse($file);
  
          while (my($package, $meta) = each %$packages) {
              $provides->{$package} ||= {
                  file => $meta->{infile},
                  ($meta->{version} eq 'undef') ? () : (version => $meta->{version}),
              };
          }
      }
  
      return $provides;
  }
  
  sub save_meta {
      my($self, $module, $dist, $module_name, $config_deps, $build_deps) = @_;
  
      return unless $dist->{distvname} && $dist->{source} eq 'cpan';
  
      my $base = ($ENV{PERL_MM_OPT} || '') =~ /INSTALL_BASE=/
          ? ($self->install_base($ENV{PERL_MM_OPT}) . "/lib/perl5") : $Config{sitelibexp};
  
      my $provides = $dist->{provides};
  
      File::Path::mkpath("blib/meta", 0, 0777);
  
      my $local = {
          name => $module_name,
          target => $module,
          version => exists $provides->{$module_name}
              ? ($provides->{$module_name}{version} || $dist->{version}) : $dist->{version},
          dist => $dist->{distvname},
          pathname => $dist->{pathname},
          provides => $provides,
      };
  
      require JSON::PP;
      open my $fh, ">", "blib/meta/install.json" or die $!;
      print $fh JSON::PP::encode_json($local);
  
      File::Copy::copy("MYMETA.json", "blib/meta/MYMETA.json");
  
      my @cmd = (
          ($self->{sudo} ? 'sudo' : ()),
          $^X,
          '-MExtUtils::Install=install',
          '-e',
          qq[install({ 'blib/meta' => '$base/$Config{archname}/.meta/$dist->{distvname}' })],
      );
      $self->run_command(\@cmd);
  }
  
  sub install_base {
      my($self, $mm_opt) = @_;
      $mm_opt =~ /INSTALL_BASE=(\S+)/ and return $1;
      die "Your PERL_MM_OPT doesn't contain INSTALL_BASE";
  }
  
  sub configure_features {
      my($self, $dist, @features) = @_;
      map $_->identifier, grep { $self->effective_feature($dist, $_) } @features;
  }
  
  sub effective_feature {
      my($self, $dist, $feature) = @_;
  
      if ($dist->{depth} == 0) {
          my $value = $self->{features}{$feature->identifier};
          return $value if defined $value;
          return 1 if $self->{features}{__all};
      }
  
      if ($self->{interactive}) {
          require CPAN::Meta::Requirements;
  
          $self->diag("[@{[ $feature->description ]}]\n", 1);
  
          my $req = CPAN::Meta::Requirements->new;
          for my $phase (@{$dist->{want_phases}}) {
              for my $type (@{$self->{install_types}}) {
                  $req->add_requirements($feature->prereqs->requirements_for($phase, $type));
              }
          }
  
          my $reqs = $req->as_string_hash;
          my @missing;
          for my $module (keys %$reqs) {
              if ($self->should_install($module, $req->{$module})) {
                  push @missing, $module;
              }
          }
  
          if (@missing) {
              my $howmany = @missing;
              $self->diag("==> Found missing dependencies: " . join(", ", @missing) . "\n", 1);
              local $self->{prompt} = 1;
              return $self->prompt_bool("Install the $howmany optional module(s)?", "y");
          }
      }
  
      return;
  }
  
  sub find_prereqs {
      my($self, $dist) = @_;
  
      my @deps = $self->extract_meta_prereqs($dist);
  
      if ($dist->{module} =~ /^Bundle::/i) {
          push @deps, $self->bundle_deps($dist);
      }
  
      $self->merge_with_cpanfile($dist, \@deps);
  
      return @deps;
  }
  
  sub merge_with_cpanfile {
      my($self, $dist, $deps) = @_;
  
      if ($self->{cpanfile_requirements} && !$dist->{cpanfile}) {
          for my $dep (@$deps) {
              $dep->merge_with($self->{cpanfile_requirements});
          }
      }
  
      if ($self->{cpanfile_global}) {
          for my $dep (@$deps) {
              my $opts = $self->{cpanfile_global}->options_for_module($dep->module)
                or next;
  
              $dep->dist($opts->{dist})     if $opts->{dist};
              $dep->mirror($opts->{mirror}) if $opts->{mirror};
              $dep->url($opts->{url})       if $opts->{url};
          }
      }
  }
  
  sub extract_meta_prereqs {
      my($self, $dist) = @_;
  
      if ($dist->{cpanfile}) {
          my @features = $self->configure_features($dist, $dist->{cpanfile}->features);
          my $prereqs = $dist->{cpanfile}->prereqs_with(@features);
          # TODO: creating requirements is useful even without cpanfile to detect conflicting prereqs
          $self->{cpanfile_requirements} = $prereqs->merged_requirements($dist->{want_phases}, ['requires']);
          return Menlo::Dependency->from_prereqs($prereqs, $dist->{want_phases}, $self->{install_types});
      }
  
      require CPAN::Meta;
  
      my @meta = qw(MYMETA.json MYMETA.yml);
      if ($self->no_dynamic_config($dist->{meta})) {
          push @meta, qw(META.json META.yml);
      }
  
      my @deps;
      my($meta_file) = grep -f, @meta;
      if ($meta_file) {
          $self->chat("Checking dependencies from $meta_file ...\n");
          my $mymeta = eval { CPAN::Meta->load_file($meta_file, { lazy_validation => 1 }) };
          if ($mymeta) {
              $dist->{meta}{name}    = $mymeta->name;
              $dist->{meta}{version} = $mymeta->version;
              return $self->extract_prereqs($mymeta, $dist);
          }
      }
  
      $self->diag_fail("No MYMETA file is found after configure. Your toolchain is too old?");
      return;
  }
  
  sub bundle_deps {
      my($self, $dist) = @_;
  
      my $match;
      if ($dist->{module}) {
          $match = sub {
              my $meta = Module::Metadata->new_from_file($_[0]);
              $meta && ($meta->name eq $dist->{module});
          };
      } else {
          $match = sub { 1 };
      }
  
      my @files;
      File::Find::find({
          wanted => sub {
              push @files, File::Spec->rel2abs($_) if /\.pm$/i && $match->($_);
          },
          no_chdir => 1,
      }, '.');
  
      my @deps;
  
      for my $file (@files) {
          open my $pod, "<", $file or next;
          my $in_contents;
          while (<$pod>) {
              if (/^=head\d\s+CONTENTS/) {
                  $in_contents = 1;
              } elsif (/^=/) {
                  $in_contents = 0;
              } elsif ($in_contents) {
                  /^(\S+)\s*(\S+)?/
                      and push @deps, Menlo::Dependency->new($1, $self->maybe_version($2));
              }
          }
      }
  
      return @deps;
  }
  
  sub maybe_version {
      my($self, $string) = @_;
      return $string && $string =~ /^\.?\d/ ? $string : undef;
  }
  
  sub extract_prereqs {
      my($self, $meta, $dist) = @_;
  
      my @features = $self->configure_features($dist, $meta->features);
  
      my $prereqs = $meta->effective_prereqs(\@features)->clone;
      $self->adjust_prereqs($dist, $prereqs);
  
      return Menlo::Dependency->from_prereqs($prereqs, $dist->{want_phases}, $self->{install_types});
  }
  
  sub adjust_prereqs {
      my($self, $dist, $prereqs) = @_;
  
      # Workaround for Module::Install 1.04 creating a bogus (higher) MakeMaker requirement that it needs in build_requires
      # Assuming MakeMaker requirement is already satisfied in configure_requires, there's no need to have higher version of
      # MakeMaker in build/test anyway. https://github.com/miyagawa/cpanminus/issues/463
      if (-e "inc/Module/Install.pm") {
          for my $phase (qw( build test runtime )) {
              my $reqs = $prereqs->requirements_for($phase, 'requires');
              if ($reqs->requirements_for_module('ExtUtils::MakeMaker')) {
                  $reqs->clear_requirement('ExtUtils::MakeMaker');
                  $reqs->add_minimum('ExtUtils::MakeMaker' => 0);
              }
          }
      }
  
      # Static installation is optional and we're adding runtime dependencies
      if ($dist->{static_install}) {
          my $reqs = $prereqs->requirements_for('test' => 'requires');
          $reqs->add_minimum('TAP::Harness::Env' => 0);
      }
  }
  
  sub cleanup_workdirs {
      my $self = shift;
  
      my $expire = time - 24 * 60 * 60 * $self->{auto_cleanup};
      my @targets;
  
      opendir my $dh, "$self->{home}/work";
      while (my $e = readdir $dh) {
          next if $e !~ /^(\d+)\.\d+$/; # {UNIX time}.{PID}
          my $time = $1;
          if ($time < $expire) {
              push @targets, "$self->{home}/work/$e";
          }
      }
  
      if (@targets) {
          if (@targets >= 64) {
              $self->diag("Expiring " . scalar(@targets) . " work directories. This might take a while...\n");
          } else {
              $self->chat("Expiring " . scalar(@targets) . " work directories.\n");
          }
          File::Path::rmtree(\@targets, 0, 0); # safe = 0, since blib usually doesn't have write bits
      }
  }
  
  sub scandeps_append_child {
      my($self, $dist) = @_;
  
      my $new_node = [ $dist, [] ];
  
      my $curr_node = $self->{scandeps_current} || [ undef, $self->{scandeps_tree} ];
      push @{$curr_node->[1]}, $new_node;
  
      $self->{scandeps_current} = $new_node;
  
      return sub { $self->{scandeps_current} = $curr_node };
  }
  
  sub dump_scandeps {
      my $self = shift;
  
      if ($self->{format} eq 'tree') {
          $self->walk_down(sub {
              my($dist, $depth) = @_;
              if ($depth == 0) {
                  print "$dist->{distvname}\n";
              } else {
                  print " " x ($depth - 1);
                  print "\\_ $dist->{distvname}\n";
              }
          }, 1);
      } elsif ($self->{format} =~ /^dists?$/) {
          $self->walk_down(sub {
              my($dist, $depth) = @_;
              print $self->format_dist($dist), "\n";
          }, 0);
      } elsif ($self->{format} eq 'json') {
          require JSON::PP;
          print JSON::PP::encode_json($self->{scandeps_tree});
      } elsif ($self->{format} eq 'yaml') {
          require CPAN::Meta::YAML;
          print CPAN::Meta::YAML::Dump($self->{scandeps_tree});
      } else {
          $self->diag("Unknown format: $self->{format}\n");
      }
  }
  
  sub walk_down {
      my($self, $cb, $pre) = @_;
      $self->_do_walk_down($self->{scandeps_tree}, $cb, 0, $pre);
  }
  
  sub _do_walk_down {
      my($self, $children, $cb, $depth, $pre) = @_;
  
      # DFS - $pre determines when we call the callback
      for my $node (@$children) {
          $cb->($node->[0], $depth) if $pre;
          $self->_do_walk_down($node->[1], $cb, $depth + 1, $pre);
          $cb->($node->[0], $depth) unless $pre;
      }
  }
  
  sub DESTROY {
      my $self = shift;
      $self->{at_exit}->($self) if $self->{at_exit};
  }
  
  # Utils
  
  sub mirror {
      my($self, $uri, $local) = @_;
      if ($uri =~ /^file:/) {
          $self->file_mirror($uri, $local);
      } else {
          $self->{http}->mirror($uri, $local);
      }
  }
  
  sub untar    { $_[0]->{_backends}{untar}->(@_) };
  sub unzip    { $_[0]->{_backends}{unzip}->(@_) };
  
  sub uri_to_file {
      my($self, $uri) = @_;
  
      # file:///path/to/file -> /path/to/file
      # file://C:/path       -> C:/path
      if ($uri =~ s!file:/+!!) {
          $uri = "/$uri" unless $uri =~ m![a-zA-Z]:!;
      }
  
      return $uri;
  }
  
  sub file_get {
      my($self, $uri) = @_;
      my $file = $self->uri_to_file($uri);
      open my $fh, "<$file" or return;
      join '', <$fh>;
  }
  
  sub file_mirror {
      my($self, $uri, $path) = @_;
      my $file = $self->uri_to_file($uri);
  
      my $source_mtime = (stat $file)[9];
  
      # Don't mirror a file that's already there (like the index)
      return 1 if -e $path && (stat $path)[9] >= $source_mtime;
  
      File::Copy::copy($file, $path);
  
      utime $source_mtime, $source_mtime, $path;
  }
  
  sub configure_http {
      my $self = shift;
  
      require HTTP::Tinyish;
  
      my @try = qw(HTTPTiny);
      unshift @try, 'Wget' if $self->{try_wget};
      unshift @try, 'Curl' if $self->{try_curl};
      unshift @try, 'LWP'  if $self->{try_lwp};
  
      my @protocol = ('http');
      push @protocol, 'https'
        if grep /^https:/, @{$self->{mirrors}};
  
      my $backend;
      for my $try (map "HTTP::Tinyish::$_", @try) {
          if (my $meta = HTTP::Tinyish->configure_backend($try)) {
              if ((grep $try->supports($_), @protocol) == @protocol) {
                  for my $tool (sort keys %$meta){
                      (my $desc = $meta->{$tool}) =~ s/^(.*?)\n.*/$1/s;
                      $self->chat("You have $tool: $desc\n");
                  }
                  $backend = $try;
                  last;
              }
          }
      }
  
      $backend->new(agent => "Menlo/$Menlo::VERSION", verify_SSL => 1);
  }
  
  sub init_tools {
      my $self = shift;
  
      return if $self->{initialized}++;
  
      if ($self->{make} = which($Config{make})) {
          $self->chat("You have make $self->{make}\n");
      }
  
      $self->{http} = $self->configure_http;
  
      my $tar = which('tar');
      my $tar_ver;
      my $maybe_bad_tar = sub { WIN32 || BAD_TAR || (($tar_ver = `@{[ qs $tar ]} --version 2>/dev/null`) =~ /GNU.*1\.13/i) };
  
      if ($tar && !$maybe_bad_tar->()) {
          chomp $tar_ver;
          $self->chat("You have $tar: $tar_ver\n");
          $self->{_backends}{untar} = sub {
              my($self, $tarfile) = @_;
  
              my $xf = ($self->{verbose} ? 'v' : '')."xf";
              my $ar = $tarfile =~ /bz2$/ ? 'j' : 'z';
  
              my($root, @others) = `@{[ qs $tar ]} ${ar}tf @{[ qs $tarfile ]}`
                  or return undef;
  
              FILE: {
                  chomp $root;
                  $root =~ s!^\./!!;
                  $root =~ s{^(.+?)/.*$}{$1};
  
                  if (!length($root)) {
                      # archive had ./ as the first entry, so try again
                      $root = shift(@others);
                      redo FILE if $root;
                  }
              }
  
              $self->run_command([ $tar, $ar.$xf, $tarfile ]);
              return $root if -d $root;
  
              $self->diag_fail("Bad archive: $tarfile");
              return undef;
          }
      } elsif (    $tar
               and my $gzip = which('gzip')
               and my $bzip2 = which('bzip2')) {
          $self->chat("You have $tar, $gzip and $bzip2\n");
          $self->{_backends}{untar} = sub {
              my($self, $tarfile) = @_;
  
              my $x  = "x" . ($self->{verbose} ? 'v' : '') . "f -";
              my $ar = $tarfile =~ /bz2$/ ? $bzip2 : $gzip;
  
              my($root, @others) = `@{[ qs $ar ]} -dc @{[ qs $tarfile ]} | @{[ qs $tar ]} tf -`
                  or return undef;
  
              FILE: {
                  chomp $root;
                  $root =~ s!^\./!!;
                  $root =~ s{^(.+?)/.*$}{$1};
  
                  if (!length($root)) {
                      # archive had ./ as the first entry, so try again
                      $root = shift(@others);
                      redo FILE if $root;
                  }
              }
  
              system "@{[ qs $ar ]} -dc @{[ qs $tarfile ]} | @{[ qs $tar ]} $x";
              return $root if -d $root;
  
              $self->diag_fail("Bad archive: $tarfile");
              return undef;
          }
      } elsif (eval { require Archive::Tar }) { # uses too much memory!
          $self->chat("Falling back to Archive::Tar $Archive::Tar::VERSION\n");
          $self->{_backends}{untar} = sub {
              my $self = shift;
              my $t = Archive::Tar->new($_[0]);
              my($root, @others) = $t->list_files;
              FILE: {
                  $root =~ s!^\./!!;
                  $root =~ s{^(.+?)/.*$}{$1};
  
                  if (!length($root)) {
                      # archive had ./ as the first entry, so try again
                      $root = shift(@others);
                      redo FILE if $root;
                  }
              }
              $t->extract;
              return -d $root ? $root : undef;
          };
      } else {
          $self->{_backends}{untar} = sub {
              die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n";
          };
      }
  
      if (my $unzip = which('unzip')) {
          $self->chat("You have $unzip\n");
          $self->{_backends}{unzip} = sub {
              my($self, $zipfile) = @_;
  
              my @opt = $self->{verbose} ? () : ('-q');
              my(undef, $root, @others) = `@{[ qs $unzip ]} -t @{[ qs $zipfile ]}`
                  or return undef;
              FILE: {
                  chomp $root;
                  if ($root !~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1}) {
                      $root = shift(@others);
                      redo FILE if $root;
                  }
              }
  
              $self->run_command([ $unzip, @opt, $zipfile ]);
              return $root if -d $root;
  
              $self->diag_fail("Bad archive: '$root' $zipfile");
              return undef;
          }
      } else {
          $self->{_backends}{unzip} = sub {
              eval { require Archive::Zip }
                  or  die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";
              my($self, $file) = @_;
              my $zip = Archive::Zip->new();
              my $status;
              $status = $zip->read($file);
              $self->diag_fail("Read of file '$file' failed")
                  if $status != Archive::Zip::AZ_OK();
              my @members = $zip->members();
              for my $member ( @members ) {
                  my $af = $member->fileName();
                  next if ($af =~ m!^(/|\.\./)!);
                  $status = $member->extractToFileNamed( $af );
                  $self->diag_fail("Extracting of file 'af' from zipfile '$file' failed")
                      if $status != Archive::Zip::AZ_OK();
              }
  
              my ($root) = $zip->membersMatching( qr<^[^/]+/$> );
              $root &&= $root->fileName;
              return -d $root ? $root : undef;
          };
      }
  }
  
  sub mask_uri_passwords {
      my($self, @strings) = @_;
      s{ (https?://) ([^:/]+) : [^@/]+ @ }{$1$2:********@}gx for @strings;
      return @strings;
  }
  
  1;
  
  __END__
  
  =encoding utf-8
  
  =head1 NAME
  
  Menlo::CLI::Compat - cpanm compatible CPAN installer
  
  =head1 SYNOPSIS
  
    use Menlo::CLI::Compat;
  
    my $app = Menlo::CLI::Compat->new;
    $app->parse_options(@ARGV);
    $app->run;
  
  =head1 DESCRIPTION
  
  Menlo::CLI::Compat is a port of App::cpanminus to Menlo, and provides
  a compatibility layer for users and clients to depend on the specific
  cpanm behaviors.
  
  =head1 SEE ALSO
  
  L<Menlo>, L<Menlo::Legacy>
  
  =cut
  
MENLO_CLI_COMPAT

$fatpacked{"Menlo/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_DEPENDENCY';
  package Menlo::Dependency;
  use strict;
  use CPAN::Meta::Requirements;
  use Class::Tiny qw( module version type original_version dist mirror url );
  
  sub BUILDARGS {
      my($class, $module, $version, $type) = @_;
      return {
          module => $module,
          version => $version,
          type => $type || 'requires',
      };
  }
  
  sub from_prereqs {
      my($class, $prereqs, $phases, $types) = @_;
  
      my @deps;
      for my $type (@$types) {
          push @deps, $class->from_versions(
              $prereqs->merged_requirements($phases, [$type])->as_string_hash,
              $type,
          );
      }
  
      return @deps;
  }
  
  sub from_versions {
      my($class, $versions, $type) = @_;
  
      my @deps;
      while (my($module, $version) = each %$versions) {
          push @deps, $class->new($module, $version, $type)
      }
  
      @deps;
  }
  
  sub merge_with {
      my($self, $requirements) = @_;
  
      # save the original requirement
      $self->original_version($self->version);
  
      # should it clone? not cloning means we upgrade root $requirements on our way
      eval {
          $requirements->add_string_requirement($self->module, $self->version);
      };
      if ($@ =~ /illegal requirements/) {
          # Just give a warning then replace with the root requirements
          # so that later CPAN::Meta::Check can give a valid error
          warn sprintf("Can't merge requirements for %s: '%s' and '%s'",
                      $self->module, $self->version,
                      $requirements->requirements_for_module($self->module));
      }
  
      $self->version( $requirements->requirements_for_module($self->module) );
  }
  
  sub requires_version {
      my $self = shift;
  
      # original_version may be 0
      if (defined $self->original_version) {
          return $self->original_version;
      }
  
      $self->version;
  }
  
  sub is_requirement {
      $_[0]->type eq 'requires';
  }
  
  1;
MENLO_DEPENDENCY

$fatpacked{"Menlo/Index/MetaCPAN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_METACPAN';
  use 5.008001;
  use strict;
  use warnings;
  
  package Menlo::Index::MetaCPAN;
  # ABSTRACT: Search index via MetaCPAN
  # VERSION
  
  use parent 'CPAN::Common::Index';
  
  use Class::Tiny qw/uri include_dev/;
  
  use Carp;
  use HTTP::Tinyish;
  use JSON::PP ();
  use Time::Local ();
  
  sub BUILD {
      my $self = shift;
      my $uri  = $self->uri;
      $uri = "https://fastapi.metacpan.org/v1/download_url/"
        unless defined $uri;
      # ensure URI ends in '/'
      $uri =~ s{/?$}{/};
      $self->uri($uri);
      return;
  }
  
  sub search_packages {
      my ( $self, $args ) = @_;
      Carp::croak("Argument to search_packages must be hash reference")
        unless ref $args eq 'HASH';
  
      my $range;
      if ( $args->{version} ) {
          $range = "== $args->{version}";
      } elsif ( $args->{version_range} ) {
          $range = $args->{version_range};
      }
      my %query = (
          ($self->include_dev ? (dev => 1) : ()),
          ($range ? (version => $range) : ()),
      );
      my $query = join "&", map { "$_=" . $self->_uri_escape($query{$_}) } sort keys %query;
  
      my $uri = $self->uri . $args->{package} . ($query ? "?$query" : "");
      my $res = HTTP::Tinyish->new->get($uri);
      return unless $res->{success};
  
      my $dist_meta = eval { JSON::PP::decode_json($res->{content}) };
      if ($dist_meta && $dist_meta->{download_url}) {
          (my $distfile = $dist_meta->{download_url}) =~ s!.+/authors/id/\w/\w\w/!!;
  
          return {
              package => $args->{package},
              version => $dist_meta->{version},
              uri => "cpan:///distfile/$distfile",
              download_uri => $self->_download_uri("http://cpan.metacpan.org", $distfile),
          };
      }
  
      return;
  }
  
  sub _parse_date {
      my($self, $date) = @_;
      my @date = $date =~ /^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)$/;
      Time::Local::timegm($date[5], $date[4], $date[3], $date[2], $date[1] - 1, $date[0] - 1900);
  }
  
  sub _uri_escape {
      my($self, $string) = @_;
      $string =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
      $string;
  }
  
  sub _download_uri {
      my($self, $base, $distfile) = @_;
      join "/", $base, "authors/id", substr($distfile, 0, 1), substr($distfile, 0, 2), $distfile;
  }
  
  sub index_age { return time }    # pretend always current
  
  sub search_authors { return }    # not supported
  
  1;
  
  =for Pod::Coverage attributes validate_attributes search_packages search_authors BUILD
  
  =head1 SYNOPSIS
  
    use CPAN::Common::Index::MetaCPAN;
  
    $index = CPAN::Common::Index::MetaCPAN->new({ include_dev => 1 });
    $index->search_packages({ package => "Moose", version => "1.1" });
    $index->search_packages({ package => "Moose", version_range => ">= 1.1, < 2" });
  
  =head1 DESCRIPTION
  
  This module implements a CPAN::Common::Index that searches for packages against
  the MetaCPAN API.
  
  This backend supports searching modules with a version range (as
  specified in L<CPAN::Meta::Spec>) which is translated into MetaCPAN
  search query.
  
  There is also a support for I<dev> release search, by passing
  C<include_dev> parameter to the index object.
  
  The result may include an optional field C<download_uri> which
  suggests a specific mirror URL to download from, which can be
  C<backpan.org> if the archive was deleted, or C<cpan.metacpan.org> if
  the release date is within 1 day (because some mirrors might not have
  synced it yet).
  
  There is no support for searching packages with a regular expression, nor searching authors.
  
  =cut
  
  # vim: ts=4 sts=4 sw=4 et:
MENLO_INDEX_METACPAN

$fatpacked{"Menlo/Index/MetaDB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_METADB';
  use 5.008001;
  use strict;
  use warnings;
  
  package Menlo::Index::MetaDB;
  # ABSTRACT: Search index via CPAN MetaDB
  
  our $VERSION = "1.9019";
  
  use parent 'CPAN::Common::Index';
  
  use Class::Tiny qw/uri/;
  
  use Carp;
  use CPAN::Meta::YAML;
  use CPAN::Meta::Requirements;
  use HTTP::Tiny;
  
  sub BUILD {
      my $self = shift;
      my $uri  = $self->uri;
      $uri = "http://cpanmetadb.plackperl.org/v1.0/"
        unless defined $uri;
      # ensure URI ends in '/'
      $uri =~ s{/?$}{/};
      $self->uri($uri);
      return;
  }
  
  sub search_packages {
      my ( $self, $args ) = @_;
      Carp::croak("Argument to search_packages must be hash reference")
        unless ref $args eq 'HASH';
  
      return
        unless exists $args->{package} && ref $args->{package} eq '';
  
      my $mod = $args->{package};
  
      if ($args->{version} || $args->{version_range}) {
          my $res = HTTP::Tiny->new->get( $self->uri . "history/$mod" );
          return unless $res->{success};
  
          my $range = defined $args->{version} ? "== $args->{version}" : $args->{version_range};
          my $reqs = CPAN::Meta::Requirements->from_string_hash({ $mod => $range });
  
          my @found;
          for my $line ( split /\r?\n/, $res->{content} ) {
              if ($line =~ /^$mod\s+(\S+)\s+(\S+)$/) {
                  push @found, {
                      version => $1,
                      version_o => version::->parse($1),
                      distfile => $2,
                  };
              }
          }
  
          return unless @found;
          $found[-1]->{latest} = 1;
  
          my $match;
          for my $try (sort { $b->{version_o} <=> $a->{version_o} } @found) {
              if ($reqs->accepts_module($mod => $try->{version_o})) {
                  $match = $try, last;
              }
          }
  
          if ($match) {
              my $file = $match->{distfile};
              $file =~ s{^./../}{}; # strip leading
              return {
                  package => $mod,
                  version => $match->{version},
                  uri     => "cpan:///distfile/$file",
                  ($match->{latest} ? () :
                     (download_uri => "http://backpan.perl.org/authors/id/$match->{distfile}")),
              };
          }
      } else {
          my $res = HTTP::Tiny->new->get( $self->uri . "package/$mod" );
          return unless $res->{success};
  
          if ( my $yaml = CPAN::Meta::YAML->read_string( $res->{content} ) ) {
              my $meta = $yaml->[0];
              if ( $meta && $meta->{distfile} ) {
                  my $file = $meta->{distfile};
                  $file =~ s{^./../}{}; # strip leading
                  return {
                      package => $mod,
                      version => $meta->{version},
                      uri     => "cpan:///distfile/$file",
                  };
              }
          }
      }
  
      return;
  }
  
  sub index_age { return time };    # pretend always current
  
  sub search_authors { return };    # not supported
  
  1;
  
  =for Pod::Coverage attributes validate_attributes search_packages search_authors BUILD
  
  =head1 SYNOPSIS
  
    use CPAN::Common::Index::MetaDB;
  
    $index = CPAN::Common::Index::MetaDB->new;
  
    $index->search_packages({ package => "Moose" });
    $index->search_packages({ package => "Moose", version_range => ">= 2.0" });
  
  =head1 DESCRIPTION
  
  This module implements a CPAN::Common::Index that searches for packages against
  the same CPAN MetaDB API used by L<cpanminus>.
  
  There is no support for advanced package queries or searching authors.  It just
  takes a package name and returns the corresponding version and distribution.
  
  =cut
  
  # vim: ts=4 sts=4 sw=4 et:
MENLO_INDEX_METADB

$fatpacked{"Menlo/Index/Mirror.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_MIRROR';
  package Menlo::Index::Mirror;
  use strict;
  use parent qw(CPAN::Common::Index::Mirror);
  use Class::Tiny qw(fetcher);
  
  use File::Basename ();
  use File::Spec ();
  use URI ();
  
  our $HAS_IO_UNCOMPRESS_GUNZIP = eval { require IO::Uncompress::Gunzip };
  
  my %INDICES = (
  #    mailrc   => 'authors/01mailrc.txt.gz',
      packages => 'modules/02packages.details.txt.gz',
  );
  
  sub refresh_index {
      my $self = shift;
      for my $file ( values %INDICES ) {
          my $remote = URI->new_abs( $file, $self->mirror );
          $remote =~ s/\.gz$//
            unless $HAS_IO_UNCOMPRESS_GUNZIP;
          my $local = File::Spec->catfile( $self->cache, File::Basename::basename($file) );
          $self->fetcher->($remote, $local)
            or Carp::croak( "Cannot fetch $remote to $local");
          if ($HAS_IO_UNCOMPRESS_GUNZIP) {
              ( my $uncompressed = $local ) =~ s/\.gz$//;
              IO::Uncompress::Gunzip::gunzip( $local, $uncompressed )
                or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n";
          }
      }
  }
  
  1;
MENLO_INDEX_MIRROR

$fatpacked{"Menlo/Legacy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_LEGACY';
  package Menlo::Legacy;
  
  use strict;
  our $VERSION = '1.9022';
  
  1;
  __END__
  
  =encoding utf-8
  
  =head1 NAME
  
  Menlo::Legacy - Legacy internal and client support for Menlo
  
  =head1 DESCRIPTION
  
  Menlo::Legacy is a package to install L<Menlo::CLI::Compat> which is a
  compatibility library that implements the classic version of cpanminus
  internals and behavios. This is so that existing users of cpanm and
  API clients such as L<Carton>, L<Carmel> and L<App::cpm>) can rely on
  the stable features and specific behaviors of cpanm.
  
  This way Menlo can evolve and be refactored without the fear of
  breaking any downstream clients, including C<cpanm> itself.
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2018- Tatsuhiko Miyagawa
  
  =head1 LICENSE
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 SEE ALSO
  
  L<Menlo::CLI::Compat>
  
  =cut
MENLO_LEGACY

$fatpacked{"Menlo/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_UTIL';
  package Menlo::Util;
  use strict;
  
  use Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT_OK = qw(WIN32);
  
  use constant WIN32 => $^O eq 'MSWin32';
  
  if (WIN32) {
      require Win32::ShellQuote;
      *shell_quote = \&Win32::ShellQuote::quote_native;
  } else {
      require String::ShellQuote;
      *shell_quote = \&String::ShellQuote::shell_quote_best_effort;
  }
  
  1;
  
MENLO_UTIL

$fatpacked{"Module/CPANfile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE';
  package Module::CPANfile;
  use strict;
  use warnings;
  use Cwd;
  use Carp ();
  use Module::CPANfile::Environment;
  use Module::CPANfile::Requirement;
  
  our $VERSION = '1.1004';
  
  BEGIN {
      if (${^TAINT}) {
          *untaint = sub {
              my $str = shift;
              ($str) = $str =~ /^(.+)$/s;
              $str;
          };
      } else {
          *untaint = sub { $_[0] };
      }
  }
  
  sub new {
      my($class, $file) = @_;
      bless {}, $class;
  }
  
  sub load {
      my($proto, $file) = @_;
  
      my $self = ref $proto ? $proto : $proto->new;
      $self->parse($file || _default_cpanfile());
      $self;
  }
  
  sub save {
      my($self, $path) = @_;
  
      open my $out, ">", $path or die "$path: $!";
      print {$out} $self->to_string;
  }
  
  sub parse {
      my($self, $file) = @_;
  
      my $code = do {
          open my $fh, "<", $file or die "$file: $!";
          join '', <$fh>;
      };
  
      $code = untaint $code;
  
      my $env = Module::CPANfile::Environment->new($file);
      $env->parse($code) or die $@;
  
      $self->{_mirrors} = $env->mirrors;
      $self->{_prereqs} = $env->prereqs;
  }
  
  sub from_prereqs {
      my($proto, $prereqs) = @_;
  
      my $self = $proto->new;
      $self->{_prereqs} = Module::CPANfile::Prereqs->from_cpan_meta($prereqs);
  
      $self;
  }
  
  sub mirrors {
      my $self = shift;
      $self->{_mirrors} || [];
  }
  
  sub features {
      my $self = shift;
      map $self->feature($_), $self->{_prereqs}->identifiers;
  }
  
  sub feature {
      my($self, $identifier) = @_;
      $self->{_prereqs}->feature($identifier);
  }
  
  sub prereq { shift->prereqs }
  
  sub prereqs {
      my $self = shift;
      $self->{_prereqs}->as_cpan_meta;
  }
  
  sub merged_requirements {
      my $self = shift;
      $self->{_prereqs}->merged_requirements;
  }
  
  sub effective_prereqs {
      my($self, $features) = @_;
      $self->prereqs_with(@{$features || []});
  }
  
  sub prereqs_with {
      my($self, @feature_identifiers) = @_;
  
      my @others = map { $self->feature($_)->prereqs } @feature_identifiers;
      $self->prereqs->with_merged_prereqs(\@others);
  }
  
  sub prereq_specs {
      my $self = shift;
      $self->prereqs->as_string_hash;
  }
  
  sub prereq_for_module {
      my($self, $module) = @_;
      $self->{_prereqs}->find($module);
  }
  
  sub options_for_module {
      my($self, $module) = @_;
      my $prereq = $self->prereq_for_module($module) or return;
      $prereq->requirement->options;
  }
  
  sub merge_meta {
      my($self, $file, $version) = @_;
  
      require CPAN::Meta;
  
      $version ||= $file =~ /\.yml$/ ? '1.4' : '2';
  
      my $prereq = $self->prereqs;
  
      my $meta = CPAN::Meta->load_file($file);
      my $prereqs_hash = $prereq->with_merged_prereqs($meta->effective_prereqs)->as_string_hash;
      my $struct = { %{$meta->as_struct}, prereqs => $prereqs_hash };
  
      CPAN::Meta->new($struct)->save($file, { version => $version });
  }
  
  sub _d($) {
      require Data::Dumper;
      chomp(my $value = Data::Dumper->new([$_[0]])->Terse(1)->Dump);
      $value;
  }
  
  sub _default_cpanfile {
      my $file = Cwd::abs_path('cpanfile');
      untaint $file;
  }
  
  sub to_string {
      my($self, $include_empty) = @_;
  
      my $mirrors = $self->mirrors;
      my $prereqs = $self->prereq_specs;
  
      my $code = '';
      $code .= $self->_dump_mirrors($mirrors);
      $code .= $self->_dump_prereqs($prereqs, $include_empty);
  
      for my $feature ($self->features) {
          $code .= "feature @{[ _d $feature->{identifier} ]}, @{[ _d $feature->{description} ]} => sub {\n";
          $code .= $self->_dump_prereqs($feature->{prereqs}->as_string_hash, $include_empty, 4);
          $code .= "};\n\n";
      }
  
      $code =~ s/\n+$/\n/s;
      $code;
  }
  
  sub _dump_mirrors {
      my($self, $mirrors) = @_;
  
      my $code = "";
  
      for my $url (@$mirrors) {
          $code .= "mirror @{[ _d $url ]};\n";
      }
  
      $code =~ s/\n+$/\n/s;
      $code;
  }
  
  sub _dump_prereqs {
      my($self, $prereqs, $include_empty, $base_indent) = @_;
  
      my $code = '';
      for my $phase (qw(runtime configure build test develop)) {
          my $indent = $phase eq 'runtime' ? '' : '    ';
          $indent .= (' ' x ($base_indent || 0));
  
          my($phase_code, $requirements);
          $phase_code .= "on $phase => sub {\n" unless $phase eq 'runtime';
  
          for my $type (qw(requires recommends suggests conflicts)) {
              for my $mod (sort keys %{$prereqs->{$phase}{$type}}) {
                  my $ver = $prereqs->{$phase}{$type}{$mod};
                  $phase_code .= $ver eq '0'
                               ? "${indent}$type @{[ _d $mod ]}"
                               : "${indent}$type @{[ _d $mod ]}, @{[ _d $ver ]}";
  
                  my $options = $self->options_for_module($mod) || {};
                  if (%$options) {
                      my @opts;
                      for my $key (keys %$options) {
                          my $k = $key =~ /^[a-zA-Z0-9_]+$/ ? $key : _d $key;
                          push @opts, "$k => @{[ _d $options->{$k} ]}";
                      }
  
                      $phase_code .= ",\n" . join(",\n", map "  $indent$_", @opts);
                  }
  
                  $phase_code .= ";\n";
                  $requirements++;
              }
          }
  
          $phase_code .= "\n" unless $requirements;
          $phase_code .= "};\n" unless $phase eq 'runtime';
  
          $code .= $phase_code . "\n" if $requirements or $include_empty;
      }
  
      $code =~ s/\n+$/\n/s;
      $code;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Module::CPANfile - Parse cpanfile
  
  =head1 SYNOPSIS
  
    use Module::CPANfile;
  
    my $file = Module::CPANfile->load("cpanfile");
    my $prereqs = $file->prereqs; # CPAN::Meta::Prereqs object
  
    my @features = $file->features; # CPAN::Meta::Feature objects
    my $merged_prereqs = $file->prereqs_with(@identifiers); # CPAN::Meta::Prereqs
  
    $file->merge_meta('MYMETA.json');
  
  =head1 DESCRIPTION
  
  Module::CPANfile is a tool to handle L<cpanfile> format to load application
  specific dependencies, not just for CPAN distributions.
  
  =head1 METHODS
  
  =over 4
  
  =item load
  
    $file = Module::CPANfile->load;
    $file = Module::CPANfile->load('cpanfile');
  
  Load and parse a cpanfile. By default it tries to load C<cpanfile> in
  the current directory, unless you pass the path to its argument.
  
  =item from_prereqs
  
    $file = Module::CPANfile->from_prereqs({
      runtime => { requires => { DBI => '1.000' } },
    });
  
  Creates a new Module::CPANfile object from prereqs hash you can get
  via L<CPAN::Meta>'s C<prereqs>, or L<CPAN::Meta::Prereqs>'
  C<as_string_hash>.
  
    # read MYMETA, then feed the prereqs to create Module::CPANfile
    my $meta = CPAN::Meta->load_file('MYMETA.json');
    my $file = Module::CPANfile->from_prereqs($meta->prereqs);
  
    # load cpanfile, then recreate it with round-trip
    my $file = Module::CPANfile->load('cpanfile');
    $file = Module::CPANfile->from_prereqs($file->prereq_specs);
                                      # or $file->prereqs->as_string_hash
  
  =item prereqs
  
  Returns L<CPAN::Meta::Prereqs> object out of the parsed cpanfile.
  
  =item prereq_specs
  
  Returns a hash reference that should be passed to C<< CPAN::Meta::Prereqs->new >>.
  
  =item features
  
  Returns a list of features available in the cpanfile as L<CPAN::Meta::Feature>.
  
  =item prereqs_with(@identifiers), effective_prereqs(\@identifiers)
  
  Returns L<CPAN::Meta::Prereqs> object, with merged prereqs for
  features identified with the C<@identifiers>.
  
  =item to_string($include_empty)
  
    $file->to_string;
    $file->to_string(1);
  
  Returns a canonical string (code) representation for cpanfile. Useful
  if you want to convert L<CPAN::Meta::Prereqs> to a new cpanfile.
  
    # read MYMETA's prereqs and print cpanfile representation of it
    my $meta = CPAN::Meta->load_file('MYMETA.json');
    my $file = Module::CPANfile->from_prereqs($meta->prereqs);
    print $file->to_string;
  
  By default, it omits the phase where there're no modules
  registered. If you pass the argument of a true value, it will print
  them as well.
  
  =item save
  
    $file->save('cpanfile');
  
  Saves the currently loaded prereqs as a new C<cpanfile> by calling
  C<to_string>. Beware B<this method will overwrite the existing
  cpanfile without any warning or backup>. Taking a backup or giving
  warnings to users is a caller's responsibility.
  
    # Read MYMETA.json and creates a new cpanfile
    my $meta = CPAN::Meta->load_file('MYMETA.json');
    my $file = Module::CPANfile->from_prereqs($meta->prereqs);
    $file->save('cpanfile');
  
  =item merge_meta
  
    $file->merge_meta('META.yml');
    $file->merge_meta('MYMETA.json', '2.0');
  
  Merge the effective prereqs with Meta specification loaded from the
  given META file, using CPAN::Meta. You can specify the META spec
  version in the second argument, which defaults to 1.4 in case the
  given file is YAML, and 2 if it is JSON.
  
  =item options_for_module
  
    my $options = $file->options_for_module($module);
  
  Returns the extra options specified for a given module as a hash
  reference. Returns C<undef> when the given module is not specified in
  the C<cpanfile>.
  
  For example,
  
    # cpanfile
    requires 'Plack', '1.000',
      dist => "MIYAGAWA/Plack-1.000.tar.gz";
  
    # ...
    my $file = Module::CPANfile->load;
    my $options = $file->options_for_module('Plack');
    # => { dist => "MIYAGAWA/Plack-1.000.tar.gz" }
  
  =back
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa
  
  =head1 SEE ALSO
  
  L<cpanfile>, L<CPAN::Meta>, L<CPAN::Meta::Spec>
  
  =cut
MODULE_CPANFILE

$fatpacked{"Module/CPANfile/Environment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_ENVIRONMENT';
  package Module::CPANfile::Environment;
  use strict;
  use warnings;
  use Module::CPANfile::Prereqs;
  use Carp ();
  
  my @bindings = qw(
      on requires recommends suggests conflicts
      feature
      osname
      mirror
      configure_requires build_requires test_requires author_requires
  );
  
  my $file_id = 1;
  
  sub new {
      my($class, $file) = @_;
      bless {
          file     => $file,
          phase    => 'runtime', # default phase
          feature  => undef,
          features => {},
          prereqs  => Module::CPANfile::Prereqs->new,
          mirrors  => [],
      }, $class;
  }
  
  sub bind {
      my $self = shift;
      my $pkg = caller;
  
      for my $binding (@bindings) {
          no strict 'refs';
          *{"$pkg\::$binding"} = sub { $self->$binding(@_) };
      }
  }
  
  sub parse {
      my($self, $code) = @_;
  
      my $err;
      {
          local $@;
          $file_id++;
          $self->_evaluate(<<EVAL);
  package Module::CPANfile::Sandbox$file_id;
  no warnings;
  BEGIN { \$_environment->bind }
  
  # line 1 "$self->{file}"
  $code;
  EVAL
          $err = $@;
      }
  
      if ($err) { die "Parsing $self->{file} failed: $err" };
  
      return 1;
  }
  
  sub _evaluate {
      my $_environment = $_[0];
      eval $_[1];
  }
  
  sub prereqs { $_[0]->{prereqs} }
  
  sub mirrors { $_[0]->{mirrors} }
  
  # DSL goes from here
  
  sub on {
      my($self, $phase, $code) = @_;
      local $self->{phase} = $phase;
      $code->();
  }
  
  sub feature {
      my($self, $identifier, $description, $code) = @_;
  
      # shortcut: feature identifier => sub { ... }
      if (@_ == 3 && ref($description) eq 'CODE') {
          $code = $description;
          $description = $identifier;
      }
  
      unless (ref $description eq '' && ref $code eq 'CODE') {
          Carp::croak("Usage: feature 'identifier', 'Description' => sub { ... }");
      }
  
      local $self->{feature} = $identifier;
      $self->prereqs->add_feature($identifier, $description);
  
      $code->();
  }
  
  sub osname { die "TODO" }
  
  sub mirror {
      my($self, $url) = @_;
      push @{$self->{mirrors}}, $url;
  }
  
  sub requirement_for {
      my($self, $module, @args) = @_;
  
      my $requirement = 0;
      $requirement = shift @args if @args % 2;
  
      return Module::CPANfile::Requirement->new(
          name    => $module,
          version => $requirement,
          @args,
      );
  }
  
  sub requires {
      my $self = shift;
      $self->add_prereq(requires => @_);
  }
  
  sub recommends {
      my $self = shift;
      $self->add_prereq(recommends => @_);
  }
  
  sub suggests {
      my $self = shift;
      $self->add_prereq(suggests => @_);
  }
  
  sub conflicts {
      my $self = shift;
      $self->add_prereq(conflicts => @_);
  }
  
  sub add_prereq {
      my($self, $type, $module, @args) = @_;
  
      $self->prereqs->add(
          feature => $self->{feature},
          phase   => $self->{phase},
          type    => $type,
          module  => $module,
          requirement => $self->requirement_for($module, @args),
      );
  }
  
  # Module::Install compatible shortcuts
  
  sub configure_requires {
      my($self, @args) = @_;
      $self->on(configure => sub { $self->requires(@args) });
  }
  
  sub build_requires {
      my($self, @args) = @_;
      $self->on(build => sub { $self->requires(@args) });
  }
  
  sub test_requires {
      my($self, @args) = @_;
      $self->on(test => sub { $self->requires(@args) });
  }
  
  sub author_requires {
      my($self, @args) = @_;
      $self->on(develop => sub { $self->requires(@args) });
  }
  
  1;
  
MODULE_CPANFILE_ENVIRONMENT

$fatpacked{"Module/CPANfile/Prereq.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_PREREQ';
  package Module::CPANfile::Prereq;
  use strict;
  
  sub new {
      my($class, %options) = @_;
      bless \%options, $class;
  }
  
  sub feature { $_[0]->{feature} }
  sub phase   { $_[0]->{phase} }
  sub type    { $_[0]->{type} }
  sub module  { $_[0]->{module} }
  sub requirement { $_[0]->{requirement} }
  
  1;
MODULE_CPANFILE_PREREQ

$fatpacked{"Module/CPANfile/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_PREREQS';
  package Module::CPANfile::Prereqs;
  use strict;
  use Carp ();
  use CPAN::Meta::Feature;
  use Module::CPANfile::Prereq;
  
  sub from_cpan_meta {
      my($class, $prereqs) = @_;
  
      my $self = $class->new;
  
      for my $phase (keys %$prereqs) {
          for my $type (keys %{ $prereqs->{$phase} }) {
              while (my($module, $requirement) = each %{ $prereqs->{$phase}{$type} }) {
                  $self->add(
                      phase => $phase,
                      type  => $type,
                      module => $module,
                      requirement => Module::CPANfile::Requirement->new(name => $module, version => $requirement),
                  );
              }
          }
      }
  
      $self;
  }
  
  sub new {
      my $class = shift;
      bless {
          prereqs => {},
          features => {},
      }, $class;
  }
  
  sub add_feature {
      my($self, $identifier, $description) = @_;
      $self->{features}{$identifier} = { description => $description };
  }
  
  sub add {
      my($self, %args) = @_;
  
      my $feature = $args{feature} || '';
      push @{$self->{prereqs}{$feature}},
        Module::CPANfile::Prereq->new(%args);
  }
  
  sub as_cpan_meta {
      my $self = shift;
      $self->{cpanmeta} ||= $self->build_cpan_meta;
  }
  
  sub build_cpan_meta {
      my($self, $feature) = @_;
      CPAN::Meta::Prereqs->new($self->specs($feature));
  }
  
  sub specs {
      my($self, $feature) = @_;
  
      $feature = ''
        unless defined $feature;
  
      my $prereqs = $self->{prereqs}{$feature} || [];
      my $specs = {};
  
      for my $prereq (@$prereqs) {
           $specs->{$prereq->phase}{$prereq->type}{$prereq->module} =
             $prereq->requirement->version;
      }
  
      return $specs;
  }
  
  sub merged_requirements {
      my $self = shift;
  
      my $reqs = CPAN::Meta::Requirements->new;
      for my $prereq (@{$self->{prereqs}}) {
          $reqs->add_string_requirement($prereq->module, $prereq->requirement->version);
      }
  
      $reqs;
  }
  
  sub find {
      my($self, $module) = @_;
  
      for my $feature ('', keys %{$self->{features}}) {
          for my $prereq (@{$self->{prereqs}{$feature}}) {
              return $prereq if $prereq->module eq $module;
          }
      }
  
      return;
  }
  
  sub identifiers {
      my $self = shift;
      keys %{$self->{features}};
  }
  
  sub feature {
      my($self, $identifier) = @_;
  
      my $data = $self->{features}{$identifier}
        or Carp::croak("Unknown feature '$identifier'");
  
      my $prereqs = $self->build_cpan_meta($identifier);
  
      CPAN::Meta::Feature->new($identifier, {
          description => $data->{description},
          prereqs => $prereqs->as_string_hash,
      });
  }
  
  1;
MODULE_CPANFILE_PREREQS

$fatpacked{"Module/CPANfile/Requirement.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_REQUIREMENT';
  package Module::CPANfile::Requirement;
  use strict;
  
  sub new {
      my ($class, %args) = @_;
  
      $args{version} ||= 0;
  
      bless +{
          name    => delete $args{name},
          version => delete $args{version},
          options => \%args,
      }, $class;
  }
  
  sub name    { $_[0]->{name} }
  sub version { $_[0]->{version} }
  
  sub options { $_[0]->{options} }
  
  sub has_options {
      keys %{$_[0]->{options}} > 0;
  }
  
  1;
MODULE_CPANFILE_REQUIREMENT

$fatpacked{"Module/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_METADATA';
  # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
  # vim:ts=8:sw=2:et:sta:sts=2:tw=78
  package Module::Metadata; # git description: v1.000035-3-gaa51be1
  # ABSTRACT: Gather package and POD information from perl module files
  
  # Adapted from Perl-licensed code originally distributed with
  # Module-Build by Ken Williams
  
  # This module provides routines to gather information about
  # perl modules (assuming this may be expanded in the distant
  # parrot future to look at other types of modules).
  
  sub __clean_eval { eval $_[0] }
  use strict;
  use warnings;
  
  our $VERSION = '1.000036';
  
  use Carp qw/croak/;
  use File::Spec;
  BEGIN {
         # Try really hard to not depend ony any DynaLoaded module, such as IO::File or Fcntl
         eval {
                 require Fcntl; Fcntl->import('SEEK_SET'); 1;
         } or *SEEK_SET = sub { 0 }
  }
  use version 0.87;
  BEGIN {
    if ($INC{'Log/Contextual.pm'}) {
      require "Log/Contextual/WarnLogger.pm"; # Hide from AutoPrereqs
      Log::Contextual->import('log_info',
        '-default_logger' => Log::Contextual::WarnLogger->new({ env_prefix => 'MODULE_METADATA', }),
      );
    }
    else {
      *log_info = sub (&) { warn $_[0]->() };
    }
  }
  use File::Find qw(find);
  
  my $V_NUM_REGEXP = qr{v?[0-9._]+};  # crudely, a v-string or decimal
  
  my $PKG_FIRST_WORD_REGEXP = qr{ # the FIRST word in a package name
    [a-zA-Z_]                     # the first word CANNOT start with a digit
      (?:
        [\w']?                    # can contain letters, digits, _, or ticks
        \w                        # But, NO multi-ticks or trailing ticks
      )*
  }x;
  
  my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name
    \w                           # the 2nd+ word CAN start with digits
      (?:
        [\w']?                   # and can contain letters or ticks
        \w                       # But, NO multi-ticks or trailing ticks
      )*
  }x;
  
  my $PKG_NAME_REGEXP = qr{ # match a package name
    (?: :: )?               # a pkg name can start with arisdottle
    $PKG_FIRST_WORD_REGEXP  # a package word
    (?:
      (?: :: )+             ### arisdottle (allow one or many times)
      $PKG_ADDL_WORD_REGEXP ### a package word
    )*                      # ^ zero, one or many times
    (?:
      ::                    # allow trailing arisdottle
    )?
  }x;
  
  my $PKG_REGEXP  = qr{   # match a package declaration
    ^[\s\{;]*             # intro chars on a line
    package               # the word 'package'
    \s+                   # whitespace
    ($PKG_NAME_REGEXP)    # a package name
    \s*                   # optional whitespace
    ($V_NUM_REGEXP)?        # optional version number
    \s*                   # optional whitesapce
    [;\{]                 # semicolon line terminator or block start (since 5.16)
  }x;
  
  my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
    ([\$*])         # sigil - $ or *
    (
      (             # optional leading package name
        (?:::|\')?  # possibly starting like just :: (a la $::VERSION)
        (?:\w+(?:::|\'))*  # Foo::Bar:: ...
      )?
      VERSION
    )\b
  }x;
  
  my $VERS_REGEXP = qr{ # match a VERSION definition
    (?:
      \(\s*$VARNAME_REGEXP\s*\) # with parens
    |
      $VARNAME_REGEXP           # without parens
    )
    \s*
    =[^=~>]  # = but not ==, nor =~, nor =>
  }x;
  
  sub new_from_file {
    my $class    = shift;
    my $filename = File::Spec->rel2abs( shift );
  
    return undef unless defined( $filename ) && -f $filename;
    return $class->_init(undef, $filename, @_);
  }
  
  sub new_from_handle {
    my $class    = shift;
    my $handle   = shift;
    my $filename = shift;
    return undef unless defined($handle) && defined($filename);
    $filename = File::Spec->rel2abs( $filename );
  
    return $class->_init(undef, $filename, @_, handle => $handle);
  
  }
  
  
  sub new_from_module {
    my $class   = shift;
    my $module  = shift;
    my %props   = @_;
  
    $props{inc} ||= \@INC;
    my $filename = $class->find_module_by_name( $module, $props{inc} );
    return undef unless defined( $filename ) && -f $filename;
    return $class->_init($module, $filename, %props);
  }
  
  {
  
    my $compare_versions = sub {
      my ($v1, $op, $v2) = @_;
      $v1 = version->new($v1)
        unless UNIVERSAL::isa($v1,'version');
  
      my $eval_str = "\$v1 $op \$v2";
      my $result   = eval $eval_str;
      log_info { "error comparing versions: '$eval_str' $@" } if $@;
  
      return $result;
    };
  
    my $normalize_version = sub {
      my ($version) = @_;
      if ( $version =~ /[=<>!,]/ ) { # logic, not just version
        # take as is without modification
      }
      elsif ( ref $version eq 'version' ) { # version objects
        $version = $version->is_qv ? $version->normal : $version->stringify;
      }
      elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
        # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
        $version = "v$version";
      }
      else {
        # leave alone
      }
      return $version;
    };
  
    # separate out some of the conflict resolution logic
  
    my $resolve_module_versions = sub {
      my $packages = shift;
  
      my( $file, $version );
      my $err = '';
        foreach my $p ( @$packages ) {
          if ( defined( $p->{version} ) ) {
            if ( defined( $version ) ) {
              if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
                $err .= "  $p->{file} ($p->{version})\n";
              }
              else {
                # same version declared multiple times, ignore
              }
            }
            else {
              $file    = $p->{file};
              $version = $p->{version};
            }
          }
        $file ||= $p->{file} if defined( $p->{file} );
      }
  
      if ( $err ) {
        $err = "  $file ($version)\n" . $err;
      }
  
      my %result = (
        file    => $file,
        version => $version,
        err     => $err
      );
  
      return \%result;
    };
  
    sub provides {
      my $class = shift;
  
      croak "provides() requires key/value pairs \n" if @_ % 2;
      my %args = @_;
  
      croak "provides() takes only one of 'dir' or 'files'\n"
        if $args{dir} && $args{files};
  
      croak "provides() requires a 'version' argument"
        unless defined $args{version};
  
      croak "provides() does not support version '$args{version}' metadata"
          unless grep $args{version} eq $_, qw/1.4 2/;
  
      $args{prefix} = 'lib' unless defined $args{prefix};
  
      my $p;
      if ( $args{dir} ) {
        $p = $class->package_versions_from_directory($args{dir});
      }
      else {
        croak "provides() requires 'files' to be an array reference\n"
          unless ref $args{files} eq 'ARRAY';
        $p = $class->package_versions_from_directory($args{files});
      }
  
      # Now, fix up files with prefix
      if ( length $args{prefix} ) { # check in case disabled with q{}
        $args{prefix} =~ s{/$}{};
        for my $v ( values %$p ) {
          $v->{file} = "$args{prefix}/$v->{file}";
        }
      }
  
      return $p
    }
  
    sub package_versions_from_directory {
      my ( $class, $dir, $files ) = @_;
  
      my @files;
  
      if ( $files ) {
        @files = @$files;
      }
      else {
        find( {
          wanted => sub {
            push @files, $_ if -f $_ && /\.pm$/;
          },
          no_chdir => 1,
        }, $dir );
      }
  
      # First, we enumerate all packages & versions,
      # separating into primary & alternative candidates
      my( %prime, %alt );
      foreach my $file (@files) {
        my $mapped_filename = File::Spec->abs2rel( $file, $dir );
        my @path = File::Spec->splitdir( $mapped_filename );
        (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
  
        my $pm_info = $class->new_from_file( $file );
  
        foreach my $package ( $pm_info->packages_inside ) {
          next if $package eq 'main';  # main can appear numerous times, ignore
          next if $package eq 'DB';    # special debugging package, ignore
          next if grep /^_/, split( /::/, $package ); # private package, ignore
  
          my $version = $pm_info->version( $package );
  
          $prime_package = $package if lc($prime_package) eq lc($package);
          if ( $package eq $prime_package ) {
            if ( exists( $prime{$package} ) ) {
              croak "Unexpected conflict in '$package'; multiple versions found.\n";
            }
            else {
              $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename);
              $prime{$package}{file} = $mapped_filename;
              $prime{$package}{version} = $version if defined( $version );
            }
          }
          else {
            push( @{$alt{$package}}, {
                                      file    => $mapped_filename,
                                      version => $version,
                                     } );
          }
        }
      }
  
      # Then we iterate over all the packages found above, identifying conflicts
      # and selecting the "best" candidate for recording the file & version
      # for each package.
      foreach my $package ( keys( %alt ) ) {
        my $result = $resolve_module_versions->( $alt{$package} );
  
        if ( exists( $prime{$package} ) ) { # primary package selected
  
          if ( $result->{err} ) {
          # Use the selected primary package, but there are conflicting
          # errors among multiple alternative packages that need to be
          # reported
            log_info {
              "Found conflicting versions for package '$package'\n" .
              "  $prime{$package}{file} ($prime{$package}{version})\n" .
              $result->{err}
            };
  
          }
          elsif ( defined( $result->{version} ) ) {
          # There is a primary package selected, and exactly one
          # alternative package
  
          if ( exists( $prime{$package}{version} ) &&
               defined( $prime{$package}{version} ) ) {
            # Unless the version of the primary package agrees with the
            # version of the alternative package, report a conflict
          if ( $compare_versions->(
                   $prime{$package}{version}, '!=', $result->{version}
                 )
               ) {
  
              log_info {
                "Found conflicting versions for package '$package'\n" .
                "  $prime{$package}{file} ($prime{$package}{version})\n" .
                "  $result->{file} ($result->{version})\n"
              };
            }
  
          }
          else {
            # The prime package selected has no version so, we choose to
            # use any alternative package that does have a version
            $prime{$package}{file}    = $result->{file};
            $prime{$package}{version} = $result->{version};
          }
  
          }
          else {
          # no alt package found with a version, but we have a prime
          # package so we use it whether it has a version or not
          }
  
        }
        else { # No primary package was selected, use the best alternative
  
          if ( $result->{err} ) {
            log_info {
              "Found conflicting versions for package '$package'\n" .
              $result->{err}
            };
          }
  
          # Despite possible conflicting versions, we choose to record
          # something rather than nothing
          $prime{$package}{file}    = $result->{file};
          $prime{$package}{version} = $result->{version}
            if defined( $result->{version} );
        }
      }
  
      # Normalize versions.  Can't use exists() here because of bug in YAML::Node.
      # XXX "bug in YAML::Node" comment seems irrelevant -- dagolden, 2009-05-18
      for (grep defined $_->{version}, values %prime) {
        $_->{version} = $normalize_version->( $_->{version} );
      }
  
      return \%prime;
    }
  }
  
  
  sub _init {
    my $class    = shift;
    my $module   = shift;
    my $filename = shift;
    my %props = @_;
  
    my $handle = delete $props{handle};
    my( %valid_props, @valid_props );
    @valid_props = qw( collect_pod inc );
    @valid_props{@valid_props} = delete( @props{@valid_props} );
    warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
  
    my %data = (
      module       => $module,
      filename     => $filename,
      version      => undef,
      packages     => [],
      versions     => {},
      pod          => {},
      pod_headings => [],
      collect_pod  => 0,
  
      %valid_props,
    );
  
    my $self = bless(\%data, $class);
  
    if ( not $handle ) {
      my $filename = $self->{filename};
      open $handle, '<', $filename
        or croak( "Can't open '$filename': $!" );
  
      $self->_handle_bom($handle, $filename);
    }
    $self->_parse_fh($handle);
  
    @{$self->{packages}} = __uniq(@{$self->{packages}});
  
    unless($self->{module} and length($self->{module})) {
      # CAVEAT (possible TODO): .pmc files not treated the same as .pm
      if ($self->{filename} =~ /\.pm$/) {
        my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
        $f =~ s/\..+$//;
        my @candidates = grep /(^|::)$f$/, @{$self->{packages}};
        $self->{module} = shift(@candidates); # this may be undef
      }
      else {
        # this seems like an atrocious heuristic, albeit marginally better than
        # what was here before. It should be rewritten entirely to be more like
        # "if it's not a .pm file, it's not require()able as a name, therefore
        # name() should be undef."
        if ((grep /main/, @{$self->{packages}})
            or (grep /main/, keys %{$self->{versions}})) {
          $self->{module} = 'main';
        }
        else {
          # TODO: this should maybe default to undef instead
          $self->{module} = $self->{packages}[0] || '';
        }
      }
    }
  
    $self->{version} = $self->{versions}{$self->{module}}
      if defined( $self->{module} );
  
    return $self;
  }
  
  # class method
  sub _do_find_module {
    my $class   = shift;
    my $module  = shift || croak 'find_module_by_name() requires a package name';
    my $dirs    = shift || \@INC;
  
    my $file = File::Spec->catfile(split( /::/, $module));
    foreach my $dir ( @$dirs ) {
      my $testfile = File::Spec->catfile($dir, $file);
      return [ File::Spec->rel2abs( $testfile ), $dir ]
        if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
      # CAVEAT (possible TODO): .pmc files are not discoverable here
      $testfile .= '.pm';
      return [ File::Spec->rel2abs( $testfile ), $dir ]
        if -e $testfile;
    }
    return;
  }
  
  # class method
  sub find_module_by_name {
    my $found = shift()->_do_find_module(@_) or return;
    return $found->[0];
  }
  
  # class method
  sub find_module_dir_by_name {
    my $found = shift()->_do_find_module(@_) or return;
    return $found->[1];
  }
  
  
  # given a line of perl code, attempt to parse it if it looks like a
  # $VERSION assignment, returning sigil, full name, & package name
  sub _parse_version_expression {
    my $self = shift;
    my $line = shift;
  
    my( $sigil, $variable_name, $package);
    if ( $line =~ /$VERS_REGEXP/o ) {
      ( $sigil, $variable_name, $package) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
      if ( $package ) {
        $package = ($package eq '::') ? 'main' : $package;
        $package =~ s/::$//;
      }
    }
  
    return ( $sigil, $variable_name, $package );
  }
  
  # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
  # If there's one, then skip it and set the :encoding layer appropriately.
  sub _handle_bom {
    my ($self, $fh, $filename) = @_;
  
    my $pos = tell $fh;
    return unless defined $pos;
  
    my $buf = ' ' x 2;
    my $count = read $fh, $buf, length $buf;
    return unless defined $count and $count >= 2;
  
    my $encoding;
    if ( $buf eq "\x{FE}\x{FF}" ) {
      $encoding = 'UTF-16BE';
    }
    elsif ( $buf eq "\x{FF}\x{FE}" ) {
      $encoding = 'UTF-16LE';
    }
    elsif ( $buf eq "\x{EF}\x{BB}" ) {
      $buf = ' ';
      $count = read $fh, $buf, length $buf;
      if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
        $encoding = 'UTF-8';
      }
    }
  
    if ( defined $encoding ) {
      if ( "$]" >= 5.008 ) {
        binmode( $fh, ":encoding($encoding)" );
      }
    }
    else {
      seek $fh, $pos, SEEK_SET
        or croak( sprintf "Can't reset position to the top of '$filename'" );
    }
  
    return $encoding;
  }
  
  sub _parse_fh {
    my ($self, $fh) = @_;
  
    my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
    my( @packages, %vers, %pod, @pod );
    my $package = 'main';
    my $pod_sect = '';
    my $pod_data = '';
    my $in_end = 0;
  
    while (defined( my $line = <$fh> )) {
      my $line_num = $.;
  
      chomp( $line );
  
      # From toke.c : any line that begins by "=X", where X is an alphabetic
      # character, introduces a POD segment.
      my $is_cut;
      if ( $line =~ /^=([a-zA-Z].*)/ ) {
        my $cmd = $1;
        # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
        # character (which includes the newline, but here we chomped it away).
        $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
        $in_pod = !$is_cut;
      }
  
      if ( $in_pod ) {
  
        if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
          push( @pod, $1 );
          if ( $self->{collect_pod} && length( $pod_data ) ) {
            $pod{$pod_sect} = $pod_data;
            $pod_data = '';
          }
          $pod_sect = $1;
        }
        elsif ( $self->{collect_pod} ) {
          $pod_data .= "$line\n";
        }
        next;
      }
      elsif ( $is_cut ) {
        if ( $self->{collect_pod} && length( $pod_data ) ) {
          $pod{$pod_sect} = $pod_data;
          $pod_data = '';
        }
        $pod_sect = '';
        next;
      }
  
      # Skip after __END__
      next if $in_end;
  
      # Skip comments in code
      next if $line =~ /^\s*#/;
  
      # Would be nice if we could also check $in_string or something too
      if ($line eq '__END__') {
        $in_end++;
        next;
      }
  
      last if $line eq '__DATA__';
  
      # parse $line to see if it's a $VERSION declaration
      my( $version_sigil, $version_fullname, $version_package ) =
        index($line, 'VERSION') >= 1
          ? $self->_parse_version_expression( $line )
          : ();
  
      if ( $line =~ /$PKG_REGEXP/o ) {
        $package = $1;
        my $version = $2;
        push( @packages, $package ) unless grep( $package eq $_, @packages );
        $need_vers = defined $version ? 0 : 1;
  
        if ( not exists $vers{$package} and defined $version ){
          # Upgrade to a version object.
          my $dwim_version = eval { _dwim_version($version) };
          croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n"
            unless defined $dwim_version;  # "0" is OK!
          $vers{$package} = $dwim_version;
        }
      }
  
      # VERSION defined with full package spec, i.e. $Module::VERSION
      elsif ( $version_fullname && $version_package ) {
        # we do NOT save this package in found @packages
        $need_vers = 0 if $version_package eq $package;
  
        unless ( defined $vers{$version_package} && length $vers{$version_package} ) {
          $vers{$version_package} = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line );
        }
      }
  
      # first non-comment line in undeclared package main is VERSION
      elsif ( $package eq 'main' && $version_fullname && !exists($vers{main}) ) {
        $need_vers = 0;
        my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line );
        $vers{$package} = $v;
        push( @packages, 'main' );
      }
  
      # first non-comment line in undeclared package defines package main
      elsif ( $package eq 'main' && !exists($vers{main}) && $line =~ /\w/ ) {
        $need_vers = 1;
        $vers{main} = '';
        push( @packages, 'main' );
      }
  
      # only keep if this is the first $VERSION seen
      elsif ( $version_fullname && $need_vers ) {
        $need_vers = 0;
        my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line );
  
        unless ( defined $vers{$package} && length $vers{$package} ) {
          $vers{$package} = $v;
        }
      }
    } # end loop over each line
  
    if ( $self->{collect_pod} && length($pod_data) ) {
      $pod{$pod_sect} = $pod_data;
    }
  
    $self->{versions} = \%vers;
    $self->{packages} = \@packages;
    $self->{pod} = \%pod;
    $self->{pod_headings} = \@pod;
  }
  
  sub __uniq (@)
  {
      my (%seen, $key);
      grep !$seen{ $key = $_ }++, @_;
  }
  
  {
  my $pn = 0;
  sub _evaluate_version_line {
    my $self = shift;
    my( $sigil, $variable_name, $line ) = @_;
  
    # We compile into a local sub because 'use version' would cause
    # compiletime/runtime issues with local()
    $pn++; # everybody gets their own package
    my $eval = qq{ my \$dummy = q#  Hide from _packages_inside()
      #; package Module::Metadata::_version::p${pn};
      use version;
      sub {
        local $sigil$variable_name;
        $line;
        return \$$variable_name if defined \$$variable_name;
        return \$Module::Metadata::_version::p${pn}::$variable_name;
      };
    };
  
    $eval = $1 if $eval =~ m{^(.+)}s;
  
    local $^W;
    # Try to get the $VERSION
    my $vsub = __clean_eval($eval);
    # some modules say $VERSION <equal sign> $Foo::Bar::VERSION, but Foo::Bar isn't
    # installed, so we need to hunt in ./lib for it
    if ( $@ =~ /Can't locate/ && -d 'lib' ) {
      local @INC = ('lib',@INC);
      $vsub = __clean_eval($eval);
    }
    warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
      if $@;
  
    (ref($vsub) eq 'CODE') or
      croak "failed to build version sub for $self->{filename}";
  
    my $result = eval { $vsub->() };
    # FIXME: $eval is not the right thing to print here
    croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
      if $@;
  
    # Upgrade it into a version object
    my $version = eval { _dwim_version($result) };
  
    # FIXME: $eval is not the right thing to print here
    croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
      unless defined $version; # "0" is OK!
  
    return $version;
  }
  }
  
  # Try to DWIM when things fail the lax version test in obvious ways
  {
    my @version_prep = (
      # Best case, it just works
      sub { return shift },
  
      # If we still don't have a version, try stripping any
      # trailing junk that is prohibited by lax rules
      sub {
        my $v = shift;
        $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
        return $v;
      },
  
      # Activestate apparently creates custom versions like '1.23_45_01', which
      # cause version.pm to think it's an invalid alpha.  So check for that
      # and strip them
      sub {
        my $v = shift;
        my $num_dots = () = $v =~ m{(\.)}g;
        my $num_unders = () = $v =~ m{(_)}g;
        my $leading_v = substr($v,0,1) eq 'v';
        if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
          $v =~ s{_}{}g;
          $num_unders = () = $v =~ m{(_)}g;
        }
        return $v;
      },
  
      # Worst case, try numifying it like we would have before version objects
      sub {
        my $v = shift;
        no warnings 'numeric';
        return 0 + $v;
      },
  
    );
  
    sub _dwim_version {
      my ($result) = shift;
  
      return $result if ref($result) eq 'version';
  
      my ($version, $error);
      for my $f (@version_prep) {
        $result = $f->($result);
        $version = eval { version->new($result) };
        $error ||= $@ if $@; # capture first failure
        last if defined $version;
      }
  
      croak $error unless defined $version;
  
      return $version;
    }
  }
  
  ############################################################
  
  # accessors
  sub name            { $_[0]->{module}            }
  
  sub filename        { $_[0]->{filename}          }
  sub packages_inside { @{$_[0]->{packages}}       }
  sub pod_inside      { @{$_[0]->{pod_headings}}   }
  sub contains_pod    { 0+@{$_[0]->{pod_headings}} }
  
  sub version {
      my $self = shift;
      my $mod  = shift || $self->{module};
      my $vers;
      if ( defined( $mod ) && length( $mod ) &&
           exists( $self->{versions}{$mod} ) ) {
          return $self->{versions}{$mod};
      }
      else {
          return undef;
      }
  }
  
  sub pod {
      my $self = shift;
      my $sect = shift;
      if ( defined( $sect ) && length( $sect ) &&
           exists( $self->{pod}{$sect} ) ) {
          return $self->{pod}{$sect};
      }
      else {
          return undef;
      }
  }
  
  sub is_indexable {
    my ($self, $package) = @_;
  
    my @indexable_packages = grep $_ ne 'main', $self->packages_inside;
  
    # check for specific package, if provided
    return !! grep $_ eq $package, @indexable_packages if $package;
  
    # otherwise, check for any indexable packages at all
    return !! @indexable_packages;
  }
  
  1;
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Module::Metadata - Gather package and POD information from perl module files
  
  =head1 VERSION
  
  version 1.000036
  
  =head1 SYNOPSIS
  
    use Module::Metadata;
  
    # information about a .pm file
    my $info = Module::Metadata->new_from_file( $file );
    my $version = $info->version;
  
    # CPAN META 'provides' field for .pm files in a directory
    my $provides = Module::Metadata->provides(
      dir => 'lib', version => 2
    );
  
  =head1 DESCRIPTION
  
  This module provides a standard way to gather metadata about a .pm file through
  (mostly) static analysis and (some) code execution.  When determining the
  version of a module, the C<$VERSION> assignment is C<eval>ed, as is traditional
  in the CPAN toolchain.
  
  =head1 CLASS METHODS
  
  =head2 C<< new_from_file($filename, collect_pod => 1) >>
  
  Constructs a C<Module::Metadata> object given the path to a file.  Returns
  undef if the filename does not exist.
  
  C<collect_pod> is a optional boolean argument that determines whether POD
  data is collected and stored for reference.  POD data is not collected by
  default.  POD headings are always collected.
  
  If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then
  it is skipped before processing, and the content of the file is also decoded
  appropriately starting from perl 5.8.
  
  =head2 C<< new_from_handle($handle, $filename, collect_pod => 1) >>
  
  This works just like C<new_from_file>, except that a handle can be provided
  as the first argument.
  
  Note that there is no validation to confirm that the handle is a handle or
  something that can act like one.  Passing something that isn't a handle will
  cause a exception when trying to read from it.  The C<filename> argument is
  mandatory or undef will be returned.
  
  You are responsible for setting the decoding layers on C<$handle> if
  required.
  
  =head2 C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
  
  Constructs a C<Module::Metadata> object given a module or package name.
  Returns undef if the module cannot be found.
  
  In addition to accepting the C<collect_pod> argument as described above,
  this method accepts a C<inc> argument which is a reference to an array of
  directories to search for the module.  If none are given, the default is
  @INC.
  
  If the file that contains the module begins by an UTF-8, UTF-16BE or
  UTF-16LE byte-order mark, then it is skipped before processing, and the
  content of the file is also decoded appropriately starting from perl 5.8.
  
  =head2 C<< find_module_by_name($module, \@dirs) >>
  
  Returns the path to a module given the module or package name. A list
  of directories can be passed in as an optional parameter, otherwise
  @INC is searched.
  
  Can be called as either an object or a class method.
  
  =head2 C<< find_module_dir_by_name($module, \@dirs) >>
  
  Returns the entry in C<@dirs> (or C<@INC> by default) that contains
  the module C<$module>. A list of directories can be passed in as an
  optional parameter, otherwise @INC is searched.
  
  Can be called as either an object or a class method.
  
  =head2 C<< provides( %options ) >>
  
  This is a convenience wrapper around C<package_versions_from_directory>
  to generate a CPAN META C<provides> data structure.  It takes key/value
  pairs.  Valid option keys include:
  
  =over
  
  =item version B<(required)>
  
  Specifies which version of the L<CPAN::Meta::Spec> should be used as
  the format of the C<provides> output.  Currently only '1.4' and '2'
  are supported (and their format is identical).  This may change in
  the future as the definition of C<provides> changes.
  
  The C<version> option is required.  If it is omitted or if
  an unsupported version is given, then C<provides> will throw an error.
  
  =item dir
  
  Directory to search recursively for F<.pm> files.  May not be specified with
  C<files>.
  
  =item files
  
  Array reference of files to examine.  May not be specified with C<dir>.
  
  =item prefix
  
  String to prepend to the C<file> field of the resulting output. This defaults
  to F<lib>, which is the common case for most CPAN distributions with their
  F<.pm> files in F<lib>.  This option ensures the META information has the
  correct relative path even when the C<dir> or C<files> arguments are
  absolute or have relative paths from a location other than the distribution
  root.
  
  =back
  
  For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
  is a hashref of the form:
  
    {
      'Package::Name' => {
        version => '0.123',
        file => 'lib/Package/Name.pm'
      },
      'OtherPackage::Name' => ...
    }
  
  =head2 C<< package_versions_from_directory($dir, \@files?) >>
  
  Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
  for those files in C<$dir> - and reads each file for packages and versions,
  returning a hashref of the form:
  
    {
      'Package::Name' => {
        version => '0.123',
        file => 'Package/Name.pm'
      },
      'OtherPackage::Name' => ...
    }
  
  The C<DB> and C<main> packages are always omitted, as are any "private"
  packages that have leading underscores in the namespace (e.g.
  C<Foo::_private>)
  
  Note that the file path is relative to C<$dir> if that is specified.
  This B<must not> be used directly for CPAN META C<provides>.  See
  the C<provides> method instead.
  
  =head2 C<< log_info (internal) >>
  
  Used internally to perform logging; imported from Log::Contextual if
  Log::Contextual has already been loaded, otherwise simply calls warn.
  
  =head1 OBJECT METHODS
  
  =head2 C<< name() >>
  
  Returns the name of the package represented by this module. If there
  is more than one package, it makes a best guess based on the
  filename. If it's a script (i.e. not a *.pm) the package name is
  'main'.
  
  =head2 C<< version($package) >>
  
  Returns the version as defined by the $VERSION variable for the
  package as returned by the C<name> method if no arguments are
  given. If given the name of a package it will attempt to return the
  version of that package if it is specified in the file.
  
  =head2 C<< filename() >>
  
  Returns the absolute path to the file.
  Note that this file may not actually exist on disk yet, e.g. if the module was read from an in-memory filehandle.
  
  =head2 C<< packages_inside() >>
  
  Returns a list of packages. Note: this is a raw list of packages
  discovered (or assumed, in the case of C<main>).  It is not
  filtered for C<DB>, C<main> or private packages the way the
  C<provides> method does.  Invalid package names are not returned,
  for example "Foo:Bar".  Strange but valid package names are
  returned, for example "Foo::Bar::", and are left up to the caller
  on how to handle.
  
  =head2 C<< pod_inside() >>
  
  Returns a list of POD sections.
  
  =head2 C<< contains_pod() >>
  
  Returns true if there is any POD in the file.
  
  =head2 C<< pod($section) >>
  
  Returns the POD data in the given section.
  
  =head2 C<< is_indexable($package) >> or C<< is_indexable() >>
  
  Available since version 1.000020.
  
  Returns a boolean indicating whether the package (if provided) or any package
  (otherwise) is eligible for indexing by PAUSE, the Perl Authors Upload Server.
  Note This only checks for valid C<package> declarations, and does not take any
  ownership information into account.
  
  =head1 SUPPORT
  
  Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Metadata>
  (or L<bug-Module-Metadata@rt.cpan.org|mailto:bug-Module-Metadata@rt.cpan.org>).
  
  There is also a mailing list available for users of this distribution, at
  L<http://lists.perl.org/list/cpan-workers.html>.
  
  There is also an irc channel available for users of this distribution, at
  L<C<#toolchain> on C<irc.perl.org>|irc://irc.perl.org/#toolchain>.
  
  =head1 AUTHOR
  
  Original code from Module::Build::ModuleInfo by Ken Williams
  <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
  
  Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
  assistance from David Golden (xdg) <dagolden@cpan.org>.
  
  =head1 CONTRIBUTORS
  
  =for stopwords Karen Etheridge David Golden Vincent Pit Matt S Trout Chris Nehren Graham Knop Olivier Mengué Tomas Doran tokuhirom Christian Walde Tatsuhiko Miyagawa Peter Rabbitson Steve Hay Jerry D. Hedden Craig A. Berry Mitchell Steinbrunner Edward Zborowski Gareth Harper James Raspass 'BinGOs' Williams Josh Jore Kent Fredric
  
  =over 4
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Vincent Pit <perl@profvince.com>
  
  =item *
  
  Matt S Trout <mst@shadowcat.co.uk>
  
  =item *
  
  Chris Nehren <apeiron@cpan.org>
  
  =item *
  
  Graham Knop <haarg@haarg.org>
  
  =item *
  
  Olivier Mengué <dolmen@cpan.org>
  
  =item *
  
  Tomas Doran <bobtfish@bobtfish.net>
  
  =item *
  
  tokuhirom <tokuhirom@gmail.com>
  
  =item *
  
  Christian Walde <walde.christian@googlemail.com>
  
  =item *
  
  Tatsuhiko Miyagawa <miyagawa@bulknews.net>
  
  =item *
  
  Peter Rabbitson <ribasushi@cpan.org>
  
  =item *
  
  Steve Hay <steve.m.hay@googlemail.com>
  
  =item *
  
  Jerry D. Hedden <jdhedden@cpan.org>
  
  =item *
  
  Craig A. Berry <cberry@cpan.org>
  
  =item *
  
  Craig A. Berry <craigberry@mac.com>
  
  =item *
  
  David Mitchell <davem@iabyn.com>
  
  =item *
  
  David Steinbrunner <dsteinbrunner@pobox.com>
  
  =item *
  
  Edward Zborowski <ed@rubensteintech.com>
  
  =item *
  
  Gareth Harper <gareth@broadbean.com>
  
  =item *
  
  James Raspass <jraspass@gmail.com>
  
  =item *
  
  Chris 'BinGOs' Williams <chris@bingosnet.co.uk>
  
  =item *
  
  Josh Jore <jjore@cpan.org>
  
  =item *
  
  Kent Fredric <kentnl@cpan.org>
  
  =back
  
  =head1 COPYRIGHT & LICENSE
  
  Original code Copyright (c) 2001-2011 Ken Williams.
  Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
  All rights reserved.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
MODULE_METADATA

$fatpacked{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META';
  use 5.008001;
  use strict;
  package Parse::CPAN::Meta;
  # ABSTRACT: Parse META.yml and META.json CPAN metadata files
  our $VERSION = '1.4414'; # VERSION
  
  use Exporter;
  use Carp 'croak';
  
  our @ISA = qw/Exporter/;
  our @EXPORT_OK = qw/Load LoadFile/;
  
  sub load_file {
    my ($class, $filename) = @_;
  
    my $meta = _slurp($filename);
  
    if ($filename =~ /\.ya?ml$/) {
      return $class->load_yaml_string($meta);
    }
    elsif ($filename =~ /\.json$/) {
      return $class->load_json_string($meta);
    }
    else {
      $class->load_string($meta); # try to detect yaml/json
    }
  }
  
  sub load_string {
    my ($class, $string) = @_;
    if ( $string =~ /^---/ ) { # looks like YAML
      return $class->load_yaml_string($string);
    }
    elsif ( $string =~ /^\s*\{/ ) { # looks like JSON
      return $class->load_json_string($string);
    }
    else { # maybe doc-marker-free YAML
      return $class->load_yaml_string($string);
    }
  }
  
  sub load_yaml_string {
    my ($class, $string) = @_;
    my $backend = $class->yaml_backend();
    my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
    croak $@ if $@;
    return $data || {}; # in case document was valid but empty
  }
  
  sub load_json_string {
    my ($class, $string) = @_;
    my $data = eval { $class->json_backend()->new->decode($string) };
    croak $@ if $@;
    return $data || {};
  }
  
  sub yaml_backend {
    if (! defined $ENV{PERL_YAML_BACKEND} ) {
      _can_load( 'CPAN::Meta::YAML', 0.011 )
        or croak "CPAN::Meta::YAML 0.011 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 {
    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 {
    require Encode;
    open my $fh, "<:raw", "$_[0]" ## no critic
      or die "can't open $_[0] for reading: $!";
    my $content = do { local $/; <$fh> };
    $content = Encode::decode('UTF-8', $content, Encode::PERLQQ());
    return $content;
  }
    
  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 ($) {
    return Load(_slurp(shift));
  }
  
  # Parse a document from a string.
  sub Load ($) {
    require CPAN::Meta::YAML;
    my $object = eval { CPAN::Meta::YAML::Load(shift) };
    croak $@ if $@;
    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.4414
  
  =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.
  
  =begin Pod::Coverage
  
  
  
  
  =end Pod::Coverage
  
  =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.
  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 load_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_string($some_string);
  
  If you don't know whether a string contains YAML or JSON data, this method
  will use some heuristics and guess.  If it can't tell, it assumes YAML.
  
  =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 by default.  These functions
  are available for backwards compatibility only and are best avoided in favor of
  C<load_file>.
  
  =head2 Load
  
    my @yaml = Parse::CPAN::Meta::Load( $string );
  
  Parses a string containing a valid YAML stream into a list of Perl data
  structures.
  
  =head2 LoadFile
  
    my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
  
  Reads the YAML stream from a file instead of a string.
  
  =head1 ENVIRONMENT
  
  =head2 PERL_JSON_BACKEND
  
  By default, L<JSON::PP> will be used for deserializing JSON data. If the
  C<PERL_JSON_BACKEND> environment variable exists, is true and is not
  "JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
  used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
  old, an exception will be thrown.
  
  =head2 PERL_YAML_BACKEND
  
  By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
  the C<PERL_YAML_BACKEND> environment variable is defined, then it is interpreted
  as a module to use for deserialization.  The given module must be installed,
  must load correctly and must implement the C<Load()> function or an exception
  will be thrown.
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Parse-CPAN-Meta>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta>
  
    git clone https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta.git
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Adam Kennedy <adamk@cpan.org>
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =back
  
  =head1 CONTRIBUTORS
  
  =over 4
  
  =item *
  
  Graham Knop <haarg@haarg.org>
  
  =item *
  
  Joshua ben Jore <jjore@cpan.org>
  
  =item *
  
  Neil Bowers <neil@bowers.com>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =item *
  
  Steffen Mueller <smueller@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2014 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{"Parse/PMFile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_PMFILE';
  package Parse::PMFile;
  
  sub __clean_eval { eval $_[0] } # needs to be here (RT#101273)
  
  use strict;
  use warnings;
  use Safe;
  use JSON::PP ();
  use Dumpvalue;
  use version ();
  use File::Spec ();
  
  our $VERSION = '0.41';
  our $VERBOSE = 0;
  our $ALLOW_DEV_VERSION = 0;
  our $FORK = 0;
  our $UNSAFE = $] < 5.010000 ? 1 : 0;
  
  sub new {
      my ($class, $meta, $opts) = @_;
      bless {%{ $opts || {} }, META_CONTENT => $meta}, $class;
  }
  
  # from PAUSE::pmfile::examine_fio
  sub parse {
      my ($self, $pmfile) = @_;
  
      $pmfile =~ s|\\|/|g;
  
      my($filemtime) = (stat $pmfile)[9];
      $self->{MTIME} = $filemtime;
      $self->{PMFILE} = $pmfile;
  
      unless ($self->_version_from_meta_ok) {
          my $version;
          unless (eval { $version = $self->_parse_version; 1 }) {
            $self->_verbose(1, "error with version in $pmfile: $@");
            return;
          }
  
          $self->{VERSION} = $version;
          if ($self->{VERSION} =~ /^\{.*\}$/) {
              # JSON error message
          } elsif ($self->{VERSION} =~ /[_\s]/ && !$self->{ALLOW_DEV_VERSION} && !$ALLOW_DEV_VERSION){   # ignore developer releases and "You suck!"
              return;
          }
      }
  
      my($ppp) = $self->_packages_per_pmfile;
      my @keys_ppp = $self->_filter_ppps(sort keys %$ppp);
      $self->_verbose(1,"Will check keys_ppp[@keys_ppp]\n");
  
      #
      # Immediately after each package (pmfile) examined contact
      # the database
      #
  
      my ($package, %errors);
      my %checked_in;
    DBPACK: foreach $package (@keys_ppp) {
          # this part is taken from PAUSE::package::examine_pkg
          # and PAUSE::package::_pkg_name_insane
          if ($package !~ /^\w[\w\:\']*\w?\z/
           || $package !~ /\w\z/
           || $package =~ /:/ && $package !~ /::/
           || $package =~ /\w:\w/
           || $package =~ /:::/
          ){
              $self->_verbose(1,"Package[$package] did not pass the ultimate sanity check");
              delete $ppp->{$package};
              next;
          }
  
          if ($self->{USERID} && $self->{PERMISSIONS} && !$self->_perm_check($package)) {
              delete $ppp->{$package};
              next;
          }
  
          # Check that package name matches case of file name
          {
            my (undef, $module) = split m{/lib/}, $self->{PMFILE}, 2;
            if ($module) {
              $module =~ s{\.pm\z}{};
              $module =~ s{/}{::}g;
  
              if (lc $module eq lc $package && $module ne $package) {
                # warn "/// $self->{PMFILE} vs. $module vs. $package\n";
                $errors{$package} = {
                  indexing_warning => "Capitalization of package ($package) does not match filename!",
                  infile => $self->{PMFILE},
                };
              }
            }
          }
  
          my $pp = $ppp->{$package};
          if ($pp->{version} && $pp->{version} =~ /^\{.*\}$/) { # JSON parser error
              my $err = JSON::PP::decode_json($pp->{version});
              if ($err->{x_normalize}) {
                  $errors{$package} = {
                      normalize => $err->{version},
                      infile => $pp->{infile},
                  };
                  $pp->{version} = "undef";
              } elsif ($err->{openerr}) {
                  $pp->{version} = "undef";
                  $self->_verbose(1,
                                qq{Parse::PMFile was not able to
          read the file. It issued the following error: C< $err->{r} >},
                                );
                  $errors{$package} = {
                      open => $err->{r},
                      infile => $pp->{infile},
                  };
              } else {
                  $pp->{version} = "undef";
                  $self->_verbose(1, 
                                qq{Parse::PMFile was not able to
          parse the following line in that file: C< $err->{line} >
  
          Note: the indexer is running in a Safe compartement and cannot
          provide the full functionality of perl in the VERSION line. It
          is trying hard, but sometime it fails. As a workaround, please
          consider writing a META.yml that contains a 'provides'
          attribute or contact the CPAN admins to investigate (yet
          another) workaround against "Safe" limitations.)},
  
                                );
                  $errors{$package} = {
                      parse_version => $err->{line},
                      infile => $err->{file},
                  };
              }
          }
  
          # Sanity checks
  
          for (
              $package,
              $pp->{version},
          ) {
              if (!defined || /^\s*$/ || /\s/){  # for whatever reason I come here
                  delete $ppp->{$package};
                  next;            # don't screw up 02packages
              }
          }
          unless ($self->_version_ok($pp)) {
              $errors{$package} = {
                  long_version => qq{Version string exceeds maximum allowed length of 16b: "$pp->{version}"},
                  infile => $pp->{infile},
              };
              next;
          }
          $checked_in{$package} = $ppp->{$package};
      }                       # end foreach package
  
      return (wantarray && %errors) ? (\%checked_in, \%errors) : \%checked_in;
  }
  
  sub _version_ok {
      my ($self, $pp) = @_;
      return if length($pp->{version} || 0) > 16;
      return 1
  }
  
  sub _perm_check {
      my ($self, $package) = @_;
      my $userid = $self->{USERID};
      my $module = $self->{PERMISSIONS}->module_permissions($package);
      return 1 if !$module; # not listed yet
      return 1 if defined $module->m && $module->m eq $userid;
      return 1 if defined $module->f && $module->f eq $userid;
      return 1 if defined $module->c && grep {$_ eq $userid} @{$module->c};
      return;
  }
  
  # from PAUSE::pmfile;
  sub _parse_version {
      my $self = shift;
  
      use strict;
  
      my $pmfile = $self->{PMFILE};
      my $tmpfile = File::Spec->catfile(File::Spec->tmpdir, "ParsePMFile$$" . rand(1000));
  
      my $pmcp = $pmfile;
      for ($pmcp) {
          s/([^\\](\\\\)*)@/$1\\@/g; # thanks to Raphael Manfredi for the
          # solution to escape @s and \
      }
      my($v);
      {
  
          package main; # seems necessary
  
          # XXX: do we need to fork as PAUSE does?
          # or, is alarm() just fine?
          my $pid;
          if ($self->{FORK} || $FORK) {
              $pid = fork();
              die "Can't fork: $!" unless defined $pid;
          }
          if ($pid) {
              waitpid($pid, 0);
              if (open my $fh, '<', $tmpfile) {
                  $v = <$fh>;
              }
          } else {
              # XXX Limit Resources too
  
              my($comp) = Safe->new;
              my $eval = qq{
                  local(\$^W) = 0;
                  Parse::PMFile::_parse_version_safely("$pmcp");
              };
              $comp->permit("entereval"); # for MBARBON/Module-Info-0.30.tar.gz
              $comp->share("*Parse::PMFile::_parse_version_safely");
              $comp->share("*version::new");
              $comp->share("*version::numify");
              $comp->share_from('main', ['*version::',
                                          '*charstar::',
                                          '*Exporter::',
                                          '*DynaLoader::']);
              $comp->share_from('version', ['&qv']);
              $comp->permit(":base_math"); # atan2 (Acme-Pi)
              # $comp->permit("require"); # no strict!
              $comp->deny(qw/enteriter iter unstack goto/); # minimum protection against Acme::BadExample
  
              version->import('qv') if $self->{UNSAFE} || $UNSAFE;
              {
                  no strict;
                  $v = ($self->{UNSAFE} || $UNSAFE) ? eval $eval : $comp->reval($eval);
              }
              if ($@){ # still in the child process, out of Safe::reval
                  my $err = $@;
                  # warn ">>>>>>>err[$err]<<<<<<<<";
                  if (ref $err) {
                      if ($err->{line} =~ /([\$*])([\w\:\']*)\bVERSION\b.*?\=(.*)/) {
                          local($^W) = 0;
                          my ($sigil, $vstr) = ($1, $3);
                          $self->_restore_overloaded_stuff(1) if $err->{line} =~ /use\s+version\b|version\->|qv\(/;
                          $v = ($self->{UNSAFE} || $UNSAFE) ? eval $vstr : $comp->reval($vstr);
                          $v = $$v if $sigil eq '*' && ref $v;
                      }
                      if ($@ or !$v) {
                          $self->_verbose(1, sprintf("reval failed: err[%s] for eval[%s]",
                                        JSON::PP::encode_json($err),
                                        $eval,
                                      ));
                          $v = JSON::PP::encode_json($err);
                      }
                  } else {
                      $v = JSON::PP::encode_json({ openerr => $err });
                  }
              }
              if (defined $v) {
                  no warnings;
                  $v = $v->numify if ref($v) =~ /^version(::vpp)?$/;
              } else {
                  $v = "";
              }
              if ($self->{FORK} || $FORK) {
                  open my $fh, '>:utf8', $tmpfile;
                  print $fh $v;
                  exit 0;
              } else {
                  utf8::encode($v);
                  # undefine empty $v as if read from the tmpfile
                  $v = undef if defined $v && !length $v;
                  $comp->erase;
                  $self->_restore_overloaded_stuff;
              }
          }
      }
      unlink $tmpfile if ($self->{FORK} || $FORK) && -e $tmpfile;
  
      return $self->_normalize_version($v);
  }
  
  sub _restore_overloaded_stuff {
      my ($self, $used_version_in_safe) = @_;
      return if $self->{UNSAFE} || $UNSAFE;
  
      no strict 'refs';
      no warnings 'redefine';
  
      # version XS in CPAN
      my $restored;
      if ($INC{'version/vxs.pm'}) {
          *{'version::(""'} = \&version::vxs::stringify;
          *{'version::(0+'} = \&version::vxs::numify;
          *{'version::(cmp'} = \&version::vxs::VCMP;
          *{'version::(<=>'} = \&version::vxs::VCMP;
          *{'version::(bool'} = \&version::vxs::boolean;
          $restored = 1;
      }
      # version PP in CPAN
      if ($INC{'version/vpp.pm'}) {
          {
              package # hide from PAUSE
                  charstar;
              overload->import;
          }
          if (!$used_version_in_safe) {
              package # hide from PAUSE
                  version::vpp;
              overload->import;
          }
          unless ($restored) {
              *{'version::(""'} = \&version::vpp::stringify;
              *{'version::(0+'} = \&version::vpp::numify;
              *{'version::(cmp'} = \&version::vpp::vcmp;
              *{'version::(<=>'} = \&version::vpp::vcmp;
              *{'version::(bool'} = \&version::vpp::vbool;
          }
          *{'version::vpp::(""'} = \&version::vpp::stringify;
          *{'version::vpp::(0+'} = \&version::vpp::numify;
          *{'version::vpp::(cmp'} = \&version::vpp::vcmp;
          *{'version::vpp::(<=>'} = \&version::vpp::vcmp;
          *{'version::vpp::(bool'} = \&version::vpp::vbool;
          *{'charstar::(""'} = \&charstar::thischar;
          *{'charstar::(0+'} = \&charstar::thischar;
          *{'charstar::(++'} = \&charstar::increment;
          *{'charstar::(--'} = \&charstar::decrement;
          *{'charstar::(+'} = \&charstar::plus;
          *{'charstar::(-'} = \&charstar::minus;
          *{'charstar::(*'} = \&charstar::multiply;
          *{'charstar::(cmp'} = \&charstar::cmp;
          *{'charstar::(<=>'} = \&charstar::spaceship;
          *{'charstar::(bool'} = \&charstar::thischar;
          *{'charstar::(='} = \&charstar::clone;
          $restored = 1;
      }
      # version in core
      if (!$restored) {
          *{'version::(""'} = \&version::stringify;
          *{'version::(0+'} = \&version::numify;
          *{'version::(cmp'} = \&version::vcmp;
          *{'version::(<=>'} = \&version::vcmp;
          *{'version::(bool'} = \&version::boolean;
      }
  }
  
  # from PAUSE::pmfile;
  sub _packages_per_pmfile {
      my $self = shift;
  
      my $ppp = {};
      my $pmfile = $self->{PMFILE};
      my $filemtime = $self->{MTIME};
      my $version = $self->{VERSION};
  
      open my $fh, "<", "$pmfile" or return $ppp;
  
      local $/ = "\n";
      my $inpod = 0;
  
    PLINE: while (<$fh>) {
          chomp;
          my($pline) = $_;
          $inpod = $pline =~ /^=(?!cut)/ ? 1 :
              $pline =~ /^=cut/ ? 0 : $inpod;
          next if $inpod;
          next if substr($pline,0,4) eq "=cut";
  
          $pline =~ s/\#.*//;
          next if $pline =~ /^\s*$/;
          if ($pline =~ /^__(?:END|DATA)__\b/
              and $pmfile !~ /\.PL$/   # PL files may well have code after __DATA__
              ){
              last PLINE;
          }
  
          my $pkg;
          my $strict_version;
  
          if (
              $pline =~ m{
                        # (.*) # takes too much time if $pline is long
                        #(?<![*\$\\@%&]) # no sigils
                        ^[\s\{;]*
                        \bpackage\s+
                        ([\w\:\']+)
                        \s*
                        (?: $ | [\}\;] | \{ | \s+($version::STRICT) )
                      }x) {
              $pkg = $1;
              $strict_version = $2;
              if ($pkg eq "DB"){
                  # XXX if pumpkin and perl make him comaintainer! I
                  # think I always made the pumpkins comaint on DB
                  # without further ado (?)
                  next PLINE;
              }
          }
  
          if ($pkg) {
              # Found something
  
              # from package
              $pkg =~ s/\'/::/g;
              next PLINE unless $pkg =~ /^[A-Za-z]/;
              next PLINE unless $pkg =~ /\w$/;
              next PLINE if $pkg eq "main";
              # Perl::Critic::Policy::TestingAndDebugging::ProhibitShebangWarningsArg
              # database for modid in mods, package in packages, package in perms
              # alter table mods modify modid varchar(128) binary NOT NULL default '';
              # alter table packages modify package varchar(128) binary NOT NULL default '';
              next PLINE if length($pkg) > 128;
              #restriction
              $ppp->{$pkg}{parsed}++;
              $ppp->{$pkg}{infile} = $pmfile;
              if ($self->_simile($pmfile,$pkg)) {
                  $ppp->{$pkg}{simile} = $pmfile;
                  if ($self->_version_from_meta_ok) {
                      my $provides = $self->{META_CONTENT}{provides};
                      if (exists $provides->{$pkg}) {
                          if (defined $provides->{$pkg}{version}) {
                              my $v = $provides->{$pkg}{version};
                              if ($v =~ /[_\s]/ && !$self->{ALLOW_DEV_VERSION} && !$ALLOW_DEV_VERSION){   # ignore developer releases and "You suck!"
                                  next PLINE;
                              }
  
                              unless (eval { $version = $self->_normalize_version($v); 1 }) {
                                $self->_verbose(1, "error with version in $pmfile: $@");
                                next;
  
                              }
                              $ppp->{$pkg}{version} = $version;
                          } else {
                              $ppp->{$pkg}{version} = "undef";
                          }
                      }
                  } else {
                      if (defined $strict_version){
                          $ppp->{$pkg}{version} = $strict_version ;
                      } else {
                          $ppp->{$pkg}{version} = defined $version ? $version : "";
                      }
                      no warnings;
                      if ($version eq 'undef') {
                          $ppp->{$pkg}{version} = $version unless defined $ppp->{$pkg}{version};
                      } else {
                          $ppp->{$pkg}{version} =
                              $version
                                  if $version
                                      > $ppp->{$pkg}{version} ||
                                          $version
                                              gt $ppp->{$pkg}{version};
                      }
                  }
              } else {        # not simile
                  #### it comes later, it would be nonsense
                  #### to set to "undef". MM_Unix gives us
                  #### the best we can reasonably consider
                  $ppp->{$pkg}{version} =
                      $version
                          unless defined $ppp->{$pkg}{version} &&
                              length($ppp->{$pkg}{version});
              }
              $ppp->{$pkg}{filemtime} = $filemtime;
          } else {
              # $self->_verbose(2,"no pkg found");
          }
      }
  
      close $fh;
      $ppp;
  }
  
  # from PAUSE::pmfile;
  {
      no strict;
      sub _parse_version_safely {
          my($parsefile) = @_;
          my $result;
          local *FH;
          local $/ = "\n";
          open(FH,$parsefile) or die "Could not open '$parsefile': $!";
          my $inpod = 0;
          while (<FH>) {
              $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
              next if $inpod || /^\s*#/;
              last if /^__(?:END|DATA)__\b/; # fails on quoted __END__ but this is rare -> __END__ in the middle of a line is rarer
              chop;
  
              if (my ($ver) = /package \s+ \S+ \s+ (\S+) \s* [;{]/x) {
                # XXX: should handle this better if version is bogus -- rjbs,
                # 2014-03-16
                return $ver if version::is_lax($ver);
              }
  
              # next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
              next unless /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*(?<![!><=])\=(?![=>])/;
              my $current_parsed_line = $_;
              my $eval = qq{
                  package #
                      ExtUtils::MakeMaker::_version;
  
                  local $1$2;
                  \$$2=undef; do {
                      $_
                  }; \$$2
              };
              local $^W = 0;
              local $SIG{__WARN__} = sub {};
              $result = __clean_eval($eval);
              # warn "current_parsed_line[$current_parsed_line]\$\@[$@]";
              if ($@ or !defined $result){
                  die +{
                        eval => $eval,
                        line => $current_parsed_line,
                        file => $parsefile,
                        err => $@,
                        };
              }
              last;
          } #;
          close FH;
  
          $result = "undef" unless defined $result;
          if ((ref $result) =~ /^version(?:::vpp)?\b/) {
              no warnings;
              $result = $result->numify;
          }
          return $result;
      }
  }
  
  # from PAUSE::pmfile;
  sub _filter_ppps {
      my($self,@ppps) = @_;
      my @res;
  
      # very similar code is in PAUSE::dist::filter_pms
    MANI: for my $ppp ( @ppps ) {
          if ($self->{META_CONTENT}){
              my $no_index = $self->{META_CONTENT}{no_index}
                              || $self->{META_CONTENT}{private}; # backward compat
              if (ref($no_index) eq 'HASH') {
                  my %map = (
                              package => qr{\z},
                              namespace => qr{::},
                            );
                  for my $k (qw(package namespace)) {
                      next unless my $v = $no_index->{$k};
                      my $rest = $map{$k};
                      if (ref $v eq "ARRAY") {
                          for my $ve (@$v) {
                              $ve =~ s|::$||;
                              if ($ppp =~ /^$ve$rest/){
                                  $self->_verbose(1,"Skipping ppp[$ppp] due to ve[$ve]");
                                  next MANI;
                              } else {
                                  $self->_verbose(1,"NOT skipping ppp[$ppp] due to ve[$ve]");
                              }
                          }
                      } else {
                          $v =~ s|::$||;
                          if ($ppp =~ /^$v$rest/){
                              $self->_verbose(1,"Skipping ppp[$ppp] due to v[$v]");
                              next MANI;
                          } else {
                              $self->_verbose(1,"NOT skipping ppp[$ppp] due to v[$v]");
                          }
                      }
                  }
              } else {
                  $self->_verbose(1,"No keyword 'no_index' or 'private' in META_CONTENT");
              }
          } else {
              # $self->_verbose(1,"no META_CONTENT"); # too noisy
          }
          push @res, $ppp;
      }
      $self->_verbose(1,"Result of filter_ppps: res[@res]");
      @res;
  }
  
  # from PAUSE::pmfile;
  sub _simile {
      my($self,$file,$package) = @_;
      # MakeMaker gives them the chance to have the file Simple.pm in
      # this directory but have the package HTML::Simple in it.
      # Afaik, they wouldn't be able to do so with deeper nested packages
      $file =~ s|.*/||;
      $file =~ s|\.pm(?:\.PL)?||;
      my $ret = $package =~ m/\b\Q$file\E$/;
      $ret ||= 0;
      unless ($ret) {
          # Apache::mod_perl_guide stuffs it into Version.pm
          $ret = 1 if lc $file eq 'version';
      }
      $self->_verbose(1,"Result of simile(): file[$file] package[$package] ret[$ret]\n");
      $ret;
  }
  
  # from PAUSE::pmfile
  sub _normalize_version {
      my($self,$v) = @_;
      $v = "undef" unless defined $v;
      my $dv = Dumpvalue->new;
      my $sdv = $dv->stringify($v,1); # second argument prevents ticks
      $self->_verbose(1,"Result of normalize_version: sdv[$sdv]\n");
  
      return $v if $v eq "undef";
      return $v if $v =~ /^\{.*\}$/; # JSON object
      $v =~ s/^\s+//;
      $v =~ s/\s+\z//;
      if ($v =~ /_/) {
          # XXX should pass something like EDEVELOPERRELEASE up e.g.
          # SIXTEASE/XML-Entities-0.0306.tar.gz had nothing but one
          # such modules and the mesage was not helpful that "nothing
          # was found".
          return $v ;
      }
      if (!version::is_lax($v)) {
          return JSON::PP::encode_json({ x_normalize => 'version::is_lax failed', version => $v });
      }
      # may warn "Integer overflow"
      my $vv = eval { no warnings; version->new($v)->numify };
      if ($@) {
          # warn "$v: $@";
          return JSON::PP::encode_json({ x_normalize => $@, version => $v });
          # return "undef";
      }
      if ($vv eq $v) {
          # the boring 3.14
      } else {
          my $forced = $self->_force_numeric($v);
          if ($forced eq $vv) {
          } elsif ($forced =~ /^v(.+)/) {
              # rare case where a v1.0.23 slipped in (JANL/w3mir-1.0.10.tar.gz)
              no warnings;
              $vv = version->new($1)->numify;
          } else {
              # warn "Unequal forced[$forced] and vv[$vv]";
              if ($forced == $vv) {
                  # the trailing zeroes would cause unnecessary havoc
                  $vv = $forced;
              }
          }
      }
      return $vv;
  }
  
  # from PAUSE::pmfile;
  sub _force_numeric {
      my($self,$v) = @_;
      $v = $self->_readable($v);
  
      if (
          $v =~
          /^(\+?)(\d*)(\.(\d*))?/ &&
          # "$2$4" ne ''
          (
            defined $2 && length $2
            ||
            defined $4 && length $4
          )
          ) {
          my $two = defined $2 ? $2 : "";
          my $three = defined $3 ? $3 : "";
          $v = "$two$three";
      }
      # no else branch! We simply say, everything else is a string.
      $v;
  }
  
  # from PAUSE::dist
  sub _version_from_meta_ok {
    my($self) = @_;
    return $self->{VERSION_FROM_META_OK} if exists $self->{VERSION_FROM_META_OK};
    my $c = $self->{META_CONTENT};
  
    # If there's no provides hash, we can't get our module versions from the
    # provides hash! -- rjbs, 2012-03-31
    return($self->{VERSION_FROM_META_OK} = 0) unless $c->{provides};
  
    # Some versions of Module::Build geneated an empty provides hash.  If we're
    # *not* looking at a Module::Build-generated metafile, then it's okay.
    my ($mb_v) = (defined $c->{generated_by} ? $c->{generated_by} : '') =~ /Module::Build version ([\d\.]+)/;
    return($self->{VERSION_FROM_META_OK} = 1) unless $mb_v;
  
    # ??? I don't know why this is here.
    return($self->{VERSION_FROM_META_OK} = 1) if $mb_v eq '0.250.0';
  
    if ($mb_v >= 0.19 && $mb_v < 0.26 && ! keys %{$c->{provides}}) {
        # RSAVAGE/Javascript-SHA1-1.01.tgz had an empty provides hash. Ron
        # did not find the reason why this happened, but let's not go
        # overboard, 0.26 seems a good threshold from the statistics: there
        # are not many empty provides hashes from 0.26 up.
        return($self->{VERSION_FROM_META_OK} = 0);
    }
  
    # We're not in the suspect range of M::B versions.  It's good to go.
    return($self->{VERSION_FROM_META_OK} = 1);
  }
  
  sub _verbose {
      my($self,$level,@what) = @_;
      warn @what if $level <= ((ref $self && $self->{VERBOSE}) || $VERBOSE);
  }
  
  # all of the following methods are stripped from CPAN::Version
  # (as of version 5.5001, bundled in CPAN 2.03), and slightly
  # modified (ie. made private, as well as CPAN->debug(...) are
  # replaced with $self->_verbose(9, ...).)
  
  # CPAN::Version::vcmp courtesy Jost Krieger
  sub _vcmp {
      my($self,$l,$r) = @_;
      local($^W) = 0;
      $self->_verbose(9, "l[$l] r[$r]");
  
      return 0 if $l eq $r; # short circuit for quicker success
  
      for ($l,$r) {
          s/_//g;
      }
      $self->_verbose(9, "l[$l] r[$r]");
      for ($l,$r) {
          next unless tr/.// > 1 || /^v/;
          s/^v?/v/;
          1 while s/\.0+(\d)/.$1/; # remove leading zeroes per group
      }
      $self->_verbose(9, "l[$l] r[$r]");
      if ($l=~/^v/ <=> $r=~/^v/) {
          for ($l,$r) {
              next if /^v/;
              $_ = $self->_float2vv($_);
          }
      }
      $self->_verbose(9, "l[$l] r[$r]");
      my $lvstring = "v0";
      my $rvstring = "v0";
      if ($] >= 5.006
       && $l =~ /^v/
       && $r =~ /^v/) {
          $lvstring = $self->_vstring($l);
          $rvstring = $self->_vstring($r);
          $self->_verbose(9, sprintf "lv[%vd] rv[%vd]", $lvstring, $rvstring);
      }
  
      return (
              ($l ne "undef") <=> ($r ne "undef")
              ||
              $lvstring cmp $rvstring
              ||
              $l <=> $r
              ||
              $l cmp $r
      );
  }
  
  sub _vgt {
      my($self,$l,$r) = @_;
      $self->_vcmp($l,$r) > 0;
  }
  
  sub _vlt {
      my($self,$l,$r) = @_;
      $self->_vcmp($l,$r) < 0;
  }
  
  sub _vge {
      my($self,$l,$r) = @_;
      $self->_vcmp($l,$r) >= 0;
  }
  
  sub _vle {
      my($self,$l,$r) = @_;
      $self->_vcmp($l,$r) <= 0;
  }
  
  sub _vstring {
      my($self,$n) = @_;
      $n =~ s/^v// or die "Parse::PMFile::_vstring() called with invalid arg [$n]";
      pack "U*", split /\./, $n;
  }
  
  # vv => visible vstring
  sub _float2vv {
      my($self,$n) = @_;
      my($rev) = int($n);
      $rev ||= 0;
      my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit
                                            # architecture influence
      $mantissa ||= 0;
      $mantissa .= "0" while length($mantissa)%3;
      my $ret = "v" . $rev;
      while ($mantissa) {
          $mantissa =~ s/(\d{1,3})// or
              die "Panic: length>0 but not a digit? mantissa[$mantissa]";
          $ret .= ".".int($1);
      }
      # warn "n[$n]ret[$ret]";
      $ret =~ s/(\.0)+/.0/; # v1.0.0 => v1.0
      $ret;
  }
  
  sub _readable {
      my($self,$n) = @_;
      $n =~ /^([\w\-\+\.]+)/;
  
      return $1 if defined $1 && length($1)>0;
      # if the first user reaches version v43, he will be treated as "+".
      # We'll have to decide about a new rule here then, depending on what
      # will be the prevailing versioning behavior then.
  
      if ($] < 5.006) { # or whenever v-strings were introduced
          # we get them wrong anyway, whatever we do, because 5.005 will
          # have already interpreted 0.2.4 to be "0.24". So even if he
          # indexer sends us something like "v0.2.4" we compare wrongly.
  
          # And if they say v1.2, then the old perl takes it as "v12"
  
          $self->_verbose(9, "Suspicious version string seen [$n]\n");
          return $n;
      }
      my $better = sprintf "v%vd", $n;
      $self->_verbose(9, "n[$n] better[$better]");
      return $better;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Parse::PMFile - parses .pm file as PAUSE does
  
  =head1 SYNOPSIS
  
      use Parse::PMFile;
  
      my $parser = Parse::PMFile->new($metadata, {VERBOSE => 1});
      my $packages_info = $parser->parse($pmfile);
  
      # if you need info about invalid versions
      my ($packages_info, $errors) = $parser->parse($pmfile);
  
      # to check permissions
      my $parser = Parse::PMFile->new($metadata, {
          USERID => 'ISHIGAKI',
          PERMISSIONS => PAUSE::Permissions->new,
      });
  
  =head1 DESCRIPTION
  
  The most of the code of this module is taken from the PAUSE code as of April 2013 almost verbatim. Thus, the heart of this module should be quite stable. However, I made it not to use pipe ("-|") as well as I stripped database-related code. If you encounter any issue, that's most probably because of my modification.
  
  This module doesn't provide features to extract a distribution or parse meta files intentionally.
  
  =head1 METHODS
  
  =head2 new
  
  creates an object. You can also pass a hashref taken from META.yml etc, and an optional hashref. Options are:
  
  =over 4
  
  =item ALLOW_DEV_VERSION
  
  Parse::PMFile usually ignores a version with an underscore as PAUSE does (because it's for a developer release, and should not be indexed). Set this option to true if you happen to need to keep such a version for better analysis.
  
  =item VERBOSE
  
  Set this to true if you need to know some details.
  
  =item FORK
  
  As of version 0.17, Parse::PMFile stops forking while parsing a version for better performance. Parse::PMFile should return the same result no matter how this option is set, but if you do care, set this to true to fork as PAUSE does.
  
  =item USERID, PERMISSIONS
  
  As of version 0.21, Parse::PMFile checks permissions of a package if both USERID and PERMISSIONS (which should be an instance of L<PAUSE::Permissions>) are provided. Unauthorized packages are removed.
  
  =item UNSAFE
  
  Parse::PMFile usually parses a module version in a Safe compartment. However, this approach doesn't work smoothly under older perls (prior to 5.10) plus some combinations of recent versions of Safe.pm (2.24 and above) and version.pm (0.9905 and above) for various reasons. As of version 0.27, Parse::PMFile simply uses C<eval> to parse a version under older perls. If you want it to use always C<eval> (even under recent perls), set this to true.
  
  =back
  
  =head2 parse
  
  takes a path to a .pm file, and returns a hash reference that holds information for package(s) found in the file.
  
  =head1 SEE ALSO
  
  L<Parse::LocalDistribution>, L<PAUSE::Permissions>
  
  Most part of this module is derived from PAUSE and CPAN::Version.
  
  L<https://github.com/andk/pause>
  
  L<https://github.com/andk/cpanpm>
  
  =head1 AUTHOR
  
  Andreas Koenig E<lt>andreas.koenig@anima.deE<gt>
  
  Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 1995 - 2013 by Andreas Koenig E<lt>andk@cpan.orgE<gt> for most of the code.
  
  Copyright 2013 by Kenichi Ishigaki for some.
  
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
PARSE_PMFILE

$fatpacked{"Path/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_TINY';
  use 5.008001;
  use strict;
  use warnings;
  
  package Path::Tiny;
  # ABSTRACT: File path utility
  
  our $VERSION = '0.108';
  
  # Dependencies
  use Config;
  use Exporter 5.57   (qw/import/);
  use File::Spec 0.86 ();          # shipped with 5.8.1
  use Carp ();
  
  our @EXPORT    = qw/path/;
  our @EXPORT_OK = qw/cwd rootdir tempfile tempdir/;
  
  use constant {
      PATH     => 0,
      CANON    => 1,
      VOL      => 2,
      DIR      => 3,
      FILE     => 4,
      TEMP     => 5,
      IS_WIN32 => ( $^O eq 'MSWin32' ),
  };
  
  use overload (
      q{""}    => sub    { $_[0]->[PATH] },
      bool     => sub () { 1 },
      fallback => 1,
  );
  
  # FREEZE/THAW per Sereal/CBOR/Types::Serialiser protocol
  sub FREEZE { return $_[0]->[PATH] }
  sub THAW   { return path( $_[2] ) }
  { no warnings 'once'; *TO_JSON = *FREEZE };
  
  my $HAS_UU; # has Unicode::UTF8; lazily populated
  
  sub _check_UU {
      local $SIG{__DIE__}; # prevent outer handler from being called
      !!eval {
          require Unicode::UTF8;
          Unicode::UTF8->VERSION(0.58);
          1;
      };
  }
  
  my $HAS_PU;              # has PerlIO::utf8_strict; lazily populated
  
  sub _check_PU {
      local $SIG{__DIE__}; # prevent outer handler from being called
      !!eval {
          # MUST preload Encode or $SIG{__DIE__} localization fails
          # on some Perl 5.8.8 (maybe other 5.8.*) compiled with -O2.
          require Encode;
          require PerlIO::utf8_strict;
          PerlIO::utf8_strict->VERSION(0.003);
          1;
      };
  }
  
  my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
  
  # notions of "root" directories differ on Win32: \\server\dir\ or C:\ or \
  my $SLASH      = qr{[\\/]};
  my $NOTSLASH   = qr{[^\\/]};
  my $DRV_VOL    = qr{[a-z]:}i;
  my $UNC_VOL    = qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x;
  my $WIN32_ROOT = qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;
  
  sub _win32_vol {
      my ( $path, $drv ) = @_;
      require Cwd;
      my $dcwd = eval { Cwd::getdcwd($drv) }; # C: -> C:\some\cwd
      # getdcwd on non-existent drive returns empty string
      # so just use the original drive Z: -> Z:
      $dcwd = "$drv" unless defined $dcwd && length $dcwd;
      # normalize dwcd to end with a slash: might be C:\some\cwd or D:\ or Z:
      $dcwd =~ s{$SLASH?$}{/};
      # make the path absolute with dcwd
      $path =~ s{^$DRV_VOL}{$dcwd};
      return $path;
  }
  
  # This is a string test for before we have the object; see is_rootdir for well-formed
  # object test
  sub _is_root {
      return IS_WIN32() ? ( $_[0] =~ /^$WIN32_ROOT$/ ) : ( $_[0] eq '/' );
  }
  
  BEGIN {
      *_same = IS_WIN32() ? sub { lc( $_[0] ) eq lc( $_[1] ) } : sub { $_[0] eq $_[1] };
  }
  
  # mode bits encoded for chmod in symbolic mode
  my %MODEBITS = ( om => 0007, gm => 0070, um => 0700 ); ## no critic
  { my $m = 0; $MODEBITS{$_} = ( 1 << $m++ ) for qw/ox ow or gx gw gr ux uw ur/ };
  
  sub _symbolic_chmod {
      my ( $mode, $symbolic ) = @_;
      for my $clause ( split /,\s*/, $symbolic ) {
          if ( $clause =~ m{\A([augo]+)([=+-])([rwx]+)\z} ) {
              my ( $who, $action, $perms ) = ( $1, $2, $3 );
              $who =~ s/a/ugo/g;
              for my $w ( split //, $who ) {
                  my $p = 0;
                  $p |= $MODEBITS{"$w$_"} for split //, $perms;
                  if ( $action eq '=' ) {
                      $mode = ( $mode & ~$MODEBITS{"${w}m"} ) | $p;
                  }
                  else {
                      $mode = $action eq "+" ? ( $mode | $p ) : ( $mode & ~$p );
                  }
              }
          }
          else {
              Carp::croak("Invalid mode clause '$clause' for chmod()");
          }
      }
      return $mode;
  }
  
  # flock doesn't work on NFS on BSD or on some filesystems like lustre.
  # Since program authors often can't control or detect that, we warn once
  # instead of being fatal if we can detect it and people who need it strict
  # can fatalize the 'flock' category
  
  #<<< No perltidy
  { package flock; use warnings::register }
  #>>>
  
  my $WARNED_NO_FLOCK = 0;
  
  sub _throw {
      my ( $self, $function, $file, $msg ) = @_;
      if (   $function =~ /^flock/
          && $! =~ /operation not supported|function not implemented/i
          && !warnings::fatal_enabled('flock') )
      {
          if ( !$WARNED_NO_FLOCK ) {
              warnings::warn( flock => "Flock not available: '$!': continuing in unsafe mode" );
              $WARNED_NO_FLOCK++;
          }
      }
      else {
          $msg = $! unless defined $msg;
          Path::Tiny::Error->throw( $function, ( defined $file ? $file : $self->[PATH] ),
              $msg );
      }
      return;
  }
  
  # cheapo option validation
  sub _get_args {
      my ( $raw, @valid ) = @_;
      if ( defined($raw) && ref($raw) ne 'HASH' ) {
          my ( undef, undef, undef, $called_as ) = caller(1);
          $called_as =~ s{^.*::}{};
          Carp::croak("Options for $called_as must be a hash reference");
      }
      my $cooked = {};
      for my $k (@valid) {
          $cooked->{$k} = delete $raw->{$k} if exists $raw->{$k};
      }
      if ( keys %$raw ) {
          my ( undef, undef, undef, $called_as ) = caller(1);
          $called_as =~ s{^.*::}{};
          Carp::croak( "Invalid option(s) for $called_as: " . join( ", ", keys %$raw ) );
      }
      return $cooked;
  }
  
  #--------------------------------------------------------------------------#
  # Constructors
  #--------------------------------------------------------------------------#
  
  #pod =construct path
  #pod
  #pod     $path = path("foo/bar");
  #pod     $path = path("/tmp", "file.txt"); # list
  #pod     $path = path(".");                # cwd
  #pod     $path = path("~user/file.txt");   # tilde processing
  #pod
  #pod Constructs a C<Path::Tiny> object.  It doesn't matter if you give a file or
  #pod directory path.  It's still up to you to call directory-like methods only on
  #pod directories and file-like methods only on files.  This function is exported
  #pod automatically by default.
  #pod
  #pod The first argument must be defined and have non-zero length or an exception
  #pod will be thrown.  This prevents subtle, dangerous errors with code like
  #pod C<< path( maybe_undef() )->remove_tree >>.
  #pod
  #pod If the first component of the path is a tilde ('~') then the component will be
  #pod replaced with the output of C<glob('~')>.  If the first component of the path
  #pod is a tilde followed by a user name then the component will be replaced with
  #pod output of C<glob('~username')>.  Behaviour for non-existent users depends on
  #pod the output of C<glob> on the system.
  #pod
  #pod On Windows, if the path consists of a drive identifier without a path component
  #pod (C<C:> or C<D:>), it will be expanded to the absolute path of the current
  #pod directory on that volume using C<Cwd::getdcwd()>.
  #pod
  #pod If called with a single C<Path::Tiny> argument, the original is returned unless
  #pod the original is holding a temporary file or directory reference in which case a
  #pod stringified copy is made.
  #pod
  #pod     $path = path("foo/bar");
  #pod     $temp = Path::Tiny->tempfile;
  #pod
  #pod     $p2 = path($path); # like $p2 = $path
  #pod     $t2 = path($temp); # like $t2 = path( "$temp" )
  #pod
  #pod This optimizes copies without proliferating references unexpectedly if a copy is
  #pod made by code outside your control.
  #pod
  #pod Current API available since 0.017.
  #pod
  #pod =cut
  
  sub path {
      my $path = shift;
      Carp::croak("Path::Tiny paths require defined, positive-length parts")
        unless 1 + @_ == grep { defined && length } $path, @_;
  
      # non-temp Path::Tiny objects are effectively immutable and can be reused
      if ( !@_ && ref($path) eq __PACKAGE__ && !$path->[TEMP] ) {
          return $path;
      }
  
      # stringify objects
      $path = "$path";
  
      # expand relative volume paths on windows; put trailing slash on UNC root
      if ( IS_WIN32() ) {
          $path = _win32_vol( $path, $1 ) if $path =~ m{^($DRV_VOL)(?:$NOTSLASH|$)};
          $path .= "/" if $path =~ m{^$UNC_VOL$};
      }
  
      # concatenations stringifies objects, too
      if (@_) {
          $path .= ( _is_root($path) ? "" : "/" ) . join( "/", @_ );
      }
  
      # canonicalize, but with unix slashes and put back trailing volume slash
      my $cpath = $path = File::Spec->canonpath($path);
      $path =~ tr[\\][/] if IS_WIN32();
      $path = "/" if $path eq '/..'; # for old File::Spec
      $path .= "/" if IS_WIN32() && $path =~ m{^$UNC_VOL$};
  
      # root paths must always have a trailing slash, but other paths must not
      if ( _is_root($path) ) {
          $path =~ s{/?$}{/};
      }
      else {
          $path =~ s{/$}{};
      }
  
      # do any tilde expansions
      if ( $path =~ m{^(~[^/]*).*} ) {
          require File::Glob;
          my ($homedir) = File::Glob::bsd_glob($1);
          $homedir =~ tr[\\][/] if IS_WIN32();
          $path =~ s{^(~[^/]*)}{$homedir};
      }
  
      bless [ $path, $cpath ], __PACKAGE__;
  }
  
  #pod =construct new
  #pod
  #pod     $path = Path::Tiny->new("foo/bar");
  #pod
  #pod This is just like C<path>, but with method call overhead.  (Why would you
  #pod do that?)
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub new { shift; path(@_) }
  
  #pod =construct cwd
  #pod
  #pod     $path = Path::Tiny->cwd; # path( Cwd::getcwd )
  #pod     $path = cwd; # optional export
  #pod
  #pod Gives you the absolute path to the current directory as a C<Path::Tiny> object.
  #pod This is slightly faster than C<< path(".")->absolute >>.
  #pod
  #pod C<cwd> may be exported on request and used as a function instead of as a
  #pod method.
  #pod
  #pod Current API available since 0.018.
  #pod
  #pod =cut
  
  sub cwd {
      require Cwd;
      return path( Cwd::getcwd() );
  }
  
  #pod =construct rootdir
  #pod
  #pod     $path = Path::Tiny->rootdir; # /
  #pod     $path = rootdir;             # optional export 
  #pod
  #pod Gives you C<< File::Spec->rootdir >> as a C<Path::Tiny> object if you're too
  #pod picky for C<path("/")>.
  #pod
  #pod C<rootdir> may be exported on request and used as a function instead of as a
  #pod method.
  #pod
  #pod Current API available since 0.018.
  #pod
  #pod =cut
  
  sub rootdir { path( File::Spec->rootdir ) }
  
  #pod =construct tempfile, tempdir
  #pod
  #pod     $temp = Path::Tiny->tempfile( @options );
  #pod     $temp = Path::Tiny->tempdir( @options );
  #pod     $temp = tempfile( @options ); # optional export
  #pod     $temp = tempdir( @options );  # optional export
  #pod
  #pod C<tempfile> passes the options to C<< File::Temp->new >> and returns a C<Path::Tiny>
  #pod object with the file name.  The C<TMPDIR> option is enabled by default.
  #pod
  #pod The resulting C<File::Temp> object is cached. When the C<Path::Tiny> object is
  #pod destroyed, the C<File::Temp> object will be as well.
  #pod
  #pod C<File::Temp> annoyingly requires you to specify a custom template in slightly
  #pod different ways depending on which function or method you call, but
  #pod C<Path::Tiny> lets you ignore that and can take either a leading template or a
  #pod C<TEMPLATE> option and does the right thing.
  #pod
  #pod     $temp = Path::Tiny->tempfile( "customXXXXXXXX" );             # ok
  #pod     $temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok
  #pod
  #pod The tempfile path object will be normalized to have an absolute path, even if
  #pod created in a relative directory using C<DIR>.  If you want it to have
  #pod the C<realpath> instead, pass a leading options hash like this:
  #pod
  #pod     $real_temp = tempfile({realpath => 1}, @options);
  #pod
  #pod C<tempdir> is just like C<tempfile>, except it calls
  #pod C<< File::Temp->newdir >> instead.
  #pod
  #pod Both C<tempfile> and C<tempdir> may be exported on request and used as
  #pod functions instead of as methods.
  #pod
  #pod B<Note>: for tempfiles, the filehandles from File::Temp are closed and not
  #pod reused.  This is not as secure as using File::Temp handles directly, but is
  #pod less prone to deadlocks or access problems on some platforms.  Think of what
  #pod C<Path::Tiny> gives you to be just a temporary file B<name> that gets cleaned
  #pod up.
  #pod
  #pod B<Note 2>: if you don't want these cleaned up automatically when the object
  #pod is destroyed, File::Temp requires different options for directories and
  #pod files.  Use C<< CLEANUP => 0 >> for directories and C<< UNLINK => 0 >> for
  #pod files.
  #pod
  #pod B<Note 3>: Don't lose the temporary object by chaining a method call instead
  #pod of storing it:
  #pod
  #pod     my $lost = tempdir()->child("foo"); # tempdir cleaned up right away
  #pod
  #pod B<Note 4>: The cached object may be accessed with the L</cached_temp> method.
  #pod Keeping a reference to, or modifying the cached object may break the
  #pod behavior documented above and is not supported.  Use at your own risk.
  #pod
  #pod Current API available since 0.097.
  #pod
  #pod =cut
  
  sub tempfile {
      shift if @_ && $_[0] eq 'Path::Tiny'; # called as method
      my $opts = ( @_ && ref $_[0] eq 'HASH' ) ? shift @_ : {};
      $opts = _get_args( $opts, qw/realpath/ );
  
      my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
      # File::Temp->new demands TEMPLATE
      $args->{TEMPLATE} = $maybe_template->[0] if @$maybe_template;
  
      require File::Temp;
      my $temp = File::Temp->new( TMPDIR => 1, %$args );
      close $temp;
      my $self = $opts->{realpath} ? path($temp)->realpath : path($temp)->absolute;
      $self->[TEMP] = $temp;                # keep object alive while we are
      return $self;
  }
  
  sub tempdir {
      shift if @_ && $_[0] eq 'Path::Tiny'; # called as method
      my $opts = ( @_ && ref $_[0] eq 'HASH' ) ? shift @_ : {};
      $opts = _get_args( $opts, qw/realpath/ );
  
      my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
  
      # File::Temp->newdir demands leading template
      require File::Temp;
      my $temp = File::Temp->newdir( @$maybe_template, TMPDIR => 1, %$args );
      my $self = $opts->{realpath} ? path($temp)->realpath : path($temp)->absolute;
      $self->[TEMP] = $temp;                # keep object alive while we are
      # Some ActiveState Perls for Windows break Cwd in ways that lead
      # File::Temp to get confused about what path to remove; this
      # monkey-patches the object with our own view of the absolute path
      $temp->{REALNAME} = $self->[CANON] if IS_WIN32;
      return $self;
  }
  
  # normalize the various ways File::Temp does templates
  sub _parse_file_temp_args {
      my $leading_template = ( scalar(@_) % 2 == 1 ? shift(@_) : '' );
      my %args = @_;
      %args = map { uc($_), $args{$_} } keys %args;
      my @template = (
            exists $args{TEMPLATE} ? delete $args{TEMPLATE}
          : $leading_template      ? $leading_template
          :                          ()
      );
      return ( \@template, \%args );
  }
  
  #--------------------------------------------------------------------------#
  # Private methods
  #--------------------------------------------------------------------------#
  
  sub _splitpath {
      my ($self) = @_;
      @{$self}[ VOL, DIR, FILE ] = File::Spec->splitpath( $self->[PATH] );
  }
  
  sub _resolve_symlinks {
      my ($self) = @_;
      my $new = $self;
      my ( $count, %seen ) = 0;
      while ( -l $new->[PATH] ) {
          if ( $seen{ $new->[PATH] }++ ) {
              $self->_throw( 'readlink', $self->[PATH], "symlink loop detected" );
          }
          if ( ++$count > 100 ) {
              $self->_throw( 'readlink', $self->[PATH], "maximum symlink depth exceeded" );
          }
          my $resolved = readlink $new->[PATH] or $new->_throw( 'readlink', $new->[PATH] );
          $resolved = path($resolved);
          $new = $resolved->is_absolute ? $resolved : $new->sibling($resolved);
      }
      return $new;
  }
  
  #--------------------------------------------------------------------------#
  # Public methods
  #--------------------------------------------------------------------------#
  
  #pod =method absolute
  #pod
  #pod     $abs = path("foo/bar")->absolute;
  #pod     $abs = path("foo/bar")->absolute("/tmp");
  #pod
  #pod Returns a new C<Path::Tiny> object with an absolute path (or itself if already
  #pod absolute).  If no argument is given, the current directory is used as the
  #pod absolute base path.  If an argument is given, it will be converted to an
  #pod absolute path (if it is not already) and used as the absolute base path.
  #pod
  #pod This will not resolve upward directories ("foo/../bar") unless C<canonpath>
  #pod in L<File::Spec> would normally do so on your platform.  If you need them
  #pod resolved, you must call the more expensive C<realpath> method instead.
  #pod
  #pod On Windows, an absolute path without a volume component will have it added
  #pod based on the current drive.
  #pod
  #pod Current API available since 0.101.
  #pod
  #pod =cut
  
  sub absolute {
      my ( $self, $base ) = @_;
  
      # absolute paths handled differently by OS
      if (IS_WIN32) {
          return $self if length $self->volume;
          # add missing volume
          if ( $self->is_absolute ) {
              require Cwd;
              # use Win32::GetCwd not Cwd::getdcwd because we're sure
              # to have the former but not necessarily the latter
              my ($drv) = Win32::GetCwd() =~ /^($DRV_VOL | $UNC_VOL)/x;
              return path( $drv . $self->[PATH] );
          }
      }
      else {
          return $self if $self->is_absolute;
      }
  
      # no base means use current directory as base
      require Cwd;
      return path( Cwd::getcwd(), $_[0]->[PATH] ) unless defined $base;
  
      # relative base should be made absolute; we check is_absolute rather
      # than unconditionally make base absolute so that "/foo" doesn't become
      # "C:/foo" on Windows.
      $base = path($base);
      return path( ( $base->is_absolute ? $base : $base->absolute ), $_[0]->[PATH] );
  }
  
  #pod =method append, append_raw, append_utf8
  #pod
  #pod     path("foo.txt")->append(@data);
  #pod     path("foo.txt")->append(\@data);
  #pod     path("foo.txt")->append({binmode => ":raw"}, @data);
  #pod     path("foo.txt")->append_raw(@data);
  #pod     path("foo.txt")->append_utf8(@data);
  #pod
  #pod Appends data to a file.  The file is locked with C<flock> prior to writing
  #pod and closed afterwards.  An optional hash reference may be used to pass
  #pod options.  Valid options are:
  #pod
  #pod =for :list
  #pod * C<binmode>: passed to C<binmode()> on the handle used for writing.
  #pod * C<truncate>: truncates the file after locking and before appending
  #pod
  #pod The C<truncate> option is a way to replace the contents of a file
  #pod B<in place>, unlike L</spew> which writes to a temporary file and then
  #pod replaces the original (if it exists).
  #pod
  #pod C<append_raw> is like C<append> with a C<binmode> of C<:unix> for fast,
  #pod unbuffered, raw write.
  #pod
  #pod C<append_utf8> is like C<append> with a C<binmode> of
  #pod C<:unix:encoding(UTF-8)> (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8>
  #pod 0.58+ is installed, a raw append will be done instead on the data encoded
  #pod with C<Unicode::UTF8>.
  #pod
  #pod Current API available since 0.060.
  #pod
  #pod =cut
  
  sub append {
      my ( $self, @data ) = @_;
      my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
      $args = _get_args( $args, qw/binmode truncate/ );
      my $binmode = $args->{binmode};
      $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
      my $mode = $args->{truncate} ? ">" : ">>";
      my $fh = $self->filehandle( { locked => 1 }, $mode, $binmode );
      print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
      close $fh or $self->_throw('close');
  }
  
  sub append_raw {
      my ( $self, @data ) = @_;
      my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
      $args = _get_args( $args, qw/binmode truncate/ );
      $args->{binmode} = ':unix';
      append( $self, $args, @data );
  }
  
  sub append_utf8 {
      my ( $self, @data ) = @_;
      my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
      $args = _get_args( $args, qw/binmode truncate/ );
      if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
          $args->{binmode} = ":unix";
          append( $self, $args, map { Unicode::UTF8::encode_utf8($_) } @data );
      }
      elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
          $args->{binmode} = ":unix:utf8_strict";
          append( $self, $args, @data );
      }
      else {
          $args->{binmode} = ":unix:encoding(UTF-8)";
          append( $self, $args, @data );
      }
  }
  
  #pod =method assert
  #pod
  #pod     $path = path("foo.txt")->assert( sub { $_->exists } );
  #pod
  #pod Returns the invocant after asserting that a code reference argument returns
  #pod true.  When the assertion code reference runs, it will have the invocant
  #pod object in the C<$_> variable.  If it returns false, an exception will be
  #pod thrown.  The assertion code reference may also throw its own exception.
  #pod
  #pod If no assertion is provided, the invocant is returned without error.
  #pod
  #pod Current API available since 0.062.
  #pod
  #pod =cut
  
  sub assert {
      my ( $self, $assertion ) = @_;
      return $self unless $assertion;
      if ( ref $assertion eq 'CODE' ) {
          local $_ = $self;
          $assertion->()
            or Path::Tiny::Error->throw( "assert", $self->[PATH], "failed assertion" );
      }
      else {
          Carp::croak("argument to assert must be a code reference argument");
      }
      return $self;
  }
  
  #pod =method basename
  #pod
  #pod     $name = path("foo/bar.txt")->basename;        # bar.txt
  #pod     $name = path("foo.txt")->basename('.txt');    # foo
  #pod     $name = path("foo.txt")->basename(qr/.txt/);  # foo
  #pod     $name = path("foo.txt")->basename(@suffixes);
  #pod
  #pod Returns the file portion or last directory portion of a path.
  #pod
  #pod Given a list of suffixes as strings or regular expressions, any that match at
  #pod the end of the file portion or last directory portion will be removed before
  #pod the result is returned.
  #pod
  #pod Current API available since 0.054.
  #pod
  #pod =cut
  
  sub basename {
      my ( $self, @suffixes ) = @_;
      $self->_splitpath unless defined $self->[FILE];
      my $file = $self->[FILE];
      for my $s (@suffixes) {
          my $re = ref($s) eq 'Regexp' ? qr/$s$/ : qr/\Q$s\E$/;
          last if $file =~ s/$re//;
      }
      return $file;
  }
  
  #pod =method canonpath
  #pod
  #pod     $canonical = path("foo/bar")->canonpath; # foo\bar on Windows
  #pod
  #pod Returns a string with the canonical format of the path name for
  #pod the platform.  In particular, this means directory separators
  #pod will be C<\> on Windows.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub canonpath { $_[0]->[CANON] }
  
  #pod =method cached_temp
  #pod
  #pod Returns the cached C<File::Temp> or C<File::Temp::Dir> object if the
  #pod C<Path::Tiny> object was created with C</tempfile> or C</tempdir>.
  #pod If there is no such object, this method throws.
  #pod
  #pod B<WARNING>: Keeping a reference to, or modifying the cached object may
  #pod break the behavior documented for temporary files and directories created
  #pod with C<Path::Tiny> and is not supported.  Use at your own risk.
  #pod
  #pod Current API available since 0.101.
  #pod
  #pod =cut
  
  sub cached_temp {
      my $self = shift;
      $self->_throw( "cached_temp", $self, "has no cached File::Temp object" )
        unless defined $self->[TEMP];
      return $self->[TEMP];
  }
  
  #pod =method child
  #pod
  #pod     $file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt"
  #pod     $file = path("/tmp")->child(@parts);
  #pod
  #pod Returns a new C<Path::Tiny> object relative to the original.  Works
  #pod like C<catfile> or C<catdir> from File::Spec, but without caring about
  #pod file or directories.
  #pod
  #pod B<WARNING>: because the argument could contain C<..> or refer to symlinks,
  #pod there is no guarantee that the new path refers to an actual descendent of
  #pod the original.  If this is important to you, transform parent and child with
  #pod L</realpath> and check them with L</subsumes>.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub child {
      my ( $self, @parts ) = @_;
      return path( $self->[PATH], @parts );
  }
  
  #pod =method children
  #pod
  #pod     @paths = path("/tmp")->children;
  #pod     @paths = path("/tmp")->children( qr/\.txt$/ );
  #pod
  #pod Returns a list of C<Path::Tiny> objects for all files and directories
  #pod within a directory.  Excludes "." and ".." automatically.
  #pod
  #pod If an optional C<qr//> argument is provided, it only returns objects for child
  #pod names that match the given regular expression.  Only the base name is used
  #pod for matching:
  #pod
  #pod     @paths = path("/tmp")->children( qr/^foo/ );
  #pod     # matches children like the glob foo*
  #pod
  #pod Current API available since 0.028.
  #pod
  #pod =cut
  
  sub children {
      my ( $self, $filter ) = @_;
      my $dh;
      opendir $dh, $self->[PATH] or $self->_throw('opendir');
      my @children = readdir $dh;
      closedir $dh or $self->_throw('closedir');
  
      if ( not defined $filter ) {
          @children = grep { $_ ne '.' && $_ ne '..' } @children;
      }
      elsif ( $filter && ref($filter) eq 'Regexp' ) {
          @children = grep { $_ ne '.' && $_ ne '..' && $_ =~ $filter } @children;
      }
      else {
          Carp::croak("Invalid argument '$filter' for children()");
      }
  
      return map { path( $self->[PATH], $_ ) } @children;
  }
  
  #pod =method chmod
  #pod
  #pod     path("foo.txt")->chmod(0777);
  #pod     path("foo.txt")->chmod("0755");
  #pod     path("foo.txt")->chmod("go-w");
  #pod     path("foo.txt")->chmod("a=r,u+wx");
  #pod
  #pod Sets file or directory permissions.  The argument can be a numeric mode, a
  #pod octal string beginning with a "0" or a limited subset of the symbolic mode use
  #pod by F</bin/chmod>.
  #pod
  #pod The symbolic mode must be a comma-delimited list of mode clauses.  Clauses must
  #pod match C<< qr/\A([augo]+)([=+-])([rwx]+)\z/ >>, which defines "who", "op" and
  #pod "perms" parameters for each clause.  Unlike F</bin/chmod>, all three parameters
  #pod are required for each clause, multiple ops are not allowed and permissions
  #pod C<stugoX> are not supported.  (See L<File::chmod> for more complex needs.)
  #pod
  #pod Current API available since 0.053.
  #pod
  #pod =cut
  
  sub chmod {
      my ( $self, $new_mode ) = @_;
  
      my $mode;
      if ( $new_mode =~ /\d/ ) {
          $mode = ( $new_mode =~ /^0/ ? oct($new_mode) : $new_mode );
      }
      elsif ( $new_mode =~ /[=+-]/ ) {
          $mode = _symbolic_chmod( $self->stat->mode & 07777, $new_mode ); ## no critic
      }
      else {
          Carp::croak("Invalid mode argument '$new_mode' for chmod()");
      }
  
      CORE::chmod( $mode, $self->[PATH] ) or $self->_throw("chmod");
  
      return 1;
  }
  
  #pod =method copy
  #pod
  #pod     path("/tmp/foo.txt")->copy("/tmp/bar.txt");
  #pod
  #pod Copies the current path to the given destination using L<File::Copy>'s
  #pod C<copy> function. Upon success, returns the C<Path::Tiny> object for the
  #pod newly copied file.
  #pod
  #pod Current API available since 0.070.
  #pod
  #pod =cut
  
  # XXX do recursively for directories?
  sub copy {
      my ( $self, $dest ) = @_;
      require File::Copy;
      File::Copy::copy( $self->[PATH], $dest )
        or Carp::croak("copy failed for $self to $dest: $!");
  
      return -d $dest ? path( $dest, $self->basename ) : path($dest);
  }
  
  #pod =method digest
  #pod
  #pod     $obj = path("/tmp/foo.txt")->digest;        # SHA-256
  #pod     $obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected
  #pod     $obj = path("/tmp/foo.txt")->digest( { chunk_size => 1e6 }, "MD5" );
  #pod
  #pod Returns a hexadecimal digest for a file.  An optional hash reference of options may
  #pod be given.  The only option is C<chunk_size>.  If C<chunk_size> is given, that many
  #pod bytes will be read at a time.  If not provided, the entire file will be slurped
  #pod into memory to compute the digest.
  #pod
  #pod Any subsequent arguments are passed to the constructor for L<Digest> to select
  #pod an algorithm.  If no arguments are given, the default is SHA-256.
  #pod
  #pod Current API available since 0.056.
  #pod
  #pod =cut
  
  sub digest {
      my ( $self, @opts ) = @_;
      my $args = ( @opts && ref $opts[0] eq 'HASH' ) ? shift @opts : {};
      $args = _get_args( $args, qw/chunk_size/ );
      unshift @opts, 'SHA-256' unless @opts;
      require Digest;
      my $digest = Digest->new(@opts);
      if ( $args->{chunk_size} ) {
          my $fh = $self->filehandle( { locked => 1 }, "<", ":unix" );
          my $buf;
          $digest->add($buf) while read $fh, $buf, $args->{chunk_size};
      }
      else {
          $digest->add( $self->slurp_raw );
      }
      return $digest->hexdigest;
  }
  
  #pod =method dirname (deprecated)
  #pod
  #pod     $name = path("/tmp/foo.txt")->dirname; # "/tmp/"
  #pod
  #pod Returns the directory portion you would get from calling
  #pod C<< File::Spec->splitpath( $path->stringify ) >> or C<"."> for a path without a
  #pod parent directory portion.  Because L<File::Spec> is inconsistent, the result
  #pod might or might not have a trailing slash.  Because of this, this method is
  #pod B<deprecated>.
  #pod
  #pod A better, more consistently approach is likely C<< $path->parent->stringify >>,
  #pod which will not have a trailing slash except for a root directory.
  #pod
  #pod Deprecated in 0.056.
  #pod
  #pod =cut
  
  sub dirname {
      my ($self) = @_;
      $self->_splitpath unless defined $self->[DIR];
      return length $self->[DIR] ? $self->[DIR] : ".";
  }
  
  #pod =method edit, edit_raw, edit_utf8
  #pod
  #pod     path("foo.txt")->edit( \&callback, $options );
  #pod     path("foo.txt")->edit_utf8( \&callback );
  #pod     path("foo.txt")->edit_raw( \&callback );
  #pod
  #pod These are convenience methods that allow "editing" a file using a single
  #pod callback argument. They slurp the file using C<slurp>, place the contents
  #pod inside a localized C<$_> variable, call the callback function (without
  #pod arguments), and then write C<$_> (presumably mutated) back to the
  #pod file with C<spew>.
  #pod
  #pod An optional hash reference may be used to pass options.  The only option is
  #pod C<binmode>, which is passed to C<slurp> and C<spew>.
  #pod
  #pod C<edit_utf8> and C<edit_raw> act like their respective C<slurp_*> and
  #pod C<spew_*> methods.
  #pod
  #pod Current API available since 0.077.
  #pod
  #pod =cut
  
  sub edit {
      my $self = shift;
      my $cb   = shift;
      my $args = _get_args( shift, qw/binmode/ );
      Carp::croak("Callback for edit() must be a code reference")
        unless defined($cb) && ref($cb) eq 'CODE';
  
      local $_ =
        $self->slurp( exists( $args->{binmode} ) ? { binmode => $args->{binmode} } : () );
      $cb->();
      $self->spew( $args, $_ );
  
      return;
  }
  
  # this is done long-hand to benefit from slurp_utf8 optimizations
  sub edit_utf8 {
      my ( $self, $cb ) = @_;
      Carp::croak("Callback for edit_utf8() must be a code reference")
        unless defined($cb) && ref($cb) eq 'CODE';
  
      local $_ = $self->slurp_utf8;
      $cb->();
      $self->spew_utf8($_);
  
      return;
  }
  
  sub edit_raw { $_[2] = { binmode => ":unix" }; goto &edit }
  
  #pod =method edit_lines, edit_lines_utf8, edit_lines_raw
  #pod
  #pod     path("foo.txt")->edit_lines( \&callback, $options );
  #pod     path("foo.txt")->edit_lines_utf8( \&callback );
  #pod     path("foo.txt")->edit_lines_raw( \&callback );
  #pod
  #pod These are convenience methods that allow "editing" a file's lines using a
  #pod single callback argument.  They iterate over the file: for each line, the
  #pod line is put into a localized C<$_> variable, the callback function is
  #pod executed (without arguments) and then C<$_> is written to a temporary file.
  #pod When iteration is finished, the temporary file is atomically renamed over
  #pod the original.
  #pod
  #pod An optional hash reference may be used to pass options.  The only option is
  #pod C<binmode>, which is passed to the method that open handles for reading and
  #pod writing.
  #pod
  #pod C<edit_lines_utf8> and C<edit_lines_raw> act like their respective
  #pod C<slurp_*> and C<spew_*> methods.
  #pod
  #pod Current API available since 0.077.
  #pod
  #pod =cut
  
  sub edit_lines {
      my $self = shift;
      my $cb   = shift;
      my $args = _get_args( shift, qw/binmode/ );
      Carp::croak("Callback for edit_lines() must be a code reference")
        unless defined($cb) && ref($cb) eq 'CODE';
  
      my $binmode = $args->{binmode};
      # get default binmode from caller's lexical scope (see "perldoc open")
      $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
  
      # writing need to follow the link and create the tempfile in the same
      # dir for later atomic rename
      my $resolved_path = $self->_resolve_symlinks;
      my $temp          = path( $resolved_path . $$ . int( rand( 2**31 ) ) );
  
      my $temp_fh = $temp->filehandle( { exclusive => 1, locked => 1 }, ">", $binmode );
      my $in_fh = $self->filehandle( { locked => 1 }, '<', $binmode );
  
      local $_;
      while (<$in_fh>) {
          $cb->();
          $temp_fh->print($_);
      }
  
      close $temp_fh or $self->_throw( 'close', $temp );
      close $in_fh or $self->_throw('close');
  
      return $temp->move($resolved_path);
  }
  
  sub edit_lines_raw { $_[2] = { binmode => ":unix" }; goto &edit_lines }
  
  sub edit_lines_utf8 {
      $_[2] = { binmode => ":raw:encoding(UTF-8)" };
      goto &edit_lines;
  }
  
  #pod =method exists, is_file, is_dir
  #pod
  #pod     if ( path("/tmp")->exists ) { ... }     # -e
  #pod     if ( path("/tmp")->is_dir ) { ... }     # -d
  #pod     if ( path("/tmp")->is_file ) { ... }    # -e && ! -d
  #pod
  #pod Implements file test operations, this means the file or directory actually has
  #pod to exist on the filesystem.  Until then, it's just a path.
  #pod
  #pod B<Note>: C<is_file> is not C<-f> because C<-f> is not the opposite of C<-d>.
  #pod C<-f> means "plain file", excluding symlinks, devices, etc. that often can be
  #pod read just like files.
  #pod
  #pod Use C<-f> instead if you really mean to check for a plain file.
  #pod
  #pod Current API available since 0.053.
  #pod
  #pod =cut
  
  sub exists { -e $_[0]->[PATH] }
  
  sub is_file { -e $_[0]->[PATH] && !-d _ }
  
  sub is_dir { -d $_[0]->[PATH] }
  
  #pod =method filehandle
  #pod
  #pod     $fh = path("/tmp/foo.txt")->filehandle($mode, $binmode);
  #pod     $fh = path("/tmp/foo.txt")->filehandle({ locked => 1 }, $mode, $binmode);
  #pod     $fh = path("/tmp/foo.txt")->filehandle({ exclusive => 1  }, $mode, $binmode);
  #pod
  #pod Returns an open file handle.  The C<$mode> argument must be a Perl-style
  #pod read/write mode string ("<" ,">", ">>", etc.).  If a C<$binmode>
  #pod is given, it is set during the C<open> call.
  #pod
  #pod An optional hash reference may be used to pass options.
  #pod
  #pod The C<locked> option governs file locking; if true, handles opened for writing,
  #pod appending or read-write are locked with C<LOCK_EX>; otherwise, they are
  #pod locked with C<LOCK_SH>.  When using C<locked>, ">" or "+>" modes will delay
  #pod truncation until after the lock is acquired.
  #pod
  #pod The C<exclusive> option causes the open() call to fail if the file already
  #pod exists.  This corresponds to the O_EXCL flag to sysopen / open(2).
  #pod C<exclusive> implies C<locked> and will set it for you if you forget it.
  #pod
  #pod See C<openr>, C<openw>, C<openrw>, and C<opena> for sugar.
  #pod
  #pod Current API available since 0.066.
  #pod
  #pod =cut
  
  # Note: must put binmode on open line, not subsequent binmode() call, so things
  # like ":unix" actually stop perlio/crlf from being added
  
  sub filehandle {
      my ( $self, @args ) = @_;
      my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
      $args = _get_args( $args, qw/locked exclusive/ );
      $args->{locked} = 1 if $args->{exclusive};
      my ( $opentype, $binmode ) = @args;
  
      $opentype = "<" unless defined $opentype;
      Carp::croak("Invalid file mode '$opentype'")
        unless grep { $opentype eq $_ } qw/< +< > +> >> +>>/;
  
      $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $opentype, -1, 1 ) }
        unless defined $binmode;
      $binmode = "" unless defined $binmode;
  
      my ( $fh, $lock, $trunc );
      if ( $HAS_FLOCK && $args->{locked} && !$ENV{PERL_PATH_TINY_NO_FLOCK} ) {
          require Fcntl;
          # truncating file modes shouldn't truncate until lock acquired
          if ( grep { $opentype eq $_ } qw( > +> ) ) {
              # sysopen in write mode without truncation
              my $flags = $opentype eq ">" ? Fcntl::O_WRONLY() : Fcntl::O_RDWR();
              $flags |= Fcntl::O_CREAT();
              $flags |= Fcntl::O_EXCL() if $args->{exclusive};
              sysopen( $fh, $self->[PATH], $flags ) or $self->_throw("sysopen");
  
              # fix up the binmode since sysopen() can't specify layers like
              # open() and binmode() can't start with just :unix like open()
              if ( $binmode =~ s/^:unix// ) {
                  # eliminate pseudo-layers
                  binmode( $fh, ":raw" ) or $self->_throw("binmode (:raw)");
                  # strip off real layers until only :unix is left
                  while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
                      binmode( $fh, ":pop" ) or $self->_throw("binmode (:pop)");
                  }
              }
  
              # apply any remaining binmode layers
              if ( length $binmode ) {
                  binmode( $fh, $binmode ) or $self->_throw("binmode ($binmode)");
              }
  
              # ask for lock and truncation
              $lock  = Fcntl::LOCK_EX();
              $trunc = 1;
          }
          elsif ( $^O eq 'aix' && $opentype eq "<" ) {
              # AIX can only lock write handles, so upgrade to RW and LOCK_EX if
              # the file is writable; otherwise give up on locking.  N.B.
              # checking -w before open to determine the open mode is an
              # unavoidable race condition
              if ( -w $self->[PATH] ) {
                  $opentype = "+<";
                  $lock     = Fcntl::LOCK_EX();
              }
          }
          else {
              $lock = $opentype eq "<" ? Fcntl::LOCK_SH() : Fcntl::LOCK_EX();
          }
      }
  
      unless ($fh) {
          my $mode = $opentype . $binmode;
          open $fh, $mode, $self->[PATH] or $self->_throw("open ($mode)");
      }
  
      do { flock( $fh, $lock ) or $self->_throw("flock ($lock)") } if $lock;
      do { truncate( $fh, 0 ) or $self->_throw("truncate") } if $trunc;
  
      return $fh;
  }
  
  #pod =method is_absolute, is_relative
  #pod
  #pod     if ( path("/tmp")->is_absolute ) { ... }
  #pod     if ( path("/tmp")->is_relative ) { ... }
  #pod
  #pod Booleans for whether the path appears absolute or relative.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub is_absolute { substr( $_[0]->dirname, 0, 1 ) eq '/' }
  
  sub is_relative { substr( $_[0]->dirname, 0, 1 ) ne '/' }
  
  #pod =method is_rootdir
  #pod
  #pod     while ( ! $path->is_rootdir ) {
  #pod         $path = $path->parent;
  #pod         ...
  #pod     }
  #pod
  #pod Boolean for whether the path is the root directory of the volume.  I.e. the
  #pod C<dirname> is C<q[/]> and the C<basename> is C<q[]>.
  #pod
  #pod This works even on C<MSWin32> with drives and UNC volumes:
  #pod
  #pod     path("C:/")->is_rootdir;             # true
  #pod     path("//server/share/")->is_rootdir; #true
  #pod
  #pod Current API available since 0.038.
  #pod
  #pod =cut
  
  sub is_rootdir {
      my ($self) = @_;
      $self->_splitpath unless defined $self->[DIR];
      return $self->[DIR] eq '/' && $self->[FILE] eq '';
  }
  
  #pod =method iterator
  #pod
  #pod     $iter = path("/tmp")->iterator( \%options );
  #pod
  #pod Returns a code reference that walks a directory lazily.  Each invocation
  #pod returns a C<Path::Tiny> object or undef when the iterator is exhausted.
  #pod
  #pod     $iter = path("/tmp")->iterator;
  #pod     while ( $path = $iter->() ) {
  #pod         ...
  #pod     }
  #pod
  #pod The current and parent directory entries ("." and "..") will not
  #pod be included.
  #pod
  #pod If the C<recurse> option is true, the iterator will walk the directory
  #pod recursively, breadth-first.  If the C<follow_symlinks> option is also true,
  #pod directory links will be followed recursively.  There is no protection against
  #pod loops when following links. If a directory is not readable, it will not be
  #pod followed.
  #pod
  #pod The default is the same as:
  #pod
  #pod     $iter = path("/tmp")->iterator( {
  #pod         recurse         => 0,
  #pod         follow_symlinks => 0,
  #pod     } );
  #pod
  #pod For a more powerful, recursive iterator with built-in loop avoidance, see
  #pod L<Path::Iterator::Rule>.
  #pod
  #pod See also L</visit>.
  #pod
  #pod Current API available since 0.016.
  #pod
  #pod =cut
  
  sub iterator {
      my $self = shift;
      my $args = _get_args( shift, qw/recurse follow_symlinks/ );
      my @dirs = $self;
      my $current;
      return sub {
          my $next;
          while (@dirs) {
              if ( ref $dirs[0] eq 'Path::Tiny' ) {
                  if ( !-r $dirs[0] ) {
                      # Directory is missing or not readable, so skip it.  There
                      # is still a race condition possible between the check and
                      # the opendir, but we can't easily differentiate between
                      # error cases that are OK to skip and those that we want
                      # to be exceptions, so we live with the race and let opendir
                      # be fatal.
                      shift @dirs and next;
                  }
                  $current = $dirs[0];
                  my $dh;
                  opendir( $dh, $current->[PATH] )
                    or $self->_throw( 'opendir', $current->[PATH] );
                  $dirs[0] = $dh;
                  if ( -l $current->[PATH] && !$args->{follow_symlinks} ) {
                      # Symlink attack! It was a real dir, but is now a symlink!
                      # N.B. we check *after* opendir so the attacker has to win
                      # two races: replace dir with symlink before opendir and
                      # replace symlink with dir before -l check above
                      shift @dirs and next;
                  }
              }
              while ( defined( $next = readdir $dirs[0] ) ) {
                  next if $next eq '.' || $next eq '..';
                  my $path = $current->child($next);
                  push @dirs, $path
                    if $args->{recurse} && -d $path && !( !$args->{follow_symlinks} && -l $path );
                  return $path;
              }
              shift @dirs;
          }
          return;
      };
  }
  
  #pod =method lines, lines_raw, lines_utf8
  #pod
  #pod     @contents = path("/tmp/foo.txt")->lines;
  #pod     @contents = path("/tmp/foo.txt")->lines(\%options);
  #pod     @contents = path("/tmp/foo.txt")->lines_raw;
  #pod     @contents = path("/tmp/foo.txt")->lines_utf8;
  #pod
  #pod     @contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } );
  #pod
  #pod Returns a list of lines from a file.  Optionally takes a hash-reference of
  #pod options.  Valid options are C<binmode>, C<count> and C<chomp>.
  #pod
  #pod If C<binmode> is provided, it will be set on the handle prior to reading.
  #pod
  #pod If a positive C<count> is provided, that many lines will be returned from the
  #pod start of the file.  If a negative C<count> is provided, the entire file will be
  #pod read, but only C<abs(count)> will be kept and returned.  If C<abs(count)>
  #pod exceeds the number of lines in the file, all lines will be returned.
  #pod
  #pod If C<chomp> is set, any end-of-line character sequences (C<CR>, C<CRLF>, or
  #pod C<LF>) will be removed from the lines returned.
  #pod
  #pod Because the return is a list, C<lines> in scalar context will return the number
  #pod of lines (and throw away the data).
  #pod
  #pod     $number_of_lines = path("/tmp/foo.txt")->lines;
  #pod
  #pod C<lines_raw> is like C<lines> with a C<binmode> of C<:raw>.  We use C<:raw>
  #pod instead of C<:unix> so PerlIO buffering can manage reading by line.
  #pod
  #pod C<lines_utf8> is like C<lines> with a C<binmode> of C<:raw:encoding(UTF-8)>
  #pod (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8> 0.58+ is installed, a raw
  #pod UTF-8 slurp will be done and then the lines will be split.  This is
  #pod actually faster than relying on C<:encoding(UTF-8)>, though a bit memory
  #pod intensive.  If memory use is a concern, consider C<openr_utf8> and
  #pod iterating directly on the handle.
  #pod
  #pod Current API available since 0.065.
  #pod
  #pod =cut
  
  sub lines {
      my $self    = shift;
      my $args    = _get_args( shift, qw/binmode chomp count/ );
      my $binmode = $args->{binmode};
      $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
      my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
      my $chomp = $args->{chomp};
      # XXX more efficient to read @lines then chomp(@lines) vs map?
      if ( $args->{count} ) {
          my ( $counter, $mod, @result ) = ( 0, abs( $args->{count} ) );
          while ( my $line = <$fh> ) {
              $line =~ s/(?:\x{0d}?\x{0a}|\x{0d})$// if $chomp;
              $result[ $counter++ ] = $line;
              # for positive count, terminate after right number of lines
              last if $counter == $args->{count};
              # for negative count, eventually wrap around in the result array
              $counter %= $mod;
          }
          # reorder results if full and wrapped somewhere in the middle
          splice( @result, 0, 0, splice( @result, $counter ) )
            if @result == $mod && $counter % $mod;
          return @result;
      }
      elsif ($chomp) {
          return map { s/(?:\x{0d}?\x{0a}|\x{0d})$//; $_ } <$fh>; ## no critic
      }
      else {
          return wantarray ? <$fh> : ( my $count =()= <$fh> );
      }
  }
  
  sub lines_raw {
      my $self = shift;
      my $args = _get_args( shift, qw/binmode chomp count/ );
      if ( $args->{chomp} && !$args->{count} ) {
          return split /\n/, slurp_raw($self);                    ## no critic
      }
      else {
          $args->{binmode} = ":raw";
          return lines( $self, $args );
      }
  }
  
  my $CRLF = qr/(?:\x{0d}?\x{0a}|\x{0d})/;
  
  sub lines_utf8 {
      my $self = shift;
      my $args = _get_args( shift, qw/binmode chomp count/ );
      if (   ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) )
          && $args->{chomp}
          && !$args->{count} )
      {
          my $slurp = slurp_utf8($self);
          $slurp =~ s/$CRLF$//; # like chomp, but full CR?LF|CR
          return split $CRLF, $slurp, -1; ## no critic
      }
      elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
          $args->{binmode} = ":unix:utf8_strict";
          return lines( $self, $args );
      }
      else {
          $args->{binmode} = ":raw:encoding(UTF-8)";
          return lines( $self, $args );
      }
  }
  
  #pod =method mkpath
  #pod
  #pod     path("foo/bar/baz")->mkpath;
  #pod     path("foo/bar/baz")->mkpath( \%options );
  #pod
  #pod Like calling C<make_path> from L<File::Path>.  An optional hash reference
  #pod is passed through to C<make_path>.  Errors will be trapped and an exception
  #pod thrown.  Returns the list of directories created or an empty list if
  #pod the directories already exist, just like C<make_path>.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub mkpath {
      my ( $self, $args ) = @_;
      $args = {} unless ref $args eq 'HASH';
      my $err;
      $args->{error} = \$err unless defined $args->{error};
      require File::Path;
      my @dirs = File::Path::make_path( $self->[PATH], $args );
      if ( $err && @$err ) {
          my ( $file, $message ) = %{ $err->[0] };
          Carp::croak("mkpath failed for $file: $message");
      }
      return @dirs;
  }
  
  #pod =method move
  #pod
  #pod     path("foo.txt")->move("bar.txt");
  #pod
  #pod Move the current path to the given destination path using Perl's
  #pod built-in L<rename|perlfunc/rename> function. Returns the result
  #pod of the C<rename> function (except it throws an exception if it fails).
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub move {
      my ( $self, $dst ) = @_;
  
      return rename( $self->[PATH], $dst )
        || $self->_throw( 'rename', $self->[PATH] . "' -> '$dst" );
  }
  
  #pod =method openr, openw, openrw, opena
  #pod
  #pod     $fh = path("foo.txt")->openr($binmode);  # read
  #pod     $fh = path("foo.txt")->openr_raw;
  #pod     $fh = path("foo.txt")->openr_utf8;
  #pod
  #pod     $fh = path("foo.txt")->openw($binmode);  # write
  #pod     $fh = path("foo.txt")->openw_raw;
  #pod     $fh = path("foo.txt")->openw_utf8;
  #pod
  #pod     $fh = path("foo.txt")->opena($binmode);  # append
  #pod     $fh = path("foo.txt")->opena_raw;
  #pod     $fh = path("foo.txt")->opena_utf8;
  #pod
  #pod     $fh = path("foo.txt")->openrw($binmode); # read/write
  #pod     $fh = path("foo.txt")->openrw_raw;
  #pod     $fh = path("foo.txt")->openrw_utf8;
  #pod
  #pod Returns a file handle opened in the specified mode.  The C<openr> style methods
  #pod take a single C<binmode> argument.  All of the C<open*> methods have
  #pod C<open*_raw> and C<open*_utf8> equivalents that use C<:raw> and
  #pod C<:raw:encoding(UTF-8)>, respectively.
  #pod
  #pod An optional hash reference may be used to pass options.  The only option is
  #pod C<locked>.  If true, handles opened for writing, appending or read-write are
  #pod locked with C<LOCK_EX>; otherwise, they are locked for C<LOCK_SH>.
  #pod
  #pod     $fh = path("foo.txt")->openrw_utf8( { locked => 1 } );
  #pod
  #pod See L</filehandle> for more on locking.
  #pod
  #pod Current API available since 0.011.
  #pod
  #pod =cut
  
  # map method names to corresponding open mode
  my %opens = (
      opena  => ">>",
      openr  => "<",
      openw  => ">",
      openrw => "+<"
  );
  
  while ( my ( $k, $v ) = each %opens ) {
      no strict 'refs';
      # must check for lexical IO mode hint
      *{$k} = sub {
          my ( $self, @args ) = @_;
          my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
          $args = _get_args( $args, qw/locked/ );
          my ($binmode) = @args;
          $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $v, -1, 1 ) }
            unless defined $binmode;
          $self->filehandle( $args, $v, $binmode );
      };
      *{ $k . "_raw" } = sub {
          my ( $self, @args ) = @_;
          my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
          $args = _get_args( $args, qw/locked/ );
          $self->filehandle( $args, $v, ":raw" );
      };
      *{ $k . "_utf8" } = sub {
          my ( $self, @args ) = @_;
          my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
          $args = _get_args( $args, qw/locked/ );
          $self->filehandle( $args, $v, ":raw:encoding(UTF-8)" );
      };
  }
  
  #pod =method parent
  #pod
  #pod     $parent = path("foo/bar/baz")->parent; # foo/bar
  #pod     $parent = path("foo/wibble.txt")->parent; # foo
  #pod
  #pod     $parent = path("foo/bar/baz")->parent(2); # foo
  #pod
  #pod Returns a C<Path::Tiny> object corresponding to the parent directory of the
  #pod original directory or file. An optional positive integer argument is the number
  #pod of parent directories upwards to return.  C<parent> by itself is equivalent to
  #pod C<parent(1)>.
  #pod
  #pod Current API available since 0.014.
  #pod
  #pod =cut
  
  # XXX this is ugly and coverage is incomplete.  I think it's there for windows
  # so need to check coverage there and compare
  sub parent {
      my ( $self, $level ) = @_;
      $level = 1 unless defined $level && $level > 0;
      $self->_splitpath unless defined $self->[FILE];
      my $parent;
      if ( length $self->[FILE] ) {
          if ( $self->[FILE] eq '.' || $self->[FILE] eq ".." ) {
              $parent = path( $self->[PATH] . "/.." );
          }
          else {
              $parent = path( _non_empty( $self->[VOL] . $self->[DIR] ) );
          }
      }
      elsif ( length $self->[DIR] ) {
          # because of symlinks, any internal updir requires us to
          # just add more updirs at the end
          if ( $self->[DIR] =~ m{(?:^\.\./|/\.\./|/\.\.$)} ) {
              $parent = path( $self->[VOL] . $self->[DIR] . "/.." );
          }
          else {
              ( my $dir = $self->[DIR] ) =~ s{/[^\/]+/$}{/};
              $parent = path( $self->[VOL] . $dir );
          }
      }
      else {
          $parent = path( _non_empty( $self->[VOL] ) );
      }
      return $level == 1 ? $parent : $parent->parent( $level - 1 );
  }
  
  sub _non_empty {
      my ($string) = shift;
      return ( ( defined($string) && length($string) ) ? $string : "." );
  }
  
  #pod =method realpath
  #pod
  #pod     $real = path("/baz/foo/../bar")->realpath;
  #pod     $real = path("foo/../bar")->realpath;
  #pod
  #pod Returns a new C<Path::Tiny> object with all symbolic links and upward directory
  #pod parts resolved using L<Cwd>'s C<realpath>.  Compared to C<absolute>, this is
  #pod more expensive as it must actually consult the filesystem.
  #pod
  #pod If the parent path can't be resolved (e.g. if it includes directories that
  #pod don't exist), an exception will be thrown:
  #pod
  #pod     $real = path("doesnt_exist/foo")->realpath; # dies
  #pod
  #pod However, if the parent path exists and only the last component (e.g. filename)
  #pod doesn't exist, the realpath will be the realpath of the parent plus the
  #pod non-existent last component:
  #pod
  #pod     $real = path("./aasdlfasdlf")->realpath; # works
  #pod
  #pod The underlying L<Cwd> module usually worked this way on Unix, but died on
  #pod Windows (and some Unixes) if the full path didn't exist.  As of version 0.064,
  #pod it's safe to use anywhere.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  # Win32 and some Unixes need parent path resolved separately so realpath
  # doesn't throw an error resolving non-existent basename
  sub realpath {
      my $self = shift;
      $self = $self->_resolve_symlinks;
      require Cwd;
      $self->_splitpath if !defined $self->[FILE];
      my $check_parent =
        length $self->[FILE] && $self->[FILE] ne '.' && $self->[FILE] ne '..';
      my $realpath = eval {
          # pure-perl Cwd can carp
          local $SIG{__WARN__} = sub { };
          Cwd::realpath( $check_parent ? $self->parent->[PATH] : $self->[PATH] );
      };
      # parent realpath must exist; not all Cwd::realpath will error if it doesn't
      $self->_throw("resolving realpath")
        unless defined $realpath && length $realpath && -e $realpath;
      return ( $check_parent ? path( $realpath, $self->[FILE] ) : path($realpath) );
  }
  
  #pod =method relative
  #pod
  #pod     $rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar
  #pod
  #pod Returns a C<Path::Tiny> object with a path relative to a new base path
  #pod given as an argument.  If no argument is given, the current directory will
  #pod be used as the new base path.
  #pod
  #pod If either path is already relative, it will be made absolute based on the
  #pod current directly before determining the new relative path.
  #pod
  #pod The algorithm is roughly as follows:
  #pod
  #pod =for :list
  #pod * If the original and new base path are on different volumes, an exception
  #pod   will be thrown.
  #pod * If the original and new base are identical, the relative path is C<".">.
  #pod * If the new base subsumes the original, the relative path is the original
  #pod   path with the new base chopped off the front
  #pod * If the new base does not subsume the original, a common prefix path is
  #pod   determined (possibly the root directory) and the relative path will
  #pod   consist of updirs (C<"..">) to reach the common prefix, followed by the
  #pod   original path less the common prefix.
  #pod
  #pod Unlike C<File::Spec::abs2rel>, in the last case above, the calculation based
  #pod on a common prefix takes into account symlinks that could affect the updir
  #pod process.  Given an original path "/A/B" and a new base "/A/C",
  #pod (where "A", "B" and "C" could each have multiple path components):
  #pod
  #pod =for :list
  #pod * Symlinks in "A" don't change the result unless the last component of A is
  #pod   a symlink and the first component of "C" is an updir.
  #pod * Symlinks in "B" don't change the result and will exist in the result as
  #pod   given.
  #pod * Symlinks and updirs in "C" must be resolved to actual paths, taking into
  #pod   account the possibility that not all path components might exist on the
  #pod   filesystem.
  #pod
  #pod Current API available since 0.001.  New algorithm (that accounts for
  #pod symlinks) available since 0.079.
  #pod
  #pod =cut
  
  sub relative {
      my ( $self, $base ) = @_;
      $base = path( defined $base && length $base ? $base : '.' );
  
      # relative paths must be converted to absolute first
      $self = $self->absolute if $self->is_relative;
      $base = $base->absolute if $base->is_relative;
  
      # normalize volumes if they exist
      $self = $self->absolute if !length $self->volume && length $base->volume;
      $base = $base->absolute if length $self->volume  && !length $base->volume;
  
      # can't make paths relative across volumes
      if ( !_same( $self->volume, $base->volume ) ) {
          Carp::croak("relative() can't cross volumes: '$self' vs '$base'");
      }
  
      # if same absolute path, relative is current directory
      return path(".") if _same( $self->[PATH], $base->[PATH] );
  
      # if base is a prefix of self, chop prefix off self
      if ( $base->subsumes($self) ) {
          $base = "" if $base->is_rootdir;
          my $relative = "$self";
          $relative =~ s{\A\Q$base/}{};
          return path($relative);
      }
  
      # base is not a prefix, so must find a common prefix (even if root)
      my ( @common, @self_parts, @base_parts );
      @base_parts = split /\//, $base->_just_filepath;
  
      # if self is rootdir, then common directory is root (shown as empty
      # string for later joins); otherwise, must be computed from path parts.
      if ( $self->is_rootdir ) {
          @common = ("");
          shift @base_parts;
      }
      else {
          @self_parts = split /\//, $self->_just_filepath;
  
          while ( @self_parts && @base_parts && _same( $self_parts[0], $base_parts[0] ) ) {
              push @common, shift @base_parts;
              shift @self_parts;
          }
      }
  
      # if there are any symlinks from common to base, we have a problem, as
      # you can't guarantee that updir from base reaches the common prefix;
      # we must resolve symlinks and try again; likewise, any updirs are
      # a problem as it throws off calculation of updirs needed to get from
      # self's path to the common prefix.
      if ( my $new_base = $self->_resolve_between( \@common, \@base_parts ) ) {
          return $self->relative($new_base);
      }
  
      # otherwise, symlinks in common or from common to A don't matter as
      # those don't involve updirs
      my @new_path = ( ("..") x ( 0+ @base_parts ), @self_parts );
      return path(@new_path);
  }
  
  sub _just_filepath {
      my $self     = shift;
      my $self_vol = $self->volume;
      return "$self" if !length $self_vol;
  
      ( my $self_path = "$self" ) =~ s{\A\Q$self_vol}{};
  
      return $self_path;
  }
  
  sub _resolve_between {
      my ( $self, $common, $base ) = @_;
      my $path = $self->volume . join( "/", @$common );
      my $changed = 0;
      for my $p (@$base) {
          $path .= "/$p";
          if ( $p eq '..' ) {
              $changed = 1;
              if ( -e $path ) {
                  $path = path($path)->realpath->[PATH];
              }
              else {
                  $path =~ s{/[^/]+/..$}{/};
              }
          }
          if ( -l $path ) {
              $changed = 1;
              $path    = path($path)->realpath->[PATH];
          }
      }
      return $changed ? path($path) : undef;
  }
  
  #pod =method remove
  #pod
  #pod     path("foo.txt")->remove;
  #pod
  #pod This is just like C<unlink>, except for its error handling: if the path does
  #pod not exist, it returns false; if deleting the file fails, it throws an
  #pod exception.
  #pod
  #pod Current API available since 0.012.
  #pod
  #pod =cut
  
  sub remove {
      my $self = shift;
  
      return 0 if !-e $self->[PATH] && !-l $self->[PATH];
  
      return unlink( $self->[PATH] ) || $self->_throw('unlink');
  }
  
  #pod =method remove_tree
  #pod
  #pod     # directory
  #pod     path("foo/bar/baz")->remove_tree;
  #pod     path("foo/bar/baz")->remove_tree( \%options );
  #pod     path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove
  #pod
  #pod Like calling C<remove_tree> from L<File::Path>, but defaults to C<safe> mode.
  #pod An optional hash reference is passed through to C<remove_tree>.  Errors will be
  #pod trapped and an exception thrown.  Returns the number of directories deleted,
  #pod just like C<remove_tree>.
  #pod
  #pod If you want to remove a directory only if it is empty, use the built-in
  #pod C<rmdir> function instead.
  #pod
  #pod     rmdir path("foo/bar/baz/");
  #pod
  #pod Current API available since 0.013.
  #pod
  #pod =cut
  
  sub remove_tree {
      my ( $self, $args ) = @_;
      return 0 if !-e $self->[PATH] && !-l $self->[PATH];
      $args = {} unless ref $args eq 'HASH';
      my $err;
      $args->{error} = \$err unless defined $args->{error};
      $args->{safe}  = 1     unless defined $args->{safe};
      require File::Path;
      my $count = File::Path::remove_tree( $self->[PATH], $args );
  
      if ( $err && @$err ) {
          my ( $file, $message ) = %{ $err->[0] };
          Carp::croak("remove_tree failed for $file: $message");
      }
      return $count;
  }
  
  #pod =method sibling
  #pod
  #pod     $foo = path("/tmp/foo.txt");
  #pod     $sib = $foo->sibling("bar.txt");        # /tmp/bar.txt
  #pod     $sib = $foo->sibling("baz", "bam.txt"); # /tmp/baz/bam.txt
  #pod
  #pod Returns a new C<Path::Tiny> object relative to the parent of the original.
  #pod This is slightly more efficient than C<< $path->parent->child(...) >>.
  #pod
  #pod Current API available since 0.058.
  #pod
  #pod =cut
  
  sub sibling {
      my $self = shift;
      return path( $self->parent->[PATH], @_ );
  }
  
  #pod =method slurp, slurp_raw, slurp_utf8
  #pod
  #pod     $data = path("foo.txt")->slurp;
  #pod     $data = path("foo.txt")->slurp( {binmode => ":raw"} );
  #pod     $data = path("foo.txt")->slurp_raw;
  #pod     $data = path("foo.txt")->slurp_utf8;
  #pod
  #pod Reads file contents into a scalar.  Takes an optional hash reference which may
  #pod be used to pass options.  The only available option is C<binmode>, which is
  #pod passed to C<binmode()> on the handle used for reading.
  #pod
  #pod C<slurp_raw> is like C<slurp> with a C<binmode> of C<:unix> for
  #pod a fast, unbuffered, raw read.
  #pod
  #pod C<slurp_utf8> is like C<slurp> with a C<binmode> of
  #pod C<:unix:encoding(UTF-8)> (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8>
  #pod 0.58+ is installed, a raw slurp will be done instead and the result decoded
  #pod with C<Unicode::UTF8>.  This is just as strict and is roughly an order of
  #pod magnitude faster than using C<:encoding(UTF-8)>.
  #pod
  #pod B<Note>: C<slurp> and friends lock the filehandle before slurping.  If
  #pod you plan to slurp from a file created with L<File::Temp>, be sure to
  #pod close other handles or open without locking to avoid a deadlock:
  #pod
  #pod     my $tempfile = File::Temp->new(EXLOCK => 0);
  #pod     my $guts = path($tempfile)->slurp;
  #pod
  #pod Current API available since 0.004.
  #pod
  #pod =cut
  
  sub slurp {
      my $self    = shift;
      my $args    = _get_args( shift, qw/binmode/ );
      my $binmode = $args->{binmode};
      $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
      my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
      if ( ( defined($binmode) ? $binmode : "" ) eq ":unix"
          and my $size = -s $fh )
      {
          my $buf;
          read $fh, $buf, $size; # File::Slurp in a nutshell
          return $buf;
      }
      else {
          local $/;
          return scalar <$fh>;
      }
  }
  
  sub slurp_raw { $_[1] = { binmode => ":unix" }; goto &slurp }
  
  sub slurp_utf8 {
      if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
          return Unicode::UTF8::decode_utf8( slurp( $_[0], { binmode => ":unix" } ) );
      }
      elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
          $_[1] = { binmode => ":unix:utf8_strict" };
          goto &slurp;
      }
      else {
          $_[1] = { binmode => ":raw:encoding(UTF-8)" };
          goto &slurp;
      }
  }
  
  #pod =method spew, spew_raw, spew_utf8
  #pod
  #pod     path("foo.txt")->spew(@data);
  #pod     path("foo.txt")->spew(\@data);
  #pod     path("foo.txt")->spew({binmode => ":raw"}, @data);
  #pod     path("foo.txt")->spew_raw(@data);
  #pod     path("foo.txt")->spew_utf8(@data);
  #pod
  #pod Writes data to a file atomically.  The file is written to a temporary file in
  #pod the same directory, then renamed over the original.  An optional hash reference
  #pod may be used to pass options.  The only option is C<binmode>, which is passed to
  #pod C<binmode()> on the handle used for writing.
  #pod
  #pod C<spew_raw> is like C<spew> with a C<binmode> of C<:unix> for a fast,
  #pod unbuffered, raw write.
  #pod
  #pod C<spew_utf8> is like C<spew> with a C<binmode> of C<:unix:encoding(UTF-8)>
  #pod (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8> 0.58+ is installed, a raw
  #pod spew will be done instead on the data encoded with C<Unicode::UTF8>.
  #pod
  #pod B<NOTE>: because the file is written to a temporary file and then renamed, the
  #pod new file will wind up with permissions based on your current umask.  This is a
  #pod feature to protect you from a race condition that would otherwise give
  #pod different permissions than you might expect.  If you really want to keep the
  #pod original mode flags, use L</append> with the C<truncate> option.
  #pod
  #pod Current API available since 0.011.
  #pod
  #pod =cut
  
  # XXX add "unsafe" option to disable flocking and atomic?  Check benchmarks on append() first.
  sub spew {
      my ( $self, @data ) = @_;
      my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
      $args = _get_args( $args, qw/binmode/ );
      my $binmode = $args->{binmode};
      # get default binmode from caller's lexical scope (see "perldoc open")
      $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
  
      # spewing need to follow the link
      # and create the tempfile in the same dir
      my $resolved_path = $self->_resolve_symlinks;
  
      my $temp = path( $resolved_path . $$ . int( rand( 2**31 ) ) );
      my $fh = $temp->filehandle( { exclusive => 1, locked => 1 }, ">", $binmode );
      print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
      close $fh or $self->_throw( 'close', $temp->[PATH] );
  
      return $temp->move($resolved_path);
  }
  
  sub spew_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &spew }
  
  sub spew_utf8 {
      if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
          my $self = shift;
          spew(
              $self,
              { binmode => ":unix" },
              map { Unicode::UTF8::encode_utf8($_) } map { ref eq 'ARRAY' ? @$_ : $_ } @_
          );
      }
      elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
          splice @_, 1, 0, { binmode => ":unix:utf8_strict" };
          goto &spew;
      }
      else {
          splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" };
          goto &spew;
      }
  }
  
  #pod =method stat, lstat
  #pod
  #pod     $stat = path("foo.txt")->stat;
  #pod     $stat = path("/some/symlink")->lstat;
  #pod
  #pod Like calling C<stat> or C<lstat> from L<File::stat>.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  # XXX break out individual stat() components as subs?
  sub stat {
      my $self = shift;
      require File::stat;
      return File::stat::stat( $self->[PATH] ) || $self->_throw('stat');
  }
  
  sub lstat {
      my $self = shift;
      require File::stat;
      return File::stat::lstat( $self->[PATH] ) || $self->_throw('lstat');
  }
  
  #pod =method stringify
  #pod
  #pod     $path = path("foo.txt");
  #pod     say $path->stringify; # same as "$path"
  #pod
  #pod Returns a string representation of the path.  Unlike C<canonpath>, this method
  #pod returns the path standardized with Unix-style C</> directory separators.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub stringify { $_[0]->[PATH] }
  
  #pod =method subsumes
  #pod
  #pod     path("foo/bar")->subsumes("foo/bar/baz"); # true
  #pod     path("/foo/bar")->subsumes("/foo/baz");   # false
  #pod
  #pod Returns true if the first path is a prefix of the second path at a directory
  #pod boundary.
  #pod
  #pod This B<does not> resolve parent directory entries (C<..>) or symlinks:
  #pod
  #pod     path("foo/bar")->subsumes("foo/bar/../baz"); # true
  #pod
  #pod If such things are important to you, ensure that both paths are resolved to
  #pod the filesystem with C<realpath>:
  #pod
  #pod     my $p1 = path("foo/bar")->realpath;
  #pod     my $p2 = path("foo/bar/../baz")->realpath;
  #pod     if ( $p1->subsumes($p2) ) { ... }
  #pod
  #pod Current API available since 0.048.
  #pod
  #pod =cut
  
  sub subsumes {
      my $self = shift;
      Carp::croak("subsumes() requires a defined, positive-length argument")
        unless defined $_[0];
      my $other = path(shift);
  
      # normalize absolute vs relative
      if ( $self->is_absolute && !$other->is_absolute ) {
          $other = $other->absolute;
      }
      elsif ( $other->is_absolute && !$self->is_absolute ) {
          $self = $self->absolute;
      }
  
      # normalize volume vs non-volume; do this after absolute path
      # adjustments above since that might add volumes already
      if ( length $self->volume && !length $other->volume ) {
          $other = $other->absolute;
      }
      elsif ( length $other->volume && !length $self->volume ) {
          $self = $self->absolute;
      }
  
      if ( $self->[PATH] eq '.' ) {
          return !!1; # cwd subsumes everything relative
      }
      elsif ( $self->is_rootdir ) {
          # a root directory ("/", "c:/") already ends with a separator
          return $other->[PATH] =~ m{^\Q$self->[PATH]\E};
      }
      else {
          # exact match or prefix breaking at a separator
          return $other->[PATH] =~ m{^\Q$self->[PATH]\E(?:/|$)};
      }
  }
  
  #pod =method touch
  #pod
  #pod     path("foo.txt")->touch;
  #pod     path("foo.txt")->touch($epoch_secs);
  #pod
  #pod Like the Unix C<touch> utility.  Creates the file if it doesn't exist, or else
  #pod changes the modification and access times to the current time.  If the first
  #pod argument is the epoch seconds then it will be used.
  #pod
  #pod Returns the path object so it can be easily chained with other methods:
  #pod
  #pod     # won't die if foo.txt doesn't exist
  #pod     $content = path("foo.txt")->touch->slurp;
  #pod
  #pod Current API available since 0.015.
  #pod
  #pod =cut
  
  sub touch {
      my ( $self, $epoch ) = @_;
      if ( !-e $self->[PATH] ) {
          my $fh = $self->openw;
          close $fh or $self->_throw('close');
      }
      if ( defined $epoch ) {
          utime $epoch, $epoch, $self->[PATH]
            or $self->_throw("utime ($epoch)");
      }
      else {
          # literal undef prevents warnings :-(
          utime undef, undef, $self->[PATH]
            or $self->_throw("utime ()");
      }
      return $self;
  }
  
  #pod =method touchpath
  #pod
  #pod     path("bar/baz/foo.txt")->touchpath;
  #pod
  #pod Combines C<mkpath> and C<touch>.  Creates the parent directory if it doesn't exist,
  #pod before touching the file.  Returns the path object like C<touch> does.
  #pod
  #pod Current API available since 0.022.
  #pod
  #pod =cut
  
  sub touchpath {
      my ($self) = @_;
      my $parent = $self->parent;
      $parent->mkpath unless $parent->exists;
      $self->touch;
  }
  
  #pod =method visit
  #pod
  #pod     path("/tmp")->visit( \&callback, \%options );
  #pod
  #pod Executes a callback for each child of a directory.  It returns a hash
  #pod reference with any state accumulated during iteration.
  #pod
  #pod The options are the same as for L</iterator> (which it uses internally):
  #pod C<recurse> and C<follow_symlinks>.  Both default to false.
  #pod
  #pod The callback function will receive a C<Path::Tiny> object as the first argument
  #pod and a hash reference to accumulate state as the second argument.  For example:
  #pod
  #pod     # collect files sizes
  #pod     my $sizes = path("/tmp")->visit(
  #pod         sub {
  #pod             my ($path, $state) = @_;
  #pod             return if $path->is_dir;
  #pod             $state->{$path} = -s $path;
  #pod         },
  #pod         { recurse => 1 }
  #pod     );
  #pod
  #pod For convenience, the C<Path::Tiny> object will also be locally aliased as the
  #pod C<$_> global variable:
  #pod
  #pod     # print paths matching /foo/
  #pod     path("/tmp")->visit( sub { say if /foo/ }, { recurse => 1} );
  #pod
  #pod If the callback returns a B<reference> to a false scalar value, iteration will
  #pod terminate.  This is not the same as "pruning" a directory search; this just
  #pod stops all iteration and returns the state hash reference.
  #pod
  #pod     # find up to 10 files larger than 100K
  #pod     my $files = path("/tmp")->visit(
  #pod         sub {
  #pod             my ($path, $state) = @_;
  #pod             $state->{$path}++ if -s $path > 102400
  #pod             return \0 if keys %$state == 10;
  #pod         },
  #pod         { recurse => 1 }
  #pod     );
  #pod
  #pod If you want more flexible iteration, use a module like L<Path::Iterator::Rule>.
  #pod
  #pod Current API available since 0.062.
  #pod
  #pod =cut
  
  sub visit {
      my $self = shift;
      my $cb   = shift;
      my $args = _get_args( shift, qw/recurse follow_symlinks/ );
      Carp::croak("Callback for visit() must be a code reference")
        unless defined($cb) && ref($cb) eq 'CODE';
      my $next  = $self->iterator($args);
      my $state = {};
      while ( my $file = $next->() ) {
          local $_ = $file;
          my $r = $cb->( $file, $state );
          last if ref($r) eq 'SCALAR' && !$$r;
      }
      return $state;
  }
  
  #pod =method volume
  #pod
  #pod     $vol = path("/tmp/foo.txt")->volume;   # ""
  #pod     $vol = path("C:/tmp/foo.txt")->volume; # "C:"
  #pod
  #pod Returns the volume portion of the path.  This is equivalent
  #pod to what L<File::Spec> would give from C<splitpath> and thus
  #pod usually is the empty string on Unix-like operating systems or the
  #pod drive letter for an absolute path on C<MSWin32>.
  #pod
  #pod Current API available since 0.001.
  #pod
  #pod =cut
  
  sub volume {
      my ($self) = @_;
      $self->_splitpath unless defined $self->[VOL];
      return $self->[VOL];
  }
  
  package Path::Tiny::Error;
  
  our @CARP_NOT = qw/Path::Tiny/;
  
  use overload ( q{""} => sub { (shift)->{msg} }, fallback => 1 );
  
  sub throw {
      my ( $class, $op, $file, $err ) = @_;
      chomp( my $trace = Carp::shortmess );
      my $msg = "Error $op on '$file': $err$trace\n";
      die bless { op => $op, file => $file, err => $err, msg => $msg }, $class;
  }
  
  1;
  
  
  # vim: ts=4 sts=4 sw=4 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Path::Tiny - File path utility
  
  =head1 VERSION
  
  version 0.108
  
  =head1 SYNOPSIS
  
    use Path::Tiny;
  
    # creating Path::Tiny objects
  
    $dir = path("/tmp");
    $foo = path("foo.txt");
  
    $subdir = $dir->child("foo");
    $bar = $subdir->child("bar.txt");
  
    # stringifies as cleaned up path
  
    $file = path("./foo.txt");
    print $file; # "foo.txt"
  
    # reading files
  
    $guts = $file->slurp;
    $guts = $file->slurp_utf8;
  
    @lines = $file->lines;
    @lines = $file->lines_utf8;
  
    ($head) = $file->lines( {count => 1} );
    ($tail) = $file->lines( {count => -1} );
  
    # writing files
  
    $bar->spew( @data );
    $bar->spew_utf8( @data );
  
    # reading directories
  
    for ( $dir->children ) { ... }
  
    $iter = $dir->iterator;
    while ( my $next = $iter->() ) { ... }
  
  =head1 DESCRIPTION
  
  This module provides a small, fast utility for working with file paths.  It is
  friendlier to use than L<File::Spec> and provides easy access to functions from
  several other core file handling modules.  It aims to be smaller and faster
  than many alternatives on CPAN, while helping people do many common things in
  consistent and less error-prone ways.
  
  Path::Tiny does not try to work for anything except Unix-like and Win32
  platforms.  Even then, it might break if you try something particularly obscure
  or tortuous.  (Quick!  What does this mean:
  C<< ///../../..//./././a//b/.././c/././ >>?  And how does it differ on Win32?)
  
  All paths are forced to have Unix-style forward slashes.  Stringifying
  the object gives you back the path (after some clean up).
  
  File input/output methods C<flock> handles before reading or writing,
  as appropriate (if supported by the platform and/or filesystem).
  
  The C<*_utf8> methods (C<slurp_utf8>, C<lines_utf8>, etc.) operate in raw
  mode.  On Windows, that means they will not have CRLF translation from the
  C<:crlf> IO layer.  Installing L<Unicode::UTF8> 0.58 or later will speed up
  C<*_utf8> situations in many cases and is highly recommended.
  Alternatively, installing L<PerlIO::utf8_strict> 0.003 or later will be
  used in place of the default C<:encoding(UTF-8)>.
  
  This module depends heavily on PerlIO layers for correct operation and thus
  requires Perl 5.008001 or later.
  
  =head1 CONSTRUCTORS
  
  =head2 path
  
      $path = path("foo/bar");
      $path = path("/tmp", "file.txt"); # list
      $path = path(".");                # cwd
      $path = path("~user/file.txt");   # tilde processing
  
  Constructs a C<Path::Tiny> object.  It doesn't matter if you give a file or
  directory path.  It's still up to you to call directory-like methods only on
  directories and file-like methods only on files.  This function is exported
  automatically by default.
  
  The first argument must be defined and have non-zero length or an exception
  will be thrown.  This prevents subtle, dangerous errors with code like
  C<< path( maybe_undef() )->remove_tree >>.
  
  If the first component of the path is a tilde ('~') then the component will be
  replaced with the output of C<glob('~')>.  If the first component of the path
  is a tilde followed by a user name then the component will be replaced with
  output of C<glob('~username')>.  Behaviour for non-existent users depends on
  the output of C<glob> on the system.
  
  On Windows, if the path consists of a drive identifier without a path component
  (C<C:> or C<D:>), it will be expanded to the absolute path of the current
  directory on that volume using C<Cwd::getdcwd()>.
  
  If called with a single C<Path::Tiny> argument, the original is returned unless
  the original is holding a temporary file or directory reference in which case a
  stringified copy is made.
  
      $path = path("foo/bar");
      $temp = Path::Tiny->tempfile;
  
      $p2 = path($path); # like $p2 = $path
      $t2 = path($temp); # like $t2 = path( "$temp" )
  
  This optimizes copies without proliferating references unexpectedly if a copy is
  made by code outside your control.
  
  Current API available since 0.017.
  
  =head2 new
  
      $path = Path::Tiny->new("foo/bar");
  
  This is just like C<path>, but with method call overhead.  (Why would you
  do that?)
  
  Current API available since 0.001.
  
  =head2 cwd
  
      $path = Path::Tiny->cwd; # path( Cwd::getcwd )
      $path = cwd; # optional export
  
  Gives you the absolute path to the current directory as a C<Path::Tiny> object.
  This is slightly faster than C<< path(".")->absolute >>.
  
  C<cwd> may be exported on request and used as a function instead of as a
  method.
  
  Current API available since 0.018.
  
  =head2 rootdir
  
      $path = Path::Tiny->rootdir; # /
      $path = rootdir;             # optional export 
  
  Gives you C<< File::Spec->rootdir >> as a C<Path::Tiny> object if you're too
  picky for C<path("/")>.
  
  C<rootdir> may be exported on request and used as a function instead of as a
  method.
  
  Current API available since 0.018.
  
  =head2 tempfile, tempdir
  
      $temp = Path::Tiny->tempfile( @options );
      $temp = Path::Tiny->tempdir( @options );
      $temp = tempfile( @options ); # optional export
      $temp = tempdir( @options );  # optional export
  
  C<tempfile> passes the options to C<< File::Temp->new >> and returns a C<Path::Tiny>
  object with the file name.  The C<TMPDIR> option is enabled by default.
  
  The resulting C<File::Temp> object is cached. When the C<Path::Tiny> object is
  destroyed, the C<File::Temp> object will be as well.
  
  C<File::Temp> annoyingly requires you to specify a custom template in slightly
  different ways depending on which function or method you call, but
  C<Path::Tiny> lets you ignore that and can take either a leading template or a
  C<TEMPLATE> option and does the right thing.
  
      $temp = Path::Tiny->tempfile( "customXXXXXXXX" );             # ok
      $temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok
  
  The tempfile path object will be normalized to have an absolute path, even if
  created in a relative directory using C<DIR>.  If you want it to have
  the C<realpath> instead, pass a leading options hash like this:
  
      $real_temp = tempfile({realpath => 1}, @options);
  
  C<tempdir> is just like C<tempfile>, except it calls
  C<< File::Temp->newdir >> instead.
  
  Both C<tempfile> and C<tempdir> may be exported on request and used as
  functions instead of as methods.
  
  B<Note>: for tempfiles, the filehandles from File::Temp are closed and not
  reused.  This is not as secure as using File::Temp handles directly, but is
  less prone to deadlocks or access problems on some platforms.  Think of what
  C<Path::Tiny> gives you to be just a temporary file B<name> that gets cleaned
  up.
  
  B<Note 2>: if you don't want these cleaned up automatically when the object
  is destroyed, File::Temp requires different options for directories and
  files.  Use C<< CLEANUP => 0 >> for directories and C<< UNLINK => 0 >> for
  files.
  
  B<Note 3>: Don't lose the temporary object by chaining a method call instead
  of storing it:
  
      my $lost = tempdir()->child("foo"); # tempdir cleaned up right away
  
  B<Note 4>: The cached object may be accessed with the L</cached_temp> method.
  Keeping a reference to, or modifying the cached object may break the
  behavior documented above and is not supported.  Use at your own risk.
  
  Current API available since 0.097.
  
  =head1 METHODS
  
  =head2 absolute
  
      $abs = path("foo/bar")->absolute;
      $abs = path("foo/bar")->absolute("/tmp");
  
  Returns a new C<Path::Tiny> object with an absolute path (or itself if already
  absolute).  If no argument is given, the current directory is used as the
  absolute base path.  If an argument is given, it will be converted to an
  absolute path (if it is not already) and used as the absolute base path.
  
  This will not resolve upward directories ("foo/../bar") unless C<canonpath>
  in L<File::Spec> would normally do so on your platform.  If you need them
  resolved, you must call the more expensive C<realpath> method instead.
  
  On Windows, an absolute path without a volume component will have it added
  based on the current drive.
  
  Current API available since 0.101.
  
  =head2 append, append_raw, append_utf8
  
      path("foo.txt")->append(@data);
      path("foo.txt")->append(\@data);
      path("foo.txt")->append({binmode => ":raw"}, @data);
      path("foo.txt")->append_raw(@data);
      path("foo.txt")->append_utf8(@data);
  
  Appends data to a file.  The file is locked with C<flock> prior to writing
  and closed afterwards.  An optional hash reference may be used to pass
  options.  Valid options are:
  
  =over 4
  
  =item *
  
  C<binmode>: passed to C<binmode()> on the handle used for writing.
  
  =item *
  
  C<truncate>: truncates the file after locking and before appending
  
  =back
  
  The C<truncate> option is a way to replace the contents of a file
  B<in place>, unlike L</spew> which writes to a temporary file and then
  replaces the original (if it exists).
  
  C<append_raw> is like C<append> with a C<binmode> of C<:unix> for fast,
  unbuffered, raw write.
  
  C<append_utf8> is like C<append> with a C<binmode> of
  C<:unix:encoding(UTF-8)> (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8>
  0.58+ is installed, a raw append will be done instead on the data encoded
  with C<Unicode::UTF8>.
  
  Current API available since 0.060.
  
  =head2 assert
  
      $path = path("foo.txt")->assert( sub { $_->exists } );
  
  Returns the invocant after asserting that a code reference argument returns
  true.  When the assertion code reference runs, it will have the invocant
  object in the C<$_> variable.  If it returns false, an exception will be
  thrown.  The assertion code reference may also throw its own exception.
  
  If no assertion is provided, the invocant is returned without error.
  
  Current API available since 0.062.
  
  =head2 basename
  
      $name = path("foo/bar.txt")->basename;        # bar.txt
      $name = path("foo.txt")->basename('.txt');    # foo
      $name = path("foo.txt")->basename(qr/.txt/);  # foo
      $name = path("foo.txt")->basename(@suffixes);
  
  Returns the file portion or last directory portion of a path.
  
  Given a list of suffixes as strings or regular expressions, any that match at
  the end of the file portion or last directory portion will be removed before
  the result is returned.
  
  Current API available since 0.054.
  
  =head2 canonpath
  
      $canonical = path("foo/bar")->canonpath; # foo\bar on Windows
  
  Returns a string with the canonical format of the path name for
  the platform.  In particular, this means directory separators
  will be C<\> on Windows.
  
  Current API available since 0.001.
  
  =head2 cached_temp
  
  Returns the cached C<File::Temp> or C<File::Temp::Dir> object if the
  C<Path::Tiny> object was created with C</tempfile> or C</tempdir>.
  If there is no such object, this method throws.
  
  B<WARNING>: Keeping a reference to, or modifying the cached object may
  break the behavior documented for temporary files and directories created
  with C<Path::Tiny> and is not supported.  Use at your own risk.
  
  Current API available since 0.101.
  
  =head2 child
  
      $file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt"
      $file = path("/tmp")->child(@parts);
  
  Returns a new C<Path::Tiny> object relative to the original.  Works
  like C<catfile> or C<catdir> from File::Spec, but without caring about
  file or directories.
  
  B<WARNING>: because the argument could contain C<..> or refer to symlinks,
  there is no guarantee that the new path refers to an actual descendent of
  the original.  If this is important to you, transform parent and child with
  L</realpath> and check them with L</subsumes>.
  
  Current API available since 0.001.
  
  =head2 children
  
      @paths = path("/tmp")->children;
      @paths = path("/tmp")->children( qr/\.txt$/ );
  
  Returns a list of C<Path::Tiny> objects for all files and directories
  within a directory.  Excludes "." and ".." automatically.
  
  If an optional C<qr//> argument is provided, it only returns objects for child
  names that match the given regular expression.  Only the base name is used
  for matching:
  
      @paths = path("/tmp")->children( qr/^foo/ );
      # matches children like the glob foo*
  
  Current API available since 0.028.
  
  =head2 chmod
  
      path("foo.txt")->chmod(0777);
      path("foo.txt")->chmod("0755");
      path("foo.txt")->chmod("go-w");
      path("foo.txt")->chmod("a=r,u+wx");
  
  Sets file or directory permissions.  The argument can be a numeric mode, a
  octal string beginning with a "0" or a limited subset of the symbolic mode use
  by F</bin/chmod>.
  
  The symbolic mode must be a comma-delimited list of mode clauses.  Clauses must
  match C<< qr/\A([augo]+)([=+-])([rwx]+)\z/ >>, which defines "who", "op" and
  "perms" parameters for each clause.  Unlike F</bin/chmod>, all three parameters
  are required for each clause, multiple ops are not allowed and permissions
  C<stugoX> are not supported.  (See L<File::chmod> for more complex needs.)
  
  Current API available since 0.053.
  
  =head2 copy
  
      path("/tmp/foo.txt")->copy("/tmp/bar.txt");
  
  Copies the current path to the given destination using L<File::Copy>'s
  C<copy> function. Upon success, returns the C<Path::Tiny> object for the
  newly copied file.
  
  Current API available since 0.070.
  
  =head2 digest
  
      $obj = path("/tmp/foo.txt")->digest;        # SHA-256
      $obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected
      $obj = path("/tmp/foo.txt")->digest( { chunk_size => 1e6 }, "MD5" );
  
  Returns a hexadecimal digest for a file.  An optional hash reference of options may
  be given.  The only option is C<chunk_size>.  If C<chunk_size> is given, that many
  bytes will be read at a time.  If not provided, the entire file will be slurped
  into memory to compute the digest.
  
  Any subsequent arguments are passed to the constructor for L<Digest> to select
  an algorithm.  If no arguments are given, the default is SHA-256.
  
  Current API available since 0.056.
  
  =head2 dirname (deprecated)
  
      $name = path("/tmp/foo.txt")->dirname; # "/tmp/"
  
  Returns the directory portion you would get from calling
  C<< File::Spec->splitpath( $path->stringify ) >> or C<"."> for a path without a
  parent directory portion.  Because L<File::Spec> is inconsistent, the result
  might or might not have a trailing slash.  Because of this, this method is
  B<deprecated>.
  
  A better, more consistently approach is likely C<< $path->parent->stringify >>,
  which will not have a trailing slash except for a root directory.
  
  Deprecated in 0.056.
  
  =head2 edit, edit_raw, edit_utf8
  
      path("foo.txt")->edit( \&callback, $options );
      path("foo.txt")->edit_utf8( \&callback );
      path("foo.txt")->edit_raw( \&callback );
  
  These are convenience methods that allow "editing" a file using a single
  callback argument. They slurp the file using C<slurp>, place the contents
  inside a localized C<$_> variable, call the callback function (without
  arguments), and then write C<$_> (presumably mutated) back to the
  file with C<spew>.
  
  An optional hash reference may be used to pass options.  The only option is
  C<binmode>, which is passed to C<slurp> and C<spew>.
  
  C<edit_utf8> and C<edit_raw> act like their respective C<slurp_*> and
  C<spew_*> methods.
  
  Current API available since 0.077.
  
  =head2 edit_lines, edit_lines_utf8, edit_lines_raw
  
      path("foo.txt")->edit_lines( \&callback, $options );
      path("foo.txt")->edit_lines_utf8( \&callback );
      path("foo.txt")->edit_lines_raw( \&callback );
  
  These are convenience methods that allow "editing" a file's lines using a
  single callback argument.  They iterate over the file: for each line, the
  line is put into a localized C<$_> variable, the callback function is
  executed (without arguments) and then C<$_> is written to a temporary file.
  When iteration is finished, the temporary file is atomically renamed over
  the original.
  
  An optional hash reference may be used to pass options.  The only option is
  C<binmode>, which is passed to the method that open handles for reading and
  writing.
  
  C<edit_lines_utf8> and C<edit_lines_raw> act like their respective
  C<slurp_*> and C<spew_*> methods.
  
  Current API available since 0.077.
  
  =head2 exists, is_file, is_dir
  
      if ( path("/tmp")->exists ) { ... }     # -e
      if ( path("/tmp")->is_dir ) { ... }     # -d
      if ( path("/tmp")->is_file ) { ... }    # -e && ! -d
  
  Implements file test operations, this means the file or directory actually has
  to exist on the filesystem.  Until then, it's just a path.
  
  B<Note>: C<is_file> is not C<-f> because C<-f> is not the opposite of C<-d>.
  C<-f> means "plain file", excluding symlinks, devices, etc. that often can be
  read just like files.
  
  Use C<-f> instead if you really mean to check for a plain file.
  
  Current API available since 0.053.
  
  =head2 filehandle
  
      $fh = path("/tmp/foo.txt")->filehandle($mode, $binmode);
      $fh = path("/tmp/foo.txt")->filehandle({ locked => 1 }, $mode, $binmode);
      $fh = path("/tmp/foo.txt")->filehandle({ exclusive => 1  }, $mode, $binmode);
  
  Returns an open file handle.  The C<$mode> argument must be a Perl-style
  read/write mode string ("<" ,">", ">>", etc.).  If a C<$binmode>
  is given, it is set during the C<open> call.
  
  An optional hash reference may be used to pass options.
  
  The C<locked> option governs file locking; if true, handles opened for writing,
  appending or read-write are locked with C<LOCK_EX>; otherwise, they are
  locked with C<LOCK_SH>.  When using C<locked>, ">" or "+>" modes will delay
  truncation until after the lock is acquired.
  
  The C<exclusive> option causes the open() call to fail if the file already
  exists.  This corresponds to the O_EXCL flag to sysopen / open(2).
  C<exclusive> implies C<locked> and will set it for you if you forget it.
  
  See C<openr>, C<openw>, C<openrw>, and C<opena> for sugar.
  
  Current API available since 0.066.
  
  =head2 is_absolute, is_relative
  
      if ( path("/tmp")->is_absolute ) { ... }
      if ( path("/tmp")->is_relative ) { ... }
  
  Booleans for whether the path appears absolute or relative.
  
  Current API available since 0.001.
  
  =head2 is_rootdir
  
      while ( ! $path->is_rootdir ) {
          $path = $path->parent;
          ...
      }
  
  Boolean for whether the path is the root directory of the volume.  I.e. the
  C<dirname> is C<q[/]> and the C<basename> is C<q[]>.
  
  This works even on C<MSWin32> with drives and UNC volumes:
  
      path("C:/")->is_rootdir;             # true
      path("//server/share/")->is_rootdir; #true
  
  Current API available since 0.038.
  
  =head2 iterator
  
      $iter = path("/tmp")->iterator( \%options );
  
  Returns a code reference that walks a directory lazily.  Each invocation
  returns a C<Path::Tiny> object or undef when the iterator is exhausted.
  
      $iter = path("/tmp")->iterator;
      while ( $path = $iter->() ) {
          ...
      }
  
  The current and parent directory entries ("." and "..") will not
  be included.
  
  If the C<recurse> option is true, the iterator will walk the directory
  recursively, breadth-first.  If the C<follow_symlinks> option is also true,
  directory links will be followed recursively.  There is no protection against
  loops when following links. If a directory is not readable, it will not be
  followed.
  
  The default is the same as:
  
      $iter = path("/tmp")->iterator( {
          recurse         => 0,
          follow_symlinks => 0,
      } );
  
  For a more powerful, recursive iterator with built-in loop avoidance, see
  L<Path::Iterator::Rule>.
  
  See also L</visit>.
  
  Current API available since 0.016.
  
  =head2 lines, lines_raw, lines_utf8
  
      @contents = path("/tmp/foo.txt")->lines;
      @contents = path("/tmp/foo.txt")->lines(\%options);
      @contents = path("/tmp/foo.txt")->lines_raw;
      @contents = path("/tmp/foo.txt")->lines_utf8;
  
      @contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } );
  
  Returns a list of lines from a file.  Optionally takes a hash-reference of
  options.  Valid options are C<binmode>, C<count> and C<chomp>.
  
  If C<binmode> is provided, it will be set on the handle prior to reading.
  
  If a positive C<count> is provided, that many lines will be returned from the
  start of the file.  If a negative C<count> is provided, the entire file will be
  read, but only C<abs(count)> will be kept and returned.  If C<abs(count)>
  exceeds the number of lines in the file, all lines will be returned.
  
  If C<chomp> is set, any end-of-line character sequences (C<CR>, C<CRLF>, or
  C<LF>) will be removed from the lines returned.
  
  Because the return is a list, C<lines> in scalar context will return the number
  of lines (and throw away the data).
  
      $number_of_lines = path("/tmp/foo.txt")->lines;
  
  C<lines_raw> is like C<lines> with a C<binmode> of C<:raw>.  We use C<:raw>
  instead of C<:unix> so PerlIO buffering can manage reading by line.
  
  C<lines_utf8> is like C<lines> with a C<binmode> of C<:raw:encoding(UTF-8)>
  (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8> 0.58+ is installed, a raw
  UTF-8 slurp will be done and then the lines will be split.  This is
  actually faster than relying on C<:encoding(UTF-8)>, though a bit memory
  intensive.  If memory use is a concern, consider C<openr_utf8> and
  iterating directly on the handle.
  
  Current API available since 0.065.
  
  =head2 mkpath
  
      path("foo/bar/baz")->mkpath;
      path("foo/bar/baz")->mkpath( \%options );
  
  Like calling C<make_path> from L<File::Path>.  An optional hash reference
  is passed through to C<make_path>.  Errors will be trapped and an exception
  thrown.  Returns the list of directories created or an empty list if
  the directories already exist, just like C<make_path>.
  
  Current API available since 0.001.
  
  =head2 move
  
      path("foo.txt")->move("bar.txt");
  
  Move the current path to the given destination path using Perl's
  built-in L<rename|perlfunc/rename> function. Returns the result
  of the C<rename> function (except it throws an exception if it fails).
  
  Current API available since 0.001.
  
  =head2 openr, openw, openrw, opena
  
      $fh = path("foo.txt")->openr($binmode);  # read
      $fh = path("foo.txt")->openr_raw;
      $fh = path("foo.txt")->openr_utf8;
  
      $fh = path("foo.txt")->openw($binmode);  # write
      $fh = path("foo.txt")->openw_raw;
      $fh = path("foo.txt")->openw_utf8;
  
      $fh = path("foo.txt")->opena($binmode);  # append
      $fh = path("foo.txt")->opena_raw;
      $fh = path("foo.txt")->opena_utf8;
  
      $fh = path("foo.txt")->openrw($binmode); # read/write
      $fh = path("foo.txt")->openrw_raw;
      $fh = path("foo.txt")->openrw_utf8;
  
  Returns a file handle opened in the specified mode.  The C<openr> style methods
  take a single C<binmode> argument.  All of the C<open*> methods have
  C<open*_raw> and C<open*_utf8> equivalents that use C<:raw> and
  C<:raw:encoding(UTF-8)>, respectively.
  
  An optional hash reference may be used to pass options.  The only option is
  C<locked>.  If true, handles opened for writing, appending or read-write are
  locked with C<LOCK_EX>; otherwise, they are locked for C<LOCK_SH>.
  
      $fh = path("foo.txt")->openrw_utf8( { locked => 1 } );
  
  See L</filehandle> for more on locking.
  
  Current API available since 0.011.
  
  =head2 parent
  
      $parent = path("foo/bar/baz")->parent; # foo/bar
      $parent = path("foo/wibble.txt")->parent; # foo
  
      $parent = path("foo/bar/baz")->parent(2); # foo
  
  Returns a C<Path::Tiny> object corresponding to the parent directory of the
  original directory or file. An optional positive integer argument is the number
  of parent directories upwards to return.  C<parent> by itself is equivalent to
  C<parent(1)>.
  
  Current API available since 0.014.
  
  =head2 realpath
  
      $real = path("/baz/foo/../bar")->realpath;
      $real = path("foo/../bar")->realpath;
  
  Returns a new C<Path::Tiny> object with all symbolic links and upward directory
  parts resolved using L<Cwd>'s C<realpath>.  Compared to C<absolute>, this is
  more expensive as it must actually consult the filesystem.
  
  If the parent path can't be resolved (e.g. if it includes directories that
  don't exist), an exception will be thrown:
  
      $real = path("doesnt_exist/foo")->realpath; # dies
  
  However, if the parent path exists and only the last component (e.g. filename)
  doesn't exist, the realpath will be the realpath of the parent plus the
  non-existent last component:
  
      $real = path("./aasdlfasdlf")->realpath; # works
  
  The underlying L<Cwd> module usually worked this way on Unix, but died on
  Windows (and some Unixes) if the full path didn't exist.  As of version 0.064,
  it's safe to use anywhere.
  
  Current API available since 0.001.
  
  =head2 relative
  
      $rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar
  
  Returns a C<Path::Tiny> object with a path relative to a new base path
  given as an argument.  If no argument is given, the current directory will
  be used as the new base path.
  
  If either path is already relative, it will be made absolute based on the
  current directly before determining the new relative path.
  
  The algorithm is roughly as follows:
  
  =over 4
  
  =item *
  
  If the original and new base path are on different volumes, an exception will be thrown.
  
  =item *
  
  If the original and new base are identical, the relative path is C<".">.
  
  =item *
  
  If the new base subsumes the original, the relative path is the original path with the new base chopped off the front
  
  =item *
  
  If the new base does not subsume the original, a common prefix path is determined (possibly the root directory) and the relative path will consist of updirs (C<"..">) to reach the common prefix, followed by the original path less the common prefix.
  
  =back
  
  Unlike C<File::Spec::abs2rel>, in the last case above, the calculation based
  on a common prefix takes into account symlinks that could affect the updir
  process.  Given an original path "/A/B" and a new base "/A/C",
  (where "A", "B" and "C" could each have multiple path components):
  
  =over 4
  
  =item *
  
  Symlinks in "A" don't change the result unless the last component of A is a symlink and the first component of "C" is an updir.
  
  =item *
  
  Symlinks in "B" don't change the result and will exist in the result as given.
  
  =item *
  
  Symlinks and updirs in "C" must be resolved to actual paths, taking into account the possibility that not all path components might exist on the filesystem.
  
  =back
  
  Current API available since 0.001.  New algorithm (that accounts for
  symlinks) available since 0.079.
  
  =head2 remove
  
      path("foo.txt")->remove;
  
  This is just like C<unlink>, except for its error handling: if the path does
  not exist, it returns false; if deleting the file fails, it throws an
  exception.
  
  Current API available since 0.012.
  
  =head2 remove_tree
  
      # directory
      path("foo/bar/baz")->remove_tree;
      path("foo/bar/baz")->remove_tree( \%options );
      path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove
  
  Like calling C<remove_tree> from L<File::Path>, but defaults to C<safe> mode.
  An optional hash reference is passed through to C<remove_tree>.  Errors will be
  trapped and an exception thrown.  Returns the number of directories deleted,
  just like C<remove_tree>.
  
  If you want to remove a directory only if it is empty, use the built-in
  C<rmdir> function instead.
  
      rmdir path("foo/bar/baz/");
  
  Current API available since 0.013.
  
  =head2 sibling
  
      $foo = path("/tmp/foo.txt");
      $sib = $foo->sibling("bar.txt");        # /tmp/bar.txt
      $sib = $foo->sibling("baz", "bam.txt"); # /tmp/baz/bam.txt
  
  Returns a new C<Path::Tiny> object relative to the parent of the original.
  This is slightly more efficient than C<< $path->parent->child(...) >>.
  
  Current API available since 0.058.
  
  =head2 slurp, slurp_raw, slurp_utf8
  
      $data = path("foo.txt")->slurp;
      $data = path("foo.txt")->slurp( {binmode => ":raw"} );
      $data = path("foo.txt")->slurp_raw;
      $data = path("foo.txt")->slurp_utf8;
  
  Reads file contents into a scalar.  Takes an optional hash reference which may
  be used to pass options.  The only available option is C<binmode>, which is
  passed to C<binmode()> on the handle used for reading.
  
  C<slurp_raw> is like C<slurp> with a C<binmode> of C<:unix> for
  a fast, unbuffered, raw read.
  
  C<slurp_utf8> is like C<slurp> with a C<binmode> of
  C<:unix:encoding(UTF-8)> (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8>
  0.58+ is installed, a raw slurp will be done instead and the result decoded
  with C<Unicode::UTF8>.  This is just as strict and is roughly an order of
  magnitude faster than using C<:encoding(UTF-8)>.
  
  B<Note>: C<slurp> and friends lock the filehandle before slurping.  If
  you plan to slurp from a file created with L<File::Temp>, be sure to
  close other handles or open without locking to avoid a deadlock:
  
      my $tempfile = File::Temp->new(EXLOCK => 0);
      my $guts = path($tempfile)->slurp;
  
  Current API available since 0.004.
  
  =head2 spew, spew_raw, spew_utf8
  
      path("foo.txt")->spew(@data);
      path("foo.txt")->spew(\@data);
      path("foo.txt")->spew({binmode => ":raw"}, @data);
      path("foo.txt")->spew_raw(@data);
      path("foo.txt")->spew_utf8(@data);
  
  Writes data to a file atomically.  The file is written to a temporary file in
  the same directory, then renamed over the original.  An optional hash reference
  may be used to pass options.  The only option is C<binmode>, which is passed to
  C<binmode()> on the handle used for writing.
  
  C<spew_raw> is like C<spew> with a C<binmode> of C<:unix> for a fast,
  unbuffered, raw write.
  
  C<spew_utf8> is like C<spew> with a C<binmode> of C<:unix:encoding(UTF-8)>
  (or L<PerlIO::utf8_strict>).  If L<Unicode::UTF8> 0.58+ is installed, a raw
  spew will be done instead on the data encoded with C<Unicode::UTF8>.
  
  B<NOTE>: because the file is written to a temporary file and then renamed, the
  new file will wind up with permissions based on your current umask.  This is a
  feature to protect you from a race condition that would otherwise give
  different permissions than you might expect.  If you really want to keep the
  original mode flags, use L</append> with the C<truncate> option.
  
  Current API available since 0.011.
  
  =head2 stat, lstat
  
      $stat = path("foo.txt")->stat;
      $stat = path("/some/symlink")->lstat;
  
  Like calling C<stat> or C<lstat> from L<File::stat>.
  
  Current API available since 0.001.
  
  =head2 stringify
  
      $path = path("foo.txt");
      say $path->stringify; # same as "$path"
  
  Returns a string representation of the path.  Unlike C<canonpath>, this method
  returns the path standardized with Unix-style C</> directory separators.
  
  Current API available since 0.001.
  
  =head2 subsumes
  
      path("foo/bar")->subsumes("foo/bar/baz"); # true
      path("/foo/bar")->subsumes("/foo/baz");   # false
  
  Returns true if the first path is a prefix of the second path at a directory
  boundary.
  
  This B<does not> resolve parent directory entries (C<..>) or symlinks:
  
      path("foo/bar")->subsumes("foo/bar/../baz"); # true
  
  If such things are important to you, ensure that both paths are resolved to
  the filesystem with C<realpath>:
  
      my $p1 = path("foo/bar")->realpath;
      my $p2 = path("foo/bar/../baz")->realpath;
      if ( $p1->subsumes($p2) ) { ... }
  
  Current API available since 0.048.
  
  =head2 touch
  
      path("foo.txt")->touch;
      path("foo.txt")->touch($epoch_secs);
  
  Like the Unix C<touch> utility.  Creates the file if it doesn't exist, or else
  changes the modification and access times to the current time.  If the first
  argument is the epoch seconds then it will be used.
  
  Returns the path object so it can be easily chained with other methods:
  
      # won't die if foo.txt doesn't exist
      $content = path("foo.txt")->touch->slurp;
  
  Current API available since 0.015.
  
  =head2 touchpath
  
      path("bar/baz/foo.txt")->touchpath;
  
  Combines C<mkpath> and C<touch>.  Creates the parent directory if it doesn't exist,
  before touching the file.  Returns the path object like C<touch> does.
  
  Current API available since 0.022.
  
  =head2 visit
  
      path("/tmp")->visit( \&callback, \%options );
  
  Executes a callback for each child of a directory.  It returns a hash
  reference with any state accumulated during iteration.
  
  The options are the same as for L</iterator> (which it uses internally):
  C<recurse> and C<follow_symlinks>.  Both default to false.
  
  The callback function will receive a C<Path::Tiny> object as the first argument
  and a hash reference to accumulate state as the second argument.  For example:
  
      # collect files sizes
      my $sizes = path("/tmp")->visit(
          sub {
              my ($path, $state) = @_;
              return if $path->is_dir;
              $state->{$path} = -s $path;
          },
          { recurse => 1 }
      );
  
  For convenience, the C<Path::Tiny> object will also be locally aliased as the
  C<$_> global variable:
  
      # print paths matching /foo/
      path("/tmp")->visit( sub { say if /foo/ }, { recurse => 1} );
  
  If the callback returns a B<reference> to a false scalar value, iteration will
  terminate.  This is not the same as "pruning" a directory search; this just
  stops all iteration and returns the state hash reference.
  
      # find up to 10 files larger than 100K
      my $files = path("/tmp")->visit(
          sub {
              my ($path, $state) = @_;
              $state->{$path}++ if -s $path > 102400
              return \0 if keys %$state == 10;
          },
          { recurse => 1 }
      );
  
  If you want more flexible iteration, use a module like L<Path::Iterator::Rule>.
  
  Current API available since 0.062.
  
  =head2 volume
  
      $vol = path("/tmp/foo.txt")->volume;   # ""
      $vol = path("C:/tmp/foo.txt")->volume; # "C:"
  
  Returns the volume portion of the path.  This is equivalent
  to what L<File::Spec> would give from C<splitpath> and thus
  usually is the empty string on Unix-like operating systems or the
  drive letter for an absolute path on C<MSWin32>.
  
  Current API available since 0.001.
  
  =for Pod::Coverage openr_utf8 opena_utf8 openw_utf8 openrw_utf8
  openr_raw opena_raw openw_raw openrw_raw
  IS_WIN32 FREEZE THAW TO_JSON abs2rel
  
  =head1 EXCEPTION HANDLING
  
  Simple usage errors will generally croak.  Failures of underlying Perl
  functions will be thrown as exceptions in the class
  C<Path::Tiny::Error>.
  
  A C<Path::Tiny::Error> object will be a hash reference with the following fields:
  
  =over 4
  
  =item *
  
  C<op> — a description of the operation, usually function call and any extra info
  
  =item *
  
  C<file> — the file or directory relating to the error
  
  =item *
  
  C<err> — hold C<$!> at the time the error was thrown
  
  =item *
  
  C<msg> — a string combining the above data and a Carp-like short stack trace
  
  =back
  
  Exception objects will stringify as the C<msg> field.
  
  =head1 ENVIRONMENT
  
  =head2 PERL_PATH_TINY_NO_FLOCK
  
  If the environment variable C<PERL_PATH_TINY_NO_FLOCK> is set to a true
  value then flock will NOT be used when accessing files (this is not
  recommended).
  
  =head1 CAVEATS
  
  =head2 Subclassing not supported
  
  For speed, this class is implemented as an array based object and uses many
  direct function calls internally.  You must not subclass it and expect
  things to work properly.
  
  =head2 File locking
  
  If flock is not supported on a platform, it will not be used, even if
  locking is requested.
  
  In situations where a platform normally would support locking, but the
  flock fails due to a filesystem limitation, Path::Tiny has some heuristics
  to detect this and will warn once and continue in an unsafe mode.  If you
  want this failure to be fatal, you can fatalize the 'flock' warnings
  category:
  
      use warnings FATAL => 'flock';
  
  See additional caveats below.
  
  =head3 NFS and BSD
  
  On BSD, Perl's flock implementation may not work to lock files on an
  NFS filesystem.  If detected, this situation will warn once, as described
  above.
  
  =head3 Lustre
  
  The Lustre filesystem does not support flock.  If detected, this situation
  will warn once, as described above.
  
  =head3 AIX and locking
  
  AIX requires a write handle for locking.  Therefore, calls that normally
  open a read handle and take a shared lock instead will open a read-write
  handle and take an exclusive lock.  If the user does not have write
  permission, no lock will be used.
  
  =head2 utf8 vs UTF-8
  
  All the C<*_utf8> methods by default use C<:encoding(UTF-8)> -- either as
  C<:unix:encoding(UTF-8)> (unbuffered) or C<:raw:encoding(UTF-8)> (buffered) --
  which is strict against the Unicode spec and disallows illegal Unicode
  codepoints or UTF-8 sequences.
  
  Unfortunately, C<:encoding(UTF-8)> is very, very slow.  If you install
  L<Unicode::UTF8> 0.58 or later, that module will be used by some C<*_utf8>
  methods to encode or decode data after a raw, binary input/output operation,
  which is much faster.  Alternatively, if you install L<PerlIO::utf8_strict>,
  that will be used instead of C<:encoding(UTF-8)> and is also very fast.
  
  If you need the performance and can accept the security risk,
  C<< slurp({binmode => ":unix:utf8"}) >> will be faster than C<:unix:encoding(UTF-8)>
  (but not as fast as C<Unicode::UTF8>).
  
  Note that the C<*_utf8> methods read in B<raw> mode.  There is no CRLF
  translation on Windows.  If you must have CRLF translation, use the regular
  input/output methods with an appropriate binmode:
  
    $path->spew_utf8($data);                            # raw
    $path->spew({binmode => ":encoding(UTF-8)"}, $data; # LF -> CRLF
  
  =head2 Default IO layers and the open pragma
  
  If you have Perl 5.10 or later, file input/output methods (C<slurp>, C<spew>,
  etc.) and high-level handle opening methods ( C<filehandle>, C<openr>,
  C<openw>, etc. ) respect default encodings set by the C<-C> switch or lexical
  L<open> settings of the caller.  For UTF-8, this is almost certainly slower
  than using the dedicated C<_utf8> methods if you have L<Unicode::UTF8>.
  
  =head1 TYPE CONSTRAINTS AND COERCION
  
  A standard L<MooseX::Types> library is available at
  L<MooseX::Types::Path::Tiny>.  A L<Type::Tiny> equivalent is available as
  L<Types::Path::Tiny>.
  
  =head1 SEE ALSO
  
  These are other file/path utilities, which may offer a different feature
  set than C<Path::Tiny>.
  
  =over 4
  
  =item *
  
  L<File::chmod>
  
  =item *
  
  L<File::Fu>
  
  =item *
  
  L<IO::All>
  
  =item *
  
  L<Path::Class>
  
  =back
  
  These iterators may be slightly faster than the recursive iterator in
  C<Path::Tiny>:
  
  =over 4
  
  =item *
  
  L<Path::Iterator::Rule>
  
  =item *
  
  L<File::Next>
  
  =back
  
  There are probably comparable, non-Tiny tools.  Let me know if you want me to
  add a module to the list.
  
  This module was featured in the L<2013 Perl Advent Calendar|http://www.perladvent.org/2013/2013-12-18.html>.
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<https://github.com/dagolden/Path-Tiny/issues>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/dagolden/Path-Tiny>
  
    git clone https://github.com/dagolden/Path-Tiny.git
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 CONTRIBUTORS
  
  =for stopwords Alex Efros Aristotle Pagaltzis Chris Williams Dave Rolsky David Steinbrunner Doug Bell Gabor Szabo Gabriel Andrade George Hartzell Geraud Continsouzas Goro Fuji Graham Knop Ollis Ian Sillitoe James Hunt John Karr Karen Etheridge Mark Ellis Martin H. Sluka Kjeldsen Michael G. Schwern Nigel Gregoire Philippe Bruhat (BooK) Regina Verbae Roy Ivy III Shlomi Fish Smylers Tatsuhiko Miyagawa Toby Inkster Yanick Champoux 김도형 - Keedi Kim
  
  =over 4
  
  =item *
  
  Alex Efros <powerman@powerman.name>
  
  =item *
  
  Aristotle Pagaltzis <pagaltzis@gmx.de>
  
  =item *
  
  Chris Williams <bingos@cpan.org>
  
  =item *
  
  Dave Rolsky <autarch@urth.org>
  
  =item *
  
  David Steinbrunner <dsteinbrunner@pobox.com>
  
  =item *
  
  Doug Bell <madcityzen@gmail.com>
  
  =item *
  
  Gabor Szabo <szabgab@cpan.org>
  
  =item *
  
  Gabriel Andrade <gabiruh@gmail.com>
  
  =item *
  
  George Hartzell <hartzell@cpan.org>
  
  =item *
  
  Geraud Continsouzas <geraud@scsi.nc>
  
  =item *
  
  Goro Fuji <gfuji@cpan.org>
  
  =item *
  
  Graham Knop <haarg@haarg.org>
  
  =item *
  
  Graham Ollis <plicease@cpan.org>
  
  =item *
  
  Ian Sillitoe <ian@sillit.com>
  
  =item *
  
  James Hunt <james@niftylogic.com>
  
  =item *
  
  John Karr <brainbuz@brainbuz.org>
  
  =item *
  
  Karen Etheridge <ether@cpan.org>
  
  =item *
  
  Mark Ellis <mark.ellis@cartridgesave.co.uk>
  
  =item *
  
  Martin H. Sluka <fany@cpan.org>
  
  =item *
  
  Martin Kjeldsen <mk@bluepipe.dk>
  
  =item *
  
  Michael G. Schwern <mschwern@cpan.org>
  
  =item *
  
  Nigel Gregoire <nigelgregoire@gmail.com>
  
  =item *
  
  Philippe Bruhat (BooK) <book@cpan.org>
  
  =item *
  
  Regina Verbae <regina-verbae@users.noreply.github.com>
  
  =item *
  
  Roy Ivy III <rivy@cpan.org>
  
  =item *
  
  Shlomi Fish <shlomif@shlomifish.org>
  
  =item *
  
  Smylers <Smylers@stripey.com>
  
  =item *
  
  Tatsuhiko Miyagawa <miyagawa@bulknews.net>
  
  =item *
  
  Toby Inkster <tobyink@cpan.org>
  
  =item *
  
  Yanick Champoux <yanick@babyl.dyndns.org>
  
  =item *
  
  김도형 - Keedi Kim <keedi@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2014 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
PATH_TINY

$fatpacked{"Search/Dict.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SEARCH_DICT';
  package Search::Dict;
  require 5.000;
  require Exporter;
  
  my $fc_available;
  BEGIN {
    $fc_available = '5.015008';
    if ( $] ge $fc_available ) {
      require feature;
      'feature'->import('fc'); # string avoids warning on old Perls <sigh>
    }
  }
  
  use strict;
  
  our $VERSION = '1.07';
  our @ISA = qw(Exporter);
  our @EXPORT = qw(look);
  
  =head1 NAME
  
  Search::Dict - look - search for key in dictionary file
  
  =head1 SYNOPSIS
  
      use Search::Dict;
      look *FILEHANDLE, $key, $dict, $fold;
  
      use Search::Dict;
      look *FILEHANDLE, $params;
  
  =head1 DESCRIPTION
  
  Sets file position in FILEHANDLE to be first line greater than or equal
  (stringwise) to I<$key>.  Returns the new file position, or -1 if an error
  occurs.
  
  The flags specify dictionary order and case folding:
  
  If I<$dict> is true, search by dictionary order (ignore anything but word
  characters and whitespace).  The default is honour all characters.
  
  If I<$fold> is true, ignore case.  The default is to honour case.
  
  If there are only three arguments and the third argument is a hash
  reference, the keys of that hash can have values C<dict>, C<fold>, and
  C<comp> or C<xfrm> (see below), and their corresponding values will be
  used as the parameters.
  
  If a comparison subroutine (comp) is defined, it must return less than zero,
  zero, or greater than zero, if the first comparand is less than,
  equal, or greater than the second comparand.
  
  If a transformation subroutine (xfrm) is defined, its value is used to
  transform the lines read from the filehandle before their comparison.
  
  =cut
  
  sub look {
      my($fh,$key,$dict,$fold) = @_;
      my ($comp, $xfrm);
      if (@_ == 3 && ref $dict eq 'HASH') {
  	my $params = $dict;
  	$dict = 0;
  	$dict = $params->{dict} if exists $params->{dict};
  	$fold = $params->{fold} if exists $params->{fold};
  	$comp = $params->{comp} if exists $params->{comp};
  	$xfrm = $params->{xfrm} if exists $params->{xfrm};
      }
      $comp = sub { $_[0] cmp $_[1] } unless defined $comp;
      local($_);
      my $fno = fileno $fh;
      my @stat;
      if ( defined $fno && $fno >= 0 && ! tied *{$fh} ) { # real, open file
        @stat = eval { stat($fh) }; # in case fileno lies
      }
      my($size, $blksize) = @stat[7,11];
      $size = do { seek($fh,0,2); my $s = tell($fh); seek($fh,0,0); $s }
          unless defined $size;
      $blksize ||= 8192;
      $key =~ s/[^\w\s]//g if $dict;
      if ( $fold ) {
        $key = $] ge $fc_available ? fc($key) : lc($key);
      }
      # find the right block
      my($min, $max) = (0, int($size / $blksize));
      my $mid;
      while ($max - $min > 1) {
  	$mid = int(($max + $min) / 2);
  	seek($fh, $mid * $blksize, 0)
  	    or return -1;
  	<$fh> if $mid;			# probably a partial line
  	$_ = <$fh>;
  	$_ = $xfrm->($_) if defined $xfrm;
  	chomp;
  	s/[^\w\s]//g if $dict;
          if ( $fold ) {
            $_ = $] ge $fc_available ? fc($_) : lc($_);
          }
  	if (defined($_) && $comp->($_, $key) < 0) {
  	    $min = $mid;
  	}
  	else {
  	    $max = $mid;
  	}
      }
      # find the right line
      $min *= $blksize;
      seek($fh,$min,0)
  	or return -1;
      <$fh> if $min;
      for (;;) {
  	$min = tell($fh);
  	defined($_ = <$fh>)
  	    or last;
  	$_ = $xfrm->($_) if defined $xfrm;
  	chomp;
  	s/[^\w\s]//g if $dict;
          if ( $fold ) {
            $_ = $] ge $fc_available ? fc($_) : lc($_);
          }
  	last if $comp->($_, $key) >= 0;
      }
      seek($fh,$min,0);
      $min;
  }
  
  1;
SEARCH_DICT

$fatpacked{"String/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_SHELLQUOTE';
  # $Id: ShellQuote.pm,v 1.11 2010-06-11 20:08:57 roderick Exp $
  #
  # Copyright (c) 1997 Roderick Schertler.  All rights reserved.  This
  # program is free software; you can redistribute it and/or modify it
  # under the same terms as Perl itself.
  
  =head1 NAME
  
  String::ShellQuote - quote strings for passing through the shell
  
  =head1 SYNOPSIS
  
      $string = shell_quote @list;
      $string = shell_quote_best_effort @list;
      $string = shell_comment_quote $string;
  
  =head1 DESCRIPTION
  
  This module contains some functions which are useful for quoting strings
  which are going to pass through the shell or a shell-like object.
  
  =over
  
  =cut
  
  package String::ShellQuote;
  
  use strict;
  use vars qw($VERSION @ISA @EXPORT);
  
  require Exporter;
  
  $VERSION	= '1.04';
  @ISA		= qw(Exporter);
  @EXPORT		= qw(shell_quote shell_quote_best_effort shell_comment_quote);
  
  sub croak {
      require Carp;
      goto &Carp::croak;
  }
  
  sub _shell_quote_backend {
      my @in = @_;
      my @err = ();
  
      if (0) {
  	require RS::Handy;
  	print RS::Handy::data_dump(\@in);
      }
  
      return \@err, '' unless @in;
  
      my $ret = '';
      my $saw_non_equal = 0;
      foreach (@in) {
  	if (!defined $_ or $_ eq '') {
  	    $_ = "''";
  	    next;
  	}
  
  	if (s/\x00//g) {
  	    push @err, "No way to quote string containing null (\\000) bytes";
  	}
  
      	my $escape = 0;
  
  	# = needs quoting when it's the first element (or part of a
  	# series of such elements), as in command position it's a
  	# program-local environment setting
  
  	if (/=/) {
  	    if (!$saw_non_equal) {
  	    	$escape = 1;
  	    }
  	}
  	else {
  	    $saw_non_equal = 1;
  	}
  
  	if (m|[^\w!%+,\-./:=@^]|) {
  	    $escape = 1;
  	}
  
  	if ($escape
  		|| (!$saw_non_equal && /=/)) {
  
  	    # ' -> '\''
      	    s/'/'\\''/g;
  
  	    # make multiple ' in a row look simpler
  	    # '\'''\'''\'' -> '"'''"'
      	    s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;
  
  	    $_ = "'$_'";
  	    s/^''//;
  	    s/''$//;
  	}
      }
      continue {
  	$ret .= "$_ ";
      }
  
      chop $ret;
      return \@err, $ret;
  }
  
  =item B<shell_quote> [I<string>]...
  
  B<shell_quote> quotes strings so they can be passed through the shell.
  Each I<string> is quoted so that the shell will pass it along as a
  single argument and without further interpretation.  If no I<string>s
  are given an empty string is returned.
  
  If any I<string> can't be safely quoted B<shell_quote> will B<croak>.
  
  =cut
  
  sub shell_quote {
      my ($rerr, $s) = _shell_quote_backend @_;
  
      if (@$rerr) {
      	my %seen;
      	@$rerr = grep { !$seen{$_}++ } @$rerr;
  	my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
  	chomp $s;
  	croak $s;
      }
      return $s;
  }
  
  =item B<shell_quote_best_effort> [I<string>]...
  
  This is like B<shell_quote>, excpet if the string can't be safely quoted
  it does the best it can and returns the result, instead of dying.
  
  =cut
  
  sub shell_quote_best_effort {
      my ($rerr, $s) = _shell_quote_backend @_;
  
      return $s;
  }
  
  =item B<shell_comment_quote> [I<string>]
  
  B<shell_comment_quote> quotes the I<string> so that it can safely be
  included in a shell-style comment (the current algorithm is that a sharp
  character is placed after any newlines in the string).
  
  This routine might be changed to accept multiple I<string> arguments
  in the future.  I haven't done this yet because I'm not sure if the
  I<string>s should be joined with blanks ($") or nothing ($,).  Cast
  your vote today!  Be sure to justify your answer.
  
  =cut
  
  sub shell_comment_quote {
      return '' unless @_;
      unless (@_ == 1) {
  	croak "Too many arguments to shell_comment_quote "
  	    	    . "(got " . @_ . " expected 1)";
      }
      local $_ = shift;
      s/\n/\n#/g;
      return $_;
  }
  
  1;
  
  __END__
  
  =back
  
  =head1 EXAMPLES
  
      $cmd = 'fuser 2>/dev/null ' . shell_quote @files;
      @pids = split ' ', `$cmd`;
  
      print CFG "# Configured by: ",
  		shell_comment_quote($ENV{LOGNAME}), "\n";
  
  =head1 BUGS
  
  Only Bourne shell quoting is supported.  I'd like to add other shells
  (particularly cmd.exe), but I'm not familiar with them.  It would be a
  big help if somebody supplied the details.
  
  =head1 AUTHOR
  
  Roderick Schertler <F<roderick@argon.org>>
  
  =head1 SEE ALSO
  
  perl(1).
  
  =cut
STRING_SHELLQUOTE

$fatpacked{"Tie/Handle/Offset.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIE_HANDLE_OFFSET';
  use strict;
  BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } }
  
  package Tie::Handle::Offset;
  # ABSTRACT: Tied handle that hides the beginning of a file
  
  our $VERSION = '0.004';
  
  use Tie::Handle;
  our @ISA = qw/Tie::Handle/;
  
  #--------------------------------------------------------------------------#
  # Glob slot accessor
  #--------------------------------------------------------------------------#
  
  sub offset {
    my $self = shift;
    if ( @_ ) {
      return ${*$self}{offset} = shift;
    }
    else {
      return ${*$self}{offset};
    }
  }
  
  #--------------------------------------------------------------------------#
  # Tied handle methods
  #--------------------------------------------------------------------------#
  
  sub TIEHANDLE
  {
    my $class = shift;
    my $params;
    $params = pop if ref $_[-1] eq 'HASH';
  
    my $self    = \do { no warnings 'once'; local *HANDLE};
    bless $self,$class;
  
    $self->OPEN(@_) if (@_);
    if ( $params->{offset} ) {
      seek( $self, $self->offset( $params->{offset} ), 0 );
    }
    return $self;
  }
  
  sub TELL    {
    my $cur = tell($_[0]) - $_[0]->offset;
    # XXX shouldn't ever be less than zero, but just in case...
    return $cur > 0 ? $cur : 0;
  }
  
  sub SEEK    {
    my ($self, $pos, $whence) = @_;
    my $rc;
    if ( $whence == 0 || $whence == 1 ) { # pos from start, cur
      $rc = seek($self, $pos + $self->offset, $whence);
    }
    elsif ( _size($self) + $pos < $self->offset ) { # from end
      $rc = '';
    }
    else {
      $rc = seek($self,$pos,$whence);
    }
    return $rc;
  }
  
  sub OPEN
  {
    $_[0]->offset(0);
    $_[0]->CLOSE if defined($_[0]->FILENO);
    @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]);
  }
  
  sub _size {
    my ($self) = @_;
    my $cur = tell($self);
    seek($self,0,2); # end
    my $size = tell($self);
    seek($self,$cur,0); # reset
    return $size;
  }
  
  #--------------------------------------------------------------------------#
  # Methods copied from Tie::StdHandle to avoid dependency on Perl 5.8.9/5.10.0
  #--------------------------------------------------------------------------#
  
  sub EOF     { eof($_[0]) }
  sub FILENO  { fileno($_[0]) }
  sub CLOSE   { close($_[0]) }
  sub BINMODE { binmode($_[0]) }
  sub READ     { read($_[0],$_[1],$_[2]) }
  sub READLINE { my $fh = $_[0]; <$fh> }
  sub GETC     { getc($_[0]) }
  
  sub WRITE
  {
   my $fh = $_[0];
   print $fh substr($_[1],0,$_[2])
  }
  
  1;
  
  
  # vim: ts=2 sts=2 sw=2 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Tie::Handle::Offset - Tied handle that hides the beginning of a file
  
  =head1 VERSION
  
  version 0.004
  
  =head1 SYNOPSIS
  
    use Tie::Handle::Offset;
  
    tie *FH, 'Tie::Handle::Offset', "<", $filename, { offset => 20 };
  
  =head1 DESCRIPTION
  
  This modules provides a file handle that hides the beginning of a file.
  After opening, the file is positioned at the offset location. C<seek()> and
  C<tell()> calls are modified to preserve the offset.
  
  For example, C<tell($fh)> will return 0, though the actual file position
  is at the offset.  Likewise, C<seek($fh,80,0)> will seek to 80 bytes from
  the offset instead of 80 bytes from the actual start of the file.
  
  =for Pod::Coverage method_names_here
  
  =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/tie-handle-offset/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/tie-handle-offset>
  
    git clone https://github.com/dagolden/tie-handle-offset.git
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2012 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
TIE_HANDLE_OFFSET

$fatpacked{"Tie/Handle/SkipHeader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIE_HANDLE_SKIPHEADER';
  use strict;
  BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } }
  
  package Tie::Handle::SkipHeader;
  # ABSTRACT: Tied handle that hides an RFC822-style header
  
  our $VERSION = '0.004';
  
  use Tie::Handle::Offset;
  our @ISA = qw/Tie::Handle::Offset/;
  
  sub TIEHANDLE
  {
    my $class = shift;
    pop if ref $_[-1] eq 'HASH'; # we don't take any arguments
    return $class->SUPER::TIEHANDLE(@_);
  }
  
  # read to blank/whitespace line and set offset right after
  sub OPEN
  {
    my $self = shift;
    my $rc = $self->SUPER::OPEN(@_);
    while ( my $line = <$self> ) {
      last if $line =~ /\A\s*\Z/;
    }
    $self->offset( tell($self) );
    return $rc;
  }
  
  1;
  
  
  # vim: ts=2 sts=2 sw=2 et:
  
  __END__
  
  =pod
  
  =encoding UTF-8
  
  =head1 NAME
  
  Tie::Handle::SkipHeader - Tied handle that hides an RFC822-style header
  
  =head1 VERSION
  
  version 0.004
  
  =head1 SYNOPSIS
  
    use Tie::Handle::SkipHeader;
  
    tie *FH, 'Tie::Handle::SkipHeader', "<", $filename;
  
  =head1 DESCRIPTION
  
  This subclass of L<Tie::Handle::Offset> automatically hides an email-style
  message header.  After opening the file, it reads up to a blank or
  white-space-only line and sets the offset to the next byte.
  
  =for Pod::Coverage method_names_here
  
  =head1 AUTHOR
  
  David Golden <dagolden@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is Copyright (c) 2012 by David Golden.
  
  This is free software, licensed under:
  
    The Apache License, Version 2.0, January 2004
  
  =cut
TIE_HANDLE_SKIPHEADER

$fatpacked{"Try/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TRY_TINY';
  package Try::Tiny; # git description: v0.29-2-g3b23a06
  use 5.006;
  # ABSTRACT: Minimal try/catch with proper preservation of $@
  
  our $VERSION = '0.30';
  
  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.30
  
  =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
  learnt 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<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 Lukas Mai Aristotle Pagaltzis Dagfinn Ilmari Mannsåker Paul Howarth Rudolf Leermakers anaxagoras awalker chromatic Alex cm-perl Andrew Yates David Lowe Glenn Hans Dieter Pearcey Jens Berthold Jonathan Yu Marc Mims Stosberg Pali
  
  =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 *
  
  Lukas Mai <l.mai@web.de>
  
  =item *
  
  Aristotle Pagaltzis <pagaltzis@gmx.de>
  
  =item *
  
  Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
  
  =item *
  
  Paul Howarth <paul@city-fan.org>
  
  =item *
  
  Rudolf Leermakers <rudolf@hatsuseno.org>
  
  =item *
  
  anaxagoras <walkeraj@gmail.com>
  
  =item *
  
  awalker <awalker@sourcefire.com>
  
  =item *
  
  chromatic <chromatic@wgz.org>
  
  =item *
  
  Alex <alex@koban.(none)>
  
  =item *
  
  cm-perl <cm-perl@users.noreply.github.com>
  
  =item *
  
  Andrew Yates <ayates@haddock.local>
  
  =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>
  
  =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

$fatpacked{"URI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI';
  package URI;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  our ($ABS_REMOTE_LEADING_DOTS, $ABS_ALLOW_RELATIVE_SCHEME, $DEFAULT_QUERY_FORM_DELIMITER);
  
  my %implements;  # mapping from scheme to implementor class
  
  # Some "official" character classes
  
  our $reserved   = q(;/?:@&=+$,[]);
  our $mark       = q(-_.!~*'());                                    #'; emacs
  our $unreserved = "A-Za-z0-9\Q$mark\E";
  our $uric       = quotemeta($reserved) . $unreserved . "%";
  
  our $scheme_re  = '[a-zA-Z][a-zA-Z0-9.+\-]*';
  
  use Carp ();
  use URI::Escape ();
  
  use overload ('""'     => sub { ${$_[0]} },
                '=='     => sub { _obj_eq(@_) },
                '!='     => sub { !_obj_eq(@_) },
                fallback => 1,
               );
  
  # Check if two objects are the same object
  sub _obj_eq {
      return overload::StrVal($_[0]) eq overload::StrVal($_[1]);
  }
  
  sub new
  {
      my($class, $uri, $scheme) = @_;
  
      $uri = defined ($uri) ? "$uri" : "";   # stringify
      # Get rid of potential wrapping
      $uri =~ s/^<(?:URL:)?(.*)>$/$1/;  # 
      $uri =~ s/^"(.*)"$/$1/;
      $uri =~ s/^\s+//;
      $uri =~ s/\s+$//;
  
      my $impclass;
      if ($uri =~ m/^($scheme_re):/so) {
  	$scheme = $1;
      }
      else {
  	if (($impclass = ref($scheme))) {
  	    $scheme = $scheme->scheme;
  	}
  	elsif ($scheme && $scheme =~ m/^($scheme_re)(?::|$)/o) {
  	    $scheme = $1;
          }
      }
      $impclass ||= implementor($scheme) ||
  	do {
  	    require URI::_foreign;
  	    $impclass = 'URI::_foreign';
  	};
  
      return $impclass->_init($uri, $scheme);
  }
  
  
  sub new_abs
  {
      my($class, $uri, $base) = @_;
      $uri = $class->new($uri, $base);
      $uri->abs($base);
  }
  
  
  sub _init
  {
      my $class = shift;
      my($str, $scheme) = @_;
      # find all funny characters and encode the bytes.
      $str = $class->_uric_escape($str);
      $str = "$scheme:$str" unless $str =~ /^$scheme_re:/o ||
                                   $class->_no_scheme_ok;
      my $self = bless \$str, $class;
      $self;
  }
  
  
  sub _uric_escape
  {
      my($class, $str) = @_;
      $str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
      utf8::downgrade($str);
      return $str;
  }
  
  my %require_attempted;
  
  sub implementor
  {
      my($scheme, $impclass) = @_;
      if (!$scheme || $scheme !~ /\A$scheme_re\z/o) {
  	require URI::_generic;
  	return "URI::_generic";
      }
  
      $scheme = lc($scheme);
  
      if ($impclass) {
  	# Set the implementor class for a given scheme
          my $old = $implements{$scheme};
          $impclass->_init_implementor($scheme);
          $implements{$scheme} = $impclass;
          return $old;
      }
  
      my $ic = $implements{$scheme};
      return $ic if $ic;
  
      # scheme not yet known, look for internal or
      # preloaded (with 'use') implementation
      $ic = "URI::$scheme";  # default location
  
      # turn scheme into a valid perl identifier by a simple transformation...
      $ic =~ s/\+/_P/g;
      $ic =~ s/\./_O/g;
      $ic =~ s/\-/_/g;
  
      no strict 'refs';
      # check we actually have one for the scheme:
      unless (@{"${ic}::ISA"}) {
          if (not exists $require_attempted{$ic}) {
              # Try to load it
              my $_old_error = $@;
              eval "require $ic";
              die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
              $@ = $_old_error;
          }
          return undef unless @{"${ic}::ISA"};
      }
  
      $ic->_init_implementor($scheme);
      $implements{$scheme} = $ic;
      $ic;
  }
  
  
  sub _init_implementor
  {
      my($class, $scheme) = @_;
      # Remember that one implementor class may actually
      # serve to implement several URI schemes.
  }
  
  
  sub clone
  {
      my $self = shift;
      my $other = $$self;
      bless \$other, ref $self;
  }
  
  sub TO_JSON { ${$_[0]} }
  
  sub _no_scheme_ok { 0 }
  
  sub _scheme
  {
      my $self = shift;
  
      unless (@_) {
  	return undef unless $$self =~ /^($scheme_re):/o;
  	return $1;
      }
  
      my $old;
      my $new = shift;
      if (defined($new) && length($new)) {
  	Carp::croak("Bad scheme '$new'") unless $new =~ /^$scheme_re$/o;
  	$old = $1 if $$self =~ s/^($scheme_re)://o;
  	my $newself = URI->new("$new:$$self");
  	$$self = $$newself; 
  	bless $self, ref($newself);
      }
      else {
  	if ($self->_no_scheme_ok) {
  	    $old = $1 if $$self =~ s/^($scheme_re)://o;
  	    Carp::carp("Oops, opaque part now look like scheme")
  		if $^W && $$self =~ m/^$scheme_re:/o
  	}
  	else {
  	    $old = $1 if $$self =~ m/^($scheme_re):/o;
  	}
      }
  
      return $old;
  }
  
  sub scheme
  {
      my $scheme = shift->_scheme(@_);
      return undef unless defined $scheme;
      lc($scheme);
  }
  
  sub has_recognized_scheme {
      my $self = shift;
      return ref($self) !~ /^URI::_(?:foreign|generic)\z/;
  }
  
  sub opaque
  {
      my $self = shift;
  
      unless (@_) {
  	$$self =~ /^(?:$scheme_re:)?([^\#]*)/o or die;
  	return $1;
      }
  
      $$self =~ /^($scheme_re:)?    # optional scheme
  	        ([^\#]*)          # opaque
                  (\#.*)?           # optional fragment
                $/sx or die;
  
      my $old_scheme = $1;
      my $old_opaque = $2;
      my $old_frag   = $3;
  
      my $new_opaque = shift;
      $new_opaque = "" unless defined $new_opaque;
      $new_opaque =~ s/([^$uric])/ URI::Escape::escape_char($1)/ego;
      utf8::downgrade($new_opaque);
  
      $$self = defined($old_scheme) ? $old_scheme : "";
      $$self .= $new_opaque;
      $$self .= $old_frag if defined $old_frag;
  
      $old_opaque;
  }
  
  sub path { goto &opaque }  # alias
  
  
  sub fragment
  {
      my $self = shift;
      unless (@_) {
  	return undef unless $$self =~ /\#(.*)/s;
  	return $1;
      }
  
      my $old;
      $old = $1 if $$self =~ s/\#(.*)//s;
  
      my $new_frag = shift;
      if (defined $new_frag) {
  	$new_frag =~ s/([^$uric])/ URI::Escape::escape_char($1) /ego;
  	utf8::downgrade($new_frag);
  	$$self .= "#$new_frag";
      }
      $old;
  }
  
  
  sub as_string
  {
      my $self = shift;
      $$self;
  }
  
  
  sub as_iri
  {
      my $self = shift;
      my $str = $$self;
      if ($str =~ s/%([89a-fA-F][0-9a-fA-F])/chr(hex($1))/eg) {
  	# All this crap because the more obvious:
  	#
  	#   Encode::decode("UTF-8", $str, sub { sprintf "%%%02X", shift })
  	#
  	# doesn't work before Encode 2.39.  Wait for a standard release
  	# to bundle that version.
  
  	require Encode;
  	my $enc = Encode::find_encoding("UTF-8");
  	my $u = "";
  	while (length $str) {
  	    $u .= $enc->decode($str, Encode::FB_QUIET());
  	    if (length $str) {
  		# escape next char
  		$u .= URI::Escape::escape_char(substr($str, 0, 1, ""));
  	    }
  	}
  	$str = $u;
      }
      return $str;
  }
  
  
  sub canonical
  {
      # Make sure scheme is lowercased, that we don't escape unreserved chars,
      # and that we use upcase escape sequences.
  
      my $self = shift;
      my $scheme = $self->_scheme || "";
      my $uc_scheme = $scheme =~ /[A-Z]/;
      my $esc = $$self =~ /%[a-fA-F0-9]{2}/;
      return $self unless $uc_scheme || $esc;
  
      my $other = $self->clone;
      if ($uc_scheme) {
  	$other->_scheme(lc $scheme);
      }
      if ($esc) {
  	$$other =~ s{%([0-9a-fA-F]{2})}
  	            { my $a = chr(hex($1));
                        $a =~ /^[$unreserved]\z/o ? $a : "%\U$1"
                      }ge;
      }
      return $other;
  }
  
  # Compare two URIs, subclasses will provide a more correct implementation
  sub eq {
      my($self, $other) = @_;
      $self  = URI->new($self, $other) unless ref $self;
      $other = URI->new($other, $self) unless ref $other;
      ref($self) eq ref($other) &&                # same class
  	$self->canonical->as_string eq $other->canonical->as_string;
  }
  
  # generic-URI transformation methods
  sub abs { $_[0]; }
  sub rel { $_[0]; }
  
  sub secure { 0 }
  
  # help out Storable
  sub STORABLE_freeze {
         my($self, $cloning) = @_;
         return $$self;
  }
  
  sub STORABLE_thaw {
         my($self, $cloning, $str) = @_;
         $$self = $str;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI - Uniform Resource Identifiers (absolute and relative)
  
  =head1 SYNOPSIS
  
   use URI;
  
   $u1 = URI->new("http://www.perl.com");
   $u2 = URI->new("foo", "http");
   $u3 = $u2->abs($u1);
   $u4 = $u3->clone;
   $u5 = URI->new("HTTP://WWW.perl.com:80")->canonical;
  
   $str = $u->as_string;
   $str = "$u";
  
   $scheme = $u->scheme;
   $opaque = $u->opaque;
   $path   = $u->path;
   $frag   = $u->fragment;
  
   $u->scheme("ftp");
   $u->host("ftp.perl.com");
   $u->path("cpan/");
  
  =head1 DESCRIPTION
  
  This module implements the C<URI> class.  Objects of this class
  represent "Uniform Resource Identifier references" as specified in RFC
  2396 (and updated by RFC 2732).
  
  A Uniform Resource Identifier is a compact string of characters that
  identifies an abstract or physical resource.  A Uniform Resource
  Identifier can be further classified as either a Uniform Resource Locator
  (URL) or a Uniform Resource Name (URN).  The distinction between URL
  and URN does not matter to the C<URI> class interface. A
  "URI-reference" is a URI that may have additional information attached
  in the form of a fragment identifier.
  
  An absolute URI reference consists of three parts:  a I<scheme>, a
  I<scheme-specific part> and a I<fragment> identifier.  A subset of URI
  references share a common syntax for hierarchical namespaces.  For
  these, the scheme-specific part is further broken down into
  I<authority>, I<path> and I<query> components.  These URIs can also
  take the form of relative URI references, where the scheme (and
  usually also the authority) component is missing, but implied by the
  context of the URI reference.  The three forms of URI reference
  syntax are summarized as follows:
  
    <scheme>:<scheme-specific-part>#<fragment>
    <scheme>://<authority><path>?<query>#<fragment>
    <path>?<query>#<fragment>
  
  The components into which a URI reference can be divided depend on the
  I<scheme>.  The C<URI> class provides methods to get and set the
  individual components.  The methods available for a specific
  C<URI> object depend on the scheme.
  
  =head1 CONSTRUCTORS
  
  The following methods construct new C<URI> objects:
  
  =over 4
  
  =item $uri = URI->new( $str )
  
  =item $uri = URI->new( $str, $scheme )
  
  Constructs a new URI object.  The string
  representation of a URI is given as argument, together with an optional
  scheme specification.  Common URI wrappers like "" and <>, as well as
  leading and trailing white space, are automatically removed from
  the $str argument before it is processed further.
  
  The constructor determines the scheme, maps this to an appropriate
  URI subclass, constructs a new object of that class and returns it.
  
  If the scheme isn't one of those that URI recognizes, you still get
  an URI object back that you can access the generic methods on.  The
  C<< $uri->has_recognized_scheme >> method can be used to test for
  this.
  
  The $scheme argument is only used when $str is a
  relative URI.  It can be either a simple string that
  denotes the scheme, a string containing an absolute URI reference, or
  an absolute C<URI> object.  If no $scheme is specified for a relative
  URI $str, then $str is simply treated as a generic URI (no scheme-specific
  methods available).
  
  The set of characters available for building URI references is
  restricted (see L<URI::Escape>).  Characters outside this set are
  automatically escaped by the URI constructor.
  
  =item $uri = URI->new_abs( $str, $base_uri )
  
  Constructs a new absolute URI object.  The $str argument can
  denote a relative or absolute URI.  If relative, then it is
  absolutized using $base_uri as base. The $base_uri must be an absolute
  URI.
  
  =item $uri = URI::file->new( $filename )
  
  =item $uri = URI::file->new( $filename, $os )
  
  Constructs a new I<file> URI from a file name.  See L<URI::file>.
  
  =item $uri = URI::file->new_abs( $filename )
  
  =item $uri = URI::file->new_abs( $filename, $os )
  
  Constructs a new absolute I<file> URI from a file name.  See
  L<URI::file>.
  
  =item $uri = URI::file->cwd
  
  Returns the current working directory as a I<file> URI.  See
  L<URI::file>.
  
  =item $uri->clone
  
  Returns a copy of the $uri.
  
  =back
  
  =head1 COMMON METHODS
  
  The methods described in this section are available for all C<URI>
  objects.
  
  Methods that give access to components of a URI always return the
  old value of the component.  The value returned is C<undef> if the
  component was not present.  There is generally a difference between a
  component that is empty (represented as C<"">) and a component that is
  missing (represented as C<undef>).  If an accessor method is given an
  argument, it updates the corresponding component in addition to
  returning the old value of the component.  Passing an undefined
  argument removes the component (if possible).  The description of
  each accessor method indicates whether the component is passed as
  an escaped (percent-encoded) or an unescaped string.  A component that can be further
  divided into sub-parts are usually passed escaped, as unescaping might
  change its semantics.
  
  The common methods available for all URI are:
  
  =over 4
  
  =item $uri->scheme
  
  =item $uri->scheme( $new_scheme )
  
  Sets and returns the scheme part of the $uri.  If the $uri is
  relative, then $uri->scheme returns C<undef>.  If called with an
  argument, it updates the scheme of $uri, possibly changing the
  class of $uri, and returns the old scheme value.  The method croaks
  if the new scheme name is illegal; a scheme name must begin with a
  letter and must consist of only US-ASCII letters, numbers, and a few
  special marks: ".", "+", "-".  This restriction effectively means
  that the scheme must be passed unescaped.  Passing an undefined
  argument to the scheme method makes the URI relative (if possible).
  
  Letter case does not matter for scheme names.  The string
  returned by $uri->scheme is always lowercase.  If you want the scheme
  just as it was written in the URI in its original case,
  you can use the $uri->_scheme method instead.
  
  =item $uri->has_recognized_scheme
  
  Returns TRUE if the URI scheme is one that URI recognizes.
  
  It will also be TRUE for relative URLs where a recognized
  scheme was provided to the constructor, even if C<< $uri->scheme >>
  returns C<undef> for these.
  
  =item $uri->opaque
  
  =item $uri->opaque( $new_opaque )
  
  Sets and returns the scheme-specific part of the $uri
  (everything between the scheme and the fragment)
  as an escaped string.
  
  =item $uri->path
  
  =item $uri->path( $new_path )
  
  Sets and returns the same value as $uri->opaque unless the URI
  supports the generic syntax for hierarchical namespaces.
  In that case the generic method is overridden to set and return
  the part of the URI between the I<host name> and the I<fragment>.
  
  =item $uri->fragment
  
  =item $uri->fragment( $new_frag )
  
  Returns the fragment identifier of a URI reference
  as an escaped string.
  
  =item $uri->as_string
  
  Returns a URI object to a plain ASCII string.  URI objects are
  also converted to plain strings automatically by overloading.  This
  means that $uri objects can be used as plain strings in most Perl
  constructs.
  
  =item $uri->as_iri
  
  Returns a Unicode string representing the URI.  Escaped UTF-8 sequences
  representing non-ASCII characters are turned into their corresponding Unicode
  code point.
  
  =item $uri->canonical
  
  Returns a normalized version of the URI.  The rules
  for normalization are scheme-dependent.  They usually involve
  lowercasing the scheme and Internet host name components,
  removing the explicit port specification if it matches the default port,
  uppercasing all escape sequences, and unescaping octets that can be
  better represented as plain characters.
  
  For efficiency reasons, if the $uri is already in normalized form,
  then a reference to it is returned instead of a copy.
  
  =item $uri->eq( $other_uri )
  
  =item URI::eq( $first_uri, $other_uri )
  
  Tests whether two URI references are equal.  URI references
  that normalize to the same string are considered equal.  The method
  can also be used as a plain function which can also test two string
  arguments.
  
  If you need to test whether two C<URI> object references denote the
  same object, use the '==' operator.
  
  =item $uri->abs( $base_uri )
  
  Returns an absolute URI reference.  If $uri is already
  absolute, then a reference to it is simply returned.  If the $uri
  is relative, then a new absolute URI is constructed by combining the
  $uri and the $base_uri, and returned.
  
  =item $uri->rel( $base_uri )
  
  Returns a relative URI reference if it is possible to
  make one that denotes the same resource relative to $base_uri.
  If not, then $uri is simply returned.
  
  =item $uri->secure
  
  Returns a TRUE value if the URI is considered to point to a resource on
  a secure channel, such as an SSL or TLS encrypted one.
  
  =back
  
  =head1 GENERIC METHODS
  
  The following methods are available to schemes that use the
  common/generic syntax for hierarchical namespaces.  The descriptions of
  schemes below indicate which these are.  Unrecognized schemes are
  assumed to support the generic syntax, and therefore the following
  methods:
  
  =over 4
  
  =item $uri->authority
  
  =item $uri->authority( $new_authority )
  
  Sets and returns the escaped authority component
  of the $uri.
  
  =item $uri->path
  
  =item $uri->path( $new_path )
  
  Sets and returns the escaped path component of
  the $uri (the part between the host name and the query or fragment).
  The path can never be undefined, but it can be the empty string.
  
  =item $uri->path_query
  
  =item $uri->path_query( $new_path_query )
  
  Sets and returns the escaped path and query
  components as a single entity.  The path and the query are
  separated by a "?" character, but the query can itself contain "?".
  
  =item $uri->path_segments
  
  =item $uri->path_segments( $segment, ... )
  
  Sets and returns the path.  In a scalar context, it returns
  the same value as $uri->path.  In a list context, it returns the
  unescaped path segments that make up the path.  Path segments that
  have parameters are returned as an anonymous array.  The first element
  is the unescaped path segment proper;  subsequent elements are escaped
  parameter strings.  Such an anonymous array uses overloading so it can
  be treated as a string too, but this string does not include the
  parameters.
  
  Note that absolute paths have the empty string as their first
  I<path_segment>, i.e. the I<path> C</foo/bar> have 3
  I<path_segments>; "", "foo" and "bar".
  
  =item $uri->query
  
  =item $uri->query( $new_query )
  
  Sets and returns the escaped query component of
  the $uri.
  
  =item $uri->query_form
  
  =item $uri->query_form( $key1 => $val1, $key2 => $val2, ... )
  
  =item $uri->query_form( $key1 => $val1, $key2 => $val2, ..., $delim )
  
  =item $uri->query_form( \@key_value_pairs )
  
  =item $uri->query_form( \@key_value_pairs, $delim )
  
  =item $uri->query_form( \%hash )
  
  =item $uri->query_form( \%hash, $delim )
  
  Sets and returns query components that use the
  I<application/x-www-form-urlencoded> format.  Key/value pairs are
  separated by "&", and the key is separated from the value by a "="
  character.
  
  The form can be set either by passing separate key/value pairs, or via
  an array or hash reference.  Passing an empty array or an empty hash
  removes the query component, whereas passing no arguments at all leaves
  the component unchanged.  The order of keys is undefined if a hash
  reference is passed.  The old value is always returned as a list of
  separate key/value pairs.  Assigning this list to a hash is unwise as
  the keys returned might repeat.
  
  The values passed when setting the form can be plain strings or
  references to arrays of strings.  Passing an array of values has the
  same effect as passing the key repeatedly with one value at a time.
  All the following statements have the same effect:
  
      $uri->query_form(foo => 1, foo => 2);
      $uri->query_form(foo => [1, 2]);
      $uri->query_form([ foo => 1, foo => 2 ]);
      $uri->query_form([ foo => [1, 2] ]);
      $uri->query_form({ foo => [1, 2] });
  
  The $delim parameter can be passed as ";" to force the key/value pairs
  to be delimited by ";" instead of "&" in the query string.  This
  practice is often recommended for URLs embedded in HTML or XML
  documents as this avoids the trouble of escaping the "&" character.
  You might also set the $URI::DEFAULT_QUERY_FORM_DELIMITER variable to
  ";" for the same global effect.
  
  The C<URI::QueryParam> module can be loaded to add further methods to
  manipulate the form of a URI.  See L<URI::QueryParam> for details.
  
  =item $uri->query_keywords
  
  =item $uri->query_keywords( $keywords, ... )
  
  =item $uri->query_keywords( \@keywords )
  
  Sets and returns query components that use the
  keywords separated by "+" format.
  
  The keywords can be set either by passing separate keywords directly
  or by passing a reference to an array of keywords.  Passing an empty
  array removes the query component, whereas passing no arguments at
  all leaves the component unchanged.  The old value is always returned
  as a list of separate words.
  
  =back
  
  =head1 SERVER METHODS
  
  For schemes where the I<authority> component denotes an Internet host,
  the following methods are available in addition to the generic
  methods.
  
  =over 4
  
  =item $uri->userinfo
  
  =item $uri->userinfo( $new_userinfo )
  
  Sets and returns the escaped userinfo part of the
  authority component.
  
  For some schemes this is a user name and a password separated by
  a colon.  This practice is not recommended. Embedding passwords in
  clear text (such as URI) has proven to be a security risk in almost
  every case where it has been used.
  
  =item $uri->host
  
  =item $uri->host( $new_host )
  
  Sets and returns the unescaped hostname.
  
  If the $new_host string ends with a colon and a number, then this
  number also sets the port.
  
  For IPv6 addresses the brackets around the raw address is removed in the return
  value from $uri->host.  When setting the host attribute to an IPv6 address you
  can use a raw address or one enclosed in brackets.  The address needs to be
  enclosed in brackets if you want to pass in a new port value as well.
  
  =item $uri->ihost
  
  Returns the host in Unicode form.  Any IDNA A-labels are turned into U-labels.
  
  =item $uri->port
  
  =item $uri->port( $new_port )
  
  Sets and returns the port.  The port is a simple integer
  that should be greater than 0.
  
  If a port is not specified explicitly in the URI, then the URI scheme's default port
  is returned. If you don't want the default port
  substituted, then you can use the $uri->_port method instead.
  
  =item $uri->host_port
  
  =item $uri->host_port( $new_host_port )
  
  Sets and returns the host and port as a single
  unit.  The returned value includes a port, even if it matches the
  default port.  The host part and the port part are separated by a
  colon: ":".
  
  For IPv6 addresses the bracketing is preserved; thus
  URI->new("http://[::1]/")->host_port returns "[::1]:80".  Contrast this with
  $uri->host which will remove the brackets.
  
  =item $uri->default_port
  
  Returns the default port of the URI scheme to which $uri
  belongs.  For I<http> this is the number 80, for I<ftp> this
  is the number 21, etc.  The default port for a scheme can not be
  changed.
  
  =back
  
  =head1 SCHEME-SPECIFIC SUPPORT
  
  Scheme-specific support is provided for the following URI schemes.  For C<URI>
  objects that do not belong to one of these, you can only use the common and
  generic methods.
  
  =over 4
  
  =item B<data>:
  
  The I<data> URI scheme is specified in RFC 2397.  It allows inclusion
  of small data items as "immediate" data, as if it had been included
  externally.
  
  C<URI> objects belonging to the data scheme support the common methods
  and two new methods to access their scheme-specific components:
  $uri->media_type and $uri->data.  See L<URI::data> for details.
  
  =item B<file>:
  
  An old specification of the I<file> URI scheme is found in RFC 1738.
  A new RFC 2396 based specification in not available yet, but file URI
  references are in common use.
  
  C<URI> objects belonging to the file scheme support the common and
  generic methods.  In addition, they provide two methods for mapping file URIs
  back to local file names; $uri->file and $uri->dir.  See L<URI::file>
  for details.
  
  =item B<ftp>:
  
  An old specification of the I<ftp> URI scheme is found in RFC 1738.  A
  new RFC 2396 based specification in not available yet, but ftp URI
  references are in common use.
  
  C<URI> objects belonging to the ftp scheme support the common,
  generic and server methods.  In addition, they provide two methods for
  accessing the userinfo sub-components: $uri->user and $uri->password.
  
  =item B<gopher>:
  
  The I<gopher> URI scheme is specified in
  <draft-murali-url-gopher-1996-12-04> and will hopefully be available
  as a RFC 2396 based specification.
  
  C<URI> objects belonging to the gopher scheme support the common,
  generic and server methods. In addition, they support some methods for
  accessing gopher-specific path components: $uri->gopher_type,
  $uri->selector, $uri->search, $uri->string.
  
  =item B<http>:
  
  The I<http> URI scheme is specified in RFC 2616.
  The scheme is used to reference resources hosted by HTTP servers.
  
  C<URI> objects belonging to the http scheme support the common,
  generic and server methods.
  
  =item B<https>:
  
  The I<https> URI scheme is a Netscape invention which is commonly
  implemented.  The scheme is used to reference HTTP servers through SSL
  connections.  Its syntax is the same as http, but the default
  port is different.
  
  =item B<ldap>:
  
  The I<ldap> URI scheme is specified in RFC 2255.  LDAP is the
  Lightweight Directory Access Protocol.  An ldap URI describes an LDAP
  search operation to perform to retrieve information from an LDAP
  directory.
  
  C<URI> objects belonging to the ldap scheme support the common,
  generic and server methods as well as ldap-specific methods: $uri->dn,
  $uri->attributes, $uri->scope, $uri->filter, $uri->extensions.  See
  L<URI::ldap> for details.
  
  =item B<ldapi>:
  
  Like the I<ldap> URI scheme, but uses a UNIX domain socket.  The
  server methods are not supported, and the local socket path is
  available as $uri->un_path.  The I<ldapi> scheme is used by the
  OpenLDAP package.  There is no real specification for it, but it is
  mentioned in various OpenLDAP manual pages.
  
  =item B<ldaps>:
  
  Like the I<ldap> URI scheme, but uses an SSL connection.  This
  scheme is deprecated, as the preferred way is to use the I<start_tls>
  mechanism.
  
  =item B<mailto>:
  
  The I<mailto> URI scheme is specified in RFC 2368.  The scheme was
  originally used to designate the Internet mailing address of an
  individual or service.  It has (in RFC 2368) been extended to allow
  setting of other mail header fields and the message body.
  
  C<URI> objects belonging to the mailto scheme support the common
  methods and the generic query methods.  In addition, they support the
  following mailto-specific methods: $uri->to, $uri->headers.
  
  Note that the "foo@example.com" part of a mailto is I<not> the
  C<userinfo> and C<host> but instead the C<path>.  This allows a
  mailto URI to contain multiple comma separated email addresses.
  
  =item B<mms>:
  
  The I<mms> URL specification can be found at L<http://sdp.ppona.com/>.
  C<URI> objects belonging to the mms scheme support the common,
  generic, and server methods, with the exception of userinfo and
  query-related sub-components.
  
  =item B<news>:
  
  The I<news>, I<nntp> and I<snews> URI schemes are specified in
  <draft-gilman-news-url-01> and will hopefully be available as an RFC
  2396 based specification soon.
  
  C<URI> objects belonging to the news scheme support the common,
  generic and server methods.  In addition, they provide some methods to
  access the path: $uri->group and $uri->message.
  
  =item B<nntp>:
  
  See I<news> scheme.
  
  =item B<pop>:
  
  The I<pop> URI scheme is specified in RFC 2384. The scheme is used to
  reference a POP3 mailbox.
  
  C<URI> objects belonging to the pop scheme support the common, generic
  and server methods.  In addition, they provide two methods to access the
  userinfo components: $uri->user and $uri->auth
  
  =item B<rlogin>:
  
  An old specification of the I<rlogin> URI scheme is found in RFC
  1738. C<URI> objects belonging to the rlogin scheme support the
  common, generic and server methods.
  
  =item B<rtsp>:
  
  The I<rtsp> URL specification can be found in section 3.2 of RFC 2326.
  C<URI> objects belonging to the rtsp scheme support the common,
  generic, and server methods, with the exception of userinfo and
  query-related sub-components.
  
  =item B<rtspu>:
  
  The I<rtspu> URI scheme is used to talk to RTSP servers over UDP
  instead of TCP.  The syntax is the same as rtsp.
  
  =item B<rsync>:
  
  Information about rsync is available from L<http://rsync.samba.org/>.
  C<URI> objects belonging to the rsync scheme support the common,
  generic and server methods.  In addition, they provide methods to
  access the userinfo sub-components: $uri->user and $uri->password.
  
  =item B<sip>:
  
  The I<sip> URI specification is described in sections 19.1 and 25
  of RFC 3261.  C<URI> objects belonging to the sip scheme support the
  common, generic, and server methods with the exception of path related
  sub-components.  In addition, they provide two methods to get and set
  I<sip> parameters: $uri->params_form and $uri->params.
  
  =item B<sips>:
  
  See I<sip> scheme.  Its syntax is the same as sip, but the default
  port is different.
  
  =item B<snews>:
  
  See I<news> scheme.  Its syntax is the same as news, but the default
  port is different.
  
  =item B<telnet>:
  
  An old specification of the I<telnet> URI scheme is found in RFC
  1738. C<URI> objects belonging to the telnet scheme support the
  common, generic and server methods.
  
  =item B<tn3270>:
  
  These URIs are used like I<telnet> URIs but for connections to IBM
  mainframes.  C<URI> objects belonging to the tn3270 scheme support the
  common, generic and server methods.
  
  =item B<ssh>:
  
  Information about ssh is available at L<http://www.openssh.com/>.
  C<URI> objects belonging to the ssh scheme support the common,
  generic and server methods. In addition, they provide methods to
  access the userinfo sub-components: $uri->user and $uri->password.
  
  =item B<sftp>:
  
  C<URI> objects belonging to the sftp scheme support the common,
  generic and server methods. In addition, they provide methods to
  access the userinfo sub-components: $uri->user and $uri->password.
  
  =item B<urn>:
  
  The syntax of Uniform Resource Names is specified in RFC 2141.  C<URI>
  objects belonging to the urn scheme provide the common methods, and also the
  methods $uri->nid and $uri->nss, which return the Namespace Identifier
  and the Namespace-Specific String respectively.
  
  The Namespace Identifier basically works like the Scheme identifier of
  URIs, and further divides the URN namespace.  Namespace Identifier
  assignments are maintained at
  L<http://www.iana.org/assignments/urn-namespaces>.
  
  Letter case is not significant for the Namespace Identifier.  It is
  always returned in lower case by the $uri->nid method.  The $uri->_nid
  method can be used if you want it in its original case.
  
  =item B<urn>:B<isbn>:
  
  The C<urn:isbn:> namespace contains International Standard Book
  Numbers (ISBNs) and is described in RFC 3187.  A C<URI> object belonging
  to this namespace has the following extra methods (if the
  Business::ISBN module is available): $uri->isbn,
  $uri->isbn_publisher_code, $uri->isbn_group_code (formerly isbn_country_code,
  which is still supported by issues a deprecation warning), $uri->isbn_as_ean.
  
  =item B<urn>:B<oid>:
  
  The C<urn:oid:> namespace contains Object Identifiers (OIDs) and is
  described in RFC 3061.  An object identifier consists of sequences of digits
  separated by dots.  A C<URI> object belonging to this namespace has an
  additional method called $uri->oid that can be used to get/set the oid
  value.  In a list context, oid numbers are returned as separate elements.
  
  =back
  
  =head1 CONFIGURATION VARIABLES
  
  The following configuration variables influence how the class and its
  methods behave:
  
  =over 4
  
  =item $URI::ABS_ALLOW_RELATIVE_SCHEME
  
  Some older parsers used to allow the scheme name to be present in the
  relative URL if it was the same as the base URL scheme.  RFC 2396 says
  that this should be avoided, but you can enable this old behaviour by
  setting the $URI::ABS_ALLOW_RELATIVE_SCHEME variable to a TRUE value.
  The difference is demonstrated by the following examples:
  
    URI->new("http:foo")->abs("http://host/a/b")
        ==>  "http:foo"
  
    local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
    URI->new("http:foo")->abs("http://host/a/b")
        ==>  "http:/host/a/foo"
  
  
  =item $URI::ABS_REMOTE_LEADING_DOTS
  
  You can also have the abs() method ignore excess ".."
  segments in the relative URI by setting $URI::ABS_REMOTE_LEADING_DOTS
  to a TRUE value.  The difference is demonstrated by the following
  examples:
  
    URI->new("../../../foo")->abs("http://host/a/b")
        ==> "http://host/../../foo"
  
    local $URI::ABS_REMOTE_LEADING_DOTS = 1;
    URI->new("../../../foo")->abs("http://host/a/b")
        ==> "http://host/foo"
  
  =item $URI::DEFAULT_QUERY_FORM_DELIMITER
  
  This value can be set to ";" to have the query form C<key=value> pairs
  delimited by ";" instead of "&" which is the default.
  
  =back
  
  =head1 BUGS
  
  There are some things that are not quite right:
  
  =over
  
  =item *
  
  Using regexp variables like $1 directly as arguments to the URI accessor methods
  does not work too well with current perl implementations.  I would argue
  that this is actually a bug in perl.  The workaround is to quote
  them. Example:
  
     /(...)/ || die;
     $u->query("$1");
  
  
  =item *
  
  The escaping (percent encoding) of chars in the 128 .. 255 range passed to the
  URI constructor or when setting URI parts using the accessor methods depend on
  the state of the internal UTF8 flag (see utf8::is_utf8) of the string passed.
  If the UTF8 flag is set the UTF-8 encoded version of the character is percent
  encoded.  If the UTF8 flag isn't set the Latin-1 version (byte) of the
  character is percent encoded.  This basically exposes the internal encoding of
  Perl strings.
  
  =back
  
  =head1 PARSING URIs WITH REGEXP
  
  As an alternative to this module, the following (official) regular
  expression can be used to decode a URI:
  
    my($scheme, $authority, $path, $query, $fragment) =
    $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
  
  The C<URI::Split> module provides the function uri_split() as a
  readable alternative.
  
  =head1 SEE ALSO
  
  L<URI::file>, L<URI::WithBase>, L<URI::QueryParam>, L<URI::Escape>,
  L<URI::Split>, L<URI::Heuristic>
  
  RFC 2396: "Uniform Resource Identifiers (URI): Generic Syntax",
  Berners-Lee, Fielding, Masinter, August 1998.
  
  L<http://www.iana.org/assignments/uri-schemes>
  
  L<http://www.iana.org/assignments/urn-namespaces>
  
  L<http://www.w3.org/Addressing/>
  
  =head1 COPYRIGHT
  
  Copyright 1995-2009 Gisle Aas.
  
  Copyright 1995 Martijn Koster.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =head1 AUTHORS / ACKNOWLEDGMENTS
  
  This module is based on the C<URI::URL> module, which in turn was
  (distantly) based on the C<wwwurl.pl> code in the libwww-perl for
  perl4 developed by Roy Fielding, as part of the Arcadia project at the
  University of California, Irvine, with contributions from Brooks
  Cutter.
  
  C<URI::URL> was developed by Gisle Aas, Tim Bunce, Roy Fielding and
  Martijn Koster with input from other people on the libwww-perl mailing
  list.
  
  C<URI> and related subclasses was developed by Gisle Aas.
  
  =cut
URI

$fatpacked{"URI/Escape.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_ESCAPE';
  package URI::Escape;
  
  use strict;
  use warnings;
  
  =head1 NAME
  
  URI::Escape - Percent-encode and percent-decode unsafe characters
  
  =head1 SYNOPSIS
  
   use URI::Escape;
   $safe = uri_escape("10% is enough\n");
   $verysafe = uri_escape("foo", "\0-\377");
   $str  = uri_unescape($safe);
  
  =head1 DESCRIPTION
  
  This module provides functions to percent-encode and percent-decode URI strings as
  defined by RFC 3986. Percent-encoding URI's is informally called "URI escaping".
  This is the terminology used by this module, which predates the formalization of the
  terms by the RFC by several years.
  
  A URI consists of a restricted set of characters.  The restricted set
  of characters consists of digits, letters, and a few graphic symbols
  chosen from those common to most of the character encodings and input
  facilities available to Internet users.  They are made up of the
  "unreserved" and "reserved" character sets as defined in RFC 3986.
  
     unreserved    = ALPHA / DIGIT / "-" / "." / "_" / "~"
     reserved      = ":" / "/" / "?" / "#" / "[" / "]" / "@"
                     "!" / "$" / "&" / "'" / "(" / ")"
                   / "*" / "+" / "," / ";" / "="
  
  In addition, any byte (octet) can be represented in a URI by an escape
  sequence: a triplet consisting of the character "%" followed by two
  hexadecimal digits.  A byte can also be represented directly by a
  character, using the US-ASCII character for that octet.
  
  Some of the characters are I<reserved> for use as delimiters or as
  part of certain URI components.  These must be escaped if they are to
  be treated as ordinary data.  Read RFC 3986 for further details.
  
  The functions provided (and exported by default) from this module are:
  
  =over 4
  
  =item uri_escape( $string )
  
  =item uri_escape( $string, $unsafe )
  
  Replaces each unsafe character in the $string with the corresponding
  escape sequence and returns the result.  The $string argument should
  be a string of bytes.  The uri_escape() function will croak if given a
  characters with code above 255.  Use uri_escape_utf8() if you know you
  have such chars or/and want chars in the 128 .. 255 range treated as
  UTF-8.
  
  The uri_escape() function takes an optional second argument that
  overrides the set of characters that are to be escaped.  The set is
  specified as a string that can be used in a regular expression
  character class (between [ ]).  E.g.:
  
    "\x00-\x1f\x7f-\xff"          # all control and hi-bit characters
    "a-z"                         # all lower case characters
    "^A-Za-z"                     # everything not a letter
  
  The default set of characters to be escaped is all those which are
  I<not> part of the C<unreserved> character class shown above as well
  as the reserved characters.  I.e. the default is:
  
      "^A-Za-z0-9\-\._~"
  
  =item uri_escape_utf8( $string )
  
  =item uri_escape_utf8( $string, $unsafe )
  
  Works like uri_escape(), but will encode chars as UTF-8 before
  escaping them.  This makes this function able to deal with characters
  with code above 255 in $string.  Note that chars in the 128 .. 255
  range will be escaped differently by this function compared to what
  uri_escape() would.  For chars in the 0 .. 127 range there is no
  difference.
  
  Equivalent to:
  
      utf8::encode($string);
      my $uri = uri_escape($string);
  
  Note: JavaScript has a function called escape() that produces the
  sequence "%uXXXX" for chars in the 256 .. 65535 range.  This function
  has really nothing to do with URI escaping but some folks got confused
  since it "does the right thing" in the 0 .. 255 range.  Because of
  this you sometimes see "URIs" with these kind of escapes.  The
  JavaScript encodeURIComponent() function is similar to uri_escape_utf8().
  
  =item uri_unescape($string,...)
  
  Returns a string with each %XX sequence replaced with the actual byte
  (octet).
  
  This does the same as:
  
     $string =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
  
  but does not modify the string in-place as this RE would.  Using the
  uri_unescape() function instead of the RE might make the code look
  cleaner and is a few characters less to type.
  
  In a simple benchmark test I did,
  calling the function (instead of the inline RE above) if a few chars
  were unescaped was something like 40% slower, and something like 700% slower if none were.  If
  you are going to unescape a lot of times it might be a good idea to
  inline the RE.
  
  If the uri_unescape() function is passed multiple strings, then each
  one is returned unescaped.
  
  =back
  
  The module can also export the C<%escapes> hash, which contains the
  mapping from all 256 bytes to the corresponding escape codes.  Lookup
  in this hash is faster than evaluating C<sprintf("%%%02X", ord($byte))>
  each time.
  
  =head1 SEE ALSO
  
  L<URI>
  
  
  =head1 COPYRIGHT
  
  Copyright 1995-2004 Gisle Aas.
  
  This program is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
  
  use Exporter 5.57 'import';
  our %escapes;
  our @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
  our @EXPORT_OK = qw(%escapes);
  our $VERSION = "3.31";
  
  use Carp ();
  
  # Build a char->hex map
  for (0..255) {
      $escapes{chr($_)} = sprintf("%%%02X", $_);
  }
  
  my %subst;  # compiled patterns
  
  my %Unsafe = (
      RFC2732 => qr/[^A-Za-z0-9\-_.!~*'()]/,
      RFC3986 => qr/[^A-Za-z0-9\-\._~]/,
  );
  
  sub uri_escape {
      my($text, $patn) = @_;
      return undef unless defined $text;
      if (defined $patn){
          unless (exists  $subst{$patn}) {
              # Because we can't compile the regex we fake it with a cached sub
              (my $tmp = $patn) =~ s,/,\\/,g;
              eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
              Carp::croak("uri_escape: $@") if $@;
          }
          &{$subst{$patn}}($text);
      } else {
          $text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
      }
      $text;
  }
  
  sub _fail_hi {
      my $chr = shift;
      Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr));
  }
  
  sub uri_escape_utf8 {
      my $text = shift;
      return undef unless defined $text;
      utf8::encode($text);
      return uri_escape($text, @_);
  }
  
  sub uri_unescape {
      # Note from RFC1630:  "Sequences which start with a percent sign
      # but are not followed by two hexadecimal characters are reserved
      # for future extension"
      my $str = shift;
      if (@_ && wantarray) {
          # not executed for the common case of a single argument
          my @str = ($str, @_);  # need to copy
          for (@str) {
              s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
          }
          return @str;
      }
      $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
      $str;
  }
  
  # XXX FIXME escape_char is buggy as it assigns meaning to the string's storage format.
  sub escape_char {
      # Old versions of utf8::is_utf8() didn't properly handle magical vars (e.g. $1).
      # The following forces a fetch to occur beforehand.
      my $dummy = substr($_[0], 0, 0);
  
      if (utf8::is_utf8($_[0])) {
          my $s = shift;
          utf8::encode($s);
          unshift(@_, $s);
      }
  
      return join '', @URI::Escape::escapes{split //, $_[0]};
  }
  
  1;
URI_ESCAPE

$fatpacked{"URI/Heuristic.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HEURISTIC';
  package URI::Heuristic;
  
  =head1 NAME
  
  URI::Heuristic - Expand URI using heuristics
  
  =head1 SYNOPSIS
  
   use URI::Heuristic qw(uf_uristr);
   $u = uf_uristr("perl");             # http://www.perl.com
   $u = uf_uristr("www.sol.no/sol");   # http://www.sol.no/sol
   $u = uf_uristr("aas");              # http://www.aas.no
   $u = uf_uristr("ftp.funet.fi");     # ftp://ftp.funet.fi
   $u = uf_uristr("/etc/passwd");      # file:/etc/passwd
  
  =head1 DESCRIPTION
  
  This module provides functions that expand strings into real absolute
  URIs using some built-in heuristics.  Strings that already represent
  absolute URIs (i.e. that start with a C<scheme:> part) are never modified
  and are returned unchanged.  The main use of these functions is to
  allow abbreviated URIs similar to what many web browsers allow for URIs
  typed in by the user.
  
  The following functions are provided:
  
  =over 4
  
  =item uf_uristr($str)
  
  Tries to make the argument string
  into a proper absolute URI string.  The "uf_" prefix stands for "User 
  Friendly".  Under MacOS, it assumes that any string with a common URL 
  scheme (http, ftp, etc.) is a URL rather than a local path.  So don't name 
  your volumes after common URL schemes and expect uf_uristr() to construct 
  valid file: URL's on those volumes for you, because it won't.
  
  =item uf_uri($str)
  
  Works the same way as uf_uristr() but
  returns a C<URI> object.
  
  =back
  
  =head1 ENVIRONMENT
  
  If the hostname portion of a URI does not contain any dots, then
  certain qualified guesses are made.  These guesses are governed by
  the following environment variables:
  
  =over 10
  
  =item COUNTRY
  
  The two-letter country code (ISO 3166) for your location.  If
  the domain name of your host ends with two letters, then it is taken
  to be the default country. See also L<Locale::Country>.
  
  =item HTTP_ACCEPT_LANGUAGE, LC_ALL, LANG
  
  If COUNTRY is not set, these standard environment variables are
  examined and country (not language) information possibly found in them
  is used as the default country.
  
  =item URL_GUESS_PATTERN
  
  Contains a space-separated list of URL patterns to try.  The string
  "ACME" is for some reason used as a placeholder for the host name in
  the URL provided.  Example:
  
   URL_GUESS_PATTERN="www.ACME.no www.ACME.se www.ACME.com"
   export URL_GUESS_PATTERN
  
  Specifying URL_GUESS_PATTERN disables any guessing rules based on
  country.  An empty URL_GUESS_PATTERN disables any guessing that
  involves host name lookups.
  
  =back
  
  =head1 COPYRIGHT
  
  Copyright 1997-1998, Gisle Aas
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
  
  use strict;
  use warnings;
  
  use Exporter 5.57 'import';
  our @EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr);
  our $VERSION = "4.20";
  
  our ($MY_COUNTRY, $DEBUG);
  
  sub MY_COUNTRY() {
      for ($MY_COUNTRY) {
  	return $_ if defined;
  
  	# First try the environment.
  	$_ = $ENV{COUNTRY};
  	return $_ if defined;
  
  	# Try the country part of LC_ALL and LANG from environment
  	my @srcs = ($ENV{LC_ALL}, $ENV{LANG});
  	# ...and HTTP_ACCEPT_LANGUAGE before those if present
  	if (my $httplang = $ENV{HTTP_ACCEPT_LANGUAGE}) {
  	    # TODO: q-value processing/ordering
  	    for $httplang (split(/\s*,\s*/, $httplang)) {
  		if ($httplang =~ /^\s*([a-zA-Z]+)[_-]([a-zA-Z]{2})\s*$/) {
  		    unshift(@srcs, "${1}_${2}");
  		    last;
  		}
  	    }
  	}
  	for (@srcs) {
  	    next unless defined;
  	    return lc($1) if /^[a-zA-Z]+_([a-zA-Z]{2})(?:[.@]|$)/;
  	}
  
  	# Last bit of domain name.  This may access the network.
  	require Net::Domain;
  	my $fqdn = Net::Domain::hostfqdn();
  	$_ = lc($1) if $fqdn =~ /\.([a-zA-Z]{2})$/;
  	return $_ if defined;
  
  	# Give up.  Defined but false.
  	return ($_ = 0);
      }
  }
  
  our %LOCAL_GUESSING =
  (
   'us' => [qw(www.ACME.gov www.ACME.mil)],
   'gb' => [qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],
   'au' => [qw(www.ACME.com.au www.ACME.org.au www.ACME.edu.au)],
   'il' => [qw(www.ACME.co.il www.ACME.org.il www.ACME.net.il)],
   # send corrections and new entries to <gisle@aas.no>
  );
  # Backwards compatibility; uk != United Kingdom in ISO 3166
  $LOCAL_GUESSING{uk} = $LOCAL_GUESSING{gb};
  
  
  sub uf_uristr ($)
  {
      local($_) = @_;
      print STDERR "uf_uristr: resolving $_\n" if $DEBUG;
      return unless defined;
  
      s/^\s+//;
      s/\s+$//;
  
      if (/^(www|web|home)[a-z0-9-]*(?:\.|$)/i) {
  	$_ = "http://$_";
  
      } elsif (/^(ftp|gopher|news|wais|https|http)[a-z0-9-]*(?:\.|$)/i) {
  	$_ = lc($1) . "://$_";
  
      } elsif ($^O ne "MacOS" && 
  	    (m,^/,      ||          # absolute file name
  	     m,^\.\.?/, ||          # relative file name
  	     m,^[a-zA-Z]:[/\\],)    # dosish file name
  	    )
      {
  	$_ = "file:$_";
  
      } elsif ($^O eq "MacOS" && m/:/) {
          # potential MacOS file name
  	unless (m/^(ftp|gopher|news|wais|http|https|mailto):/) {
  	    require URI::file;
  	    my $a = URI::file->new($_)->as_string;
  	    $_ = ($a =~ m/^file:/) ? $a : "file:$a";
  	}
      } elsif (/^\w+([\.\-]\w+)*\@(\w+\.)+\w{2,3}$/) {
  	$_ = "mailto:$_";
  
      } elsif (!/^[a-zA-Z][a-zA-Z0-9.+\-]*:/) {      # no scheme specified
  	if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/) {
  	    my $host = $1;
  
  	    my $scheme = "http";
  	    if (/^:(\d+)\b/) {
  		# Some more or less well known ports
  		if ($1 =~ /^[56789]?443$/) {
  		    $scheme = "https";
  		} elsif ($1 eq "21") {
  		    $scheme = "ftp";
  		}
  	    }
  
  	    if ($host !~ /\./ && $host ne "localhost") {
  		my @guess;
  		if (exists $ENV{URL_GUESS_PATTERN}) {
  		    @guess = map { s/\bACME\b/$host/; $_ }
  		             split(' ', $ENV{URL_GUESS_PATTERN});
  		} else {
  		    if (MY_COUNTRY()) {
  			my $special = $LOCAL_GUESSING{MY_COUNTRY()};
  			if ($special) {
  			    my @special = @$special;
  			    push(@guess, map { s/\bACME\b/$host/; $_ }
                                                 @special);
  			} else {
  			    push(@guess, "www.$host." . MY_COUNTRY());
  			}
  		    }
  		    push(@guess, map "www.$host.$_",
  			             "com", "org", "net", "edu", "int");
  		}
  
  
  		my $guess;
  		for $guess (@guess) {
  		    print STDERR "uf_uristr: gethostbyname('$guess.')..."
  		      if $DEBUG;
  		    if (gethostbyname("$guess.")) {
  			print STDERR "yes\n" if $DEBUG;
  			$host = $guess;
  			last;
  		    }
  		    print STDERR "no\n" if $DEBUG;
  		}
  	    }
  	    $_ = "$scheme://$host$_";
  
  	} else {
  	    # pure junk, just return it unchanged...
  
  	}
      }
      print STDERR "uf_uristr: ==> $_\n" if $DEBUG;
  
      $_;
  }
  
  sub uf_uri ($)
  {
      require URI;
      URI->new(uf_uristr($_[0]));
  }
  
  # legacy
  *uf_urlstr = \*uf_uristr;
  
  sub uf_url ($)
  {
      require URI::URL;
      URI::URL->new(uf_uristr($_[0]));
  }
  
  1;
URI_HEURISTIC

$fatpacked{"URI/IRI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_IRI';
  package URI::IRI;
  
  # Experimental
  
  use strict;
  use warnings;
  use URI ();
  
  use overload '""' => sub { shift->as_string };
  
  our $VERSION = '1.76';
  
  sub new {
      my($class, $uri, $scheme) = @_;
      utf8::upgrade($uri);
      return bless {
  	uri => URI->new($uri, $scheme),
      }, $class;
  }
  
  sub clone {
      my $self = shift;
      return bless {
  	uri => $self->{uri}->clone,
      }, ref($self);
  }
  
  sub as_string {
      my $self = shift;
      return $self->{uri}->as_iri;
  }
  
  our $AUTOLOAD;
  sub AUTOLOAD
  {
      my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
  
      # We create the function here so that it will not need to be
      # autoloaded the next time.
      no strict 'refs';
      *$method = sub { shift->{uri}->$method(@_) };
      goto &$method;
  }
  
  sub DESTROY {}   # avoid AUTOLOADing it
  
  1;
URI_IRI

$fatpacked{"URI/QueryParam.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_QUERYPARAM';
  package URI::QueryParam;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  sub URI::_query::query_param {
      my $self = shift;
      my @old = $self->query_form;
  
      if (@_ == 0) {
  	# get keys
  	my (%seen, $i);
  	return grep !($i++ % 2 || $seen{$_}++), @old;
      }
  
      my $key = shift;
      my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old;
  
      if (@_) {
  	my @new = @old;
  	my @new_i = @i;
  	my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
  
  	while (@new_i > @vals) {
  	    splice @new, pop @new_i, 2;
  	}
  	if (@vals > @new_i) {
  	    my $i = @new_i ? $new_i[-1] + 2 : @new;
  	    my @splice = splice @vals, @new_i, @vals - @new_i;
  
  	    splice @new, $i, 0, map { $key => $_ } @splice;
  	}
  	if (@vals) {
  	    #print "SET $new_i[0]\n";
  	    @new[ map $_ + 1, @new_i ] = @vals;
  	}
  
  	$self->query_form(\@new);
      }
  
      return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef;
  }
  
  sub URI::_query::query_param_append {
      my $self = shift;
      my $key = shift;
      my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_;
      $self->query_form($self->query_form, $key => \@vals);  # XXX
      return;
  }
  
  sub URI::_query::query_param_delete {
      my $self = shift;
      my $key = shift;
      my @old = $self->query_form;
      my @vals;
  
      for (my $i = @old - 2; $i >= 0; $i -= 2) {
  	next if $old[$i] ne $key;
  	push(@vals, (splice(@old, $i, 2))[1]);
      }
      $self->query_form(\@old) if @vals;
      return wantarray ? reverse @vals : $vals[-1];
  }
  
  sub URI::_query::query_form_hash {
      my $self = shift;
      my @old = $self->query_form;
      if (@_) {
  	$self->query_form(@_ == 1 ? %{shift(@_)} : @_);
      }
      my %hash;
      while (my($k, $v) = splice(@old, 0, 2)) {
  	if (exists $hash{$k}) {
  	    for ($hash{$k}) {
  		$_ = [$_] unless ref($_) eq "ARRAY";
  		push(@$_, $v);
  	    }
  	}
  	else {
  	    $hash{$k} = $v;
  	}
      }
      return \%hash;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI::QueryParam - Additional query methods for URIs
  
  =head1 SYNOPSIS
  
    use URI;
    use URI::QueryParam;
  
    $u = URI->new("", "http");
    $u->query_param(foo => 1, 2, 3);
    print $u->query;    # prints foo=1&foo=2&foo=3
  
    for my $key ($u->query_param) {
        print "$key: ", join(", ", $u->query_param($key)), "\n";
    }
  
  =head1 DESCRIPTION
  
  Loading the C<URI::QueryParam> module adds some extra methods to
  URIs that support query methods.  These methods provide an alternative
  interface to the $u->query_form data.
  
  The query_param_* methods have deliberately been made identical to the
  interface of the corresponding C<CGI.pm> methods.
  
  The following additional methods are made available:
  
  =over
  
  =item @keys = $u->query_param
  
  =item @values = $u->query_param( $key )
  
  =item $first_value = $u->query_param( $key )
  
  =item $u->query_param( $key, $value,... )
  
  If $u->query_param is called with no arguments, it returns all the
  distinct parameter keys of the URI.  In a scalar context it returns the
  number of distinct keys.
  
  When a $key argument is given, the method returns the parameter values with the
  given key.  In a scalar context, only the first parameter value is
  returned.
  
  If additional arguments are given, they are used to update successive
  parameters with the given key.  If any of the values provided are
  array references, then the array is dereferenced to get the actual
  values.
  
  Please note that you can supply multiple values to this method, but you cannot
  supply multiple keys.
  
  Do this:
  
      $uri->query_param( widget_id => 1, 5, 9 );
  
  Do NOT do this:
  
      $uri->query_param( widget_id => 1, frobnicator_id => 99 );
  
  =item $u->query_param_append($key, $value,...)
  
  Adds new parameters with the given
  key without touching any old parameters with the same key.  It
  can be explained as a more efficient version of:
  
     $u->query_param($key,
                     $u->query_param($key),
                     $value,...);
  
  One difference is that this expression would return the old values
  of $key, whereas the query_param_append() method does not.
  
  =item @values = $u->query_param_delete($key)
  
  =item $first_value = $u->query_param_delete($key)
  
  Deletes all key/value pairs with the given key.
  The old values are returned.  In a scalar context, only the first value
  is returned.
  
  Using the query_param_delete() method is slightly more efficient than
  the equivalent:
  
     $u->query_param($key, []);
  
  =item $hashref = $u->query_form_hash
  
  =item $u->query_form_hash( \%new_form )
  
  Returns a reference to a hash that represents the
  query form's key/value pairs.  If a key occurs multiple times, then the hash
  value becomes an array reference.
  
  Note that sequence information is lost.  This means that:
  
     $u->query_form_hash($u->query_form_hash);
  
  is not necessarily a no-op, as it may reorder the key/value pairs.
  The values returned by the query_param() method should stay the same
  though.
  
  =back
  
  =head1 SEE ALSO
  
  L<URI>, L<CGI>
  
  =head1 COPYRIGHT
  
  Copyright 2002 Gisle Aas.
  
  =cut
URI_QUERYPARAM

$fatpacked{"URI/Split.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SPLIT';
  package URI::Split;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use Exporter 5.57 'import';
  our @EXPORT_OK = qw(uri_split uri_join);
  
  use URI::Escape ();
  
  sub uri_split {
       return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
  }
  
  sub uri_join {
      my($scheme, $auth, $path, $query, $frag) = @_;
      my $uri = defined($scheme) ? "$scheme:" : "";
      $path = "" unless defined $path;
      if (defined $auth) {
  	$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
  	$uri .= "//$auth";
  	$path = "/$path" if length($path) && $path !~ m,^/,;
      }
      elsif ($path =~ m,^//,) {
  	$uri .= "//";  # XXX force empty auth
      }
      unless (length $uri) {
  	$path =~ s,(:), URI::Escape::escape_char($1),e while $path =~ m,^[^:/?\#]+:,;
      }
      $path =~ s,([?\#]), URI::Escape::escape_char($1),eg;
      $uri .= $path;
      if (defined $query) {
  	$query =~ s,(\#), URI::Escape::escape_char($1),eg;
  	$uri .= "?$query";
      }
      $uri .= "#$frag" if defined $frag;
      $uri;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI::Split - Parse and compose URI strings
  
  =head1 SYNOPSIS
  
   use URI::Split qw(uri_split uri_join);
   ($scheme, $auth, $path, $query, $frag) = uri_split($uri);
   $uri = uri_join($scheme, $auth, $path, $query, $frag);
  
  =head1 DESCRIPTION
  
  Provides functions to parse and compose URI
  strings.  The following functions are provided:
  
  =over
  
  =item ($scheme, $auth, $path, $query, $frag) = uri_split($uri)
  
  Breaks up a URI string into its component
  parts.  An C<undef> value is returned for those parts that are not
  present.  The $path part is always present (but can be the empty
  string) and is thus never returned as C<undef>.
  
  No sensible value is returned if this function is called in a scalar
  context.
  
  =item $uri = uri_join($scheme, $auth, $path, $query, $frag)
  
  Puts together a URI string from its parts.
  Missing parts are signaled by passing C<undef> for the corresponding
  argument.
  
  Minimal escaping is applied to parts that contain reserved chars
  that would confuse a parser.  For instance, any occurrence of '?' or '#'
  in $path is always escaped, as it would otherwise be parsed back
  as a query or fragment.
  
  =back
  
  =head1 SEE ALSO
  
  L<URI>, L<URI::Escape>
  
  =head1 COPYRIGHT
  
  Copyright 2003, Gisle Aas
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
URI_SPLIT

$fatpacked{"URI/URL.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URL';
  package URI::URL;
  
  use strict;
  use warnings;
  
  use parent 'URI::WithBase';
  
  our $VERSION = "5.04";
  
  # Provide as much as possible of the old URI::URL interface for backwards
  # compatibility...
  
  use Exporter 5.57 'import';
  our @EXPORT = qw(url);
  
  # Easy to use constructor
  sub url ($;$) { URI::URL->new(@_); }
  
  use URI::Escape qw(uri_unescape);
  
  sub new
  {
      my $class = shift;
      my $self = $class->SUPER::new(@_);
      $self->[0] = $self->[0]->canonical;
      $self;
  }
  
  sub newlocal
  {
      my $class = shift;
      require URI::file;
      bless [URI::file->new_abs(shift)], $class;
  }
  
  {package URI::_foreign;
      sub _init  # hope it is not defined
      {
  	my $class = shift;
  	die "Unknown URI::URL scheme $_[1]:" if $URI::URL::STRICT;
  	$class->SUPER::_init(@_);
      }
  }
  
  sub strict
  {
      my $old = $URI::URL::STRICT;
      $URI::URL::STRICT = shift if @_;
      $old;
  }
  
  sub print_on
  {
      my $self = shift;
      require Data::Dumper;
      print STDERR Data::Dumper::Dumper($self);
  }
  
  sub _try
  {
      my $self = shift;
      my $method = shift;
      scalar(eval { $self->$method(@_) });
  }
  
  sub crack
  {
      # should be overridden by subclasses
      my $self = shift;
      (scalar($self->scheme),
       $self->_try("user"),
       $self->_try("password"),
       $self->_try("host"),
       $self->_try("port"),
       $self->_try("path"),
       $self->_try("params"),
       $self->_try("query"),
       scalar($self->fragment),
      )
  }
  
  sub full_path
  {
      my $self = shift;
      my $path = $self->path_query;
      $path = "/" unless length $path;
      $path;
  }
  
  sub netloc
  {
      shift->authority(@_);
  }
  
  sub epath
  {
      my $path = shift->SUPER::path(@_);
      $path =~ s/;.*//;
      $path;
  }
  
  sub eparams
  {
      my $self = shift;
      my @p = $self->path_segments;
      return undef unless ref($p[-1]);
      @p = @{$p[-1]};
      shift @p;
      join(";", @p);
  }
  
  sub params { shift->eparams(@_); }
  
  sub path {
      my $self = shift;
      my $old = $self->epath(@_);
      return unless defined wantarray;
      return '/' if !defined($old) || !length($old);
      Carp::croak("Path components contain '/' (you must call epath)")
  	if $old =~ /%2[fF]/ and !@_;
      $old = "/$old" if $old !~ m|^/| && defined $self->netloc;
      return uri_unescape($old);
  }
  
  sub path_components {
      shift->path_segments(@_);
  }
  
  sub query {
      my $self = shift;
      my $old = $self->equery(@_);
      if (defined(wantarray) && defined($old)) {
  	if ($old =~ /%(?:26|2[bB]|3[dD])/) {  # contains escaped '=' '&' or '+'
  	    my $mess;
  	    for ($old) {
  		$mess = "Query contains both '+' and '%2B'"
  		  if /\+/ && /%2[bB]/;
  		$mess = "Form query contains escaped '=' or '&'"
  		  if /=/  && /%(?:3[dD]|26)/;
  	    }
  	    if ($mess) {
  		Carp::croak("$mess (you must call equery)");
  	    }
  	}
  	# Now it should be safe to unescape the string without losing
  	# information
  	return uri_unescape($old);
      }
      undef;
  
  }
  
  sub abs
  {
      my $self = shift;
      my $base = shift;
      my $allow_scheme = shift;
      $allow_scheme = $URI::URL::ABS_ALLOW_RELATIVE_SCHEME
  	unless defined $allow_scheme;
      local $URI::ABS_ALLOW_RELATIVE_SCHEME = $allow_scheme;
      local $URI::ABS_REMOTE_LEADING_DOTS = $URI::URL::ABS_REMOTE_LEADING_DOTS;
      $self->SUPER::abs($base);
  }
  
  sub frag { shift->fragment(@_); }
  sub keywords { shift->query_keywords(@_); }
  
  # file:
  sub local_path { shift->file; }
  sub unix_path  { shift->file("unix"); }
  sub dos_path   { shift->file("dos");  }
  sub mac_path   { shift->file("mac");  }
  sub vms_path   { shift->file("vms");  }
  
  # mailto:
  sub address { shift->to(@_); }
  sub encoded822addr { shift->to(@_); }
  sub URI::mailto::authority { shift->to(@_); }  # make 'netloc' method work
  
  # news:
  sub groupart { shift->_group(@_); }
  sub article  { shift->message(@_); }
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI::URL - Uniform Resource Locators
  
  =head1 SYNOPSIS
  
   $u1 = URI::URL->new($str, $base);
   $u2 = $u1->abs;
  
  =head1 DESCRIPTION
  
  This module is provided for backwards compatibility with modules that
  depend on the interface provided by the C<URI::URL> class that used to
  be distributed with the libwww-perl library.
  
  The following differences exist compared to the C<URI> class interface:
  
  =over 3
  
  =item *
  
  The URI::URL module exports the url() function as an alternate
  constructor interface.
  
  =item *
  
  The constructor takes an optional $base argument.  The C<URI::URL>
  class is a subclass of C<URI::WithBase>.
  
  =item *
  
  The URI::URL->newlocal class method is the same as URI::file->new_abs.
  
  =item *
  
  URI::URL::strict(1)
  
  =item *
  
  $url->print_on method
  
  =item *
  
  $url->crack method
  
  =item *
  
  $url->full_path: same as ($uri->abs_path || "/")
  
  =item *
  
  $url->netloc: same as $uri->authority
  
  =item *
  
  $url->epath, $url->equery: same as $uri->path, $uri->query
  
  =item *
  
  $url->path and $url->query pass unescaped strings.
  
  =item *
  
  $url->path_components: same as $uri->path_segments (if you don't
  consider path segment parameters)
  
  =item *
  
  $url->params and $url->eparams methods
  
  =item *
  
  $url->base method.  See L<URI::WithBase>.
  
  =item *
  
  $url->abs and $url->rel have an optional $base argument.  See
  L<URI::WithBase>.
  
  =item *
  
  $url->frag: same as $uri->fragment
  
  =item *
  
  $url->keywords: same as $uri->query_keywords
  
  =item *
  
  $url->localpath and friends map to $uri->file.
  
  =item *
  
  $url->address and $url->encoded822addr: same as $uri->to for mailto URI
  
  =item *
  
  $url->groupart method for news URI
  
  =item *
  
  $url->article: same as $uri->message
  
  =back
  
  
  
  =head1 SEE ALSO
  
  L<URI>, L<URI::WithBase>
  
  =head1 COPYRIGHT
  
  Copyright 1998-2000 Gisle Aas.
  
  =cut
URI_URL

$fatpacked{"URI/WithBase.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_WITHBASE';
  package URI::WithBase;
  
  use strict;
  use warnings;
  
  use URI;
  use Scalar::Util 'blessed';
  
  our $VERSION = "2.20";
  
  use overload '""' => "as_string", fallback => 1;
  
  sub as_string;  # help overload find it
  
  sub new
  {
      my($class, $uri, $base) = @_;
      my $ibase = $base;
      if ($base && blessed($base) && $base->isa(__PACKAGE__)) {
  	$base = $base->abs;
  	$ibase = $base->[0];
      }
      bless [URI->new($uri, $ibase), $base], $class;
  }
  
  sub new_abs
  {
      my $class = shift;
      my $self = $class->new(@_);
      $self->abs;
  }
  
  sub _init
  {
      my $class = shift;
      my($str, $scheme) = @_;
      bless [URI->new($str, $scheme), undef], $class;
  }
  
  sub eq
  {
      my($self, $other) = @_;
      $other = $other->[0] if blessed($other) and $other->isa(__PACKAGE__);
      $self->[0]->eq($other);
  }
  
  our $AUTOLOAD;
  sub AUTOLOAD
  {
      my $self = shift;
      my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
      return if $method eq "DESTROY";
      $self->[0]->$method(@_);
  }
  
  sub can {                                  # override UNIVERSAL::can
      my $self = shift;
      $self->SUPER::can(@_) || (
        ref($self)
        ? $self->[0]->can(@_)
        : undef
      )
  }
  
  sub base {
      my $self = shift;
      my $base  = $self->[1];
  
      if (@_) { # set
  	my $new_base = shift;
  	# ensure absoluteness
  	$new_base = $new_base->abs if ref($new_base) && $new_base->isa(__PACKAGE__);
  	$self->[1] = $new_base;
      }
      return unless defined wantarray;
  
      # The base attribute supports 'lazy' conversion from URL strings
      # to URL objects. Strings may be stored but when a string is
      # fetched it will automatically be converted to a URL object.
      # The main benefit is to make it much cheaper to say:
      #   URI::WithBase->new($random_url_string, 'http:')
      if (defined($base) && !ref($base)) {
  	$base = ref($self)->new($base);
  	$self->[1] = $base unless @_;
      }
      $base;
  }
  
  sub clone
  {
      my $self = shift;
      my $base = $self->[1];
      $base = $base->clone if ref($base);
      bless [$self->[0]->clone, $base], ref($self);
  }
  
  sub abs
  {
      my $self = shift;
      my $base = shift || $self->base || return $self->clone;
      $base = $base->as_string if ref($base);
      bless [$self->[0]->abs($base, @_), $base], ref($self);
  }
  
  sub rel
  {
      my $self = shift;
      my $base = shift || $self->base || return $self->clone;
      $base = $base->as_string if ref($base);
      bless [$self->[0]->rel($base, @_), $base], ref($self);
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI::WithBase - URIs which remember their base
  
  =head1 SYNOPSIS
  
   $u1 = URI::WithBase->new($str, $base);
   $u2 = $u1->abs;
  
   $base = $u1->base;
   $u1->base( $new_base )
  
  =head1 DESCRIPTION
  
  This module provides the C<URI::WithBase> class.  Objects of this class
  are like C<URI> objects, but can keep their base too.  The base
  represents the context where this URI was found and can be used to
  absolutize or relativize the URI.  All the methods described in L<URI>
  are supported for C<URI::WithBase> objects.
  
  The methods provided in addition to or modified from those of C<URI> are:
  
  =over 4
  
  =item $uri = URI::WithBase->new($str, [$base])
  
  The constructor takes an optional base URI as the second argument.
  If provided, this argument initializes the base attribute.
  
  =item $uri->base( [$new_base] )
  
  Can be used to get or set the value of the base attribute.
  The return value, which is the old value, is a URI object or C<undef>.
  
  =item $uri->abs( [$base_uri] )
  
  The $base_uri argument is now made optional as the object carries its
  base with it.  A new object is returned even if $uri is already
  absolute (while plain URI objects simply return themselves in
  that case).
  
  =item $uri->rel( [$base_uri] )
  
  The $base_uri argument is now made optional as the object carries its
  base with it.  A new object is always returned.
  
  =back
  
  
  =head1 SEE ALSO
  
  L<URI>
  
  =head1 COPYRIGHT
  
  Copyright 1998-2002 Gisle Aas.
  
  =cut
URI_WITHBASE

$fatpacked{"URI/_foreign.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__FOREIGN';
  package URI::_foreign;
  
  use strict;
  use warnings;
  
  use parent 'URI::_generic';
  
  our $VERSION = '1.76';
  
  1;
URI__FOREIGN

$fatpacked{"URI/_generic.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__GENERIC';
  package URI::_generic;
  
  use strict;
  use warnings;
  
  use parent qw(URI URI::_query);
  
  use URI::Escape qw(uri_unescape);
  use Carp ();
  
  our $VERSION = '1.76';
  
  my $ACHAR = $URI::uric;  $ACHAR =~ s,\\[/?],,g;
  my $PCHAR = $URI::uric;  $PCHAR =~ s,\\[?],,g;
  
  sub _no_scheme_ok { 1 }
  
  sub authority
  {
      my $self = shift;
      $$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;
  
      if (@_) {
  	my $auth = shift;
  	$$self = $1;
  	my $rest = $3;
  	if (defined $auth) {
  	    $auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;
  	    utf8::downgrade($auth);
  	    $$self .= "//$auth";
  	}
  	_check_path($rest, $$self);
  	$$self .= $rest;
      }
      $2;
  }
  
  sub path
  {
      my $self = shift;
      $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;
  
      if (@_) {
  	$$self = $1;
  	my $rest = $3;
  	my $new_path = shift;
  	$new_path = "" unless defined $new_path;
  	$new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;
  	utf8::downgrade($new_path);
  	_check_path($new_path, $$self);
  	$$self .= $new_path . $rest;
      }
      $2;
  }
  
  sub path_query
  {
      my $self = shift;
      $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;
  
      if (@_) {
  	$$self = $1;
  	my $rest = $3;
  	my $new_path = shift;
  	$new_path = "" unless defined $new_path;
  	$new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
  	utf8::downgrade($new_path);
  	_check_path($new_path, $$self);
  	$$self .= $new_path . $rest;
      }
      $2;
  }
  
  sub _check_path
  {
      my($path, $pre) = @_;
      my $prefix;
      if ($pre =~ m,/,) {  # authority present
  	$prefix = "/" if length($path) && $path !~ m,^[/?\#],;
      }
      else {
  	if ($path =~ m,^//,) {
  	    Carp::carp("Path starting with double slash is confusing")
  		if $^W;
  	}
  	elsif (!length($pre) && $path =~ m,^[^:/?\#]+:,) {
  	    Carp::carp("Path might look like scheme, './' prepended")
  		if $^W;
  	    $prefix = "./";
  	}
      }
      substr($_[0], 0, 0) = $prefix if defined $prefix;
  }
  
  sub path_segments
  {
      my $self = shift;
      my $path = $self->path;
      if (@_) {
  	my @arg = @_;  # make a copy
  	for (@arg) {
  	    if (ref($_)) {
  		my @seg = @$_;
  		$seg[0] =~ s/%/%25/g;
  		for (@seg) { s/;/%3B/g; }
  		$_ = join(";", @seg);
  	    }
  	    else {
  		 s/%/%25/g; s/;/%3B/g;
  	    }
  	    s,/,%2F,g;
  	}
  	$self->path(join("/", @arg));
      }
      return $path unless wantarray;
      map {/;/ ? $self->_split_segment($_)
               : uri_unescape($_) }
          split('/', $path, -1);
  }
  
  
  sub _split_segment
  {
      my $self = shift;
      require URI::_segment;
      URI::_segment->new(@_);
  }
  
  
  sub abs
  {
      my $self = shift;
      my $base = shift || Carp::croak("Missing base argument");
  
      if (my $scheme = $self->scheme) {
  	return $self unless $URI::ABS_ALLOW_RELATIVE_SCHEME;
  	$base = URI->new($base) unless ref $base;
  	return $self unless $scheme eq $base->scheme;
      }
  
      $base = URI->new($base) unless ref $base;
      my $abs = $self->clone;
      $abs->scheme($base->scheme);
      return $abs if $$self =~ m,^(?:$URI::scheme_re:)?//,o;
      $abs->authority($base->authority);
  
      my $path = $self->path;
      return $abs if $path =~ m,^/,;
  
      if (!length($path)) {
  	my $abs = $base->clone;
  	my $query = $self->query;
  	$abs->query($query) if defined $query;
  	my $fragment = $self->fragment;
  	$abs->fragment($fragment) if defined $fragment;
  	return $abs;
      }
  
      my $p = $base->path;
      $p =~ s,[^/]+$,,;
      $p .= $path;
      my @p = split('/', $p, -1);
      shift(@p) if @p && !length($p[0]);
      my $i = 1;
      while ($i < @p) {
  	#print "$i ", join("/", @p), " ($p[$i])\n";
  	if ($p[$i-1] eq ".") {
  	    splice(@p, $i-1, 1);
  	    $i-- if $i > 1;
  	}
  	elsif ($p[$i] eq ".." && $p[$i-1] ne "..") {
  	    splice(@p, $i-1, 2);
  	    if ($i > 1) {
  		$i--;
  		push(@p, "") if $i == @p;
  	    }
  	}
  	else {
  	    $i++;
  	}
      }
      $p[-1] = "" if @p && $p[-1] eq ".";  # trailing "/."
      if ($URI::ABS_REMOTE_LEADING_DOTS) {
          shift @p while @p && $p[0] =~ /^\.\.?$/;
      }
      $abs->path("/" . join("/", @p));
      $abs;
  }
  
  # The opposite of $url->abs.  Return a URI which is as relative as possible
  sub rel {
      my $self = shift;
      my $base = shift || Carp::croak("Missing base argument");
      my $rel = $self->clone;
      $base = URI->new($base) unless ref $base;
  
      #my($scheme, $auth, $path) = @{$rel}{qw(scheme authority path)};
      my $scheme = $rel->scheme;
      my $auth   = $rel->canonical->authority;
      my $path   = $rel->path;
  
      if (!defined($scheme) && !defined($auth)) {
  	# it is already relative
  	return $rel;
      }
  
      #my($bscheme, $bauth, $bpath) = @{$base}{qw(scheme authority path)};
      my $bscheme = $base->scheme;
      my $bauth   = $base->canonical->authority;
      my $bpath   = $base->path;
  
      for ($bscheme, $bauth, $auth) {
  	$_ = '' unless defined
      }
  
      unless ($scheme eq $bscheme && $auth eq $bauth) {
  	# different location, can't make it relative
  	return $rel;
      }
  
      for ($path, $bpath) {  $_ = "/$_" unless m,^/,; }
  
      # Make it relative by eliminating scheme and authority
      $rel->scheme(undef);
      $rel->authority(undef);
  
      # This loop is based on code from Nicolai Langfeldt <janl@ifi.uio.no>.
      # First we calculate common initial path components length ($li).
      my $li = 1;
      while (1) {
  	my $i = index($path, '/', $li);
  	last if $i < 0 ||
                  $i != index($bpath, '/', $li) ||
  	        substr($path,$li,$i-$li) ne substr($bpath,$li,$i-$li);
  	$li=$i+1;
      }
      # then we nuke it from both paths
      substr($path, 0,$li) = '';
      substr($bpath,0,$li) = '';
  
      if ($path eq $bpath &&
          defined($rel->fragment) &&
          !defined($rel->query)) {
          $rel->path("");
      }
      else {
          # Add one "../" for each path component left in the base path
          $path = ('../' x $bpath =~ tr|/|/|) . $path;
  	$path = "./" if $path eq "";
          $rel->path($path);
      }
  
      $rel;
  }
  
  1;
URI__GENERIC

$fatpacked{"URI/_idna.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__IDNA';
  package URI::_idna;
  
  # This module implements the RFCs 3490 (IDNA) and 3491 (Nameprep)
  # based on Python-2.6.4/Lib/encodings/idna.py
  
  use strict;
  use warnings;
  
  use URI::_punycode qw(encode_punycode decode_punycode);
  use Carp qw(croak);
  
  our $VERSION = '1.76';
  
  BEGIN {
    *URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS = "$]" < 5.008_003
      ? sub () { 1 }
      : sub () { 0 }
    ;
  }
  
  my $ASCII = qr/^[\x00-\x7F]*\z/;
  
  sub encode {
      my $idomain = shift;
      my @labels = split(/\./, $idomain, -1);
      my @last_empty;
      push(@last_empty, pop @labels) if @labels > 1 && $labels[-1] eq "";
      for (@labels) {
  	$_ = ToASCII($_);
      }
  
      return eval 'join(".", @labels, @last_empty)' if URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS;
      return join(".", @labels, @last_empty);
  }
  
  sub decode {
      my $domain = shift;
      return join(".", map ToUnicode($_), split(/\./, $domain, -1))
  }
  
  sub nameprep { # XXX real implementation missing
      my $label = shift;
      $label = lc($label);
      return $label;
  }
  
  sub check_size {
      my $label = shift;
      croak "Label empty" if $label eq "";
      croak "Label too long" if length($label) > 63;
      return $label;
  }
  
  sub ToASCII {
      my $label = shift;
      return check_size($label) if $label =~ $ASCII;
  
      # Step 2: nameprep
      $label = nameprep($label);
      # Step 3: UseSTD3ASCIIRules is false
      # Step 4: try ASCII again
      return check_size($label) if $label =~ $ASCII;
  
      # Step 5: Check ACE prefix
      if ($label =~ /^xn--/) {
          croak "Label starts with ACE prefix";
      }
  
      # Step 6: Encode with PUNYCODE
      $label = encode_punycode($label);
  
      # Step 7: Prepend ACE prefix
      $label = "xn--$label";
  
      # Step 8: Check size
      return check_size($label);
  }
  
  sub ToUnicode {
      my $label = shift;
      $label = nameprep($label) unless $label =~ $ASCII;
      return $label unless $label =~ /^xn--/;
      my $result = decode_punycode(substr($label, 4));
      my $label2 = ToASCII($result);
      if (lc($label) ne $label2) {
  	croak "IDNA does not round-trip: '\L$label\E' vs '$label2'";
      }
      return $result;
  }
  
  1;
URI__IDNA

$fatpacked{"URI/_ldap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__LDAP';
  # Copyright (c) 1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
  # This program is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  
  package URI::_ldap;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use URI::Escape qw(uri_unescape);
  
  sub _ldap_elem {
    my $self  = shift;
    my $elem  = shift;
    my $query = $self->query;
    my @bits  = (split(/\?/,defined($query) ? $query : ""),("")x4);
    my $old   = $bits[$elem];
  
    if (@_) {
      my $new = shift;
      $new =~ s/\?/%3F/g;
      $bits[$elem] = $new;
      $query = join("?",@bits);
      $query =~ s/\?+$//;
      $query = undef unless length($query);
      $self->query($query);
    }
  
    $old;
  }
  
  sub dn {
    my $old = shift->path(@_);
    $old =~ s:^/::;
    uri_unescape($old);
  }
  
  sub attributes {
    my $self = shift;
    my $old = _ldap_elem($self,0, @_ ? join(",", map { my $tmp = $_; $tmp =~ s/,/%2C/g; $tmp } @_) : ());
    return $old unless wantarray;
    map { uri_unescape($_) } split(/,/,$old);
  }
  
  sub _scope {
    my $self = shift;
    my $old = _ldap_elem($self,1, @_);
    return undef unless defined wantarray && defined $old;
    uri_unescape($old);
  }
  
  sub scope {
    my $old = &_scope;
    $old = "base" unless length $old;
    $old;
  }
  
  sub _filter {
    my $self = shift;
    my $old = _ldap_elem($self,2, @_);
    return undef unless defined wantarray && defined $old;
    uri_unescape($old); # || "(objectClass=*)";
  }
  
  sub filter {
    my $old = &_filter;
    $old = "(objectClass=*)" unless length $old;
    $old;
  }
  
  sub extensions {
    my $self = shift;
    my @ext;
    while (@_) {
      my $key = shift;
      my $value = shift;
      push(@ext, join("=", map { $_="" unless defined; s/,/%2C/g; $_ } $key, $value));
    }
    @ext = join(",", @ext) if @ext;
    my $old = _ldap_elem($self,3, @ext);
    return $old unless wantarray;
    map { uri_unescape($_) } map { /^([^=]+)=(.*)$/ } split(/,/,$old);
  }
  
  sub canonical
  {
      my $self = shift;
      my $other = $self->_nonldap_canonical;
  
      # The stuff below is not as efficient as one might hope...
  
      $other = $other->clone if $other == $self;
  
      $other->dn(_normalize_dn($other->dn));
  
      # Should really know about mixed case "postalAddress", etc...
      $other->attributes(map lc, $other->attributes);
  
      # Lowercase scope, remove default
      my $old_scope = $other->scope;
      my $new_scope = lc($old_scope);
      $new_scope = "" if $new_scope eq "base";
      $other->scope($new_scope) if $new_scope ne $old_scope;
  
      # Remove filter if default
      my $old_filter = $other->filter;
      $other->filter("") if lc($old_filter) eq "(objectclass=*)" ||
  	                  lc($old_filter) eq "objectclass=*";
  
      # Lowercase extensions types and deal with known extension values
      my @ext = $other->extensions;
      for (my $i = 0; $i < @ext; $i += 2) {
  	my $etype = $ext[$i] = lc($ext[$i]);
  	if ($etype =~ /^!?bindname$/) {
  	    $ext[$i+1] = _normalize_dn($ext[$i+1]);
  	}
      }
      $other->extensions(@ext) if @ext;
      
      $other;
  }
  
  sub _normalize_dn  # RFC 2253
  {
      my $dn = shift;
  
      return $dn;
      # The code below will fail if the "+" or "," is embedding in a quoted
      # string or simply escaped...
  
      my @dn = split(/([+,])/, $dn);
      for (@dn) {
  	s/^([a-zA-Z]+=)/lc($1)/e;
      }
      join("", @dn);
  }
  
  1;
URI__LDAP

$fatpacked{"URI/_login.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__LOGIN';
  package URI::_login;
  
  use strict;
  use warnings;
  
  use parent qw(URI::_server URI::_userpass);
  
  our $VERSION = '1.76';
  
  # Generic terminal logins.  This is used as a base class for 'telnet',
  # 'tn3270', and 'rlogin' URL schemes.
  
  1;
URI__LOGIN

$fatpacked{"URI/_punycode.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__PUNYCODE';
  package URI::_punycode;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use Exporter 'import';
  our @EXPORT = qw(encode_punycode decode_punycode);
  
  use integer;
  
  our $DEBUG = 0;
  
  use constant BASE => 36;
  use constant TMIN => 1;
  use constant TMAX => 26;
  use constant SKEW => 38;
  use constant DAMP => 700;
  use constant INITIAL_BIAS => 72;
  use constant INITIAL_N => 128;
  
  my $Delimiter = chr 0x2D;
  my $BasicRE   = qr/[\x00-\x7f]/;
  
  sub _croak { require Carp; Carp::croak(@_); }
  
  sub digit_value {
      my $code = shift;
      return ord($code) - ord("A") if $code =~ /[A-Z]/;
      return ord($code) - ord("a") if $code =~ /[a-z]/;
      return ord($code) - ord("0") + 26 if $code =~ /[0-9]/;
      return;
  }
  
  sub code_point {
      my $digit = shift;
      return $digit + ord('a') if 0 <= $digit && $digit <= 25;
      return $digit + ord('0') - 26 if 26 <= $digit && $digit <= 36;
      die 'NOT COME HERE';
  }
  
  sub adapt {
      my($delta, $numpoints, $firsttime) = @_;
      $delta = $firsttime ? $delta / DAMP : $delta / 2;
      $delta += $delta / $numpoints;
      my $k = 0;
      while ($delta > ((BASE - TMIN) * TMAX) / 2) {
  	$delta /= BASE - TMIN;
  	$k += BASE;
      }
      return $k + (((BASE - TMIN + 1) * $delta) / ($delta + SKEW));
  }
  
  sub decode_punycode {
      my $code = shift;
  
      my $n      = INITIAL_N;
      my $i      = 0;
      my $bias   = INITIAL_BIAS;
      my @output;
  
      if ($code =~ s/(.*)$Delimiter//o) {
  	push @output, map ord, split //, $1;
  	return _croak('non-basic code point') unless $1 =~ /^$BasicRE*$/o;
      }
  
      while ($code) {
  	my $oldi = $i;
  	my $w    = 1;
      LOOP:
  	for (my $k = BASE; 1; $k += BASE) {
  	    my $cp = substr($code, 0, 1, '');
  	    my $digit = digit_value($cp);
  	    defined $digit or return _croak("invalid punycode input");
  	    $i += $digit * $w;
  	    my $t = ($k <= $bias) ? TMIN
  		: ($k >= $bias + TMAX) ? TMAX : $k - $bias;
  	    last LOOP if $digit < $t;
  	    $w *= (BASE - $t);
  	}
  	$bias = adapt($i - $oldi, @output + 1, $oldi == 0);
  	warn "bias becomes $bias" if $DEBUG;
  	$n += $i / (@output + 1);
  	$i = $i % (@output + 1);
  	splice(@output, $i, 0, $n);
  	warn join " ", map sprintf('%04x', $_), @output if $DEBUG;
  	$i++;
      }
      return join '', map chr, @output;
  }
  
  sub encode_punycode {
      my $input = shift;
      my @input = split //, $input;
  
      my $n     = INITIAL_N;
      my $delta = 0;
      my $bias  = INITIAL_BIAS;
  
      my @output;
      my @basic = grep /$BasicRE/, @input;
      my $h = my $b = @basic;
      push @output, @basic;
      push @output, $Delimiter if $b && $h < @input;
      warn "basic codepoints: (@output)" if $DEBUG;
  
      while ($h < @input) {
  	my $m = min(grep { $_ >= $n } map ord, @input);
  	warn sprintf "next code point to insert is %04x", $m if $DEBUG;
  	$delta += ($m - $n) * ($h + 1);
  	$n = $m;
  	for my $i (@input) {
  	    my $c = ord($i);
  	    $delta++ if $c < $n;
  	    if ($c == $n) {
  		my $q = $delta;
  	    LOOP:
  		for (my $k = BASE; 1; $k += BASE) {
  		    my $t = ($k <= $bias) ? TMIN :
  			($k >= $bias + TMAX) ? TMAX : $k - $bias;
  		    last LOOP if $q < $t;
  		    my $cp = code_point($t + (($q - $t) % (BASE - $t)));
  		    push @output, chr($cp);
  		    $q = ($q - $t) / (BASE - $t);
  		}
  		push @output, chr(code_point($q));
  		$bias = adapt($delta, $h + 1, $h == $b);
  		warn "bias becomes $bias" if $DEBUG;
  		$delta = 0;
  		$h++;
  	    }
  	}
  	$delta++;
  	$n++;
      }
      return join '', @output;
  }
  
  sub min {
      my $min = shift;
      for (@_) { $min = $_ if $_ <= $min }
      return $min;
  }
  
  1;
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  URI::_punycode - encodes Unicode string in Punycode
  
  =head1 SYNOPSIS
  
    use strict;
    use warnings;
    use utf8;
  
    use URI::_punycode qw(encode_punycode decode_punycode);
  
    # encode a unicode string
    my $punycode = encode_punycode('http://☃.net'); # http://.net-xc8g
    $punycode = encode_punycode('bücher'); # bcher-kva
    $punycode = encode_punycode('他们为什么不说中文'); # ihqwcrb4cv8a8dqg056pqjye
  
    # decode a punycode string back into a unicode string
    my $unicode = decode_punycode('http://.net-xc8g'); # http://☃.net
    $unicode = decode_punycode('bcher-kva'); # bücher
    $unicode = decode_punycode('ihqwcrb4cv8a8dqg056pqjye'); # 他们为什么不说中文
  
  =head1 DESCRIPTION
  
  L<URI::_punycode> is a module to encode / decode Unicode strings into
  L<Punycode|https://tools.ietf.org/html/rfc3492>, an efficient
  encoding of Unicode for use with L<IDNA|https://tools.ietf.org/html/rfc5890>.
  
  =head1 FUNCTIONS
  
  All functions throw exceptions on failure. You can C<catch> them with
  L<Syntax::Keyword::Try> or L<Try::Tiny>. The following functions are exported
  by default.
  
  =head2 encode_punycode
  
    my $punycode = encode_punycode('http://☃.net');  # http://.net-xc8g
    $punycode = encode_punycode('bücher'); # bcher-kva
    $punycode = encode_punycode('他们为什么不说中文') # ihqwcrb4cv8a8dqg056pqjye
  
  Takes a Unicode string (UTF8-flagged variable) and returns a Punycode
  encoding for it.
  
  =head2 decode_punycode
  
    my $unicode = decode_punycode('http://.net-xc8g'); # http://☃.net
    $unicode = decode_punycode('bcher-kva'); # bücher
    $unicode = decode_punycode('ihqwcrb4cv8a8dqg056pqjye'); # 他们为什么不说中文
  
  Takes a Punycode encoding and returns original Unicode string.
  
  =head1 AUTHOR
  
  Tatsuhiko Miyagawa <F<miyagawa@bulknews.net>> is the author of
  L<IDNA::Punycode> which was the basis for this module.
  
  =head1 SEE ALSO
  
  L<IDNA::Punycode>, L<RFC 3492|https://tools.ietf.org/html/rfc3492>,
  L<RFC 5891|https://tools.ietf.org/html/rfc5891>
  
  =head1 COPYRIGHT AND LICENSE
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
URI__PUNYCODE

$fatpacked{"URI/_query.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__QUERY';
  package URI::_query;
  
  use strict;
  use warnings;
  
  use URI ();
  use URI::Escape qw(uri_unescape);
  
  our $VERSION = '1.76';
  
  sub query
  {
      my $self = shift;
      $$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die;
  
      if (@_) {
  	my $q = shift;
  	$$self = $1;
  	if (defined $q) {
  	    $q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
  	    utf8::downgrade($q);
  	    $$self .= "?$q";
  	}
  	$$self .= $3;
      }
      $2;
  }
  
  # Handle ...?foo=bar&bar=foo type of query
  sub query_form {
      my $self = shift;
      my $old = $self->query;
      if (@_) {
          # Try to set query string
          my $delim;
          my $r = $_[0];
          if (ref($r) eq "ARRAY") {
              $delim = $_[1];
              @_ = @$r;
          }
          elsif (ref($r) eq "HASH") {
              $delim = $_[1];
              @_ = map { $_ => $r->{$_} } sort keys %$r;
          }
          $delim = pop if @_ % 2;
  
          my @query;
          while (my($key,$vals) = splice(@_, 0, 2)) {
              $key = '' unless defined $key;
  	    $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
  	    $key =~ s/ /+/g;
  	    $vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
              for my $val (@$vals) {
                  $val = '' unless defined $val;
  		$val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
                  $val =~ s/ /+/g;
                  push(@query, "$key=$val");
              }
          }
          if (@query) {
              unless ($delim) {
                  $delim = $1 if $old && $old =~ /([&;])/;
                  $delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&";
              }
              $self->query(join($delim, @query));
          }
          else {
              $self->query(undef);
          }
      }
      return if !defined($old) || !length($old) || !defined(wantarray);
      return unless $old =~ /=/; # not a form
      map { s/\+/ /g; uri_unescape($_) }
           map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
  }
  
  # Handle ...?dog+bones type of query
  sub query_keywords
  {
      my $self = shift;
      my $old = $self->query;
      if (@_) {
          # Try to set query string
  	my @copy = @_;
  	@copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY";
  	for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; }
  	$self->query(@copy ? join('+', @copy) : undef);
      }
      return if !defined($old) || !defined(wantarray);
      return if $old =~ /=/;  # not keywords, but a form
      map { uri_unescape($_) } split(/\+/, $old, -1);
  }
  
  # Some URI::URL compatibility stuff
  sub equery { goto &query }
  
  1;
URI__QUERY

$fatpacked{"URI/_segment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__SEGMENT';
  package URI::_segment;
  
  # Represents a generic path_segment so that it can be treated as
  # a string too.
  
  use strict;
  use warnings;
  
  use URI::Escape qw(uri_unescape);
  
  use overload '""' => sub { $_[0]->[0] },
               fallback => 1;
  
  our $VERSION = '1.76';
  
  sub new
  {
      my $class = shift;
      my @segment = split(';', shift, -1);
      $segment[0] = uri_unescape($segment[0]);
      bless \@segment, $class;
  }
  
  1;
URI__SEGMENT

$fatpacked{"URI/_server.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__SERVER';
  package URI::_server;
  
  use strict;
  use warnings;
  
  use parent 'URI::_generic';
  
  use URI::Escape qw(uri_unescape);
  
  our $VERSION = '1.76';
  
  sub _uric_escape {
      my($class, $str) = @_;
      if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
  	my($scheme, $host, $rest) = ($1, $2, $3);
  	my $ui = $host =~ s/(.*@)// ? $1 : "";
  	my $port = $host =~ s/(:\d+)\z// ? $1 : "";
  	if (_host_escape($host)) {
  	    $str = "$scheme//$ui$host$port$rest";
  	}
      }
      return $class->SUPER::_uric_escape($str);
  }
  
  sub _host_escape {
      return unless $_[0] =~ /[^$URI::uric]/;
      eval {
  	require URI::_idna;
  	$_[0] = URI::_idna::encode($_[0]);
      };
      return 0 if $@;
      return 1;
  }
  
  sub as_iri {
      my $self = shift;
      my $str = $self->SUPER::as_iri;
      if ($str =~ /\bxn--/) {
  	if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
  	    my($scheme, $host, $rest) = ($1, $2, $3);
  	    my $ui = $host =~ s/(.*@)// ? $1 : "";
  	    my $port = $host =~ s/(:\d+)\z// ? $1 : "";
  	    require URI::_idna;
  	    $host = URI::_idna::decode($host);
  	    $str = "$scheme//$ui$host$port$rest";
  	}
      }
      return $str;
  }
  
  sub userinfo
  {
      my $self = shift;
      my $old = $self->authority;
  
      if (@_) {
  	my $new = $old;
  	$new = "" unless defined $new;
  	$new =~ s/.*@//;  # remove old stuff
  	my $ui = shift;
  	if (defined $ui) {
  	    $ui =~ s/@/%40/g;   # protect @
  	    $new = "$ui\@$new";
  	}
  	$self->authority($new);
      }
      return undef if !defined($old) || $old !~ /(.*)@/;
      return $1;
  }
  
  sub host
  {
      my $self = shift;
      my $old = $self->authority;
      if (@_) {
  	my $tmp = $old;
  	$tmp = "" unless defined $tmp;
  	my $ui = ($tmp =~ /(.*@)/) ? $1 : "";
  	my $port = ($tmp =~ /(:\d+)$/) ? $1 : "";
  	my $new = shift;
  	$new = "" unless defined $new;
  	if (length $new) {
  	    $new =~ s/[@]/%40/g;   # protect @
  	    if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/) {
  		$new =~ s/(:\d*)\z// || die "Assert";
  		$port = $1;
  	    }
  	    $new = "[$new]" if $new =~ /:/ && $new !~ /^\[/; # IPv6 address
  	    _host_escape($new);
  	}
  	$self->authority("$ui$new$port");
      }
      return undef unless defined $old;
      $old =~ s/.*@//;
      $old =~ s/:\d+$//;          # remove the port
      $old =~ s{^\[(.*)\]$}{$1};  # remove brackets around IPv6 (RFC 3986 3.2.2)
      return uri_unescape($old);
  }
  
  sub ihost
  {
      my $self = shift;
      my $old = $self->host(@_);
      if ($old =~ /(^|\.)xn--/) {
  	require URI::_idna;
  	$old = URI::_idna::decode($old);
      }
      return $old;
  }
  
  sub _port
  {
      my $self = shift;
      my $old = $self->authority;
      if (@_) {
  	my $new = $old;
  	$new =~ s/:\d*$//;
  	my $port = shift;
  	$new .= ":$port" if defined $port;
  	$self->authority($new);
      }
      return $1 if defined($old) && $old =~ /:(\d*)$/;
      return;
  }
  
  sub port
  {
      my $self = shift;
      my $port = $self->_port(@_);
      $port = $self->default_port if !defined($port) || $port eq "";
      $port;
  }
  
  sub host_port
  {
      my $self = shift;
      my $old = $self->authority;
      $self->host(shift) if @_;
      return undef unless defined $old;
      $old =~ s/.*@//;        # zap userinfo
      $old =~ s/:$//;         # empty port should be treated the same a no port
      $old .= ":" . $self->port unless $old =~ /:\d+$/;
      $old;
  }
  
  
  sub default_port { undef }
  
  sub canonical
  {
      my $self = shift;
      my $other = $self->SUPER::canonical;
      my $host = $other->host || "";
      my $port = $other->_port;
      my $uc_host = $host =~ /[A-Z]/;
      my $def_port = defined($port) && ($port eq "" ||
                                        $port == $self->default_port);
      if ($uc_host || $def_port) {
  	$other = $other->clone if $other == $self;
  	$other->host(lc $host) if $uc_host;
  	$other->port(undef)    if $def_port;
      }
      $other;
  }
  
  1;
URI__SERVER

$fatpacked{"URI/_userpass.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__USERPASS';
  package URI::_userpass;
  
  use strict;
  use warnings;
  
  use URI::Escape qw(uri_unescape);
  
  our $VERSION = '1.76';
  
  sub user
  {
      my $self = shift;
      my $info = $self->userinfo;
      if (@_) {
  	my $new = shift;
  	my $pass = defined($info) ? $info : "";
  	$pass =~ s/^[^:]*//;
  
  	if (!defined($new) && !length($pass)) {
  	    $self->userinfo(undef);
  	} else {
  	    $new = "" unless defined($new);
  	    $new =~ s/%/%25/g;
  	    $new =~ s/:/%3A/g;
  	    $self->userinfo("$new$pass");
  	}
      }
      return undef unless defined $info;
      $info =~ s/:.*//;
      uri_unescape($info);
  }
  
  sub password
  {
      my $self = shift;
      my $info = $self->userinfo;
      if (@_) {
  	my $new = shift;
  	my $user = defined($info) ? $info : "";
  	$user =~ s/:.*//;
  
  	if (!defined($new) && !length($user)) {
  	    $self->userinfo(undef);
  	} else {
  	    $new = "" unless defined($new);
  	    $new =~ s/%/%25/g;
  	    $self->userinfo("$user:$new");
  	}
      }
      return undef unless defined $info;
      return undef unless $info =~ s/^[^:]*://;
      uri_unescape($info);
  }
  
  1;
URI__USERPASS

$fatpacked{"URI/data.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_DATA';
  package URI::data;  # RFC 2397
  
  use strict;
  use warnings;
  
  use parent 'URI';
  
  our $VERSION = '1.76';
  
  use MIME::Base64 qw(encode_base64 decode_base64);
  use URI::Escape  qw(uri_unescape);
  
  sub media_type
  {
      my $self = shift;
      my $opaque = $self->opaque;
      $opaque =~ /^([^,]*),?/ or die;
      my $old = $1;
      my $base64;
      $base64 = $1 if $old =~ s/(;base64)$//i;
      if (@_) {
  	my $new = shift;
  	$new = "" unless defined $new;
  	$new =~ s/%/%25/g;
  	$new =~ s/,/%2C/g;
  	$base64 = "" unless defined $base64;
  	$opaque =~ s/^[^,]*,?/$new$base64,/;
  	$self->opaque($opaque);
      }
      return uri_unescape($old) if $old;  # media_type can't really be "0"
      "text/plain;charset=US-ASCII";      # default type
  }
  
  sub data
  {
      my $self = shift;
      my($enc, $data) = split(",", $self->opaque, 2);
      unless (defined $data) {
  	$data = "";
  	$enc  = "" unless defined $enc;
      }
      my $base64 = ($enc =~ /;base64$/i);
      if (@_) {
  	$enc =~ s/;base64$//i if $base64;
  	my $new = shift;
  	$new = "" unless defined $new;
  	my $uric_count = _uric_count($new);
  	my $urienc_len = $uric_count + (length($new) - $uric_count) * 3;
  	my $base64_len = int((length($new)+2) / 3) * 4;
  	$base64_len += 7;  # because of ";base64" marker
  	if ($base64_len < $urienc_len || $_[0]) {
  	    $enc .= ";base64";
  	    $new = encode_base64($new, "");
  	} else {
  	    $new =~ s/%/%25/g;
  	}
  	$self->opaque("$enc,$new");
      }
      return unless defined wantarray;
      $data = uri_unescape($data);
      return $base64 ? decode_base64($data) : $data;
  }
  
  # I could not find a better way to interpolate the tr/// chars from
  # a variable.
  my $ENC = $URI::uric;
  $ENC =~ s/%//;
  
  eval <<EOT; die $@ if $@;
  sub _uric_count
  {
      \$_[0] =~ tr/$ENC//;
  }
  EOT
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI::data - URI that contains immediate data
  
  =head1 SYNOPSIS
  
   use URI;
  
   $u = URI->new("data:");
   $u->media_type("image/gif");
   $u->data(scalar(`cat camel.gif`));
   print "$u\n";
   open(XV, "|xv -") and print XV $u->data;
  
  =head1 DESCRIPTION
  
  The C<URI::data> class supports C<URI> objects belonging to the I<data>
  URI scheme.  The I<data> URI scheme is specified in RFC 2397.  It
  allows inclusion of small data items as "immediate" data, as if it had
  been included externally.  Examples:
  
    data:,Perl%20is%20good
  
    data:image/gif;base64,R0lGODdhIAAgAIAAAAAAAPj8+CwAAAAAI
      AAgAAAClYyPqcu9AJyCjtIKc5w5xP14xgeO2tlY3nWcajmZZdeJcG
      Kxrmimms1KMTa1Wg8UROx4MNUq1HrycMjHT9b6xKxaFLM6VRKzI+p
      KS9XtXpcbdun6uWVxJXA8pNPkdkkxhxc21LZHFOgD2KMoQXa2KMWI
      JtnE2KizVUkYJVZZ1nczBxXlFopZBtoJ2diXGdNUymmJdFMAADs=
  
  
  
  C<URI> objects belonging to the data scheme support the common methods
  (described in L<URI>) and the following two scheme-specific methods:
  
  =over 4
  
  =item $uri->media_type( [$new_media_type] )
  
  Can be used to get or set the media type specified in the
  URI.  If no media type is specified, then the default
  C<"text/plain;charset=US-ASCII"> is returned.
  
  =item $uri->data( [$new_data] )
  
  Can be used to get or set the data contained in the URI.
  The data is passed unescaped (in binary form).  The decision about
  whether to base64 encode the data in the URI is taken automatically,
  based on the encoding that produces the shorter URI string.
  
  =back
  
  =head1 SEE ALSO
  
  L<URI>
  
  =head1 COPYRIGHT
  
  Copyright 1995-1998 Gisle Aas.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
URI_DATA

$fatpacked{"URI/file.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE';
  package URI::file;
  
  use strict;
  use warnings;
  
  use parent 'URI::_generic';
  our $VERSION = "4.21";
  
  use URI::Escape qw(uri_unescape);
  
  our $DEFAULT_AUTHORITY = "";
  
  # Map from $^O values to implementation classes.  The Unix
  # class is the default.
  our %OS_CLASS = (
       os2     => "OS2",
       mac     => "Mac",
       MacOS   => "Mac",
       MSWin32 => "Win32",
       win32   => "Win32",
       msdos   => "FAT",
       dos     => "FAT",
       qnx     => "QNX",
  );
  
  sub os_class
  {
      my($OS) = shift || $^O;
  
      my $class = "URI::file::" . ($OS_CLASS{$OS} || "Unix");
      no strict 'refs';
      unless (%{"$class\::"}) {
  	eval "require $class";
  	die $@ if $@;
      }
      $class;
  }
  
  sub host { uri_unescape(shift->authority(@_)) }
  
  sub new
  {
      my($class, $path, $os) = @_;
      os_class($os)->new($path);
  }
  
  sub new_abs
  {
      my $class = shift;
      my $file = $class->new(@_);
      return $file->abs($class->cwd) unless $$file =~ /^file:/;
      $file;
  }
  
  sub cwd
  {
      my $class = shift;
      require Cwd;
      my $cwd = Cwd::cwd();
      $cwd = VMS::Filespec::unixpath($cwd) if $^O eq 'VMS';
      $cwd = $class->new($cwd);
      $cwd .= "/" unless substr($cwd, -1, 1) eq "/";
      $cwd;
  }
  
  sub canonical {
      my $self = shift;
      my $other = $self->SUPER::canonical;
  
      my $scheme = $other->scheme;
      my $auth = $other->authority;
      return $other if !defined($scheme) && !defined($auth);  # relative
  
      if (!defined($auth) ||
  	$auth eq "" ||
  	lc($auth) eq "localhost" ||
  	(defined($DEFAULT_AUTHORITY) && lc($auth) eq lc($DEFAULT_AUTHORITY))
         )
      {
  	# avoid cloning if $auth already match
  	if ((defined($auth) || defined($DEFAULT_AUTHORITY)) &&
  	    (!defined($auth) || !defined($DEFAULT_AUTHORITY) || $auth ne $DEFAULT_AUTHORITY)
  	   )
  	{
  	    $other = $other->clone if $self == $other;
  	    $other->authority($DEFAULT_AUTHORITY);
          }
      }
  
      $other;
  }
  
  sub file
  {
      my($self, $os) = @_;
      os_class($os)->file($self);
  }
  
  sub dir
  {
      my($self, $os) = @_;
      os_class($os)->dir($self);
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI::file - URI that maps to local file names
  
  =head1 SYNOPSIS
  
   use URI::file;
   
   $u1 = URI->new("file:/foo/bar");
   $u2 = URI->new("foo/bar", "file");
   
   $u3 = URI::file->new($path);
   $u4 = URI::file->new("c:\\windows\\", "win32");
   
   $u1->file;
   $u1->file("mac");
  
  =head1 DESCRIPTION
  
  The C<URI::file> class supports C<URI> objects belonging to the I<file>
  URI scheme.  This scheme allows us to map the conventional file names
  found on various computer systems to the URI name space.  An old
  specification of the I<file> URI scheme is found in RFC 1738.  Some
  older background information is also in RFC 1630. There are no newer
  specifications as far as I know.
  
  If you simply want to construct I<file> URI objects from URI strings,
  use the normal C<URI> constructor.  If you want to construct I<file>
  URI objects from the actual file names used by various systems, then
  use one of the following C<URI::file> constructors:
  
  =over 4
  
  =item $u = URI::file->new( $filename, [$os] )
  
  Maps a file name to the I<file:> URI name space, creates a URI object
  and returns it.  The $filename is interpreted as belonging to the
  indicated operating system ($os), which defaults to the value of the
  $^O variable.  The $filename can be either absolute or relative, and
  the corresponding type of URI object for $os is returned.
  
  =item $u = URI::file->new_abs( $filename, [$os] )
  
  Same as URI::file->new, but makes sure that the URI returned
  represents an absolute file name.  If the $filename argument is
  relative, then the name is resolved relative to the current directory,
  i.e. this constructor is really the same as:
  
    URI::file->new($filename)->abs(URI::file->cwd);
  
  =item $u = URI::file->cwd
  
  Returns a I<file> URI that represents the current working directory.
  See L<Cwd>.
  
  =back
  
  The following methods are supported for I<file> URI (in addition to
  the common and generic methods described in L<URI>):
  
  =over 4
  
  =item $u->file( [$os] )
  
  Returns a file name.  It maps from the URI name space
  to the file name space of the indicated operating system.
  
  It might return C<undef> if the name can not be represented in the
  indicated file system.
  
  =item $u->dir( [$os] )
  
  Some systems use a different form for names of directories than for plain
  files.  Use this method if you know you want to use the name for
  a directory.
  
  =back
  
  The C<URI::file> module can be used to map generic file names to names
  suitable for the current system.  As such, it can work as a nice
  replacement for the C<File::Spec> module.  For instance, the following
  code translates the UNIX-style file name F<Foo/Bar.pm> to a name
  suitable for the local system:
  
    $file = URI::file->new("Foo/Bar.pm", "unix")->file;
    die "Can't map filename Foo/Bar.pm for $^O" unless defined $file;
    open(FILE, $file) || die "Can't open '$file': $!";
    # do something with FILE
  
  =head1 MAPPING NOTES
  
  Most computer systems today have hierarchically organized file systems.
  Mapping the names used in these systems to the generic URI syntax
  allows us to work with relative file URIs that behave as they should
  when resolved using the generic algorithm for URIs (specified in RFC
  2396).  Mapping a file name to the generic URI syntax involves mapping
  the path separator character to "/" and encoding any reserved
  characters that appear in the path segments of the file name.  If
  path segments consisting of the strings "." or ".." have a
  different meaning than what is specified for generic URIs, then these
  must be encoded as well.
  
  If the file system has device, volume or drive specifications as
  the root of the name space, then it makes sense to map them to the
  authority field of the generic URI syntax.  This makes sure that
  relative URIs can not be resolved "above" them, i.e. generally how
  relative file names work in those systems.
  
  Another common use of the authority field is to encode the host on which
  this file name is valid.  The host name "localhost" is special and
  generally has the same meaning as a missing or empty authority
  field.  This use is in conflict with using it as a device
  specification, but can often be resolved for device specifications
  having characters not legal in plain host names.
  
  File name to URI mapping in normally not one-to-one.  There are
  usually many URIs that map to any given file name.  For instance, an
  authority of "localhost" maps the same as a URI with a missing or empty
  authority.
  
  Example 1: The Mac classic (Mac OS 9 and earlier) used ":" as path separator,
  but not in the same way as a generic URI. ":foo" was a relative name.  "foo:bar"
  was an absolute name.  Also, path segments could contain the "/" character as well
  as the literal "." or "..".  So the mapping looks like this:
  
    Mac classic           URI
    ----------            -------------------
    :foo:bar     <==>     foo/bar
    :            <==>     ./
    ::foo:bar    <==>     ../foo/bar
    :::          <==>     ../../
    foo:bar      <==>     file:/foo/bar
    foo:bar:     <==>     file:/foo/bar/
    ..           <==>     %2E%2E
    <undef>      <==      /
    foo/         <==      file:/foo%2F
    ./foo.txt    <==      file:/.%2Ffoo.txt
  
  Note that if you want a relative URL, you *must* begin the path with a :.  Any
  path that begins with [^:] is treated as absolute.
  
  Example 2: The UNIX file system is easy to map, as it uses the same path
  separator as URIs, has a single root, and segments of "." and ".."
  have the same meaning.  URIs that have the character "\0" or "/" as
  part of any path segment can not be turned into valid UNIX file names.
  
    UNIX                  URI
    ----------            ------------------
    foo/bar      <==>     foo/bar
    /foo/bar     <==>     file:/foo/bar
    /foo/bar     <==      file://localhost/foo/bar
    file:         ==>     ./file:
    <undef>      <==      file:/fo%00/bar
    /            <==>     file:/
  
  =cut
  
  
  RFC 1630
  
     [...]
  
     There is clearly a danger of confusion that a link made to a local
     file should be followed by someone on a different system, with
     unexpected and possibly harmful results.  Therefore, the convention
     is that even a "file" URL is provided with a host part.  This allows
     a client on another system to know that it cannot access the file
     system, or perhaps to use some other local mechanism to access the
     file.
  
     The special value "localhost" is used in the host field to indicate
     that the filename should really be used on whatever host one is.
     This for example allows links to be made to files which are
     distributed on many machines, or to "your unix local password file"
     subject of course to consistency across the users of the data.
  
     A void host field is equivalent to "localhost".
  
  =head1 CONFIGURATION VARIABLES
  
  The following configuration variables influence how the class and its
  methods behave:
  
  =over
  
  =item %URI::file::OS_CLASS
  
  This hash maps OS identifiers to implementation classes.  You might
  want to add or modify this if you want to plug in your own file
  handler class.  Normally the keys should match the $^O values in use.
  
  If there is no mapping then the "Unix" implementation is used.
  
  =item $URI::file::DEFAULT_AUTHORITY
  
  This determine what "authority" string to include in absolute file
  URIs.  It defaults to "".  If you prefer verbose URIs you might set it
  to be "localhost".
  
  Setting this value to C<undef> force behaviour compatible to URI v1.31
  and earlier.  In this mode host names in UNC paths and drive letters
  are mapped to the authority component on Windows, while we produce
  authority-less URIs on Unix.
  
  =back
  
  
  =head1 SEE ALSO
  
  L<URI>, L<File::Spec>, L<perlport>
  
  =head1 COPYRIGHT
  
  Copyright 1995-1998,2004 Gisle Aas.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
URI_FILE

$fatpacked{"URI/file/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_BASE';
  package URI::file::Base;
  
  use strict;
  use warnings;
  
  use URI::Escape qw();
  
  our $VERSION = '1.76';
  
  sub new
  {
      my $class = shift;
      my $path  = shift;
      $path = "" unless defined $path;
  
      my($auth, $escaped_auth, $escaped_path);
  
      ($auth, $escaped_auth) = $class->_file_extract_authority($path);
      ($path, $escaped_path) = $class->_file_extract_path($path);
  
      if (defined $auth) {
  	$auth =~ s,%,%25,g unless $escaped_auth;
  	$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
  	$auth = "//$auth";
  	if (defined $path) {
  	    $path = "/$path" unless substr($path, 0, 1) eq "/";
  	} else {
  	    $path = "";
  	}
      } else {
  	return undef unless defined $path;
  	$auth = "";
      }
  
      $path =~ s,([%;?]), URI::Escape::escape_char($1),eg unless $escaped_path;
      $path =~ s/\#/%23/g;
  
      my $uri = $auth . $path;
      $uri = "file:$uri" if substr($uri, 0, 1) eq "/";
  
      URI->new($uri, "file");
  }
  
  sub _file_extract_authority
  {
      my($class, $path) = @_;
      return undef unless $class->_file_is_absolute($path);
      return $URI::file::DEFAULT_AUTHORITY;
  }
  
  sub _file_extract_path
  {
      return undef;
  }
  
  sub _file_is_absolute
  {
      return 0;
  }
  
  sub _file_is_localhost
  {
      shift; # class
      my $host = lc(shift);
      return 1 if $host eq "localhost";
      eval {
  	require Net::Domain;
  	lc(Net::Domain::hostfqdn() || '') eq $host ||
  	lc(Net::Domain::hostname() || '') eq $host;
      };
  }
  
  sub file
  {
      undef;
  }
  
  sub dir
  {
      my $self = shift;
      $self->file(@_);
  }
  
  1;
URI_FILE_BASE

$fatpacked{"URI/file/FAT.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_FAT';
  package URI::file::FAT;
  
  use strict;
  use warnings;
  
  use parent 'URI::file::Win32';
  
  our $VERSION = '1.76';
  
  sub fix_path
  {
      shift; # class
      for (@_) {
  	# turn it into 8.3 names
  	my @p = map uc, split(/\./, $_, -1);
  	return if @p > 2;     # more than 1 dot is not allowed
  	@p = ("") unless @p;  # split bug? (returns nothing when splitting "")
  	$_ = substr($p[0], 0, 8);
          if (@p > 1) {
  	    my $ext = substr($p[1], 0, 3);
  	    $_ .= ".$ext" if length $ext;
  	}
      }
      1;  # ok
  }
  
  1;
URI_FILE_FAT

$fatpacked{"URI/file/Mac.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_MAC';
  package URI::file::Mac;
  
  use strict;
  use warnings;
  
  use parent 'URI::file::Base';
  
  use URI::Escape qw(uri_unescape);
  
  our $VERSION = '1.76';
  
  sub _file_extract_path
  {
      my $class = shift;
      my $path = shift;
  
      my @pre;
      if ($path =~ s/^(:+)//) {
  	if (length($1) == 1) {
  	    @pre = (".") unless length($path);
  	} else {
  	    @pre = ("..") x (length($1) - 1);
  	}
      } else { #absolute
  	$pre[0] = "";
      }
  
      my $isdir = ($path =~ s/:$//);
      $path =~ s,([%/;]), URI::Escape::escape_char($1),eg;
  
      my @path = split(/:/, $path, -1);
      for (@path) {
  	if ($_ eq "." || $_ eq "..") {
  	    $_ = "%2E" x length($_);
  	}
  	$_ = ".." unless length($_);
      }
      push (@path,"") if $isdir;
      (join("/", @pre, @path), 1);
  }
  
  
  sub file
  {
      my $class = shift;
      my $uri = shift;
      my @path;
  
      my $auth = $uri->authority;
      if (defined $auth) {
  	if (lc($auth) ne "localhost" && $auth ne "") {
  	    my $u_auth = uri_unescape($auth);
  	    if (!$class->_file_is_localhost($u_auth)) {
  		# some other host (use it as volume name)
  		@path = ("", $auth);
  		# XXX or just return to make it illegal;
  	    }
  	}
      }
      my @ps = split("/", $uri->path, -1);
      shift @ps if @path;
      push(@path, @ps);
  
      my $pre = "";
      if (!@path) {
  	return;  # empty path; XXX return ":" instead?
      } elsif ($path[0] eq "") {
  	# absolute
  	shift(@path);
  	if (@path == 1) {
  	    return if $path[0] eq "";  # not root directory
  	    push(@path, "");           # volume only, effectively append ":"
  	}
  	@ps = @path;
  	@path = ();
          my $part;
  	for (@ps) {  #fix up "." and "..", including interior, in relatives
  	    next if $_ eq ".";
  	    $part = $_ eq ".." ? "" : $_;
  	    push(@path,$part);
  	}
  	if ($ps[-1] eq "..") {  #if this happens, we need another :
  	    push(@path,"");
  	}
  	
      } else {
  	$pre = ":";
  	@ps = @path;
  	@path = ();
          my $part;
  	for (@ps) {  #fix up "." and "..", including interior, in relatives
  	    next if $_ eq ".";
  	    $part = $_ eq ".." ? "" : $_;
  	    push(@path,$part);
  	}
  	if ($ps[-1] eq "..") {  #if this happens, we need another :
  	    push(@path,"");
  	}
  	
      }
      return unless $pre || @path;
      for (@path) {
  	s/;.*//;  # get rid of parameters
  	#return unless length; # XXX
  	$_ = uri_unescape($_);
  	return if /\0/;
  	return if /:/;  # Should we?
      }
      $pre . join(":", @path);
  }
  
  sub dir
  {
      my $class = shift;
      my $path = $class->file(@_);
      return unless defined $path;
      $path .= ":" unless $path =~ /:$/;
      $path;
  }
  
  1;
URI_FILE_MAC

$fatpacked{"URI/file/OS2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_OS2';
  package URI::file::OS2;
  
  use strict;
  use warnings;
  
  use parent 'URI::file::Win32';
  
  our $VERSION = '1.76';
  
  # The Win32 version translates k:/foo to file://k:/foo  (?!)
  # We add an empty host
  
  sub _file_extract_authority
  {
      my $class = shift;
      return $1 if $_[0] =~ s,^\\\\([^\\]+),,;  # UNC
      return $1 if $_[0] =~ s,^//([^/]+),,;     # UNC too?
  
      if ($_[0] =~ m#^[a-zA-Z]{1,2}:#) {	      # allow for ab: drives
  	return "";
      }
      return;
  }
  
  sub file {
    my $p = &URI::file::Win32::file;
    return unless defined $p;
    $p =~ s,\\,/,g;
    $p;
  }
  
  1;
URI_FILE_OS2

$fatpacked{"URI/file/QNX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_QNX';
  package URI::file::QNX;
  
  use strict;
  use warnings;
  
  use parent 'URI::file::Unix';
  
  our $VERSION = '1.76';
  
  sub _file_extract_path
  {
      my($class, $path) = @_;
      # tidy path
      $path =~ s,(.)//+,$1/,g; # ^// is correct
      $path =~ s,(/\.)+/,/,g;
      $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:"
      $path;
  }
  
  1;
URI_FILE_QNX

$fatpacked{"URI/file/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_UNIX';
  package URI::file::Unix;
  
  use strict;
  use warnings;
  
  use parent 'URI::file::Base';
  
  use URI::Escape qw(uri_unescape);
  
  our $VERSION = '1.76';
  
  sub _file_extract_path
  {
      my($class, $path) = @_;
  
      # tidy path
      $path =~ s,//+,/,g;
      $path =~ s,(/\.)+/,/,g;
      $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:"
  
      return $path;
  }
  
  sub _file_is_absolute {
      my($class, $path) = @_;
      return $path =~ m,^/,;
  }
  
  sub file
  {
      my $class = shift;
      my $uri = shift;
      my @path;
  
      my $auth = $uri->authority;
      if (defined($auth)) {
  	if (lc($auth) ne "localhost" && $auth ne "") {
  	    $auth = uri_unescape($auth);
  	    unless ($class->_file_is_localhost($auth)) {
  		push(@path, "", "", $auth);
  	    }
  	}
      }
  
      my @ps = $uri->path_segments;
      shift @ps if @path;
      push(@path, @ps);
  
      for (@path) {
  	# Unix file/directory names are not allowed to contain '\0' or '/'
  	return undef if /\0/;
  	return undef if /\//;  # should we really?
      }
  
      return join("/", @path);
  }
  
  1;
URI_FILE_UNIX

$fatpacked{"URI/file/Win32.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_WIN32';
  package URI::file::Win32;
  
  use strict;
  use warnings;
  
  use parent 'URI::file::Base';
  
  use URI::Escape qw(uri_unescape);
  
  our $VERSION = '1.76';
  
  sub _file_extract_authority
  {
      my $class = shift;
  
      return $class->SUPER::_file_extract_authority($_[0])
  	if defined $URI::file::DEFAULT_AUTHORITY;
  
      return $1 if $_[0] =~ s,^\\\\([^\\]+),,;  # UNC
      return $1 if $_[0] =~ s,^//([^/]+),,;     # UNC too?
  
      if ($_[0] =~ s,^([a-zA-Z]:),,) {
  	my $auth = $1;
  	$auth .= "relative" if $_[0] !~ m,^[\\/],;
  	return $auth;
      }
      return undef;
  }
  
  sub _file_extract_path
  {
      my($class, $path) = @_;
      $path =~ s,\\,/,g;
      #$path =~ s,//+,/,g;
      $path =~ s,(/\.)+/,/,g;
  
      if (defined $URI::file::DEFAULT_AUTHORITY) {
  	$path =~ s,^([a-zA-Z]:),/$1,;
      }
  
      return $path;
  }
  
  sub _file_is_absolute {
      my($class, $path) = @_;
      return $path =~ m,^[a-zA-Z]:, || $path =~ m,^[/\\],;
  }
  
  sub file
  {
      my $class = shift;
      my $uri = shift;
      my $auth = $uri->authority;
      my $rel; # is filename relative to drive specified in authority
      if (defined $auth) {
          $auth = uri_unescape($auth);
  	if ($auth =~ /^([a-zA-Z])[:|](relative)?/) {
  	    $auth = uc($1) . ":";
  	    $rel++ if $2;
  	} elsif (lc($auth) eq "localhost") {
  	    $auth = "";
  	} elsif (length $auth) {
  	    $auth = "\\\\" . $auth;  # UNC
  	}
      } else {
  	$auth = "";
      }
  
      my @path = $uri->path_segments;
      for (@path) {
  	return undef if /\0/;
  	return undef if /\//;
  	#return undef if /\\/;        # URLs with "\" is not uncommon
      }
      return undef unless $class->fix_path(@path);
  
      my $path = join("\\", @path);
      $path =~ s/^\\// if $rel;
      $path = $auth . $path;
      $path =~ s,^\\([a-zA-Z])[:|],\u$1:,;
  
      return $path;
  }
  
  sub fix_path { 1; }
  
  1;
URI_FILE_WIN32

$fatpacked{"URI/ftp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FTP';
  package URI::ftp;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent qw(URI::_server URI::_userpass);
  
  sub default_port { 21 }
  
  sub path { shift->path_query(@_) }  # XXX
  
  sub _user     { shift->SUPER::user(@_);     }
  sub _password { shift->SUPER::password(@_); }
  
  sub user
  {
      my $self = shift;
      my $user = $self->_user(@_);
      $user = "anonymous" unless defined $user;
      $user;
  }
  
  sub password
  {
      my $self = shift;
      my $pass = $self->_password(@_);
      unless (defined $pass) {
  	my $user = $self->user;
  	if ($user eq 'anonymous' || $user eq 'ftp') {
  	    # anonymous ftp login password
              # If there is no ftp anonymous password specified
              # then we'll just use 'anonymous@'
              # We don't try to send the read e-mail address because:
              # - We want to remain anonymous
              # - We want to stop SPAM
              # - We don't want to let ftp sites to discriminate by the user,
              #   host, country or ftp client being used.
  	    $pass = 'anonymous@';
  	}
      }
      $pass;
  }
  
  1;
URI_FTP

$fatpacked{"URI/gopher.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_GOPHER';
  package URI::gopher;  # <draft-murali-url-gopher>, Dec 4, 1996
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_server';
  
  use URI::Escape qw(uri_unescape);
  
  #  A Gopher URL follows the common internet scheme syntax as defined in 
  #  section 4.3 of [RFC-URL-SYNTAX]:
  #
  #        gopher://<host>[:<port>]/<gopher-path>
  #
  #  where
  #
  #        <gopher-path> :=  <gopher-type><selector> | 
  #                          <gopher-type><selector>%09<search> |
  #                          <gopher-type><selector>%09<search>%09<gopher+_string>
  #
  #        <gopher-type> := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7'
  #                         '8' | '9' | '+' | 'I' | 'g' | 'T'
  #
  #        <selector>    := *pchar     Refer to RFC 1808 [4]
  #        <search>      := *pchar
  #        <gopher+_string> := *uchar  Refer to RFC 1738 [3]
  #        
  #  If the optional port is omitted, the port defaults to 70. 
  
  sub default_port { 70 }
  
  sub _gopher_type
  {
      my $self = shift;
      my $path = $self->path_query;
      $path =~ s,^/,,;
      my $gtype = $1 if $path =~ s/^(.)//s;
      if (@_) {
  	my $new_type = shift;
  	if (defined($new_type)) {
  	    Carp::croak("Bad gopher type '$new_type'")
                 unless length($new_type) == 1;
  	    substr($path, 0, 0) = $new_type;
  	    $self->path_query($path);
  	} else {
  	    Carp::croak("Can't delete gopher type when selector is present")
  		if length($path);
  	    $self->path_query(undef);
  	}
      }
      return $gtype;
  }
  
  sub gopher_type
  {
      my $self = shift;
      my $gtype = $self->_gopher_type(@_);
      $gtype = "1" unless defined $gtype;
      $gtype;
  }
  
  sub gtype { goto &gopher_type }  # URI::URL compatibility
  
  sub selector { shift->_gfield(0, @_) }
  sub search   { shift->_gfield(1, @_) }
  sub string   { shift->_gfield(2, @_) }
  
  sub _gfield
  {
      my $self = shift;
      my $fno  = shift;
      my $path = $self->path_query;
  
      # not according to spec., but many popular browsers accept
      # gopher URLs with a '?' before the search string.
      $path =~ s/\?/\t/;
      $path = uri_unescape($path);
      $path =~ s,^/,,;
      my $gtype = $1 if $path =~ s,^(.),,s;
      my @path = split(/\t/, $path, 3);
      if (@_) {
  	# modify
  	my $new = shift;
  	$path[$fno] = $new;
  	pop(@path) while @path && !defined($path[-1]);
  	for (@path) { $_="" unless defined }
  	$path = $gtype;
  	$path = "1" unless defined $path;
  	$path .= join("\t", @path);
  	$self->path_query($path);
      }
      $path[$fno];
  }
  
  1;
URI_GOPHER

$fatpacked{"URI/http.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HTTP';
  package URI::http;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_server';
  
  sub default_port { 80 }
  
  sub canonical
  {
      my $self = shift;
      my $other = $self->SUPER::canonical;
  
      my $slash_path = defined($other->authority) &&
          !length($other->path) && !defined($other->query);
  
      if ($slash_path) {
  	$other = $other->clone if $other == $self;
  	$other->path("/");
      }
      $other;
  }
  
  1;
URI_HTTP

$fatpacked{"URI/https.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HTTPS';
  package URI::https;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::http';
  
  sub default_port { 443 }
  
  sub secure { 1 }
  
  1;
URI_HTTPS

$fatpacked{"URI/ldap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAP';
  # Copyright (c) 1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
  # This program is free software; you can redistribute it and/or
  # modify it under the same terms as Perl itself.
  
  package URI::ldap;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent qw(URI::_ldap URI::_server);
  
  sub default_port { 389 }
  
  sub _nonldap_canonical {
      my $self = shift;
      $self->URI::_server::canonical(@_);
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  URI::ldap - LDAP Uniform Resource Locators
  
  =head1 SYNOPSIS
  
    use URI;
  
    $uri = URI->new("ldap:$uri_string");
    $dn     = $uri->dn;
    $filter = $uri->filter;
    @attr   = $uri->attributes;
    $scope  = $uri->scope;
    %extn   = $uri->extensions;
    
    $uri = URI->new("ldap:");  # start empty
    $uri->host("ldap.itd.umich.edu");
    $uri->dn("o=University of Michigan,c=US");
    $uri->attributes(qw(postalAddress));
    $uri->scope('sub');
    $uri->filter('(cn=Babs Jensen)');
    print $uri->as_string,"\n";
  
  =head1 DESCRIPTION
  
  C<URI::ldap> provides an interface to parse an LDAP URI into its
  constituent parts and also to build a URI as described in
  RFC 2255.
  
  =head1 METHODS
  
  C<URI::ldap> supports all the generic and server methods defined by
  L<URI>, plus the following.
  
  Each of the following methods can be used to set or get the value in
  the URI. The values are passed in unescaped form.  None of these
  return undefined values, but elements without a default can be empty.
  If arguments are given, then a new value is set for the given part
  of the URI.
  
  =over 4
  
  =item $uri->dn( [$new_dn] )
  
  Sets or gets the I<Distinguished Name> part of the URI.  The DN
  identifies the base object of the LDAP search.
  
  =item $uri->attributes( [@new_attrs] )
  
  Sets or gets the list of attribute names which are
  returned by the search.
  
  =item $uri->scope( [$new_scope] )
  
  Sets or gets the scope to be used by the search. The value can be one of
  C<"base">, C<"one"> or C<"sub">. If none is given in the URI then the
  return value defaults to C<"base">.
  
  =item $uri->_scope( [$new_scope] )
  
  Same as scope(), but does not default to anything.
  
  =item $uri->filter( [$new_filter] )
  
  Sets or gets the filter to be used by the search. If none is given in
  the URI then the return value defaults to C<"(objectClass=*)">.
  
  =item $uri->_filter( [$new_filter] )
  
  Same as filter(), but does not default to anything.
  
  =item $uri->extensions( [$etype => $evalue,...] )
  
  Sets or gets the extensions used for the search. The list passed should
  be in the form etype1 => evalue1, etype2 => evalue2,... This is also
  the form of list that is returned.
  
  =back
  
  =head1 SEE ALSO
  
  L<http://tools.ietf.org/html/rfc2255>
  
  =head1 AUTHOR
  
  Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
  
  Slightly modified by Gisle Aas to fit into the URI distribution.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1998 Graham Barr. All rights reserved. This program is
  free software; you can redistribute it and/or modify it under the same
  terms as Perl itself.
  
  =cut
URI_LDAP

$fatpacked{"URI/ldapi.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAPI';
  package URI::ldapi;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent qw(URI::_ldap URI::_generic);
  
  require URI::Escape;
  
  sub un_path {
      my $self = shift;
      my $old = URI::Escape::uri_unescape($self->authority);
      if (@_) {
  	my $p = shift;
  	$p =~ s/:/%3A/g;
  	$p =~ s/\@/%40/g;
  	$self->authority($p);
      }
      return $old;
  }
  
  sub _nonldap_canonical {
      my $self = shift;
      $self->URI::_generic::canonical(@_);
  }
  
  1;
URI_LDAPI

$fatpacked{"URI/ldaps.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAPS';
  package URI::ldaps;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::ldap';
  
  sub default_port { 636 }
  
  sub secure { 1 }
  
  1;
URI_LDAPS

$fatpacked{"URI/mailto.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_MAILTO';
  package URI::mailto;  # RFC 2368
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent qw(URI URI::_query);
  
  sub to
  {
      my $self = shift;
      my @old = $self->headers;
      if (@_) {
  	my @new = @old;
  	# get rid of any other to: fields
  	for (my $i = 0; $i < @new; $i += 2) {
  	    if (lc($new[$i] || '') eq "to") {
  		splice(@new, $i, 2);
  		redo;
  	    }
  	}
  
  	my $to = shift;
  	$to = "" unless defined $to;
  	unshift(@new, "to" => $to);
  	$self->headers(@new);
      }
      return unless defined wantarray;
  
      my @to;
      while (@old) {
  	my $h = shift @old;
  	my $v = shift @old;
  	push(@to, $v) if lc($h) eq "to";
      }
      join(",", @to);
  }
  
  
  sub headers
  {
      my $self = shift;
  
      # The trick is to just treat everything as the query string...
      my $opaque = "to=" . $self->opaque;
      $opaque =~ s/\?/&/;
  
      if (@_) {
  	my @new = @_;
  
  	# strip out any "to" fields
  	my @to;
  	for (my $i=0; $i < @new; $i += 2) {
  	    if (lc($new[$i] || '') eq "to") {
  		push(@to, (splice(@new, $i, 2))[1]);  # remove header
  		redo;
  	    }
  	}
  
  	my $new = join(",",@to);
  	$new =~ s/%/%25/g;
  	$new =~ s/\?/%3F/g;
  	$self->opaque($new);
  	$self->query_form(@new) if @new;
      }
      return unless defined wantarray;
  
      # I am lazy today...
      URI->new("mailto:?$opaque")->query_form;
  }
  
  1;
URI_MAILTO

$fatpacked{"URI/mms.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_MMS';
  package URI::mms;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::http';
  
  sub default_port { 1755 }
  
  1;
URI_MMS

$fatpacked{"URI/news.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_NEWS';
  package URI::news;  # draft-gilman-news-url-01
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_server';
  
  use URI::Escape qw(uri_unescape);
  use Carp ();
  
  sub default_port { 119 }
  
  #   newsURL      =  scheme ":" [ news-server ] [ refbygroup | message ]
  #   scheme       =  "news" | "snews" | "nntp"
  #   news-server  =  "//" server "/"
  #   refbygroup   = group [ "/" messageno [ "-" messageno ] ]
  #   message      = local-part "@" domain
  
  sub _group
  {
      my $self = shift;
      my $old = $self->path;
      if (@_) {
  	my($group,$from,$to) = @_;
  	if ($group =~ /\@/) {
              $group =~ s/^<(.*)>$/$1/;  # "<" and ">" should not be part of it
  	}
  	$group =~ s,%,%25,g;
  	$group =~ s,/,%2F,g;
  	my $path = $group;
  	if (defined $from) {
  	    $path .= "/$from";
  	    $path .= "-$to" if defined $to;
  	}
  	$self->path($path);
      }
  
      $old =~ s,^/,,;
      if ($old !~ /\@/ && $old =~ s,/(.*),, && wantarray) {
  	my $extra = $1;
  	return (uri_unescape($old), split(/-/, $extra));
      }
      uri_unescape($old);
  }
  
  
  sub group
  {
      my $self = shift;
      if (@_) {
  	Carp::croak("Group name can't contain '\@'") if $_[0] =~ /\@/;
      }
      my @old = $self->_group(@_);
      return if $old[0] =~ /\@/;
      wantarray ? @old : $old[0];
  }
  
  sub message
  {
      my $self = shift;
      if (@_) {
  	Carp::croak("Message must contain '\@'") unless $_[0] =~ /\@/;
      }
      my $old = $self->_group(@_);
      return undef unless $old =~ /\@/;
      return $old;
  }
  
  1;
URI_NEWS

$fatpacked{"URI/nntp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_NNTP';
  package URI::nntp;  # draft-gilman-news-url-01
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::news';
  
  1;
URI_NNTP

$fatpacked{"URI/pop.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_POP';
  package URI::pop;   # RFC 2384
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_server';
  
  use URI::Escape qw(uri_unescape);
  
  sub default_port { 110 }
  
  #pop://<user>;auth=<auth>@<host>:<port>
  
  sub user
  {
      my $self = shift;
      my $old = $self->userinfo;
  
      if (@_) {
  	my $new_info = $old;
  	$new_info = "" unless defined $new_info;
  	$new_info =~ s/^[^;]*//;
  
  	my $new = shift;
  	if (!defined($new) && !length($new_info)) {
  	    $self->userinfo(undef);
  	} else {
  	    $new = "" unless defined $new;
  	    $new =~ s/%/%25/g;
  	    $new =~ s/;/%3B/g;
  	    $self->userinfo("$new$new_info");
  	}
      }
  
      return undef unless defined $old;
      $old =~ s/;.*//;
      return uri_unescape($old);
  }
  
  sub auth
  {
      my $self = shift;
      my $old = $self->userinfo;
  
      if (@_) {
  	my $new = $old;
  	$new = "" unless defined $new;
  	$new =~ s/(^[^;]*)//;
  	my $user = $1;
  	$new =~ s/;auth=[^;]*//i;
  
  	
  	my $auth = shift;
  	if (defined $auth) {
  	    $auth =~ s/%/%25/g;
  	    $auth =~ s/;/%3B/g;
  	    $new = ";AUTH=$auth$new";
  	}
  	$self->userinfo("$user$new");
  	
      }
  
      return undef unless defined $old;
      $old =~ s/^[^;]*//;
      return uri_unescape($1) if $old =~ /;auth=(.*)/i;
      return;
  }
  
  1;
URI_POP

$fatpacked{"URI/rlogin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RLOGIN';
  package URI::rlogin;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_login';
  
  sub default_port { 513 }
  
  1;
URI_RLOGIN

$fatpacked{"URI/rsync.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RSYNC';
  package URI::rsync;  # http://rsync.samba.org/
  
  # rsync://[USER@]HOST[:PORT]/SRC
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent qw(URI::_server URI::_userpass);
  
  sub default_port { 873 }
  
  1;
URI_RSYNC

$fatpacked{"URI/rtsp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RTSP';
  package URI::rtsp;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::http';
  
  sub default_port { 554 }
  
  1;
URI_RTSP

$fatpacked{"URI/rtspu.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RTSPU';
  package URI::rtspu;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::rtsp';
  
  sub default_port { 554 }
  
  1;
URI_RTSPU

$fatpacked{"URI/sftp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SFTP';
  package URI::sftp;
  
  use strict;
  use warnings;
  
  use parent 'URI::ssh';
  
  our $VERSION = '1.76';
  
  1;
URI_SFTP

$fatpacked{"URI/sip.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SIP';
  #
  # Written by Ryan Kereliuk <ryker@ryker.org>.  This file may be
  # distributed under the same terms as Perl itself.
  #
  # The RFC 3261 sip URI is <scheme>:<authority>;<params>?<query>.
  #
  
  package URI::sip;
  
  use strict;
  use warnings;
  
  use parent qw(URI::_server URI::_userpass);
  
  use URI::Escape qw(uri_unescape);
  
  our $VERSION = '1.76';
  
  sub default_port { 5060 }
  
  sub authority
  {
      my $self = shift;
      $$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;
      my $old = $2;
  
      if (@_) {
          my $auth = shift;
          $$self = defined($1) ? $1 : "";
          my $rest = $3;
          if (defined $auth) {
              $auth =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
              $$self .= "$auth";
          }
          $$self .= $rest;
      }
      $old;
  }
  
  sub params_form
  {
      my $self = shift;
      $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
      my $paramstr = $3;
  
      if (@_) {
      	my @args = @_; 
          $$self = $1 . $2;
          my $rest = $4;
  	my @new;
  	for (my $i=0; $i < @args; $i += 2) {
  	    push(@new, "$args[$i]=$args[$i+1]");
  	}
  	$paramstr = join(";", @new);
  	$$self .= ";" . $paramstr . $rest;
      }
      $paramstr =~ s/^;//o;
      return split(/[;=]/, $paramstr);
  }
  
  sub params
  {
      my $self = shift;
      $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
      my $paramstr = $3;
  
      if (@_) {
      	my $new = shift; 
          $$self = $1 . $2;
          my $rest = $4;
  	$$self .= $paramstr . $rest;
      }
      $paramstr =~ s/^;//o;
      return $paramstr;
  }
  
  # Inherited methods that make no sense for a SIP URI.
  sub path {}
  sub path_query {}
  sub path_segments {}
  sub abs { shift }
  sub rel { shift }
  sub query_keywords {}
  
  1;
URI_SIP

$fatpacked{"URI/sips.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SIPS';
  package URI::sips;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::sip';
  
  sub default_port { 5061 }
  
  sub secure { 1 }
  
  1;
URI_SIPS

$fatpacked{"URI/snews.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SNEWS';
  package URI::snews;  # draft-gilman-news-url-01
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::news';
  
  sub default_port { 563 }
  
  sub secure { 1 }
  
  1;
URI_SNEWS

$fatpacked{"URI/ssh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SSH';
  package URI::ssh;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_login';
  
  # ssh://[USER@]HOST[:PORT]/SRC
  
  sub default_port { 22 }
  
  sub secure { 1 }
  
  1;
URI_SSH

$fatpacked{"URI/telnet.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_TELNET';
  package URI::telnet;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_login';
  
  sub default_port { 23 }
  
  1;
URI_TELNET

$fatpacked{"URI/tn3270.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_TN3270';
  package URI::tn3270;
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::_login';
  
  sub default_port { 23 }
  
  1;
URI_TN3270

$fatpacked{"URI/urn.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN';
  package URI::urn;  # RFC 2141
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI';
  
  use Carp qw(carp);
  
  my %implementor;
  my %require_attempted;
  
  sub _init {
      my $class = shift;
      my $self = $class->SUPER::_init(@_);
      my $nid = $self->nid;
  
      my $impclass = $implementor{$nid};
      return $impclass->_urn_init($self, $nid) if $impclass;
  
      $impclass = "URI::urn";
      if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/) {
  	my $id = $nid;
  	# make it a legal perl identifier
  	$id =~ s/-/_/g;
  	$id = "_$id" if $id =~ /^\d/;
  
  	$impclass = "URI::urn::$id";
  	no strict 'refs';
  	unless (@{"${impclass}::ISA"}) {
              if (not exists $require_attempted{$impclass}) {
                  # Try to load it
                  my $_old_error = $@;
                  eval "require $impclass";
                  die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
                  $@ = $_old_error;
              }
  	    $impclass = "URI::urn" unless @{"${impclass}::ISA"};
  	}
      }
      else {
  	carp("Illegal namespace identifier '$nid' for URN '$self'") if $^W;
      }
      $implementor{$nid} = $impclass;
  
      return $impclass->_urn_init($self, $nid);
  }
  
  sub _urn_init {
      my($class, $self, $nid) = @_;
      bless $self, $class;
  }
  
  sub _nid {
      my $self = shift;
      my $opaque = $self->opaque;
      if (@_) {
  	my $v = $opaque;
  	my $new = shift;
  	$v =~ s/[^:]*/$new/;
  	$self->opaque($v);
  	# XXX possible rebless
      }
      $opaque =~ s/:.*//s;
      return $opaque;
  }
  
  sub nid {  # namespace identifier
      my $self = shift;
      my $nid = $self->_nid(@_);
      $nid = lc($nid) if defined($nid);
      return $nid;
  }
  
  sub nss {  # namespace specific string
      my $self = shift;
      my $opaque = $self->opaque;
      if (@_) {
  	my $v = $opaque;
  	my $new = shift;
  	if (defined $new) {
  	    $v =~ s/(:|\z).*/:$new/;
  	}
  	else {
  	    $v =~ s/:.*//s;
  	}
  	$self->opaque($v);
      }
      return undef unless $opaque =~ s/^[^:]*://;
      return $opaque;
  }
  
  sub canonical {
      my $self = shift;
      my $nid = $self->_nid;
      my $new = $self->SUPER::canonical;
      return $new if $nid !~ /[A-Z]/ || $nid =~ /%/;
      $new = $new->clone if $new == $self;
      $new->nid(lc($nid));
      return $new;
  }
  
  1;
URI_URN

$fatpacked{"URI/urn/isbn.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN_ISBN';
  package URI::urn::isbn;  # RFC 3187
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::urn';
  
  use Carp qw(carp);
  
  BEGIN {
      require Business::ISBN;
      
      local $^W = 0; # don't warn about dev versions, perl5.004 style
      warn "Using Business::ISBN version " . Business::ISBN->VERSION . 
          " which is deprecated.\nUpgrade to Business::ISBN version 2\n"
          if Business::ISBN->VERSION < 2;
      }
      
  sub _isbn {
      my $nss = shift;
      $nss = $nss->nss if ref($nss);
      my $isbn = Business::ISBN->new($nss);
      $isbn = undef if $isbn && !$isbn->is_valid;
      return $isbn;
  }
  
  sub _nss_isbn {
      my $self = shift;
      my $nss = $self->nss(@_);
      my $isbn = _isbn($nss);
      $isbn = $isbn->as_string if $isbn;
      return($nss, $isbn);
  }
  
  sub isbn {
      my $self = shift;
      my $isbn;
      (undef, $isbn) = $self->_nss_isbn(@_);
      return $isbn;
  }
  
  sub isbn_publisher_code {
      my $isbn = shift->_isbn || return undef;
      return $isbn->publisher_code;
  }
  
  BEGIN {
  my $group_method = do {
      local $^W = 0; # don't warn about dev versions, perl5.004 style
      Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code';
      };
  
  sub isbn_group_code {
      my $isbn = shift->_isbn || return undef;
      return $isbn->$group_method;
  }
  }
  
  sub isbn_country_code {
      my $name = (caller(0))[3]; $name =~ s/.*:://;
      carp "$name is DEPRECATED. Use isbn_group_code instead";
      
      no strict 'refs';
      &isbn_group_code;
  }
  
  BEGIN {
  my $isbn13_method = do {
      local $^W = 0; # don't warn about dev versions, perl5.004 style
      Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean';
      };
  
  sub isbn13 {
      my $isbn = shift->_isbn || return undef;
      
      # Business::ISBN 1.x didn't put hyphens in the EAN, and it was just a string
      # Business::ISBN 2.0 doesn't do EAN, but it does ISBN-13 objects
      #   and it uses the hyphens, so call as_string with an empty anon array
      # or, adjust the test and features to say that it comes out with hyphens.
      my $thingy = $isbn->$isbn13_method;
      return eval { $thingy->can( 'as_string' ) } ? $thingy->as_string([]) : $thingy;
  }
  }
  
  sub isbn_as_ean {
      my $name = (caller(0))[3]; $name =~ s/.*:://;
      carp "$name is DEPRECATED. Use isbn13 instead";
  
      no strict 'refs';
      &isbn13;
  }
  
  sub canonical {
      my $self = shift;
      my($nss, $isbn) = $self->_nss_isbn;
      my $new = $self->SUPER::canonical;
      return $new unless $nss && $isbn && $nss ne $isbn;
      $new = $new->clone if $new == $self;
      $new->nss($isbn);
      return $new;
  }
  
  1;
URI_URN_ISBN

$fatpacked{"URI/urn/oid.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN_OID';
  package URI::urn::oid;  # RFC 2061
  
  use strict;
  use warnings;
  
  our $VERSION = '1.76';
  
  use parent 'URI::urn';
  
  sub oid {
      my $self = shift;
      my $old = $self->nss;
      if (@_) {
  	$self->nss(join(".", @_));
      }
      return split(/\./, $old) if wantarray;
      return $old;
  }
  
  1;
URI_URN_OID

$fatpacked{"Win32/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'WIN32_SHELLQUOTE';
  package Win32::ShellQuote;
  use strict;
  use warnings FATAL => 'all';
  use base 'Exporter';
  use Carp;
  
  our $VERSION = '0.003001';
  $VERSION = eval $VERSION;
  
  our @EXPORT_OK = qw(
      quote_native
      quote_cmd
      quote_system_list
      quote_system_string
      quote_system
      quote_system_cmd
      quote_literal
      cmd_escape
      unquote_native
      cmd_unescape
  );
  our %EXPORT_TAGS = (all => [@EXPORT_OK]);
  
  sub quote_native {
      return join q{ }, quote_system_list(@_);
  }
  
  sub quote_cmd {
      return cmd_escape(quote_native(@_));
  }
  
  sub quote_system_list {
      # have to force quoting, or perl might try to use cmd anyway
      return map { quote_literal($_, 1) } @_;
  }
  
  sub quote_system_string {
      my $args = quote_native(@_);
  
      if (_has_shell_metachars($args)) {
          $args = cmd_escape($args);
      }
      return $args;
  }
  
  sub quote_system {
      if (@_ > 1) {
          return quote_system_list(@_);
      }
      else {
          return quote_system_string(@_);
      }
  }
  
  sub quote_system_cmd {
      # force cmd, even when running through system
      my $args = quote_native(@_);
  
      if (! _has_shell_metachars($args)) {
          # IT BURNS LOOK AWAY
          return '%PATH:~0,0%' . cmd_escape($args);
      }
      return cmd_escape($args);
  }
  
  
  sub cmd_escape {
      my $string = shift;
      if ($string =~ /[\r\n\0]/) {
          croak "can't quote newlines to pass through cmd.exe";
      }
      $string =~ s/([()%!^"<>&|])/^$1/g;
      return $string;
  }
  
  sub quote_literal {
      my ($text, $force) = @_;
  
      # basic argument quoting.  uses backslashes and quotes to escape
      # everything.
      if (!$force && $text ne '' && $text !~ /[ \t\n\x0b"]/) {
          # no quoting needed
      }
      else {
          $text =~ s{(\\*)(?="|\z)}{$1$1}g;
          $text =~ s{"}{\\"}g;
          $text = qq{"$text"};
      }
  
      return $text;
  }
  
  # derived from rules in code in win32.c
  sub _has_shell_metachars {
      my $string = shift;
  
      return 1
          if $string =~ /%/;
      $string =~ s/(['"]).*?(\1|\z)//sg;
      return $string =~ /[<>|]/;
  }
  
  sub unquote_native {
      local ($_) = @_;
      my @argv;
  
      my $length = length
          or return @argv;
  
      m/\G\s*/gc;
  
      ARGS: until ( pos == $length ) {
          my $quote_mode;
          my $arg = '';
          CHARS: until ( pos == $length ) {
              if ( m/\G((?:\\\\)+)(?=\\?(")?)/gc ) {
                  if (defined $2) {
                      $arg .= '\\' x (length($1) / 2);
                  }
                  else {
                      $arg .= $1;
                  }
              }
              elsif ( m/\G\\"/gc ) {
                  $arg .= '"';
              }
              elsif ( m/\G"/gc ) {
                  if ( $quote_mode && m/\G"/gc ) {
                      $arg .= '"';
                  }
                  $quote_mode = !$quote_mode;
              }
              elsif ( !$quote_mode && m/\G\s+/gc ) {
                  last;
              }
              elsif ( m/\G(.)/sgc ) {
                  $arg .= $1;
              }
          }
          push @argv, $arg;
      }
  
      return @argv;
  }
  
  sub cmd_unescape {
      my ($string) = @_;
  
      no warnings 'uninitialized';
      $string =~ s/\^(.?)|([^^"]+)|("[^"]*(?:"|\z))/$1$2$3/gs;
  
      return $string;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Win32::ShellQuote - Quote argument lists for Win32
  
  =head1 SYNOPSIS
  
      use Win32::ShellQuote qw(:all);
  
      system quote_system('program.exe', '--switch', 'argument with spaces or other special characters');
  
  =head1 DESCRIPTION
  
  Quotes argument lists to be used in Win32 in several different
  situations.
  
  Windows passes its arguments as a single string instead of an array
  as other platforms do.  In almost all cases, the standard Win32
  L<CommandLineToArgvW|http://msdn.microsoft.com/en-us/library/ms647232.aspx>
  function is used to parse this string.  F<cmd.exe> has different
  rules for handling quoting, so extra work has to be done if it is
  involved.  It isn't possible to consistantly create a single string
  that will be handled the same by F<cmd.exe> and the stardard parsing
  rules.
  
  Perl will try to detect if you need the shell by detecting shell
  metacharacters.  The routine that checks that uses different quoting
  rules from both F<cmd.exe> and the native Win32 parsing.  Extra
  work must therefore be done to protect against this autodetection.
  
  =head1 SUBROUTINES
  
  =head2 quote_native
  
  Quotes as a string to pass directly to a program using native methods
  like L<Win32::Spawn()|Win32>.  This is the safest option to use if
  possible.
  
  =head2 quote_cmd
  
  Quotes as a string to be run through F<cmd.exe>, such as in a batch file.
  
  =head2 quote_system_list
  
  Quotes as a list to be passed to L<system|perlfunc/system> or
  L<exec|perlfunc/exec>.  This is equally as safe as L</quote_native>,
  but you must ensure you have more than one item being quoted for
  the list to be usable with system.
  
  =head2 quote_system_string
  
  Like L</quote_system_list>, but returns a single string.  Some
  argument lists cannot be properly quoted using this function.
  
  =head2 quote_system
  
  Switches between L</quote_system_list> and L</quote_system_string>
  based on the number of items quoted.
  
  =head2 quote_system_cmd
  
  Quotes as a single string that will always be run with F<cmd.exe>.
  
  =head2 quote_literal
  
  Quotes a single parameter in native form.
  
  =head2 cmd_escape
  
  Escapes a string to be passed untouched by F<cmd.exe>.
  
  =head1 CAVEATS
  
  =over
  
  =item *
  
  Newlines (\n or \r) and null (\0) can't be properly quoted when
  running through F<cmd.exe>.
  
  =item *
  
  This module re-implements some under-specified part of the perl
  internals to accurately perform its work.
  
  =back
  
  =head1 AUTHOR
  
  haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
  
  =head1 CONTRIBUTORS
  
  =over 8
  
  =item * Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright (c) 2012 the L</AUTHOR> and L</CONTRIBUTORS>
  as listed above.
  
  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
WIN32_SHELLQUOTE

$fatpacked{"lib/core/only.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIB_CORE_ONLY';
  package lib::core::only;
  
  use strict;
  use warnings FATAL => 'all';
  use Config;
  
  sub import {
    @INC = @Config{qw(privlibexp archlibexp)};
    return
  }
  
  =head1 NAME
  
  lib::core::only - Remove all non-core paths from @INC to avoid site/vendor dirs
  
  =head1 SYNOPSIS
  
    use lib::core::only; # now @INC contains only the two core directories
  
  To get only the core directories plus the ones for the local::lib in scope:
  
    $ perl -mlocal::lib -Mlib::core::only -Mlocal::lib=~/perl5 myscript.pl
  
  To attempt to do a self-contained build (but note this will not reliably
  propagate into subprocesses, see the CAVEATS below):
  
    $ PERL5OPT='-mlocal::lib -Mlib::core::only -Mlocal::lib=~/perl5' cpan
  
  Please note that it is necessary to use C<local::lib> twice for this to work.
  First so that C<lib::core::only> doesn't prevent C<local::lib> from loading
  (it's not currently in core) and then again after C<lib::core::only> so that
  the local paths are not removed.
  
  =head1 DESCRIPTION
  
  lib::core::only is simply a shortcut to say "please reduce my @INC to only
  the core lib and archlib (architecture-specific lib) directories of this perl".
  
  You might want to do this to ensure a local::lib contains only the code you
  need, or to test an L<App::FatPacker|App::FatPacker> tree, or to avoid known
  bad vendor packages.
  
  You might want to use this to try and install a self-contained tree of perl
  modules. Be warned that that probably won't work (see L</CAVEATS>).
  
  This module was extracted from L<local::lib|local::lib>'s --self-contained
  feature, and contains the only part that ever worked. I apologise to anybody
  who thought anything else did.
  
  =head1 CAVEATS
  
  This does B<not> propagate properly across perl invocations like local::lib's
  stuff does. It can't. It's only a module import, so it B<only affects the
  specific perl VM instance in which you load and import() it>.
  
  If you want to cascade it across invocations, you can set the PERL5OPT
  environment variable to '-Mlib::core::only' and it'll sort of work. But be
  aware that taint mode ignores this, so some modules' build and test code
  probably will as well.
  
  You also need to be aware that perl's command line options are not processed
  in order - -I options take effect before -M options, so
  
    perl -Mlib::core::only -Ilib
  
  is unlike to do what you want - it's exactly equivalent to:
  
    perl -Mlib::core::only
  
  If you want to combine a core-only @INC with additional paths, you need to
  add the additional paths using -M options and the L<lib|lib> module:
  
    perl -Mlib::core::only -Mlib=lib
  
    # or if you're trying to test compiled code:
  
    perl -Mlib::core::only -Mblib
  
  For more information on the impossibility of sanely propagating this across
  module builds without help from the build program, see
  L<http://www.shadowcat.co.uk/blog/matt-s-trout/tainted-love> - and for ways
  to achieve the old --self-contained feature's results, look at
  L<App::FatPacker|App::FatPacker>'s tree function, and at
  L<App::cpanminus|cpanm>'s --local-lib-contained feature.
  
  =head1 AUTHOR
  
  Matt S. Trout <mst@shadowcat.co.uk>
  
  =head1 LICENSE
  
  This library is free software under the same terms as perl itself.
  
  =head1 COPYRIGHT
  
  (c) 2010 the lib::core::only L</AUTHOR> as specified above.
  
  =cut
  
  1;
LIB_CORE_ONLY

$fatpacked{"local/lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCAL_LIB';
  package local::lib;
  use 5.006;
  BEGIN {
    if ($ENV{RELEASE_TESTING}) {
      require strict;
      strict->import;
      require warnings;
      warnings->import;
    }
  }
  use Config ();
  
  our $VERSION = '2.000024';
  $VERSION = eval $VERSION;
  
  BEGIN {
    *_WIN32 = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'symbian')
      ? sub(){1} : sub(){0};
    # punt on these systems
    *_USE_FSPEC = ($^O eq 'MacOS' || $^O eq 'VMS' || $INC{'File/Spec.pm'})
      ? sub(){1} : sub(){0};
  }
  my $_archname = $Config::Config{archname};
  my $_version = $Config::Config{version};
  my @_inc_version_list = reverse split / /, $Config::Config{inc_version_list};
  my $_path_sep = $Config::Config{path_sep};
  
  our $_DIR_JOIN = _WIN32 ? '\\' : '/';
  our $_DIR_SPLIT = (_WIN32 || $^O eq 'cygwin') ? qr{[\\/]}
                                                : qr{/};
  our $_ROOT = _WIN32 ? do {
    my $UNC = qr{[\\/]{2}[^\\/]+[\\/][^\\/]+};
    qr{^(?:$UNC|[A-Za-z]:|)$_DIR_SPLIT};
  } : qr{^/};
  our $_PERL;
  
  sub _perl {
    if (!$_PERL) {
      # untaint and validate
      ($_PERL, my $exe) = $^X =~ /((?:.*$_DIR_SPLIT)?(.+))/;
      $_PERL = 'perl'
        if $exe !~ /perl/;
      if (_is_abs($_PERL)) {
      }
      elsif (-x $Config::Config{perlpath}) {
        $_PERL = $Config::Config{perlpath};
      }
      elsif ($_PERL =~ $_DIR_SPLIT && -x $_PERL) {
        $_PERL = _rel2abs($_PERL);
      }
      else {
        ($_PERL) =
          map { /(.*)/ }
          grep { -x $_ }
          map { ($_, _WIN32 ? ("$_.exe") : ()) }
          map { join($_DIR_JOIN, $_, $_PERL) }
          split /\Q$_path_sep\E/, $ENV{PATH};
      }
    }
    $_PERL;
  }
  
  sub _cwd {
    if (my $cwd
      = defined &Cwd::sys_cwd ? \&Cwd::sys_cwd
      : defined &Cwd::cwd     ? \&Cwd::cwd
      : undef
    ) {
      no warnings 'redefine';
      *_cwd = $cwd;
      goto &$cwd;
    }
    my $drive = shift;
    return Win32::Cwd()
      if _WIN32 && defined &Win32::Cwd && !$drive;
    local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
    my $cmd = $drive ? "eval { Cwd::getdcwd(q($drive)) }"
                     : 'getcwd';
    my $perl = _perl;
    my $cwd = `"$perl" -MCwd -le "print $cmd"`;
    chomp $cwd;
    if (!length $cwd && $drive) {
      $cwd = $drive;
    }
    $cwd =~ s/$_DIR_SPLIT?$/$_DIR_JOIN/;
    $cwd;
  }
  
  sub _catdir {
    if (_USE_FSPEC) {
      require File::Spec;
      File::Spec->catdir(@_);
    }
    else {
      my $dir = join($_DIR_JOIN, @_);
      $dir =~ s{($_DIR_SPLIT)(?:\.?$_DIR_SPLIT)+}{$1}g;
      $dir;
    }
  }
  
  sub _is_abs {
    if (_USE_FSPEC) {
      require File::Spec;
      File::Spec->file_name_is_absolute($_[0]);
    }
    else {
      $_[0] =~ $_ROOT;
    }
  }
  
  sub _rel2abs {
    my ($dir, $base) = @_;
    return $dir
      if _is_abs($dir);
  
    $base = _WIN32 && $dir =~ s/^([A-Za-z]:)// ? _cwd("$1")
          : $base                              ? _rel2abs($base)
                                               : _cwd;
    return _catdir($base, $dir);
  }
  
  our $_DEVNULL;
  sub _devnull {
    return $_DEVNULL ||=
      _USE_FSPEC      ? (require File::Spec, File::Spec->devnull)
      : _WIN32        ? 'nul'
      : $^O eq 'os2'  ? '/dev/nul'
      : '/dev/null';
  }
  
  sub import {
    my ($class, @args) = @_;
    if ($0 eq '-') {
      push @args, @ARGV;
      require Cwd;
    }
  
    my @steps;
    my %opts;
    my %attr;
    my $shelltype;
  
    while (@args) {
      my $arg = shift @args;
      # check for lethal dash first to stop processing before causing problems
      # the fancy dash is U+2212 or \xE2\x88\x92
      if ($arg =~ /\xE2\x88\x92/) {
        die <<'DEATH';
  WHOA THERE! It looks like you've got some fancy dashes in your commandline!
  These are *not* the traditional -- dashes that software recognizes. You
  probably got these by copy-pasting from the perldoc for this module as
  rendered by a UTF8-capable formatter. This most typically happens on an OS X
  terminal, but can happen elsewhere too. Please try again after replacing the
  dashes with normal minus signs.
  DEATH
      }
      elsif ($arg eq '--self-contained') {
        die <<'DEATH';
  FATAL: The local::lib --self-contained flag has never worked reliably and the
  original author, Mark Stosberg, was unable or unwilling to maintain it. As
  such, this flag has been removed from the local::lib codebase in order to
  prevent misunderstandings and potentially broken builds. The local::lib authors
  recommend that you look at the lib::core::only module shipped with this
  distribution in order to create a more robust environment that is equivalent to
  what --self-contained provided (although quite possibly not what you originally
  thought it provided due to the poor quality of the documentation, for which we
  apologise).
  DEATH
      }
      elsif( $arg =~ /^--deactivate(?:=(.*))?$/ ) {
        my $path = defined $1 ? $1 : shift @args;
        push @steps, ['deactivate', $path];
      }
      elsif ( $arg eq '--deactivate-all' ) {
        push @steps, ['deactivate_all'];
      }
      elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) {
        $shelltype = defined $1 ? $1 : shift @args;
      }
      elsif ( $arg eq '--no-create' ) {
        $opts{no_create} = 1;
      }
      elsif ( $arg eq '--quiet' ) {
        $attr{quiet} = 1;
      }
      elsif ( $arg =~ /^--/ ) {
        die "Unknown import argument: $arg";
      }
      else {
        push @steps, ['activate', $arg, \%opts];
      }
    }
    if (!@steps) {
      push @steps, ['activate', undef, \%opts];
    }
  
    my $self = $class->new(%attr);
  
    for (@steps) {
      my ($method, @args) = @$_;
      $self = $self->$method(@args);
    }
  
    if ($0 eq '-') {
      print $self->environment_vars_string($shelltype);
      exit 0;
    }
    else {
      $self->setup_local_lib;
    }
  }
  
  sub new {
    my $class = shift;
    bless {@_}, $class;
  }
  
  sub clone {
    my $self = shift;
    bless {%$self, @_}, ref $self;
  }
  
  sub inc { $_[0]->{inc}     ||= \@INC }
  sub libs { $_[0]->{libs}   ||= [ \'PERL5LIB' ] }
  sub bins { $_[0]->{bins}   ||= [ \'PATH' ] }
  sub roots { $_[0]->{roots} ||= [ \'PERL_LOCAL_LIB_ROOT' ] }
  sub extra { $_[0]->{extra} ||= {} }
  sub quiet { $_[0]->{quiet} }
  
  sub _as_list {
    my $list = shift;
    grep length, map {
      !(ref $_ && ref $_ eq 'SCALAR') ? $_ : (
        defined $ENV{$$_} ? split(/\Q$_path_sep/, $ENV{$$_})
                          : ()
      )
    } ref $list ? @$list : $list;
  }
  sub _remove_from {
    my ($list, @remove) = @_;
    return @$list
      if !@remove;
    my %remove = map { $_ => 1 } @remove;
    grep !$remove{$_}, _as_list($list);
  }
  
  my @_lib_subdirs = (
    [$_version, $_archname],
    [$_version],
    [$_archname],
    (map [$_], @_inc_version_list),
    [],
  );
  
  sub install_base_bin_path {
    my ($class, $path) = @_;
    return _catdir($path, 'bin');
  }
  sub install_base_perl_path {
    my ($class, $path) = @_;
    return _catdir($path, 'lib', 'perl5');
  }
  sub install_base_arch_path {
    my ($class, $path) = @_;
    _catdir($class->install_base_perl_path($path), $_archname);
  }
  
  sub lib_paths_for {
    my ($class, $path) = @_;
    my $base = $class->install_base_perl_path($path);
    return map { _catdir($base, @$_) } @_lib_subdirs;
  }
  
  sub _mm_escape_path {
    my $path = shift;
    $path =~ s/\\/\\\\/g;
    if ($path =~ s/ /\\ /g) {
      $path = qq{"$path"};
    }
    return $path;
  }
  
  sub _mb_escape_path {
    my $path = shift;
    $path =~ s/\\/\\\\/g;
    return qq{"$path"};
  }
  
  sub installer_options_for {
    my ($class, $path) = @_;
    return (
      PERL_MM_OPT =>
        defined $path ? "INSTALL_BASE="._mm_escape_path($path) : undef,
      PERL_MB_OPT =>
        defined $path ? "--install_base "._mb_escape_path($path) : undef,
    );
  }
  
  sub active_paths {
    my ($self) = @_;
    $self = ref $self ? $self : $self->new;
  
    return grep {
      # screen out entries that aren't actually reflected in @INC
      my $active_ll = $self->install_base_perl_path($_);
      grep { $_ eq $active_ll } @{$self->inc};
    } _as_list($self->roots);
  }
  
  
  sub deactivate {
    my ($self, $path) = @_;
    $self = $self->new unless ref $self;
    $path = $self->resolve_path($path);
    $path = $self->normalize_path($path);
  
    my @active_lls = $self->active_paths;
  
    if (!grep { $_ eq $path } @active_lls) {
      warn "Tried to deactivate inactive local::lib '$path'\n";
      return $self;
    }
  
    my %args = (
      bins  => [ _remove_from($self->bins,
        $self->install_base_bin_path($path)) ],
      libs  => [ _remove_from($self->libs,
        $self->install_base_perl_path($path)) ],
      inc   => [ _remove_from($self->inc,
        $self->lib_paths_for($path)) ],
      roots => [ _remove_from($self->roots, $path) ],
    );
  
    $args{extra} = { $self->installer_options_for($args{roots}[0]) };
  
    $self->clone(%args);
  }
  
  sub deactivate_all {
    my ($self) = @_;
    $self = $self->new unless ref $self;
  
    my @active_lls = $self->active_paths;
  
    my %args;
    if (@active_lls) {
      %args = (
        bins => [ _remove_from($self->bins,
          map $self->install_base_bin_path($_), @active_lls) ],
        libs => [ _remove_from($self->libs,
          map $self->install_base_perl_path($_), @active_lls) ],
        inc => [ _remove_from($self->inc,
          map $self->lib_paths_for($_), @active_lls) ],
        roots => [ _remove_from($self->roots, @active_lls) ],
      );
    }
  
    $args{extra} = { $self->installer_options_for(undef) };
  
    $self->clone(%args);
  }
  
  sub activate {
    my ($self, $path, $opts) = @_;
    $opts ||= {};
    $self = $self->new unless ref $self;
    $path = $self->resolve_path($path);
    $self->ensure_dir_structure_for($path, { quiet => $self->quiet })
      unless $opts->{no_create};
  
    $path = $self->normalize_path($path);
  
    my @active_lls = $self->active_paths;
  
    if (grep { $_ eq $path } @active_lls[1 .. $#active_lls]) {
      $self = $self->deactivate($path);
    }
  
    my %args;
    if ($opts->{always} || !@active_lls || $active_lls[0] ne $path) {
      %args = (
        bins  => [ $self->install_base_bin_path($path), @{$self->bins} ],
        libs  => [ $self->install_base_perl_path($path), @{$self->libs} ],
        inc   => [ $self->lib_paths_for($path), @{$self->inc} ],
        roots => [ $path, @{$self->roots} ],
      );
    }
  
    $args{extra} = { $self->installer_options_for($path) };
  
    $self->clone(%args);
  }
  
  sub normalize_path {
    my ($self, $path) = @_;
    $path = ( Win32::GetShortPathName($path) || $path )
      if $^O eq 'MSWin32';
    return $path;
  }
  
  sub build_environment_vars_for {
    my $self = $_[0]->new->activate($_[1], { always => 1 });
    $self->build_environment_vars;
  }
  sub build_activate_environment_vars_for {
    my $self = $_[0]->new->activate($_[1], { always => 1 });
    $self->build_environment_vars;
  }
  sub build_deactivate_environment_vars_for {
    my $self = $_[0]->new->deactivate($_[1]);
    $self->build_environment_vars;
  }
  sub build_deact_all_environment_vars_for {
    my $self = $_[0]->new->deactivate_all;
    $self->build_environment_vars;
  }
  sub build_environment_vars {
    my $self = shift;
    (
      PATH                => join($_path_sep, _as_list($self->bins)),
      PERL5LIB            => join($_path_sep, _as_list($self->libs)),
      PERL_LOCAL_LIB_ROOT => join($_path_sep, _as_list($self->roots)),
      %{$self->extra},
    );
  }
  
  sub setup_local_lib_for {
    my $self = $_[0]->new->activate($_[1]);
    $self->setup_local_lib;
  }
  
  sub setup_local_lib {
    my $self = shift;
  
    # if Carp is already loaded, ensure Carp::Heavy is also loaded, to avoid
    # $VERSION mismatch errors (Carp::Heavy loads Carp, so we do not need to
    # check in the other direction)
    require Carp::Heavy if $INC{'Carp.pm'};
  
    $self->setup_env_hash;
    @INC = @{$self->inc};
  }
  
  sub setup_env_hash_for {
    my $self = $_[0]->new->activate($_[1]);
    $self->setup_env_hash;
  }
  sub setup_env_hash {
    my $self = shift;
    my %env = $self->build_environment_vars;
    for my $key (keys %env) {
      if (defined $env{$key}) {
        $ENV{$key} = $env{$key};
      }
      else {
        delete $ENV{$key};
      }
    }
  }
  
  sub print_environment_vars_for {
    print $_[0]->environment_vars_string_for(@_[1..$#_]);
  }
  
  sub environment_vars_string_for {
    my $self = $_[0]->new->activate($_[1], { always => 1});
    $self->environment_vars_string;
  }
  sub environment_vars_string {
    my ($self, $shelltype) = @_;
  
    $shelltype ||= $self->guess_shelltype;
  
    my $extra = $self->extra;
    my @envs = (
      PATH                => $self->bins,
      PERL5LIB            => $self->libs,
      PERL_LOCAL_LIB_ROOT => $self->roots,
      map { $_ => $extra->{$_} } sort keys %$extra,
    );
    $self->_build_env_string($shelltype, \@envs);
  }
  
  sub _build_env_string {
    my ($self, $shelltype, $envs) = @_;
    my @envs = @$envs;
  
    my $build_method = "build_${shelltype}_env_declaration";
  
    my $out = '';
    while (@envs) {
      my ($name, $value) = (shift(@envs), shift(@envs));
      if (
          ref $value
          && @$value == 1
          && ref $value->[0]
          && ref $value->[0] eq 'SCALAR'
          && ${$value->[0]} eq $name) {
        next;
      }
      $out .= $self->$build_method($name, $value);
    }
    my $wrap_method = "wrap_${shelltype}_output";
    if ($self->can($wrap_method)) {
      return $self->$wrap_method($out);
    }
    return $out;
  }
  
  sub build_bourne_env_declaration {
    my ($class, $name, $args) = @_;
    my $value = $class->_interpolate($args, '${%s:-}', qr/["\\\$!`]/, '\\%s');
  
    if (!defined $value) {
      return qq{unset $name;\n};
    }
  
    $value =~ s/(^|\G|$_path_sep)\$\{$name:-\}$_path_sep/$1\${$name}\${$name:+$_path_sep}/g;
    $value =~ s/$_path_sep\$\{$name:-\}$/\${$name:+$_path_sep\${$name}}/;
  
    qq{${name}="$value"; export ${name};\n}
  }
  
  sub build_csh_env_declaration {
    my ($class, $name, $args) = @_;
    my ($value, @vars) = $class->_interpolate($args, '${%s}', qr/["\$]/, '"\\%s"');
    if (!defined $value) {
      return qq{unsetenv $name;\n};
    }
  
    my $out = '';
    for my $var (@vars) {
      $out .= qq{if ! \$?$name setenv $name '';\n};
    }
  
    my $value_without = $value;
    if ($value_without =~ s/(?:^|$_path_sep)\$\{$name\}(?:$_path_sep|$)//g) {
      $out .= qq{if "\${$name}" != '' setenv $name "$value";\n};
      $out .= qq{if "\${$name}" == '' };
    }
    $out .= qq{setenv $name "$value_without";\n};
    return $out;
  }
  
  sub build_cmd_env_declaration {
    my ($class, $name, $args) = @_;
    my $value = $class->_interpolate($args, '%%%s%%', qr(%), '%s');
    if (!$value) {
      return qq{\@set $name=\n};
    }
  
    my $out = '';
    my $value_without = $value;
    if ($value_without =~ s/(?:^|$_path_sep)%$name%(?:$_path_sep|$)//g) {
      $out .= qq{\@if not "%$name%"=="" set "$name=$value"\n};
      $out .= qq{\@if "%$name%"=="" };
    }
    $out .= qq{\@set "$name=$value_without"\n};
    return $out;
  }
  
  sub build_powershell_env_declaration {
    my ($class, $name, $args) = @_;
    my $value = $class->_interpolate($args, '$env:%s', qr/["\$]/, '`%s');
  
    if (!$value) {
      return qq{Remove-Item -ErrorAction 0 Env:\\$name;\n};
    }
  
    my $maybe_path_sep = qq{\$(if("\$env:$name"-eq""){""}else{"$_path_sep"})};
    $value =~ s/(^|\G|$_path_sep)\$env:$name$_path_sep/$1\$env:$name"+$maybe_path_sep+"/g;
    $value =~ s/$_path_sep\$env:$name$/"+$maybe_path_sep+\$env:$name+"/;
  
    qq{\$env:$name = \$("$value");\n};
  }
  sub wrap_powershell_output {
    my ($class, $out) = @_;
    return $out || " \n";
  }
  
  sub build_fish_env_declaration {
    my ($class, $name, $args) = @_;
    my $value = $class->_interpolate($args, '$%s', qr/[\\"'$ ]/, '\\%s');
    if (!defined $value) {
      return qq{set -e $name;\n};
    }
  
    # fish has special handling for PATH, CDPATH, and MANPATH.  They are always
    # treated as arrays, and joined with ; when storing the environment.  Other
    # env vars can be arrays, but will be joined without a separator.  We only
    # really care about PATH, but might as well make this routine more general.
    if ($name =~ /^(?:CD|MAN)?PATH$/) {
      $value =~ s/$_path_sep/ /g;
      my $silent = $name =~ /^(?:CD)?PATH$/ ? " ^"._devnull : '';
      return qq{set -x $name $value$silent;\n};
    }
  
    my $out = '';
    my $value_without = $value;
    if ($value_without =~ s/(?:^|$_path_sep)\$$name(?:$_path_sep|$)//g) {
      $out .= qq{set -q $name; and set -x $name $value;\n};
      $out .= qq{set -q $name; or };
    }
    $out .= qq{set -x $name $value_without;\n};
    $out;
  }
  
  sub _interpolate {
    my ($class, $args, $var_pat, $escape, $escape_pat) = @_;
    return
      unless defined $args;
    my @args = ref $args ? @$args : $args;
    return
      unless @args;
    my @vars = map { $$_ } grep { ref $_ eq 'SCALAR' } @args;
    my $string = join $_path_sep, map {
      ref $_ eq 'SCALAR' ? sprintf($var_pat, $$_) : do {
        s/($escape)/sprintf($escape_pat, $1)/ge; $_;
      };
    } @args;
    return wantarray ? ($string, \@vars) : $string;
  }
  
  sub pipeline;
  
  sub pipeline {
    my @methods = @_;
    my $last = pop(@methods);
    if (@methods) {
      \sub {
        my ($obj, @args) = @_;
        $obj->${pipeline @methods}(
          $obj->$last(@args)
        );
      };
    } else {
      \sub {
        shift->$last(@_);
      };
    }
  }
  
  sub resolve_path {
    my ($class, $path) = @_;
  
    $path = $class->${pipeline qw(
      resolve_relative_path
      resolve_home_path
      resolve_empty_path
    )}($path);
  
    $path;
  }
  
  sub resolve_empty_path {
    my ($class, $path) = @_;
    if (defined $path) {
      $path;
    } else {
      '~/perl5';
    }
  }
  
  sub resolve_home_path {
    my ($class, $path) = @_;
    $path =~ /^~([^\/]*)/ or return $path;
    my $user = $1;
    my $homedir = do {
      if (! length($user) && defined $ENV{HOME}) {
        $ENV{HOME};
      }
      else {
        require File::Glob;
        File::Glob::bsd_glob("~$user", File::Glob::GLOB_TILDE());
      }
    };
    unless (defined $homedir) {
      require Carp; require Carp::Heavy;
      Carp::croak(
        "Couldn't resolve homedir for "
        .(defined $user ? $user : 'current user')
      );
    }
    $path =~ s/^~[^\/]*/$homedir/;
    $path;
  }
  
  sub resolve_relative_path {
    my ($class, $path) = @_;
    _rel2abs($path);
  }
  
  sub ensure_dir_structure_for {
    my ($class, $path, $opts) = @_;
    $opts ||= {};
    my @dirs;
    foreach my $dir (
      $class->lib_paths_for($path),
      $class->install_base_bin_path($path),
    ) {
      my $d = $dir;
      while (!-d $d) {
        push @dirs, $d;
        require File::Basename;
        $d = File::Basename::dirname($d);
      }
    }
  
    warn "Attempting to create directory ${path}\n"
      if !$opts->{quiet} && @dirs;
  
    my %seen;
    foreach my $dir (reverse @dirs) {
      next
        if $seen{$dir}++;
  
      mkdir $dir
        or -d $dir
        or die "Unable to create $dir: $!"
    }
    return;
  }
  
  sub guess_shelltype {
    my $shellbin
      = defined $ENV{SHELL} && length $ENV{SHELL}
        ? ($ENV{SHELL} =~ /([\w.]+)$/)[-1]
      : ( $^O eq 'MSWin32' && exists $ENV{'!EXITCODE'} )
        ? 'bash'
      : ( $^O eq 'MSWin32' && $ENV{PROMPT} && $ENV{COMSPEC} )
        ? ($ENV{COMSPEC} =~ /([\w.]+)$/)[-1]
      : ( $^O eq 'MSWin32' && !$ENV{PROMPT} )
        ? 'powershell.exe'
      : 'sh';
  
    for ($shellbin) {
      return
          /csh$/                   ? 'csh'
        : /fish$/                  ? 'fish'
        : /command(?:\.com)?$/i    ? 'cmd'
        : /cmd(?:\.exe)?$/i        ? 'cmd'
        : /4nt(?:\.exe)?$/i        ? 'cmd'
        : /powershell(?:\.exe)?$/i ? 'powershell'
                                   : 'bourne';
    }
  }
  
  1;
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  local::lib - create and use a local lib/ for perl modules with PERL5LIB
  
  =head1 SYNOPSIS
  
  In code -
  
    use local::lib; # sets up a local lib at ~/perl5
  
    use local::lib '~/foo'; # same, but ~/foo
  
    # Or...
    use FindBin;
    use local::lib "$FindBin::Bin/../support";  # app-local support library
  
  From the shell -
  
    # Install LWP and its missing dependencies to the '~/perl5' directory
    perl -MCPAN -Mlocal::lib -e 'CPAN::install(LWP)'
  
    # Just print out useful shell commands
    $ perl -Mlocal::lib
    PERL_MB_OPT='--install_base /home/username/perl5'; export PERL_MB_OPT;
    PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'; export PERL_MM_OPT;
    PERL5LIB="/home/username/perl5/lib/perl5"; export PERL5LIB;
    PATH="/home/username/perl5/bin:$PATH"; export PATH;
    PERL_LOCAL_LIB_ROOT="/home/usename/perl5:$PERL_LOCAL_LIB_ROOT"; export PERL_LOCAL_LIB_ROOT;
  
  From a F<.bash_profile> or F<.bashrc> file -
  
    eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"
  
  =head2 The bootstrapping technique
  
  A typical way to install local::lib is using what is known as the
  "bootstrapping" technique.  You would do this if your system administrator
  hasn't already installed local::lib.  In this case, you'll need to install
  local::lib in your home directory.
  
  Even if you do have administrative privileges, you will still want to set up your
  environment variables, as discussed in step 4. Without this, you would still
  install the modules into the system CPAN installation and also your Perl scripts
  will not use the lib/ path you bootstrapped with local::lib.
  
  By default local::lib installs itself and the CPAN modules into ~/perl5.
  
  Windows users must also see L</Differences when using this module under Win32>.
  
  =over 4
  
  =item 1.
  
  Download and unpack the local::lib tarball from CPAN (search for "Download"
  on the CPAN page about local::lib).  Do this as an ordinary user, not as root
  or administrator.  Unpack the file in your home directory or in any other
  convenient location.
  
  =item 2.
  
  Run this:
  
    perl Makefile.PL --bootstrap
  
  If the system asks you whether it should automatically configure as much
  as possible, you would typically answer yes.
  
  In order to install local::lib into a directory other than the default, you need
  to specify the name of the directory when you call bootstrap, as follows:
  
    perl Makefile.PL --bootstrap=~/foo
  
  =item 3.
  
  Run this: (local::lib assumes you have make installed on your system)
  
    make test && make install
  
  =item 4.
  
  Now we need to setup the appropriate environment variables, so that Perl
  starts using our newly generated lib/ directory. If you are using bash or
  any other Bourne shells, you can add this to your shell startup script this
  way:
  
    echo 'eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"' >>~/.bashrc
  
  If you are using C shell, you can do this as follows:
  
    /bin/csh
    echo $SHELL
    /bin/csh
    echo 'eval `perl -I$HOME/perl5/lib/perl5 -Mlocal::lib`' >> ~/.cshrc
  
  If you passed to bootstrap a directory other than default, you also need to
  give that as import parameter to the call of the local::lib module like this
  way:
  
    echo 'eval "$(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)"' >>~/.bashrc
  
  After writing your shell configuration file, be sure to re-read it to get the
  changed settings into your current shell's environment. Bourne shells use
  C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>.
  
  =back
  
  If you're on a slower machine, or are operating under draconian disk space
  limitations, you can disable the automatic generation of manpages from POD when
  installing modules by using the C<--no-manpages> argument when bootstrapping:
  
    perl Makefile.PL --bootstrap --no-manpages
  
  To avoid doing several bootstrap for several Perl module environments on the
  same account, for example if you use it for several different deployed
  applications independently, you can use one bootstrapped local::lib
  installation to install modules in different directories directly this way:
  
    cd ~/mydir1
    perl -Mlocal::lib=./
    eval $(perl -Mlocal::lib=./)  ### To set the environment for this shell alone
    printenv                      ### You will see that ~/mydir1 is in the PERL5LIB
    perl -MCPAN -e install ...    ### whatever modules you want
    cd ../mydir2
    ... REPEAT ...
  
  If you use F<.bashrc> to activate a local::lib automatically, the local::lib
  will be re-enabled in any sub-shells used, overriding adjustments you may have
  made in the parent shell.  To avoid this, you can initialize the local::lib in
  F<.bash_profile> rather than F<.bashrc>, or protect the local::lib invocation
  with a C<$SHLVL> check:
  
    [ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"
  
  If you are working with several C<local::lib> environments, you may want to
  remove some of them from the current environment without disturbing the others.
  You can deactivate one environment like this (using bourne sh):
  
    eval $(perl -Mlocal::lib=--deactivate,~/path)
  
  which will generate and run the commands needed to remove C<~/path> from your
  various search paths. Whichever environment was B<activated most recently> will
  remain the target for module installations. That is, if you activate
  C<~/path_A> and then you activate C<~/path_B>, new modules you install will go
  in C<~/path_B>. If you deactivate C<~/path_B> then modules will be installed
  into C<~/pathA> -- but if you deactivate C<~/path_A> then they will still be
  installed in C<~/pathB> because pathB was activated later.
  
  You can also ask C<local::lib> to clean itself completely out of the current
  shell's environment with the C<--deactivate-all> option.
  For multiple environments for multiple apps you may need to include a modified
  version of the C<< use FindBin >> instructions in the "In code" sample above.
  If you did something like the above, you have a set of Perl modules at C<<
  ~/mydir1/lib >>. If you have a script at C<< ~/mydir1/scripts/myscript.pl >>,
  you need to tell it where to find the modules you installed for it at C<<
  ~/mydir1/lib >>.
  
  In C<< ~/mydir1/scripts/myscript.pl >>:
  
    use strict;
    use warnings;
    use local::lib "$FindBin::Bin/..";  ### points to ~/mydir1 and local::lib finds lib
    use lib "$FindBin::Bin/../lib";     ### points to ~/mydir1/lib
  
  Put this before any BEGIN { ... } blocks that require the modules you installed.
  
  =head2 Differences when using this module under Win32
  
  To set up the proper environment variables for your current session of
  C<CMD.exe>, you can use this:
  
    C:\>perl -Mlocal::lib
    set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5
    set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5
    set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5
    set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH%
  
    ### To set the environment for this shell alone
    C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\tmp.bat
    ### instead of $(perl -Mlocal::lib=./)
  
  If you want the environment entries to persist, you'll need to add them to the
  Control Panel's System applet yourself or use L<App::local::lib::Win32Helper>.
  
  The "~" is translated to the user's profile directory (the directory named for
  the user under "Documents and Settings" (Windows XP or earlier) or "Users"
  (Windows Vista or later)) unless $ENV{HOME} exists. After that, the home
  directory is translated to a short name (which means the directory must exist)
  and the subdirectories are created.
  
  =head3 PowerShell
  
  local::lib also supports PowerShell, and can be used with the
  C<Invoke-Expression> cmdlet.
  
    Invoke-Expression "$(perl -Mlocal::lib)"
  
  =head1 RATIONALE
  
  The version of a Perl package on your machine is not always the version you
  need.  Obviously, the best thing to do would be to update to the version you
  need.  However, you might be in a situation where you're prevented from doing
  this.  Perhaps you don't have system administrator privileges; or perhaps you
  are using a package management system such as Debian, and nobody has yet gotten
  around to packaging up the version you need.
  
  local::lib solves this problem by allowing you to create your own directory of
  Perl packages downloaded from CPAN (in a multi-user system, this would typically
  be within your own home directory).  The existing system Perl installation is
  not affected; you simply invoke Perl with special options so that Perl uses the
  packages in your own local package directory rather than the system packages.
  local::lib arranges things so that your locally installed version of the Perl
  packages takes precedence over the system installation.
  
  If you are using a package management system (such as Debian), you don't need to
  worry about Debian and CPAN stepping on each other's toes.  Your local version
  of the packages will be written to an entirely separate directory from those
  installed by Debian.
  
  =head1 DESCRIPTION
  
  This module provides a quick, convenient way of bootstrapping a user-local Perl
  module library located within the user's home directory. It also constructs and
  prints out for the user the list of environment variables using the syntax
  appropriate for the user's current shell (as specified by the C<SHELL>
  environment variable), suitable for directly adding to one's shell
  configuration file.
  
  More generally, local::lib allows for the bootstrapping and usage of a
  directory containing Perl modules outside of Perl's C<@INC>. This makes it
  easier to ship an application with an app-specific copy of a Perl module, or
  collection of modules. Useful in cases like when an upstream maintainer hasn't
  applied a patch to a module of theirs that you need for your application.
  
  On import, local::lib sets the following environment variables to appropriate
  values:
  
  =over 4
  
  =item PERL_MB_OPT
  
  =item PERL_MM_OPT
  
  =item PERL5LIB
  
  =item PATH
  
  =item PERL_LOCAL_LIB_ROOT
  
  =back
  
  When possible, these will be appended to instead of overwritten entirely.
  
  These values are then available for reference by any code after import.
  
  =head1 CREATING A SELF-CONTAINED SET OF MODULES
  
  See L<lib::core::only> for one way to do this - but note that
  there are a number of caveats, and the best approach is always to perform a
  build against a clean perl (i.e. site and vendor as close to empty as possible).
  
  =head1 IMPORT OPTIONS
  
  Options are values that can be passed to the C<local::lib> import besides the
  directory to use. They are specified as C<use local::lib '--option'[, path];>
  or C<perl -Mlocal::lib=--option[,path]>.
  
  =head2 --deactivate
  
  Remove the chosen path (or the default path) from the module search paths if it
  was added by C<local::lib>, instead of adding it.
  
  =head2 --deactivate-all
  
  Remove all directories that were added to search paths by C<local::lib> from the
  search paths.
  
  =head2 --shelltype
  
  Specify the shell type to use for output.  By default, the shell will be
  detected based on the environment.  Should be one of: C<bourne>, C<csh>,
  C<cmd>, or C<powershell>.
  
  =head2 --no-create
  
  Prevents C<local::lib> from creating directories when activating dirs.  This is
  likely to cause issues on Win32 systems.
  
  =head1 CLASS METHODS
  
  =head2 ensure_dir_structure_for
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: None
  
  =back
  
  Attempts to create a local::lib directory, including subdirectories and all
  required parent directories. Throws an exception on failure.
  
  =head2 print_environment_vars_for
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: None
  
  =back
  
  Prints to standard output the variables listed above, properly set to use the
  given path as the base directory.
  
  =head2 build_environment_vars_for
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: %environment_vars
  
  =back
  
  Returns a hash with the variables listed above, properly set to use the
  given path as the base directory.
  
  =head2 setup_env_hash_for
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: None
  
  =back
  
  Constructs the C<%ENV> keys for the given path, by calling
  L</build_environment_vars_for>.
  
  =head2 active_paths
  
  =over 4
  
  =item Arguments: None
  
  =item Return value: @paths
  
  =back
  
  Returns a list of active C<local::lib> paths, according to the
  C<PERL_LOCAL_LIB_ROOT> environment variable and verified against
  what is really in C<@INC>.
  
  =head2 install_base_perl_path
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $install_base_perl_path
  
  =back
  
  Returns a path describing where to install the Perl modules for this local
  library installation. Appends the directories C<lib> and C<perl5> to the given
  path.
  
  =head2 lib_paths_for
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: @lib_paths
  
  =back
  
  Returns the list of paths perl will search for libraries, given a base path.
  This includes the base path itself, the architecture specific subdirectory, and
  perl version specific subdirectories.  These paths may not all exist.
  
  =head2 install_base_bin_path
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $install_base_bin_path
  
  =back
  
  Returns a path describing where to install the executable programs for this
  local library installation. Appends the directory C<bin> to the given path.
  
  =head2 installer_options_for
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: %installer_env_vars
  
  =back
  
  Returns a hash of environment variables that should be set to cause
  installation into the given path.
  
  =head2 resolve_empty_path
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $base_path
  
  =back
  
  Builds and returns the base path into which to set up the local module
  installation. Defaults to C<~/perl5>.
  
  =head2 resolve_home_path
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $home_path
  
  =back
  
  Attempts to find the user's home directory. If installed, uses C<File::HomeDir>
  for this purpose. If no definite answer is available, throws an exception.
  
  =head2 resolve_relative_path
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $absolute_path
  
  =back
  
  Translates the given path into an absolute path.
  
  =head2 resolve_path
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $absolute_path
  
  =back
  
  Calls the following in a pipeline, passing the result from the previous to the
  next, in an attempt to find where to configure the environment for a local
  library installation: L</resolve_empty_path>, L</resolve_home_path>,
  L</resolve_relative_path>. Passes the given path argument to
  L</resolve_empty_path> which then returns a result that is passed to
  L</resolve_home_path>, which then has its result passed to
  L</resolve_relative_path>. The result of this final call is returned from
  L</resolve_path>.
  
  =head1 OBJECT INTERFACE
  
  =head2 new
  
  =over 4
  
  =item Arguments: %attributes
  
  =item Return value: $local_lib
  
  =back
  
  Constructs a new C<local::lib> object, representing the current state of
  C<@INC> and the relevant environment variables.
  
  =head1 ATTRIBUTES
  
  =head2 roots
  
  An arrayref representing active C<local::lib> directories.
  
  =head2 inc
  
  An arrayref representing C<@INC>.
  
  =head2 libs
  
  An arrayref representing the PERL5LIB environment variable.
  
  =head2 bins
  
  An arrayref representing the PATH environment variable.
  
  =head2 extra
  
  A hashref of extra environment variables (e.g. C<PERL_MM_OPT> and
  C<PERL_MB_OPT>)
  
  =head2 no_create
  
  If set, C<local::lib> will not try to create directories when activating them.
  
  =head1 OBJECT METHODS
  
  =head2 clone
  
  =over 4
  
  =item Arguments: %attributes
  
  =item Return value: $local_lib
  
  =back
  
  Constructs a new C<local::lib> object based on the existing one, overriding the
  specified attributes.
  
  =head2 activate
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $new_local_lib
  
  =back
  
  Constructs a new instance with the specified path active.
  
  =head2 deactivate
  
  =over 4
  
  =item Arguments: $path
  
  =item Return value: $new_local_lib
  
  =back
  
  Constructs a new instance with the specified path deactivated.
  
  =head2 deactivate_all
  
  =over 4
  
  =item Arguments: None
  
  =item Return value: $new_local_lib
  
  =back
  
  Constructs a new instance with all C<local::lib> directories deactivated.
  
  =head2 environment_vars_string
  
  =over 4
  
  =item Arguments: [ $shelltype ]
  
  =item Return value: $shell_env_string
  
  =back
  
  Returns a string to set up the C<local::lib>, meant to be run by a shell.
  
  =head2 build_environment_vars
  
  =over 4
  
  =item Arguments: None
  
  =item Return value: %environment_vars
  
  =back
  
  Returns a hash with the variables listed above, properly set to use the
  given path as the base directory.
  
  =head2 setup_env_hash
  
  =over 4
  
  =item Arguments: None
  
  =item Return value: None
  
  =back
  
  Constructs the C<%ENV> keys for the given path, by calling
  L</build_environment_vars>.
  
  =head2 setup_local_lib
  
  Constructs the C<%ENV> hash using L</setup_env_hash>, and set up C<@INC>.
  
  =head1 A WARNING ABOUT UNINST=1
  
  Be careful about using local::lib in combination with "make install UNINST=1".
  The idea of this feature is that will uninstall an old version of a module
  before installing a new one. However it lacks a safety check that the old
  version and the new version will go in the same directory. Used in combination
  with local::lib, you can potentially delete a globally accessible version of a
  module while installing the new version in a local place. Only combine "make
  install UNINST=1" and local::lib if you understand these possible consequences.
  
  =head1 LIMITATIONS
  
  =over 4
  
  =item * Directory names with spaces in them are not well supported by the perl
  toolchain and the programs it uses.  Pure-perl distributions should support
  spaces, but problems are more likely with dists that require compilation. A
  workaround you can do is moving your local::lib to a directory with spaces
  B<after> you installed all modules inside your local::lib bootstrap. But be
  aware that you can't update or install CPAN modules after the move.
  
  =item * Rather basic shell detection. Right now anything with csh in its name is
  assumed to be a C shell or something compatible, and everything else is assumed
  to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is
  not set, a Bourne-compatible shell is assumed.
  
  =item * Kills any existing PERL_MM_OPT or PERL_MB_OPT.
  
  =item * Should probably auto-fixup CPAN config if not already done.
  
  =item * On VMS and MacOS Classic (pre-OS X), local::lib loads L<File::Spec>.
  This means any L<File::Spec> version installed in the local::lib will be
  ignored by scripts using local::lib.  A workaround for this is using
  C<use lib "$local_lib/lib/perl5";> instead of using C<local::lib> directly.
  
  =item * Conflicts with L<ExtUtils::MakeMaker>'s C<PREFIX> option.
  C<local::lib> uses the C<INSTALL_BASE> option, as it has more predictable and
  sane behavior.  If something attempts to use the C<PREFIX> option when running
  a F<Makefile.PL>, L<ExtUtils::MakeMaker> will refuse to run, as the two
  options conflict.  This can be worked around by temporarily unsetting the
  C<PERL_MM_OPT> environment variable.
  
  =item * Conflicts with L<Module::Build>'s C<--prefix> option.  Similar to the
  previous limitation, but any C<--prefix> option specified will be ignored.
  This can be worked around by temporarily unsetting the C<PERL_MB_OPT>
  environment variable.
  
  =back
  
  Patches very much welcome for any of the above.
  
  =over 4
  
  =item * On Win32 systems, does not have a way to write the created environment
  variables to the registry, so that they can persist through a reboot.
  
  =back
  
  =head1 TROUBLESHOOTING
  
  If you've configured local::lib to install CPAN modules somewhere in to your
  home directory, and at some point later you try to install a module with C<cpan
  -i Foo::Bar>, but it fails with an error like: C<Warning: You do not have
  permissions to install into /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux at
  /usr/lib64/perl5/5.8.8/Foo/Bar.pm> and buried within the install log is an
  error saying C<'INSTALL_BASE' is not a known MakeMaker parameter name>, then
  you've somehow lost your updated ExtUtils::MakeMaker module.
  
  To remedy this situation, rerun the bootstrapping procedure documented above.
  
  Then, run C<rm -r ~/.cpan/build/Foo-Bar*>
  
  Finally, re-run C<cpan -i Foo::Bar> and it should install without problems.
  
  =head1 ENVIRONMENT
  
  =over 4
  
  =item SHELL
  
  =item COMSPEC
  
  local::lib looks at the user's C<SHELL> environment variable when printing out
  commands to add to the shell configuration file.
  
  On Win32 systems, C<COMSPEC> is also examined.
  
  =back
  
  =head1 SEE ALSO
  
  =over 4
  
  =item * L<Perl Advent article, 2011|http://perladvent.org/2011/2011-12-01.html>
  
  =back
  
  =head1 SUPPORT
  
  IRC:
  
      Join #toolchain on irc.perl.org.
  
  =head1 AUTHOR
  
  Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/
  
  auto_install fixes kindly sponsored by http://www.takkle.com/
  
  =head1 CONTRIBUTORS
  
  Patches to correctly output commands for csh style shells, as well as some
  documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>.
  
  Doc patches for a custom local::lib directory, more cleanups in the english
  documentation and a L<german documentation|POD2::DE::local::lib> contributed by
  Torsten Raudssus <torsten@raudssus.de>.
  
  Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring
  things will install properly, submitted a fix for the bug causing problems with
  writing Makefiles during bootstrapping, contributed an example program, and
  submitted yet another fix to ensure that local::lib can install and bootstrap
  properly. Many, many thanks!
  
  pattern of Freenode IRC contributed the beginnings of the Troubleshooting
  section. Many thanks!
  
  Patch to add Win32 support contributed by Curtis Jewell <csjewell@cpan.org>.
  
  Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced
  by a patch from Marco Emilio Poleggi.
  
  Mark Stosberg <mark@summersault.com> provided the code for the now deleted
  '--self-contained' option.
  
  Documentation patches to make win32 usage clearer by
  David Mertens <dcmertens.perl@gmail.com> (run4flat).
  
  Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc
  patches contributed by Breno G. de Oliveira <garu@cpan.org>.
  
  Improvements to stacking multiple local::lib dirs and removing them from the
  environment later on contributed by Andrew Rodland <arodland@cpan.org>.
  
  Patch for Carp version mismatch contributed by Hakim Cassimally
  <osfameron@cpan.org>.
  
  Rewrite of internals and numerous bug fixes and added features contributed by
  Graham Knop <haarg@haarg.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 2007 - 2013 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as
  listed above.
  
  =head1 LICENSE
  
  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
LOCAL_LIB

$fatpacked{"x86_64-linux-gnu-thread-multi/Socket.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_SOCKET';
  package Socket;
  
  use strict;
  { use 5.006001; }
  
  our $VERSION = '2.029';
  
  =head1 NAME
  
  C<Socket> - networking constants and support functions
  
  =head1 SYNOPSIS
  
  C<Socket> a low-level module used by, among other things, the L<IO::Socket>
  family of modules. The following examples demonstrate some low-level uses but
  a practical program would likely use the higher-level API provided by
  C<IO::Socket> or similar instead.
  
   use Socket qw(PF_INET SOCK_STREAM pack_sockaddr_in inet_aton);
  
   socket(my $socket, PF_INET, SOCK_STREAM, 0)
       or die "socket: $!";
  
   my $port = getservbyname "echo", "tcp";
   connect($socket, pack_sockaddr_in($port, inet_aton("localhost")))
       or die "connect: $!";
  
   print $socket "Hello, world!\n";
   print <$socket>;
  
  See also the L</EXAMPLES> section.
  
  =head1 DESCRIPTION
  
  This module provides a variety of constants, structure manipulators and other
  functions related to socket-based networking. The values and functions
  provided are useful when used in conjunction with Perl core functions such as
  socket(), setsockopt() and bind(). It also provides several other support
  functions, mostly for dealing with conversions of network addresses between
  human-readable and native binary forms, and for hostname resolver operations.
  
  Some constants and functions are exported by default by this module; but for
  backward-compatibility any recently-added symbols are not exported by default
  and must be requested explicitly. When an import list is provided to the
  C<use Socket> line, the default exports are not automatically imported. It is
  therefore best practice to always to explicitly list all the symbols required.
  
  Also, some common socket "newline" constants are provided: the constants
  C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and C<$CRLF>, which map
  to C<\015>, C<\012>, and C<\015\012>. If you do not want to use the literal
  characters in your programs, then use the constants provided here. They are
  not exported by default, but can be imported individually, and with the
  C<:crlf> export tag:
  
   use Socket qw(:DEFAULT :crlf);
  
   $sock->print("GET / HTTP/1.0$CRLF");
  
  The entire getaddrinfo() subsystem can be exported using the tag C<:addrinfo>;
  this exports the getaddrinfo() and getnameinfo() functions, and all the
  C<AI_*>, C<NI_*>, C<NIx_*> and C<EAI_*> constants.
  
  =cut
  
  =head1 CONSTANTS
  
  In each of the following groups, there may be many more constants provided
  than just the ones given as examples in the section heading. If the heading
  ends C<...> then this means there are likely more; the exact constants
  provided will depend on the OS and headers found at compile-time.
  
  =cut
  
  =head2 PF_INET, PF_INET6, PF_UNIX, ...
  
  Protocol family constants to use as the first argument to socket() or the
  value of the C<SO_DOMAIN> or C<SO_FAMILY> socket option.
  
  =head2 AF_INET, AF_INET6, AF_UNIX, ...
  
  Address family constants used by the socket address structures, to pass to
  such functions as inet_pton() or getaddrinfo(), or are returned by such
  functions as sockaddr_family().
  
  =head2 SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, ...
  
  Socket type constants to use as the second argument to socket(), or the value
  of the C<SO_TYPE> socket option.
  
  =head2 SOCK_NONBLOCK. SOCK_CLOEXEC
  
  Linux-specific shortcuts to specify the C<O_NONBLOCK> and C<FD_CLOEXEC> flags
  during a C<socket(2)> call.
  
   socket( my $sockh, PF_INET, SOCK_DGRAM|SOCK_NONBLOCK, 0 )
  
  =head2 SOL_SOCKET
  
  Socket option level constant for setsockopt() and getsockopt().
  
  =head2 SO_ACCEPTCONN, SO_BROADCAST, SO_ERROR, ...
  
  Socket option name constants for setsockopt() and getsockopt() at the
  C<SOL_SOCKET> level.
  
  =head2 IP_OPTIONS, IP_TOS, IP_TTL, ...
  
  Socket option name constants for IPv4 socket options at the C<IPPROTO_IP>
  level.
  
  =head2 IP_PMTUDISC_WANT, IP_PMTUDISC_DONT, ...
  
  Socket option value contants for C<IP_MTU_DISCOVER> socket option.
  
  =head2 IPTOS_LOWDELAY, IPTOS_THROUGHPUT, IPTOS_RELIABILITY, ...
  
  Socket option value constants for C<IP_TOS> socket option.
  
  =head2 MSG_BCAST, MSG_OOB, MSG_TRUNC, ...
  
  Message flag constants for send() and recv().
  
  =head2 SHUT_RD, SHUT_RDWR, SHUT_WR
  
  Direction constants for shutdown().
  
  =head2 INADDR_ANY, INADDR_BROADCAST, INADDR_LOOPBACK, INADDR_NONE
  
  Constants giving the special C<AF_INET> addresses for wildcard, broadcast,
  local loopback, and invalid addresses.
  
  Normally equivalent to inet_aton('0.0.0.0'), inet_aton('255.255.255.255'),
  inet_aton('localhost') and inet_aton('255.255.255.255') respectively.
  
  =head2 IPPROTO_IP, IPPROTO_IPV6, IPPROTO_TCP, ...
  
  IP protocol constants to use as the third argument to socket(), the level
  argument to getsockopt() or setsockopt(), or the value of the C<SO_PROTOCOL>
  socket option.
  
  =head2 TCP_CORK, TCP_KEEPALIVE, TCP_NODELAY, ...
  
  Socket option name constants for TCP socket options at the C<IPPROTO_TCP>
  level.
  
  =head2 IN6ADDR_ANY, IN6ADDR_LOOPBACK
  
  Constants giving the special C<AF_INET6> addresses for wildcard and local
  loopback.
  
  Normally equivalent to inet_pton(AF_INET6, "::") and
  inet_pton(AF_INET6, "::1") respectively.
  
  =head2 IPV6_ADD_MEMBERSHIP, IPV6_MTU, IPV6_V6ONLY, ...
  
  Socket option name constants for IPv6 socket options at the C<IPPROTO_IPV6>
  level.
  
  =cut
  
  # Still undocumented: SCM_*, SOMAXCONN, IOV_MAX, UIO_MAXIOV
  
  =head1 STRUCTURE MANIPULATORS
  
  The following functions convert between lists of Perl values and packed binary
  strings representing structures.
  
  =cut
  
  =head2 $family = sockaddr_family $sockaddr
  
  Takes a packed socket address (as returned by pack_sockaddr_in(),
  pack_sockaddr_un() or the perl builtin functions getsockname() and
  getpeername()). Returns the address family tag. This will be one of the
  C<AF_*> constants, such as C<AF_INET> for a C<sockaddr_in> addresses or
  C<AF_UNIX> for a C<sockaddr_un>. It can be used to figure out what unpack to
  use for a sockaddr of unknown type.
  
  =head2 $sockaddr = pack_sockaddr_in $port, $ip_address
  
  Takes two arguments, a port number and an opaque string (as returned by
  inet_aton(), or a v-string). Returns the C<sockaddr_in> structure with those
  arguments packed in and C<AF_INET> filled in. For Internet domain sockets,
  this structure is normally what you need for the arguments in bind(),
  connect(), and send().
  
  An undefined $port argument is taken as zero; an undefined $ip_address is
  considered a fatal error.
  
  =head2 ($port, $ip_address) = unpack_sockaddr_in $sockaddr
  
  Takes a C<sockaddr_in> structure (as returned by pack_sockaddr_in(),
  getpeername() or recv()). Returns a list of two elements: the port and an
  opaque string representing the IP address (you can use inet_ntoa() to convert
  the address to the four-dotted numeric format). Will croak if the structure
  does not represent an C<AF_INET> address.
  
  In scalar context will return just the IP address.
  
  =head2 $sockaddr = sockaddr_in $port, $ip_address
  
  =head2 ($port, $ip_address) = sockaddr_in $sockaddr
  
  A wrapper of pack_sockaddr_in() or unpack_sockaddr_in(). In list context,
  unpacks its argument and returns a list consisting of the port and IP address.
  In scalar context, packs its port and IP address arguments as a C<sockaddr_in>
  and returns it.
  
  Provided largely for legacy compatibility; it is better to use
  pack_sockaddr_in() or unpack_sockaddr_in() explicitly.
  
  =head2 $sockaddr = pack_sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]]
  
  Takes two to four arguments, a port number, an opaque string (as returned by
  inet_pton()), optionally a scope ID number, and optionally a flow label
  number. Returns the C<sockaddr_in6> structure with those arguments packed in
  and C<AF_INET6> filled in. IPv6 equivalent of pack_sockaddr_in().
  
  An undefined $port argument is taken as zero; an undefined $ip6_address is
  considered a fatal error.
  
  =head2 ($port, $ip6_address, $scope_id, $flowinfo) = unpack_sockaddr_in6 $sockaddr
  
  Takes a C<sockaddr_in6> structure. Returns a list of four elements: the port
  number, an opaque string representing the IPv6 address, the scope ID, and the
  flow label. (You can use inet_ntop() to convert the address to the usual
  string format). Will croak if the structure does not represent an C<AF_INET6>
  address.
  
  In scalar context will return just the IP address.
  
  =head2 $sockaddr = sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]]
  
  =head2 ($port, $ip6_address, $scope_id, $flowinfo) = sockaddr_in6 $sockaddr
  
  A wrapper of pack_sockaddr_in6() or unpack_sockaddr_in6(). In list context,
  unpacks its argument according to unpack_sockaddr_in6(). In scalar context,
  packs its arguments according to pack_sockaddr_in6().
  
  Provided largely for legacy compatibility; it is better to use
  pack_sockaddr_in6() or unpack_sockaddr_in6() explicitly.
  
  =head2 $sockaddr = pack_sockaddr_un $path
  
  Takes one argument, a pathname. Returns the C<sockaddr_un> structure with that
  path packed in with C<AF_UNIX> filled in. For C<PF_UNIX> sockets, this
  structure is normally what you need for the arguments in bind(), connect(),
  and send().
  
  =head2 ($path) = unpack_sockaddr_un $sockaddr
  
  Takes a C<sockaddr_un> structure (as returned by pack_sockaddr_un(),
  getpeername() or recv()). Returns a list of one element: the pathname. Will
  croak if the structure does not represent an C<AF_UNIX> address.
  
  =head2 $sockaddr = sockaddr_un $path
  
  =head2 ($path) = sockaddr_un $sockaddr
  
  A wrapper of pack_sockaddr_un() or unpack_sockaddr_un(). In a list context,
  unpacks its argument and returns a list consisting of the pathname. In a
  scalar context, packs its pathname as a C<sockaddr_un> and returns it.
  
  Provided largely for legacy compatibility; it is better to use
  pack_sockaddr_un() or unpack_sockaddr_un() explicitly.
  
  These are only supported if your system has E<lt>F<sys/un.h>E<gt>.
  
  =head2 $ip_mreq = pack_ip_mreq $multiaddr, $interface
  
  Takes an IPv4 multicast address and optionally an interface address (or
  C<INADDR_ANY>). Returns the C<ip_mreq> structure with those arguments packed
  in. Suitable for use with the C<IP_ADD_MEMBERSHIP> and C<IP_DROP_MEMBERSHIP>
  sockopts.
  
  =head2 ($multiaddr, $interface) = unpack_ip_mreq $ip_mreq
  
  Takes an C<ip_mreq> structure. Returns a list of two elements; the IPv4
  multicast address and interface address.
  
  =head2 $ip_mreq_source = pack_ip_mreq_source $multiaddr, $source, $interface
  
  Takes an IPv4 multicast address, source address, and optionally an interface
  address (or C<INADDR_ANY>). Returns the C<ip_mreq_source> structure with those
  arguments packed in. Suitable for use with the C<IP_ADD_SOURCE_MEMBERSHIP>
  and C<IP_DROP_SOURCE_MEMBERSHIP> sockopts.
  
  =head2 ($multiaddr, $source, $interface) = unpack_ip_mreq_source $ip_mreq
  
  Takes an C<ip_mreq_source> structure. Returns a list of three elements; the
  IPv4 multicast address, source address and interface address.
  
  =head2 $ipv6_mreq = pack_ipv6_mreq $multiaddr6, $ifindex
  
  Takes an IPv6 multicast address and an interface number. Returns the
  C<ipv6_mreq> structure with those arguments packed in. Suitable for use with
  the C<IPV6_ADD_MEMBERSHIP> and C<IPV6_DROP_MEMBERSHIP> sockopts.
  
  =head2 ($multiaddr6, $ifindex) = unpack_ipv6_mreq $ipv6_mreq
  
  Takes an C<ipv6_mreq> structure. Returns a list of two elements; the IPv6
  address and an interface number.
  
  =cut
  
  =head1 FUNCTIONS
  
  =cut
  
  =head2 $ip_address = inet_aton $string
  
  Takes a string giving the name of a host, or a textual representation of an IP
  address and translates that to an packed binary address structure suitable to
  pass to pack_sockaddr_in(). If passed a hostname that cannot be resolved,
  returns C<undef>. For multi-homed hosts (hosts with more than one address),
  the first address found is returned.
  
  For portability do not assume that the result of inet_aton() is 32 bits wide,
  in other words, that it would contain only the IPv4 address in network order.
  
  This IPv4-only function is provided largely for legacy reasons. Newly-written
  code should use getaddrinfo() or inet_pton() instead for IPv6 support.
  
  =head2 $string = inet_ntoa $ip_address
  
  Takes a packed binary address structure such as returned by
  unpack_sockaddr_in() (or a v-string representing the four octets of the IPv4
  address in network order) and translates it into a string of the form
  C<d.d.d.d> where the C<d>s are numbers less than 256 (the normal
  human-readable four dotted number notation for Internet addresses).
  
  This IPv4-only function is provided largely for legacy reasons. Newly-written
  code should use getnameinfo() or inet_ntop() instead for IPv6 support.
  
  =head2 $address = inet_pton $family, $string
  
  Takes an address family (such as C<AF_INET> or C<AF_INET6>) and a string
  containing a textual representation of an address in that family and
  translates that to an packed binary address structure.
  
  See also getaddrinfo() for a more powerful and flexible function to look up
  socket addresses given hostnames or textual addresses.
  
  =head2 $string = inet_ntop $family, $address
  
  Takes an address family and a packed binary address structure and translates
  it into a human-readable textual representation of the address; typically in
  C<d.d.d.d> form for C<AF_INET> or C<hhhh:hhhh::hhhh> form for C<AF_INET6>.
  
  See also getnameinfo() for a more powerful and flexible function to turn
  socket addresses into human-readable textual representations.
  
  =head2 ($err, @result) = getaddrinfo $host, $service, [$hints]
  
  Given both a hostname and service name, this function attempts to resolve the
  host name into a list of network addresses, and the service name into a
  protocol and port number, and then returns a list of address structures
  suitable to connect() to it.
  
  Given just a host name, this function attempts to resolve it to a list of
  network addresses, and then returns a list of address structures giving these
  addresses.
  
  Given just a service name, this function attempts to resolve it to a protocol
  and port number, and then returns a list of address structures that represent
  it suitable to bind() to. This use should be combined with the C<AI_PASSIVE>
  flag; see below.
  
  Given neither name, it generates an error.
  
  If present, $hints should be a reference to a hash, where the following keys
  are recognised:
  
  =over 4
  
  =item flags => INT
  
  A bitfield containing C<AI_*> constants; see below.
  
  =item family => INT
  
  Restrict to only generating addresses in this address family
  
  =item socktype => INT
  
  Restrict to only generating addresses of this socket type
  
  =item protocol => INT
  
  Restrict to only generating addresses for this protocol
  
  =back
  
  The return value will be a list; the first value being an error indication,
  followed by a list of address structures (if no error occurred).
  
  The error value will be a dualvar; comparable to the C<EAI_*> error constants,
  or printable as a human-readable error message string. If no error occurred it
  will be zero numerically and an empty string.
  
  Each value in the results list will be a hash reference containing the following
  fields:
  
  =over 4
  
  =item family => INT
  
  The address family (e.g. C<AF_INET>)
  
  =item socktype => INT
  
  The socket type (e.g. C<SOCK_STREAM>)
  
  =item protocol => INT
  
  The protocol (e.g. C<IPPROTO_TCP>)
  
  =item addr => STRING
  
  The address in a packed string (such as would be returned by
  pack_sockaddr_in())
  
  =item canonname => STRING
  
  The canonical name for the host if the C<AI_CANONNAME> flag was provided, or
  C<undef> otherwise. This field will only be present on the first returned
  address.
  
  =back
  
  The following flag constants are recognised in the $hints hash. Other flag
  constants may exist as provided by the OS.
  
  =over 4
  
  =item AI_PASSIVE
  
  Indicates that this resolution is for a local bind() for a passive (i.e.
  listening) socket, rather than an active (i.e. connecting) socket.
  
  =item AI_CANONNAME
  
  Indicates that the caller wishes the canonical hostname (C<canonname>) field
  of the result to be filled in.
  
  =item AI_NUMERICHOST
  
  Indicates that the caller will pass a numeric address, rather than a hostname,
  and that getaddrinfo() must not perform a resolve operation on this name. This
  flag will prevent a possibly-slow network lookup operation, and instead return
  an error if a hostname is passed.
  
  =back
  
  =head2 ($err, $hostname, $servicename) = getnameinfo $sockaddr, [$flags, [$xflags]]
  
  Given a packed socket address (such as from getsockname(), getpeername(), or
  returned by getaddrinfo() in a C<addr> field), returns the hostname and
  symbolic service name it represents. $flags may be a bitmask of C<NI_*>
  constants, or defaults to 0 if unspecified.
  
  The return value will be a list; the first value being an error condition,
  followed by the hostname and service name.
  
  The error value will be a dualvar; comparable to the C<EAI_*> error constants,
  or printable as a human-readable error message string. The host and service
  names will be plain strings.
  
  The following flag constants are recognised as $flags. Other flag constants may
  exist as provided by the OS.
  
  =over 4
  
  =item NI_NUMERICHOST
  
  Requests that a human-readable string representation of the numeric address be
  returned directly, rather than performing a name resolve operation that may
  convert it into a hostname. This will also avoid potentially-blocking network
  IO.
  
  =item NI_NUMERICSERV
  
  Requests that the port number be returned directly as a number representation
  rather than performing a name resolve operation that may convert it into a
  service name.
  
  =item NI_NAMEREQD
  
  If a name resolve operation fails to provide a name, then this flag will cause
  getnameinfo() to indicate an error, rather than returning the numeric
  representation as a human-readable string.
  
  =item NI_DGRAM
  
  Indicates that the socket address relates to a C<SOCK_DGRAM> socket, for the
  services whose name differs between TCP and UDP protocols.
  
  =back
  
  The following constants may be supplied as $xflags.
  
  =over 4
  
  =item NIx_NOHOST
  
  Indicates that the caller is not interested in the hostname of the result, so
  it does not have to be converted. C<undef> will be returned as the hostname.
  
  =item NIx_NOSERV
  
  Indicates that the caller is not interested in the service name of the result,
  so it does not have to be converted. C<undef> will be returned as the service
  name.
  
  =back
  
  =head1 getaddrinfo() / getnameinfo() ERROR CONSTANTS
  
  The following constants may be returned by getaddrinfo() or getnameinfo().
  Others may be provided by the OS.
  
  =over 4
  
  =item EAI_AGAIN
  
  A temporary failure occurred during name resolution. The operation may be
  successful if it is retried later.
  
  =item EAI_BADFLAGS
  
  The value of the C<flags> hint to getaddrinfo(), or the $flags parameter to
  getnameinfo() contains unrecognised flags.
  
  =item EAI_FAMILY
  
  The C<family> hint to getaddrinfo(), or the family of the socket address
  passed to getnameinfo() is not supported.
  
  =item EAI_NODATA
  
  The host name supplied to getaddrinfo() did not provide any usable address
  data.
  
  =item EAI_NONAME
  
  The host name supplied to getaddrinfo() does not exist, or the address
  supplied to getnameinfo() is not associated with a host name and the
  C<NI_NAMEREQD> flag was supplied.
  
  =item EAI_SERVICE
  
  The service name supplied to getaddrinfo() is not available for the socket
  type given in the $hints.
  
  =back
  
  =cut
  
  =head1 EXAMPLES
  
  =head2 Lookup for connect()
  
  The getaddrinfo() function converts a hostname and a service name into a list
  of structures, each containing a potential way to connect() to the named
  service on the named host.
  
   use IO::Socket;
   use Socket qw(SOCK_STREAM getaddrinfo);
  
   my %hints = (socktype => SOCK_STREAM);
   my ($err, @res) = getaddrinfo("localhost", "echo", \%hints);
   die "Cannot getaddrinfo - $err" if $err;
  
   my $sock;
  
   foreach my $ai (@res) {
       my $candidate = IO::Socket->new();
  
       $candidate->socket($ai->{family}, $ai->{socktype}, $ai->{protocol})
           or next;
  
       $candidate->connect($ai->{addr})
           or next;
  
       $sock = $candidate;
       last;
   }
  
   die "Cannot connect to localhost:echo" unless $sock;
  
   $sock->print("Hello, world!\n");
   print <$sock>;
  
  Because a list of potential candidates is returned, the C<while> loop tries
  each in turn until it finds one that succeeds both the socket() and connect()
  calls.
  
  This function performs the work of the legacy functions gethostbyname(),
  getservbyname(), inet_aton() and pack_sockaddr_in().
  
  In practice this logic is better performed by L<IO::Socket::IP>.
  
  =head2 Making a human-readable string out of an address
  
  The getnameinfo() function converts a socket address, such as returned by
  getsockname() or getpeername(), into a pair of human-readable strings
  representing the address and service name.
  
   use IO::Socket::IP;
   use Socket qw(getnameinfo);
  
   my $server = IO::Socket::IP->new(LocalPort => 12345, Listen => 1) or
       die "Cannot listen - $@";
  
   my $socket = $server->accept or die "accept: $!";
  
   my ($err, $hostname, $servicename) = getnameinfo($socket->peername);
   die "Cannot getnameinfo - $err" if $err;
  
   print "The peer is connected from $hostname\n";
  
  Since in this example only the hostname was used, the redundant conversion of
  the port number into a service name may be omitted by passing the
  C<NIx_NOSERV> flag.
  
   use Socket qw(getnameinfo NIx_NOSERV);
  
   my ($err, $hostname) = getnameinfo($socket->peername, 0, NIx_NOSERV);
  
  This function performs the work of the legacy functions unpack_sockaddr_in(),
  inet_ntoa(), gethostbyaddr() and getservbyport().
  
  In practice this logic is better performed by L<IO::Socket::IP>.
  
  =head2 Resolving hostnames into IP addresses
  
  To turn a hostname into a human-readable plain IP address use getaddrinfo()
  to turn the hostname into a list of socket structures, then getnameinfo() on
  each one to make it a readable IP address again.
  
   use Socket qw(:addrinfo SOCK_RAW);
  
   my ($err, @res) = getaddrinfo($hostname, "", {socktype => SOCK_RAW});
   die "Cannot getaddrinfo - $err" if $err;
  
   while( my $ai = shift @res ) {
       my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV);
       die "Cannot getnameinfo - $err" if $err;
  
       print "$ipaddr\n";
   }
  
  The C<socktype> hint to getaddrinfo() filters the results to only include one
  socket type and protocol. Without this most OSes return three combinations,
  for C<SOCK_STREAM>, C<SOCK_DGRAM> and C<SOCK_RAW>, resulting in triplicate
  output of addresses. The C<NI_NUMERICHOST> flag to getnameinfo() causes it to
  return a string-formatted plain IP address, rather than reverse resolving it
  back into a hostname.
  
  This combination performs the work of the legacy functions gethostbyname()
  and inet_ntoa().
  
  =head2 Accessing socket options
  
  The many C<SO_*> and other constants provide the socket option names for
  getsockopt() and setsockopt().
  
   use IO::Socket::INET;
   use Socket qw(SOL_SOCKET SO_RCVBUF IPPROTO_IP IP_TTL);
  
   my $socket = IO::Socket::INET->new(LocalPort => 0, Proto => 'udp')
       or die "Cannot create socket: $@";
  
   $socket->setsockopt(SOL_SOCKET, SO_RCVBUF, 64*1024) or
       die "setsockopt: $!";
  
   print "Receive buffer is ", $socket->getsockopt(SOL_SOCKET, SO_RCVBUF),
       " bytes\n";
  
   print "IP TTL is ", $socket->getsockopt(IPPROTO_IP, IP_TTL), "\n";
  
  As a convenience, L<IO::Socket>'s setsockopt() method will convert a number
  into a packed byte buffer, and getsockopt() will unpack a byte buffer of the
  correct size back into a number.
  
  =cut
  
  =head1 AUTHOR
  
  This module was originally maintained in Perl core by the Perl 5 Porters.
  
  It was extracted to dual-life on CPAN at version 1.95 by
  Paul Evans <leonerd@leonerd.org.uk>
  
  =cut
  
  use Carp;
  use warnings::register;
  
  require Exporter;
  require XSLoader;
  our @ISA = qw(Exporter);
  
  # <@Nicholas> you can't change @EXPORT without breaking the implicit API
  # Please put any new constants in @EXPORT_OK!
  
  # List re-ordered to match documentation above. Try to keep the ordering
  # consistent so it's easier to see which ones are or aren't documented.
  our @EXPORT = qw(
  	PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT
  	PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6
  	PF_ISO PF_KEY PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS PF_OSI
  	PF_OSINET PF_PUP PF_ROUTE PF_SNA PF_UNIX PF_UNSPEC PF_USER PF_WAN
  	PF_X25
  
  	AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF AF_DATAKIT
  	AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_INET6
  	AF_ISO AF_KEY AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS AF_OSI
  	AF_OSINET AF_PUP AF_ROUTE AF_SNA AF_UNIX AF_UNSPEC AF_USER AF_WAN
  	AF_X25
  
  	SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM
  
  	SOL_SOCKET
  
  	SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BROADCAST SO_CHAMELEON
  	SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER
  	SO_DONTROUTE SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE
  	SO_PASSCRED SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE
  	SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
  	SO_SECURITY_AUTHENTICATION SO_SECURITY_ENCRYPTION_NETWORK
  	SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO
  	SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE
  
  	IP_HDRINCL IP_OPTIONS IP_RECVOPTS IP_RECVRETOPTS IP_RETOPTS IP_TOS
  	IP_TTL
  
  	MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_CTRUNC MSG_DONTROUTE
  	MSG_DONTWAIT MSG_EOF MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FASTOPEN MSG_FIN
  	MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK MSG_PROXY MSG_RST
  	MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE
  
  	SHUT_RD SHUT_RDWR SHUT_WR
  
  	INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
  
  	SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP
  
  	SOMAXCONN
  
  	IOV_MAX
  	UIO_MAXIOV
  
  	sockaddr_family
  	pack_sockaddr_in  unpack_sockaddr_in  sockaddr_in
  	pack_sockaddr_in6 unpack_sockaddr_in6 sockaddr_in6
  	pack_sockaddr_un  unpack_sockaddr_un  sockaddr_un 
  
  	inet_aton inet_ntoa
  );
  
  # List re-ordered to match documentation above. Try to keep the ordering
  # consistent so it's easier to see which ones are or aren't documented.
  our @EXPORT_OK = qw(
  	CR LF CRLF $CR $LF $CRLF
  
  	SOCK_NONBLOCK SOCK_CLOEXEC
  
  	IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_BIND_ADDRESS_NO_PORT
  	IP_DROP_MEMBERSHIP IP_DROP_SOURCE_MEMBERSHIP IP_FREEBIND
  	IP_MULTICAST_ALL IP_MULTICAST_IF IP_MULTICAST_LOOP IP_MULTICAST_TTL
  	IP_MTU IP_MTU_DISCOVER IP_NODEFRAG IP_RECVERR IP_TRANSPARENT
  
  	IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_IGMP
  	IPPROTO_TCP IPPROTO_UDP IPPROTO_GRE IPPROTO_ESP IPPROTO_AH
  	IPPROTO_ICMPV6 IPPROTO_SCTP
  
  	IP_PMTUDISC_DO IP_PMTUDISC_DONT IP_PMTUDISC_PROBE IP_PMTUDISC_WANT
  
  	IPTOS_LOWDELAY IPTOS_THROUGHPUT IPTOS_RELIABILITY IPTOS_MINCOST
  
  	TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT
  	TCP_FASTOPEN TCP_INFO TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT
  	TCP_KEEPIDLE TCP_KEEPINTVL TCP_LINGER2 TCP_MAXRT TCP_MAXSEG
  	TCP_MD5SIG TCP_NODELAY TCP_NOOPT TCP_NOPUSH TCP_QUICKACK
  	TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT TCP_USER_TIMEOUT
  	TCP_WINDOW_CLAMP
  
  	IN6ADDR_ANY IN6ADDR_LOOPBACK
  
  	IPV6_ADDRFROM IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP
  	IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS
  	IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_RECVERR IPV6_ROUTER_ALERT
  	IPV6_UNICAST_HOPS IPV6_V6ONLY
  
  	SO_LOCK_FILTER SO_RCVBUFFORCE SO_SNDBUFFORCE
  
  	pack_ip_mreq unpack_ip_mreq pack_ip_mreq_source unpack_ip_mreq_source
  
  	pack_ipv6_mreq unpack_ipv6_mreq
  
  	inet_pton inet_ntop
  
  	getaddrinfo getnameinfo
  
  	AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN
  	AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST
  	AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED
  
  	NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES
  	NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV
  
  	NIx_NOHOST NIx_NOSERV
  
  	EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY
  	EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM
  );
  
  our %EXPORT_TAGS = (
      crlf     => [qw(CR LF CRLF $CR $LF $CRLF)],
      addrinfo => [qw(getaddrinfo getnameinfo), grep m/^(?:AI|NI|NIx|EAI)_/, @EXPORT_OK],
      all      => [@EXPORT, @EXPORT_OK],
  );
  
  BEGIN {
      sub CR   () {"\015"}
      sub LF   () {"\012"}
      sub CRLF () {"\015\012"}
  
      # These are not gni() constants; they're extensions for the perl API
      # The definitions in Socket.pm and Socket.xs must match
      sub NIx_NOHOST() {1 << 0}
      sub NIx_NOSERV() {1 << 1}
  }
  
  *CR   = \CR();
  *LF   = \LF();
  *CRLF = \CRLF();
  
  sub sockaddr_in {
      if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
  	my($af, $port, @quad) = @_;
  	warnings::warn "6-ARG sockaddr_in call is deprecated" 
  	    if warnings::enabled();
  	pack_sockaddr_in($port, inet_aton(join('.', @quad)));
      } elsif (wantarray) {
  	croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
          unpack_sockaddr_in(@_);
      } else {
  	croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
          pack_sockaddr_in(@_);
      }
  }
  
  sub sockaddr_in6 {
      if (wantarray) {
  	croak "usage:   (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1;
  	unpack_sockaddr_in6(@_);
      }
      else {
  	croak "usage:   sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4;
  	pack_sockaddr_in6(@_);
      }
  }
  
  sub sockaddr_un {
      if (wantarray) {
  	croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
          unpack_sockaddr_un(@_);
      } else {
  	croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
          pack_sockaddr_un(@_);
      }
  }
  
  XSLoader::load(__PACKAGE__, $VERSION);
  
  my %errstr;
  
  if( defined &getaddrinfo ) {
      # These are not part of the API, nothing uses them, and deleting them
      # reduces the size of %Socket:: by about 12K
      delete $Socket::{fake_getaddrinfo};
      delete $Socket::{fake_getnameinfo};
  } else {
      require Scalar::Util;
  
      *getaddrinfo = \&fake_getaddrinfo;
      *getnameinfo = \&fake_getnameinfo;
  
      # These numbers borrowed from GNU libc's implementation, but since
      # they're only used by our emulation, it doesn't matter if the real
      # platform's values differ
      my %constants = (
  	AI_PASSIVE     => 1,
  	AI_CANONNAME   => 2,
  	AI_NUMERICHOST => 4,
  	AI_V4MAPPED    => 8,
  	AI_ALL         => 16,
  	AI_ADDRCONFIG  => 32,
  	# RFC 2553 doesn't define this but Linux does - lets be nice and
  	# provide it since we can
  	AI_NUMERICSERV => 1024,
  
  	EAI_BADFLAGS   => -1,
  	EAI_NONAME     => -2,
  	EAI_NODATA     => -5,
  	EAI_FAMILY     => -6,
  	EAI_SERVICE    => -8,
  
  	NI_NUMERICHOST => 1,
  	NI_NUMERICSERV => 2,
  	NI_NOFQDN      => 4,
  	NI_NAMEREQD    => 8,
  	NI_DGRAM       => 16,
  
  	# Constants we don't support. Export them, but croak if anyone tries to
  	# use them
  	AI_IDN                      => 64,
  	AI_CANONIDN                 => 128,
  	AI_IDN_ALLOW_UNASSIGNED     => 256,
  	AI_IDN_USE_STD3_ASCII_RULES => 512,
  	NI_IDN                      => 32,
  	NI_IDN_ALLOW_UNASSIGNED     => 64,
  	NI_IDN_USE_STD3_ASCII_RULES => 128,
  
  	# Error constants we'll never return, so it doesn't matter what value
  	# these have, nor that we don't provide strings for them
  	EAI_SYSTEM   => -11,
  	EAI_BADHINTS => -1000,
  	EAI_PROTOCOL => -1001
      );
  
      foreach my $name ( keys %constants ) {
  	my $value = $constants{$name};
  
  	no strict 'refs';
  	defined &$name or *$name = sub () { $value };
      }
  
      %errstr = (
  	# These strings from RFC 2553
  	EAI_BADFLAGS()   => "invalid value for ai_flags",
  	EAI_NONAME()     => "nodename nor servname provided, or not known",
  	EAI_NODATA()     => "no address associated with nodename",
  	EAI_FAMILY()     => "ai_family not supported",
  	EAI_SERVICE()    => "servname not supported for ai_socktype",
      );
  }
  
  # The following functions are used if the system does not have a
  # getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET
  # family
  
  # Borrowed from Regexp::Common::net
  my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}/;
  my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
  
  sub fake_makeerr
  {
      my ( $errno ) = @_;
      my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno );
      return Scalar::Util::dualvar( $errno, $errstr );
  }
  
  sub fake_getaddrinfo
  {
      my ( $node, $service, $hints ) = @_;
  
      $node = "" unless defined $node;
  
      $service = "" unless defined $service;
  
      my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )};
  
      $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too
      $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() );
  
      $socktype ||= 0;
  
      $protocol ||= 0;
  
      $flags ||= 0;
  
      my $flag_passive     = $flags & AI_PASSIVE();     $flags &= ~AI_PASSIVE();
      my $flag_canonname   = $flags & AI_CANONNAME();   $flags &= ~AI_CANONNAME();
      my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST();
      my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV();
  
      # These constants don't apply to AF_INET-only lookups, so we might as well
      # just ignore them. For AI_ADDRCONFIG we just presume the host has ability
      # to talk AF_INET. If not we'd have to return no addresses at all. :)
      $flags &= ~(AI_V4MAPPED()|AI_ALL()|AI_ADDRCONFIG());
  
      $flags & (AI_IDN()|AI_CANONIDN()|AI_IDN_ALLOW_UNASSIGNED()|AI_IDN_USE_STD3_ASCII_RULES()) and
  	croak "Socket::getaddrinfo() does not support IDN";
  
      $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
  
      $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() );
  
      my $canonname;
      my @addrs;
      if( $node ne "" ) {
  	return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ );
  	( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node );
  	defined $canonname or return fake_makeerr( EAI_NONAME() );
  
  	undef $canonname unless $flag_canonname;
      }
      else {
  	$addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" )
  				  : Socket::inet_aton( "127.0.0.1" );
      }
  
      my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ]
      my $protname = "";
      if( $protocol ) {
  	$protname = eval { getprotobynumber( $protocol ) };
      }
  
      if( $service ne "" and $service !~ m/^\d+$/ ) {
  	return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv );
  	getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() );
      }
  
      foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) {
  	next if $socktype and $this_socktype != $socktype;
  
  	my $this_protname = "raw";
  	$this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp";
  	$this_socktype == Socket::SOCK_DGRAM()  and $this_protname = "udp";
  
  	next if $protname and $this_protname ne $protname;
  
  	my $port;
  	if( $service ne "" ) {
  	    if( $service =~ m/^\d+$/ ) {
  		$port = "$service";
  	    }
  	    else {
  		( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname );
  		next unless defined $port;
  	    }
  	}
  	else {
  	    $port = 0;
  	}
  
  	push @ports, [ $this_socktype, eval { scalar getprotobyname( $this_protname ) } || 0, $port ];
      }
  
      my @ret;
      foreach my $addr ( @addrs ) {
  	foreach my $portspec ( @ports ) {
  	    my ( $socktype, $protocol, $port ) = @$portspec;
  	    push @ret, {
  		family    => $family,
  		socktype  => $socktype,
  		protocol  => $protocol,
  		addr      => Socket::pack_sockaddr_in( $port, $addr ),
  		canonname => undef,
  	    };
  	}
      }
  
      # Only supply canonname for the first result
      if( defined $canonname ) {
  	$ret[0]->{canonname} = $canonname;
      }
  
      return ( fake_makeerr( 0 ), @ret );
  }
  
  sub fake_getnameinfo
  {
      my ( $addr, $flags, $xflags ) = @_;
  
      my ( $port, $inetaddr );
      eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) }
  	or return fake_makeerr( EAI_FAMILY() );
  
      my $family = Socket::AF_INET();
  
      $flags ||= 0;
  
      my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST();
      my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV();
      my $flag_nofqdn      = $flags & NI_NOFQDN();      $flags &= ~NI_NOFQDN();
      my $flag_namereqd    = $flags & NI_NAMEREQD();    $flags &= ~NI_NAMEREQD();
      my $flag_dgram       = $flags & NI_DGRAM()   ;    $flags &= ~NI_DGRAM();
  
      $flags & (NI_IDN()|NI_IDN_ALLOW_UNASSIGNED()|NI_IDN_USE_STD3_ASCII_RULES()) and
  	croak "Socket::getnameinfo() does not support IDN";
  
      $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
  
      $xflags ||= 0;
  
      my $node;
      if( $xflags & NIx_NOHOST ) {
  	$node = undef;
      }
      elsif( $flag_numerichost ) {
  	$node = Socket::inet_ntoa( $inetaddr );
      }
      else {
  	$node = gethostbyaddr( $inetaddr, $family );
  	if( !defined $node ) {
  	    return fake_makeerr( EAI_NONAME() ) if $flag_namereqd;
  	    $node = Socket::inet_ntoa( $inetaddr );
  	}
  	elsif( $flag_nofqdn ) {
  	    my ( $shortname ) = split m/\./, $node;
  	    my ( $fqdn ) = gethostbyname $shortname;
  	    $node = $shortname if defined $fqdn and $fqdn eq $node;
  	}
      }
  
      my $service;
      if( $xflags & NIx_NOSERV ) {
  	$service = undef;
      }
      elsif( $flag_numericserv ) {
  	$service = "$port";
      }
      else {
  	my $protname = $flag_dgram ? "udp" : "";
  	$service = getservbyport( $port, $protname );
  	if( !defined $service ) {
  	    $service = "$port";
  	}
      }
  
      return ( fake_makeerr( 0 ), $node, $service );
  }
  
  1;
X86_64-LINUX-GNU-THREAD-MULTI_SOCKET

$fatpacked{"x86_64-linux-gnu-thread-multi/version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_VERSION';
  #!perl -w
  package version;
  
  use 5.006002;
  use strict;
  use warnings::register;
  if ($] >= 5.015) {
      warnings::register_categories(qw/version/);
  }
  
  our $VERSION = 0.9924;
  our $CLASS = 'version';
  our (@ISA, $STRICT, $LAX);
  
  # !!!!Delete this next block completely when adding to Perl core!!!!
  {
      local $SIG{'__DIE__'};
      eval "use version::vxs $VERSION";
      if ( $@ ) { # don't have the XS version installed
  	eval "use version::vpp $VERSION"; # don't tempt fate
  	die "$@" if ( $@ );
  	push @ISA, "version::vpp";
  	local $^W;
  	*version::qv = \&version::vpp::qv;
  	*version::declare = \&version::vpp::declare;
  	*version::_VERSION = \&version::vpp::_VERSION;
  	*version::vcmp = \&version::vpp::vcmp;
  	*version::new = \&version::vpp::new;
  	*version::numify = \&version::vpp::numify;
  	*version::normal = \&version::vpp::normal;
  	if ($] >= 5.009000) {
  	    no strict 'refs';
  	    *version::stringify = \&version::vpp::stringify;
  	    *{'version::(""'} = \&version::vpp::stringify;
  	    *{'version::(<=>'} = \&version::vpp::vcmp;
  	    *{'version::(cmp'} = \&version::vpp::vcmp;
  	    *version::parse = \&version::vpp::parse;
  	}
      }
      else { # use XS module
  	push @ISA, "version::vxs";
  	local $^W;
  	*version::declare = \&version::vxs::declare;
  	*version::qv = \&version::vxs::qv;
  	*version::_VERSION = \&version::vxs::_VERSION;
  	*version::vcmp = \&version::vxs::VCMP;
  	*version::new = \&version::vxs::new;
  	*version::numify = \&version::vxs::numify;
  	*version::normal = \&version::vxs::normal;
  	if ($] >= 5.009000) {
  	    no strict 'refs';
  	    *version::stringify = \&version::vxs::stringify;
  	    *{'version::(""'} = \&version::vxs::stringify;
  	    *{'version::(<=>'} = \&version::vxs::VCMP;
  	    *{'version::(cmp'} = \&version::vxs::VCMP;
  	    *version::parse = \&version::vxs::parse;
  	}
      }
  }
  
  # avoid using Exporter
  require version::regex;
  *version::is_lax = \&version::regex::is_lax;
  *version::is_strict = \&version::regex::is_strict;
  *LAX = \$version::regex::LAX;
  *LAX_DECIMAL_VERSION = \$version::regex::LAX_DECIMAL_VERSION;
  *LAX_DOTTED_DECIMAL_VERSION = \$version::regex::LAX_DOTTED_DECIMAL_VERSION;
  *STRICT = \$version::regex::STRICT;
  *STRICT_DECIMAL_VERSION = \$version::regex::STRICT_DECIMAL_VERSION;
  *STRICT_DOTTED_DECIMAL_VERSION = \$version::regex::STRICT_DOTTED_DECIMAL_VERSION;
  
  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'});
      }
  }
  
  
  1;
X86_64-LINUX-GNU-THREAD-MULTI_VERSION

$fatpacked{"x86_64-linux-gnu-thread-multi/version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_VERSION_REGEX';
  package version::regex;
  
  use strict;
  
  our $VERSION = 0.9924;
  
  #--------------------------------------------------------------------------#
  # 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.
  
  our $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.
  
  our $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
  
  our $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
  
  our $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
  
  our $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
  
  our $LAX =
      qr/ undef | $LAX_DOTTED_DECIMAL_VERSION | $LAX_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;
X86_64-LINUX-GNU-THREAD-MULTI_VERSION_REGEX

$fatpacked{"x86_64-linux-gnu-thread-multi/version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_VERSION_VPP';
  package charstar;
  # a little helper class to emulate C char* semantics in Perl
  # so that prescan_version can use the same code as in C
  
  use overload (
      '""'	=> \&thischar,
      '0+'	=> \&thischar,
      '++'	=> \&increment,
      '--'	=> \&decrement,
      '+'		=> \&plus,
      '-'		=> \&minus,
      '*'		=> \&multiply,
      'cmp'	=> \&cmp,
      '<=>'	=> \&spaceship,
      'bool'	=> \&thischar,
      '='		=> \&clone,
  );
  
  sub new {
      my ($self, $string) = @_;
      my $class = ref($self) || $self;
  
      my $obj = {
  	string  => [split(//,$string)],
  	current => 0,
      };
      return bless $obj, $class;
  }
  
  sub thischar {
      my ($self) = @_;
      my $last = $#{$self->{string}};
      my $curr = $self->{current};
      if ($curr >= 0 && $curr <= $last) {
  	return $self->{string}->[$curr];
      }
      else {
  	return '';
      }
  }
  
  sub increment {
      my ($self) = @_;
      $self->{current}++;
  }
  
  sub decrement {
      my ($self) = @_;
      $self->{current}--;
  }
  
  sub plus {
      my ($self, $offset) = @_;
      my $rself = $self->clone;
      $rself->{current} += $offset;
      return $rself;
  }
  
  sub minus {
      my ($self, $offset) = @_;
      my $rself = $self->clone;
      $rself->{current} -= $offset;
      return $rself;
  }
  
  sub multiply {
      my ($left, $right, $swapped) = @_;
      my $char = $left->thischar();
      return $char * $right;
  }
  
  sub spaceship {
      my ($left, $right, $swapped) = @_;
      unless (ref($right)) { # not an object already
  	$right = $left->new($right);
      }
      return $left->{current} <=> $right->{current};
  }
  
  sub cmp {
      my ($left, $right, $swapped) = @_;
      unless (ref($right)) { # not an object already
  	if (length($right) == 1) { # comparing single character only
  	    return $left->thischar cmp $right;
  	}
  	$right = $left->new($right);
      }
      return $left->currstr cmp $right->currstr;
  }
  
  sub bool {
      my ($self) = @_;
      my $char = $self->thischar;
      return ($char ne '');
  }
  
  sub clone {
      my ($left, $right, $swapped) = @_;
      $right = {
  	string  => [@{$left->{string}}],
  	current => $left->{current},
      };
      return bless $right, ref($left);
  }
  
  sub currstr {
      my ($self, $s) = @_;
      my $curr = $self->{current};
      my $last = $#{$self->{string}};
      if (defined($s) && $s->{current} < $last) {
  	$last = $s->{current};
      }
  
      my $string = join('', @{$self->{string}}[$curr..$last]);
      return $string;
  }
  
  package version::vpp;
  
  use 5.006002;
  use strict;
  use warnings::register;
  
  use Config;
  
  our $VERSION = 0.9924;
  our $CLASS = 'version::vpp';
  our ($LAX, $STRICT, $WARN_CATEGORY);
  
  if ($] > 5.015) {
      warnings::register_categories(qw/version/);
      $WARN_CATEGORY = 'version';
  } else {
      $WARN_CATEGORY = 'numeric';
  }
  
  require version::regex;
  *version::vpp::is_strict = \&version::regex::is_strict;
  *version::vpp::is_lax = \&version::regex::is_lax;
  *LAX = \$version::regex::LAX;
  *STRICT = \$version::regex::STRICT;
  
  use overload (
      '""'       => \&stringify,
      '0+'       => \&numify,
      'cmp'      => \&vcmp,
      '<=>'      => \&vcmp,
      'bool'     => \&vbool,
      '+'        => \&vnoop,
      '-'        => \&vnoop,
      '*'        => \&vnoop,
      '/'        => \&vnoop,
      '+='        => \&vnoop,
      '-='        => \&vnoop,
      '*='        => \&vnoop,
      '/='        => \&vnoop,
      'abs'      => \&vnoop,
  );
  
  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'})) {
  	no warnings qw/redefine/;
  	*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 ($saw_decimal > 1 && ($d-1) eq '.') {
  	# no trailing period allowed
  	return BADVERSION($s,$errstr,"Invalid version format (trailing decimal)");
      }
  
      if (defined $sqv) {
  	$$sqv = $qv;
      }
      if (defined $swidth) {
  	$$swidth = $width;
      }
      if (defined $ssaw_decimal) {
  	$$ssaw_decimal = $saw_decimal;
      }
      if (defined $salpha) {
  	$$salpha = $alpha;
      }
      return $d;
  }
  
  sub scan_version {
      my ($s, $rv, $qv) = @_;
      my $start;
      my $pos;
      my $last;
      my $errstr;
      my $saw_decimal = 0;
      my $width = 3;
      my $alpha = FALSE;
      my $vinf = FALSE;
      my @av;
  
      $s = new charstar $s;
  
      while (isSPACE($s)) { # leading whitespace is OK
  	$s++;
      }
  
      $last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal,
  	\$width, \$alpha);
  
      if ($errstr) {
  	# 'undef' is a special case and not an error
  	if ( $s ne 'undef') {
  	    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 eq '_') {
  	$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 ) {
  			next if $s eq '_';
  			$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) {
  			next if $end eq '_';
  			$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 eq '_') {
  		    $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}) {
  	use POSIX qw/locale_h/;
  	use if $Config{d_setlocale}, 'locale';
  	my $currlocale = setlocale(LC_ALL);
  
  	# if the current locale uses commas for decimal points, we
  	# just replace commas with decimal places, rather than changing
  	# locales
  	if ( localeconv()->{decimal_point} eq ',' ) {
  	    $value =~ tr/,/./;
  	}
      }
  
      # 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(sprintf "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 $alpha = $self->{alpha} || "";
      my $len = $#{$self->{version}};
      my $digit = $self->{version}[0];
      my $string = sprintf("%d.", $digit );
  
      if ($alpha and warnings::enabled()) {
  	warnings::warn($WARN_CATEGORY, 'alpha->numify() is lossy');
      }
  
      for ( my $i = 1 ; $i <= $len ; $i++ ) {
  	$digit = $self->{version}[$i];
  	$string .= sprintf("%03d", $digit);
      }
  
      if ( $len == 0 ) {
  	$string .= sprintf("000");
      }
  
      return $string;
  }
  
  sub normal {
      my ($self) = @_;
      unless (_verify($self)) {
  	require Carp;
  	Carp::croak("Invalid version object");
      }
  
      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 <= 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 {
      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++;
      }
  
      # 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 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) >= 1 && $value !~ /[,._]/
  	&& _is_non_alphanumeric($value)) {
  	my $tvalue;
  	if ( $] >= 5.008_001 ) {
  	    $tvalue = _find_magic_vstring($value);
  	    $value = $tvalue if length $tvalue;
  	}
  	elsif ( $] >= 5.006_000 ) {
  	    $tvalue = sprintf("v%vd",$value);
  	    if ( $tvalue =~ /^v\d+(\.\d+)*$/ ) {
  		# 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;
  	}
      }
      $tvalue =~ tr/_//d;
      return $tvalue;
  }
  
  sub _VERSION {
      my ($obj, $req) = @_;
      my $class = ref($obj) || $obj;
  
      no strict 'refs';
      if ( exists $INC{"$class.pm"} and not %{"$class\::"} and $] >= 5.008) {
  	 # file but no package
  	require Carp;
  	Carp::croak( "$class defines neither package nor VERSION"
  	    ."--version check failed");
      }
  
      my $version = eval "\$$class\::VERSION";
      if ( defined $version ) {
  	local $^W if $] <= 5.008;
  	$version = version::vpp->new($version);
      }
  
      if ( defined $req ) {
  	unless ( defined $version ) {
  	    require Carp;
  	    my $msg =  $] < 5.006
  	    ? "$class version $req required--this is only version "
  	    : "$class does not define \$$class\::VERSION"
  	      ."--version check failed";
  
  	    if ( $ENV{VERSION_DEBUG} ) {
  		Carp::confess($msg);
  	    }
  	    else {
  		Carp::croak($msg);
  	    }
  	}
  
  	$req = version::vpp->new($req);
  
  	if ( $req > $version ) {
  	    require Carp;
  	    if ( $req->is_qv ) {
  		Carp::croak(
  		    sprintf ("%s version %s required--".
  			"this is only version %s", $class,
  			$req->normal, $version->normal)
  		);
  	    }
  	    else {
  		Carp::croak(
  		    sprintf ("%s version %s required--".
  			"this is only version %s", $class,
  			$req->stringify, $version->stringify)
  		);
  	    }
  	}
      }
  
      return defined $version ? $version->stringify : undef;
  }
  
  1; #this line is important and will help the module return a true value
X86_64-LINUX-GNU-THREAD-MULTI_VERSION_VPP

$fatpacked{"x86_64-linux-gnu-thread-multi/version/vxs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-GNU-THREAD-MULTI_VERSION_VXS';
  #!perl -w
  package version::vxs;
  
  use v5.10;
  use strict;
  
  our $VERSION = 0.9924;
  our $CLASS = 'version::vxs';
  our @ISA;
  
  eval {
      require XSLoader;
      local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION
      XSLoader::load('version::vxs', $VERSION);
      1;
  } or do {
      require DynaLoader;
      push @ISA, 'DynaLoader'; 
      local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION
      bootstrap version::vxs $VERSION;
  };
  
  # Preloaded methods go here.
  
  1;
X86_64-LINUX-GNU-THREAD-MULTI_VERSION_VXS

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