#!/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/Meta.pm"} = <<'CPAN_META';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta;
  our $VERSION = '2.112621'; # VERSION
  
  
  use Carp qw(carp croak);
  use CPAN::Meta::Feature;
  use CPAN::Meta::Prereqs;
  use CPAN::Meta::Converter;
  use CPAN::Meta::Validator;
  use Parse::CPAN::Meta 1.4400 ();
  
  BEGIN { *_dclone = \&CPAN::Meta::Converter::_dclone }
  
  
  BEGIN {
    my @STRING_READERS = qw(
      abstract
      description
      dynamic_config
      generated_by
      name
      release_status
      version
    );
  
    no strict 'refs';
    for my $attr (@STRING_READERS) {
      *$attr = sub { $_[0]{ $attr } };
    }
  }
  
  
  BEGIN {
    my @LIST_READERS = qw(
      author
      keywords
      license
    );
  
    no strict 'refs';
    for my $attr (@LIST_READERS) {
      *$attr = sub {
        my $value = $_[0]{ $attr };
        croak "$attr must be called in list context"
          unless wantarray;
        return @{ _dclone($value) } if ref $value;
        return $value;
      };
    }
  }
  
  sub authors  { $_[0]->author }
  sub licenses { $_[0]->license }
  
  
  BEGIN {
    my @MAP_READERS = qw(
      meta-spec
      resources
      provides
      no_index
  
      prereqs
      optional_features
    );
  
    no strict 'refs';
    for my $attr (@MAP_READERS) {
      (my $subname = $attr) =~ s/-/_/;
      *$subname = sub {
        my $value = $_[0]{ $attr };
        return _dclone($value) if $value;
        return {};
      };
    }
  }
  
  
  sub custom_keys {
    return grep { /^x_/i } keys %{$_[0]};
  }
  
  sub custom {
    my ($self, $attr) = @_;
    my $value = $self->{$attr};
    return _dclone($value) if ref $value;
    return $value;
  }
  
  
  sub _new {
    my ($class, $struct, $options) = @_;
    my $self;
  
    if ( $options->{lazy_validation} ) {
      # try to convert to a valid structure; if succeeds, then return it
      my $cmc = CPAN::Meta::Converter->new( $struct );
      $self = $cmc->convert( version => 2 ); # valid or dies
      return bless $self, $class;
    }
    else {
      # validate original struct
      my $cmv = CPAN::Meta::Validator->new( $struct );
      unless ( $cmv->is_valid) {
        die "Invalid metadata structure. Errors: "
          . join(", ", $cmv->errors) . "\n";
      }
    }
  
    # up-convert older spec versions
    my $version = $struct->{'meta-spec'}{version} || '1.0';
    if ( $version == 2 ) {
      $self = $struct;
    }
    else {
      my $cmc = CPAN::Meta::Converter->new( $struct );
      $self = $cmc->convert( version => 2 );
    }
  
    return bless $self, $class;
  }
  
  sub new {
    my ($class, $struct, $options) = @_;
    my $self = eval { $class->_new($struct, $options) };
    croak($@) if $@;
    return $self;
  }
  
  
  sub create {
    my ($class, $struct, $options) = @_;
    my $version = __PACKAGE__->VERSION || 2;
    $struct->{generated_by} ||= __PACKAGE__ . " version $version" ;
    $struct->{'meta-spec'}{version} ||= int($version);
    my $self = eval { $class->_new($struct, $options) };
    croak ($@) if $@;
    return $self;
  }
  
  
  sub load_file {
    my ($class, $file, $options) = @_;
    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
  
    croak "load_file() requires a valid, readable filename"
      unless -r $file;
  
    my $self;
    eval {
      my $struct = Parse::CPAN::Meta->load_file( $file );
      $self = $class->_new($struct, $options);
    };
    croak($@) if $@;
    return $self;
  }
  
  
  sub load_yaml_string {
    my ($class, $yaml, $options) = @_;
    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
  
    my $self;
    eval {
      my ($struct) = Parse::CPAN::Meta->load_yaml_string( $yaml );
      $self = $class->_new($struct, $options);
    };
    croak($@) if $@;
    return $self;
  }
  
  
  sub load_json_string {
    my ($class, $json, $options) = @_;
    $options->{lazy_validation} = 1 unless exists $options->{lazy_validation};
  
    my $self;
    eval {
      my $struct = Parse::CPAN::Meta->load_json_string( $json );
      $self = $class->_new($struct, $options);
    };
    croak($@) if $@;
    return $self;
  }
  
  
  sub save {
    my ($self, $file, $options) = @_;
  
    my $version = $options->{version} || '2';
    my $layer = $] ge '5.008001' ? ':utf8' : '';
  
    if ( $version ge '2' ) {
      carp "'$file' should end in '.json'"
        unless $file =~ m{\.json$};
    }
    else {
      carp "'$file' should end in '.yml'"
        unless $file =~ m{\.yml$};
    }
  
    my $data = $self->as_string( $options );
    open my $fh, ">$layer", $file
      or die "Error opening '$file' for writing: $!\n";
  
    print {$fh} $data;
    close $fh
      or die "Error closing '$file': $!\n";
  
    return 1;
  }
  
  
  sub meta_spec_version {
    my ($self) = @_;
    return $self->meta_spec->{version};
  }
  
  
  sub effective_prereqs {
    my ($self, $features) = @_;
    $features ||= [];
  
    my $prereq = CPAN::Meta::Prereqs->new($self->prereqs);
  
    return $prereq unless @$features;
  
    my @other = map {; $self->feature($_)->prereqs } @$features;
  
    return $prereq->with_merged_prereqs(\@other);
  }
  
  
  sub should_index_file {
    my ($self, $filename) = @_;
  
    for my $no_index_file (@{ $self->no_index->{file} || [] }) {
      return if $filename eq $no_index_file;
    }
  
    for my $no_index_dir (@{ $self->no_index->{directory} }) {
      $no_index_dir =~ s{$}{/} unless $no_index_dir =~ m{/\z};
      return if index($filename, $no_index_dir) == 0;
    }
  
    return 1;
  }
  
  
  sub should_index_package {
    my ($self, $package) = @_;
  
    for my $no_index_pkg (@{ $self->no_index->{package} || [] }) {
      return if $package eq $no_index_pkg;
    }
  
    for my $no_index_ns (@{ $self->no_index->{namespace} }) {
      return if index($package, "${no_index_ns}::") == 0;
    }
  
    return 1;
  }
  
  
  sub features {
    my ($self) = @_;
  
    my $opt_f = $self->optional_features;
    my @features = map {; CPAN::Meta::Feature->new($_ => $opt_f->{ $_ }) }
                   keys %$opt_f;
  
    return @features;
  }
  
  
  sub feature {
    my ($self, $ident) = @_;
  
    croak "no feature named $ident"
      unless my $f = $self->optional_features->{ $ident };
  
    return CPAN::Meta::Feature->new($ident, $f);
  }
  
  
  sub as_struct {
    my ($self, $options) = @_;
    my $struct = _dclone($self);
    if ( $options->{version} ) {
      my $cmc = CPAN::Meta::Converter->new( $struct );
      $struct = $cmc->convert( version => $options->{version} );
    }
    return $struct;
  }
  
  
  sub as_string {
    my ($self, $options) = @_;
  
    my $version = $options->{version} || '2';
  
    my $struct;
    if ( $self->meta_spec_version ne $version ) {
      my $cmc = CPAN::Meta::Converter->new( $self->as_struct );
      $struct = $cmc->convert( version => $version );
    }
    else {
      $struct = $self->as_struct;
    }
  
    my ($data, $backend);
    if ( $version ge '2' ) {
      $backend = Parse::CPAN::Meta->json_backend();
      $data = $backend->new->pretty->canonical->encode($struct);
    }
    else {
      $backend = Parse::CPAN::Meta->yaml_backend();
      $data = eval { no strict 'refs'; &{"$backend\::Dump"}($struct) };
      if ( $@ ) {
        croak $backend->can('errstr') ? $backend->errstr : $@
      }
    }
  
    return $data;
  }
  
  # Used by JSON::PP, etc. for "convert_blessed"
  sub TO_JSON {
    return { %{ $_[0] } };
  }
  
  1;
  
  # ABSTRACT: the distribution metadata for a CPAN dist
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta - the distribution metadata for a CPAN dist
  
  =head1 VERSION
  
  version 2.112621
  
  =head1 SYNOPSIS
  
    my $meta = CPAN::Meta->load_file('META.json');
  
    printf "testing requirements for %s version %s\n",
      $meta->name,
      $meta->version;
  
    my $prereqs = $meta->requirements_for('configure');
  
    for my $module ($prereqs->required_modules) {
      my $version = get_local_version($module);
  
      die "missing required module $module" unless defined $version;
      die "version for $module not in range"
        unless $prereqs->accepts_module($module, $version);
    }
  
  =head1 DESCRIPTION
  
  Software distributions released to the CPAN include a F<META.json> or, for
  older distributions, F<META.yml>, which describes the distribution, its
  contents, and the requirements for building and installing the distribution.
  The data structure stored in the F<META.json> file is described in
  L<CPAN::Meta::Spec>.
  
  CPAN::Meta provides a simple class to represent this distribution metadata (or
  I<distmeta>), along with some helpful methods for interrogating that data.
  
  The documentation below is only for the methods of the CPAN::Meta object.  For
  information on the meaning of individual fields, consult the spec.
  
  =head1 METHODS
  
  =head2 new
  
    my $meta = CPAN::Meta->new($distmeta_struct, \%options);
  
  Returns a valid CPAN::Meta object or dies if the supplied metadata hash
  reference fails to validate.  Older-format metadata will be up-converted to
  version 2 if they validate against the original stated specification.
  
  It takes an optional hashref of options. Valid options include:
  
  =over
  
  =item *
  
  lazy_validation -- if true, new will attempt to convert the given metadata
  to version 2 before attempting to validate it.  This means than any
  fixable errors will be handled by CPAN::Meta::Converter before validation.
  (Note that this might result in invalid optional data being silently
  dropped.)  The default is false.
  
  =back
  
  =head2 create
  
    my $meta = CPAN::Meta->create($distmeta_struct, \%options);
  
  This is same as C<new()>, except that C<generated_by> and C<meta-spec> fields
  will be generated if not provided.  This means the metadata structure is
  assumed to otherwise follow the latest L<CPAN::Meta::Spec>.
  
  =head2 load_file
  
    my $meta = CPAN::Meta->load_file($distmeta_file, \%options);
  
  Given a pathname to a file containing metadata, this deserializes the file
  according to its file suffix and constructs a new C<CPAN::Meta> object, just
  like C<new()>.  It will die if the deserialized version fails to validate
  against its stated specification version.
  
  It takes the same options as C<new()> but C<lazy_validation> defaults to
  true.
  
  =head2 load_yaml_string
  
    my $meta = CPAN::Meta->load_yaml_string($yaml, \%options);
  
  This method returns a new CPAN::Meta object using the first document in the
  given YAML string.  In other respects it is identical to C<load_file()>.
  
  =head2 load_json_string
  
    my $meta = CPAN::Meta->load_json_string($json, \%options);
  
  This method returns a new CPAN::Meta object using the structure represented by
  the given JSON string.  In other respects it is identical to C<load_file()>.
  
  =head2 save
  
    $meta->save($distmeta_file, \%options);
  
  Serializes the object as JSON and writes it to the given file.  The only valid
  option is C<version>, which defaults to '2'. On Perl 5.8.1 or later, the file
  is saved with UTF-8 encoding.
  
  For C<version> 2 (or higher), the filename should end in '.json'.  L<JSON::PP>
  is the default JSON backend. Using another JSON backend requires L<JSON> 2.5 or
  later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate
  backend like L<JSON::XS>.
  
  For C<version> less than 2, the filename should end in '.yml'.
  L<CPAN::Meta::Converter> is used to generate an older metadata structure, which
  is serialized to YAML.  CPAN::Meta::YAML is the default YAML backend.  You may
  set the C<$ENV{PERL_YAML_BACKEND}> to a supported alternative backend, though
  this is not recommended due to subtle incompatibilities between YAML parsers on
  CPAN.
  
  =head2 meta_spec_version
  
  This method returns the version part of the C<meta_spec> entry in the distmeta
  structure.  It is equivalent to:
  
    $meta->meta_spec->{version};
  
  =head2 effective_prereqs
  
    my $prereqs = $meta->effective_prereqs;
  
    my $prereqs = $meta->effective_prereqs( \@feature_identifiers );
  
  This method returns a L<CPAN::Meta::Prereqs> object describing all the
  prereqs for the distribution.  If an arrayref of feature identifiers is given,
  the prereqs for the identified features are merged together with the
  distribution's core prereqs before the CPAN::Meta::Prereqs object is returned.
  
  =head2 should_index_file
  
    ... if $meta->should_index_file( $filename );
  
  This method returns true if the given file should be indexed.  It decides this
  by checking the C<file> and C<directory> keys in the C<no_index> property of
  the distmeta structure.
  
  C<$filename> should be given in unix format.
  
  =head2 should_index_package
  
    ... if $meta->should_index_package( $package );
  
  This method returns true if the given package should be indexed.  It decides
  this by checking the C<package> and C<namespace> keys in the C<no_index>
  property of the distmeta structure.
  
  =head2 features
  
    my @feature_objects = $meta->features;
  
  This method returns a list of L<CPAN::Meta::Feature> objects, one for each
  optional feature described by the distribution's metadata.
  
  =head2 feature
  
    my $feature_object = $meta->feature( $identifier );
  
  This method returns a L<CPAN::Meta::Feature> object for the optional feature
  with the given identifier.  If no feature with that identifier exists, an
  exception will be raised.
  
  =head2 as_struct
  
    my $copy = $meta->as_struct( \%options );
  
  This method returns a deep copy of the object's metadata as an unblessed has
  reference.  It takes an optional hashref of options.  If the hashref contains
  a C<version> argument, the copied metadata will be converted to the version
  of the specification and returned.  For example:
  
    my $old_spec = $meta->as_struct( {version => "1.4"} );
  
  =head2 as_string
  
    my $string = $meta->as_string( \%options );
  
  This method returns a serialized copy of the object's metadata as a character
  string.  (The strings are B<not> UTF-8 encoded.)  It takes an optional hashref
  of options.  If the hashref contains a C<version> argument, the copied metadata
  will be converted to the version of the specification and returned.  For
  example:
  
    my $string = $meta->as_struct( {version => "1.4"} );
  
  For C<version> greater than or equal to 2, the string will be serialized as
  JSON.  For C<version> less than 2, the string will be serialized as YAML.  In
  both cases, the same rules are followed as in the C<save()> method for choosing
  a serialization backend.
  
  =head1 STRING DATA
  
  The following methods return a single value, which is the value for the
  corresponding entry in the distmeta structure.  Values should be either undef
  or strings.
  
  =over 4
  
  =item *
  
  abstract
  
  =item *
  
  description
  
  =item *
  
  dynamic_config
  
  =item *
  
  generated_by
  
  =item *
  
  name
  
  =item *
  
  release_status
  
  =item *
  
  version
  
  =back
  
  =head1 LIST DATA
  
  These methods return lists of string values, which might be represented in the
  distmeta structure as arrayrefs or scalars:
  
  =over 4
  
  =item *
  
  authors
  
  =item *
  
  keywords
  
  =item *
  
  licenses
  
  =back
  
  The C<authors> and C<licenses> methods may also be called as C<author> and
  C<license>, respectively, to match the field name in the distmeta structure.
  
  =head1 MAP DATA
  
  These readers return hashrefs of arbitrary unblessed data structures, each
  described more fully in the specification:
  
  =over 4
  
  =item *
  
  meta_spec
  
  =item *
  
  resources
  
  =item *
  
  provides
  
  =item *
  
  no_index
  
  =item *
  
  prereqs
  
  =item *
  
  optional_features
  
  =back
  
  =head1 CUSTOM DATA
  
  A list of custom keys are available from the C<custom_keys> method and
  particular keys may be retrieved with the C<custom> method.
  
    say $meta->custom($_) for $meta->custom_keys;
  
  If a custom key refers to a data structure, a deep clone is returned.
  
  =for Pod::Coverage TO_JSON abstract author authors custom custom_keys description dynamic_config
  generated_by keywords license licenses meta_spec name no_index
  optional_features prereqs provides release_status resources version
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 SEE ALSO
  
  =over 4
  
  =item *
  
  L<CPAN::Meta::Converter>
  
  =item *
  
  L<CPAN::Meta::Validator>
  
  =back
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests by email to C<bug-cpan-meta at rt.cpan.org>, or through
  the web interface at L<http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta>. You will be automatically notified of any
  progress on the request by the system.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<http://github.com/dagolden/cpan-meta>
  
    git clone git://github.com/dagolden/cpan-meta.git
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
  
  
  __END__
  
  
CPAN_META

$fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Converter;
  our $VERSION = '2.112621'; # VERSION
  
  
  use CPAN::Meta::Validator;
  use version 0.82 ();
  use Parse::CPAN::Meta 1.4400 ();
  
  sub _dclone {
    my $ref = shift;
  
    # if an object is in the data structure and doesn't specify how to
    # turn itself into JSON, we just stringify the object.  That does the
    # right thing for typical things that might be there, like version objects,
    # Path::Class objects, etc.
    no warnings 'once';
    local *UNIVERSAL::TO_JSON = sub { return "$_[0]" };
  
    my $backend = Parse::CPAN::Meta->json_backend();
    return $backend->new->utf8->decode(
      $backend->new->utf8->allow_blessed->convert_blessed->encode($ref)
    );
  }
  
  my %known_specs = (
      '2'   => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
      '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
      '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
      '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
      '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
      '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
  );
  
  my @spec_list = sort { $a <=> $b } keys %known_specs;
  my ($LOWEST, $HIGHEST) = @spec_list[0,-1];
  
  #--------------------------------------------------------------------------#
  # converters
  #
  # called as $converter->($element, $field_name, $full_meta, $to_version)
  #
  # defined return value used for field
  # undef return value means field is skipped
  #--------------------------------------------------------------------------#
  
  sub _keep { $_[0] }
  
  sub _keep_or_one { defined($_[0]) ? $_[0] : 1 }
  
  sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 }
  
  sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" }
  
  sub _generated_by {
    my $gen = shift;
    my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>");
  
    return $sig unless defined $gen and length $gen;
    return $gen if $gen =~ /(, )\Q$sig/;
    return "$gen, $sig";
  }
  
  sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] }
  
  sub _prefix_custom {
    my $key = shift;
    $key =~ s/^(?!x_)   # Unless it already starts with x_
               (?:x-?)? # Remove leading x- or x (if present)
             /x_/ix;    # and prepend x_
    return $key;
  }
  
  sub _ucfirst_custom {
    my $key = shift;
    $key = ucfirst $key unless $key =~ /[A-Z]/;
    return $key;
  }
  
  sub _change_meta_spec {
    my ($element, undef, undef, $version) = @_;
    $element->{version} = $version;
    $element->{url} = $known_specs{$version};
    return $element;
  }
  
  my @valid_licenses_1 = (
    'perl',
    'gpl',
    'apache',
    'artistic',
    'artistic_2',
    'lgpl',
    'bsd',
    'gpl',
    'mit',
    'mozilla',
    'open_source',
    'unrestricted',
    'restrictive',
    'unknown',
  );
  
  my %license_map_1 = (
    ( map { $_ => $_ } @valid_licenses_1 ),
    artistic2 => 'artistic_2',
  );
  
  sub _license_1 {
    my ($element) = @_;
    return 'unknown' unless defined $element;
    if ( $license_map_1{lc $element} ) {
      return $license_map_1{lc $element};
    }
    return 'unknown';
  }
  
  my @valid_licenses_2 = qw(
    agpl_3
    apache_1_1
    apache_2_0
    artistic_1
    artistic_2
    bsd
    freebsd
    gfdl_1_2
    gfdl_1_3
    gpl_1
    gpl_2
    gpl_3
    lgpl_2_1
    lgpl_3_0
    mit
    mozilla_1_0
    mozilla_1_1
    openssl
    perl_5
    qpl_1_0
    ssleay
    sun
    zlib
    open_source
    restricted
    unrestricted
    unknown
  );
  
  # The "old" values were defined by Module::Build, and were often vague.  I have
  # made the decisions below based on reading Module::Build::API and how clearly
  # it specifies the version of the license.
  my %license_map_2 = (
    (map { $_ => $_ } @valid_licenses_2),
    apache      => 'apache_2_0',  # clearly stated as 2.0
    artistic    => 'artistic_1',  # clearly stated as 1
    artistic2   => 'artistic_2',  # clearly stated as 2
    gpl         => 'open_source', # we don't know which GPL; punt
    lgpl        => 'open_source', # we don't know which LGPL; punt
    mozilla     => 'open_source', # we don't know which MPL; punt
    perl        => 'perl_5',      # clearly Perl 5
    restrictive => 'restricted',
  );
  
  sub _license_2 {
    my ($element) = @_;
    return [ 'unknown' ] unless defined $element;
    $element = [ $element ] unless ref $element eq 'ARRAY';
    my @new_list;
    for my $lic ( @$element ) {
      next unless defined $lic;
      if ( my $new = $license_map_2{lc $lic} ) {
        push @new_list, $new;
      }
    }
    return @new_list ? \@new_list : [ 'unknown' ];
  }
  
  my %license_downgrade_map = qw(
    agpl_3            open_source
    apache_1_1        apache
    apache_2_0        apache
    artistic_1        artistic
    artistic_2        artistic_2
    bsd               bsd
    freebsd           open_source
    gfdl_1_2          open_source
    gfdl_1_3          open_source
    gpl_1             gpl
    gpl_2             gpl
    gpl_3             gpl
    lgpl_2_1          lgpl
    lgpl_3_0          lgpl
    mit               mit
    mozilla_1_0       mozilla
    mozilla_1_1       mozilla
    openssl           open_source
    perl_5            perl
    qpl_1_0           open_source
    ssleay            open_source
    sun               open_source
    zlib              open_source
    open_source       open_source
    restricted        restrictive
    unrestricted      unrestricted
    unknown           unknown
  );
  
  sub _downgrade_license {
    my ($element) = @_;
    if ( ! defined $element ) {
      return "unknown";
    }
    elsif( ref $element eq 'ARRAY' ) {
      if ( @$element == 1 ) {
        return $license_downgrade_map{$element->[0]} || "unknown";
      }
    }
    elsif ( ! ref $element ) {
      return $license_downgrade_map{$element} || "unknown";
    }
    return "unknown";
  }
  
  my $no_index_spec_1_2 = {
    'file' => \&_listify,
    'dir' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_1_3 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
  };
  
  my $no_index_spec_2 = {
    'file' => \&_listify,
    'directory' => \&_listify,
    'package' => \&_listify,
    'namespace' => \&_listify,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _no_index_1_2 {
    my (undef, undef, $meta) = @_;
    my $no_index = $meta->{no_index} || $meta->{private};
    return unless $no_index;
  
    # cleanup wrong format
    if ( ! ref $no_index ) {
      my $item = $no_index;
      $no_index = { dir => [ $item ], file => [ $item ] };
    }
    elsif ( ref $no_index eq 'ARRAY' ) {
      my $list = $no_index;
      $no_index = { dir => [ @$list ], file => [ @$list ] };
    }
  
    # common mistake: files -> file
    if ( exists $no_index->{files} ) {
      $no_index->{file} = delete $no_index->{file};
    }
    # common mistake: modules -> module
    if ( exists $no_index->{modules} ) {
      $no_index->{module} = delete $no_index->{module};
    }
    return _convert($no_index, $no_index_spec_1_2);
  }
  
  sub _no_index_directory {
    my ($element, $key, $meta, $version) = @_;
    return unless $element;
  
    # cleanup wrong format
    if ( ! ref $element ) {
      my $item = $element;
      $element = { directory => [ $item ], file => [ $item ] };
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $list = $element;
      $element = { directory => [ @$list ], file => [ @$list ] };
    }
  
    if ( exists $element->{dir} ) {
      $element->{directory} = delete $element->{dir};
    }
    # common mistake: files -> file
    if ( exists $element->{files} ) {
      $element->{file} = delete $element->{file};
    }
    # common mistake: modules -> module
    if ( exists $element->{modules} ) {
      $element->{module} = delete $element->{module};
    }
    my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3;
    return _convert($element, $spec);
  }
  
  sub _is_module_name {
    my $mod = shift;
    return unless defined $mod && length $mod;
    return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$};
  }
  
  sub _clean_version {
    my ($element, $key, $meta, $to_version) = @_;
    return 0 if ! defined $element;
  
    $element =~ s{^\s*}{};
    $element =~ s{\s*$}{};
    $element =~ s{^\.}{0.};
  
    return 0 if ! length $element;
    return 0 if ( $element eq 'undef' || $element eq '<undef>' );
  
    if ( my $v = eval { version->new($element) } ) {
      return $v->is_qv ? $v->normal : $element;
    }
    else {
      return 0;
    }
  }
  
  sub _version_map {
    my ($element) = @_;
    return undef unless defined $element;
    if ( ref $element eq 'HASH' ) {
      my $new_map = {};
      for my $k ( keys %$element ) {
        next unless _is_module_name($k);
        my $value = $element->{$k};
        if ( ! ( defined $value && length $value ) ) {
          $new_map->{$k} = 0;
        }
        elsif ( $value eq 'undef' || $value eq '<undef>' ) {
          $new_map->{$k} = 0;
        }
        elsif ( _is_module_name( $value ) ) { # some weird, old META have this
          $new_map->{$k} = 0;
          $new_map->{$value} = 0;
        }
        else {
          $new_map->{$k} = _clean_version($value);
        }
      }
      return $new_map;
    }
    elsif ( ref $element eq 'ARRAY' ) {
      my $hashref = { map { $_ => 0 } @$element };
      return _version_map($hashref); # cleanup any weird stuff
    }
    elsif ( ref $element eq '' && length $element ) {
      return { $element => 0 }
    }
    return;
  }
  
  sub _prereqs_from_1 {
    my (undef, undef, $meta) = @_;
    my $prereqs = {};
    for my $phase ( qw/build configure/ ) {
      my $key = "${phase}_requires";
      $prereqs->{$phase}{requires} = _version_map($meta->{$key})
        if $meta->{$key};
    }
    for my $rel ( qw/requires recommends conflicts/ ) {
      $prereqs->{runtime}{$rel} = _version_map($meta->{$rel})
        if $meta->{$rel};
    }
    return $prereqs;
  }
  
  my $prereqs_spec = {
    configure => \&_prereqs_rel,
    build     => \&_prereqs_rel,
    test      => \&_prereqs_rel,
    runtime   => \&_prereqs_rel,
    develop   => \&_prereqs_rel,
    ':custom'  => \&_prefix_custom,
  };
  
  my $relation_spec = {
    requires   => \&_version_map,
    recommends => \&_version_map,
    suggests   => \&_version_map,
    conflicts  => \&_version_map,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _cleanup_prereqs {
    my ($prereqs, $key, $meta, $to_version) = @_;
    return unless $prereqs && ref $prereqs eq 'HASH';
    return _convert( $prereqs, $prereqs_spec, $to_version );
  }
  
  sub _prereqs_rel {
    my ($relation, $key, $meta, $to_version) = @_;
    return unless $relation && ref $relation eq 'HASH';
    return _convert( $relation, $relation_spec, $to_version );
  }
  
  
  BEGIN {
    my @old_prereqs = qw(
      requires
      configure_requires
      recommends
      conflicts
    );
  
    for ( @old_prereqs ) {
      my $sub = "_get_$_";
      my ($phase,$type) = split qr/_/, $_;
      if ( ! defined $type ) {
        $type = $phase;
        $phase = 'runtime';
      }
      no strict 'refs';
      *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
    }
  }
  
  sub _get_build_requires {
    my ($data, $key, $meta) = @_;
  
    my $test_h  = _extract_prereqs($_[2]->{prereqs}, qw(test  requires)) || {};
    my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {};
  
    require Version::Requirements;
    my $test_req  = Version::Requirements->from_string_hash($test_h);
    my $build_req = Version::Requirements->from_string_hash($build_h);
  
    $test_req->add_requirements($build_req)->as_string_hash;
  }
  
  sub _extract_prereqs {
    my ($prereqs, $phase, $type) = @_;
    return unless ref $prereqs eq 'HASH';
    return $prereqs->{$phase}{$type};
  }
  
  sub _downgrade_optional_features {
    my (undef, undef, $meta) = @_;
    return undef unless exists $meta->{optional_features};
    my $origin = $meta->{optional_features};
    my $features = {};
    for my $name ( keys %$origin ) {
      $features->{$name} = {
        description => $origin->{$name}{description},
        requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),
        configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),
        build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),
        recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),
        conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),
      };
      for my $k (keys %{$features->{$name}} ) {
        delete $features->{$name}{$k} unless defined $features->{$name}{$k};
      }
    }
    return $features;
  }
  
  sub _upgrade_optional_features {
    my (undef, undef, $meta) = @_;
    return undef unless exists $meta->{optional_features};
    my $origin = $meta->{optional_features};
    my $features = {};
    for my $name ( keys %$origin ) {
      $features->{$name} = {
        description => $origin->{$name}{description},
        prereqs => _prereqs_from_1(undef, undef, $origin->{$name}),
      };
      delete $features->{$name}{prereqs}{configure};
    }
    return $features;
  }
  
  my $optional_features_2_spec = {
    description => \&_keep,
    prereqs => \&_cleanup_prereqs,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _feature_2 {
    my ($element, $key, $meta, $to_version) = @_;
    return unless $element && ref $element eq 'HASH';
    _convert( $element, $optional_features_2_spec, $to_version );
  }
  
  sub _cleanup_optional_features_2 {
    my ($element, $key, $meta, $to_version) = @_;
    return unless $element && ref $element eq 'HASH';
    my $new_data = {};
    for my $k ( keys %$element ) {
      $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version );
    }
    return unless keys %$new_data;
    return $new_data;
  }
  
  sub _optional_features_1_4 {
    my ($element) = @_;
    return unless $element;
    $element = _optional_features_as_map($element);
    for my $name ( keys %$element ) {
      for my $drop ( qw/requires_packages requires_os excluded_os/ ) {
        delete $element->{$name}{$drop};
      }
    }
    return $element;
  }
  
  sub _optional_features_as_map {
    my ($element) = @_;
    return unless $element;
    if ( ref $element eq 'ARRAY' ) {
      my %map;
      for my $feature ( @$element ) {
        my (@parts) = %$feature;
        $map{$parts[0]} = $parts[1];
      }
      $element = \%map;
    }
    return $element;
  }
  
  sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
  
  sub _url_or_drop {
    my ($element) = @_;
    return $element if _is_urlish($element);
    return;
  }
  
  sub _url_list {
    my ($element) = @_;
    return unless $element;
    $element = _listify( $element );
    $element = [ grep { _is_urlish($_) } @$element ];
    return unless @$element;
    return $element;
  }
  
  sub _author_list {
    my ($element) = @_;
    return [ 'unknown' ] unless $element;
    $element = _listify( $element );
    $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ];
    return [ 'unknown' ] unless @$element;
    return $element;
  }
  
  my $resource2_upgrade = {
    license    => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef },
    homepage   => \&_url_or_drop,
    bugtracker => sub {
      my ($item) = @_;
      return unless $item;
      if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } }
      elsif( _is_urlish($item) ) { return { web => $item } }
      else { return undef }
    },
    repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef },
    ':custom'  => \&_prefix_custom,
  };
  
  sub _upgrade_resources_2 {
    my (undef, undef, $meta, $version) = @_;
    return undef unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource2_upgrade);
  }
  
  my $bugtracker2_spec = {
    web => \&_url_or_drop,
    mailto => \&_keep,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _repo_type {
    my ($element, $key, $meta, $to_version) = @_;
    return $element if defined $element;
    return unless exists $meta->{url};
    my $repo_url = $meta->{url};
    for my $type ( qw/git svn/ ) {
      return $type if $repo_url =~ m{\A$type};
    }
    return;
  }
  
  my $repository2_spec = {
    web => \&_url_or_drop,
    url => \&_url_or_drop,
    type => \&_repo_type,
    ':custom'  => \&_prefix_custom,
  };
  
  my $resources2_cleanup = {
    license    => \&_url_list,
    homepage   => \&_url_or_drop,
    bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef },
    repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef },
    ':custom'  => \&_prefix_custom,
  };
  
  sub _cleanup_resources_2 {
    my ($resources, $key, $meta, $to_version) = @_;
    return undef unless $resources && ref $resources eq 'HASH';
    return _convert($resources, $resources2_cleanup, $to_version);
  }
  
  my $resource1_spec = {
    license    => \&_url_or_drop,
    homepage   => \&_url_or_drop,
    bugtracker => \&_url_or_drop,
    repository => \&_url_or_drop,
    ':custom'  => \&_keep,
  };
  
  sub _resources_1_3 {
    my (undef, undef, $meta, $version) = @_;
    return undef unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource1_spec);
  }
  
  *_resources_1_4 = *_resources_1_3;
  
  sub _resources_1_2 {
    my (undef, undef, $meta) = @_;
    my $resources = $meta->{resources} || {};
    if ( $meta->{license_url} && ! $resources->{license} ) {
      $resources->{license} = $meta->license_url
        if _is_urlish($meta->{license_url});
    }
    return undef unless keys %$resources;
    return _convert($resources, $resource1_spec);
  }
  
  my $resource_downgrade_spec = {
    license    => sub { return ref $_[0] ? $_[0]->[0] : $_[0] },
    homepage   => \&_url_or_drop,
    bugtracker => sub { return $_[0]->{web} },
    repository => sub { return $_[0]->{url} || $_[0]->{web} },
    ':custom'  => \&_ucfirst_custom,
  };
  
  sub _downgrade_resources {
    my (undef, undef, $meta, $version) = @_;
    return undef unless exists $meta->{resources};
    return _convert($meta->{resources}, $resource_downgrade_spec);
  }
  
  sub _release_status {
    my ($element, undef, $meta) = @_;
    return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z};
    return _release_status_from_version(undef, undef, $meta);
  }
  
  sub _release_status_from_version {
    my (undef, undef, $meta) = @_;
    my $version = $meta->{version} || '';
    return ( $version =~ /_/ ) ? 'testing' : 'stable';
  }
  
  my $provides_spec = {
    file => \&_keep,
    version => \&_clean_version,
  };
  
  my $provides_spec_2 = {
    file => \&_keep,
    version => \&_clean_version,
    ':custom'  => \&_prefix_custom,
  };
  
  sub _provides {
    my ($element, $key, $meta, $to_version) = @_;
    return unless defined $element && ref $element eq 'HASH';
    my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec;
    my $new_data = {};
    for my $k ( keys %$element ) {
      $new_data->{$k} = _convert($element->{$k}, $spec, $to_version);
    }
    return $new_data;
  }
  
  sub _convert {
    my ($data, $spec, $to_version) = @_;
  
    my $new_data = {};
    for my $key ( keys %$spec ) {
      next if $key eq ':custom' || $key eq ':drop';
      next unless my $fcn = $spec->{$key};
      die "spec for '$key' is not a coderef"
        unless ref $fcn && ref $fcn eq 'CODE';
      my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
      $new_data->{$key} = $new_value if defined $new_value;
    }
  
    my $drop_list   = $spec->{':drop'};
    my $customizer  = $spec->{':custom'} || \&_keep;
  
    for my $key ( keys %$data ) {
      next if $drop_list && grep { $key eq $_ } @$drop_list;
      next if exists $spec->{$key}; # we handled it
      $new_data->{ $customizer->($key) } = $data->{$key};
    }
  
    return $new_data;
  }
  
  #--------------------------------------------------------------------------#
  # define converters for each conversion
  #--------------------------------------------------------------------------#
  
  # each converts from prior version
  # special ":custom" field is used for keys not recognized in spec
  my %up_convert = (
    '2-from-1.4' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_2,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'dynamic_config'      => \&_keep_or_one,
      # ADDED MANDATORY
      'release_status'      => \&_release_status_from_version,
      # PRIOR OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_upgrade_optional_features,
      'provides'            => \&_provides,
      'resources'           => \&_upgrade_resources_2,
      # ADDED OPTIONAL
      'description'         => \&_keep,
      'prereqs'             => \&_prereqs_from_1,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
          build_requires
          configure_requires
          conflicts
          distribution_type
          license_url
          private
          recommends
          requires
      ) ],
  
      # other random keys need x_ prefixing
      ':custom'              => \&_prefix_custom,
    },
    '1.4-from-1.3' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_1_4,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_4,
      # ADDED OPTIONAL
      'configure_requires'  => \&_keep,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.3-from-1.2' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.2-from-1.1' => {
      # PRIOR MANDATORY
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'license'             => \&_license_1,
      'name'                => \&_keep,
      'generated_by'        => \&_generated_by,
      # ADDED MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'resources'           => \&_resources_1_2,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
        license_url
        private
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
    '1.1-from-1.0' => {
      # CHANGED TO MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'license_url'         => \&_url_or_drop,
      'private'             => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep
    },
  );
  
  my %down_convert = (
    '1.4-from-2' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_downgrade_license,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_get_build_requires,
      'configure_requires'  => \&_get_configure_requires,
      'conflicts'           => \&_get_conflicts,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_downgrade_optional_features,
      'provides'            => \&_provides,
      'recommends'          => \&_get_recommends,
      'requires'            => \&_get_requires,
      'resources'           => \&_downgrade_resources,
  
      # drop these unsupported fields (after conversion)
      ':drop' => [ qw(
        description
        prereqs
        release_status
      )],
  
      # custom keys will be left unchanged
      ':custom'              => \&_keep
    },
    '1.3-from-1.4' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # drop these unsupported fields, but only after we convert
      ':drop' => [ qw(
        configure_requires
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.2-from-1.3' => {
      # MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.1-from-1.2' => {
      # MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      # OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'private'             => \&_keep,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # drop unsupported fields
      ':drop' => [ qw(
        abstract
        author
        provides
        no_index
        keywords
        resources
      )],
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
    '1.0-from-1.1' => {
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # other random keys are OK if already valid
      ':custom'              => \&_keep,
    },
  );
  
  my %cleanup = (
    '2' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_2,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'dynamic_config'      => \&_keep_or_one,
      # ADDED MANDATORY
      'release_status'      => \&_release_status,
      # PRIOR OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_cleanup_optional_features_2,
      'provides'            => \&_provides,
      'resources'           => \&_cleanup_resources_2,
      # ADDED OPTIONAL
      'description'         => \&_keep,
      'prereqs'             => \&_cleanup_prereqs,
  
      # drop these deprecated fields, but only after we convert
      ':drop' => [ qw(
          build_requires
          configure_requires
          conflicts
          distribution_type
          license_url
          private
          recommends
          requires
      ) ],
  
      # other random keys need x_ prefixing
      ':custom'              => \&_prefix_custom,
    },
    '1.4' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_1_4,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_4,
      # ADDED OPTIONAL
      'configure_requires'  => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.3' => {
      # PRIOR MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'meta-spec'           => \&_change_meta_spec,
      'name'                => \&_keep,
      'version'             => \&_keep,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_directory,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      'resources'           => \&_resources_1_3,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.2' => {
      # PRIOR MANDATORY
      'version'             => \&_keep,
      # CHANGED TO MANDATORY
      'license'             => \&_license_1,
      'name'                => \&_keep,
      'generated_by'        => \&_generated_by,
      # ADDED MANDATORY
      'abstract'            => \&_keep_or_unknown,
      'author'              => \&_author_list,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'keywords'            => \&_keep,
      'no_index'            => \&_no_index_1_2,
      'optional_features'   => \&_optional_features_as_map,
      'provides'            => \&_provides,
      'resources'           => \&_resources_1_2,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.1' => {
      # CHANGED TO MANDATORY
      'version'             => \&_keep,
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      # PRIOR OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
      # ADDED OPTIONAL
      'license_url'         => \&_url_or_drop,
      'private'             => \&_keep,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep
    },
    '1.0' => {
      # IMPLIED MANDATORY
      'name'                => \&_keep,
      'meta-spec'           => \&_change_meta_spec,
      'version'             => \&_keep,
      # IMPLIED OPTIONAL
      'build_requires'      => \&_version_map,
      'conflicts'           => \&_version_map,
      'distribution_type'   => \&_keep,
      'dynamic_config'      => \&_keep_or_one,
      'generated_by'        => \&_generated_by,
      'license'             => \&_license_1,
      'recommends'          => \&_version_map,
      'requires'            => \&_version_map,
  
      # other random keys are OK if already valid
      ':custom'             => \&_keep,
    },
  );
  
  #--------------------------------------------------------------------------#
  # Code
  #--------------------------------------------------------------------------#
  
  
  sub new {
    my ($class,$data) = @_;
  
    # create an attributes hash
    my $self = {
      'data'    => $data,
      'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
    };
  
    # create the object
    return bless $self, $class;
  }
  
  
  sub convert {
    my ($self, %args) = @_;
    my $args = { %args };
  
    my $new_version = $args->{version} || $HIGHEST;
  
    my ($old_version) = $self->{spec};
    my $converted = _dclone($self->{data});
  
    if ( $old_version == $new_version ) {
      $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
      my $cmv = CPAN::Meta::Validator->new( $converted );
      unless ( $cmv->is_valid ) {
        my $errs = join("\n", $cmv->errors);
        die "Failed to clean-up $old_version metadata. Errors:\n$errs\n";
      }
      return $converted;
    }
    elsif ( $old_version > $new_version )  {
      my @vers = sort { $b <=> $a } keys %known_specs;
      for my $i ( 0 .. $#vers-1 ) {
        next if $vers[$i] > $old_version;
        last if $vers[$i+1] < $new_version;
        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
        $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
        my $cmv = CPAN::Meta::Validator->new( $converted );
        unless ( $cmv->is_valid ) {
          my $errs = join("\n", $cmv->errors);
          die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
        }
      }
      return $converted;
    }
    else {
      my @vers = sort { $a <=> $b } keys %known_specs;
      for my $i ( 0 .. $#vers-1 ) {
        next if $vers[$i] < $old_version;
        last if $vers[$i+1] > $new_version;
        my $spec_string = "$vers[$i+1]-from-$vers[$i]";
        $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
        my $cmv = CPAN::Meta::Validator->new( $converted );
        unless ( $cmv->is_valid ) {
          my $errs = join("\n", $cmv->errors);
          die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n";
        }
      }
      return $converted;
    }
  }
  
  1;
  
  # ABSTRACT: Convert CPAN distribution metadata structures
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Converter - Convert CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.112621
  
  =head1 SYNOPSIS
  
    my $struct = decode_json_file('META.json');
  
    my $cmc = CPAN::Meta::Converter->new( $struct );
  
    my $new_struct = $cmc->convert( version => "2" );
  
  =head1 DESCRIPTION
  
  This module converts CPAN Meta structures from one form to another.  The
  primary use is to convert older structures to the most modern version of
  the specification, but other transformations may be implemented in the
  future as needed.  (E.g. stripping all custom fields or stripping all
  optional fields.)
  
  =head1 METHODS
  
  =head2 new
  
    my $cmc = CPAN::Meta::Converter->new( $struct );
  
  The constructor should be passed a valid metadata structure but invalid
  structures are accepted.  If no meta-spec version is provided, version 1.0 will
  be assumed.
  
  =head2 convert
  
    my $new_struct = $cmc->convert( version => "2" );
  
  Returns a new hash reference with the metadata converted to a different form.
  C<convert> will die if any conversion/standardization still results in an
  invalid structure.
  
  Valid parameters include:
  
  =over
  
  =item *
  
  C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
  Defaults to the latest version of the CPAN Meta Spec.
  
  =back
  
  Conversion proceeds through each version in turn.  For example, a version 1.2
  structure might be converted to 1.3 then 1.4 then finally to version 2. The
  conversion process attempts to clean-up simple errors and standardize data.
  For example, if C<author> is given as a scalar, it will converted to an array
  reference containing the item. (Converting a structure to its own version will
  also clean-up and standardize.)
  
  When data are cleaned and standardized, missing or invalid fields will be
  replaced with sensible defaults when possible.  This may be lossy or imprecise.
  For example, some badly structured META.yml files on CPAN have prerequisite
  modules listed as both keys and values:
  
    requires => { 'Foo::Bar' => 'Bam::Baz' }
  
  These would be split and each converted to a prerequisite with a minimum
  version of zero.
  
  When some mandatory fields are missing or invalid, the conversion will attempt
  to provide a sensible default or will fill them with a value of 'unknown'.  For
  example a missing or unrecognized C<license> field will result in a C<license>
  field of 'unknown'.  Fields that may get an 'unknown' include:
  
  =over 4
  
  =item *
  
  abstract
  
  =item *
  
  author
  
  =item *
  
  license
  
  =back
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
  
  
  __END__
  
  
CPAN_META_CONVERTER

$fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Feature;
  our $VERSION = '2.112621'; # VERSION
  
  use CPAN::Meta::Prereqs;
  
  
  sub new {
    my ($class, $identifier, $spec) = @_;
  
    my %guts = (
      identifier  => $identifier,
      description => $spec->{description},
      prereqs     => CPAN::Meta::Prereqs->new($spec->{prereqs}),
    );
  
    bless \%guts => $class;
  }
  
  
  sub identifier  { $_[0]{identifier}  }
  
  
  sub description { $_[0]{description} }
  
  
  sub prereqs     { $_[0]{prereqs} }
  
  1;
  
  # ABSTRACT: an optional feature provided by a CPAN distribution
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
  
  =head1 VERSION
  
  version 2.112621
  
  =head1 DESCRIPTION
  
  A CPAN::Meta::Feature object describes an optional feature offered by a CPAN
  distribution and specified in the distribution's F<META.json> (or F<META.yml>)
  file.
  
  For the most part, this class will only be used when operating on the result of
  the C<feature> or C<features> methods on a L<CPAN::Meta> object.
  
  =head1 METHODS
  
  =head2 new
  
    my $feature = CPAN::Meta::Feature->new( $identifier => \%spec );
  
  This returns a new Feature object.  The C<%spec> argument to the constructor
  should be the same as the value of the C<optional_feature> entry in the
  distmeta.  It must contain entries for C<description> and C<prereqs>.
  
  =head2 identifier
  
  This method returns the feature's identifier.
  
  =head2 description
  
  This method returns the feature's long description.
  
  =head2 prereqs
  
  This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs>
  object.
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
  
  
  __END__
  
  
  
CPAN_META_FEATURE

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

$fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Prereqs;
  our $VERSION = '2.112621'; # VERSION
  
  
  use Carp qw(confess);
  use Scalar::Util qw(blessed);
  use Version::Requirements 0.101020; # finalize
  
  
  sub __legal_phases { qw(configure build test runtime develop)   }
  sub __legal_types  { qw(requires recommends suggests conflicts) }
  
  # expect a prereq spec from META.json -- rjbs, 2010-04-11
  sub new {
    my ($class, $prereq_spec) = @_;
    $prereq_spec ||= {};
  
    my %is_legal_phase = map {; $_ => 1 } $class->__legal_phases;
    my %is_legal_type  = map {; $_ => 1 } $class->__legal_types;
  
    my %guts;
    PHASE: for my $phase (keys %$prereq_spec) {
      next PHASE unless $phase =~ /\Ax_/i or $is_legal_phase{$phase};
  
      my $phase_spec = $prereq_spec->{ $phase };
      next PHASE unless keys %$phase_spec;
  
      TYPE: for my $type (keys %$phase_spec) {
        next TYPE unless $type =~ /\Ax_/i or $is_legal_type{$type};
  
        my $spec = $phase_spec->{ $type };
  
        next TYPE unless keys %$spec;
  
        $guts{prereqs}{$phase}{$type} = Version::Requirements->from_string_hash(
          $spec
        );
      }
    }
  
    return bless \%guts => $class;
  }
  
  
  sub requirements_for {
    my ($self, $phase, $type) = @_;
  
    confess "requirements_for called without phase" unless defined $phase;
    confess "requirements_for called without type"  unless defined $type;
  
    unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) {
      confess "requested requirements for unknown phase: $phase";
    }
  
    unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) {
      confess "requested requirements for unknown type: $type";
    }
  
    my $req = ($self->{prereqs}{$phase}{$type} ||= Version::Requirements->new);
  
    $req->finalize if $self->is_finalized;
  
    return $req;
  }
  
  
  sub with_merged_prereqs {
    my ($self, $other) = @_;
  
    my @other = blessed($other) ? $other : @$other;
  
    my @prereq_objs = ($self, @other);
  
    my %new_arg;
  
    for my $phase ($self->__legal_phases) {
      for my $type ($self->__legal_types) {
        my $req = Version::Requirements->new;
  
        for my $prereq (@prereq_objs) {
          my $this_req = $prereq->requirements_for($phase, $type);
          next unless $this_req->required_modules;
  
          $req->add_requirements($this_req);
        }
  
        next unless $req->required_modules;
  
        $new_arg{ $phase }{ $type } = $req->as_string_hash;
      }
    }
  
    return (ref $self)->new(\%new_arg);
  }
  
  
  sub as_string_hash {
    my ($self) = @_;
  
    my %hash;
  
    for my $phase ($self->__legal_phases) {
      for my $type ($self->__legal_types) {
        my $req = $self->requirements_for($phase, $type);
        next unless $req->required_modules;
  
        $hash{ $phase }{ $type } = $req->as_string_hash;
      }
    }
  
    return \%hash;
  }
  
  
  sub is_finalized { $_[0]{finalized} }
  
  
  sub finalize {
    my ($self) = @_;
  
    $self->{finalized} = 1;
  
    for my $phase (keys %{ $self->{prereqs} }) {
      $_->finalize for values %{ $self->{prereqs}{$phase} };
    }
  }
  
  
  sub clone {
    my ($self) = @_;
  
    my $clone = (ref $self)->new( $self->as_string_hash );
  }
  
  1;
  
  # ABSTRACT: a set of distribution prerequisites by phase and type
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
  
  =head1 VERSION
  
  version 2.112621
  
  =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<Version::Requirements> object for the given phase/type
  combination.  If no prerequisites are registered for that combination, a new
  Version::Requirements object will be returned, and it may be added to as
  needed.
  
  If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
  be raised.
  
  =head2 with_merged_prereqs
  
    my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
  
    my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs );
  
  This method returns a new CPAN::Meta::Prereqs objects in which all the
  other prerequisites given are merged into the current set.  This is primarily
  provided for combining a distribution's core prereqs with the prereqs of one of
  its optional features.
  
  The new prereqs object has no ties to the originals, and altering it further
  will not alter them.
  
  =head2 as_string_hash
  
  This method returns a hashref containing structures suitable for dumping into a
  distmeta data structure.  It is made up of hashes and strings, only; there will
  be no Prereqs, Version::Requirements, or C<version> objects inside it.
  
  =head2 is_finalized
  
  This method returns true if the set of prereqs has been marked "finalized," and
  cannot be altered.
  
  =head2 finalize
  
  Calling C<finalize> on a Prereqs object will close it for further modification.
  Attempting to make any changes that would actually alter the prereqs will
  result in an exception being thrown.
  
  =head2 clone
  
    my $cloned_prereqs = $prereqs->clone;
  
  This method returns a Prereqs object that is identical to the original object,
  but can be altered without affecting the original object.  Finalization does
  not survive cloning, meaning that you may clone a finalized set of prereqs and
  then modify the clone.
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
  
  
  __END__
  
  
  
CPAN_META_PREREQS

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

$fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
  use 5.006;
  use strict;
  use warnings;
  package CPAN::Meta::Validator;
  our $VERSION = '2.112621'; # VERSION
  
  
  #--------------------------------------------------------------------------#
  # This code copied and adapted from Test::CPAN::Meta
  # by Barbie, <barbie@cpan.org> for Miss Barbell Productions,
  # L<http://www.missbarbell.co.uk>
  #--------------------------------------------------------------------------#
  
  #--------------------------------------------------------------------------#
  # Specification Definitions
  #--------------------------------------------------------------------------#
  
  my %known_specs = (
      '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
      '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
      '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
      '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
      '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
  );
  my %known_urls = map {$known_specs{$_} => $_} keys %known_specs;
  
  my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } };
  
  my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version   } } };
  
  my $no_index_2 = {
      'map'       => { file       => { list => { value => \&string } },
                       directory  => { list => { value => \&string } },
                       'package'  => { list => { value => \&string } },
                       namespace  => { list => { value => \&string } },
                      ':key'      => { name => \&custom_2, value => \&anything },
      }
  };
  
  my $no_index_1_3 = {
      'map'       => { file       => { list => { value => \&string } },
                       directory  => { list => { value => \&string } },
                       'package'  => { list => { value => \&string } },
                       namespace  => { list => { value => \&string } },
                       ':key'     => { name => \&string, value => \&anything },
      }
  };
  
  my $no_index_1_2 = {
      'map'       => { file       => { list => { value => \&string } },
                       dir        => { list => { value => \&string } },
                       'package'  => { list => { value => \&string } },
                       namespace  => { list => { value => \&string } },
                       ':key'     => { name => \&string, value => \&anything },
      }
  };
  
  my $no_index_1_1 = {
      'map'       => { ':key'     => { name => \&string, list => { value => \&string } },
      }
  };
  
  my $prereq_map = {
    map => {
      ':key' => {
        name => \&phase,
        'map' => {
          ':key'  => {
            name => \&relation,
            %$module_map1,
          },
        },
      }
    },
  };
  
  my %definitions = (
    '2' => {
      # REQUIRED
      'abstract'            => { mandatory => 1, value => \&string  },
      'author'              => { mandatory => 1, lazylist => { value => \&string } },
      'dynamic_config'      => { mandatory => 1, value => \&boolean },
      'generated_by'        => { mandatory => 1, value => \&string  },
      'license'             => { mandatory => 1, lazylist => { value => \&license } },
      'meta-spec' => {
        mandatory => 1,
        'map' => {
          version => { mandatory => 1, value => \&version},
          url     => { value => \&url },
          ':key' => { name => \&custom_2, value => \&anything },
        }
      },
      'name'                => { mandatory => 1, value => \&string  },
      'release_status'      => { mandatory => 1, value => \&release_status },
      'version'             => { mandatory => 1, value => \&version },
  
      # OPTIONAL
      'description' => { value => \&string },
      'keywords'    => { lazylist => { value => \&string } },
      'no_index'    => $no_index_2,
      'optional_features'   => {
        'map'       => {
          ':key'  => {
            name => \&string,
            'map'   => {
              description        => { value => \&string },
              prereqs => $prereq_map,
              ':key' => { name => \&custom_2, value => \&anything },
            }
          }
        }
      },
      'prereqs' => $prereq_map,
      'provides'    => {
        'map'       => {
          ':key' => {
            name  => \&module,
            'map' => {
              file    => { mandatory => 1, value => \&file },
              version => { value => \&version },
              ':key' => { name => \&custom_2, value => \&anything },
            }
          }
        }
      },
      'resources'   => {
        'map'       => {
          license    => { lazylist => { value => \&url } },
          homepage   => { value => \&url },
          bugtracker => {
            'map' => {
              web => { value => \&url },
              mailto => { value => \&string},
              ':key' => { name => \&custom_2, value => \&anything },
            }
          },
          repository => {
            'map' => {
              web => { value => \&url },
              url => { value => \&url },
              type => { value => \&string },
              ':key' => { name => \&custom_2, value => \&anything },
            }
          },
          ':key'     => { value => \&string, name => \&custom_2 },
        }
      },
  
      # CUSTOM -- additional user defined key/value pairs
      # note we can only validate the key name, as the structure is user defined
      ':key'        => { name => \&custom_2, value => \&anything },
    },
  
  '1.4' => {
    'meta-spec'           => {
      mandatory => 1,
      'map' => {
        version => { mandatory => 1, value => \&version},
        url     => { mandatory => 1, value => \&urlspec },
        ':key'  => { name => \&string, value => \&anything },
      },
    },
  
    'name'                => { mandatory => 1, value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'abstract'            => { mandatory => 1, value => \&string  },
    'author'              => { mandatory => 1, list  => { value => \&string } },
    'license'             => { mandatory => 1, value => \&license },
    'generated_by'        => { mandatory => 1, value => \&string  },
  
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'configure_requires'  => $module_map1,
    'conflicts'           => $module_map2,
  
    'optional_features'   => {
      'map'       => {
          ':key'  => { name => \&string,
              'map'   => { description        => { value => \&string },
                           requires           => $module_map1,
                           recommends         => $module_map1,
                           build_requires     => $module_map1,
                           conflicts          => $module_map2,
                           ':key'  => { name => \&string, value => \&anything },
              }
          }
       }
    },
  
    'provides'    => {
      'map'       => {
        ':key' => { name  => \&module,
          'map' => {
            file    => { mandatory => 1, value => \&file },
            version => { value => \&version },
            ':key'  => { name => \&string, value => \&anything },
          }
        }
      }
    },
  
    'no_index'    => $no_index_1_3,
    'private'     => $no_index_1_3,
  
    'keywords'    => { list => { value => \&string } },
  
    'resources'   => {
      'map'       => { license    => { value => \&url },
                       homepage   => { value => \&url },
                       bugtracker => { value => \&url },
                       repository => { value => \&url },
                       ':key'     => { value => \&string, name => \&custom_1 },
      }
    },
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  '1.3' => {
    'meta-spec'           => {
      mandatory => 1,
      'map' => {
        version => { mandatory => 1, value => \&version},
        url     => { mandatory => 1, value => \&urlspec },
        ':key'  => { name => \&string, value => \&anything },
      },
    },
  
    'name'                => { mandatory => 1, value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'abstract'            => { mandatory => 1, value => \&string  },
    'author'              => { mandatory => 1, list  => { value => \&string } },
    'license'             => { mandatory => 1, value => \&license },
    'generated_by'        => { mandatory => 1, value => \&string  },
  
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    'optional_features'   => {
      'map'       => {
          ':key'  => { name => \&string,
              'map'   => { description        => { value => \&string },
                           requires           => $module_map1,
                           recommends         => $module_map1,
                           build_requires     => $module_map1,
                           conflicts          => $module_map2,
                           ':key'  => { name => \&string, value => \&anything },
              }
          }
       }
    },
  
    'provides'    => {
      'map'       => {
        ':key' => { name  => \&module,
          'map' => {
            file    => { mandatory => 1, value => \&file },
            version => { value => \&version },
            ':key'  => { name => \&string, value => \&anything },
          }
        }
      }
    },
  
  
    'no_index'    => $no_index_1_3,
    'private'     => $no_index_1_3,
  
    'keywords'    => { list => { value => \&string } },
  
    'resources'   => {
      'map'       => { license    => { value => \&url },
                       homepage   => { value => \&url },
                       bugtracker => { value => \&url },
                       repository => { value => \&url },
                       ':key'     => { value => \&string, name => \&custom_1 },
      }
    },
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  # v1.2 is misleading, it seems to assume that a number of fields where created
  # within v1.1, when they were created within v1.2. This may have been an
  # original mistake, and that a v1.1 was retro fitted into the timeline, when
  # v1.2 was originally slated as v1.1. But I could be wrong ;)
  '1.2' => {
    'meta-spec'           => {
      mandatory => 1,
      'map' => {
        version => { mandatory => 1, value => \&version},
        url     => { mandatory => 1, value => \&urlspec },
        ':key'  => { name => \&string, value => \&anything },
      },
    },
  
  
    'name'                => { mandatory => 1, value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'license'             => { mandatory => 1, value => \&license },
    'generated_by'        => { mandatory => 1, value => \&string  },
    'author'              => { mandatory => 1, list => { value => \&string } },
    'abstract'            => { mandatory => 1, value => \&string  },
  
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'keywords'            => { list => { value => \&string } },
  
    'private'             => $no_index_1_2,
    '$no_index'           => $no_index_1_2,
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    'optional_features'   => {
      'map'       => {
          ':key'  => { name => \&string,
              'map'   => { description        => { value => \&string },
                           requires           => $module_map1,
                           recommends         => $module_map1,
                           build_requires     => $module_map1,
                           conflicts          => $module_map2,
                           ':key'  => { name => \&string, value => \&anything },
              }
          }
       }
    },
  
    'provides'    => {
      'map'       => {
        ':key' => { name  => \&module,
          'map' => {
            file    => { mandatory => 1, value => \&file },
            version => { value => \&version },
            ':key'  => { name => \&string, value => \&anything },
          }
        }
      }
    },
  
    'resources'   => {
      'map'       => { license    => { value => \&url },
                       homepage   => { value => \&url },
                       bugtracker => { value => \&url },
                       repository => { value => \&url },
                       ':key'     => { value => \&string, name => \&custom_1 },
      }
    },
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  # note that the 1.1 spec only specifies 'version' as mandatory
  '1.1' => {
    'name'                => { value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'license'             => { value => \&license },
    'generated_by'        => { value => \&string  },
  
    'license_uri'         => { value => \&url },
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'private'             => $no_index_1_1,
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  
  # note that the 1.0 spec doesn't specify optional or mandatory fields
  # but we will treat version as mandatory since otherwise META 1.0 is
  # completely arbitrary and pointless
  '1.0' => {
    'name'                => { value => \&string  },
    'version'             => { mandatory => 1, value => \&version },
    'license'             => { value => \&license },
    'generated_by'        => { value => \&string  },
  
    'license_uri'         => { value => \&url },
    'distribution_type'   => { value => \&string  },
    'dynamic_config'      => { value => \&boolean },
  
    'requires'            => $module_map1,
    'recommends'          => $module_map1,
    'build_requires'      => $module_map1,
    'conflicts'           => $module_map2,
  
    # additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        => { name => \&string, value => \&anything },
  },
  );
  
  #--------------------------------------------------------------------------#
  # Code
  #--------------------------------------------------------------------------#
  
  
  sub new {
    my ($class,$data) = @_;
  
    # create an attributes hash
    my $self = {
      'data'    => $data,
      'spec'    => $data->{'meta-spec'}{'version'} || "1.0",
      'errors'  => undef,
    };
  
    # create the object
    return bless $self, $class;
  }
  
  
  sub is_valid {
      my $self = shift;
      my $data = $self->{data};
      my $spec_version = $self->{spec};
      $self->check_map($definitions{$spec_version},$data);
      return ! $self->errors;
  }
  
  
  sub errors {
      my $self = shift;
      return ()   unless(defined $self->{errors});
      return @{$self->{errors}};
  }
  
  
  my $spec_error = "Missing validation action in specification. "
    . "Must be one of 'map', 'list', 'lazylist', or 'value'";
  
  sub check_map {
      my ($self,$spec,$data) = @_;
  
      if(ref($spec) ne 'HASH') {
          $self->_error( "Unknown META specification, cannot validate." );
          return;
      }
  
      if(ref($data) ne 'HASH') {
          $self->_error( "Expected a map structure from string or file." );
          return;
      }
  
      for my $key (keys %$spec) {
          next    unless($spec->{$key}->{mandatory});
          next    if(defined $data->{$key});
          push @{$self->{stack}}, $key;
          $self->_error( "Missing mandatory field, '$key'" );
          pop @{$self->{stack}};
      }
  
      for my $key (keys %$data) {
          push @{$self->{stack}}, $key;
          if($spec->{$key}) {
              if($spec->{$key}{value}) {
                  $spec->{$key}{value}->($self,$key,$data->{$key});
              } elsif($spec->{$key}{'map'}) {
                  $self->check_map($spec->{$key}{'map'},$data->{$key});
              } elsif($spec->{$key}{'list'}) {
                  $self->check_list($spec->{$key}{'list'},$data->{$key});
              } elsif($spec->{$key}{'lazylist'}) {
                  $self->check_lazylist($spec->{$key}{'lazylist'},$data->{$key});
              } else {
                  $self->_error( "$spec_error for '$key'" );
              }
  
          } elsif ($spec->{':key'}) {
              $spec->{':key'}{name}->($self,$key,$key);
              if($spec->{':key'}{value}) {
                  $spec->{':key'}{value}->($self,$key,$data->{$key});
              } elsif($spec->{':key'}{'map'}) {
                  $self->check_map($spec->{':key'}{'map'},$data->{$key});
              } elsif($spec->{':key'}{'list'}) {
                  $self->check_list($spec->{':key'}{'list'},$data->{$key});
              } elsif($spec->{':key'}{'lazylist'}) {
                  $self->check_lazylist($spec->{':key'}{'lazylist'},$data->{$key});
              } else {
                  $self->_error( "$spec_error for ':key'" );
              }
  
  
          } else {
              $self->_error( "Unknown key, '$key', found in map structure" );
          }
          pop @{$self->{stack}};
      }
  }
  
  # if it's a string, make it into a list and check the list
  sub check_lazylist {
      my ($self,$spec,$data) = @_;
  
      if ( defined $data && ! ref($data) ) {
        $data = [ $data ];
      }
  
      $self->check_list($spec,$data);
  }
  
  sub check_list {
      my ($self,$spec,$data) = @_;
  
      if(ref($data) ne 'ARRAY') {
          $self->_error( "Expected a list structure" );
          return;
      }
  
      if(defined $spec->{mandatory}) {
          if(!defined $data->[0]) {
              $self->_error( "Missing entries from mandatory list" );
          }
      }
  
      for my $value (@$data) {
          push @{$self->{stack}}, $value || "<undef>";
          if(defined $spec->{value}) {
              $spec->{value}->($self,'list',$value);
          } elsif(defined $spec->{'map'}) {
              $self->check_map($spec->{'map'},$value);
          } elsif(defined $spec->{'list'}) {
              $self->check_list($spec->{'list'},$value);
          } elsif(defined $spec->{'lazylist'}) {
              $self->check_lazylist($spec->{'lazylist'},$value);
          } elsif ($spec->{':key'}) {
              $self->check_map($spec,$value);
          } else {
            $self->_error( "$spec_error associated with '$self->{stack}[-2]'" );
          }
          pop @{$self->{stack}};
      }
  }
  
  
  sub header {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value && $value =~ /^--- #YAML:1.0/);
      }
      $self->_error( "file does not have a valid YAML header." );
      return 0;
  }
  
  sub release_status {
    my ($self,$key,$value) = @_;
    if(defined $value) {
      my $version = $self->{data}{version} || '';
      if ( $version =~ /_/ ) {
        return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
        $self->_error( "'$value' for '$key' is invalid for version '$version'" );
      }
      else {
        return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
        $self->_error( "'$value' for '$key' is invalid" );
      }
    }
    else {
      $self->_error( "'$key' is not defined" );
    }
    return 0;
  }
  
  # _uri_split taken from URI::Split by Gisle Aas, Copyright 2003
  sub _uri_split {
       return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
  }
  
  sub url {
      my ($self,$key,$value) = @_;
      if(defined $value) {
        my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
        unless ( defined $scheme && length $scheme ) {
          $self->_error( "'$value' for '$key' does not have a URL scheme" );
          return 0;
        }
        unless ( defined $auth && length $auth ) {
          $self->_error( "'$value' for '$key' does not have a URL authority" );
          return 0;
        }
        return 1;
      }
      $value ||= '';
      $self->_error( "'$value' for '$key' is not a valid URL." );
      return 0;
  }
  
  sub urlspec {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value && $known_specs{$self->{spec}} eq $value);
          if($value && $known_urls{$value}) {
              $self->_error( 'META specification URL does not match version' );
              return 0;
          }
      }
      $self->_error( 'Unknown META specification' );
      return 0;
  }
  
  sub anything { return 1 }
  
  sub string {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value || $value =~ /^0$/);
      }
      $self->_error( "value is an undefined string" );
      return 0;
  }
  
  sub string_or_undef {
      my ($self,$key,$value) = @_;
      return 1    unless(defined $value);
      return 1    if($value || $value =~ /^0$/);
      $self->_error( "No string defined for '$key'" );
      return 0;
  }
  
  sub file {
      my ($self,$key,$value) = @_;
      return 1    if(defined $value);
      $self->_error( "No file defined for '$key'" );
      return 0;
  }
  
  sub exversion {
      my ($self,$key,$value) = @_;
      if(defined $value && ($value || $value =~ /0/)) {
          my $pass = 1;
          for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
          return $pass;
      }
      $value = '<undef>'  unless(defined $value);
      $self->_error( "'$value' for '$key' is not a valid version." );
      return 0;
  }
  
  sub version {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 0    unless($value || $value =~ /0/);
          return 1    if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
      } else {
          $value = '<undef>';
      }
      $self->_error( "'$value' for '$key' is not a valid version." );
      return 0;
  }
  
  sub boolean {
      my ($self,$key,$value) = @_;
      if(defined $value) {
          return 1    if($value =~ /^(0|1|true|false)$/);
      } else {
          $value = '<undef>';
      }
      $self->_error( "'$value' for '$key' is not a boolean value." );
      return 0;
  }
  
  my %v1_licenses = (
      'perl'         => 'http://dev.perl.org/licenses/',
      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
      'apache'       => 'http://apache.org/licenses/LICENSE-2.0',
      'artistic'     => 'http://opensource.org/licenses/artistic-license.php',
      'artistic_2'   => 'http://opensource.org/licenses/artistic-license-2.0.php',
      'lgpl'         => 'http://www.opensource.org/licenses/lgpl-license.php',
      'bsd'          => 'http://www.opensource.org/licenses/bsd-license.php',
      'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
      'mit'          => 'http://opensource.org/licenses/mit-license.php',
      'mozilla'      => 'http://opensource.org/licenses/mozilla1.1.php',
      'open_source'  => undef,
      'unrestricted' => undef,
      'restrictive'  => undef,
      'unknown'      => undef,
  );
  
  my %v2_licenses = map { $_ => 1 } qw(
    agpl_3
    apache_1_1
    apache_2_0
    artistic_1
    artistic_2
    bsd
    freebsd
    gfdl_1_2
    gfdl_1_3
    gpl_1
    gpl_2
    gpl_3
    lgpl_2_1
    lgpl_3_0
    mit
    mozilla_1_0
    mozilla_1_1
    openssl
    perl_5
    qpl_1_0
    ssleay
    sun
    zlib
    open_source
    restricted
    unrestricted
    unknown
  );
  
  sub license {
      my ($self,$key,$value) = @_;
      my $licenses = $self->{spec} < 2 ? \%v1_licenses : \%v2_licenses;
      if(defined $value) {
          return 1    if($value && exists $licenses->{$value});
      } else {
          $value = '<undef>';
      }
      $self->_error( "License '$value' is invalid" );
      return 0;
  }
  
  sub custom_1 {
      my ($self,$key) = @_;
      if(defined $key) {
          # a valid user defined key should be alphabetic
          # and contain at least one capital case letter.
          return 1    if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/);
      } else {
          $key = '<undef>';
      }
      $self->_error( "Custom resource '$key' must be in CamelCase." );
      return 0;
  }
  
  sub custom_2 {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^x_/i);  # user defined
      } else {
          $key = '<undef>';
      }
      $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." );
      return 0;
  }
  
  sub identifier {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^([a-z][_a-z]+)$/i);    # spec 2.0 defined
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal identifier." );
      return 0;
  }
  
  sub module {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1    if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal module name." );
      return 0;
  }
  
  my @valid_phases = qw/ configure build test runtime develop /;
  sub phase {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1 if( length $key && grep { $key eq $_ } @valid_phases );
          return 1 if $key =~ /x_/i;
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal phase." );
      return 0;
  }
  
  my @valid_relations = qw/ requires recommends suggests conflicts /;
  sub relation {
      my ($self,$key) = @_;
      if(defined $key) {
          return 1 if( length $key && grep { $key eq $_ } @valid_relations );
          return 1 if $key =~ /x_/i;
      } else {
          $key = '<undef>';
      }
      $self->_error( "Key '$key' is not a legal prereq relationship." );
      return 0;
  }
  
  sub _error {
      my $self = shift;
      my $mess = shift;
  
      $mess .= ' ('.join(' -> ',@{$self->{stack}}).')'  if($self->{stack});
      $mess .= " [Validation: $self->{spec}]";
  
      push @{$self->{errors}}, $mess;
  }
  
  1;
  
  # ABSTRACT: validate CPAN distribution metadata structures
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::Validator - validate CPAN distribution metadata structures
  
  =head1 VERSION
  
  version 2.112621
  
  =head1 SYNOPSIS
  
    my $struct = decode_json_file('META.json');
  
    my $cmv = CPAN::Meta::Validator->new( $struct );
  
    unless ( $cmv->is_valid ) {
      my $msg = "Invalid META structure.  Errors found:\n";
      $msg .= join( "\n", $cmv->errors );
      die $msg;
    }
  
  =head1 DESCRIPTION
  
  This module validates a CPAN Meta structure against the version of the
  the specification claimed in the C<meta-spec> field of the structure.
  
  =head1 METHODS
  
  =head2 new
  
    my $cmv = CPAN::Meta::Validator->new( $struct )
  
  The constructor must be passed a metadata structure.
  
  =head2 is_valid
  
    if ( $cmv->is_valid ) {
      ...
    }
  
  Returns a boolean value indicating whether the metadata provided
  is valid.
  
  =head2 errors
  
    warn( join "\n", $cmv->errors );
  
  Returns a list of errors seen during validation.
  
  =begin :internals
  
  =head2 Check Methods
  
  =over
  
  =item *
  
  check_map($spec,$data)
  
  Checks whether a map (or hash) part of the data structure conforms to the
  appropriate specification definition.
  
  =item *
  
  check_list($spec,$data)
  
  Checks whether a list (or array) part of the data structure conforms to
  the appropriate specification definition.
  
  =item *
  
  check_lazylist($spec,$data)
  
  Checks whether a list conforms, but converts strings to a single-element list
  
  =back
  
  =head2 Validator Methods
  
  =over
  
  =item *
  
  header($self,$key,$value)
  
  Validates that the header is valid.
  
  Note: No longer used as we now read the data structure, not the file.
  
  =item *
  
  url($self,$key,$value)
  
  Validates that a given value is in an acceptable URL format
  
  =item *
  
  urlspec($self,$key,$value)
  
  Validates that the URL to a META specification is a known one.
  
  =item *
  
  string_or_undef($self,$key,$value)
  
  Validates that the value is either a string or an undef value. Bit of a
  catchall function for parts of the data structure that are completely user
  defined.
  
  =item *
  
  string($self,$key,$value)
  
  Validates that a string exists for the given key.
  
  =item *
  
  file($self,$key,$value)
  
  Validate that a file is passed for the given key. This may be made more
  thorough in the future. For now it acts like \&string.
  
  =item *
  
  exversion($self,$key,$value)
  
  Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
  
  =item *
  
  version($self,$key,$value)
  
  Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
  are both valid. A leading 'v' like 'v1.2.3' is also valid.
  
  =item *
  
  boolean($self,$key,$value)
  
  Validates for a boolean value. Currently these values are '1', '0', 'true',
  'false', however the latter 2 may be removed.
  
  =item *
  
  license($self,$key,$value)
  
  Validates that a value is given for the license. Returns 1 if an known license
  type, or 2 if a value is given but the license type is not a recommended one.
  
  =item *
  
  custom_1($self,$key,$value)
  
  Validates that the given key is in CamelCase, to indicate a user defined
  keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
  of the spec, this was only explicitly stated for 'resources'.
  
  =item *
  
  custom_2($self,$key,$value)
  
  Validates that the given key begins with 'x_' or 'X_', to indicate a user
  defined keyword and only has characters in the class [-_a-zA-Z]
  
  =item *
  
  identifier($self,$key,$value)
  
  Validates that key is in an acceptable format for the META specification,
  for an identifier, i.e. any that matches the regular expression
  qr/[a-z][a-z_]/i.
  
  =item *
  
  module($self,$key,$value)
  
  Validates that a given key is in an acceptable module name format, e.g.
  'Test::CPAN::Meta::Version'.
  
  =back
  
  =end :internals
  
  =for Pod::Coverage anything boolean check_lazylist check_list custom_1 custom_2 exversion file
  identifier license module phase relation release_status string string_or_undef
  url urlspec version header check_map
  
  =head1 BUGS
  
  Please report any bugs or feature using the CPAN Request Tracker.
  Bugs can be submitted through the web interface at
  L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
  
  When submitting a bug or request, please include a test-file or a patch to an
  existing test-file that illustrates the bug or desired feature.
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Ricardo Signes <rjbs@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by David Golden and Ricardo Signes.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
  
  
  __END__
  
  
  
CPAN_META_VALIDATOR

$fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
  package CPAN::Meta::YAML;
  {
    $CPAN::Meta::YAML::VERSION = '0.008';
  }
  
  use strict;
  
  # UTF Support?
  sub HAVE_UTF8 () { $] >= 5.007003 }
  BEGIN {
  	if ( HAVE_UTF8 ) {
  		# The string eval helps hide this from Test::MinimumVersion
  		eval "require utf8;";
  		die "Failed to load UTF-8 support" if $@;
  	}
  
  	# Class structure
  	require 5.004;
  	require Exporter;
  	require Carp;
  	@CPAN::Meta::YAML::ISA       = qw{ Exporter  };
  	@CPAN::Meta::YAML::EXPORT    = qw{ Load Dump };
  	@CPAN::Meta::YAML::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
  
  	# Error storage
  	$CPAN::Meta::YAML::errstr    = '';
  }
  
  # The character class of all characters we need to escape
  # NOTE: Inlined, since it's only used once
  # my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
  
  # Printed form of the unprintable characters in the lowest range
  # of ASCII characters, listed by ASCII ordinal position.
  my @UNPRINTABLE = qw(
  	z    x01  x02  x03  x04  x05  x06  a
  	x08  t    n    v    f    r    x0e  x0f
  	x10  x11  x12  x13  x14  x15  x16  x17
  	x18  x19  x1a  e    x1c  x1d  x1e  x1f
  );
  
  # Printable characters for escapes
  my %UNESCAPES = (
  	z => "\x00", a => "\x07", t    => "\x09",
  	n => "\x0a", v => "\x0b", f    => "\x0c",
  	r => "\x0d", e => "\x1b", '\\' => '\\',
  );
  
  # Special magic boolean words
  my %QUOTE = map { $_ => 1 } qw{
  	null Null NULL
  	y Y yes Yes YES n N no No NO
  	true True TRUE false False FALSE
  	on On ON off Off OFF
  };
  
  
  
  
  
  #####################################################################
  # Implementation
  
  # Create an empty CPAN::Meta::YAML object
  sub new {
  	my $class = shift;
  	bless [ @_ ], $class;
  }
  
  # Create an object from a file
  sub read {
  	my $class = ref $_[0] ? ref shift : shift;
  
  	# Check the file
  	my $file = shift or return $class->_error( 'You did not specify a file name' );
  	return $class->_error( "File '$file' does not exist" )              unless -e $file;
  	return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
  	return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
  
  	# Slurp in the file
  	local $/ = undef;
  	local *CFG;
  	unless ( open(CFG, $file) ) {
  		return $class->_error("Failed to open file '$file': $!");
  	}
  	my $contents = <CFG>;
  	unless ( close(CFG) ) {
  		return $class->_error("Failed to close file '$file': $!");
  	}
  
  	$class->read_string( $contents );
  }
  
  # Create an object from a string
  sub read_string {
  	my $class  = ref $_[0] ? ref shift : shift;
  	my $self   = bless [], $class;
  	my $string = $_[0];
  	eval {
  		unless ( defined $string ) {
  			die \"Did not provide a string to load";
  		}
  
  		# Byte order marks
  		# NOTE: Keeping this here to educate maintainers
  		# my %BOM = (
  		#     "\357\273\277" => 'UTF-8',
  		#     "\376\377"     => 'UTF-16BE',
  		#     "\377\376"     => 'UTF-16LE',
  		#     "\377\376\0\0" => 'UTF-32LE'
  		#     "\0\0\376\377" => 'UTF-32BE',
  		# );
  		if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
  			die \"Stream has a non UTF-8 BOM";
  		} else {
  			# Strip UTF-8 bom if found, we'll just ignore it
  			$string =~ s/^\357\273\277//;
  		}
  
  		# Try to decode as utf8
  		utf8::decode($string) if HAVE_UTF8;
  
  		# Check for some special cases
  		return $self unless length $string;
  		unless ( $string =~ /[\012\015]+\z/ ) {
  			die \"Stream does not end with newline character";
  		}
  
  		# Split the file into lines
  		my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
  			    split /(?:\015{1,2}\012|\015|\012)/, $string;
  
  		# Strip the initial YAML header
  		@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
  
  		# A nibbling parser
  		while ( @lines ) {
  			# Do we have a document header?
  			if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
  				# Handle scalar documents
  				shift @lines;
  				if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
  					push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
  					next;
  				}
  			}
  
  			if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
  				# A naked document
  				push @$self, undef;
  				while ( @lines and $lines[0] !~ /^---/ ) {
  					shift @lines;
  				}
  
  			} elsif ( $lines[0] =~ /^\s*\-/ ) {
  				# An array at the root
  				my $document = [ ];
  				push @$self, $document;
  				$self->_read_array( $document, [ 0 ], \@lines );
  
  			} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
  				# A hash at the root
  				my $document = { };
  				push @$self, $document;
  				$self->_read_hash( $document, [ length($1) ], \@lines );
  
  			} else {
  				die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
  			}
  		}
  	};
  	if ( ref $@ eq 'SCALAR' ) {
  		return $self->_error(${$@});
  	} elsif ( $@ ) {
  		require Carp;
  		Carp::croak($@);
  	}
  
  	return $self;
  }
  
  # Deparse a scalar string to the actual scalar
  sub _read_scalar {
  	my ($self, $string, $indent, $lines) = @_;
  
  	# Trim trailing whitespace
  	$string =~ s/\s*\z//;
  
  	# Explitic null/undef
  	return undef if $string eq '~';
  
  	# Single quote
  	if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
  		return '' unless defined $1;
  		$string = $1;
  		$string =~ s/\'\'/\'/g;
  		return $string;
  	}
  
  	# Double quote.
  	# The commented out form is simpler, but overloaded the Perl regex
  	# engine due to recursion and backtracking problems on strings
  	# larger than 32,000ish characters. Keep it for reference purposes.
  	# if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
  	if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) {
  		# Reusing the variable is a little ugly,
  		# but avoids a new variable and a string copy.
  		$string = $1;
  		$string =~ s/\\"/"/g;
  		$string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
  		return $string;
  	}
  
  	# Special cases
  	if ( $string =~ /^[\'\"!&]/ ) {
  		die \"CPAN::Meta::YAML does not support a feature in line '$string'";
  	}
  	return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
  	return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
  
  	# Regular unquoted string
  	if ( $string !~ /^[>|]/ ) {
  		if (
  			$string =~ /^(?:-(?:\s|$)|[\@\%\`])/
  			or
  			$string =~ /:(?:\s|$)/
  		) {
  			die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'";
  		}
  		$string =~ s/\s+#.*\z//;
  		return $string;
  	}
  
  	# Error
  	die \"CPAN::Meta::YAML failed to find multi-line scalar content" unless @$lines;
  
  	# Check the indent depth
  	$lines->[0]   =~ /^(\s*)/;
  	$indent->[-1] = length("$1");
  	if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
  		die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
  	}
  
  	# Pull the lines
  	my @multiline = ();
  	while ( @$lines ) {
  		$lines->[0] =~ /^(\s*)/;
  		last unless length($1) >= $indent->[-1];
  		push @multiline, substr(shift(@$lines), length($1));
  	}
  
  	my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
  	my $t = (substr($string, 1, 1) eq '-') ? ''  : "\n";
  	return join( $j, @multiline ) . $t;
  }
  
  # Parse an array
  sub _read_array {
  	my ($self, $array, $indent, $lines) = @_;
  
  	while ( @$lines ) {
  		# Check for a new document
  		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
  			while ( @$lines and $lines->[0] !~ /^---/ ) {
  				shift @$lines;
  			}
  			return 1;
  		}
  
  		# Check the indent level
  		$lines->[0] =~ /^(\s*)/;
  		if ( length($1) < $indent->[-1] ) {
  			return 1;
  		} elsif ( length($1) > $indent->[-1] ) {
  			die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
  		}
  
  		if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
  			# Inline nested hash
  			my $indent2 = length("$1");
  			$lines->[0] =~ s/-/ /;
  			push @$array, { };
  			$self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
  
  		} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
  			# Array entry with a value
  			shift @$lines;
  			push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
  
  		} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
  			shift @$lines;
  			unless ( @$lines ) {
  				push @$array, undef;
  				return 1;
  			}
  			if ( $lines->[0] =~ /^(\s*)\-/ ) {
  				my $indent2 = length("$1");
  				if ( $indent->[-1] == $indent2 ) {
  					# Null array entry
  					push @$array, undef;
  				} else {
  					# Naked indenter
  					push @$array, [ ];
  					$self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
  				}
  
  			} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
  				push @$array, { };
  				$self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
  
  			} else {
  				die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
  			}
  
  		} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
  			# This is probably a structure like the following...
  			# ---
  			# foo:
  			# - list
  			# bar: value
  			#
  			# ... so lets return and let the hash parser handle it
  			return 1;
  
  		} else {
  			die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
  		}
  	}
  
  	return 1;
  }
  
  # Parse an array
  sub _read_hash {
  	my ($self, $hash, $indent, $lines) = @_;
  
  	while ( @$lines ) {
  		# Check for a new document
  		if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
  			while ( @$lines and $lines->[0] !~ /^---/ ) {
  				shift @$lines;
  			}
  			return 1;
  		}
  
  		# Check the indent level
  		$lines->[0] =~ /^(\s*)/;
  		if ( length($1) < $indent->[-1] ) {
  			return 1;
  		} elsif ( length($1) > $indent->[-1] ) {
  			die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
  		}
  
  		# Get the key
  		unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
  			if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
  				die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
  			}
  			die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
  		}
  		my $key = $1;
  
  		# Do we have a value?
  		if ( length $lines->[0] ) {
  			# Yes
  			$hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
  		} else {
  			# An indent
  			shift @$lines;
  			unless ( @$lines ) {
  				$hash->{$key} = undef;
  				return 1;
  			}
  			if ( $lines->[0] =~ /^(\s*)-/ ) {
  				$hash->{$key} = [];
  				$self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
  			} elsif ( $lines->[0] =~ /^(\s*)./ ) {
  				my $indent2 = length("$1");
  				if ( $indent->[-1] >= $indent2 ) {
  					# Null hash entry
  					$hash->{$key} = undef;
  				} else {
  					$hash->{$key} = {};
  					$self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
  				}
  			}
  		}
  	}
  
  	return 1;
  }
  
  # Save an object to a file
  sub write {
  	my $self = shift;
  	my $file = shift or return $self->_error('No file name provided');
  
  	# Write it to the file
  	open( CFG, '>' . $file ) or return $self->_error(
  		"Failed to open file '$file' for writing: $!"
  		);
  	print CFG $self->write_string;
  	close CFG;
  
  	return 1;
  }
  
  # Save an object to a string
  sub write_string {
  	my $self = shift;
  	return '' unless @$self;
  
  	# Iterate over the documents
  	my $indent = 0;
  	my @lines  = ();
  	foreach my $cursor ( @$self ) {
  		push @lines, '---';
  
  		# An empty document
  		if ( ! defined $cursor ) {
  			# Do nothing
  
  		# A scalar document
  		} elsif ( ! ref $cursor ) {
  			$lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );
  
  		# A list at the root
  		} elsif ( ref $cursor eq 'ARRAY' ) {
  			unless ( @$cursor ) {
  				$lines[-1] .= ' []';
  				next;
  			}
  			push @lines, $self->_write_array( $cursor, $indent, {} );
  
  		# A hash at the root
  		} elsif ( ref $cursor eq 'HASH' ) {
  			unless ( %$cursor ) {
  				$lines[-1] .= ' {}';
  				next;
  			}
  			push @lines, $self->_write_hash( $cursor, $indent, {} );
  
  		} else {
  			Carp::croak("Cannot serialize " . ref($cursor));
  		}
  	}
  
  	join '', map { "$_\n" } @lines;
  }
  
  sub _write_scalar {
  	my $string = $_[1];
  	return '~'  unless defined $string;
  	return "''" unless length  $string;
  	if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
  		$string =~ s/\\/\\\\/g;
  		$string =~ s/"/\\"/g;
  		$string =~ s/\n/\\n/g;
  		$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
  		return qq|"$string"|;
  	}
  	if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
  		return "'$string'";
  	}
  	return $string;
  }
  
  sub _write_array {
  	my ($self, $array, $indent, $seen) = @_;
  	if ( $seen->{refaddr($array)}++ ) {
  		die "CPAN::Meta::YAML does not support circular references";
  	}
  	my @lines  = ();
  	foreach my $el ( @$array ) {
  		my $line = ('  ' x $indent) . '-';
  		my $type = ref $el;
  		if ( ! $type ) {
  			$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
  			push @lines, $line;
  
  		} elsif ( $type eq 'ARRAY' ) {
  			if ( @$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_array( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' []';
  				push @lines, $line;
  			}
  
  		} elsif ( $type eq 'HASH' ) {
  			if ( keys %$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_hash( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' {}';
  				push @lines, $line;
  			}
  
  		} else {
  			die "CPAN::Meta::YAML does not support $type references";
  		}
  	}
  
  	@lines;
  }
  
  sub _write_hash {
  	my ($self, $hash, $indent, $seen) = @_;
  	if ( $seen->{refaddr($hash)}++ ) {
  		die "CPAN::Meta::YAML does not support circular references";
  	}
  	my @lines  = ();
  	foreach my $name ( sort keys %$hash ) {
  		my $el   = $hash->{$name};
  		my $line = ('  ' x $indent) . "$name:";
  		my $type = ref $el;
  		if ( ! $type ) {
  			$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
  			push @lines, $line;
  
  		} elsif ( $type eq 'ARRAY' ) {
  			if ( @$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_array( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' []';
  				push @lines, $line;
  			}
  
  		} elsif ( $type eq 'HASH' ) {
  			if ( keys %$el ) {
  				push @lines, $line;
  				push @lines, $self->_write_hash( $el, $indent + 1, $seen );
  			} else {
  				$line .= ' {}';
  				push @lines, $line;
  			}
  
  		} else {
  			die "CPAN::Meta::YAML does not support $type references";
  		}
  	}
  
  	@lines;
  }
  
  # Set error
  sub _error {
  	$CPAN::Meta::YAML::errstr = $_[1];
  	undef;
  }
  
  # Retrieve error
  sub errstr {
  	$CPAN::Meta::YAML::errstr;
  }
  
  
  
  
  
  #####################################################################
  # YAML Compatibility
  
  sub Dump {
  	CPAN::Meta::YAML->new(@_)->write_string;
  }
  
  sub Load {
  	my $self = CPAN::Meta::YAML->read_string(@_);
  	unless ( $self ) {
  		Carp::croak("Failed to load YAML document from string");
  	}
  	if ( wantarray ) {
  		return @$self;
  	} else {
  		# To match YAML.pm, return the last document
  		return $self->[-1];
  	}
  }
  
  BEGIN {
  	*freeze = *Dump;
  	*thaw   = *Load;
  }
  
  sub DumpFile {
  	my $file = shift;
  	CPAN::Meta::YAML->new(@_)->write($file);
  }
  
  sub LoadFile {
  	my $self = CPAN::Meta::YAML->read($_[0]);
  	unless ( $self ) {
  		Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
  	}
  	if ( wantarray ) {
  		return @$self;
  	} else {
  		# Return only the last document to match YAML.pm, 
  		return $self->[-1];
  	}
  }
  
  
  
  
  
  #####################################################################
  # Use Scalar::Util if possible, otherwise emulate it
  
  BEGIN {
  	local $@;
  	eval {
  		require Scalar::Util;
  	};
  	my $v = eval("$Scalar::Util::VERSION") || 0;
  	if ( $@ or $v < 1.18 ) {
  		eval <<'END_PERL';
  # Scalar::Util failed to load or too old
  sub refaddr {
  	my $pkg = ref($_[0]) or return undef;
  	if ( !! UNIVERSAL::can($_[0], 'can') ) {
  		bless $_[0], 'Scalar::Util::Fake';
  	} else {
  		$pkg = undef;
  	}
  	"$_[0]" =~ /0x(\w+)/;
  	my $i = do { local $^W; hex $1 };
  	bless $_[0], $pkg if defined $pkg;
  	$i;
  }
  END_PERL
  	} else {
  		*refaddr = *Scalar::Util::refaddr;
  	}
  }
  
  1;
  
  
  
  =pod
  
  =head1 NAME
  
  CPAN::Meta::YAML - Read and write a subset of YAML for CPAN Meta files
  
  =head1 VERSION
  
  version 0.008
  
  =head1 SYNOPSIS
  
      use CPAN::Meta::YAML;
  
      # reading a META file
      open $fh, "<:utf8", "META.yml";
      $yaml_text = do { local $/; <$fh> };
      $yaml = CPAN::Meta::YAML->read_string($yaml_text)
        or die CPAN::Meta::YAML->errstr;
  
      # finding the metadata
      $meta = $yaml->[0];
  
      # writing a META file
      $yaml_text = $yaml->write_string
        or die CPAN::Meta::YAML->errstr;
      open $fh, ">:utf8", "META.yml";
      print $fh $yaml_text;
  
  =head1 DESCRIPTION
  
  This module implements a subset of the YAML specification for use in reading
  and writing CPAN metadata files like F<META.yml> and F<MYMETA.yml>.  It should
  not be used for any other general YAML parsing or generation task.
  
  NOTE: F<META.yml> (and F<MYMETA.yml>) files should be UTF-8 encoded.  Users are
  responsible for proper encoding and decoding.  In particular, the C<read> and
  C<write> methods do B<not> support UTF-8 and should not be used.
  
  =head1 SUPPORT
  
  This module is currently derived from L<YAML::Tiny> by Adam Kennedy.  If
  there are bugs in how it parses a particular META.yml file, please file
  a bug report in the YAML::Tiny bugtracker:
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=YAML-Tiny>
  
  =head1 SEE ALSO
  
  L<YAML::Tiny>, L<YAML>, L<YAML::XS>
  
  =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
  
  =head1 SUPPORT
  
  =head2 Bugs / Feature Requests
  
  Please report any bugs or feature requests through the issue tracker
  at L<http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta-YAML>.
  You will be notified automatically of any progress on your issue.
  
  =head2 Source Code
  
  This is open source software.  The code repository is available for
  public review and contribution under the terms of the license.
  
  L<https://github.com/dagolden/cpan-meta-yaml>
  
    git clone https://github.com/dagolden/cpan-meta-yaml.git
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Adam Kennedy <adamk@cpan.org>
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by Adam Kennedy.
  
  This is free software; you can redistribute it and/or modify it under
  the same terms as the Perl 5 programming language system itself.
  
  =cut
  
  
  __END__
  
  
  # ABSTRACT: Read and write a subset of YAML for CPAN Meta files
  
  
CPAN_META_YAML

$fatpacked{"CPAN/Perl/Releases.pm"} = <<'CPAN_PERL_RELEASES';
  package CPAN::Perl::Releases;
  {
    $CPAN::Perl::Releases::VERSION = '0.92';
  }
  
  #ABSTRACT: Mapping Perl releases on CPAN to the location of the tarballs
  
  use strict;
  use warnings;
  use vars qw[@ISA @EXPORT_OK];
  
  use Exporter;
  
  @ISA       = qw(Exporter);
  @EXPORT_OK = qw(perl_tarballs);
  
  # Data gathered from using findlinks.pl script in this dists tools/
  # directory, run over the src/5.0 of a local CPAN mirror.
  
  our $data =
  {
    "5.003_07" => {
      "tar.gz" => "A/AN/ANDYD/perl5.003_07.tar.gz",
    },
    "5.004" => {
      "tar.gz" => "C/CH/CHIPS/perl5.004.tar.gz",
    },
    "5.004_01" => {
      "tar.gz" => "T/TI/TIMB/perl5.004_01.tar.gz",
    },
    "5.004_02" => {
      "tar.gz" => "T/TI/TIMB/perl5.004_02.tar.gz",
    },
    "5.004_03" => {
      "tar.gz" => "T/TI/TIMB/perl5.004_03.tar.gz",
    },
    "5.004_04" => {
      "tar.gz" => "T/TI/TIMB/perl5.004_04.tar.gz",
    },
    "5.004_05" => {
      "tar.gz" => "C/CH/CHIPS/perl5.004_05.tar.gz",
    },
    "5.005" => {
      "tar.gz" => "G/GS/GSAR/perl5.005.tar.gz",
    },
    "5.005_01" => {
      "tar.gz" => "G/GS/GSAR/perl5.005_01.tar.gz",
    },
    "5.005_02" => {
      "tar.gz" => "G/GS/GSAR/perl5.005_02.tar.gz",
    },
    "5.005_03" => {
      "tar.gz" => "G/GB/GBARR/perl5.005_03.tar.gz",
    },
    "5.005_04" => {
      "tar.gz" => "L/LB/LBROCARD/perl5.005_04.tar.gz",
    },
    "5.10.0" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.10.0.tar.gz",
    },
    "5.10.0-RC1" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.10.0-RC1.tar.gz",
    },
    "5.10.0-RC2" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.10.0-RC2.tar.gz",
    },
    "5.10.1" => {
      "tar.bz2" => "D/DA/DAPM/perl-5.10.1.tar.bz2",
      "tar.gz" => "D/DA/DAPM/perl-5.10.1.tar.gz",
    },
    "5.11.0" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.11.0.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.11.0.tar.gz",
    },
    "5.11.1" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.11.1.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.11.1.tar.gz",
    },
    "5.11.2" => {
      "tar.bz2" => "L/LB/LBROCARD/perl-5.11.2.tar.bz2",
      "tar.gz" => "L/LB/LBROCARD/perl-5.11.2.tar.gz",
    },
    "5.11.3" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.11.3.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.11.3.tar.gz",
    },
    "5.11.4" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.11.4.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.11.4.tar.gz",
    },
    "5.11.5" => {
      "tar.bz2" => "S/SH/SHAY/perl-5.11.5.tar.bz2",
      "tar.gz" => "S/SH/SHAY/perl-5.11.5.tar.gz",
    },
    "5.12.0" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.12.0.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.12.0.tar.gz",
    },
    "5.12.1" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.12.1.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.12.1.tar.gz",
    },
    "5.12.1-RC1" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.12.1-RC1.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.12.1-RC1.tar.gz",
    },
    "5.12.1-RC2" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.12.1-RC2.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.12.1-RC2.tar.gz",
    },
    "5.12.2" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.12.2.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.12.2.tar.gz",
    },
    "5.12.2-RC1" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.12.2-RC1.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.12.2-RC1.tar.gz",
    },
    "5.12.3" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.12.3.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.12.3.tar.gz",
    },
    "5.12.4-RC1" => {
      "tar.bz2" => "L/LB/LBROCARD/perl-5.12.4-RC1.tar.bz2",
      "tar.gz" => "L/LB/LBROCARD/perl-5.12.4-RC1.tar.gz",
    },
    "5.12.4-RC2" => {
      "tar.bz2" => "L/LB/LBROCARD/perl-5.12.4-RC2.tar.bz2",
      "tar.gz" => "L/LB/LBROCARD/perl-5.12.4-RC2.tar.gz",
    },
    "5.12.4" => {
      "tar.bz2" => "L/LB/LBROCARD/perl-5.12.4.tar.bz2",
      "tar.gz" => "L/LB/LBROCARD/perl-5.12.4.tar.gz",
    },
    "5.12.5-RC1" => {
      "tar.bz2" => "D/DO/DOM/perl-5.12.5-RC1.tar.bz2",
      "tar.gz" => "D/DO/DOM/perl-5.12.5-RC1.tar.gz",
    },
    "5.12.5-RC2" => {
      "tar.bz2" => "D/DO/DOM/perl-5.12.5-RC2.tar.bz2",
      "tar.gz" => "D/DO/DOM/perl-5.12.5-RC2.tar.gz",
    },
    "5.12.5" => {
      "tar.bz2" => "D/DO/DOM/perl-5.12.5.tar.bz2",
      "tar.gz" => "D/DO/DOM/perl-5.12.5.tar.gz",
    },
    "5.13.0" => {
      "tar.bz2" => "L/LB/LBROCARD/perl-5.13.0.tar.bz2",
      "tar.gz" => "L/LB/LBROCARD/perl-5.13.0.tar.gz",
    },
    "5.13.1" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.13.1.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.13.1.tar.gz",
    },
    "5.13.10" => {
      "tar.bz2" => "A/AV/AVAR/perl-5.13.10.tar.bz2",
      "tar.gz" => "A/AV/AVAR/perl-5.13.10.tar.gz",
    },
    "5.13.11" => {
      "tar.bz2" => "F/FL/FLORA/perl-5.13.11.tar.bz2",
      "tar.gz" => "F/FL/FLORA/perl-5.13.11.tar.gz",
    },
    "5.13.2" => {
      "tar.bz2" => "M/MS/MSTROUT/perl-5.13.2.tar.bz2",
      "tar.gz" => "M/MS/MSTROUT/perl-5.13.2.tar.gz",
    },
    "5.13.3" => {
      "tar.bz2" => "D/DA/DAGOLDEN/perl-5.13.3.tar.bz2",
      "tar.gz" => "D/DA/DAGOLDEN/perl-5.13.3.tar.gz",
    },
    "5.13.4" => {
      "tar.bz2" => "F/FL/FLORA/perl-5.13.4.tar.bz2",
      "tar.gz" => "F/FL/FLORA/perl-5.13.4.tar.gz",
    },
    "5.13.5" => {
      "tar.bz2" => "S/SH/SHAY/perl-5.13.5.tar.bz2",
      "tar.gz" => "S/SH/SHAY/perl-5.13.5.tar.gz",
    },
    "5.13.6" => {
      "tar.bz2" => "M/MI/MIYAGAWA/perl-5.13.6.tar.bz2",
      "tar.gz" => "M/MI/MIYAGAWA/perl-5.13.6.tar.gz",
    },
    "5.13.7" => {
      "tar.bz2" => "B/BI/BINGOS/perl-5.13.7.tar.bz2",
      "tar.gz" => "B/BI/BINGOS/perl-5.13.7.tar.gz",
    },
    "5.13.8" => {
      "tar.bz2" => "Z/ZE/ZEFRAM/perl-5.13.8.tar.bz2",
      "tar.gz" => "Z/ZE/ZEFRAM/perl-5.13.8.tar.gz",
    },
    "5.13.9" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.13.9.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.13.9.tar.gz",
    },
    "5.14.0" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.14.0.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.14.0.tar.gz",
    },
    "5.14.0-RC1" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.14.0-RC1.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.14.0-RC1.tar.gz",
    },
    "5.14.0-RC2" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.14.0-RC2.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.14.0-RC2.tar.gz",
    },
    "5.14.0-RC3" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.14.0-RC3.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.14.0-RC3.tar.gz",
    },
    "5.14.1-RC1" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.14.1-RC1.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.14.1-RC1.tar.gz",
    },
    "5.14.1" => {
      "tar.bz2" => "J/JE/JESSE/perl-5.14.1.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.14.1.tar.gz",
    },
    "5.14.2-RC1" => {
      "tar.bz2" => "F/FL/FLORA/perl-5.14.2-RC1.tar.bz2",
      "tar.gz" => "F/FL/FLORA/perl-5.14.2-RC1.tar.gz",
    },
    "5.14.2" => {
      "tar.bz2" => "F/FL/FLORA/perl-5.14.2.tar.bz2",
      "tar.gz" => "F/FL/FLORA/perl-5.14.2.tar.gz",
    },
    "5.14.3-RC1" => {
      "tar.bz2" => "D/DO/DOM/perl-5.14.3-RC1.tar.bz2",
      "tar.gz" => "D/DO/DOM/perl-5.14.3-RC1.tar.gz",
    },
    "5.14.3-RC2" => {
      "tar.bz2" => "D/DO/DOM/perl-5.14.3-RC2.tar.bz2",
      "tar.gz" => "D/DO/DOM/perl-5.14.3-RC2.tar.gz",
    },
    "5.14.3" => {
      "tar.bz2" => "D/DO/DOM/perl-5.14.3.tar.bz2",
      "tar.gz" => "D/DO/DOM/perl-5.14.3.tar.gz",
    },
    "5.15.0" => {
      "tar.bz2" => "D/DA/DAGOLDEN/perl-5.15.0.tar.bz2",
      "tar.gz" => "D/DA/DAGOLDEN/perl-5.15.0.tar.gz",
    },
    "5.15.1" => {
      "tar.bz2" => "Z/ZE/ZEFRAM/perl-5.15.1.tar.bz2",
      "tar.gz" => "Z/ZE/ZEFRAM/perl-5.15.1.tar.gz",
    },
    "5.15.2" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.15.2.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.15.2.tar.gz",
    },
    "5.15.3" => {
      "tar.bz2" => "S/ST/STEVAN/perl-5.15.3.tar.bz2",
      "tar.gz" => "S/ST/STEVAN/perl-5.15.3.tar.gz",
    },
    "5.15.4" => {
      "tar.bz2" => "F/FL/FLORA/perl-5.15.4.tar.bz2",
      "tar.gz" => "F/FL/FLORA/perl-5.15.4.tar.gz",
    },
    "5.15.5" => {
      "tar.bz2" => "S/SH/SHAY/perl-5.15.5.tar.bz2",
      "tar.gz" => "S/SH/SHAY/perl-5.15.5.tar.gz",
    },
    "5.15.6" => {
      "tar.bz2" => "D/DR/DROLSKY/perl-5.15.6.tar.bz2",
      "tar.gz" => "D/DR/DROLSKY/perl-5.15.6.tar.gz",
    },
    "5.15.7" => {
      "tar.bz2" => "B/BI/BINGOS/perl-5.15.7.tar.bz2",
      "tar.gz" => "B/BI/BINGOS/perl-5.15.7.tar.gz",
    },
    "5.15.8" => {
      "tar.bz2" => "C/CO/CORION/perl-5.15.8.tar.bz2",
      "tar.gz" => "C/CO/CORION/perl-5.15.8.tar.gz",
    },
    "5.15.9" => {
      "tar.bz2" => "A/AB/ABIGAIL/perl-5.15.9.tar.bz2",
      "tar.gz" => "A/AB/ABIGAIL/perl-5.15.9.tar.gz",
    },
    "5.16.0-RC0" => {
      "tar.gz" => "R/RJ/RJBS/perl-5.16.0-RC0.tar.gz",
    },
    "5.16.0-RC1" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.16.0-RC1.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.16.0-RC1.tar.gz",
    },
    "5.16.0-RC2" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.16.0-RC2.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.16.0-RC2.tar.gz",
    },
    "5.16.0" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.16.0.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.16.0.tar.gz",
    },
    "5.16.1-RC1" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.16.1-RC1.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.16.1-RC1.tar.gz",
    },
    "5.16.1" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.16.1.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.16.1.tar.gz",
    },
    "5.16.2-RC1" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.16.2-RC1.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.16.2-RC1.tar.gz",
    },
    "5.16.2" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.16.2.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.16.2.tar.gz",
    },
    "5.17.0" => {
      "tar.bz2" => "Z/ZE/ZEFRAM/perl-5.17.0.tar.bz2",
      "tar.gz" => "Z/ZE/ZEFRAM/perl-5.17.0.tar.gz",
    },
    "5.17.1" => {
      "tar.bz2" => "D/DO/DOY/perl-5.17.1.tar.bz2",
      "tar.gz" => "D/DO/DOY/perl-5.17.1.tar.gz",
    },
    "5.17.2" => {
      "tar.bz2" => "T/TO/TONYC/perl-5.17.2.tar.bz2",
      "tar.gz" => "T/TO/TONYC/perl-5.17.2.tar.gz",
    },
    "5.17.3" => {
      "tar.bz2" => "S/SH/SHAY/perl-5.17.3.tar.bz2",
      "tar.gz" => "S/SH/SHAY/perl-5.17.3.tar.gz",
    },
    "5.17.4" => {
      "tar.bz2" => "F/FL/FLORA/perl-5.17.4.tar.bz2",
      "tar.gz" => "F/FL/FLORA/perl-5.17.4.tar.gz",
    },
    "5.17.5" => {
      "tar.bz2" => "F/FL/FLORA/perl-5.17.5.tar.bz2",
      "tar.gz" => "F/FL/FLORA/perl-5.17.5.tar.gz",
    },
    "5.17.6" => {
      "tar.bz2" => "R/RJ/RJBS/perl-5.17.6.tar.bz2",
      "tar.gz" => "R/RJ/RJBS/perl-5.17.6.tar.gz",
    },
    "5.17.7" => {
      "tar.bz2" => "D/DR/DROLSKY/perl-5.17.7.tar.bz2",
      "tar.gz" => "D/DR/DROLSKY/perl-5.17.7.tar.gz",
    },
    "5.6.0" => {
      "tar.gz" => "G/GS/GSAR/perl-5.6.0.tar.gz",
    },
    "5.6.1" => {
      "tar.gz" => "G/GS/GSAR/perl-5.6.1.tar.gz",
    },
    "5.6.1-TRIAL1" => {
      "tar.gz" => "G/GS/GSAR/perl-5.6.1-TRIAL1.tar.gz",
    },
    "5.6.1-TRIAL2" => {
      "tar.gz" => "G/GS/GSAR/perl-5.6.1-TRIAL2.tar.gz",
    },
    "5.6.1-TRIAL3" => {
      "tar.gz" => "G/GS/GSAR/perl-5.6.1-TRIAL3.tar.gz",
    },
    "5.6.2" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.6.2.tar.gz",
    },
    "5.7.0" => {
      "tar.gz" => "J/JH/JHI/perl-5.7.0.tar.gz",
    },
    "5.7.1" => {
      "tar.gz" => "J/JH/JHI/perl-5.7.1.tar.gz",
    },
    "5.7.2" => {
      "tar.gz" => "J/JH/JHI/perl-5.7.2.tar.gz",
    },
    "5.7.3" => {
      "tar.gz" => "J/JH/JHI/perl-5.7.3.tar.gz",
    },
    "5.8.0" => {
      "tar.gz" => "J/JH/JHI/perl-5.8.0.tar.gz",
    },
    "5.8.1" => {
      "tar.gz" => "J/JH/JHI/perl-5.8.1.tar.gz",
    },
    "5.8.2" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.2.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.2.tar.gz",
    },
    "5.8.3" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.3.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.3.tar.gz",
    },
    "5.8.4" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.4.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.4.tar.gz",
    },
    "5.8.5" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.5.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.5.tar.gz",
    },
    "5.8.6" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.6.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.6.tar.gz",
    },
    "5.8.7" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.7.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.7.tar.gz",
    },
    "5.8.8" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.8.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.8.tar.gz",
    },
    "5.8.9" => {
      "tar.bz2" => "N/NW/NWCLARK/perl-5.8.9.tar.bz2",
      "tar.gz" => "N/NW/NWCLARK/perl-5.8.9.tar.gz",
    },
    "5.9.0" => {
      "tar.bz2" => "H/HV/HVDS/perl-5.9.0.tar.bz2",
      "tar.gz" => "H/HV/HVDS/perl-5.9.0.tar.gz",
    },
    "5.9.1" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.9.1.tar.gz",
    },
    "5.9.2" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.9.2.tar.gz",
    },
    "5.9.3" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.9.3.tar.gz",
    },
    "5.9.4" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.9.4.tar.gz",
    },
    "5.9.5" => {
      "tar.gz" => "R/RG/RGARCIA/perl-5.9.5.tar.gz",
    },
  };
  
  sub perl_tarballs {
    my $vers = shift;
    $vers = shift if eval { $vers->isa(__PACKAGE__) };
    return unless exists $data->{ $vers };
    return { %{ $data->{ $vers } } };
  }
  
  q|Acme::Why::Did::I::Not::Read::The::Fecking::Memo|;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  CPAN::Perl::Releases - Mapping Perl releases on CPAN to the location of the tarballs
  
  =head1 VERSION
  
  version 0.92
  
  =head1 SYNOPSIS
  
    use CPAN::Perl::Releases qw[perl_tarballs];
  
    my $perl = '5.14.0';
  
    my $hashref = perl_tarballs( $perl );
  
    print "Location: ", $_, "\n" for values %{ $hashref };
  
  =head1 DESCRIPTION
  
  CPAN::Perl::Releases is a module that contains the mappings of all C<perl> releases that have been uploaded to CPAN to the
  C<authors/id/> path that the tarballs reside in.
  
  This is static data, but newer versions of this module will be made available as new releases of C<perl> are uploaded to CPAN.
  
  =head1 FUNCTIONS
  
  =over
  
  =item C<perl_tarballs>
  
  Takes one parameter, a C<perl> version to search for. Returns an hashref on success or C<undef> otherwise.
  
  The returned hashref will have a key/value for each type of tarball. A key of C<tar.gz> indicates the location
  of a gzipped tar file and C<tar.bz2> of a bzip2'd tar file. The values will be the relative path under C<authors/id/>
  on CPAN where the indicated tarball will be located.
  
    perl_tarballs( '5.14.0' );
  
    Returns a hashref like:
  
    {
      "tar.bz2" => "J/JE/JESSE/perl-5.14.0.tar.bz2",
      "tar.gz" => "J/JE/JESSE/perl-5.14.0.tar.gz"
    }
  
  Not all C<perl> releases had C<tar.bz2>, but only a C<tar.gz>.
  
  =back
  
  =head1 SEE ALSO
  
  L<http://www.cpan.org/src/5.0/>
  
  L<http://search.cpan.org/faq.html#Is_there_a_API?>
  
  =head1 AUTHOR
  
  Chris Williams <chris@bingosnet.co.uk>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2012 by Chris Williams.
  
  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_PERL_RELEASES

$fatpacked{"Carp.pm"} = <<'CARP';
  package Carp;
  
  { use 5.006; }
  use strict;
  use warnings;
  
  BEGIN {
      no strict "refs";
      if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"is_utf8"}) &&
  	    defined(*{*{$::{"utf8::"}}{HASH}->{"is_utf8"}}{CODE})) {
  	*is_utf8 = \&{"utf8::is_utf8"};
      } else {
  	*is_utf8 = sub { 0 };
      }
  }
  
  BEGIN {
      no strict "refs";
      if(exists($::{"utf8::"}) && exists(*{$::{"utf8::"}}{HASH}->{"downgrade"}) &&
  	    defined(*{*{$::{"utf8::"}}{HASH}->{"downgrade"}}{CODE})) {
  	*downgrade = \&{"utf8::downgrade"};
      } else {
  	*downgrade = sub {};
      }
  }
  
  our $VERSION = '1.26';
  
  our $MaxEvalLen = 0;
  our $Verbose    = 0;
  our $CarpLevel  = 0;
  our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
  our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
  
  require Exporter;
  our @ISA       = ('Exporter');
  our @EXPORT    = qw(confess croak carp);
  our @EXPORT_OK = qw(cluck verbose longmess shortmess);
  our @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
  
  # The members of %Internal are packages that are internal to perl.
  # Carp will not report errors from within these packages if it
  # can.  The members of %CarpInternal are internal to Perl's warning
  # system.  Carp will not report errors from within these packages
  # either, and will not report calls *to* these packages for carp and
  # croak.  They replace $CarpLevel, which is deprecated.    The
  # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
  # text and function arguments should be formatted when printed.
  
  our %CarpInternal;
  our %Internal;
  
  # disable these by default, so they can live w/o require Carp
  $CarpInternal{Carp}++;
  $CarpInternal{warnings}++;
  $Internal{Exporter}++;
  $Internal{'Exporter::Heavy'}++;
  
  # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
  # then the following method will be called by the Exporter which knows
  # to do this thanks to @EXPORT_FAIL, above.  $_[1] will contain the word
  # 'verbose'.
  
  sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
  
  sub _cgc {
      no strict 'refs';
      return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
      return;
  }
  
  sub longmess {
      # Icky backwards compatibility wrapper. :-(
      #
      # The story is that the original implementation hard-coded the
      # number of call levels to go back, so calls to longmess were off
      # by one.  Other code began calling longmess and expecting this
      # behaviour, so the replacement has to emulate that behaviour.
      my $cgc = _cgc();
      my $call_pack = $cgc ? $cgc->() : caller();
      if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
          return longmess_heavy(@_);
      }
      else {
          local $CarpLevel = $CarpLevel + 1;
          return longmess_heavy(@_);
      }
  }
  
  our @CARP_NOT;
  
  sub shortmess {
      my $cgc = _cgc();
  
      # Icky backwards compatibility wrapper. :-(
      local @CARP_NOT = $cgc ? $cgc->() : caller();
      shortmess_heavy(@_);
  }
  
  sub croak   { die shortmess @_ }
  sub confess { die longmess @_ }
  sub carp    { warn shortmess @_ }
  sub cluck   { warn longmess @_ }
  
  BEGIN {
      if("$]" >= 5.015002 || ("$]" >= 5.014002 && "$]" < 5.015) ||
  	    ("$]" >= 5.012005 && "$]" < 5.013)) {
  	*CALLER_OVERRIDE_CHECK_OK = sub () { 1 };
      } else {
  	*CALLER_OVERRIDE_CHECK_OK = sub () { 0 };
      }
  }
  
  sub caller_info {
      my $i = shift(@_) + 1;
      my %call_info;
      my $cgc = _cgc();
      {
  	# Some things override caller() but forget to implement the
  	# @DB::args part of it, which we need.  We check for this by
  	# pre-populating @DB::args with a sentinel which no-one else
  	# has the address of, so that we can detect whether @DB::args
  	# has been properly populated.  However, on earlier versions
  	# of perl this check tickles a bug in CORE::caller() which
  	# leaks memory.  So we only check on fixed perls.
          @DB::args = \$i if CALLER_OVERRIDE_CHECK_OK;
          package DB;
          @call_info{
              qw(pack file line sub has_args wantarray evaltext is_require) }
              = $cgc ? $cgc->($i) : caller($i);
      }
  
      unless ( defined $call_info{pack} ) {
          return ();
      }
  
      my $sub_name = Carp::get_subname( \%call_info );
      if ( $call_info{has_args} ) {
          my @args;
          if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
              && ref $DB::args[0] eq ref \$i
              && $DB::args[0] == \$i ) {
              @DB::args = ();    # Don't let anyone see the address of $i
              local $@;
              my $where = eval {
                  my $func    = $cgc or return '';
                  my $gv      =
                      *{
                          ( $::{"B::"} || return '')       # B stash
                            ->{svref_2object} || return '' # entry in stash
                       }{CODE}                             # coderef in entry
                          ->($func)->GV;
                  my $package = $gv->STASH->NAME;
                  my $subname = $gv->NAME;
                  return unless defined $package && defined $subname;
  
                  # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
                  return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
                  " in &${package}::$subname";
              } || '';
              @args
                  = "** Incomplete caller override detected$where; \@DB::args were not set **";
          }
          else {
              @args = map { Carp::format_arg($_) } @DB::args;
          }
          if ( $MaxArgNums and @args > $MaxArgNums )
          {    # More than we want to show?
              $#args = $MaxArgNums;
              push @args, '...';
          }
  
          # Push the args onto the subroutine
          $sub_name .= '(' . join( ', ', @args ) . ')';
      }
      $call_info{sub_name} = $sub_name;
      return wantarray() ? %call_info : \%call_info;
  }
  
  # Transform an argument to a function into a string.
  sub format_arg {
      my $arg = shift;
      if ( ref($arg) ) {
          $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
      }
      if ( defined($arg) ) {
          $arg =~ s/'/\\'/g;
          $arg = str_len_trim( $arg, $MaxArgLen );
  
          # Quote it?
          # Downgrade, and use [0-9] rather than \d, to avoid loading
          # Unicode tables, which would be liable to fail if we're
          # processing a syntax error.
          downgrade($arg, 1);
          $arg = "'$arg'" unless $arg =~ /^-?[0-9.]+\z/;
      }
      else {
          $arg = 'undef';
      }
  
      # The following handling of "control chars" is direct from
      # the original code - it is broken on Unicode though.
      # Suggestions?
      is_utf8($arg)
          or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
      return $arg;
  }
  
  # Takes an inheritance cache and a package and returns
  # an anon hash of known inheritances and anon array of
  # inheritances which consequences have not been figured
  # for.
  sub get_status {
      my $cache = shift;
      my $pkg   = shift;
      $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
      return @{ $cache->{$pkg} };
  }
  
  # Takes the info from caller() and figures out the name of
  # the sub/require/eval
  sub get_subname {
      my $info = shift;
      if ( defined( $info->{evaltext} ) ) {
          my $eval = $info->{evaltext};
          if ( $info->{is_require} ) {
              return "require $eval";
          }
          else {
              $eval =~ s/([\\\'])/\\$1/g;
              return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
          }
      }
  
      return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
  }
  
  # Figures out what call (from the point of view of the caller)
  # the long error backtrace should start at.
  sub long_error_loc {
      my $i;
      my $lvl = $CarpLevel;
      {
          ++$i;
          my $cgc = _cgc();
          my $pkg = $cgc ? $cgc->($i) : caller($i);
          unless ( defined($pkg) ) {
  
              # This *shouldn't* happen.
              if (%Internal) {
                  local %Internal;
                  $i = long_error_loc();
                  last;
              }
              else {
  
                  # OK, now I am irritated.
                  return 2;
              }
          }
          redo if $CarpInternal{$pkg};
          redo unless 0 > --$lvl;
          redo if $Internal{$pkg};
      }
      return $i - 1;
  }
  
  sub longmess_heavy {
      return @_ if ref( $_[0] );    # don't break references as exceptions
      my $i = long_error_loc();
      return ret_backtrace( $i, @_ );
  }
  
  # Returns a full stack backtrace starting from where it is
  # told.
  sub ret_backtrace {
      my ( $i, @error ) = @_;
      my $mess;
      my $err = join '', @error;
      $i++;
  
      my $tid_msg = '';
      if ( defined &threads::tid ) {
          my $tid = threads->tid;
          $tid_msg = " thread $tid" if $tid;
      }
  
      my %i = caller_info($i);
      $mess = "$err at $i{file} line $i{line}$tid_msg";
      if( defined $. ) {
          local $@ = '';
          local $SIG{__DIE__};
          eval {
              CORE::die;
          };
          if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) {
              $mess .= $1;
          }
      }
      $mess .= "\.\n";
  
      while ( my %i = caller_info( ++$i ) ) {
          $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
      }
  
      return $mess;
  }
  
  sub ret_summary {
      my ( $i, @error ) = @_;
      my $err = join '', @error;
      $i++;
  
      my $tid_msg = '';
      if ( defined &threads::tid ) {
          my $tid = threads->tid;
          $tid_msg = " thread $tid" if $tid;
      }
  
      my %i = caller_info($i);
      return "$err at $i{file} line $i{line}$tid_msg\.\n";
  }
  
  sub short_error_loc {
      # You have to create your (hash)ref out here, rather than defaulting it
      # inside trusts *on a lexical*, as you want it to persist across calls.
      # (You can default it on $_[2], but that gets messy)
      my $cache = {};
      my $i     = 1;
      my $lvl   = $CarpLevel;
      {
          my $cgc = _cgc();
          my $called = $cgc ? $cgc->($i) : caller($i);
          $i++;
          my $caller = $cgc ? $cgc->($i) : caller($i);
  
          return 0 unless defined($caller);    # What happened?
          redo if $Internal{$caller};
          redo if $CarpInternal{$caller};
          redo if $CarpInternal{$called};
          redo if trusts( $called, $caller, $cache );
          redo if trusts( $caller, $called, $cache );
          redo unless 0 > --$lvl;
      }
      return $i - 1;
  }
  
  sub shortmess_heavy {
      return longmess_heavy(@_) if $Verbose;
      return @_ if ref( $_[0] );    # don't break references as exceptions
      my $i = short_error_loc();
      if ($i) {
          ret_summary( $i, @_ );
      }
      else {
          longmess_heavy(@_);
      }
  }
  
  # If a string is too long, trims it with ...
  sub str_len_trim {
      my $str = shift;
      my $max = shift || 0;
      if ( 2 < $max and $max < length($str) ) {
          substr( $str, $max - 3 ) = '...';
      }
      return $str;
  }
  
  # Takes two packages and an optional cache.  Says whether the
  # first inherits from the second.
  #
  # Recursive versions of this have to work to avoid certain
  # possible endless loops, and when following long chains of
  # inheritance are less efficient.
  sub trusts {
      my $child  = shift;
      my $parent = shift;
      my $cache  = shift;
      my ( $known, $partial ) = get_status( $cache, $child );
  
      # Figure out consequences until we have an answer
      while ( @$partial and not exists $known->{$parent} ) {
          my $anc = shift @$partial;
          next if exists $known->{$anc};
          $known->{$anc}++;
          my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
          my @found = keys %$anc_knows;
          @$known{@found} = ();
          push @$partial, @$anc_partial;
      }
      return exists $known->{$parent};
  }
  
  # Takes a package and gives a list of those trusted directly
  sub trusts_directly {
      my $class = shift;
      no strict 'refs';
      no warnings 'once';
      return @{"$class\::CARP_NOT"}
          ? @{"$class\::CARP_NOT"}
          : @{"$class\::ISA"};
  }
  
  if(!defined($warnings::VERSION) ||
  	do { no warnings "numeric"; $warnings::VERSION < 1.03 }) {
      # Very old versions of warnings.pm import from Carp.  This can go
      # wrong due to the circular dependency.  If Carp is invoked before
      # warnings, then Carp starts by loading warnings, then warnings
      # tries to import from Carp, and gets nothing because Carp is in
      # the process of loading and hasn't defined its import method yet.
      # So we work around that by manually exporting to warnings here.
      no strict "refs";
      *{"warnings::$_"} = \&$_ foreach @EXPORT;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Carp - alternative warn and die for modules
  
  =head1 SYNOPSIS
  
      use Carp;
  
      # warn user (from perspective of caller)
      carp "string trimmed to 80 chars";
  
      # die of errors (from perspective of caller)
      croak "We're outta here!";
  
      # die of errors with stack backtrace
      confess "not implemented";
  
      # cluck not exported by default
      use Carp qw(cluck);
      cluck "This is how we got here!";
  
  =head1 DESCRIPTION
  
  The Carp routines are useful in your own modules because
  they act like die() or warn(), but with a message which is more
  likely to be useful to a user of your module.  In the case of
  cluck, confess, and longmess that context is a summary of every
  call in the call-stack.  For a shorter message you can use C<carp>
  or C<croak> which report the error as being from where your module
  was called.  There is no guarantee that that is where the error
  was, but it is a good educated guess.
  
  You can also alter the way the output and logic of C<Carp> works, by
  changing some global variables in the C<Carp> namespace. See the
  section on C<GLOBAL VARIABLES> below.
  
  Here is a more complete description of how C<carp> and C<croak> work.
  What they do is search the call-stack for a function call stack where
  they have not been told that there shouldn't be an error.  If every
  call is marked safe, they give up and give a full stack backtrace
  instead.  In other words they presume that the first likely looking
  potential suspect is guilty.  Their rules for telling whether
  a call shouldn't generate errors work as follows:
  
  =over 4
  
  =item 1.
  
  Any call from a package to itself is safe.
  
  =item 2.
  
  Packages claim that there won't be errors on calls to or from
  packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
  (if that array is empty) C<@ISA>.  The ability to override what
  @ISA says is new in 5.8.
  
  =item 3.
  
  The trust in item 2 is transitive.  If A trusts B, and B
  trusts C, then A trusts C.  So if you do not override C<@ISA>
  with C<@CARP_NOT>, then this trust relationship is identical to,
  "inherits from".
  
  =item 4.
  
  Any call from an internal Perl module is safe.  (Nothing keeps
  user modules from marking themselves as internal to Perl, but
  this practice is discouraged.)
  
  =item 5.
  
  Any call to Perl's warning system (eg Carp itself) is safe.
  (This rule is what keeps it from reporting the error at the
  point where you call C<carp> or C<croak>.)
  
  =item 6.
  
  C<$Carp::CarpLevel> can be set to skip a fixed number of additional
  call levels.  Using this is not recommended because it is very
  difficult to get it to behave correctly.
  
  =back
  
  =head2 Forcing a Stack Trace
  
  As a debugging aid, you can force Carp to treat a croak as a confess
  and a carp as a cluck across I<all> modules. In other words, force a
  detailed stack trace to be given.  This can be very helpful when trying
  to understand why, or from where, a warning or error is being generated.
  
  This feature is enabled by 'importing' the non-existent symbol
  'verbose'. You would typically enable it by saying
  
      perl -MCarp=verbose script.pl
  
  or by including the string C<-MCarp=verbose> in the PERL5OPT
  environment variable.
  
  Alternately, you can set the global variable C<$Carp::Verbose> to true.
  See the C<GLOBAL VARIABLES> section below.
  
  =head1 GLOBAL VARIABLES
  
  =head2 $Carp::MaxEvalLen
  
  This variable determines how many characters of a string-eval are to
  be shown in the output. Use a value of C<0> to show all text.
  
  Defaults to C<0>.
  
  =head2 $Carp::MaxArgLen
  
  This variable determines how many characters of each argument to a
  function to print. Use a value of C<0> to show the full length of the
  argument.
  
  Defaults to C<64>.
  
  =head2 $Carp::MaxArgNums
  
  This variable determines how many arguments to each function to show.
  Use a value of C<0> to show all arguments to a function call.
  
  Defaults to C<8>.
  
  =head2 $Carp::Verbose
  
  This variable makes C<carp> and C<croak> generate stack backtraces
  just like C<cluck> and C<confess>.  This is how C<use Carp 'verbose'>
  is implemented internally.
  
  Defaults to C<0>.
  
  =head2 @CARP_NOT
  
  This variable, I<in your package>, says which packages are I<not> to be
  considered as the location of an error. The C<carp()> and C<cluck()>
  functions will skip over callers when reporting where an error occurred.
  
  NB: This variable must be in the package's symbol table, thus:
  
      # These work
      our @CARP_NOT; # file scope
      use vars qw(@CARP_NOT); # package scope
      @My::Package::CARP_NOT = ... ; # explicit package variable
  
      # These don't work
      sub xyz { ... @CARP_NOT = ... } # w/o declarations above
      my @CARP_NOT; # even at top-level
  
  Example of use:
  
      package My::Carping::Package;
      use Carp;
      our @CARP_NOT;
      sub bar     { .... or _error('Wrong input') }
      sub _error  {
          # temporary control of where'ness, __PACKAGE__ is implicit
          local @CARP_NOT = qw(My::Friendly::Caller);
          carp(@_)
      }
  
  This would make C<Carp> report the error as coming from a caller not
  in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
  
  Also read the L</DESCRIPTION> section above, about how C<Carp> decides
  where the error is reported from.
  
  Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
  
  Overrides C<Carp>'s use of C<@ISA>.
  
  =head2 %Carp::Internal
  
  This says what packages are internal to Perl.  C<Carp> will never
  report an error as being from a line in a package that is internal to
  Perl.  For example:
  
      $Carp::Internal{ (__PACKAGE__) }++;
      # time passes...
      sub foo { ... or confess("whatever") };
  
  would give a full stack backtrace starting from the first caller
  outside of __PACKAGE__.  (Unless that package was also internal to
  Perl.)
  
  =head2 %Carp::CarpInternal
  
  This says which packages are internal to Perl's warning system.  For
  generating a full stack backtrace this is the same as being internal
  to Perl, the stack backtrace will not start inside packages that are
  listed in C<%Carp::CarpInternal>.  But it is slightly different for
  the summary message generated by C<carp> or C<croak>.  There errors
  will not be reported on any lines that are calling packages in
  C<%Carp::CarpInternal>.
  
  For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
  Therefore the full stack backtrace from C<confess> will not start
  inside of C<Carp>, and the short message from calling C<croak> is
  not placed on the line where C<croak> was called.
  
  =head2 $Carp::CarpLevel
  
  This variable determines how many additional call frames are to be
  skipped that would not otherwise be when reporting where an error
  occurred on a call to one of C<Carp>'s functions.  It is fairly easy
  to count these call frames on calls that generate a full stack
  backtrace.  However it is much harder to do this accounting for calls
  that generate a short message.  Usually people skip too many call
  frames.  If they are lucky they skip enough that C<Carp> goes all of
  the way through the call stack, realizes that something is wrong, and
  then generates a full stack backtrace.  If they are unlucky then the
  error is reported from somewhere misleading very high in the call
  stack.
  
  Therefore it is best to avoid C<$Carp::CarpLevel>.  Instead use
  C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
  
  Defaults to C<0>.
  
  =head1 BUGS
  
  The Carp routines don't handle exception objects currently.
  If called with a first argument that is a reference, they simply
  call die() or warn(), as appropriate.
  
  =head1 SEE ALSO
  
  L<Carp::Always>,
  L<Carp::Clan>
  
  =head1 AUTHOR
  
  The Carp module first appeared in Larry Wall's perl 5.000 distribution.
  Since then it has been modified by several of the perl 5 porters.
  Andrew Main (Zefram) <zefram@fysh.org> divested Carp into an independent
  distribution.
  
  =head1 COPYRIGHT
  
  Copyright (C) 1994-2012 Larry Wall
  
  Copyright (C) 2011, 2012 Andrew Main (Zefram) <zefram@fysh.org>
  
  =head1 LICENSE
  
  This module is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
CARP

$fatpacked{"Carp/Heavy.pm"} = <<'CARP_HEAVY';
  package Carp::Heavy;
  
  use Carp ();
  
  our $VERSION = '1.26';
  
  1;
  
  # Most of the machinery of Carp used to be here.
  # It has been moved in Carp.pm now, but this placeholder remains for
  # the benefit of modules that like to preload Carp::Heavy directly.
  # This must load Carp, because some modules rely on the historical
  # behaviour of Carp::Heavy loading Carp.
CARP_HEAVY

$fatpacked{"Devel/InnerPackage.pm"} = <<'DEVEL_INNERPACKAGE';
  package Devel::InnerPackage;
  
  use strict;
  use base qw(Exporter);
  use vars qw($VERSION @EXPORT_OK);
  
  $VERSION = '0.4';
  @EXPORT_OK = qw(list_packages);
  
  =pod
  
  =head1 NAME
  
  Devel::InnerPackage - find all the inner packages of a package
  
  =head1 SYNOPSIS
  
      use Foo::Bar;
      use Devel::InnerPackage qw(list_packages);
  
      my @inner_packages = list_packages('Foo::Bar');
  
  
  =head1 DESCRIPTION
  
  
  Given a file like this
  
  
      package Foo::Bar;
  
      sub foo {}
  
  
      package Foo::Bar::Quux;
  
      sub quux {}
  
      package Foo::Bar::Quirka;
  
      sub quirka {}
  
      1;
  
  then
  
      list_packages('Foo::Bar');
  
  will return
  
      Foo::Bar::Quux
      Foo::Bar::Quirka
  
  =head1 METHODS
  
  =head2 list_packages <package name>
  
  Return a list of all inner packages of that package.
  
  =cut
  
  sub list_packages {
              my $pack = shift; $pack .= "::" unless $pack =~ m!::$!;
  
              no strict 'refs';
              my @packs;
              my @stuff = grep !/^(main|)::$/, keys %{$pack};
              for my $cand (grep /::$/, @stuff)
              {
                  $cand =~ s!::$!!;
                  my @children = list_packages($pack.$cand);
      
                  push @packs, "$pack$cand" unless $cand =~ /^::/ ||
                      !__PACKAGE__->_loaded($pack.$cand); # or @children;
                  push @packs, @children;
              }
              return grep {$_ !~ /::(::ISA::CACHE|SUPER)/} @packs;
  }
  
  ### XXX this is an inlining of the Class-Inspector->loaded()
  ### method, but inlined to remove the dependency.
  sub _loaded {
         my ($class, $name) = @_;
  
          no strict 'refs';
  
         # Handle by far the two most common cases
         # This is very fast and handles 99% of cases.
         return 1 if defined ${"${name}::VERSION"};
         return 1 if @{"${name}::ISA"};
  
         # Are there any symbol table entries other than other namespaces
         foreach ( keys %{"${name}::"} ) {
                 next if substr($_, -2, 2) eq '::';
                 return 1 if defined &{"${name}::$_"};
         }
  
         # No functions, and it doesn't have a version, and isn't anything.
         # As an absolute last resort, check for an entry in %INC
         my $filename = join( '/', split /(?:'|::)/, $name ) . '.pm';
         return 1 if defined $INC{$filename};
  
         '';
  }
  
  
  =head1 AUTHOR
  
  Simon Wistow <simon@thegestalt.org>
  
  =head1 COPYING
  
  Copyright, 2005 Simon Wistow
  
  Distributed under the same terms as Perl itself.
  
  =head1 BUGS
  
  None known.
  
  =cut 
  
  
  
  
  
  1;
DEVEL_INNERPACKAGE

$fatpacked{"Devel/PatchPerl.pm"} = <<'DEVEL_PATCHPERL';
  package Devel::PatchPerl;
  {
    $Devel::PatchPerl::VERSION = '0.76';
  }
  
  # ABSTRACT: Patch perl source a la Devel::PPPort's buildperl.pl
  
  use strict;
  use warnings;
  use File::pushd qw[pushd];
  use File::Spec;
  use IO::File;
  use IPC::Cmd qw[can_run run];
  use Devel::PatchPerl::Hints qw[hint_file];
  use Module::Pluggable search_path => ['Devel::PatchPerl::Plugin'];
  use vars qw[@ISA @EXPORT_OK];
  
  @ISA       = qw(Exporter);
  @EXPORT_OK = qw(patch_source);
  
  my $patch_exe = can_run('patch');
  
  my @patch = (
    {
      perl => [
                qr/^5\.00[01234]/,
                qw/
                  5.005
                  5.005_01
                  5.005_02
                  5.005_03
                /,
              ],
      subs => [
                [ \&_patch_db, 1 ],
              ],
    },
    {
      perl => [
              qw/
                  5.6.0
                  5.6.1
                  5.7.0
                  5.7.1
                  5.7.2
                  5.7.3
                  5.8.0
              /,
              ],
      subs => [
                [ \&_patch_db, 3 ],
              ],
    },
    {
      perl => [
                qr/^5\.004_0[1234]$/,
              ],
      subs => [
                [ \&_patch_doio ],
              ],
    },
    {
      perl => [
                qw/
                  5.005
                  5.005_01
                  5.005_02
                /,
              ],
      subs => [
                [ \&_patch_sysv, old_format => 1 ],
              ],
    },
    {
      perl => [
                qw/
                  5.005_03
                  5.005_04
                /,
                qr/^5\.6\.[0-2]$/,
                qr/^5\.7\.[0-3]$/,
                qr/^5\.8\.[0-8]$/,
                qr/^5\.9\.[0-5]$/
              ],
      subs => [
                [ \&_patch_sysv, old_format => 0 ],
              ],
    },
    {
      perl => [
                qr/^5\.004_05$/,
                qr/^5\.005(?:_0[1-4])?$/,
                qr/^5\.6\.[01]$/,
              ],
      subs => [
                [ \&_patch_configure ],
                [ \&_patch_makedepend_lc ],
              ],
    },
    {
      perl => [
                '5.8.0',
              ],
      subs => [
                [ \&_patch_makedepend_lc ],
              ],
    },
    {
      perl => [
                qr/.*/,
              ],
      subs => [
                [ \&_patch_hints ],
              ],
    },
    {
      perl => [
                qr/^5\.6\.[0-2]$/,
                qr/^5\.7\.[0-3]$/,
                qr/^5\.8\.[0-8]$/,
              ],
      subs => [
                [ \&_patch_makedepend_SH ],
              ],
    },
    {
      perl => [
                qr/^5\.1[0-2]/,
              ],
      subs => [
                [ \&_patch_archive_tar_tests ],
                [ \&_patch_odbm_file_hints_linux ],
              ],
    },
    {
      perl => [
                qr/^5.1([24].\d+|0.1)/,
              ],
      subs => [
                [ \&_patch_make_ext_pl ],
              ],
    },
    {
      perl => [ qr/^5\.8\.9$/, ],
      subs => [ [ \&_patch_589_perlio_c ], ],
    },
  );
  
  sub patch_source {
    my $vers = shift;
    $vers = shift if eval { $vers->isa(__PACKAGE__) };
    my $source = shift || '.';
    if ( !$vers ) {
      $vers = _determine_version($source);
      if ( $vers ) {
        warn "Auto-guessed '$vers'\n";
      }
      else {
        die "You didn't provide a perl version and I don't appear to be in a perl source tree\n";
      }
    }
    $source = File::Spec->rel2abs($source);
    {
      my $dir = pushd( $source );
      for my $p ( grep { _is( $_->{perl}, $vers ) } @patch ) {
         for my $s (@{$p->{subs}}) {
           my($sub, @args) = @$s;
           push @args, $vers unless scalar @args;
           $sub->(@args);
         }
      }
      _process_plugin( version => $vers, source => $source, patchexe => $patch_exe );
    }
  }
  
  sub _process_plugin {
    my %args = @_;
    return unless my $possible = $ENV{PERL5_PATCHPERL_PLUGIN};
    my ($plugin) = grep { $possible eq $_ or /\Q$possible\E$/ } __PACKAGE__->plugins;
    unless ( $plugin ) {
      warn "# You specified a plugin '", $ENV{PERL5_PATCHPERL_PLUGIN},
           "' that isn't installed, just thought you might be interested.\n";
      return;
    }
    {
      local $@;
      eval "require $plugin";
      if ($@) {
        die "# I tried to load '", $ENV{PERL5_PATCHPERL_PLUGIN},
            "' but it didn't work out. Here is what happened '$@'\n";
      }
    }
    {
      local $@;
      eval {
        $plugin->patchperl(
          %args,
        );
      };
      if ($@) {
        warn "# Warnings from the plugin: '$@'\n";
      }
    }
    return 1;
  }
  
  sub _is
  {
    my($s1, $s2) = @_;
  
    defined $s1 != defined $s2 and return 0;
  
    ref $s2 and ($s1, $s2) = ($s2, $s1);
  
    if (ref $s1) {
      if (ref $s1 eq 'ARRAY') {
        _is($_, $s2) and return 1 for @$s1;
        return 0;
      }
      return $s2 =~ $s1;
    }
  
    return $s1 eq $s2;
  }
  
  sub _patch
  {
    my($patch) = @_;
    print "patching $_\n" for $patch =~ /^\+{3}\s+(\S+)/gm;
    my $diff = 'tmp.diff';
    _write_or_die($diff, $patch);
    die "No patch utility found\n" unless $patch_exe;
    _run_or_die("$patch_exe -f -s -p0 <$diff");
    unlink $diff or die "unlink $diff: $!\n";
  }
  
  sub _write_or_die
  {
    my($file, $data) = @_;
    my $fh = IO::File->new(">$file") or die "$file: $!\n";
    $fh->print($data);
  }
  
  sub _run_or_die
  {
    # print "[running @_]\n";
    die unless scalar run( command => [ @_ ], verbose => 1 );
  }
  
  sub _determine_version {
    my ($source) = @_;
    my $patchlevel_h = File::Spec->catfile($source, 'patchlevel.h');
    return unless -e $patchlevel_h;
    my $version;
    {
      my %defines;
      open my $fh, '<', $patchlevel_h;
      my @vers;
      while (<$fh>) {
        chomp;
        next unless /^#define/;
        my ($foo,$bar) = ( split /\s+/ )[1,2];
        $defines{$foo} = $bar;
      }
      if ( my @wotsits = grep { defined $defines{$_} } qw(PERL_REVISION PERL_VERSION PERL_SUBVERSION) ) {
        $version = join '.', map { $defines{$_} } @wotsits;
      }
      else {
        $version = sprintf '5.%03d_%02d', map { $defines{$_} } qw(PATCHLEVEL SUBVERSION);
      }
    }
    return $version;
  }
  
  sub _patch_hints {
    return unless my ($file,$data) = hint_file();
    my $path = File::Spec->catfile( 'hints', $file );
    chmod 0644, $path or die "$!\n";
    open my $fh, '>', $path or die "$!\n";
    print $fh $data;
    close $fh;
    return 1;
  }
  
  sub _patch_db
  {
    my $ver = shift;
    print "patching ext/DB_File/DB_File.xs\n";
    _run_or_die($^X, '-pi.bak', '-e', "s/<db.h>/<db$ver\\/db.h>/", 'ext/DB_File/DB_File.xs');
    unlink 'ext/DB_File/DB_File.xs.bak' if -e 'ext/DB_File/DB_File.xs.bak';
  }
  
  sub _patch_doio
  {
    _patch(<<'END');
  --- doio.c.org  2004-06-07 23:14:45.000000000 +0200
  +++ doio.c  2003-11-04 08:03:03.000000000 +0100
  @@ -75,6 +75,16 @@
   #  endif
   #endif
  
  +#if _SEM_SEMUN_UNDEFINED
  +union semun
  +{
  +  int val;
  +  struct semid_ds *buf;
  +  unsigned short int *array;
  +  struct seminfo *__buf;
  +};
  +#endif
  +
   bool
   do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
   GV *gv;
  END
  }
  
  sub _patch_sysv
  {
    my %opt = @_;
  
    # check if patching is required
    return if $^O ne 'linux' or -f '/usr/include/asm/page.h';
  
    if ($opt{old_format}) {
      _patch(<<'END');
  --- ext/IPC/SysV/SysV.xs.org  1998-07-20 10:20:07.000000000 +0200
  +++ ext/IPC/SysV/SysV.xs  2007-08-12 10:51:06.000000000 +0200
  @@ -3,9 +3,6 @@
   #include "XSUB.h"
   
   #include <sys/types.h>
  -#ifdef __linux__
  -#include <asm/page.h>
  -#endif
   #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
   #include <sys/ipc.h>
   #ifdef HAS_MSG
  END
    }
    else {
      _patch(<<'END');
  --- ext/IPC/SysV/SysV.xs.org  2007-08-11 00:12:46.000000000 +0200
  +++ ext/IPC/SysV/SysV.xs  2007-08-11 00:10:51.000000000 +0200
  @@ -3,9 +3,6 @@
   #include "XSUB.h"
   
   #include <sys/types.h>
  -#ifdef __linux__
  -#   include <asm/page.h>
  -#endif
   #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
   #ifndef HAS_SEM
   #   include <sys/ipc.h>
  END
    }
  }
  
  sub _patch_configure
  {
    _patch(<<'END');
  --- Configure
  +++ Configure
  @@ -3380,6 +3380,18 @@
   test "X$gfpthkeep" != Xy && gfpth=""
   EOSC
   
  +# gcc 3.1 complains about adding -Idirectories that it already knows about,
  +# so we will take those off from locincpth.
  +case "$gccversion" in
  +3*)
  +    echo "main(){}">try.c
  +    for incdir in `$cc -v -c try.c 2>&1 | \
  +       sed '1,/^#include <\.\.\.>/d;/^End of search list/,$d;s/^ //'` ; do
  +       locincpth=`echo $locincpth | sed s!$incdir!!`
  +    done
  +    $rm -f try try.*
  +esac
  +
   : What should the include directory be ?
   echo " "
   $echo $n "Hmm...  $c"
  END
  }
  
  sub _patch_makedepend_lc
  {
    _patch(<<'END');
  --- makedepend.SH
  +++ makedepend.SH
  @@ -58,6 +58,10 @@ case $PERL_CONFIG_SH in
         ;;
   esac
   
  +# Avoid localized gcc/cc messages
  +LC_ALL=C
  +export LC_ALL
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  END
  }
  
  
  sub _patch_makedepend_SH
  {
    my $perl = shift;
    SWITCH: {
    # If 5.6.0
      if ( $perl eq '5.6.0' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2000-03-02 18:12:26.000000000 +0000
  +++ makedepend.SH	2010-09-01 10:13:37.000000000 +0100
  @@ -1,5 +1,5 @@
   #! /bin/sh
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -29,6 +29,13 @@
   !GROK!THIS!
   $spitshell >>makedepend <<'!NO!SUBS!'
   
  +if test -d .depending; then
  +	echo "$0: Already running, exiting."
  +	exit 0
  +fi
  +
  +mkdir .depending
  +
   # This script should be called with 
   #     sh ./makedepend MAKE=$(MAKE)
   case "$1" in 
  @@ -37,7 +44,7 @@
   
   export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
   
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -51,6 +58,11 @@
   	;;
   esac
   
  +# Avoid localized gcc messages
  +case "$ccname" in
  +    gcc) LC_ALL=C ; export LC_ALL ;;
  +esac
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  @@ -58,6 +70,10 @@
   PATH=".$path_sep..$path_sep$PATH"
   export PATH
   
  +case "$osname" in
  +amigaos) cat=/bin/cat ;; # must be absolute
  +esac
  +
   $cat /dev/null >.deptmp
   $rm -f *.c.c c/*.c.c
   if test -f Makefile; then
  @@ -67,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -99,25 +114,20 @@
   	$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
   for file in `$cat .clist`; do
   # for file in `cat /dev/null`; do
  -	if [ "$osname" = uwin ]; then
  -		uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
  -	else
  -		if [ "$osname" = os2 ]; then
  -			uwinfix="-e s,\\\\\\\\,/,g"
  -		else
  -			if [ "$archname" = cygwin ]; then
  -				uwinfix="-e s,\\\\\\\\,/,g"
  -			else
  -				uwinfix=
  -			fi
  -		fi
  -	fi
  +    case "$osname" in
  +    uwin)     uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;;
  +    os2)      uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    cygwin)   uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;;
  +    vos)      uwinfix="-e s/\#/\\\#/" ;;
  +    *)        uwinfix="" ;;
  +    esac
       case "$file" in
       *.c) filebase=`basename $file .c` ;;
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -130,22 +140,45 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
       if [ "$osname" = os390 -a "$file" = perly.c ]; then
           $echo '#endif' >>UU/$file.c
       fi
  -    $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
  -    $sed \
  -	-e '1d' \
  -	-e '/^#.*<stdin>/d' \
  -	-e '/^#.*"-"/d' \
  -	-e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
  -	-e 's/^[	 ]*#[	 ]*line/#/' \
  -	-e '/^# *[0-9][0-9]* *[".\/]/!d' \
  -	-e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
  -	-e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
  -	-e 's|: \./|: |' \
  -	-e 's|\.c\.c|.c|' $uwinfix | \
  -    $uniq | $sort | $uniq >> .deptmp
  +
  +    if [ "$osname" = os390 ]; then
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
  +        $sed \
  +    	    -e '/^#.*<stdin>/d' \
  +	    -e '/^#.*"-"/d' \
  +	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
  +	    -e 's/^[	 ]*#[	 ]*line/#/' \
  +	    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
  +	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
  +	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
  +	    -e 's|: \./|: |' \
  +	    -e 's|\.c\.c|.c|' $uwinfix | \
  +        $uniq | $sort | $uniq >> .deptmp
  +    else
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
  +        $sed \
  +	    -e '1d' \
  +	    -e '/^#.*<stdin>/d' \
  +            -e '/^#.*<builtin>/d' \
  +            -e '/^#.*<built-in>/d' \
  +            -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
  +	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
  +	    -e '/: file path prefix .* never used$/d' \
  +	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
  +	    -e 's/^[	 ]*#[	 ]*line/#/' \
  +	    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
  +	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
  +	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
  +	    -e 's|: \./|: |' \
  +           -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
  +        $uniq | $sort | $uniq >> .deptmp
  +    fi
   done
   
   $sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
  @@ -177,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  @@ -208,7 +245,8 @@
   $cp $mf.new $mf
   $rm $mf.new
   $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  -$rm -rf .deptmp UU .shlist .clist .hlist .hsed
  +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
  +rmdir .depending
   
   !NO!SUBS!
   $eunicefix makedepend
  BADGER
    last SWITCH;
    }
    # If 5.6.1
      if ( $perl eq '5.6.1' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2001-03-19 07:33:17.000000000 +0000
  +++ makedepend.SH	2010-09-01 10:14:47.000000000 +0100
  @@ -1,5 +1,5 @@
   #! /bin/sh
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -29,6 +29,13 @@
   !GROK!THIS!
   $spitshell >>makedepend <<'!NO!SUBS!'
   
  +if test -d .depending; then
  +	echo "$0: Already running, exiting."
  +	exit 0
  +fi
  +
  +mkdir .depending
  +
   # This script should be called with 
   #     sh ./makedepend MAKE=$(MAKE)
   case "$1" in 
  @@ -37,7 +44,7 @@
   
   export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
   
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -51,6 +58,11 @@
   	;;
   esac
   
  +# Avoid localized gcc messages
  +case "$ccname" in
  +    gcc) LC_ALL=C ; export LC_ALL ;;
  +esac
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  @@ -58,6 +70,10 @@
   PATH=".$path_sep..$path_sep$PATH"
   export PATH
   
  +case "$osname" in
  +amigaos) cat=/bin/cat ;; # must be absolute
  +esac
  +
   $cat /dev/null >.deptmp
   $rm -f *.c.c c/*.c.c
   if test -f Makefile; then
  @@ -67,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -99,29 +114,20 @@
   	$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
   for file in `$cat .clist`; do
   # for file in `cat /dev/null`; do
  -	if [ "$osname" = uwin ]; then
  -		uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
  -	else
  -		if [ "$osname" = os2 ]; then
  -			uwinfix="-e s,\\\\\\\\,/,g"
  -		else
  -			if [ "$archname" = cygwin ]; then
  -				uwinfix="-e s,\\\\\\\\,/,g"
  -			else
  -				if [ "$osname" = posix-bc ]; then
  -					uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/"
  -				else
  -					uwinfix=
  -				fi
  -			fi
  -		fi
  -	fi
  +    case "$osname" in
  +    uwin)     uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;;
  +    os2)      uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    cygwin)   uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;;
  +    vos)      uwinfix="-e s/\#/\\\#/" ;;
  +    *)        uwinfix="" ;;
  +    esac
       case "$file" in
       *.c) filebase=`basename $file .c` ;;
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -134,10 +140,12 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
  +    if [ "$osname" = os390 -a "$file" = perly.c ]; then
  +        $echo '#endif' >>UU/$file.c
  +    fi
  +
       if [ "$osname" = os390 ]; then
  -        if [ "$file" = perly.c ]; then
  -            $echo '#endif' >>UU/$file.c
  -        fi
           $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
           $sed \
       	    -e '/^#.*<stdin>/d' \
  @@ -151,18 +159,24 @@
   	    -e 's|\.c\.c|.c|' $uwinfix | \
           $uniq | $sort | $uniq >> .deptmp
       else
  -        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
           $sed \
   	    -e '1d' \
   	    -e '/^#.*<stdin>/d' \
  +            -e '/^#.*<builtin>/d' \
  +            -e '/^#.*<built-in>/d' \
  +            -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
  +	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
   	    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
   	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's|: \./|: |' \
  -	    -e 's|\.c\.c|.c|' $uwinfix | \
  +           -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
           $uniq | $sort | $uniq >> .deptmp
       fi
   done
  @@ -196,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  @@ -227,7 +245,8 @@
   $cp $mf.new $mf
   $rm $mf.new
   $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  -$rm -rf .deptmp UU .shlist .clist .hlist .hsed
  +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
  +rmdir .depending
   
   !NO!SUBS!
   $eunicefix makedepend
  BADGER
    last SWITCH;
    }
    # If 5.6.2
      if ( $perl eq '5.6.2' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2003-07-30 23:46:59.000000000 +0100
  +++ makedepend.SH	2010-09-01 10:15:47.000000000 +0100
  @@ -1,5 +1,5 @@
   #! /bin/sh
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -29,6 +29,13 @@
   !GROK!THIS!
   $spitshell >>makedepend <<'!NO!SUBS!'
   
  +if test -d .depending; then
  +	echo "$0: Already running, exiting."
  +	exit 0
  +fi
  +
  +mkdir .depending
  +
   # This script should be called with 
   #     sh ./makedepend MAKE=$(MAKE)
   case "$1" in 
  @@ -37,7 +44,7 @@
   
   export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
   
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -63,6 +70,10 @@
   PATH=".$path_sep..$path_sep$PATH"
   export PATH
   
  +case "$osname" in
  +amigaos) cat=/bin/cat ;; # must be absolute
  +esac
  +
   $cat /dev/null >.deptmp
   $rm -f *.c.c c/*.c.c
   if test -f Makefile; then
  @@ -72,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -104,29 +114,20 @@
   	$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
   for file in `$cat .clist`; do
   # for file in `cat /dev/null`; do
  -	if [ "$osname" = uwin ]; then
  -		uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
  -	else
  -		if [ "$osname" = os2 ]; then
  -			uwinfix="-e s,\\\\\\\\,/,g"
  -		else
  -			if [ "$archname" = cygwin ]; then
  -				uwinfix="-e s,\\\\\\\\,/,g"
  -			else
  -				if [ "$osname" = posix-bc ]; then
  -					uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/"
  -				else
  -					uwinfix=
  -				fi
  -			fi
  -		fi
  -	fi
  +    case "$osname" in
  +    uwin)     uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;;
  +    os2)      uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    cygwin)   uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;;
  +    vos)      uwinfix="-e s/\#/\\\#/" ;;
  +    *)        uwinfix="" ;;
  +    esac
       case "$file" in
       *.c) filebase=`basename $file .c` ;;
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -139,10 +140,12 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
  +    if [ "$osname" = os390 -a "$file" = perly.c ]; then
  +        $echo '#endif' >>UU/$file.c
  +    fi
  +
       if [ "$osname" = os390 ]; then
  -        if [ "$file" = perly.c ]; then
  -            $echo '#endif' >>UU/$file.c
  -        fi
           $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
           $sed \
       	    -e '/^#.*<stdin>/d' \
  @@ -156,21 +159,24 @@
   	    -e 's|\.c\.c|.c|' $uwinfix | \
           $uniq | $sort | $uniq >> .deptmp
       else
  -        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
           $sed \
   	    -e '1d' \
   	    -e '/^#.*<stdin>/d' \
  -	    -e '/^#.*<builtin>/d' \
  -	    -e '/^#.*<built-in>/d' \
  -	    -e '/^#.*<command line>/d' \
  +            -e '/^#.*<builtin>/d' \
  +            -e '/^#.*<built-in>/d' \
  +            -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
  +	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
   	    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
   	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's|: \./|: |' \
  -	    -e 's|\.c\.c|.c|' $uwinfix | \
  +           -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
           $uniq | $sort | $uniq >> .deptmp
       fi
   done
  @@ -204,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  @@ -235,7 +245,8 @@
   $cp $mf.new $mf
   $rm $mf.new
   $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  -$rm -rf .deptmp UU .shlist .clist .hlist .hsed
  +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
  +rmdir .depending
   
   !NO!SUBS!
   $eunicefix makedepend
  BADGER
    last SWITCH;
    }
    # If 5.7.0
      if ( $perl eq '5.7.0' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2000-08-13 19:35:04.000000000 +0100
  +++ makedepend.SH	2010-09-01 10:47:14.000000000 +0100
  @@ -1,5 +1,5 @@
   #! /bin/sh
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -29,6 +29,13 @@
   !GROK!THIS!
   $spitshell >>makedepend <<'!NO!SUBS!'
   
  +if test -d .depending; then
  +	echo "$0: Already running, exiting."
  +	exit 0
  +fi
  +
  +mkdir .depending
  +
   # This script should be called with 
   #     sh ./makedepend MAKE=$(MAKE)
   case "$1" in 
  @@ -37,7 +44,7 @@
   
   export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
   
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -51,6 +58,11 @@
   	;;
   esac
   
  +# Avoid localized gcc messages
  +case "$ccname" in
  +    gcc) LC_ALL=C ; export LC_ALL ;;
  +esac
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  @@ -58,6 +70,10 @@
   PATH=".$path_sep..$path_sep$PATH"
   export PATH
   
  +case "$osname" in
  +amigaos) cat=/bin/cat ;; # must be absolute
  +esac
  +
   $cat /dev/null >.deptmp
   $rm -f *.c.c c/*.c.c
   if test -f Makefile; then
  @@ -67,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -99,25 +114,20 @@
   	$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
   for file in `$cat .clist`; do
   # for file in `cat /dev/null`; do
  -	if [ "$osname" = uwin ]; then
  -		uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
  -	else
  -		if [ "$osname" = os2 ]; then
  -			uwinfix="-e s,\\\\\\\\,/,g"
  -		else
  -			if [ "$archname" = cygwin ]; then
  -				uwinfix="-e s,\\\\\\\\,/,g"
  -			else
  -				uwinfix=
  -			fi
  -		fi
  -	fi
  +    case "$osname" in
  +    uwin)     uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;;
  +    os2)      uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    cygwin)   uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;;
  +    vos)      uwinfix="-e s/\#/\\\#/" ;;
  +    *)        uwinfix="" ;;
  +    esac
       case "$file" in
       *.c) filebase=`basename $file .c` ;;
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -130,10 +140,12 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
  +    if [ "$osname" = os390 -a "$file" = perly.c ]; then
  +        $echo '#endif' >>UU/$file.c
  +    fi
  +
       if [ "$osname" = os390 ]; then
  -        if [ "$file" = perly.c ]; then
  -            $echo '#endif' >>UU/$file.c
  -        fi
           $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
           $sed \
       	    -e '/^#.*<stdin>/d' \
  @@ -147,18 +159,24 @@
   	    -e 's|\.c\.c|.c|' $uwinfix | \
           $uniq | $sort | $uniq >> .deptmp
       else
  -        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
           $sed \
   	    -e '1d' \
   	    -e '/^#.*<stdin>/d' \
  +            -e '/^#.*<builtin>/d' \
  +            -e '/^#.*<built-in>/d' \
  +            -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
  +	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
   	    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
   	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's|: \./|: |' \
  -	    -e 's|\.c\.c|.c|' $uwinfix | \
  +           -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
           $uniq | $sort | $uniq >> .deptmp
       fi
   done
  @@ -192,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  @@ -223,7 +245,8 @@
   $cp $mf.new $mf
   $rm $mf.new
   $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  -$rm -rf .deptmp UU .shlist .clist .hlist .hsed
  +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
  +rmdir .depending
   
   !NO!SUBS!
   $eunicefix makedepend
  BADGER
    last SWITCH;
    }
    # If 5.7.1
      if ( $perl eq '5.7.1' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2001-03-11 16:30:08.000000000 +0000
  +++ makedepend.SH	2010-09-01 10:44:54.000000000 +0100
  @@ -1,5 +1,5 @@
   #! /bin/sh
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -29,6 +29,13 @@
   !GROK!THIS!
   $spitshell >>makedepend <<'!NO!SUBS!'
   
  +if test -d .depending; then
  +	echo "$0: Already running, exiting."
  +	exit 0
  +fi
  +
  +mkdir .depending
  +
   # This script should be called with 
   #     sh ./makedepend MAKE=$(MAKE)
   case "$1" in 
  @@ -37,7 +44,7 @@
   
   export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
   
  -case $CONFIGDOTSH in
  +case $PERL_CONFIG_SH in
   '')
   	if test -f config.sh; then TOP=.;
   	elif test -f ../config.sh; then TOP=..;
  @@ -51,6 +58,11 @@
   	;;
   esac
   
  +# Avoid localized gcc messages
  +case "$ccname" in
  +    gcc) LC_ALL=C ; export LC_ALL ;;
  +esac
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  @@ -58,6 +70,10 @@
   PATH=".$path_sep..$path_sep$PATH"
   export PATH
   
  +case "$osname" in
  +amigaos) cat=/bin/cat ;; # must be absolute
  +esac
  +
   $cat /dev/null >.deptmp
   $rm -f *.c.c c/*.c.c
   if test -f Makefile; then
  @@ -67,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -99,29 +114,20 @@
   	$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
   for file in `$cat .clist`; do
   # for file in `cat /dev/null`; do
  -	if [ "$osname" = uwin ]; then
  -		uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
  -	else
  -		if [ "$osname" = os2 ]; then
  -			uwinfix="-e s,\\\\\\\\,/,g"
  -		else
  -			if [ "$archname" = cygwin ]; then
  -				uwinfix="-e s,\\\\\\\\,/,g"
  -			else
  -				if [ "$osname" = posix-bc ]; then
  -					uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/"
  -				else
  -					uwinfix=
  -				fi
  -			fi
  -		fi
  -	fi
  +    case "$osname" in
  +    uwin)     uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;;
  +    os2)      uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    cygwin)   uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;;
  +    vos)      uwinfix="-e s/\#/\\\#/" ;;
  +    *)        uwinfix="" ;;
  +    esac
       case "$file" in
       *.c) filebase=`basename $file .c` ;;
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -134,10 +140,12 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
  +    if [ "$osname" = os390 -a "$file" = perly.c ]; then
  +        $echo '#endif' >>UU/$file.c
  +    fi
  +
       if [ "$osname" = os390 ]; then
  -        if [ "$file" = perly.c ]; then
  -            $echo '#endif' >>UU/$file.c
  -        fi
           $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
           $sed \
       	    -e '/^#.*<stdin>/d' \
  @@ -151,18 +159,24 @@
   	    -e 's|\.c\.c|.c|' $uwinfix | \
           $uniq | $sort | $uniq >> .deptmp
       else
  -        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
           $sed \
   	    -e '1d' \
   	    -e '/^#.*<stdin>/d' \
  +            -e '/^#.*<builtin>/d' \
  +            -e '/^#.*<built-in>/d' \
  +            -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
  +	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
   	    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
   	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's|: \./|: |' \
  -	    -e 's|\.c\.c|.c|' $uwinfix | \
  +           -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
           $uniq | $sort | $uniq >> .deptmp
       fi
   done
  @@ -196,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  @@ -227,7 +245,8 @@
   $cp $mf.new $mf
   $rm $mf.new
   $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  -$rm -rf .deptmp UU .shlist .clist .hlist .hsed
  +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
  +rmdir .depending
   
   !NO!SUBS!
   $eunicefix makedepend
  BADGER
    last SWITCH;
    }
    # If 5.7.2
      if ( $perl eq '5.7.2' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2001-07-09 15:11:05.000000000 +0100
  +++ makedepend.SH	2010-09-01 10:45:32.000000000 +0100
  @@ -18,10 +18,6 @@
   */*) cd `expr X$0 : 'X\(.*\)/'` ;;
   esac
   
  -case "$osname" in
  -amigaos) cat=/bin/cat ;; # must be absolute
  -esac
  -
   echo "Extracting makedepend (with variable substitutions)"
   rm -f makedepend
   $spitshell >makedepend <<!GROK!THIS!
  @@ -33,6 +29,13 @@
   !GROK!THIS!
   $spitshell >>makedepend <<'!NO!SUBS!'
   
  +if test -d .depending; then
  +	echo "$0: Already running, exiting."
  +	exit 0
  +fi
  +
  +mkdir .depending
  +
   # This script should be called with 
   #     sh ./makedepend MAKE=$(MAKE)
   case "$1" in 
  @@ -55,6 +58,11 @@
   	;;
   esac
   
  +# Avoid localized gcc messages
  +case "$ccname" in
  +    gcc) LC_ALL=C ; export LC_ALL ;;
  +esac
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  @@ -62,6 +70,10 @@
   PATH=".$path_sep..$path_sep$PATH"
   export PATH
   
  +case "$osname" in
  +amigaos) cat=/bin/cat ;; # must be absolute
  +esac
  +
   $cat /dev/null >.deptmp
   $rm -f *.c.c c/*.c.c
   if test -f Makefile; then
  @@ -71,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -103,29 +114,20 @@
   	$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
   for file in `$cat .clist`; do
   # for file in `cat /dev/null`; do
  -	if [ "$osname" = uwin ]; then
  -		uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
  -	else
  -		if [ "$osname" = os2 ]; then
  -			uwinfix="-e s,\\\\\\\\,/,g"
  -		else
  -			if [ "$archname" = cygwin ]; then
  -				uwinfix="-e s,\\\\\\\\,/,g"
  -			else
  -				if [ "$osname" = posix-bc ]; then
  -					uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/"
  -				else
  -					uwinfix=
  -				fi
  -			fi
  -		fi
  -	fi
  +    case "$osname" in
  +    uwin)     uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g" ;;
  +    os2)      uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    cygwin)   uwinfix="-e s,\\\\\\\\,/,g" ;;
  +    posix-bc) uwinfix="-e s/\\*POSIX(\\(.*\\))/\\1/" ;;
  +    vos)      uwinfix="-e s/\#/\\\#/" ;;
  +    *)        uwinfix="" ;;
  +    esac
       case "$file" in
       *.c) filebase=`basename $file .c` ;;
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -138,10 +140,12 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
  +    if [ "$osname" = os390 -a "$file" = perly.c ]; then
  +        $echo '#endif' >>UU/$file.c
  +    fi
  +
       if [ "$osname" = os390 ]; then
  -        if [ "$file" = perly.c ]; then
  -            $echo '#endif' >>UU/$file.c
  -        fi
           $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
           $sed \
       	    -e '/^#.*<stdin>/d' \
  @@ -155,18 +159,24 @@
   	    -e 's|\.c\.c|.c|' $uwinfix | \
           $uniq | $sort | $uniq >> .deptmp
       else
  -        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
           $sed \
   	    -e '1d' \
   	    -e '/^#.*<stdin>/d' \
  +            -e '/^#.*<builtin>/d' \
  +            -e '/^#.*<built-in>/d' \
  +            -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
  +	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
   	    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
   	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's|: \./|: |' \
  -	    -e 's|\.c\.c|.c|' $uwinfix | \
  +           -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
           $uniq | $sort | $uniq >> .deptmp
       fi
   done
  @@ -200,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  @@ -231,7 +245,8 @@
   $cp $mf.new $mf
   $rm $mf.new
   $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  -$rm -rf .deptmp UU .shlist .clist .hlist .hsed
  +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
  +rmdir .depending
   
   !NO!SUBS!
   $eunicefix makedepend
  BADGER
    last SWITCH;
    }
    # If 5.7.3
      if ( $perl eq '5.7.3' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2002-03-05 01:10:22.000000000 +0000
  +++ makedepend.SH	2010-09-01 10:46:13.000000000 +0100
  @@ -18,10 +18,6 @@
   */*) cd `expr X$0 : 'X\(.*\)/'` ;;
   esac
   
  -case "$osname" in
  -amigaos) cat=/bin/cat ;; # must be absolute
  -esac
  -
   echo "Extracting makedepend (with variable substitutions)"
   rm -f makedepend
   $spitshell >makedepend <<!GROK!THIS!
  @@ -33,6 +29,13 @@
   !GROK!THIS!
   $spitshell >>makedepend <<'!NO!SUBS!'
   
  +if test -d .depending; then
  +	echo "$0: Already running, exiting."
  +	exit 0
  +fi
  +
  +mkdir .depending
  +
   # This script should be called with 
   #     sh ./makedepend MAKE=$(MAKE)
   case "$1" in 
  @@ -55,6 +58,11 @@
   	;;
   esac
   
  +# Avoid localized gcc messages
  +case "$ccname" in
  +    gcc) LC_ALL=C ; export LC_ALL ;;
  +esac
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  @@ -62,6 +70,10 @@
   PATH=".$path_sep..$path_sep$PATH"
   export PATH
   
  +case "$osname" in
  +amigaos) cat=/bin/cat ;; # must be absolute
  +esac
  +
   $cat /dev/null >.deptmp
   $rm -f *.c.c c/*.c.c
   if test -f Makefile; then
  @@ -71,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -116,7 +127,7 @@
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -129,6 +140,11 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
  +    if [ "$osname" = os390 -a "$file" = perly.c ]; then
  +        $echo '#endif' >>UU/$file.c
  +    fi
  +
       if [ "$osname" = os390 ]; then
           $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
           $sed \
  @@ -143,13 +159,16 @@
   	    -e 's|\.c\.c|.c|' $uwinfix | \
           $uniq | $sort | $uniq >> .deptmp
       else
  -        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c 2>&1 |
  +        $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c >.cout 2>.cerr
           $sed \
   	    -e '1d' \
   	    -e '/^#.*<stdin>/d' \
               -e '/^#.*<builtin>/d' \
  +            -e '/^#.*<built-in>/d' \
               -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
   	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
  @@ -157,7 +176,7 @@
   	    -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
   	    -e 's|: \./|: |' \
  -	    -e 's|\.c\.c|.c|' $uwinfix | \
  +           -e 's|\.c\.c|.c|' $uwinfix .cout .cerr| \
           $uniq | $sort | $uniq >> .deptmp
       fi
   done
  @@ -191,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  @@ -222,7 +245,8 @@
   $cp $mf.new $mf
   $rm $mf.new
   $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  -$rm -rf .deptmp UU .shlist .clist .hlist .hsed
  +$rm -rf .deptmp UU .shlist .clist .hlist .hsed .cout .cerr
  +rmdir .depending
   
   !NO!SUBS!
   $eunicefix makedepend
  BADGER
    last SWITCH;
    }
    # If 5.8.0
      if ( $perl eq '5.8.0' ) {
    _patch(<<'BADGER');
  --- makedepend.SH.org	2002-07-09 15:06:42.000000000 +0100
  +++ makedepend.SH	2010-09-01 10:16:37.000000000 +0100
  @@ -58,6 +58,11 @@
   	;;
   esac
   
  +# Avoid localized gcc messages
  +case "$ccname" in
  +    gcc) LC_ALL=C ; export LC_ALL ;;
  +esac
  +
   # We need .. when we are in the x2p directory if we are using the
   # cppstdin wrapper script.
   # Put .. and . first so that we pick up the present cppstdin, not
  @@ -78,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -123,7 +127,7 @@
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -136,6 +140,11 @@
   	-e 's|\\$||' \
   	-e p \
   	-e '}' ) >UU/$file.c
  +
  +    if [ "$osname" = os390 -a "$file" = perly.c ]; then
  +        $echo '#endif' >>UU/$file.c
  +    fi
  +
       if [ "$osname" = os390 ]; then
           $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
           $sed \
  @@ -157,7 +166,9 @@
               -e '/^#.*<builtin>/d' \
               -e '/^#.*<built-in>/d' \
               -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
   	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
  @@ -199,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  BADGER
    last SWITCH;
    }
    # If 5.8.[12345678]
    _patch(<<'BADGER');
  --- makedepend.SH.org	2003-06-05 19:11:10.000000000 +0100
  +++ makedepend.SH	2010-09-01 10:24:39.000000000 +0100
  @@ -83,7 +83,6 @@
       # to be out of date.  I don't know if OS/2 has touch, so do this:
       case "$osname" in
       os2) ;;
  -    netbsd) ;;
       *) $touch $firstmakefile ;;
       esac
   fi
  @@ -128,7 +127,7 @@
       *.y) filebase=`basename $file .y` ;;
       esac
       case "$file" in
  -    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  +    */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;;
       *)   finc= ;;
       esac
       $echo "Finding dependencies for $filebase$_o."
  @@ -167,7 +166,9 @@
               -e '/^#.*<builtin>/d' \
               -e '/^#.*<built-in>/d' \
               -e '/^#.*<command line>/d' \
  +            -e '/^#.*<command-line>/d' \
   	    -e '/^#.*"-"/d' \
  +	    -e '/^#.*"\/.*\/"/d' \
   	    -e '/: file path prefix .* never used$/d' \
   	    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
   	    -e 's/^[	 ]*#[	 ]*line/#/' \
  @@ -209,6 +210,10 @@
       $echo "Updating $mf..."
       $echo "# If this runs make out of memory, delete /usr/include lines." \
   	>> $mf.new
  +    if [ "$osname" = vos ]; then
  +        $sed 's|.incl.c|.h|' .deptmp >.deptmp.vos
  +        mv -f .deptmp.vos .deptmp
  +    fi
       $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
          >>$mf.new
   else
  BADGER
    }
  }
  
  sub _patch_archive_tar_tests
  {
    my $perl = shift;
    if ($perl =~ /^5\.10/) {
      _patch(<<'END');
  --- lib/Archive/Tar/t/02_methods.t
  +++ lib/Archive/Tar/t/02_methods.t
  @@ -70,6 +70,20 @@ my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-re
   my $TOO_LONG    =   ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS')
                       && length( cwd(). $LONG_FILE ) > 247;
   
  +if(!$TOO_LONG) {
  +    my $alt = File::Spec->catfile( cwd(), $LONG_FILE);
  +    eval 'mkpath([$alt]);';
  +    if($@)
  +    {
  +        $TOO_LONG = 1;
  +    }
  +    else
  +    {
  +        $@ = '';
  +        my $base = File::Spec->catfile( cwd(), 'directory');
  +        rmtree $base;
  +    }
  +}
   ### warn if we are going to skip long file names
   if ($TOO_LONG) {
       diag("No long filename support - long filename extraction disabled") if ! $ENV{PERL_CORE};
  END
    }
    else {
      _patch(<<'END');
  --- cpan/Archive-Tar/t/02_methods.t
  +++ cpan/Archive-Tar/t/02_methods.t
  @@ -70,6 +70,20 @@ my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-re
   my $TOO_LONG    =   ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS')
                       && length( cwd(). $LONG_FILE ) > 247;
   
  +if(!$TOO_LONG) {
  +    my $alt = File::Spec->catfile( cwd(), $LONG_FILE);
  +    eval 'mkpath([$alt]);';
  +    if($@)
  +    {
  +        $TOO_LONG = 1;
  +    }
  +    else
  +    {
  +        $@ = '';
  +        my $base = File::Spec->catfile( cwd(), 'directory');
  +        rmtree $base;
  +    }
  +}
   ### warn if we are going to skip long file names
   if ($TOO_LONG) {
       diag("No long filename support - long filename extraction disabled") if ! $ENV{PERL_CORE};
  END
    }
  }
  
  sub _patch_odbm_file_hints_linux
  {
      _patch(<<'END');
  --- ext/ODBM_File/hints/linux.pl
  +++ ext/ODBM_File/hints/linux.pl
  @@ -1,8 +1,8 @@
   # uses GDBM dbm compatibility feature - at least on SuSE 8.0
   $self->{LIBS} = ['-lgdbm'];
   
  -# Debian/Ubuntu have /usr/lib/libgdbm_compat.so.3* but not this file,
  +# Debian/Ubuntu have libgdbm_compat.so but not this file,
   # so linking may fail
  -if (-e '/usr/lib/libgdbm_compat.so' or -e '/usr/lib64/libgdbm_compat.so') {
  -    $self->{LIBS}->[0] .= ' -lgdbm_compat';
  +foreach (split / /, $Config{libpth}) {
  +    $self->{LIBS}->[0] .= ' -lgdbm_compat' if -e $_.'/libgdbm_compat.so';
   }
  END
  }
  
  sub _patch_make_ext_pl
  {
    _patch(<<'END');
  --- make_ext.pl
  +++ make_ext.pl
  @@ -377,6 +377,10 @@ WriteMakefile(
   EOM
   	    close $fh or die "Can't close Makefile.PL: $!";
   	}
  +  eval {
  +    my $ftime = time - 4;
  +    utime $ftime, $ftime, 'Makefile.PL';
  +  };
   	print "\nRunning Makefile.PL in $ext_dir\n";
   
   	# Presumably this can be simplified
  END
  }
  
  sub _patch_589_perlio_c
  {
    _patch(<<'END');
  --- perlio.c
  +++ perlio.c
  @@ -2323,6 +2323,12 @@ PerlIO_init(pTHX)
   {
       /* MUTEX_INIT(&PL_perlio_mutex) is done in PERL_SYS_INIT3(). */
       PERL_UNUSED_CONTEXT;
  +    /*
  +     * No, for backwards compatibility (before PERL_SYS_INIT3 changed to be
  +     * defined as a separate function call), we need to call
  +     * MUTEX_INIT(&PL_perlio_mutex) (via the PERLIO_INIT macro).
  +     */
  +    PERLIO_INIT;
   }
   
   void
  END
  }
  
  qq[patchin'];
  
  
  
  __END__
  =pod
  
  =head1 NAME
  
  Devel::PatchPerl - Patch perl source a la Devel::PPPort's buildperl.pl
  
  =head1 VERSION
  
  version 0.76
  
  =head1 SYNOPSIS
  
    use strict;
    use warnings;
  
    use Devel::PatchPerl;
  
    Devel::PatchPerl->patch_source( '5.6.1', '/path/to/untarred/perl/source/perl-5.6.1' );
  
  =head1 DESCRIPTION
  
  Devel::PatchPerl is a modularisation of the patching code contained in L<Devel::PPPort>'s
  C<buildperl.pl>.
  
  It does not build perls, it merely provides an interface to the source patching
  functionality.
  
  =head1 FUNCTION
  
  =over
  
  =item C<patch_source>
  
  Takes two parameters, a C<perl> version and the path to unwrapped perl source for that version.
  It dies on any errors.
  
  If you don't supply a C<perl> version, it will attempt to auto-determine the
  C<perl> version from the specified path.
  
  If you don't supply the path to unwrapped perl source, it will assume the
  current working directory.
  
  =back
  
  =head1 PLUGIN SYSTEM
  
  See L<Devel::PatchPerl::Plugin> for details of Devel::PatchPerl's plugin system.
  
  =head1 CAVEAT
  
  Devel::PatchPerl is intended only to facilitate the C<building> of perls, not to
  facilitate the C<testing> of perls. This means that it will not patch failing tests
  in the perl testsuite.
  
  =head1 SEE ALSO
  
  L<Devel::PPPort>
  
  L<Devel::PatchPerl::Plugin>
  
  =head1 AUTHOR
  
  Chris Williams <chris@bingosnet.co.uk>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2012 by Chris Williams and Marcus Holland-Moritz.
  
  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
  
DEVEL_PATCHPERL

$fatpacked{"Devel/PatchPerl/Hints.pm"} = <<'DEVEL_PATCHPERL_HINTS';
  package Devel::PatchPerl::Hints;
  {
    $Devel::PatchPerl::Hints::VERSION = '0.76';
  }
  
  #ABSTRACT: replacement 'hints' files
  
  use strict;
  use warnings;
  use MIME::Base64 qw[decode_base64];
  use File::Spec;
  
  our @ISA            = qw[Exporter];
  our @EXPORT_OK      = qw[hint_file];
  
  my %hints = (
  'hpux' =>
  'IyEvdXNyL2Jpbi9zaAoKIyMjIFNZU1RFTSBBUkNISVRFQ1RVUkUKCiMgRGV0ZXJtaW5lIHRoZSBh
  cmNoaXRlY3R1cmUgdHlwZSBvZiB0aGlzIHN5c3RlbS4KIyBLZWVwIGxlYWRpbmcgdGFiIGJlbG93
  IC0tIENvbmZpZ3VyZSBCbGFjayBNYWdpYyAtLSBSQU0sIDAzLzAyLzk3Cgl4eE9zUmV2TWFqb3I9
  YHVuYW1lIC1yIHwgc2VkIC1lICdzL15bXjAtOV0qLy8nIHwgY3V0IC1kLiAtZjFgOwoJeHhPc1Jl
  dk1pbm9yPWB1bmFtZSAtciB8IHNlZCAtZSAncy9eW14wLTldKi8vJyB8IGN1dCAtZC4gLWYyYDsK
  CXh4T3NSZXY9YGV4cHIgMTAwIFwqICR4eE9zUmV2TWFqb3IgKyAkeHhPc1Jldk1pbm9yYAppZiBb
  ICIkeHhPc1Jldk1ham9yIiAtZ2UgMTAgXTsgdGhlbgogICAgIyBUaGlzIHN5c3RlbSBpcyBydW5u
  aW5nID49IDEwLngKCiAgICAjIFRlc3RlZCBvbiAxMC4wMSBQQTEueCBhbmQgMTAuMjAgUEFbMTJd
  LnguCiAgICAjIElkZWE6IFNjYW4gL3Vzci9pbmNsdWRlL3N5cy91bmlzdGQuaCBmb3IgbWF0Y2hl
  cyB3aXRoCiAgICAjICIjZGVmaW5lIENQVV8qIGBnZXRjb25mICMgQ1BVX1ZFUlNJT05gIiB0byBk
  ZXRlcm1pbmUgQ1BVIHR5cGUuCiAgICAjIE5vdGUgdGhlIHRleHQgZm9sbG93aW5nICJDUFVfIiBp
  cyB1c2VkLCAqTk9UKiB0aGUgY29tbWVudC4KICAgICMKICAgICMgQVNTVU1QVElPTlM6IE51bWJl
  cnMgd2lsbCBjb250aW51ZSB0byBiZSBkZWZpbmVkIGluIGhleCAtLSBhbmQgaW4KICAgICMgL3Vz
  ci9pbmNsdWRlL3N5cy91bmlzdGQuaCAtLSBhbmQgdGhlIENQVV8qICNkZWZpbmVzIHdpbGwgYmUg
  a2VwdAogICAgIyB1cCB0byBkYXRlIHdpdGggbmV3IENQVS9PUyByZWxlYXNlcy4KICAgIHh4Y3B1
  PWBnZXRjb25mIENQVV9WRVJTSU9OYDsgIyBHZXQgdGhlIG51bWJlci4KICAgIHh4Y3B1PWBwcmlu
  dGYgJzB4JXgnICR4eGNwdWA7ICMgY29udmVydCB0byBoZXgKICAgIGFyY2huYW1lPWBzZWQgLW4g
  LWUgInMvXiNbWzpzcGFjZTpdXSpkZWZpbmVbWzpzcGFjZTpdXSpDUFVfLy9wIiAvdXNyL2luY2x1
  ZGUvc3lzL3VuaXN0ZC5oIHwKCXNlZCAtbiAtZSAicy9bWzpzcGFjZTpdXSokeHhjcHVbWzpzcGFj
  ZTpdXS4qLy9wIiB8CglzZWQgLWUgcy9fUklTQy8tUklTQy8gLWUgcy9IUF8vLyAtZSBzL18vLi8g
  LWUgInMvW1s6c3BhY2U6XV0qLy9nImA7CmVsc2UKICAgICMgVGhpcyBzeXN0ZW0gaXMgcnVubmlu
  ZyA8PSA5LngKICAgICMgVGVzdGVkIG9uIDkuMFs1N10gUEEgYW5kIFs3OF0uMCBNQzY4MFsyM10w
  LiAgSWRlYTogQWZ0ZXIgcmVtb3ZpbmcKICAgICMgTUM2ODg4WzEyXSBmcm9tIGNvbnRleHQgc3Ry
  aW5nLCB1c2UgZmlyc3QgQ1BVIGlkZW50aWZpZXIuCiAgICAjCiAgICAjIEFTU1VNUFRJT046IE9u
  bHkgQ1BVIGlkZW50aWZpZXJzIGNvbnRhaW4gbm8gbG93ZXJjYXNlIGxldHRlcnMuCiAgICBhcmNo
  bmFtZT1gZ2V0Y29udGV4dCB8IHRyICcgJyAnXDAxMicgfCBncmVwIC12ICdbYS16XScgfCBncmVw
  IC12IE1DNjg4IHwKCXNlZCAtZSAncy9IUC0vLycgLWUgMXFgOwogICAgc2VsZWN0dHlwZT0naW50
  IConCiAgICBmaQoKIyBGb3Igc29tZSBzdHJhbmdlIHJlYXNvbiwgdGhlIHUzMmFsaWduIHRlc3Qg
  ZnJvbSBDb25maWd1cmUgaGFuZ3MgaW4KIyBIUC1VWCAxMC4yMCBzaW5jZSB0aGUgRGVjZW1iZXIg
  MjAwMSBwYXRjaGVzLiAgU28gaGludCBpdCB0byBhdm9pZAojIHRoZSB0ZXN0LgppZiBbICIkeHhP
  c1Jldk1ham9yIiAtbGUgMTAgXTsgdGhlbgogICAgZF91MzJhbGlnbj0kZGVmaW5lCiAgICBmaQoK
  ZWNobyAiQXJjaG5hbWUgaXMgJGFyY2huYW1lIgoKIyBGaXggWFNsaWIgKENQQU4pIGNvbmZ1c2lv
  biB3aGVuIHJlLXVzaW5nIGEgcHJlZml4IGJ1dCBjaGFuZ2luZyBmcm9tIElMUDMyCiMgdG8gTFA2
  NCBidWlsZHMuICBUaGV5J3JlIE5PVCBiaW5hcnkgY29tcGF0aWJsZSwgc28gcXVpdCBjbGFpbWlu
  ZyB0aGV5IGFyZS4KYXJjaG5hbWU2ND1MUDY0CgoKIyMjIEhQLVVYIE9TIHNwZWNpZmljIGJlaGF2
  aW91cgoKIyAtbGRibSBpcyBvYnNvbGV0ZSBhbmQgc2hvdWxkIG5vdCBiZSB1c2VkCiMgLWxCU0Qg
  Y29udGFpbnMgQlNELXN0eWxlIGR1cGxpY2F0ZXMgb2YgU1ZSNCByb3V0aW5lcyB0aGF0IGNhdXNl
  IGNvbmZ1c2lvbgojIC1sUFcgaXMgb2Jzb2xldGUgYW5kIHNob3VsZCBub3QgYmUgdXNlZAojIFRo
  ZSBsaWJyYXJpZXMgY3J5cHQsIG1hbGxvYywgbmRpciwgYW5kIG5ldCBhcmUgZW1wdHkuCnNldCBg
  ZWNobyAiWCAkbGlic3dhbnRlZCAiIHwgc2VkIC1lICdzLyBsZCAvIC8nIC1lICdzLyBkYm0gLyAv
  JyAtZSAncy8gQlNEIC8gLycgLWUgJ3MvIFBXIC8gLydgCnNoaWZ0CmxpYnN3YW50ZWQ9IiQqIgoK
  Y2M9JHtjYzotY2N9CmFyPS91c3IvYmluL2FyCSMgWWVzLCB0cnVseSBvdmVycmlkZS4gIFdlIGRv
  IG5vdCB3YW50IHRoZSBHTlUgYXIuCmZ1bGxfYXI9JGFyCSMgSSByZXBlYXQsIG5vIEdOVSBhci4g
  IGFycnIuCgpzZXQgYGVjaG8gIlggJGNjZmxhZ3MgIiB8IHNlZCAtZSAncy8gLUFbZWFdIC8gLycg
  LWUgJ3MvIC1EX0hQVVhfU09VUkNFIC8gLydgCnNoaWZ0CgljY19jcHBmbGFncz0iJCogLURfSFBV
  WF9TT1VSQ0UiCmNwcGZsYWdzPSItQWEgLURfX1NURENfRVhUX18gJGNjX2NwcGZsYWdzIgoKY2Fz
  ZSAiJHByZWZpeCIgaW4KICAgICIiKSBwcmVmaXg9Jy9vcHQvcGVybDUnIDs7CiAgICBlc2FjCgog
  ICAgZ251X2FzPW5vCiAgICBnbnVfbGQ9bm8KY2FzZSBgJGNjIC12IDI+JjFgIiIgaW4KICAgICpn
  Y2MqKSAgY2Npc2djYz0iJGRlZmluZSIKCSAgICBjY2ZsYWdzPSIkY2NfY3BwZmxhZ3MiCgkgICAg
  aWYgWyAiWCRnY2N2ZXJzaW9uIiA9ICJYIiBdOyB0aGVuCgkJIyBEb25lIHRvbyBsYXRlIGluIENv
  bmZpZ3VyZSBpZiBoaW50ZWQKCQlnY2N2ZXJzaW9uPWAkY2MgLWR1bXB2ZXJzaW9uYAoJCWZpCgkg
  ICAgY2FzZSAiJGdjY3ZlcnNpb24iIGluCgkJWzAxMl0qKSAjIEhQLVVYIGFuZCBnY2MtMi4qIGJy
  ZWFrIFVJTlQzMl9NQVggOi0oCgkJCWNjZmxhZ3M9IiRjY2ZsYWdzIC1EVUlOVDMyX01BWF9CUk9L
  RU4iCgkJCTs7CgkJWzM0XSopICMgR0NDIChib3RoIDMyYml0IGFuZCA2NGJpdCkgd2lsbCBkZWZp
  bmUgX19TVERDX0VYVF9fCiAgICAgICAgICAgICAgICAgICAgICAgIyBieSBkZWZhdWx0IHdoZW4g
  dXNpbmcgR0NDIDMuMCBhbmQgbmV3ZXIgdmVyc2lvbnMgb2YKICAgICAgICAgICAgICAgICAgICAg
  ICAjIHRoZSBjb21waWxlci4KICAgICAgICAgICAgICAgICAgICAgICBjcHBmbGFncz0iJGNjX2Nw
  cGZsYWdzIgogICAgICAgICAgICAgICAgICAgICAgIDs7CgkJZXNhYwoJICAgIGNhc2UgImBnZXRj
  b25mIEtFUk5FTF9CSVRTIDI+L2Rldi9udWxsYCIgaW4KCQkqNjQqKQoJCSAgICBlY2hvICJtYWlu
  KCl7fSI+dHJ5LmMKCQkgICAgY2FzZSAiJGdjY3ZlcnNpb24iIGluCgkJCVszNF0qKQoJCQkgICAg
  Y2FzZSAiJGFyY2huYW1lIiBpbgogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgUEEtUklT
  QyopCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY2FzZSAiJGNjZmxhZ3MiIGlu
  CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICotbXBhLXJpc2MqKSA7Owog
  ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAqKSBjY2ZsYWdzPSIkY2NmbGFn
  cyAtbXBhLXJpc2MtMi0wIiA7OwogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAg
  ICBlc2FjCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgOzsKCQkJCWVzYWMKCQkJ
  ICAgIDs7CgkJCSopICAjIGdjYyB3aXRoIGdhcyB3aWxsIG5vdCBhY2NlcHQgK0RBMi4wCgkJCSAg
  ICBjYXNlICJgJGNjIC1jIC1XYSwrREEyLjAgdHJ5LmMgMj4mMWAiIGluCgkJCQkqIitEQTIuMCIq
  KQkJIyBnYXMKCQkJCSAgICBnbnVfYXM9eWVzCgkJCQkgICAgOzsKCQkJCSopCQkJIyBIUGFzCgkJ
  CQkgICAgY2NmbGFncz0iJGNjZmxhZ3MgLVdhLCtEQTIuMCIKCQkJCSAgICA7OwoJCQkJZXNhYwoJ
  CQkgICAgOzsKCQkJZXNhYwoJCSAgICAjIGdjYyB3aXRoIGdsZCB3aWxsIG5vdCBhY2NlcHQgK3Zu
  b2NvbXBhdHdhcm5pbmdzCgkJICAgIGNhc2UgImAkY2MgLW8gdHJ5IC1XbCwrdm5vY29tcGF0d2Fy
  bmluZ3MgdHJ5LmMgMj4mMWAiIGluCgkJCSoiK3Zub2NvbXBhdCIqKQkJIyBnbGQKCQkJICAgIGdu
  dV9sZD15ZXMKCQkJICAgIDs7CgkJCSopCQkJIyBIUGxkCgkJCSAgIGNhc2UgIiRnY2N2ZXJzaW9u
  IiBpbgoJCQkgICAgICAgWzEyXSopCgkJCQkgICAjIFdoeSBub3QgMyBhcyB3ZWxsIGhlcmU/CgkJ
  CQkgICAjIFNpbmNlIG5vdCByZWxldmFudCB0byBJQTY0LCBub3QgY2hhbmdlZC4KCQkJCSAgIGxk
  ZmxhZ3M9IiRsZGZsYWdzIC1XbCwrdm5vY29tcGF0d2FybmluZ3MiCgkJCQkgICBjY2ZsYWdzPSIk
  Y2NmbGFncyAtV2wsK3Zub2NvbXBhdHdhcm5pbmdzIgoJCQkJICAgOzsKCQkJICAgICAgIGVzYWMK
  CQkJICAgIDs7CgkJCWVzYWMKCQkgICAgcm0gLWYgdHJ5LmMKCQkgICAgOzsKCQllc2FjCgkgICAg
  OzsKICAgICopICAgICAgY2Npc2djYz0nJwoJICAgICMgV2hhdCBjYW5ub3QgYmUgdXNlIGluIGNv
  bWJpbmF0aW9uIHdpdGggY2NhY2hlIGxpbmtzIDooCgkgICAgY2NfZm91bmQ9IiIKCSAgICBmb3Ig
  cCBpbiBgZWNobyAkUEFUSCB8IHRyIDogJyAnJ2AgOyBkbwoJCXg9IiRwL2NjIgoJCWlmIFsgLWYg
  JHggXSAmJiBbIC14ICR4IF07IHRoZW4KCQkgICAgaWYgWyAtaCAkeCBdOyB0aGVuCgkJCWw9YGxz
  IC1sICR4IHwgc2VkICdzLC4qLT4gLCwnYAoJCQljYXNlICRsIGluCgkJCSAgICAvKikgeD0kbAkJ
  OzsKCQkJICAgICopICB4PSIkcC8kbCIJOzsKCQkJICAgIGVzYWMKCQkJZmkKCQkgICAgeD1gZWNo
  byAkeCB8IHNlZCAncywvXC4vLC8sZydgCgkJICAgIGNhc2UgJHggaW4KCQkJKmNjYWNoZSopIDs7
  CgkJCSopIFsgLXogIiRjY19mb3VuZCIgXSAmJiBjY19mb3VuZD0keCA7OwoJCQllc2FjCgkJICAg
  IGZpCgkJZG9uZQoJICAgIFsgLXogIiRjY19mb3VuZCIgXSAmJiBjY19mb3VuZD1gd2hpY2ggY2Ng
  CgkgICAgd2hhdCAkY2NfZm91bmQgPiY0CgkgICAgY2N2ZXJzaW9uPWB3aGF0ICRjY19mb3VuZCB8
  IGF3ayAnL0NvbXBpbGVyL3twcmludCAkMn0vSXRhbml1bS97cHJpbnQgJDYsJDd9L2ZvciBJbnRl
  Z3JpdHkve3ByaW50ICQ2LCQ3fSdgCgkgICAgY2FzZSAiJGNjZmxhZ3MiIGluCiAgICAgICAgICAg
  ICAgICItQWUgIiopIDs7CgkJKikgIGNjZmxhZ3M9Ii1BZSAkY2NfY3BwZmxhZ3MiCgkJICAgICMg
  K3Zub2NvbXBhdHdhcm5pbmdzIG5vdCBrbm93biBpbiAxMC4xMCBhbmQgb2xkZXIKCQkgICAgaWYg
  WyAkeHhPc1JldiAtZ2UgMTAyMCBdOyB0aGVuCgkJCWNjZmxhZ3M9IiRjY2ZsYWdzIC1XbCwrdm5v
  Y29tcGF0d2FybmluZ3MiCgkJCWZpCgkJICAgIDs7CiAgICAgICAgICAgICAgIGVzYWMKCSAgICAj
  IE5lZWRlZCBiZWNhdXNlIGNwcCBkb2VzIG9ubHkgc3VwcG9ydCAtQWEgKG5vdCAtQWUpCgkgICAg
  Y3BwbGFzdD0nLScKCSAgICBjcHBtaW51cz0nLScKCSAgICBjcHBzdGRpbj0nY2MgLUUgLUFhIC1E
  X19TVERDX0VYVF9fJwoJICAgIGNwcHJ1bj0kY3Bwc3RkaW4KIwkgICAgY2FzZSAiJGRfY2FzdGkz
  MiIgaW4KIwkJIiIpIGRfY2FzdGkzMj0ndW5kZWYnIDs7CiMJCWVzYWMKCSAgICA7OwogICAgZXNh
  YwoKIyBXaGVuIEhQLVVYIHJ1bnMgYSBzY3JpcHQgd2l0aCAiIyEiLCBpdCBzZXRzIGFyZ3ZbMF0g
  dG8gdGhlIHNjcmlwdCBuYW1lLgp0b2tlX2NmbGFncz0nY2NmbGFncz0iJGNjZmxhZ3MgLURBUkdf
  WkVST19JU19TQ1JJUFQiJwoKIyMjIDY0IEJJVE5FU1MKCiMgU29tZSBnY2MgdmVyc2lvbnMgZG8g
  bmF0aXZlIDY0IGJpdCBsb25nIChlLmcuIDIuOS1ocHBhLTAwMDMxMCBhbmQgZ2NjLTMuMCkKIyBX
  ZSBoYXZlIHRvIGZvcmNlIDY0Yml0bmVzcyB0byBnbyBzZWFyY2ggdGhlIHJpZ2h0IGxpYnJhcmll
  cwogICAgZ2NjXzY0bmF0aXZlPW5vCmNhc2UgIiRjY2lzZ2NjIiBpbgogICAgJGRlZmluZXx0cnVl
  fFtZeV0pCgllY2hvICcjaW5jbHVkZSA8c3RkaW8uaD5cbmludCBtYWluKCl7bG9uZyBsO3ByaW50
  ZigiJWRcXG4iLHNpemVvZihsKSk7fSc+dHJ5LmMKCSRjYyAtbyB0cnkgJGNjZmxhZ3MgJGxkZmxh
  Z3MgdHJ5LmMKCWlmIFsgImB0cnlgIiA9ICI4IiBdOyB0aGVuCgkgICAgY2FzZSAiJHVzZTY0Yml0
  YWxsIiBpbgoJCSRkZWZpbmV8dHJ1ZXxbWXldKSA7OwoJCSopICBjYXQgPDxFT00gPiY0CgoqKiog
  VGhpcyB2ZXJzaW9uIG9mIGdjYyB1c2VzIDY0IGJpdCBsb25ncy4gLUR1c2U2NGJpdGFsbCBpcwoq
  KiogaW1wbGljaXRseSBzZXQgdG8gZW5hYmxlIGNvbnRpbnVhdGlvbgpFT00KCQllc2FjCgkgICAg
  dXNlNjRiaXRhbGw9JGRlZmluZQoJICAgIGdjY182NG5hdGl2ZT15ZXMKCSAgICBmaQoJOzsKICAg
  IGVzYWMKCmNhc2UgIiR1c2U2NGJpdGFsbCIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbeVldKikgdXNl
  NjRiaXRpbnQ9IiRkZWZpbmUiIDs7CiAgICBlc2FjCgpjYXNlICIkdXNlbW9yZWJpdHMiIGluCiAg
  ICAkZGVmaW5lfHRydWV8W3lZXSopIHVzZTY0Yml0aW50PSIkZGVmaW5lIjsgdXNlbG9uZ2RvdWJs
  ZT0iJGRlZmluZSIgOzsKICAgIGVzYWMKCmNhc2UgIiRhcmNobmFtZSIgaW4KICAgIElBNjQqKQoJ
  IyBXaGlsZSBoZXJlLCBvdmVycmlkZSBzbz1zbCBhdXRvLWRldGVjdGlvbgoJc289J3NvJwoJOzsK
  ICAgIGVzYWMKCmNhc2UgIiR1c2U2NGJpdGFsbCIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbWXldKQoK
  CWlmIFsgIiR4eE9zUmV2TWFqb3IiIC1sdCAxMSBdOyB0aGVuCgkgICAgY2F0IDw8RU9NID4mNAoK
  KioqIDY0LWJpdCBjb21waWxhdGlvbiBpcyBub3Qgc3VwcG9ydGVkIG9uIEhQLVVYICR4eE9zUmV2
  TWFqb3IuCioqKiBZb3UgbmVlZCBhdCBsZWFzdCBIUC1VWCAxMS4wLgoqKiogQ2Fubm90IGNvbnRp
  bnVlLCBhYm9ydGluZy4KRU9NCgkgICAgZXhpdCAxCgkgICAgZmkKCglpZiBbICR4eE9zUmV2IC1l
  cSAxMTAwIF07IHRoZW4KCSAgICAjIEhQLVVYIDExLjAwIHVzZXMgb25seSA0OCBiaXRzIGludGVy
  bmFsbHkgaW4gNjRiaXQgbW9kZSwgbm90IDY0CgkgICAgIyBmb3JjZSBtaW4vbWF4IHRvIDIqKjQ3
  LTEKCSAgICBzR01USU1FX21heD0xNDA3Mzc0ODgzNTUzMjcKCSAgICBzR01USU1FX21pbj0tNjIx
  NjcyMTkyMDAKCSAgICBzTE9DQUxUSU1FX21heD0xNDA3Mzc0ODgzNTUzMjcKCSAgICBzTE9DQUxU
  SU1FX21pbj0tNjIxNjcyMTkyMDAKCSAgICBmaQoKCSMgU2V0IGxpYmMgYW5kIHRoZSBsaWJyYXJ5
  IHBhdGhzCgljYXNlICIkYXJjaG5hbWUiIGluCgkgICAgUEEtUklTQyopCgkJbG9jbGlicHRoPSIk
  bG9jbGlicHRoIC9saWIvcGEyMF82NCIKCQlsaWJjPScvbGliL3BhMjBfNjQvbGliYy5zbCcgOzsK
  CSAgICBJQTY0KikKCQlsb2NsaWJwdGg9IiRsb2NsaWJwdGggL3Vzci9saWIvaHB1eDY0IgoJCWxp
  YmM9Jy91c3IvbGliL2hwdXg2NC9saWJjLnNvJyA7OwoJICAgIGVzYWMKCWlmIFsgISAtZiAiJGxp
  YmMiIF07IHRoZW4KCSAgICBjYXQgPDxFT00gPiY0CgoqKiogWW91IGRvIG5vdCBzZWVtIHRvIGhh
  dmUgdGhlIDY0LWJpdCBsaWJjLgoqKiogSSBjYW5ub3QgZmluZCB0aGUgZmlsZSAkbGliYy4KKioq
  IENhbm5vdCBjb250aW51ZSwgYWJvcnRpbmcuCkVPTQoJICAgIGV4aXQgMQoJICAgIGZpCgoJY2Fz
  ZSAiJGNjaXNnY2MiIGluCgkgICAgJGRlZmluZXx0cnVlfFtZeV0pCgkJIyBUaGUgZml4ZWQgc29j
  a2V0LmggaGVhZGVyIGZpbGUgaXMgd3JvbmcgZm9yIGdjYy00LngKCQkjIG9uIFBBLVJJU0MyLjBX
  LCBzbyBTb2NrX3R5cGVfdCBpcyBzaXplX3Qgd2hpY2ggaXMKCQkjIHVuc2lnbmVkIGxvbmcgd2hp
  Y2ggaXMgNjRiaXQgd2hpY2ggaXMgdG9vIGxvbmcKCQljYXNlICIkZ2NjdmVyc2lvbiIgaW4KCQkg
  ICAgNCopIGNhc2UgIiRhcmNobmFtZSIgaW4KCQkJICAgIFBBLVJJU0MqKSBzb2Nrc2l6ZXR5cGU9
  aW50IDs7CgkJCSAgICBlc2FjCgkJCTs7CgkJICAgIGVzYWMKCgkJIyBGb3IgdGhlIG1vbWVudCwg
  ZG9uJ3QgY2FyZSB0aGF0IGl0IGFpbid0IHN1cHBvcnRlZCAoeWV0KQoJCSMgYnkgZ2NjICh1cCB0
  byBhbmQgaW5jbHVkaW5nIDIuOTUuMyksIGNhdXNlIGl0J2xsIGNyYXNoCgkJIyBhbnl3YXkuIEV4
  cGVjdCBhdXRvLWRldGVjdGlvbiBvZiA2NC1iaXQgZW5hYmxlZCBnY2Mgb24KCQkjIEhQLVVYIHNv
  b24sIGluY2x1ZGluZyBhIHVzZXItZnJpZW5kbHkgZXhpdAoJCWNhc2UgJGdjY182NG5hdGl2ZSBp
  bgoJCSAgICBubykgY2FzZSAiJGdjY3ZlcnNpb24iIGluCgkJCSAgICBbMTIzNF0qKQoJCQkJY2Nm
  bGFncz0iJGNjZmxhZ3MgLW1scDY0IgoJCQkJY2FzZSAiJGFyY2huYW1lIiBpbgoJCQkJICAgIFBB
  LVJJU0MqKQoJCQkJCWxkZmxhZ3M9IiRsZGZsYWdzIC1XbCwrREQ2NCIKCQkJCQk7OwoJCQkJICAg
  IElBNjQqKQoJCQkJCWxkZmxhZ3M9IiRsZGZsYWdzIC1tbHA2NCIKCQkJCQk7OwoJCQkJICAgIGVz
  YWMKCQkJCTs7CgkJCSAgICBlc2FjCgkJCTs7CgkJICAgIGVzYWMKCQk7OwoJICAgICopCgkJY2Fz
  ZSAiJHVzZTY0Yml0YWxsIiBpbgoJCSAgICAkZGVmaW5lfHRydWV8W3lZXSopCgkJCWNjZmxhZ3M9
  IiRjY2ZsYWdzICtERDY0IgoJCQlsZGZsYWdzPSIkbGRmbGFncyArREQ2NCIKCQkJOzsKCQkgICAg
  ZXNhYwoJCTs7CgkgICAgZXNhYwoKCSMgUmVzZXQgdGhlIGxpYnJhcnkgY2hlY2tlciB0byBtYWtl
  IHN1cmUgbGlicmFyaWVzCgkjIGFyZSB0aGUgcmlnaHQgdHlwZQoJIyAoTk9URTogb24gSUE2NCwg
  dGhpcyBkb2Vzbid0IHdvcmsgd2l0aCAuYSBmaWxlcy4pCglsaWJzY2hlY2s9J2Nhc2UgImAvdXNy
  L2Jpbi9maWxlICR4eHhgIiBpbgoJCSAgICAgICAqRUxGLTY0KnwqTFA2NCp8KlBBLVJJU0MyLjAq
  KSA7OwoJCSAgICAgICAqKSB4eHg9L25vLzY0LWJpdCR4eHggOzsKCQkgICAgICAgZXNhYycKCgk7
  OwoKICAgICopCSMgTm90IGluIDY0LWJpdCBtb2RlCgoJY2FzZSAiJGFyY2huYW1lIiBpbgoJICAg
  IFBBLVJJU0MqKQoJCWxpYmM9Jy9saWIvbGliYy5zbCcgOzsKCSAgICBJQTY0KikKCQlsb2NsaWJw
  dGg9IiRsb2NsaWJwdGggL3Vzci9saWIvaHB1eDMyIgoJCWxpYmM9Jy91c3IvbGliL2hwdXgzMi9s
  aWJjLnNvJyA7OwoJICAgIGVzYWMKCTs7CiAgICBlc2FjCgojIEJ5IHNldHRpbmcgdGhlIGRlZmVy
  cmVkIGZsYWcgYmVsb3csIHRoaXMgbWVhbnMgdGhhdCBpZiB5b3UgcnVuIHBlcmwKIyBvbiBhIHN5
  c3RlbSB0aGF0IGRvZXMgbm90IGhhdmUgdGhlIHJlcXVpcmVkIHNoYXJlZCBsaWJyYXJ5IHRoYXQg
  eW91CiMgbGlua2VkIGl0IHdpdGgsIGl0IHdpbGwgZGllIHdoZW4geW91IHRyeSB0byBhY2Nlc3Mg
  YSBzeW1ib2wgaW4gdGhlCiMgKG1pc3NpbmcpIHNoYXJlZCBsaWJyYXJ5LiAgSWYgeW91IHdvdWxk
  IHJhdGhlciBrbm93IGF0IHBlcmwgc3RhcnR1cAojIHRpbWUgdGhhdCB5b3UgYXJlIG1pc3Npbmcg
  YW4gaW1wb3J0YW50IHNoYXJlZCBsaWJyYXJ5LCBzd2l0Y2ggdGhlCiMgY29tbWVudHMgc28gdGhh
  dCBpbW1lZGlhdGUsIHJhdGhlciB0aGFuIGRlZmVycmVkIGxvYWRpbmcgaXMKIyBwZXJmb3JtZWQu
  ICBFdmVuIHdpdGggaW1tZWRpYXRlIGxvYWRpbmcsIHlvdSBjYW4gcG9zdHBvbmUgZXJyb3JzIGZv
  cgojIHVuZGVmaW5lZCAob3IgbXVsdGlwbHkgZGVmaW5lZCkgcm91dGluZXMgdW50aWwgYWN0dWFs
  IGFjY2VzcyBieQojIGFkZGluZyB0aGUgIm5vbmZhdGFsIiBvcHRpb24uCiMgY2NkbGZsYWdzPSIt
  V2wsLUUgLVdsLC1CLGltbWVkaWF0ZSAkY2NkbGZsYWdzIgojIGNjZGxmbGFncz0iLVdsLC1FIC1X
  bCwtQixpbW1lZGlhdGUsLUIsbm9uZmF0YWwgJGNjZGxmbGFncyIKaWYgWyAiJGdudV9sZCIgPSAi
  eWVzIiBdOyB0aGVuCiAgICBjY2RsZmxhZ3M9Ii1XbCwtRSAkY2NkbGZsYWdzIgplbHNlCiAgICBj
  Y2RsZmxhZ3M9Ii1XbCwtRSAtV2wsLUIsZGVmZXJyZWQgJGNjZGxmbGFncyIKICAgIGZpCgoKIyMj
  IENPTVBJTEVSIFNQRUNJRklDUwoKIyMgTG9jYWwgcmVzdHJpY3Rpb25zIChwb2ludCB0byBSRUFE
  TUUuaHB1eCB0byBsaWZ0IHRoZXNlKQoKIyMgT3B0aW1pemF0aW9uIGxpbWl0cwpjYXQgPnRyeS5j
  IDw8RU9GCiNpbmNsdWRlIDxzdGRpby5oPgojaW5jbHVkZSA8c3lzL3Jlc291cmNlLmg+CgppbnQg
  bWFpbiAoKQp7CiAgICBzdHJ1Y3QgcmxpbWl0IHJsOwogICAgaW50IGkgPSBnZXRybGltaXQgKFJM
  SU1JVF9EQVRBLCAmcmwpOwogICAgcHJpbnRmICgiJWRcbiIsIChpbnQpKHJsLnJsaW1fY3VyIC8g
  KDEwMjQgKiAxMDI0KSkpOwogICAgfSAvKiBtYWluICovCkVPRgokY2MgLW8gdHJ5ICRjY2ZsYWdz
  ICRsZGZsYWdzIHRyeS5jCgltYXhkc2l6PWB0cnlgCnJtIC1mIHRyeSB0cnkuYyBjb3JlCmlmIFsg
  JG1heGRzaXogLWxlIDY0IF07IHRoZW4KICAgICMgNjQgTWIgaXMgcHJvYmFibHkgbm90IGVub3Vn
  aCB0byBvcHRpbWl6ZSB0b2tlLmMKICAgICMgYW5kIHJlZ2V4cC5jIHdpdGggLU8yCiAgICBjYXQg
  PDxFT00gPiY0CllvdXIga2VybmVsIGxpbWl0cyB0aGUgZGF0YSBzZWN0aW9uIG9mIHlvdXIgcHJv
  Z3JhbXMgdG8gJG1heGRzaXogTWIsCndoaWNoIGlzIChzYWRseSkgbm90IGVub3VnaCB0byBmdWxs
  eSBvcHRpbWl6ZSBzb21lIHBhcnRzIG9mIHRoZQpwZXJsIGJpbmFyeS4gSSdsbCB0cnkgdG8gdXNl
  IGEgbG93ZXIgb3B0aW1pemF0aW9uIGxldmVsIGZvcgp0aG9zZSBwYXJ0cy4gSWYgeW91IGFyZSBh
  IHN5c2FkbWluLCBhbmQgeW91ICpkbyogd2FudCBmdWxsCm9wdGltaXphdGlvbiwgcmFpc2UgdGhl
  ICdtYXhkc2l6JyBrZXJuZWwgY29uZmlndXJhdGlvbiBwYXJhbWV0ZXIKdG8gYXQgbGVhc3QgMHgw
  ODAwMDAwMCAoMTI4IE1iKSBhbmQgcmVidWlsZCB5b3VyIGtlcm5lbC4KRU9NCnJlZ2V4ZWNfY2Zs
  YWdzPScnCmRvb3BfY2ZsYWdzPScnCm9wX2NmbGFncz0nJwogICAgZmkKCmNhc2UgIiRjY2lzZ2Nj
  IiBpbgogICAgJGRlZmluZXx0cnVlfFtZeV0pCgoJY2FzZSAiJG9wdGltaXplIiBpbgoJICAgICIi
  KSAgICAgICAgICAgb3B0aW1pemU9Ii1nIC1PIiA7OwoJICAgICpPWzM0NTY3ODldKikgb3B0aW1p
  emU9YGVjaG8gIiRvcHRpbWl6ZSIgfCBzZWQgLWUgJ3MvT1szLTldL08yLydgIDs7CgkgICAgZXNh
  YwoJI2xkPSIkY2MiCglsZD0vdXNyL2Jpbi9sZAoJY2NjZGxmbGFncz0nLWZQSUMnCgkjbGRkbGZs
  YWdzPSctc2hhcmVkJwoJbGRkbGZsYWdzPSctYicKCWNhc2UgIiRvcHRpbWl6ZSIgaW4KCSAgICAq
  LWcqLU8qfCotTyotZyopCgkJIyBnY2Mgd2l0aG91dCBnYXMgd2lsbCBub3QgYWNjZXB0IC1nCgkJ
  ZWNobyAibWFpbigpe30iPnRyeS5jCgkJY2FzZSAiYCRjYyAkb3B0aW1pemUgLWMgdHJ5LmMgMj4m
  MWAiIGluCgkJICAgICoiLWcgb3B0aW9uIGRpc2FibGVkIiopCgkJCXNldCBgZWNobyAiWCAkb3B0
  aW1pemUgIiB8IHNlZCAtZSAncy8gLWcgLyAvJ2AKCQkJc2hpZnQKCQkJb3B0aW1pemU9IiQqIgoJ
  CQk7OwoJCSAgICBlc2FjCgkJOzsKCSAgICBlc2FjCglpZiBbICRtYXhkc2l6IC1sZSA2NCBdOyB0
  aGVuCgkgICAgY2FzZSAiJG9wdGltaXplIiBpbgoJCSpPMiopCW9wdD1gZWNobyAiJG9wdGltaXpl
  IiB8IHNlZCAtZSAncy9PMi9PMS8nYAoJCQl0b2tlX2NmbGFncz0iJHRva2VfY2ZsYWdzO29wdGlt
  aXplPVwiJG9wdFwiIgoJCQlyZWdleGVjX2NmbGFncz0ib3B0aW1pemU9XCIkb3B0XCIiCgkJCTs7
  CgkJZXNhYwoJICAgIGZpCgk7OwoKICAgICopCgljYXNlICIkb3B0aW1pemUiIGluCgkgICAgIiIp
  ICAgICAgICAgICBvcHRpbWl6ZT0iK08yICtPbm9saW1pdCIgOzsKCSAgICAqT1szNDU2Nzg5XSop
  IG9wdGltaXplPWBlY2hvICIkb3B0aW1pemUiIHwgc2VkIC1lICdzL09bMy05XS9PMi8nYCA7OwoJ
  ICAgIGVzYWMKCWNhc2UgIiRvcHRpbWl6ZSIgaW4KCSAgICAqLU8qfFwKCSAgICAqTzIqKSAgIG9w
  dD1gZWNobyAiJG9wdGltaXplIiB8IHNlZCAtZSAncy8tTy8rTzIvJyAtZSAncy9PMi9PMS8nIC1l
  ICdzLyAqK09ub2xpbWl0Ly8nYAoJCSAgICA7OwoJICAgICopICAgICAgb3B0PSIkb3B0aW1pemUi
  CgkJICAgIDs7CgkgICAgZXNhYwoJY2FzZSAiJGFyY2huYW1lIiBpbgoJICAgIElBNjQqKQoJCWNh
  c2UgIiRjY3ZlcnNpb24iIGluCgkJICAgIEIzOTEwQipBLjA2LjBbMTIzNDVdKQoJCQkjID4gY2Mg
  LS12ZXJzaW9uCgkJCSMgY2M6IEhQIGFDKysvQU5TSSBDIEIzOTEwQiBBLjA2LjA1IFtKdWwgMjUg
  MjAwNV0KCQkJIyBIYXMgb3B0aW1pemluZyBwcm9ibGVtcyB3aXRoIC1PMiBhbmQgdXAgZm9yIGJv
  dGgKCQkJIyBtYWludCAoNS44LjgrKSBhbmQgYmxlYWQgKDUuOS4zKykKCQkJIyAtTzEvK08xIHBh
  c3NlZCBhbGwgdGVzdHMgKG0pJzA1IFsgMTAgSmFuIDIwMDUgXQoJCQlvcHRpbWl6ZT0iJG9wdCIJ
  CQk7OwoJCQlCMzkxMEIqQS4wNi4xNSkKCQkJIyA+IGNjIC0tdmVyc2lvbgoJCQkjIGNjOiBIUCBD
  L2FDKysgQjM5MTBCIEEuMDYuMTUgW01heSAxNiAyMDA3XQoJCQkjIEhhcyBvcHRpbWl6aW5nIHBy
  b2JsZW1zIHdpdGggK08yIGZvciBibGVhZCAoNS4xNS45KSwKCQkJIyBzZWUgaHR0cHM6Ly9ydC5w
  ZXJsLm9yZzo0NDMvcnQzL1RpY2tldC9EaXNwbGF5Lmh0bWw/aWQ9MTAzNjY4LgoJCQkjCgkJCSMg
  K08yICtPbm9saW1pdCArT25vcHJvY2VsaW0gICtPc3RvcmVfb3JkZXJpbmcgXAoJCQkjICtPbm9s
  aWJjYWxscz1zdHJjbXAKCQkJIyBwYXNzZXMgYWxsIHRlc3RzICh3aXRoL3dpdGhvdXQgLURERUJV
  R0dJTkcpIFtOb3YgMTcgMjAxMV0KCQkJY2FzZSAiJG9wdGltaXplIiBpbgoJCQkJKk8yKikgb3B0
  aW1pemU9IiRvcHRpbWl6ZSArT25vcHJvY2VsaW0gK09zdG9yZV9vcmRlcmluZyArT25vbGliY2Fs
  bHM9c3RyY21wIiA7OwoJCQkJZXNhYwoJCQk7OwoJCSAgICAqKSAgZG9vcF9jZmxhZ3M9Im9wdGlt
  aXplPVwiJG9wdFwiIgoJCQlvcF9jZmxhZ3M9Im9wdGltaXplPVwiJG9wdFwiIgk7OwoJCSAgICBl
  c2FjCgkJOzsKCSAgICBlc2FjCglpZiBbICRtYXhkc2l6IC1sZSA2NCBdOyB0aGVuCgkgICAgdG9r
  ZV9jZmxhZ3M9IiR0b2tlX2NmbGFncztvcHRpbWl6ZT1cIiRvcHRcIiIKCSAgICByZWdleGVjX2Nm
  bGFncz0ib3B0aW1pemU9XCIkb3B0XCIiCgkgICAgZmkKCWxkPS91c3IvYmluL2xkCgljY2NkbGZs
  YWdzPScrWicKCWxkZGxmbGFncz0nLWIgK3Zub2NvbXBhdHdhcm5pbmdzJwoJOzsKICAgIGVzYWMK
  CiMjIExBUkdFRklMRVMKaWYgWyAkeHhPc1JldiAtbHQgMTAyMCBdOyB0aGVuCiAgICB1c2VsYXJn
  ZWZpbGVzPSIkdW5kZWYiCiAgICBmaQoKI2Nhc2UgIiR1c2VsYXJnZWZpbGVzLSRjY2lzZ2NjIiBp
  bgojICAgICIkZGVmaW5lLSRkZWZpbmUifCctZGVmaW5lJykKIwljYXQgPDxFT00gPiY0CiMKIyoq
  KiBJJ20gaWdub3JpbmcgbGFyZ2UgZmlsZXMgZm9yIHRoaXMgYnVpbGQgYmVjYXVzZQojKioqIEkg
  ZG9uJ3Qga25vdyBob3cgdG8gZG8gdXNlIGxhcmdlIGZpbGVzIGluIEhQLVVYIHVzaW5nIGdjYy4K
  IwojRU9NCiMJdXNlbGFyZ2VmaWxlcz0iJHVuZGVmIgojCTs7CiMgICAgZXNhYwoKIyBPbmNlIHdl
  IGhhdmUgdGhlIGNvbXBpbGVyIGZsYWdzIGRlZmluZWQsIENvbmZpZ3VyZSB3aWxsCiMgZXhlY3V0
  ZSB0aGUgZm9sbG93aW5nIGNhbGwtYmFjayBzY3JpcHQuIFNlZSBoaW50cy9SRUFETUUuaGludHMK
  IyBmb3IgZGV0YWlscy4KY2F0ID4gVVUvY2MuY2J1IDw8J0VPQ0JVJwojIFRoaXMgc2NyaXB0IFVV
  L2NjLmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZSBhZnRlciBpdAojIGhh
  cyBwcm9tcHRlZCB0aGUgdXNlciBmb3IgdGhlIEMgY29tcGlsZXIgdG8gdXNlLgoKIyBDb21waWxl
  IGFuZCBydW4gdGhlIGEgdGVzdCBjYXNlIHRvIHNlZSBpZiBhIGNlcnRhaW4gZ2NjIGJ1ZyBpcwoj
  IHByZXNlbnQuIElmIHNvLCBsb3dlciB0aGUgb3B0aW1pemF0aW9uIGxldmVsIHdoZW4gY29tcGls
  aW5nCiMgcHBfcGFjay5jLiAgVGhpcyB3b3JrcyBhcm91bmQgYSBidWcgaW4gdW5wYWNrLgoKaWYg
  dGVzdCAteiAiJGNjaXNnY2MiIC1hIC16ICIkZ2NjdmVyc2lvbiI7IHRoZW4KICAgIDogbm8gdGVz
  dHMgbmVlZGVkIGZvciBIUGMKZWxzZQogICAgZWNobyAiICIKICAgIGVjaG8gIlRlc3RpbmcgZm9y
  IGEgY2VydGFpbiBnY2MgYnVnIGlzIGZpeGVkIGluIHlvdXIgY29tcGlsZXIuLi4iCgogICAgIyBU
  cnkgY29tcGlsaW5nIHRoZSB0ZXN0IGNhc2UuCiAgICBpZiAkY2MgLW8gdDAwMSAtTyAkY2NmbGFn
  cyAkbGRmbGFncyAtbG0gLi4vaGludHMvdDAwMS5jOyB0aGVuCiAgICAgICBnY2NidWc9YCRydW4g
  Li90MDAxYAogICAgICAgY2FzZSAiJGdjY2J1ZyIgaW4KICAgICAgICAgICAqZmFpbHMqKQogICAg
  ICAgICAgICAgICBjYXQgPiY0IDw8RU9GClRoaXMgQyBjb21waWxlciAoJGdjY3ZlcnNpb24pIGlz
  IGtub3duIHRvIGhhdmUgb3B0aW1pemVyCnByb2JsZW1zIHdoZW4gY29tcGlsaW5nIHBwX3BhY2su
  Yy4KCkRpc2FibGluZyBvcHRpbWl6YXRpb24gZm9yIHBwX3BhY2suYy4KRU9GCiAgICAgICAgICAg
  ICAgIGNhc2UgIiRwcF9wYWNrX2NmbGFncyIgaW4KICAgICAgICAgICAgICAgICAgICcnKSBwcF9w
  YWNrX2NmbGFncz0nb3B0aW1pemU9JwogICAgICAgICAgICAgICAgICAgICAgIGVjaG8gInBwX3Bh
  Y2tfY2ZsYWdzPSdvcHRpbWl6ZT1cIlwiJyIgPj4gY29uZmlnLnNoIDs7CiAgICAgICAgICAgICAg
  ICAgICAqKSAgZWNobyAiWW91IHNwZWNpZmllZCBwcF9wYWNrX2NmbGFncyB5b3Vyc2VsZiwgc28g
  d2UnbGwgZ28gd2l0aCB5b3VyIHZhbHVlLiIgPiY0IDs7CiAgICAgICAgICAgICAgICAgICBlc2Fj
  CiAgICAgICAgICAgICAgIDs7CiAgICAgICAgICAgKikgIGVjaG8gIllvdXIgY29tcGlsZXIgaXMg
  b2suIiA+JjQKICAgICAgICAgICAgICAgOzsKICAgICAgICAgICBlc2FjCiAgICBlbHNlCiAgICAg
  ICBlY2hvICIgIgogICAgICAgZWNobyAiKioqIFdIT0EgVEhFUkUhISEgKioqIiA+JjQKICAgICAg
  IGVjaG8gIiAgICBZb3VyIEMgY29tcGlsZXIgXCIkY2NcIiBkb2Vzbid0IHNlZW0gdG8gYmUgd29y
  a2luZyEiID4mNAogICAgICAgY2FzZSAiJGtub3dpdGFsbCIgaW4KICAgICAgICAgICAnJykgZWNo
  byAiICAgIFlvdSdkIGJldHRlciBzdGFydCBodW50aW5nIGZvciBvbmUgYW5kIGxldCBtZSBrbm93
  IGFib3V0IGl0LiIgPiY0CiAgICAgICAgICAgICAgIGV4aXQgMQogICAgICAgICAgICAgICA7Owog
  ICAgICAgICAgIGVzYWMKICAgICAgIGZpCgogICAgcm0gLWYgdDAwMSRfbyB0MDAxJF9leGUKICAg
  IGZpCkVPQ0JVCgpjYXQgPlVVL3VzZWxhcmdlZmlsZXMuY2J1IDw8J0VPQ0JVJwojIFRoaXMgc2Ny
  aXB0IFVVL3VzZWxhcmdlZmlsZXMuY2J1IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmln
  dXJlCiMgYWZ0ZXIgaXQgaGFzIHByb21wdGVkIHRoZSB1c2VyIGZvciB3aGV0aGVyIHRvIHVzZSBs
  YXJnZSBmaWxlcy4KY2FzZSAiJHVzZWxhcmdlZmlsZXMiIGluCiAgICAiInwkZGVmaW5lfHRydWV8
  W3lZXSopCgkjIHRoZXJlIGFyZSBsYXJnZWZpbGUgZmxhZ3MgYXZhaWxhYmxlIHZpYSBnZXRjb25m
  KDEpCgkjIGJ1dCB3ZSBjaGVhdCBmb3Igbm93LiAgKEtlZXAgdGhhdCBpbiB0aGUgbGVmdCBtYXJn
  aW4uKQpjY2ZsYWdzX3VzZWxhcmdlZmlsZXM9Ii1EX0xBUkdFRklMRV9TT1VSQ0UgLURfRklMRV9P
  RkZTRVRfQklUUz02NCIKCgljYXNlICIgJGNjZmxhZ3MgIiBpbgoJKiIgJGNjZmxhZ3NfdXNlbGFy
  Z2VmaWxlcyAiKikgOzsKCSopIGNjZmxhZ3M9IiRjY2ZsYWdzICRjY2ZsYWdzX3VzZWxhcmdlZmls
  ZXMiIDs7Cgllc2FjCgoJaWYgdGVzdCAteiAiJGNjaXNnY2MiIC1hIC16ICIkZ2NjdmVyc2lvbiI7
  IHRoZW4KCSAgICAjIFRoZSBzdHJpY3QgQU5TSSBtb2RlICgtQWEpIGRvZXNuJ3QgbGlrZSBsYXJn
  ZSBmaWxlcy4KCSAgICBjY2ZsYWdzPWBlY2hvICIgJGNjZmxhZ3MgInxzZWQgJ3NAIC1BYSBAIEBn
  J2AKCSAgICBjYXNlICIkY2NmbGFncyIgaW4KCQkqLUFlKikgOzsKCQkqKSAgICAgY2NmbGFncz0i
  JGNjZmxhZ3MgLUFlIiA7OwoJCWVzYWMKCSAgICBmaQoJOzsKICAgIGVzYWMKRU9DQlUKCiMgVEhS
  RUFESU5HCgojIFRoaXMgc2NyaXB0IFVVL3VzZXRocmVhZHMuY2J1IHdpbGwgZ2V0ICdjYWxsZWQt
  YmFjaycgYnkgQ29uZmlndXJlCiMgYWZ0ZXIgaXQgaGFzIHByb21wdGVkIHRoZSB1c2VyIGZvciB3
  aGV0aGVyIHRvIHVzZSB0aHJlYWRzLgpjYXQgPlVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpj
  YXNlICIkdXNldGhyZWFkcyIgaW4KICAgICRkZWZpbmV8dHJ1ZXxbeVldKikKCWlmIFsgIiR4eE9z
  UmV2TWFqb3IiIC1sdCAxMCBdOyB0aGVuCgkgICAgY2F0IDw8RU9NID4mNAoKSFAtVVggJHh4T3NS
  ZXZNYWpvciBjYW5ub3Qgc3VwcG9ydCBQT1NJWCB0aHJlYWRzLgpDb25zaWRlciB1cGdyYWRpbmcg
  dG8gYXQgbGVhc3QgSFAtVVggMTEuCkNhbm5vdCBjb250aW51ZSwgYWJvcnRpbmcuCkVPTQoJICAg
  IGV4aXQgMQoJICAgIGZpCgoJaWYgWyAiJHh4T3NSZXZNYWpvciIgLWVxIDEwIF07IHRoZW4KCSAg
  ICAjIFVuZGVyIDEwLlgsIGEgdGhyZWFkZWQgcGVybCBjYW4gYmUgYnVpbHQKCSAgICBpZiBbIC1m
  IC91c3IvaW5jbHVkZS9wdGhyZWFkLmggXTsgdGhlbgoJCWlmIFsgLWYgL3Vzci9saWIvbGliY21h
  LnNsIF07IHRoZW4KCQkgICAgIyBEQ0UgKGZyb20gQ29yZSBPUyBDRCkgaXMgaW5zdGFsbGVkCgoJ
  CSAgICMgQ2hlY2sgaWYgaXQgaXMgcHJpc3RpbmUsIG9yIHBhdGNoZWQKCQkgICBjbWF2c249YHdo
  YXQgL3Vzci9saWIvbGliY21hLnNsIDI+JjEgfCBncmVwIDE5OTZgCgkJICAgaWYgWyAhIC16ICIk
  Y21hdnNuIiBdOyB0aGVuCgkJICAgICAgIGNhdCA8PEVPTSA+JjQKBwoqKioqKioqKioqKioqKioq
  KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioq
  KioKClBlcmwgd2lsbCBzdXBwb3J0IHRocmVhZGluZyB0aHJvdWdoIC91c3IvbGliL2xpYmNtYS5z
  bCBmcm9tCnRoZSBIUCBEQ0UgcGFja2FnZSwgYnV0IHRoZSB2ZXJzaW9uIGZvdW5kIGlzIHRvbyBv
  bGQgdG8gYmUKcmVsaWFibGUuCgpJZiB5b3UgYXJlIG5vdCBkZXBlbmRpbmcgb24gdGhpcyBzcGVj
  aWZpYyB2ZXJzaW9uIG9mIHRoZSBsaWJyYXJ5LApjb25zaWRlciB0byB1cGdyYWRlIHVzaW5nIHBh
  dGNoIFBIU1NfMjM2NzIgKHJlYWQgUkVBRE1FLmhwdXgpCgoqKioqKioqKioqKioqKioqKioqKioq
  KioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioKCihz
  bGVlcGluZyBmb3IgMTAgc2Vjb25kcy4uLikKRU9NCgkJICAgICAgIHNsZWVwIDEwCgkJICAgICAg
  IGZpCgoJCSAgICAjIEl0IG5lZWRzICMgbGliY21hIGFuZCBPTERfUFRIUkVBRFNfQVBJLiBBbHNv
  CgkJICAgICMgPHB0aHJlYWQuaD4gbmVlZHMgdG8gYmUgI2luY2x1ZGVkIGJlZm9yZSBhbnkKCQkg
  ICAgIyBvdGhlciBpbmNsdWRlcyAoaW4gcGVybC5oKQoKCQkgICAgIyBIUC1VWCAxMC5YIHVzZXMg
  dGhlIG9sZCBwdGhyZWFkcyBBUEkKCQkgICAgZF9vbGRwdGhyZWFkcz0iJGRlZmluZSIKCgkJICAg
  ICMgaW5jbHVkZSBsaWJjbWEgYmVmb3JlIGFsbCB0aGUgb3RoZXJzCgkJICAgIGxpYnN3YW50ZWQ9
  ImNtYSAkbGlic3dhbnRlZCIKCgkJICAgICMgdGVsbCBwZXJsLmggdG8gaW5jbHVkZSA8cHRocmVh
  ZC5oPiBiZWZvcmUgb3RoZXIKCQkgICAgIyBpbmNsdWRlIGZpbGVzCgkJICAgIGNjZmxhZ3M9IiRj
  Y2ZsYWdzIC1EUFRIUkVBRF9IX0ZJUlNUIgojIEZpcnN0IGNvbHVtbiBvbiBwdXJwb3NlOgojIHRo
  aXMgaXMgbm90IGEgc3RhbmRhcmQgQ29uZmlndXJlIHZhcmlhYmxlCiMgYnV0IHdlIG5lZWQgdG8g
  Z2V0IHRoaXMgbm90aWNlZC4KcHRocmVhZF9oX2ZpcnN0PSIkZGVmaW5lIgoKCQkgICAgIyBIUC1V
  WCAxMC5YIHNlZW1zIHRvIGhhdmUgbm8gZWFzeQoJCSAgICAjIHdheSBvZiBkZXRlY3RpbmcgdGhl
  c2UgKnRpbWVfciBwcm90b3MuCgkJICAgIGRfZ210aW1lX3JfcHJvdG89J2RlZmluZScKCQkgICAg
  Z210aW1lX3JfcHJvdG89J1JFRU5UUkFOVF9QUk9UT19JX1RTJwoJCSAgICBkX2xvY2FsdGltZV9y
  X3Byb3RvPSdkZWZpbmUnCgkJICAgIGxvY2FsdGltZV9yX3Byb3RvPSdSRUVOVFJBTlRfUFJPVE9f
  SV9UUycKCgkJICAgICMgQXZvaWQgdGhlIHBvaXNvbm91cyBjb25mbGljdGluZyAoYW5kIGlycmVs
  ZXZhbnQpCgkJICAgICMgcHJvdG90eXBlcyBvZiBzZXRrZXkgKCkuCgkJICAgIGlfY3J5cHQ9IiR1
  bmRlZiIKCgkJICAgICMgQ01BIHJlZGVmaW5lcyBzZWxlY3QgdG8gY21hX3NlbGVjdCwgYW5kIGNt
  YV9zZWxlY3QKCQkgICAgIyBleHBlY3RzIGludCAqIGluc3RlYWQgb2YgZmRfc2V0ICogKGp1c3Qg
  bGlrZSA5LlgpCgkJICAgIHNlbGVjdHR5cGU9J2ludCAqJwoKCQllbGlmIFsgLWYgL3Vzci9saWIv
  bGlicHRocmVhZC5zbCBdOyB0aGVuCgkJICAgICMgUFRIIHBhY2thZ2UgaXMgaW5zdGFsbGVkCgkJ
  ICAgIGxpYnN3YW50ZWQ9InB0aHJlYWQgJGxpYnN3YW50ZWQiCgkJZWxzZQoJCSAgICBsaWJzd2Fu
  dGVkPSJub190aHJlYWRzX2F2YWlsYWJsZSIKCQkgICAgZmkKCSAgICBlbHNlCgkJbGlic3dhbnRl
  ZD0ibm9fdGhyZWFkc19hdmFpbGFibGUiCgkJZmkKCgkgICAgaWYgWyAkbGlic3dhbnRlZCA9ICJu
  b190aHJlYWRzX2F2YWlsYWJsZSIgXTsgdGhlbgoJCWNhdCA8PEVPTSA+JjQKCkluIEhQLVVYIDEw
  LlggZm9yIFBPU0lYIHRocmVhZHMgeW91IG5lZWQgYm90aCBvZiB0aGUgZmlsZXMKL3Vzci9pbmNs
  dWRlL3B0aHJlYWQuaCBhbmQgZWl0aGVyIC91c3IvbGliL2xpYmNtYS5zbCBvciAvdXNyL2xpYi9s
  aWJwdGhyZWFkLnNsLgpFaXRoZXIgeW91IG11c3QgdXBncmFkZSB0byBIUC1VWCAxMSBvciBpbnN0
  YWxsIGEgcG9zaXggdGhyZWFkIGxpYnJhcnk6CgogICAgRENFLUNvcmVUb29scyBmcm9tIEhQLVVY
  IDEwLjIwIEhhcmR3YXJlIEV4dGVuc2lvbnMgMy4wIENEIChCMzkyMC0xMzk0MSkKCm9yCgogICAg
  UFRIIHBhY2thZ2UgZnJvbSBlLmcuIGh0dHA6Ly9ocHV4LmNvbm5lY3Qub3JnLnVrL2hwcGQvaHB1
  eC9HbnUvcHRoLTIuMC43LwoKQ2Fubm90IGNvbnRpbnVlLCBhYm9ydGluZy4KRU9NCgkJZXhpdCAx
  CgkJZmkKCWVsc2UKCSAgICAjIDEyIG1heSB3YW50IHVwcGluZyB0aGUgX1BPU0lYX0NfU09VUkNF
  IGRhdGVzdGFtcC4uLgoJICAgIGNjZmxhZ3M9IiAtRF9QT1NJWF9DX1NPVVJDRT0xOTk1MDZMIC1E
  X1JFRU5UUkFOVCAkY2NmbGFncyIKCSAgICBzZXQgYGVjaG8gWCAiJGxpYnN3YW50ZWQgInwgc2Vk
  IC1lICdzLyBjIC8gcHRocmVhZCBjIC8nYAoJICAgIHNoaWZ0CgkgICAgbGlic3dhbnRlZD0iJCoi
  CgoJICAgICMgSFAtVVggMTEuWCBzZWVtcyB0byBoYXZlIG5vIGVhc3kKCSAgICAjIHdheSBvZiBk
  ZXRlY3RpbmcgdGhlc2UgKnRpbWVfciBwcm90b3MuCgkgICAgZF9nbXRpbWVfcl9wcm90bz0nZGVm
  aW5lJwoJICAgIGdtdGltZV9yX3Byb3RvPSdSRUVOVFJBTlRfUFJPVE9fU19UUycKCSAgICBkX2xv
  Y2FsdGltZV9yX3Byb3RvPSdkZWZpbmUnCgkgICAgbG9jYWx0aW1lX3JfcHJvdG89J1JFRU5UUkFO
  VF9QUk9UT19TX1RTJwoJICAgIGZpCgk7OwogICAgZXNhYwpFT0NCVQoKIyBUaGVyZSB1c2VkIHRv
  IGJlOgojICBUaGUgbXlzdGVyaW91cyBpb194cyBtZW1vcnkgY29ycnVwdGlvbiBpbiAxMS4wMCAz
  MmJpdCBzZWVtcyB0byBnZXQKIyAgZml4ZWQgYnkgbm90IHVzaW5nIFBlcmwncyBtYWxsb2MuICBG
  bGlwIHNpZGUgaXMgcGVyZm9ybWFuY2UgbG9zcy4KIyAgU28gd2Ugd2FudCBteW1hbGxvYyBmb3Ig
  YWxsIHNpdHVhdGlvbnMgcG9zc2libGUKIyBUaGF0IHNldCB1c2VteW1hbGxvYyB0byAnbicgZm9y
  IHRocmVhZGVkIGJ1aWxkcyBhbmQgbm9uLWdjYyAzMmJpdAojICBub24tZGVidWdnaW5nIGJ1aWxk
  cyBhbmQgJ3knIGZvciBhbGwgb3RoZXJzCgp1c2VteW1hbGxvYz0nbicKY2FzZSAiJHVzZXBlcmxp
  byIgaW4KICAgICR1bmRlZnxmYWxzZXxbbk5dKikgdXNlbXltYWxsb2M9J3knIDs7CiAgICBlc2Fj
  CgojIG1hbGxvYyB3cmFwIHdvcmtzCmNhc2UgIiR1c2VtYWxsb2N3cmFwIiBpbgogICAgJycpIHVz
  ZW1hbGxvY3dyYXA9J2RlZmluZScgOzsKICAgIGVzYWMKCiMgY3RpbWVfciAoKSBhbmQgYXNjdGlt
  ZV9yICgpIHNlZW0gdG8gaGF2ZSBpc3N1ZXMgZm9yIHZlcnNpb25zIGJlZm9yZQojIEhQLVVYIDEx
  CmlmIFsgJHh4T3NSZXZNYWpvciAtbHQgMTEgXTsgdGhlbgogICAgZF9jdGltZV9yPSIkdW5kZWYi
  CiAgICBkX2FzY3RpbWVfcj0iJHVuZGVmIgogICAgZmkKCiMgZnBjbGFzc2lmeSAoKSBpcyBhIG1h
  Y3JvLCB0aGUgbGlicmFyeSBjYWxsIGlzIEZwY2xhc3NpZnkKIyBTaW1pbGFybHkgd2l0aCB0aGUg
  b3RoZXJzIGJlbG93LgpkX2ZwY2xhc3NpZnk9J2RlZmluZScKZF9pc25hbj0nZGVmaW5lJwpkX2lz
  aW5mPSdkZWZpbmUnCmRfaXNmaW5pdGU9J2RlZmluZScKZF91bm9yZGVyZWQ9J2RlZmluZScKIyBO
  ZXh0IG9uZShzKSBuZWVkIHRoZSBsZWFkaW5nIHRhYi4gIFRoZXNlIGFyZSBzcGVjaWFsICdoaW50
  JyBzeW1ib2xzIHRoYXQKIyBhcmUgbm90IHRvIGJlIHByb3BhZ2F0ZWQgdG8gY29uZmlnLnNoLCBh
  bGwgcmVsYXRlZCB0byBwdGhyZWFkcyBkcmFmdCA0CiMgaW50ZXJmYWNlcy4KY2FzZSAiJGRfb2xk
  cHRocmVhZHMiIGluCiAgICAnJ3wkdW5kZWYpCglkX2NyeXB0X3JfcHJvdG89J3VuZGVmJwoJZF9n
  ZXRncmVudF9yX3Byb3RvPSd1bmRlZicKCWRfZ2V0cHdlbnRfcl9wcm90bz0ndW5kZWYnCglkX3N0
  cmVycm9yX3JfcHJvdG89J3VuZGVmJwoJOzsKICAgIGVzYWMK',
  'darwin' =>
  'IyMKIyBEYXJ3aW4gKE1hYyBPUykgaGludHMKIyBXaWxmcmVkbyBTYW5jaGV6IDx3c2FuY2hlekB3
  c2FuY2hlei5uZXQ+CiMjCgojIwojIFBhdGhzCiMjCgojIENvbmZpZ3VyZSBoYXNuJ3QgZmlndXJl
  ZCBvdXQgdGhlIHZlcnNpb24gbnVtYmVyIHlldC4gIEJ1bW1lci4KcGVybF9yZXZpc2lvbj1gYXdr
  ICcvZGVmaW5lWyAJXStQRVJMX1JFVklTSU9OLyB7cHJpbnQgJDN9JyAkc3JjL3BhdGNobGV2ZWwu
  aGAKcGVybF92ZXJzaW9uPWBhd2sgJy9kZWZpbmVbIAldK1BFUkxfVkVSU0lPTi8ge3ByaW50ICQz
  fScgJHNyYy9wYXRjaGxldmVsLmhgCnBlcmxfc3VidmVyc2lvbj1gYXdrICcvZGVmaW5lWyAJXStQ
  RVJMX1NVQlZFUlNJT04vIHtwcmludCAkM30nICRzcmMvcGF0Y2hsZXZlbC5oYAp2ZXJzaW9uPSIk
  e3BlcmxfcmV2aXNpb259LiR7cGVybF92ZXJzaW9ufS4ke3Blcmxfc3VidmVyc2lvbn0iCgojIFBy
  ZXRlbmQgdGhhdCBEYXJ3aW4gZG9lc24ndCBrbm93IGFib3V0IHRob3NlIHN5c3RlbSBjYWxscyBp
  biBUaWdlcgojICgxMC40L2RhcndpbiA4KSBhbmQgZWFybGllciBbcGVybCAjMjQxMjJdCmNhc2Ug
  IiRvc3ZlcnMiIGluClsxLThdLiopCiAgICBkX3NldHJlZ2lkPSd1bmRlZicKICAgIGRfc2V0cmV1
  aWQ9J3VuZGVmJwogICAgZF9zZXRyZ2lkPSd1bmRlZicKICAgIGRfc2V0cnVpZD0ndW5kZWYnCiAg
  ICA7Owplc2FjCgojIFRoaXMgd2FzIHByZXZpb3VzbHkgdXNlZCBpbiBhbGwgYnV0IGNhdXNlcyB0
  aHJlZSBjYXNlcwojIChubyAtRGRwcmVmaXg9LCAtRHByZWZpeD0vdXNyLCAtRHByZWZpeD0vc29t
  ZS90aGluZy9lbHNlKQojIGJ1dCB0aGF0IGNhdXNlZCB0b28gbXVjaCBncmllZi4KIyB2ZW5kb3Js
  aWI9Ii9TeXN0ZW0vTGlicmFyeS9QZXJsLyR7dmVyc2lvbn0iOyAjIEFwcGxlLXN1cHBsaWVkIG1v
  ZHVsZXMKCiMgQlNEIHBhdGhzCmNhc2UgIiRwcmVmaXgiIGluCicnKQkjIERlZmF1bHQgaW5zdGFs
  bDsgdXNlIG5vbi1zeXN0ZW0gZGlyZWN0b3JpZXMKCXByZWZpeD0nL3Vzci9sb2NhbCc7CglzaXRl
  cHJlZml4PScvdXNyL2xvY2FsJzsKCTs7CicvdXNyJykJIyBXZSBhcmUgYnVpbGRpbmcvcmVwbGFj
  aW5nIHRoZSBidWlsdC1pbiBwZXJsCglwcmVmaXg9Jy8nOwoJaW5zdGFsbHByZWZpeD0nLyc7Cgli
  aW49Jy91c3IvYmluJzsKCXNpdGVwcmVmaXg9Jy91c3IvbG9jYWwnOwoJIyBXZSBkb24ndCB3YW50
  IC91c3IvYmluL0hFQUQgaXNzdWVzLgoJc2l0ZWJpbj0nL3Vzci9sb2NhbC9iaW4nOwoJc2l0ZXNj
  cmlwdD0nL3Vzci9sb2NhbC9iaW4nOwoJaW5zdGFsbHVzcmJpbnBlcmw9J2RlZmluZSc7ICMgWW91
  IGtuZXcgd2hhdCB5b3Ugd2VyZSBkb2luZy4KCXByaXZsaWI9Ii9TeXN0ZW0vTGlicmFyeS9QZXJs
  LyR7dmVyc2lvbn0iOwoJc2l0ZWxpYj0iL0xpYnJhcnkvUGVybC8ke3ZlcnNpb259IjsKCXZlbmRv
  cnByZWZpeD0nLyc7Cgl1c2V2ZW5kb3JwcmVmaXg9J2RlZmluZSc7Cgl2ZW5kb3JiaW49Jy91c3Iv
  YmluJzsKCXZlbmRvcnNjcmlwdD0nL3Vzci9iaW4nOwoJdmVuZG9ybGliPSIvTmV0d29yay9MaWJy
  YXJ5L1BlcmwvJHt2ZXJzaW9ufSI7CgkjIDRCU0QgdXNlcyAke3ByZWZpeH0vc2hhcmUvbWFuLCBu
  b3QgJHtwcmVmaXh9L21hbi4KCW1hbjFkaXI9Jy91c3Ivc2hhcmUvbWFuL21hbjEnOwoJbWFuM2Rp
  cj0nL3Vzci9zaGFyZS9tYW4vbWFuMyc7CgkjIEJ1dCB1c2VycycgaW5zdGFsbHMgc2hvdWxkbid0
  IHRvdWNoIHRoZSBzeXN0ZW0gbWFuIHBhZ2VzLgoJIyBUcmFuc2llbnQgb2Jzb2xldGVkIHN0eWxl
  LgoJc2l0ZW1hbjE9Jy91c3IvbG9jYWwvc2hhcmUvbWFuL21hbjEnOwoJc2l0ZW1hbjM9Jy91c3Iv
  bG9jYWwvc2hhcmUvbWFuL21hbjMnOwoJIyBOZXcgc3R5bGUuCglzaXRlbWFuMWRpcj0nL3Vzci9s
  b2NhbC9zaGFyZS9tYW4vbWFuMSc7CglzaXRlbWFuM2Rpcj0nL3Vzci9sb2NhbC9zaGFyZS9tYW4v
  bWFuMyc7Cgk7OwogICopCSMgQW55dGhpbmcgZWxzZTsgdXNlIG5vbi1zeXN0ZW0gZGlyZWN0b3Jp
  ZXMsIHVzZSBDb25maWd1cmUgZGVmYXVsdHMKCTs7CmVzYWMKCiMjCiMgVG9vbCBjaGFpbiBzZXR0
  aW5ncwojIwoKIyBTaW5jZSB3ZSBjYW4gYnVpbGQgZmF0LCB0aGUgYXJjaG5hbWUgZG9lc24ndCBu
  ZWVkIHRoZSBwcm9jZXNzb3IgdHlwZQphcmNobmFtZT0nZGFyd2luJzsKCiMgbm0gaXNuJ3Qga25v
  d24gdG8gd29yayBhZnRlciBTbm93IExlb3BhcmQgYW5kIFhDb2RlIDQ7IHRlc3Rpbmcgd2l0aCBP
  UyBYIDEwLjUKIyBhbmQgWGNvZGUgMyBzaG93cyBhIHdvcmtpbmcgbm0sIGJ1dCBwcmV0ZW5kaW5n
  IGl0IGRvZXNuJ3Qgd29yayBwcm9kdWNlcyBubwojIHByb2JsZW1zLgp1c2VubT0nZmFsc2UnOwoK
  Y2FzZSAiJG9wdGltaXplIiBpbgonJykKIyAgICBPcHRpbWl6aW5nIGZvciBzaXplIGFsc28gbWVh
  biBsZXNzIHJlc2lkZW50IG1lbW9yeSB1c2FnZSBvbiB0aGUgcGFydAojIG9mIFBlcmwuICBBcHBs
  ZSBhc3NlcnRzIHRoYXQgdGhpcyBpcyBhIG1vcmUgaW1wb3J0YW50IG9wdGltaXphdGlvbiB0aGFu
  CiMgc2F2aW5nIG9uIENQVSBjeWNsZXMuICBHaXZlbiB0aGF0IG1lbW9yeSBzcGVlZCBoYXMgbm90
  IGluY3JlYXNlZCBhdAojIHBhY2Ugd2l0aCBDUFUgc3BlZWQgb3ZlciB0aW1lIChvbiBhbnkgcGxh
  dGZvcm0pLCB0aGlzIGlzIHByb2JhYmx5IGEKIyByZWFzb25hYmxlIGFzc2VydGlvbi4KaWYgWyAt
  eiAiJHtvcHRpbWl6ZX0iIF07IHRoZW4KICBjYXNlICJgJHtjYzotZ2NjfSAtdiAyPiYxYCIgaW4K
  ICAgICoiZ2NjIHZlcnNpb24gMy4iKikgb3B0aW1pemU9Jy1PcycgOzsKICAgICopIG9wdGltaXpl
  PSctTzMnIDs7CiAgZXNhYwplbHNlCiAgb3B0aW1pemU9Jy1PMycKZmkKOzsKZXNhYwoKIyAtZm5v
  LWNvbW1vbiBiZWNhdXNlIGNvbW1vbiBzeW1ib2xzIGFyZSBub3QgYWxsb3dlZCBpbiBNSF9EWUxJ
  QgojIC1EUEVSTF9EQVJXSU46IGFwcGFyZW50bHkgdGhlIF9fQVBQTEVfXyBpcyBub3Qgc2FuY3Rp
  b25lZCBieSBBcHBsZQojIGFzIHRoZSB3YXkgdG8gZGlmZmVyZW50aWF0ZSBNYWMgT1MgWC4gIChU
  aGUgb2ZmaWNpYWwgbGluZSBpcyB0aGF0CiMgKm5vKiBjcHAgc3ltYm9sIGRvZXMgZGlmZmVyZW50
  aWF0ZSBNYWMgT1MgWC4pCmNjZmxhZ3M9IiR7Y2NmbGFnc30gLWZuby1jb21tb24gLURQRVJMX0RB
  UldJTiIKCiMgQXQgbGVhc3Qgb24gRGFyd2luIDEuMy54OgojCiMgIyBkZWZpbmUgSU5UMzJfTUlO
  IC0yMTQ3NDgzNjQ4CiMgaW50IG1haW4gKCkgewojICBkb3VibGUgYSA9IElOVDMyX01JTjsKIyAg
  cHJpbnRmICgiSU5UMzJfTUlOPSVnXG4iLCBhKTsKIyAgcmV0dXJuIDA7CiMgfQojIHdpbGwgb3V0
  cHV0OgojIElOVDMyX01JTj0yLjE0NzQ4ZSswOQojIE5vdGUgdGhhdCB0aGUgSU5UMzJfTUlOIGhh
  cyBiZWNvbWUgcG9zaXRpdmUuCiMgSU5UMzJfTUlOIGlzIHNldCBpbiAvdXNyL2luY2x1ZGUvc3Rk
  aW50LmggYnk6CiMgI2RlZmluZSBJTlQzMl9NSU4gICAgICAgIC0yMTQ3NDgzNjQ4CiMgd2hpY2gg
  c2VlbXMgdG8gYnJlYWsgdGhlIGdjYy4gIERlZmluaW5nIElOVDMyX01JTiBhcyAoLTIxNDc0ODM2
  NDctMSkKIyBzZWVtcyB0byB3b3JrLiAgSU5UNjRfTUlOIHNlZW1zIHRvIGJlIHNpbWlsYXJseSBi
  cm9rZW4uCiMgLS0gTmljaG9sYXMgQ2xhcmssIEtlbiBXaWxsaWFtcywgYW5kIEVkd2FyZCBNb3kK
  IwojIFRoaXMgc2VlbXMgdG8gaGF2ZSBiZWVuIGZpeGVkIHNpbmNlIGF0IGxlYXN0IE1hYyBPUyBY
  IDEwLjEuMywKIyBzdGRpbnQuaCBkZWZpbmluZyBJTlQzMl9NSU4gYXMgKC1JTlQzMl9NQVgtMSkK
  IyAtLSBFZHdhcmQgTW95CiMKY2FzZSAiJChncmVwICdeI2RlZmluZSBJTlQzMl9NSU4nIC91c3Iv
  aW5jbHVkZS9zdGRpbnQuaCkiIGluCiAgKi0yMTQ3NDgzNjQ4KSBjY2ZsYWdzPSIke2NjZmxhZ3N9
  IC1ESU5UMzJfTUlOX0JST0tFTiAtRElOVDY0X01JTl9CUk9LRU4iIDs7CmVzYWMKCiMgQXZvaWQg
  QXBwbGUncyBjcHAgcHJlY29tcGlsZXIsIGJldHRlciBmb3IgZXh0ZW5zaW9ucwppZiBbICJYYGVj
  aG8gfCAke2NjfSAtbm8tY3BwLXByZWNvbXAgLUUgLSAyPiYxID4vZGV2L251bGxgIiA9ICJYIiBd
  OyB0aGVuCiAgICBjcHBmbGFncz0iJHtjcHBmbGFnc30gLW5vLWNwcC1wcmVjb21wIgoKICAgICMg
  VGhpcyBpcyBuZWNlc3NhcnkgYmVjYXVzZSBwZXJsJ3MgYnVpbGQgc3lzdGVtIGRvZXNuJ3QKICAg
  ICMgYXBwbHkgY3BwZmxhZ3MgdG8gY2MgY29tcGlsZSBsaW5lcyBhcyBpdCBzaG91bGQuCiAgICBj
  Y2ZsYWdzPSIke2NjZmxhZ3N9ICR7Y3BwZmxhZ3N9IgpmaQoKIyBLbm93biBvcHRpbWl6ZXIgcHJv
  YmxlbXMuCmNhc2UgImBjYyAtdiAyPiYxYCIgaW4KICAqIjMuMSAyMDAyMDEwNSIqKSB0b2tlX2Nm
  bGFncz0nb3B0aW1pemU9IiInIDs7CmVzYWMKCiMgU2hhcmVkIGxpYnJhcnkgZXh0ZW5zaW9uIGlz
  IC5keWxpYi4KIyBCdW5kbGUgZXh0ZW5zaW9uIGlzIC5idW5kbGUuCmxkPSdjYyc7CnNvPSdkeWxp
  Yic7CmRsZXh0PSdidW5kbGUnOwp1c2VkbD0nZGVmaW5lJzsKCiMgMTAuNCBjYW4gdXNlIGRsb3Bl
  bi4KIyAxMC40IGJyb2tlIHBvbGwoKS4KY2FzZSAiJG9zdmVycyIgaW4KWzEtN10uKikKICAgIGRs
  c3JjPSdkbF9keWxkLnhzJzsKICAgIDs7CiopCiAgICBkbHNyYz0nZGxfZGxvcGVuLnhzJzsKICAg
  IGRfcG9sbD0ndW5kZWYnOwogICAgaV9wb2xsPSd1bmRlZic7CiAgICA7Owplc2FjCgpjYXNlICIk
  Y2NkbGZsYWdzIiBpbgkJIyBJZiBwYXNzZWQgaW4gZnJvbSBjb21tYW5kIGxpbmUsIHByZXN1bWUg
  dXNlciBrbm93cyBiZXN0CicnKQogICBjY2NkbGZsYWdzPScgJzsgIyBzcGFjZSwgbm90IGVtcHR5
  LCBiZWNhdXNlIG90aGVyd2lzZSB3ZSBnZXQgLWZwaWMKOzsKZXNhYwoKIyBQZXJsIGJ1bmRsZXMg
  ZG8gbm90IGV4cGVjdCB0d28tbGV2ZWwgbmFtZXNwYWNlLCBhZGRlZCBpbiBEYXJ3aW4gMS40Lgoj
  IEJ1dCBzdGFydGluZyBmcm9tIHBlcmwgNS44LjEvRGFyd2luIDcgdGhlIGRlZmF1bHQgaXMgdGhl
  IHR3by1sZXZlbC4KY2FzZSAiJG9zdmVycyIgaW4KMS5bMC0zXS4qKQogICBsZGRsZmxhZ3M9IiR7
  bGRmbGFnc30gLWJ1bmRsZSAtdW5kZWZpbmVkIHN1cHByZXNzIgogICA7OwoxLiopCiAgIGxkZmxh
  Z3M9IiR7bGRmbGFnc30gLWZsYXRfbmFtZXNwYWNlIgogICBsZGRsZmxhZ3M9IiR7bGRmbGFnc30g
  LWJ1bmRsZSAtdW5kZWZpbmVkIHN1cHByZXNzIgogICA7OwpbMi02XS4qKQogICBsZGZsYWdzPSIk
  e2xkZmxhZ3N9IC1mbGF0X25hbWVzcGFjZSIKICAgbGRkbGZsYWdzPSIke2xkZmxhZ3N9IC1idW5k
  bGUgLXVuZGVmaW5lZCBzdXBwcmVzcyIKICAgOzsKKikgCiAgIGxkZGxmbGFncz0iJHtsZGZsYWdz
  fSAtYnVuZGxlIC11bmRlZmluZWQgZHluYW1pY19sb29rdXAiCiAgIGNhc2UgIiRsZCIgaW4KICAg
  ICAgICpNQUNPU1hfREVWRUxPUE1FTlRfVEFSR0VUKikgOzsKICAgICAgICopIGxkPSJlbnYgTUFD
  T1NYX0RFUExPWU1FTlRfVEFSR0VUPTEwLjMgJHtsZH0iIDs7CiAgIGVzYWMKICAgOzsKZXNhYwps
  ZGxpYnB0aG5hbWU9J0RZTERfTElCUkFSWV9QQVRIJzsKCiMgdXNlc2hycGxpYj10cnVlIHJlc3Vs
  dHMgaW4gbXVjaCBzbG93ZXIgc3RhcnR1cCB0aW1lcy4KIyAnZmFsc2UnIGlzIHRoZSBkZWZhdWx0
  IHZhbHVlLiAgVXNlIENvbmZpZ3VyZSAtRHVzZXNocnBsaWIgdG8gb3ZlcnJpZGUuCgpjYXQgPiBV
  VS9hcmNobmFtZS5jYnUgPDwnRU9DQlUnCiMgVGhpcyBzY3JpcHQgVVUvYXJjaG5hbWUuY2J1IHdp
  bGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIAojIGFmdGVyIGl0IGhhcyBvdGhlcndp
  c2UgZGV0ZXJtaW5lZCB0aGUgYXJjaGl0ZWN0dXJlIG5hbWUuCmNhc2UgIiRsZGZsYWdzIiBpbgoq
  Ii1mbGF0X25hbWVzcGFjZSIqKSA7OyAjIEJhY2t3YXJkIGNvbXBhdCwgYmUgZmxhdC4KIyBJZiB3
  ZSBhcmUgdXNpbmcgdHdvLWxldmVsIG5hbWVzcGFjZSwgd2Ugd2lsbCBtdW5nZSB0aGUgYXJjaG5h
  bWUgdG8gc2hvdyBpdC4KKikgYXJjaG5hbWU9IiR7YXJjaG5hbWV9LTJsZXZlbCIgOzsKZXNhYwpF
  T0NCVQoKIyA2NC1iaXQgYWRkcmVzc2luZyBzdXBwb3J0LiBDdXJyZW50bHkgc3RyaWN0bHkgZXhw
  ZXJpbWVudGFsLiBERkQgMjAwNS0wNi0wNgpjYXNlICIkdXNlNjRiaXRhbGwiIGluCiRkZWZpbmV8
  dHJ1ZXxbeVldKikKY2FzZSAiJG9zdmVycyIgaW4KWzEtN10uKikKICAgICBjYXQgPDxFT00gPiY0
  CgoKCioqKiA2NC1iaXQgYWRkcmVzc2luZyBpcyBub3Qgc3VwcG9ydGVkIGZvciBNYWMgT1MgWCB2
  ZXJzaW9ucwoqKiogYmVsb3cgMTAuNCAoIlRpZ2VyIikgb3IgRGFyd2luIHZlcnNpb25zIGJlbG93
  IDguIFBsZWFzZSB0cnkKKioqIGFnYWluIHdpdGhvdXQgLUR1c2U2NGJpdGFsbC4gKC1EdXNlNjRi
  aXRpbnQgd2lsbCB3b3JrLCBob3dldmVyLikKCkVPTQogICAgIGV4aXQgMQogIDs7CiopCiAgICBj
  YXNlICIkb3N2ZXJzIiBpbgogICAgOC4qKQogICAgICAgIGNhdCA8PEVPTSA+JjQKCgoKKioqIFBl
  cmwgNjQtYml0IGFkZHJlc3Npbmcgc3VwcG9ydCBpcyBleHBlcmltZW50YWwgZm9yIE1hYyBPUyBY
  CioqKiAxMC40ICgiVGlnZXIiKSBhbmQgRGFyd2luIHZlcnNpb24gOC4gU3lzdGVtIFYgSVBDIGlz
  IGRpc2FibGVkCioqKiBkdWUgdG8gcHJvYmxlbXMgd2l0aCB0aGUgNjQtYml0IHZlcnNpb25zIG9m
  IG1zZ2N0bCwgc2VtY3RsLAoqKiogYW5kIHNobWN0bC4gWW91IHNob3VsZCBhbHNvIGV4cGVjdCB0
  aGUgZm9sbG93aW5nIHRlc3QgZmFpbHVyZXM6CioqKgoqKiogICAgZXh0L3RocmVhZHMtc2hhcmVk
  L3Qvd2FpdCAodGhyZWFkZWQgYnVpbGRzIG9ubHkpCgpFT00KCiAgICAgICAgWyAiJGRfbXNnY3Rs
  IiBdIHx8IGRfbXNnY3RsPSd1bmRlZicKICAgICAgICBbICIkZF9zZW1jdGwiIF0gfHwgZF9zZW1j
  dGw9J3VuZGVmJwogICAgICAgIFsgIiRkX3NobWN0bCIgXSB8fCBkX3NobWN0bD0ndW5kZWYnCiAg
  ICA7OwogICAgZXNhYwoKICAgIGNhc2UgYHVuYW1lIC1wYCBpbiAKICAgIHBvd2VycGMpIGFyY2g9
  cHBjNjQgOzsKICAgIGkzODYpIGFyY2g9eDg2XzY0IDs7CiAgICAqKSBjYXQgPDxFT00gPiY0Cgoq
  KiogRG9uJ3QgcmVjb2duaXplIHByb2Nlc3NvciwgY2FuJ3Qgc3BlY2lmeSA2NCBiaXQgY29tcGls
  YXRpb24uCgpFT00KICAgIDs7CiAgICBlc2FjCiAgICBmb3IgdmFyIGluIGNjZmxhZ3MgY3BwZmxh
  Z3MgbGQgbGRmbGFncwogICAgZG8KICAgICAgIGV2YWwgJHZhcj0iXCQke3Zhcn1cIC1hcmNoXCAk
  YXJjaCIKICAgIGRvbmUKCiAgICA7Owplc2FjCjs7CmVzYWMKCiMjCiMgU3lzdGVtIGxpYnJhcmll
  cwojIwoKIyB2Zm9yayB3b3Jrcwp1c2V2Zm9yaz0ndHJ1ZSc7CgojIG1hbGxvYyB3cmFwIHdvcmtz
  CmNhc2UgIiR1c2VtYWxsb2N3cmFwIiBpbgonJykgdXNlbWFsbG9jd3JhcD0nZGVmaW5lJyA7Owpl
  c2FjCgojIG91ciBtYWxsb2Mgd29ya3MgKGJ1dCBhbGxvdyB1c2VycyB0byBvdmVycmlkZSkKY2Fz
  ZSAiJHVzZW15bWFsbG9jIiBpbgonJykgdXNlbXltYWxsb2M9J24nIDs7CmVzYWMKIyBIb3dldmVy
  IHNicmsoKSByZXR1cm5zIC0xIChmYWlsdXJlKSBzb21ld2hlcmUgaW4gbGliL3VuaWNvcmUvbWt0
  YWJsZXMgYXQKIyBhcm91bmQgMTRNLCBzbyB3ZSBuZWVkIHRvIHVzZSBzeXN0ZW0gbWFsbG9jKCkg
  YXMgb3VyIHNicmsoKQptYWxsb2NfY2ZsYWdzPSdjY2ZsYWdzPSItRFVTRV9QRVJMX1NCUksgLURQ
  RVJMX1NCUktfVklBX01BTExPQyAkY2NmbGFncyInCgojIExvY2FsZXMgYXJlbid0IGZlZWxpbmcg
  d2VsbC4KTENfQUxMPUM7IGV4cG9ydCBMQ19BTEw7CkxBTkc9QzsgZXhwb3J0IExBTkc7CgojCiMg
  VGhlIGxpYnJhcmllcyBhcmUgbm90IHRocmVhZHNhZmUgYXMgb2YgT1MgWCAxMC4xLgojCiMgRml4
  IHdoZW4gQXBwbGUgZml4ZXMgbGliYy4KIwpjYXNlICIkdXNldGhyZWFkcyR1c2VpdGhyZWFkcyIg
  aW4KICAqZGVmaW5lKikKICBjYXNlICIkb3N2ZXJzIiBpbgogICAgWzEyMzQ1XS4qKSAgICAgY2F0
  IDw8RU9NID4mNAoKCgoqKiogV2FybmluZywgdGhlcmUgbWlnaHQgYmUgcHJvYmxlbXMgd2l0aCB5
  b3VyIGxpYnJhcmllcyB3aXRoCioqKiByZWdhcmRzIHRvIHRocmVhZGluZy4gIFRoZSB0ZXN0IGV4
  dC90aHJlYWRzL3QvbGliYy50IGlzIGxpa2VseQoqKiogdG8gZmFpbC4KCkVPTQogICAgOzsKICAg
  ICopIHVzZXJlZW50cmFudD0nZGVmaW5lJzs7CiAgZXNhYwoKZXNhYwoKIyBGaW5rIGNhbiBpbnN0
  YWxsIGEgR0RCTSBsaWJyYXJ5IHRoYXQgY2xhaW1zIHRvIGhhdmUgdGhlIE9EQk0gaW50ZXJmYWNl
  cwojIGJ1dCBQZXJsIGR5bmFsb2FkZXIgY2Fubm90IGZvciBzb21lIHJlYXNvbiB1c2UgdGhhdCBs
  aWJyYXJ5LiAgV2UgZG9uJ3QKIyByZWFsbHkgbmVlZCBPREJNX0ZJbGUsIHRob3VnaCwgc28gbGV0
  J3MganVzdCBoaW50IE9EQk0gYXdheS4KaV9kYm09dW5kZWY7CgojIENvbmZpZ3VyZSBkb2Vzbid0
  IGRldGVjdCByYW5saWIgb24gVGlnZXIgcHJvcGVybHkuCiMgTmVpbFcgc2F5cyB0aGlzIHNob3Vs
  ZCBiZSBhY2NlcHRhYmxlIG9uIGFsbCBkYXJ3aW4gdmVyc2lvbnMuCnJhbmxpYj0ncmFubGliJwoK
  IyMKIyBCdWlsZCBwcm9jZXNzCiMjCgojIENhc2UtaW5zZW5zaXRpdmUgZmlsZXN5c3RlbXMgZG9u
  J3QgZ2V0IGFsb25nIHdpdGggTWFrZWZpbGUgYW5kCiMgbWFrZWZpbGUgaW4gdGhlIHNhbWUgcGxh
  Y2UuICBTaW5jZSBEYXJ3aW4gdXNlcyBHTlUgbWFrZSwgdGhpcyBkb2RnZXMKIyB0aGUgcHJvYmxl
  bS4KZmlyc3RtYWtlZmlsZT1HTlVtYWtlZmlsZTsK',
  'dragonfly' =>
  'IyBoaW50cy9kcmFnb25mbHkuc2gKIwojIFRoaXMgZmlsZSBpcyBtb3N0bHkgY29waWVkIGZyb20g
  aGludHMvZnJlZWJzZC5zaCB3aXRoIHRoZSBPUyB2ZXJzaW9uCiMgaW5mb3JtYXRpb24gdGFrZW4g
  b3V0IGFuZCBvbmx5IHRoZSBGcmVlQlNELTQgaW5mb3JtYXRpb24gaW50YWN0LgojIFBsZWFzZSBj
  aGVjayB3aXRoIFRvZGQgV2lsbGV5IDx4dG9kZHhAZ21haWwuY29tPiBiZWZvcmUgbWFraW5nCiMg
  bW9kaWZpY2F0aW9ucyB0byB0aGlzIGZpbGUuIFNlZSBodHRwOi8vd3d3LmRyYWdvbmZseWJzZC5v
  cmcvCgpjYXNlICIkb3N2ZXJzIiBpbgoqKSAgdXNldmZvcms9J3RydWUnCiAgICBjYXNlICIkdXNl
  bXltYWxsb2MiIGluCgkiIikgdXNlbXltYWxsb2M9J24nCgkgICAgOzsKICAgIGVzYWMKICAgIGxp
  YnN3YW50ZWQ9YGVjaG8gJGxpYnN3YW50ZWQgfCBzZWQgJ3MvIG1hbGxvYyAvIC8nYAogICAgOzsK
  ZXNhYwoKIyBEeW5hbWljIExvYWRpbmcgZmxhZ3MgaGF2ZSBub3QgY2hhbmdlZCBtdWNoLCBzbyB0
  aGV5IGFyZSBzZXBhcmF0ZWQKIyBvdXQgaGVyZSB0byBhdm9pZCBkdXBsaWNhdGluZyB0aGVtIGV2
  ZXJ5d2hlcmUuCmNhc2UgIiRvc3ZlcnMiIGluCiopICBvYmpmb3JtYXQ9YC91c3IvYmluL29iamZv
  cm1hdGAKICAgIGxpYnB0aD0iL3Vzci9saWIgL3Vzci9sb2NhbC9saWIiCiAgICBnbGlicHRoPSIv
  dXNyL2xpYiAvdXNyL2xvY2FsL2xpYiIKICAgIGxkZmxhZ3M9Ii1XbCwtRSAiCiAgICBsZGRsZmxh
  Z3M9Ii1zaGFyZWQgIgogICAgY2NjZGxmbGFncz0nLURQSUMgLWZQSUMnCiAgICA7Owplc2FjCgpj
  YXNlICIkb3N2ZXJzIiBpbgoqKSAgY2NmbGFncz0iJHtjY2ZsYWdzfSAtREhBU19GUFNFVE1BU0sg
  LURIQVNfRkxPQVRJTkdQT0lOVF9IIgogICAgaWYgL3Vzci9iaW4vZmlsZSAtTCAvdXNyL2xpYi9s
  aWJjLnNvIHwgL3Vzci9iaW4vZ3JlcCAtdnEgIm5vdCBzdHJpcHBlZCIgOyB0aGVuCgl1c2VubT1m
  YWxzZQogICAgZmkKICAgIDs7CmVzYWMKCmNhdCA8PCdFT00nID4mNAoKU29tZSB1c2VycyBoYXZl
  IHJlcG9ydGVkIHRoYXQgQ29uZmlndXJlIGhhbHRzIHdoZW4gdGVzdGluZyBmb3IKdGhlIE9fTk9O
  QkxPQ0sgc3ltYm9sIHdpdGggYSBzeW50YXggZXJyb3IuICBUaGlzIGlzIGFwcGFyZW50bHkgYQpz
  aCBlcnJvci4gIFJlcnVubmluZyBDb25maWd1cmUgd2l0aCBrc2ggYXBwYXJlbnRseSBmaXhlcyB0
  aGUKcHJvYmxlbS4gIFRyeQogICAgICAga3NoIENvbmZpZ3VyZSBbeW91ciBvcHRpb25zXQoKRU9N
  CgojIEZyb206IEFudG9uIEJlcmV6aW4gPHRvYmV6QHBsYWIua3UuZGs+CiMgVG86IHBlcmw1LXBv
  cnRlcnNAcGVybC5vcmcKIyBTdWJqZWN0OiBbUEFUQ0ggNS4wMDVfNTRdIENvbmZpZ3VyZSAtIGhp
  bnRzL2ZyZWVic2Quc2ggc2lnbmFsIGhhbmRsZXIgdHlwZQojIERhdGU6IDMwIE5vdiAxOTk4IDE5
  OjQ2OjI0ICswMTAwCiMgTWVzc2FnZS1JRDogPDg2NHNyaGh2Y3YuZnNmQGxpb24ucGxhYi5rdS5k
  az4KCnNpZ25hbF90PSd2b2lkJwpkX3ZvaWRzaWc9J2RlZmluZScKCiMgVGhpcyBzY3JpcHQgVVUv
  dXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUKIyBhZnRl
  ciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNh
  dCA+IFVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRl
  ZmluZXx0cnVlfFt5WV0qKQogICAgY2FzZSAiJG9zdmVycyIgaW4KICAgICopICBsZGZsYWdzPSIt
  cHRocmVhZCAkbGRmbGFncyIKCgkjIEJvdGggaW4gNC54IGFuZCA1LnggZ2V0aG9zdGJ5YWRkcl9y
  IGV4aXN0cyBidXQKCSMgaXQgaXMgIlRlbXBvcmFyeSBmdW5jdGlvbiwgbm90IHRocmVhZHNhZmUi
  Li4uCgkjIFByZXN1bWFibHkgZWFybGllciBpdCBkaWRuJ3QgZXZlbiBleGlzdC4KCWRfZ2V0aG9z
  dGJ5YWRkcl9yPSJ1bmRlZiIKCWRfZ2V0aG9zdGJ5YWRkcl9yX3Byb3RvPSIwIgoKCTs7CiAgICBl
  c2FjCmVzYWMKRU9DQlUKCiMgbWFsbG9jIHdyYXAgd29ya3MKY2FzZSAiJHVzZW1hbGxvY3dyYXAi
  IGluCicnKSB1c2VtYWxsb2N3cmFwPSdkZWZpbmUnIDs7CmVzYWMK',
  'netbsd' =>
  'IyBoaW50cy9uZXRic2Quc2gKIwojIFBsZWFzZSBjaGVjayB3aXRoIHBhY2thZ2VzQG5ldGJzZC5v
  cmcgYmVmb3JlIG1ha2luZyBtb2RpZmljYXRpb25zCiMgdG8gdGhpcyBmaWxlLgoKY2FzZSAiJGFy
  Y2huYW1lIiBpbgonJykKICAgIGFyY2huYW1lPWB1bmFtZSAtbWAtJHtvc25hbWV9CiAgICA7Owpl
  c2FjCgojIE5ldEJTRCBrZWVwcyBkeW5hbWljIGxvYWRpbmcgZGwqKCkgZnVuY3Rpb25zIGluIC91
  c3IvbGliL2NydDAubywKIyBzbyBDb25maWd1cmUgZG9lc24ndCBmaW5kIHRoZW0gKHVubGVzcyB5
  b3UgYWJhbmRvbiB0aGUgbm0gc2NhbikuCiMgQWxzbywgTmV0QlNEIDAuOWEgd2FzIHRoZSBmaXJz
  dCByZWxlYXNlIHRvIGludHJvZHVjZSBzaGFyZWQKIyBsaWJyYXJpZXMuCiMKY2FzZSAiJG9zdmVy
  cyIgaW4KMC45fDAuOCopCgl1c2VkbD0iJHVuZGVmIgoJOzsKKikKCWNhc2UgYHVuYW1lIC1tYCBp
  bgoJcG1heCkKCQkjIE5ldEJTRCAxLjMgYW5kIDEuMy4xIG9uIHBtYXggc2hpcHBlZCBhbiBgb2xk
  JyBsZC5zbywKCQkjIHdoaWNoIHdpbGwgbm90IHdvcmsuCgkJY2FzZSAiJG9zdmVycyIgaW4KCQkx
  LjN8MS4zLjEpCgkJCWRfZGxvcGVuPSR1bmRlZgoJCQk7OwoJCWVzYWMKCQk7OwoJZXNhYwoJaWYg
  dGVzdCAtZiAvdXNyL2xpYmV4ZWMvbGQuZWxmX3NvOyB0aGVuCgkJIyBFTEYKCQlkX2Rsb3Blbj0k
  ZGVmaW5lCgkJZF9kbGVycm9yPSRkZWZpbmUKCQljY2NkbGZsYWdzPSItRFBJQyAtZlBJQyAkY2Nj
  ZGxmbGFncyIKCQlsZGRsZmxhZ3M9Ii1zaGFyZWQgJGxkZGxmbGFncyIKCQljYXQgPlVVL2NjLmNi
  dSA8PCdFT0NCVScKIyBnY2MgNC42IGRvZXNuJ3Qgc3VwcG9ydCAtLXdob2xlLWFyY2hpdmUsIGJ1
  dCBpdCdzIHJlcXVpcmVkIGZvciB0aGUKIyBzeXN0ZW0gZ2NjIHRvIGJ1aWxkIGNvcnJlY3RseSwg
  c28gY2hlY2sgZm9yIGl0CmVjaG8gJ2ludCBmKHZvaWQpIHsgcmV0dXJuIDA7IH0nID50cnkuYwpp
  ZiAke2NjOi1jY30gJGNjY2RsZmxhZ3MgLWMgdHJ5LmMgLW90cnkubyAyPiYxICYmCiAgICR7Y2M6
  LWNjfSAtLXdob2xlLWFyY2hpdmUgJGxkZGxmbGFncyB0cnkubyAtb3RyeS5zbyAyPiYxIDsgdGhl
  bgogICAgbGRkbGZsYWdzPSItLXdob2xlLWFyY2hpdmUgJGxkZGxmbGFncyIKZmkKcm0gdHJ5LmMg
  dHJ5Lm8gdHJ5LnNvIDI+L2Rldi9udWxsCkVPQ0JVCgkJcnBhdGhmbGFnPSItV2wsLXJwYXRoLCIK
  CQljYXNlICIkb3N2ZXJzIiBpbgoJCTEuWzAtNV0qKQoJCQkjCgkJCSMgSW5jbHVkZSB0aGUgd2hv
  bGUgbGliZ2NjLmEgaW50byB0aGUgcGVybCBleGVjdXRhYmxlCgkJCSMgc28gdGhhdCBjZXJ0YWlu
  IHN5bWJvbHMgbmVlZGVkIGJ5IGxvYWRhYmxlIG1vZHVsZXMKCQkJIyBidWlsdCBhcyBDKysgb2Jq
  ZWN0cyAoX19laF9hbGxvYywgX19wdXJlX3ZpcnR1YWwsCgkJCSMgZXRjLikgd2lsbCBhbHdheXMg
  YmUgZGVmaW5lZC4KCQkJIwoJCQljY2RsZmxhZ3M9Ii1XbCwtd2hvbGUtYXJjaGl2ZSAtbGdjYyBc
  CgkJCQktV2wsLW5vLXdob2xlLWFyY2hpdmUgLVdsLC1FICRjY2RsZmxhZ3MiCgkJCTs7CgkJKikK
  CQkJY2NkbGZsYWdzPSItV2wsLUUgJGNjZGxmbGFncyIKCQkJOzsKCQllc2FjCgllbGlmIHRlc3Qg
  LWYgL3Vzci9saWJleGVjL2xkLnNvOyB0aGVuCgkJIyBhLm91dAoJCWRfZGxvcGVuPSRkZWZpbmUK
  CQlkX2RsZXJyb3I9JGRlZmluZQoJCWNjY2RsZmxhZ3M9Ii1EUElDIC1mUElDICRjY2NkbGZsYWdz
  IgoJCWxkZGxmbGFncz0iLUJzaGFyZWFibGUgJGxkZGxmbGFncyIKCQlycGF0aGZsYWc9Ii1SIgoJ
  ZWxzZQoJCWRfZGxvcGVuPSR1bmRlZgoJCXJwYXRoZmxhZz0KCWZpCgk7Owplc2FjCgojIG5ldGJz
  ZCBoYWQgdGhlc2UgYnV0IHRoZXkgZG9uJ3QgcmVhbGx5IHdvcmsgYXMgYWR2ZXJ0aXNlZCwgaW4g
  dGhlCiMgdmVyc2lvbnMgbGlzdGVkIGJlbG93LiAgaWYgdGhleSBhcmUgZGVmaW5lZCwgdGhlbiB0
  aGVyZSBpc24ndCBhCiMgd2F5IHRvIG1ha2UgcGVybCBjYWxsIHNldHVpZCgpIG9yIHNldGdpZCgp
  LiAgaWYgdGhleSBhcmVuJ3QsIHRoZW4KIyAoJDwsICQ+KSA9ICgkdSwgJHUpOyB3aWxsIHdvcmsg
  KHNhbWUgZm9yICQoLyQpKS4gIHRoaXMgaXMgYmVjYXVzZQojIHlvdSBjYW4gbm90IGNoYW5nZSB0
  aGUgcmVhbCB1c2VyaWQgb2YgYSBwcm9jZXNzIHVuZGVyIDQuNEJTRC4KIyBuZXRic2QgZml4ZWQg
  dGhpcyBpbiAxLjMuMi4KY2FzZSAiJG9zdmVycyIgaW4KMC45KnwxLlswMTJdKnwxLjN8MS4zLjEp
  CglkX3NldHJlZ2lkPSIkdW5kZWYiCglkX3NldHJldWlkPSIkdW5kZWYiCgk7Owplc2FjCmNhc2Ug
  IiRvc3ZlcnMiIGluCjAuOSp8MS4qfDIuKnwzLip8NC4qfDUuKnw2LiopCglkX2dldHByb3RvZW50
  X3I9IiR1bmRlZiIKCWRfZ2V0cHJvdG9ieW5hbWVfcj0iJHVuZGVmIgoJZF9nZXRwcm90b2J5bnVt
  YmVyX3I9IiR1bmRlZiIKCWRfc2V0cHJvdG9lbnRfcj0iJHVuZGVmIgoJZF9lbmRwcm90b2VudF9y
  PSIkdW5kZWYiCglkX2dldHNlcnZlbnRfcj0iJHVuZGVmIgoJZF9nZXRzZXJ2YnluYW1lX3I9IiR1
  bmRlZiIKCWRfZ2V0c2VydmJ5cG9ydF9yPSIkdW5kZWYiCglkX3NldHNlcnZlbnRfcj0iJHVuZGVm
  IgoJZF9lbmRzZXJ2ZW50X3I9IiR1bmRlZiIKCWRfZ2V0cHJvdG9lbnRfcl9wcm90bz0iMCIKCWRf
  Z2V0cHJvdG9ieW5hbWVfcl9wcm90bz0iMCIKCWRfZ2V0cHJvdG9ieW51bWJlcl9yX3Byb3RvPSIw
  IgoJZF9zZXRwcm90b2VudF9yX3Byb3RvPSIwIgoJZF9lbmRwcm90b2VudF9yX3Byb3RvPSIwIgoJ
  ZF9nZXRzZXJ2ZW50X3JfcHJvdG89IjAiCglkX2dldHNlcnZieW5hbWVfcl9wcm90bz0iMCIKCWRf
  Z2V0c2VydmJ5cG9ydF9yX3Byb3RvPSIwIgoJZF9zZXRzZXJ2ZW50X3JfcHJvdG89IjAiCglkX2Vu
  ZHNlcnZlbnRfcl9wcm90bz0iMCIKCTs7CmVzYWMKCiMgVGhlc2UgYXJlIG9ic29sZXRlIGluIGFu
  eSBuZXRic2QuCmRfc2V0cmdpZD0iJHVuZGVmIgpkX3NldHJ1aWQ9IiR1bmRlZiIKCiMgdGhlcmUn
  cyBubyBwcm9ibGVtIHdpdGggdmZvcmsuCnVzZXZmb3JrPXRydWUKCiMgVGhpcyBpcyB0aGVyZSBi
  dXQgaW4gbWFjaGluZS9pZWVlZnBfaC4KaWVlZWZwX2g9ImRlZmluZSIKCiMgVGhpcyBzY3JpcHQg
  VVUvdXNldGhyZWFkcy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUKIyBh
  ZnRlciBpdCBoYXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMu
  CmNhdCA+IFVVL3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4K
  JGRlZmluZXx0cnVlfFt5WV0qKQoJbHB0aHJlYWQ9Cglmb3IgeHh4IGluIHB0aHJlYWQ7IGRvCgkJ
  Zm9yIHl5eSBpbiAkbG9jbGlicHRoICRwbGlicHRoICRnbGlicHRoIGR1bW15OyBkbwoJCQl6eno9
  JHl5eS9saWIkeHh4LmEKCQkJaWYgdGVzdCAtZiAiJHp6eiI7IHRoZW4KCQkJCWxwdGhyZWFkPSR4
  eHgKCQkJCWJyZWFrOwoJCQlmaQoJCQl6eno9JHl5eS9saWIkeHh4LnNvCgkJCWlmIHRlc3QgLWYg
  IiR6enoiOyB0aGVuCgkJCQlscHRocmVhZD0keHh4CgkJCQlicmVhazsKCQkJZmkKCQkJenp6PWBs
  cyAkeXl5L2xpYiR4eHguc28uKiAyPi9kZXYvbnVsbGAKCQkJaWYgdGVzdCAiWCR6enoiICE9IFg7
  IHRoZW4KCQkJCWxwdGhyZWFkPSR4eHgKCQkJCWJyZWFrOwoJCQlmaQoJCWRvbmUKCQlpZiB0ZXN0
  ICJYJGxwdGhyZWFkIiAhPSBYOyB0aGVuCgkJCWJyZWFrOwoJCWZpCglkb25lCglpZiB0ZXN0ICJY
  JGxwdGhyZWFkIiAhPSBYOyB0aGVuCgkJIyBBZGQgLWxwdGhyZWFkLgoJCWxpYnN3YW50ZWQ9IiRs
  aWJzd2FudGVkICRscHRocmVhZCIKCQkjIFRoZXJlIGlzIG5vIGxpYmNfciBhcyBvZiBOZXRCU0Qg
  MS41LjIsIHNvIG5vIGMgLT4gY19yLgoJCSMgVGhpcyB3aWxsIGJlIHJldmlzaXRlZCB3aGVuIE5l
  dEJTRCBnYWlucyBhIG5hdGl2ZSBwdGhyZWFkcwoJCSMgaW1wbGVtZW50YXRpb24uCgllbHNlCgkJ
  ZWNobyAiJDA6IE5vIFBPU0lYIHRocmVhZHMgbGlicmFyeSAoLWxwdGhyZWFkKSBmb3VuZC4gICIg
  XAoJCSAgICAgIllvdSBtYXkgd2FudCB0byBpbnN0YWxsIEdOVSBwdGguICBBYm9ydGluZy4iID4m
  NAoJCWV4aXQgMQoJZmkKCXVuc2V0IGxwdGhyZWFkCgoJIyBzZXZlcmFsIHJlZW50cmFudCBmdW5j
  dGlvbnMgYXJlIGVtYmVkZGVkIGluIGxpYmMsIGJ1dCBoYXZlbid0CgkjIGJlZW4gYWRkZWQgdG8g
  dGhlIGhlYWRlciBmaWxlcyB5ZXQuICBMZXQncyBob2xkIG9mZiBvbiB1c2luZwoJIyB0aGVtIHVu
  dGlsIHRoZXkgYXJlIGEgdmFsaWQgcGFydCBvZiB0aGUgQVBJCgljYXNlICIkb3N2ZXJzIiBpbgoJ
  WzAxMl0uKnwzLlswLTFdKQoJCWRfZ2V0cHJvdG9ieW5hbWVfcj0kdW5kZWYKCQlkX2dldHByb3Rv
  YnludW1iZXJfcj0kdW5kZWYKCQlkX2dldHByb3RvZW50X3I9JHVuZGVmCgkJZF9nZXRzZXJ2Ynlu
  YW1lX3I9JHVuZGVmCgkJZF9nZXRzZXJ2Ynlwb3J0X3I9JHVuZGVmCgkJZF9nZXRzZXJ2ZW50X3I9
  JHVuZGVmCgkJZF9zZXRwcm90b2VudF9yPSR1bmRlZgoJCWRfc2V0c2VydmVudF9yPSR1bmRlZgoJ
  CWRfZW5kcHJvdG9lbnRfcj0kdW5kZWYKCQlkX2VuZHNlcnZlbnRfcj0kdW5kZWYgOzsKCWVzYWMK
  CTs7Cgplc2FjCkVPQ0JVCgojIFNldCBzZW5zaWJsZSBkZWZhdWx0cyBmb3IgTmV0QlNEOiBsb29r
  IGZvciBsb2NhbCBzb2Z0d2FyZSBpbgojIC91c3IvcGtnIChOZXRCU0QgUGFja2FnZXMgQ29sbGVj
  dGlvbikgYW5kIGluIC91c3IvbG9jYWwuCiMKbG9jbGlicHRoPSIvdXNyL3BrZy9saWIgL3Vzci9s
  b2NhbC9saWIiCmxvY2luY3B0aD0iL3Vzci9wa2cvaW5jbHVkZSAvdXNyL2xvY2FsL2luY2x1ZGUi
  CmNhc2UgIiRycGF0aGZsYWciIGluCicnKQoJbGRmbGFncz0KCTs7CiopCglsZGZsYWdzPQoJZm9y
  IHl5eSBpbiAkbG9jbGlicHRoOyBkbwoJCWxkZmxhZ3M9IiRsZGZsYWdzICRycGF0aGZsYWckeXl5
  IgoJZG9uZQoJOzsKZXNhYwoKY2FzZSBgdW5hbWUgLW1gIGluCmFscGhhKQogICAgZWNobyAnaW50
  IG1haW4oKSB7fScgPiB0cnkuYwogICAgZ2NjPWAke2NjOi1jY30gLXYgLWMgdHJ5LmMgMj4mMXxn
  cmVwICdnY2MgdmVyc2lvbiBlZ2NzLTInYAogICAgY2FzZSAiJGdjYyIgaW4KICAgICcnIHwgImdj
  YyB2ZXJzaW9uIGVnY3MtMi45NS4iWzMtOV0qKSA7OyAjIDIuOTUuMyBvciBiZXR0ZXIgb2theQog
  ICAgKikJY2F0ID4mNCA8PEVPRgoqKioKKioqIFlvdXIgZ2NjICgkZ2NjKSBpcyBrbm93biB0byBi
  ZQoqKiogdG9vIGJ1Z2d5IG9uIG5ldGJzZC9hbHBoYSB0byBjb21waWxlIFBlcmwgd2l0aCBvcHRp
  bWl6YXRpb24uCioqKiBJdCBpcyBzdWdnZXN0ZWQgeW91IGluc3RhbGwgdGhlIGxhbmcvZ2NjIHBh
  Y2thZ2Ugd2hpY2ggc2hvdWxkCioqKiBoYXZlIGF0IGxlYXN0IGdjYyAyLjk1LjMgd2hpY2ggc2hv
  dWxkIHdvcmsgb2theTogdXNlIGZvciBleGFtcGxlCioqKiBDb25maWd1cmUgLURjYz0vdXNyL3Br
  Zy9nY2MtMi45NS4zL2Jpbi9jYy4gIFlvdSBjb3VsZCBhbHNvCioqKiBDb25maWd1cmUgLURvcHRp
  bWl6ZT0tTzAgdG8gY29tcGlsZSBQZXJsIHdpdGhvdXQgYW55IG9wdGltaXphdGlvbgoqKiogYnV0
  IHRoYXQgaXMgbm90IHJlY29tbWVuZGVkLgoqKioKRU9GCglleGl0IDEKCTs7CiAgICBlc2FjCiAg
  ICBybSAtZiB0cnkuKgogICAgOzsKZXNhYwoKIyBOZXRCU0Qvc3BhcmMgMS41LjMvMS42LjEgZHVt
  cHMgY29yZSBpbiB0aGUgc2VtaWRfZHMgdGVzdCBvZiBDb25maWd1cmUuCmNhc2UgYHVuYW1lIC1t
  YCBpbgpzcGFyYykgZF9zZW1jdGxfc2VtaWRfZHM9dW5kZWYgOzsKZXNhYwoKIyBtYWxsb2Mgd3Jh
  cCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIgaW4KJycpIHVzZW1hbGxvY3dyYXA9J2RlZmlu
  ZScgOzsKZXNhYwoKIyBkb24ndCB1c2UgcGVybCBtYWxsb2MgYnkgZGVmYXVsdApjYXNlICIkdXNl
  bXltYWxsb2MiIGluCicnKSB1c2VteW1hbGxvYz1uIDs7CmVzYWMK',
  'openbsd' =>
  'IyBoaW50cy9vcGVuYnNkLnNoCiMKIyBoaW50cyBmaWxlIGZvciBPcGVuQlNEOyBUb2RkIE1pbGxl
  ciA8bWlsbGVydEBvcGVuYnNkLm9yZz4KIyBFZGl0ZWQgdG8gYWxsb3cgQ29uZmlndXJlIGNvbW1h
  bmQtbGluZSBvdmVycmlkZXMgYnkKIyAgQW5keSBEb3VnaGVydHkgPGRvdWdoZXJhQGxhZmF5ZXR0
  ZS5lZHU+CiMKIyBUbyBidWlsZCB3aXRoIGRpc3RyaWJ1dGlvbiBwYXRocywgdXNlOgojCS4vQ29u
  ZmlndXJlIC1kZXMgLURvcGVuYnNkX2Rpc3RyaWJ1dGlvbj1kZWZpbmVkCiMKCiMgSW4gT3BlbkJT
  RCA+IDMuNywgdXNlIHBlcmwncyBtYWxsb2MgW3BlcmwgIzc1NzQyXQpjYXNlICIkb3N2ZXJzIiBp
  bgozLls4OV0qfFs0LTldKikKICAgIHRlc3QgIiR1c2VteW1hbGxvYyIgfHwgdXNlbXltYWxsb2M9
  eQogICAgOzsKZXNhYwoKIyBtYWxsb2Mgd3JhcCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIg
  aW4KJycpIHVzZW1hbGxvY3dyYXA9J2RlZmluZScgOzsKZXNhYwoKIyBDdXJyZW50bHksIHZmb3Jr
  KDIpIGlzIG5vdCBhIHJlYWwgd2luIG92ZXIgZm9yaygyKS4KdXNldmZvcms9IiR1bmRlZiIKCiMg
  SW4gT3BlbkJTRCA8IDMuMywgdGhlIHNldHJlP1t1Z11pZCgpIGFyZSBlbXVsYXRlZCB1c2luZyB0
  aGUKIyBfUE9TSVhfU0FWRURfSURTIGZ1bmN0aW9uYWxpdHkgd2hpY2ggZG9lcyBub3QgaGF2ZSB0
  aGUgc2FtZQojIHNlbWFudGljcyBhcyA0LjNCU0QuICBTdGFydGluZyB3aXRoIE9wZW5CU0QgMy4z
  LCB0aGUgb3JpZ2luYWwKIyBzZW1hbnRpY3MgaGF2ZSBiZWVuIHJlc3RvcmVkLgpjYXNlICIkb3N2
  ZXJzIiBpbgpbMC0yXS4qfDMuWzAtMl0pCglkX3NldHJlZ2lkPSR1bmRlZgoJZF9zZXRyZXVpZD0k
  dW5kZWYKCWRfc2V0cmdpZD0kdW5kZWYKCWRfc2V0cnVpZD0kdW5kZWYKZXNhYwoKIwojIE5vdCBh
  bGwgcGxhdGZvcm1zIHN1cHBvcnQgZHluYW1pYyBsb2FkaW5nLi4uCiMgRm9yIHRoZSBjYXNlIG9m
  ICIkb3BlbmJzZF9kaXN0cmlidXRpb24iLCB0aGUgaGludHMgZmlsZQojIG5lZWRzIHRvIGtub3cg
  d2hldGhlciB3ZSBhcmUgdXNpbmcgZHluYW1pYyBsb2FkaW5nIHNvIHRoYXQKIyBpdCBjYW4gc2V0
  IHRoZSBsaWJwZXJsIG5hbWUgYXBwcm9wcmlhdGVseS4KIyBBbGxvdyBjb21tYW5kIGxpbmUgb3Zl
  cnJpZGVzLgojCkFSQ0g9YGFyY2ggfCBzZWQgJ3MvXk9wZW5CU0QuLy8nYApjYXNlICIke0FSQ0h9
  LSR7b3N2ZXJzfSIgaW4KYWxwaGEtMi5bMC04XXxtaXBzLTIuWzAtOF18cG93ZXJwYy0yLlswLTdd
  fG04OGstKnxocHBhLSp8dmF4LSopCgl0ZXN0IC16ICIkdXNlZGwiICYmIHVzZWRsPSR1bmRlZgoJ
  OzsKKikKCXRlc3QgLXogIiR1c2VkbCIgJiYgdXNlZGw9JGRlZmluZQoJIyBXZSB1c2UgLWZQSUMg
  aGVyZSBiZWNhdXNlIC1mcGljIGlzICpOT1QqIGVub3VnaCBmb3Igc29tZSBvZiB0aGUKCSMgZXh0
  ZW5zaW9ucyBsaWtlIFRrIG9uIHNvbWUgT3BlbkJTRCBwbGF0Zm9ybXMgKGllOiBzcGFyYykKCWNj
  Y2RsZmxhZ3M9Ii1EUElDIC1mUElDICRjY2NkbGZsYWdzIgoJY2FzZSAiJG9zdmVycyIgaW4KCVsw
  MV0uKnwyLlswLTddfDIuWzAtN10uKikKCQlsZGRsZmxhZ3M9Ii1Cc2hhcmVhYmxlICRsZGRsZmxh
  Z3MiCgkJOzsKCTIuWzgtOV18My4wKQoJCWxkPSR7Y2M6LWNjfQoJCWxkZGxmbGFncz0iLXNoYXJl
  ZCAtZlBJQyAkbGRkbGZsYWdzIgoJCTs7CgkqKSAjIGZyb20gMy4xIG9ud2FyZHMKCQlsZD0ke2Nj
  Oi1jY30KCQlsZGRsZmxhZ3M9Ii1zaGFyZWQgLWZQSUMgJGxkZGxmbGFncyIKCQlsaWJzd2FudGVk
  PWBlY2hvICRsaWJzd2FudGVkIHwgc2VkICdzLyBkbCAvIC8nYAoJCTs7Cgllc2FjCgoJIyBXZSBu
  ZWVkIHRvIGZvcmNlIGxkIHRvIGV4cG9ydCBzeW1ib2xzIG9uIEVMRiBwbGF0Zm9ybXMuCgkjIFdp
  dGhvdXQgdGhpcywgZGxvcGVuKCkgaXMgY3JpcHBsZWQuCglFTEY9YCR7Y2M6LWNjfSAtZE0gLUUg
  LSA8L2Rldi9udWxsIHwgZ3JlcCBfX0VMRl9fYAoJdGVzdCAtbiAiJEVMRiIgJiYgbGRmbGFncz0i
  LVdsLC1FICRsZGZsYWdzIgoJOzsKZXNhYwoKIwojIFR3ZWFrcyBmb3IgdmFyaW91cyB2ZXJzaW9u
  cyBvZiBPcGVuQlNECiMKY2FzZSAiJG9zdmVycyIgaW4KMi41KQoJIyBPcGVuQlNEIDIuNSBoYXMg
  YnJva2VuIG9kYm0gc3VwcG9ydAoJaV9kYm09JHVuZGVmCgk7Owplc2FjCgojIE9wZW5CU0QgZG9l
  c24ndCBuZWVkIGxpYmNyeXB0IGJ1dCBtYW55IGZvbGtzIGtlZXAgYSBzdHViIGxpYgojIGFyb3Vu
  ZCBmb3Igb2xkIE5ldEJTRCBiaW5hcmllcy4KbGlic3dhbnRlZD1gZWNobyAkbGlic3dhbnRlZCB8
  IHNlZCAncy8gY3J5cHQgLyAvJ2AKCiMgQ29uZmlndXJlIGNhbid0IGZpZ3VyZSB0aGlzIG91dCBu
  b24taW50ZXJhY3RpdmVseQpkX3N1aWRzYWZlPSRkZWZpbmUKCiMgY2MgaXMgZ2NjIHNvIHdlIGNh
  biBkbyBiZXR0ZXIgdGhhbiAtTwojIEFsbG93IGEgY29tbWFuZC1saW5lIG92ZXJyaWRlLCBzdWNo
  IGFzIC1Eb3B0aW1pemU9LWcKY2FzZSAke0FSQ0h9IGluCm04OGspCiAgIG9wdGltaXplPSctTzAn
  CiAgIDs7CmhwcGEpCiAgIG9wdGltaXplPSctTzAnCiAgIDs7CiopCiAgIHRlc3QgIiRvcHRpbWl6
  ZSIgfHwgb3B0aW1pemU9Jy1PMicKICAgOzsKZXNhYwoKIyBUaGlzIHNjcmlwdCBVVS91c2V0aHJl
  YWRzLmNidSB3aWxsIGdldCAnY2FsbGVkLWJhY2snIGJ5IENvbmZpZ3VyZSAKIyBhZnRlciBpdCBo
  YXMgcHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNhdCA+IFVV
  L3VzZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRlZmluZXx0
  cnVlfFt5WV0qKQoJIyBhbnkgb3BlbmJzZCB2ZXJzaW9uIGRlcGVuZGVuY2llcyB3aXRoIHB0aHJl
  YWRzPwoJY2NmbGFncz0iLXB0aHJlYWQgJGNjZmxhZ3MiCglsZGZsYWdzPSItcHRocmVhZCAkbGRm
  bGFncyIKCWNhc2UgIiRvc3ZlcnMiIGluCglbMC0yXS4qfDMuWzAtMl0pCgkJIyBDaGFuZ2UgZnJv
  bSAtbGMgdG8gLWxjX3IKCQlzZXQgYGVjaG8gIlggJGxpYnN3YW50ZWQgIiB8IHNlZCAncy8gYyAv
  IGNfciAvJ2AKCQlzaGlmdAoJCWxpYnN3YW50ZWQ9IiQqIgoJOzsKCWVzYWMKCWNhc2UgIiRvc3Zl
  cnMiIGluCglbMDEyXS4qfDMuWzAtNl0pCiAgICAgICAgCSMgQnJva2VuIGF0IGxlYXN0IHVwIHRv
  IE9wZW5CU0QgMy42LCB3ZSdsbCBzZWUgYWJvdXQgMy43CgkJZF9nZXRzZXJ2YnluYW1lX3I9JHVu
  ZGVmIDs7Cgllc2FjCmVzYWMKRU9DQlUKCiMgVGhpcyBzY3JpcHQgVVUvdXNlNjRiaXRpbnQuY2J1
  IHdpbGwgZ2V0ICdjYWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIAojIGFmdGVyIGl0IGhhcyBwcm9t
  cHRlZCB0aGUgdXNlciBmb3Igd2hldGhlciB0byB1c2UgNjQtYml0bmVzcy4KY2F0ID4gVVUvdXNl
  NjRiaXRpbnQuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNlNjRiaXRpbnQiIGluCiRkZWZpbmV8dHJ1
  ZXxbeVldKikKCWVjaG8gIiAiCgllY2hvICJDaGVja2luZyBpZiB5b3VyIEMgbGlicmFyeSBoYXMg
  YnJva2VuIDY0LWJpdCBmdW5jdGlvbnMuLi4iID4mNAoJJGNhdCA+Y2hlY2suYyA8PEVPQ1AKI2lu
  Y2x1ZGUgPHN0ZGlvLmg+CnR5cGVkZWYgJHVxdWFkdHlwZSBteVVMTDsKaW50IG1haW4gKHZvaWQp
  CnsKICAgIHN0cnVjdCB7Cglkb3VibGUgZDsKCW15VUxMICB1OwogICAgfSAqcCwgdGVzdFtdID0g
  ewoJezQyOTQ5NjczMDMuMTUsIDQyOTQ5NjczMDNVTEx9LAoJezQyOTQ5NjcyOTQuMiwgIDQyOTQ5
  NjcyOTRVTEx9LAoJezQyOTQ5NjcyOTUuNywgIDQyOTQ5NjcyOTVVTEx9LAoJezAuMCwgMFVMTH0K
  ICAgIH07CiAgICBmb3IgKHAgPSB0ZXN0OyBwLT51OyBwKyspIHsKCW15VUxMIHggPSAobXlVTEwp
  cC0+ZDsKCWlmICh4ICE9IHAtPnUpIHsKCSAgICBwcmludGYoImJ1Z2d5XG4iKTsKCSAgICByZXR1
  cm4gMDsKCX0KICAgIH0KICAgIHByaW50Zigib2tcbiIpOwogICAgcmV0dXJuIDA7Cn0KRU9DUAoJ
  c2V0IGNoZWNrCglpZiBldmFsICRjb21waWxlX29rOyB0aGVuCgkgICAgbGliY3F1YWQ9YC4vY2hl
  Y2tgCgkgICAgZWNobyAiWW91ciBDIGxpYnJhcnkncyA2NC1iaXQgZnVuY3Rpb25zIGFyZSAkbGli
  Y3F1YWQuIgoJZWxzZQoJICAgIGVjaG8gIihJIGNhbid0IHNlZW0gdG8gY29tcGlsZSB0aGUgdGVz
  dCBwcm9ncmFtLikiCgkgICAgZWNobyAiQXNzdW1pbmcgdGhhdCB5b3VyIEMgbGlicmFyeSdzIDY0
  LWJpdCBmdW5jdGlvbnMgYXJlIG9rLiIKCSAgICBsaWJjcXVhZD0ib2siCglmaQoJJHJtIC1mIGNo
  ZWNrLmMgY2hlY2sKCgljYXNlICIkbGliY3F1YWQiIGluCgkgICAgYnVnZ3kqKQoJCWNhdCA+JjQg
  PDxFT00KCioqKiBZb3UgaGF2ZSBhIEMgbGlicmFyeSB3aXRoIGJyb2tlbiA2NC1iaXQgZnVuY3Rp
  b25zLgoqKiogNjQtYml0IHN1cHBvcnQgZG9lcyBub3Qgd29yayByZWxpYWJseSBpbiB0aGlzIGNv
  bmZpZ3VyYXRpb24uCioqKiBQbGVhc2UgcmVydW4gQ29uZmlndXJlIHdpdGhvdXQgLUR1c2U2NGJp
  dGludCBhbmQvb3IgLUR1c2Vtb3JlYml0cy4KKioqIENhbm5vdCBjb250aW51ZSwgYWJvcnRpbmcu
  CgpFT00KCQlleGl0IDEKCQk7OwoJZXNhYwplc2FjCkVPQ0JVCgojIFdoZW4gYnVpbGRpbmcgaW4g
  dGhlIE9wZW5CU0QgdHJlZSB3ZSB1c2UgZGlmZmVyZW50IHBhdGhzCiMgVGhpcyBpcyBvbmx5IHBh
  cnQgb2YgdGhlIHN0b3J5LCB0aGUgcmVzdCBjb21lcyBmcm9tIGNvbmZpZy5vdmVyCmNhc2UgIiRv
  cGVuYnNkX2Rpc3RyaWJ1dGlvbiIgaW4KJyd8JHVuZGVmfGZhbHNlKSA7OwoqKQoJIyBXZSBwdXQg
  dGhpbmdzIGluIC91c3IsIG5vdCAvdXNyL2xvY2FsCglwcmVmaXg9Jy91c3InCglwcmVmaXhleHA9
  Jy91c3InCglzeXNtYW49Jy91c3Ivc2hhcmUvbWFuL21hbjEnCglsaWJwdGg9Jy91c3IvbGliJwoJ
  Z2xpYnB0aD0nL3Vzci9saWInCgkjIExvY2FsIHRoaW5ncywgaG93ZXZlciwgZG8gZ28gaW4gL3Vz
  ci9sb2NhbAoJc2l0ZXByZWZpeD0nL3Vzci9sb2NhbCcKCXNpdGVwcmVmaXhleHA9Jy91c3IvbG9j
  YWwnCgkjIFBvcnRzIGluc3RhbGxzIG5vbi1zdGQgbGlicyBpbiAvdXNyL2xvY2FsL2xpYiBzbyBs
  b29rIHRoZXJlIHRvbwoJbG9jaW5jcHRoPScvdXNyL2xvY2FsL2luY2x1ZGUnCglsb2NsaWJwdGg9
  Jy91c3IvbG9jYWwvbGliJwoJIyBMaW5rIHBlcmwgd2l0aCBzaGFyZWQgbGlicGVybAoJaWYgWyAi
  JHVzZWRsIiA9ICIkZGVmaW5lIiAtYSAtciBzaGxpYl92ZXJzaW9uIF07IHRoZW4KCQl1c2VzaHJw
  bGliPXRydWUKCQlsaWJwZXJsPWAuIC4vc2hsaWJfdmVyc2lvbjsgZWNobyBsaWJwZXJsLnNvLiR7
  bWFqb3J9LiR7bWlub3J9YAoJZmkKCTs7CmVzYWMKCiMgZW5kCg==',
  'cygwin' =>
  'IyEgL2Jpbi9zaAojIGN5Z3dpbi5zaCAtIGhpbnRzIGZvciBidWlsZGluZyBwZXJsIHVzaW5nIHRo
  ZSBDeWd3aW4gZW52aXJvbm1lbnQgZm9yIFdpbjMyCiMKCiMgbm90IG90aGVyd2lzZSBzZXR0YWJs
  ZQpleGVfZXh0PScuZXhlJwpmaXJzdG1ha2VmaWxlPSdHTlVtYWtlZmlsZScKY2FzZSAiJGxkbGli
  cHRobmFtZSIgaW4KJycpIGxkbGlicHRobmFtZT1QQVRIIDs7CmVzYWMKYXJjaG9ianM9J2N5Z3dp
  bi5vJwoKIyBtYW5kYXRvcnkgKG92ZXJyaWRlcyBpbmNvcnJlY3QgZGVmYXVsdHMpCnRlc3QgLXog
  IiRjYyIgJiYgY2M9J2djYycKaWYgdGVzdCAteiAiJHBsaWJwdGgiCnRoZW4KICAgIHBsaWJwdGg9
  YGdjYyAtcHJpbnQtZmlsZS1uYW1lPWxpYmMuYWAKICAgIHBsaWJwdGg9YGRpcm5hbWUgJHBsaWJw
  dGhgCiAgICBwbGlicHRoPWBjZCAkcGxpYnB0aCAmJiBwd2RgCmZpCnNvPSdkbGwnCiMgLSBlbGlt
  aW5hdGUgLWxjLCBpbXBsaWVkIGJ5IGdjYyBhbmQgYSBzeW1saW5rIHRvIGxpYmN5Z3dpbi5hCmxp
  YnN3YW50ZWQ9YGVjaG8gIiAkbGlic3dhbnRlZCAiIHwgc2VkIC1lICdzLyBjIC8gL2cnYAojIC0g
  ZWxpbWluYXRlIC1sbSwgc3ltbGluayB0byBsaWJjeWd3aW4uYQpsaWJzd2FudGVkPWBlY2hvICIg
  JGxpYnN3YW50ZWQgIiB8IHNlZCAtZSAncy8gbSAvIC9nJ2AKIyAtIGVsaW1pbmF0ZSAtbHV0aWws
  IHN5bWJvbHMgYXJlIGFsbCBpbiBsaWJjeWd3aW4uYQpsaWJzd2FudGVkPWBlY2hvICIgJGxpYnN3
  YW50ZWQgIiB8IHNlZCAtZSAncy8gdXRpbCAvIC9nJ2AKIyAtIGFkZCBsaWJnZGJtX2NvbXBhdCAk
  bGlic3dhbnRlZApsaWJzd2FudGVkPSIkbGlic3dhbnRlZCBnZGJtX2NvbXBhdCIKdGVzdCAteiAi
  JG9wdGltaXplIiAmJiBvcHRpbWl6ZT0nLU8zJwptYW4zZXh0PSczcG0nCnRlc3QgLXogIiR1c2U2
  NGJpdGludCIgJiYgdXNlNjRiaXRpbnQ9J2RlZmluZScKdGVzdCAteiAiJHVzZWl0aHJlYWRzIiAm
  JiB1c2VpdGhyZWFkcz0nZGVmaW5lJwpjY2ZsYWdzPSIkY2NmbGFncyAtRFBFUkxfVVNFX1NBRkVf
  UFVURU5WIC1VX19TVFJJQ1RfQU5TSV9fIgojIC0gb3RoZXJ3aXNlIGk2ODYtY3lnd2luCmFyY2hu
  YW1lPSdjeWd3aW4nCgojIGR5bmFtaWMgbG9hZGluZwojIC0gb3RoZXJ3aXNlIC1mcGljCmNjY2Rs
  ZmxhZ3M9JyAnCmxkZGxmbGFncz0nIC0tc2hhcmVkJwp0ZXN0IC16ICIkbGQiICYmIGxkPSdnKysn
  CgpjYXNlICIkb3N2ZXJzIiBpbgogICAgIyBDb25maWd1cmUgZ2V0cyB0aGVzZSB3cm9uZyBpZiB0
  aGUgSVBDIHNlcnZlciBpc24ndCB5ZXQgcnVubmluZzoKICAgICMgb25seSB1c2UgZm9yIDEuNS43
  IGFuZCBvbndhcmRzCiAgICBbMi05XSp8MS5bNi05XSp8MS5bMS01XVswLTldKnwxLjUuWzctOV0q
  fDEuNS5bMS02XVswLTldKikKICAgICAgICBkX3NlbWN0bF9zZW1pZF9kcz0nZGVmaW5lJwogICAg
  ICAgIGRfc2VtY3RsX3NlbXVuPSdkZWZpbmUnCiAgICAgICAgOzsKZXNhYwoKY2FzZSAiJG9zdmVy
  cyIgaW4KICAgIFsyLTldKnwxLls2LTldKikKICAgICAgICAjIElQdjYgb25seSBzaW5jZSAxLjcK
  ICAgICAgICBkX2luZXRudG9wPSdkZWZpbmUnCiAgICAgICAgZF9pbmV0cHRvbj0nZGVmaW5lJwog
  ICAgICAgIDs7CiAgICAqKQogICAgICAgICMgSVB2NiBub3QgaW1wbGVtZW50ZWQgYmVmb3JlIGN5
  Z3dpbi0xLjcKICAgICAgICBkX2luZXRudG9wPSd1bmRlZicKICAgICAgICBkX2luZXRwdG9uPSd1
  bmRlZicKZXNhYwoKIyBjb21waWxlIFdpbjMyQ09SRSAibW9kdWxlIiBhcyBzdGF0aWMuIHRyeSB0
  byBhdm9pZCB0aGUgc3BhY2UuCmlmIHRlc3QgLXogIiRzdGF0aWNfZXh0IjsgdGhlbgogIHN0YXRp
  Y19leHQ9IldpbjMyQ09SRSIKZWxzZQogIHN0YXRpY19leHQ9IiRzdGF0aWNfZXh0IFdpbjMyQ09S
  RSIKZmkKCiMgV2luOXggcHJvYmxlbSB3aXRoIG5vbi1ibG9ja2luZyByZWFkIGZyb20gYSBjbG9z
  ZWQgcGlwZQpkX2VvZm5ibGs9J2RlZmluZScKCiMgc3VwcHJlc3MgYXV0by1pbXBvcnQgd2Fybmlu
  Z3MKbGRmbGFncz0iJGxkZmxhZ3MgLVdsLC0tZW5hYmxlLWF1dG8taW1wb3J0IC1XbCwtLWV4cG9y
  dC1hbGwtc3ltYm9scyAtV2wsLS1lbmFibGUtYXV0by1pbWFnZS1iYXNlIgpsZGRsZmxhZ3M9IiRs
  ZGRsZmxhZ3MgJGxkZmxhZ3MiCgojIHN0cmlwIGV4ZSdzIGFuZCBkbGwncywgYmV0dGVyIGRvIGl0
  IGFmdGVyd2FyZHMKI2xkZmxhZ3M9IiRsZGZsYWdzIC1zIgojY2NkbGZsYWdzPSIkY2NkbGZsYWdz
  IC1zIgojbGRkbGZsYWdzPSIkbGRkbGZsYWdzIC1zIgo=',
  'linux' =>
  'IyBoaW50cy9saW51eC5zaAojIE9yaWdpbmFsIHZlcnNpb24gYnkgcnNhbmRlcnMKIyBBZGRpdGlv
  bmFsIHN1cHBvcnQgYnkgS2VubmV0aCBBbGJhbm93c2tpIDxramFoZHNAa2phaGRzLmNvbT4KIwoj
  IEVMRiBzdXBwb3J0IGJ5IEguSi4gTHUgPGhqbEBueW5leHN0LmNvbT4KIyBBZGRpdGlvbmFsIGlu
  Zm8gZnJvbSBOaWdlbCBIZWFkIDxuaGVhZEBFU09DLmJpdG5ldD4KIyBhbmQgS2VubmV0aCBBbGJh
  bm93c2tpIDxramFoZHNAa2phaGRzLmNvbT4KIwojIENvbnNvbGlkYXRlZCBieSBBbmR5IERvdWdo
  ZXJ0eSA8ZG91Z2hlcmFAbGFmYXlldHRlLmVkdT4KIwojIFVwZGF0ZWQgVGh1IEZlYiAgOCAxMTo1
  NjoxMCBFU1QgMTk5NgoKIyBVcGRhdGVkIFRodSBNYXkgMzAgMTA6NTA6MjIgRURUIDE5OTYgYnkg
  PGRvdWdoZXJhQGxhZmF5ZXR0ZS5lZHU+CgojIFVwZGF0ZWQgRnJpIEp1biAyMSAxMTowNzo1NCBF
  RFQgMTk5NgojIE5EQk0gc3VwcG9ydCBmb3IgRUxGIHJlLWVuYWJsZWQgYnkgPGtqYWhkc0BramFo
  ZHMuY29tPgoKIyBObyB2ZXJzaW9uIG9mIExpbnV4IHN1cHBvcnRzIHNldHVpZCBzY3JpcHRzLgpk
  X3N1aWRzYWZlPSd1bmRlZicKCiMgTm8gdmVyc2lvbiBvZiBMaW51eCBuZWVkcyBsaWJ1dGlsIGZv
  ciBwZXJsLgppX2xpYnV0aWw9J3VuZGVmJwoKIyBEZWJpYW4gYW5kIFJlZCBIYXQsIGFuZCBwZXJo
  YXBzIG90aGVyIHZlbmRvcnMsIHByb3ZpZGUgYm90aCBydW50aW1lIGFuZAojIGRldmVsb3BtZW50
  IHBhY2thZ2VzIGZvciBzb21lIGxpYnJhcmllcy4gIFRoZSBydW50aW1lIHBhY2thZ2VzIGNvbnRh
  aW4gc2hhcmVkCiMgbGlicmFyaWVzIHdpdGggdmVyc2lvbiBpbmZvcm1hdGlvbiBpbiB0aGVpciBu
  YW1lcyAoZS5nLiwgbGliZ2RibS5zby4xLjcuMyk7CiMgdGhlIGRldmVsb3BtZW50IHBhY2thZ2Vz
  IHN1cHBsZW1lbnQgdGhpcyB3aXRoIHZlcnNpb25sZXNzIHNoYXJlZCBsaWJyYXJpZXMKIyAoZS5n
  LiwgbGliZ2RibS5zbykuCiMKIyBJZiB5b3Ugd2FudCB0byBsaW5rIGFnYWluc3Qgc3VjaCBhIGxp
  YnJhcnksIHlvdSBtdXN0IGluc3RhbGwgdGhlIGRldmVsb3BtZW50CiMgdmVyc2lvbiBvZiB0aGUg
  cGFja2FnZS4KIwojIFRoZXNlIHBhY2thZ2VzIHVzZSBhIC1kZXYgbmFtaW5nIGNvbnZlbnRpb24g
  aW4gYm90aCBEZWJpYW4gYW5kIFJlZCBIYXQ6CiMgICBsaWJnZGJtZzEgIChub24tZGV2ZWxvcG1l
  bnQgdmVyc2lvbiBvZiBHTlUgbGliYyAyLWxpbmtlZCBHREJNIGxpYnJhcnkpCiMgICBsaWJnZGJt
  ZzEtZGV2IChkZXZlbG9wbWVudCB2ZXJzaW9uIG9mIEdOVSBsaWJjIDItbGlua2VkIEdEQk0gbGli
  cmFyeSkKIyBTbyBtYWtlIHN1cmUgdGhhdCBmb3IgYW55IGxpYnJhcmllcyB5b3Ugd2lzaCB0byBs
  aW5rIFBlcmwgd2l0aCB1bmRlcgojIERlYmlhbiBvciBSZWQgSGF0IHlvdSBoYXZlIHRoZSAtZGV2
  IHBhY2thZ2VzIGluc3RhbGxlZC4KCiMgU3VTRSBMaW51eCBjYW4gYmUgdXNlZCBhcyBjcm9zcy1j
  b21waWxhdGlvbiBob3N0IGZvciBDcmF5IFhUNCBDYXRhbW91bnQvUWsuCmlmIHRlc3QgLWQgL29w
  dC94dC1wZQp0aGVuCiAgY2FzZSAiYGNjIC1WIDI+JjFgIiBpbgogICpjYXRhbW91bnQqKSAuIGhp
  bnRzL2NhdGFtb3VudC5zaDsgcmV0dXJuIDs7CiAgZXNhYwpmaQoKIyBTb21lIG9wZXJhdGluZyBz
  eXN0ZW1zIChlLmcuLCBTb2xhcmlzIDIuNikgd2lsbCBsaW5rIHRvIGEgdmVyc2lvbmVkIHNoYXJl
  ZAojIGxpYnJhcnkgaW1wbGljaXRseS4gIEZvciBleGFtcGxlLCBvbiBTb2xhcmlzLCBgbGQgZm9v
  Lm8gLWxnZGJtJyB3aWxsIGZpbmQgYW4KIyBhcHByb3ByaWF0ZSB2ZXJzaW9uIG9mIGxpYmdkYm0s
  IGlmIG9uZSBpcyBhdmFpbGFibGU7IExpbnV4LCBob3dldmVyLCBkb2Vzbid0CiMgZG8gdGhlIGlt
  cGxpY2l0IG1hcHBpbmcuCmlnbm9yZV92ZXJzaW9uZWRfc29saWJzPSd5JwoKIyBCU0QgY29tcGF0
  aWJpbGl0eSBsaWJyYXJ5IG5vIGxvbmdlciBuZWVkZWQKIyAna2FmZmUnIGhhcyBhIC91c3IvbGli
  L2xpYm5ldC5zbyB3aGljaCBpcyBub3QgYXQgYWxsIHJlbGV2YW50IGZvciBwZXJsLgojIGJpbmQg
  Y2F1c2VzIGlzc3VlcyB3aXRoIHNldmVyYWwgcmVlbnRyYW50IGZ1bmN0aW9ucwpzZXQgYGVjaG8g
  WCAiJGxpYnN3YW50ZWQgInwgc2VkIC1lICdzLyBic2QgLyAvJyAtZSAncy8gbmV0IC8gLycgLWUg
  J3MvIGJpbmQgLyAvJ2AKc2hpZnQKbGlic3dhbnRlZD0iJCoiCgojIERlYmlhbiA0LjAgcHV0cyBu
  ZGJtIGluIHRoZSAtbGdkYm1fY29tcGF0IGxpYnJhcnkuCmxpYnN3YW50ZWQ9IiRsaWJzd2FudGVk
  IGdkYm1fY29tcGF0IgoKIyBJZiB5b3UgaGF2ZSBnbGliYywgdGhlbiByZXBvcnQgdGhlIHZlcnNp
  b24gZm9yIC4vbXljb25maWcgYnVnIHJlcG9ydGluZy4KIyAoQ29uZmlndXJlIGRvZXNuJ3QgbmVl
  ZCB0byBrbm93IHRoZSBzcGVjaWZpYyB2ZXJzaW9uIHNpbmNlIGl0IGp1c3QgdXNlcwojIGdjYyB0
  byBsb2FkIHRoZSBsaWJyYXJ5IGZvciBhbGwgdGVzdHMuKQojIFdlIGRvbid0IHVzZSBfX0dMSUJD
  X18gYW5kICBfX0dMSUJDX01JTk9SX18gYmVjYXVzZSB0aGV5CiMgYXJlIGluc3VmZmljaWVudGx5
  IHByZWNpc2UgdG8gZGlzdGluZ3Vpc2ggdGhpbmdzIGxpa2UKIyBsaWJjLTIuMC42IGFuZCBsaWJj
  LTIuMC43LgppZiB0ZXN0IC1MIC9saWIvbGliYy5zby42OyB0aGVuCiAgICBsaWJjPWBscyAtbCAv
  bGliL2xpYmMuc28uNiB8IGF3ayAne3ByaW50ICRORn0nYAogICAgbGliYz0vbGliLyRsaWJjCmZp
  CgojIENvbmZpZ3VyZSBtYXkgZmFpbCB0byBmaW5kIGxzdGF0KCkgc2luY2UgaXQncyBhIHN0YXRp
  Yy9pbmxpbmUKIyBmdW5jdGlvbiBpbiA8c3lzL3N0YXQuaD4uCmRfbHN0YXQ9ZGVmaW5lCgojIG1h
  bGxvYyB3cmFwIHdvcmtzCmNhc2UgIiR1c2VtYWxsb2N3cmFwIiBpbgonJykgdXNlbWFsbG9jd3Jh
  cD0nZGVmaW5lJyA7Owplc2FjCgojIFRoZSBzeXN0ZW0gbWFsbG9jKCkgaXMgYWJvdXQgYXMgZmFz
  dCBhbmQgYXMgZnJ1Z2FsIGFzIHBlcmwncy4KIyBTaW5jZSB0aGUgc3lzdGVtIG1hbGxvYygpIGhh
  cyBiZWVuIHRoZSBkZWZhdWx0IHNpbmNlIGF0IGxlYXN0CiMgNS4wMDEsIHdlIG1pZ2h0IGFzIHdl
  bGwgbGVhdmUgaXQgdGhhdCB3YXkuICAtLUFEICAxMCBKYW4gMjAwMgpjYXNlICIkdXNlbXltYWxs
  b2MiIGluCicnKSB1c2VteW1hbGxvYz0nbicgOzsKZXNhYwoKIyBDaGVjayBpZiB3ZSdyZSBhYm91
  dCB0byB1c2UgSW50ZWwncyBJQ0MgY29tcGlsZXIKY2FzZSAiYCR7Y2M6LWNjfSAtViAyPiYxYCIg
  aW4KKiJJbnRlbChSKSBDKysgQ29tcGlsZXIiKnwqIkludGVsKFIpIEMgQ29tcGlsZXIiKikKICAg
  ICMgcmVjb3JkIHRoZSB2ZXJzaW9uLCBmb3JtYXRzOgogICAgIyBpY2MgKElDQykgMTAuMSAyMDA4
  MDgwMQogICAgIyBpY3BjIChJQ0MpIDEwLjEgMjAwODA4MDEKICAgICMgZm9sbG93ZWQgYnkgYSBj
  b3B5cmlnaHQgb24gdGhlIHNlY29uZCBsaW5lCiAgICBjY3ZlcnNpb249YCR7Y2M6LWNjfSAtLXZl
  cnNpb24gfCBzZWQgLW4gLWUgJ3MvXmljcFw/YyBcKChJQ0MpIFwpXD8vL3AnYAogICAgIyBUaGlz
  IGlzIG5lZWRlZCBmb3IgQ29uZmlndXJlJ3MgcHJvdG90eXBlIGNoZWNrcyB0byB3b3JrIGNvcnJl
  Y3RseQogICAgIyBUaGUgLW1wIGZsYWcgaXMgbmVlZGVkIHRvIHBhc3MgdmFyaW91cyBmbG9hdGlu
  ZyBwb2ludCByZWxhdGVkIHRlc3RzCiAgICAjIFRoZSAtbm8tZ2NjIGZsYWcgaXMgbmVlZGVkIG90
  aGVyd2lzZSwgaWNjIHByZXRlbmRzIChwb29ybHkpIHRvIGJlIGdjYwogICAgY2NmbGFncz0iLXdl
  MTQ3IC1tcCAtbm8tZ2NjICRjY2ZsYWdzIgogICAgIyBQcmV2ZW50IHJlbG9jYXRpb24gZXJyb3Jz
  IG9uIDY0Yml0cyBhcmNoCiAgICBjYXNlICJgdW5hbWUgLW1gIiBpbgoJKmlhNjQqfCp4ODZfNjQq
  KQoJICAgIGNjY2RsZmxhZ3M9Jy1mUElDJwoJOzsKICAgIGVzYWMKICAgICMgSWYgd2UncmUgdXNp
  bmcgSUNDLCB3ZSB1c3VhbGx5IHdhbnQgdGhlIGJlc3QgcGVyZm9ybWFuY2UKICAgIGNhc2UgIiRv
  cHRpbWl6ZSIgaW4KICAgICcnKSBvcHRpbWl6ZT0nLU8zJyA7OwogICAgZXNhYwogICAgOzsKKiIg
  U3VuICIqIkMiKikKICAgICMgU3VuJ3MgQyBjb21waWxlciwgd2hpY2ggbWlnaHQgaGF2ZSBhICd0
  YWcnIG5hbWUgYmV0d2VlbgogICAgIyAnU3VuJyBhbmQgdGhlICdDJzogIEV4YW1wbGVzOgogICAg
  IyBjYzogU3VuIEMgNS45IExpbnV4X2kzODYgUGF0Y2ggMTI0ODcxLTAxIDIwMDcvMDcvMzEKICAg
  ICMgY2M6IFN1biBDZXJlcyBDIDUuMTAgTGludXhfaTM4NiAyMDA4LzA3LzEwCiAgICB0ZXN0ICIk
  b3B0aW1pemUiIHx8IG9wdGltaXplPScteE8yJwogICAgY2NjZGxmbGFncz0nLUtQSUMnCiAgICBs
  ZGRsZmxhZ3M9Jy1HIC1CZHluYW1pYycKICAgICMgU3VuIEMgZG9lc24ndCBzdXBwb3J0IGdjYyBh
  dHRyaWJ1dGVzLCBidXQsIGluIG1hbnkgY2FzZXMsIGRvZXNuJ3QKICAgICMgY29tcGxhaW4gZWl0
  aGVyLiAgTm90IGFsbCBjYXNlcywgdGhvdWdoLgogICAgZF9hdHRyaWJ1dGVfZm9ybWF0PSd1bmRl
  ZicKICAgIGRfYXR0cmlidXRlX21hbGxvYz0ndW5kZWYnCiAgICBkX2F0dHJpYnV0ZV9ub25udWxs
  PSd1bmRlZicKICAgIGRfYXR0cmlidXRlX25vcmV0dXJuPSd1bmRlZicKICAgIGRfYXR0cmlidXRl
  X3B1cmU9J3VuZGVmJwogICAgZF9hdHRyaWJ1dGVfdW51c2VkPSd1bmRlZicKICAgIGRfYXR0cmli
  dXRlX3dhcm5fdW51c2VkX3Jlc3VsdD0ndW5kZWYnCiAgICA7Owplc2FjCgpjYXNlICIkb3B0aW1p
  emUiIGluCiMgdXNlIC1PMiBieSBkZWZhdWx0IDsgLU8zIGRvZXNuJ3Qgc2VlbSB0byBicmluZyBz
  aWduaWZpY2FudCBiZW5lZml0cyB3aXRoIGdjYwonJykKICAgIG9wdGltaXplPSctTzInCiAgICBj
  YXNlICJgdW5hbWUgLW1gIiBpbgogICAgICAgIHBwYyopCiAgICAgICAgICAgICMgb24gcHBjLCBp
  dCBzZWVtcyB0aGF0IGdjYyAoYXQgbGVhc3QgZ2NjIDMuMy4yKSBpc24ndCBoYXBweQogICAgICAg
  ICAgICAjIHdpdGggLU8yIDsgc28gZG93bmdyYWRlIHRvIC1PMS4KICAgICAgICAgICAgb3B0aW1p
  emU9Jy1PMScKICAgICAgICA7OwogICAgICAgIGlhNjQqKQogICAgICAgICAgICAjIFRoaXMgYXJj
  aGl0ZWN0dXJlIGhhcyBoYWQgdmFyaW91cyBwcm9ibGVtcyB3aXRoIGdjYydzCiAgICAgICAgICAg
  ICMgaW4gdGhlIDMuMiwgMy4zLCBhbmQgMy40IHJlbGVhc2VzIHdoZW4gb3B0aW1pemVkIHRvIC1P
  Mi4gIFNlZQogICAgICAgICAgICAjIFJUICMzNzE1NiBmb3IgYSBkaXNjdXNzaW9uIG9mIHRoZSBw
  cm9ibGVtLgogICAgICAgICAgICBjYXNlICJgJHtjYzotZ2NjfSAtdiAyPiYxYCIgaW4KICAgICAg
  ICAgICAgKiJ2ZXJzaW9uIDMuMiIqfCoidmVyc2lvbiAzLjMiKnwqInZlcnNpb24gMy40IiopCiAg
  ICAgICAgICAgICAgICBjY2ZsYWdzPSItZm5vLWRlbGV0ZS1udWxsLXBvaW50ZXItY2hlY2tzICRj
  Y2ZsYWdzIgogICAgICAgICAgICA7OwogICAgICAgICAgICBlc2FjCiAgICAgICAgOzsKICAgIGVz
  YWMKICAgIDs7CmVzYWMKCiMgVWJ1bnR1IDExLjA0IChhbmQgbGF0ZXIsIHByZXN1bWFibHkpIGRv
  ZXNuJ3Qga2VlcCBtb3N0IGxpYnJhcmllcwojIChzdWNoIGFzIC1sbSkgaW4gL2xpYiBvciAvdXNy
  L2xpYi4gIFNvIHdlIGhhdmUgdG8gYXNrIGdjYyB0byB0ZWxsIHVzCiMgd2hlcmUgdG8gbG9vay4g
  IFdlIGRvbid0IHdhbnQgZ2NjJ3Mgb3duIGxpYnJhcmllcywgaG93ZXZlciwgc28gd2UKIyBmaWx0
  ZXIgdGhvc2Ugb3V0LgojIFRoaXMgY291bGQgYmUgY29uZGl0aW9uYWwgb24gVW5idW50dSwgYnV0
  IG90aGVyIGRpc3RyaWJ1dGlvbnMgbWF5CiMgZm9sbG93IHN1aXQsIGFuZCB0aGlzIHNjaGVtZSBz
  ZWVtcyB0byB3b3JrIGV2ZW4gb24gcmF0aGVyIG9sZCBnY2Mncy4KIyBUaGlzIHVuY29uZGl0aW9u
  YWxseSB1c2VzIGdjYyBiZWNhdXNlIGV2ZW4gaWYgdGhlIHVzZXIgaXMgdXNpbmcgYW5vdGhlcgoj
  IGNvbXBpbGVyLCB3ZSBzdGlsbCBuZWVkIHRvIGZpbmQgdGhlIG1hdGggbGlicmFyeSBhbmQgZnJp
  ZW5kcywgYW5kIEkgZG9uJ3QKIyBrbm93IGhvdyBvdGhlciBjb21waWxlcnMgd2lsbCBjb3BlIHdp
  dGggdGhhdCBzaXR1YXRpb24uCiMgTW9yZXZlciwgaWYgdGhlIHVzZXIgaGFzIHRoZWlyIG93biBn
  Y2MgZWFybGllciBpbiAkUEFUSCB0aGFuIHRoZSBzeXN0ZW0gZ2NjLAojIHdlIGRvbid0IHdhbnQg
  aXRzIGxpYnJhcmllcy4gU28gd2UgdHJ5IHRvIHByZWZlciB0aGUgc3lzdGVtIGdjYwojIFN0aWxs
  LCBhcyBhbiBlc2NhcGUgaGF0Y2gsIGFsbG93IENvbmZpZ3VyZSBjb21tYW5kIGxpbmUgb3ZlcnJp
  ZGVzIHRvCiMgcGxpYnB0aCB0byBieXBhc3MgdGhpcyBjaGVjay4KaWYgWyAteCAvdXNyL2Jpbi9n
  Y2MgXSA7IHRoZW4KICAgIGdjYz0vdXNyL2Jpbi9nY2MKZWxzZQogICAgZ2NjPWdjYwpmaQoKY2Fz
  ZSAiJHBsaWJwdGgiIGluCicnKSBwbGlicHRoPWBMQU5HPUMgTENfQUxMPUMgJGdjYyAtcHJpbnQt
  c2VhcmNoLWRpcnMgfCBncmVwIGxpYnJhcmllcyB8CgljdXQgLWYyLSAtZD0gfCB0ciAnOicgJHRy
  bmwgfCBncmVwIC12ICdnY2MnIHwgc2VkIC1lICdzOi8kOjonYAogICAgc2V0IFggJHBsaWJwdGgg
  IyBDb2xsYXBzZSBhbGwgZW50cmllcyBvbiBvbmUgbGluZQogICAgc2hpZnQKICAgIHBsaWJwdGg9
  IiQqIgogICAgOzsKZXNhYwoKIyBBcmUgd2UgdXNpbmcgRUxGPyAgVGhhbmtzIHRvIEtlbm5ldGgg
  QWxiYW5vd3NraSA8a2phaGRzQGtqYWhkcy5jb20+CiMgZm9yIHRoaXMgdGVzdC4KY2F0ID50cnku
  YyA8PCdFT00nCi8qIFRlc3QgZm9yIHdoZXRoZXIgRUxGIGJpbmFyaWVzIGFyZSBwcm9kdWNlZCAq
  LwojaW5jbHVkZSA8ZmNudGwuaD4KI2luY2x1ZGUgPHN0ZGxpYi5oPgojaW5jbHVkZSA8dW5pc3Rk
  Lmg+Cm1haW4oKSB7CgljaGFyIGJ1ZmZlcls0XTsKCWludCBpPW9wZW4oImEub3V0IixPX1JET05M
  WSk7CglpZihpPT0tMSkKCQlleGl0KDEpOyAvKiBmYWlsICovCglpZihyZWFkKGksJmJ1ZmZlclsw
  XSw0KTw0KQoJCWV4aXQoMSk7IC8qIGZhaWwgKi8KCWlmKGJ1ZmZlclswXSAhPSAxMjcgfHwgYnVm
  ZmVyWzFdICE9ICdFJyB8fAogICAgICAgICAgIGJ1ZmZlclsyXSAhPSAnTCcgfHwgYnVmZmVyWzNd
  ICE9ICdGJykKCQlleGl0KDEpOyAvKiBmYWlsICovCglleGl0KDApOyAvKiBzdWNjZWVkICh5ZXMs
  IGl0J3MgRUxGKSAqLwp9CkVPTQppZiAke2NjOi1nY2N9IHRyeS5jID4vZGV2L251bGwgMj4mMSAm
  JiAkcnVuIC4vYS5vdXQ7IHRoZW4KICAgIGNhdCA8PCdFT00nID4mNAoKWW91IGFwcGVhciB0byBo
  YXZlIEVMRiBzdXBwb3J0LiAgSSdsbCB0cnkgdG8gdXNlIGl0IGZvciBkeW5hbWljIGxvYWRpbmcu
  CklmIGR5bmFtaWMgbG9hZGluZyBkb2Vzbid0IHdvcmssIHJlYWQgaGludHMvbGludXguc2ggZm9y
  IGZ1cnRoZXIgaW5mb3JtYXRpb24uCkVPTQoKZWxzZQogICAgY2F0IDw8J0VPTScgPiY0CgpZb3Ug
  ZG9uJ3QgaGF2ZSBhbiBFTEYgZ2NjLiAgSSB3aWxsIHVzZSBkbGQgaWYgcG9zc2libGUuICBJZiB5
  b3UgYXJlCnVzaW5nIGEgdmVyc2lvbiBvZiBETEQgZWFybGllciB0aGFuIDMuMi42LCBvciBkb24n
  dCBoYXZlIGl0IGF0IGFsbCwgeW91CnNob3VsZCBwcm9iYWJseSB1cGdyYWRlLiBJZiB5b3UgYXJl
  IGZvcmNlZCB0byB1c2UgMy4yLjQsIHlvdSBzaG91bGQKdW5jb21tZW50IGEgY291cGxlIG9mIGxp
  bmVzIGluIGhpbnRzL2xpbnV4LnNoIGFuZCByZXN0YXJ0IENvbmZpZ3VyZSBzbwp0aGF0IHNoYXJl
  ZCBsaWJyYXJpZXMgd2lsbCBiZSBkaXNhbGxvd2VkLgoKRU9NCiAgICBsZGRsZmxhZ3M9Ii1yICRs
  ZGRsZmxhZ3MiCiAgICAjIFRoZXNlIGVtcHR5IHZhbHVlcyBhcmUgc28gdGhhdCBDb25maWd1cmUg
  ZG9lc24ndCBwdXQgaW4gdGhlCiAgICAjIExpbnV4IEVMRiB2YWx1ZXMuCiAgICBjY2RsZmxhZ3M9
  JyAnCiAgICBjY2NkbGZsYWdzPScgJwogICAgY2NmbGFncz0iLURPVlJfREJMX0RJRz0xNCAkY2Nm
  bGFncyIKICAgIHNvPSdzYScKICAgIGRsZXh0PSdvJwogICAgbm1fc29fb3B0PScgJwogICAgIyMg
  SWYgeW91IGFyZSB1c2luZyBETEQgMy4yLjQgd2hpY2ggZG9lcyBub3Qgc3VwcG9ydCBzaGFyZWQg
  bGlicywKICAgICMjIHVuY29tbWVudCB0aGUgbmV4dCB0d28gbGluZXM6CiAgICAjbGRmbGFncz0i
  LXN0YXRpYyIKICAgICNzbz0nbm9uZScKCgkjIEluIGFkZGl0aW9uLCBvbiBzb21lIHN5c3RlbXMg
  dGhlcmUgaXMgYSBwcm9ibGVtIHdpdGggcGVybCBhbmQgTkRCTQoJIyB3aGljaCBjYXVzZXMgQW55
  REJNIGFuZCBOREJNX0ZpbGUgdG8gbG9jayB1cC4gVGhpcyBpcyBldmlkZW5jZWQKCSMgaW4gdGhl
  IHRlc3RzIGFzIEFueURCTSBqdXN0IGZyZWV6aW5nLiAgQXBwYXJlbnRseSwgdGhpcyBvbmx5Cgkj
  IGhhcHBlbnMgb24gYS5vdXQgc3lzdGVtcywgc28gd2UgZGlzYWJsZSBOREJNIGZvciBhbGwgYS5v
  dXQgbGludXgKCSMgc3lzdGVtcy4gIElmIHNvbWVvbmUgY2FuIHN1Z2dlc3QgYSBtb3JlIHJvYnVz
  dCB0ZXN0CgkjICB0aGF0IHdvdWxkIGJlIGFwcHJlY2lhdGVkLgoJIwoJIyBNb3JlIGluZm86Cgkj
  IERhdGU6IFdlZCwgNyBGZWIgMTk5NiAwMzoyMTowNCArMDkwMAoJIyBGcm9tOiBKZWZmcmV5IEZy
  aWVkbCA8amZyaWVkbEBuZmYubmNsLm9tcm9uLmNvLmpwPgoJIwoJIyBJIHRyaWVkIGNvbXBpbGlu
  ZyB3aXRoIERCTSBzdXBwb3J0IGFuZCBzdXJlIGVub3VnaCB0aGluZ3MgbG9ja2VkIHVwCgkjIGp1
  c3QgYXMgYWR2ZXJ0aXNlZC4gQ2hlY2tpbmcgaW50byBpdCwgSSBmb3VuZCB0aGF0IHRoZSBsb2Nr
  dXAgd2FzCgkjIGR1cmluZyB0aGUgY2FsbCB0byBkYm1fb3Blbi4gTm90ICppbiogZGJtX29wZW4g
  LS0gYnV0IGJldHdlZW4gdGhlIGNhbGwKCSMgdG8gYW5kIHRoZSBqdW1wIGludG8uCgkjCgkjIFRv
  IG1ha2UgYSBsb25nIHN0b3J5IHNob3J0LCBtYWtpbmcgc3VyZSB0aGF0IHRoZSAqLmEgYW5kICou
  c2EgcGFpcnMgb2YKCSMgICAvdXNyL2xpYi9saWJ7bSxkYixnZGJtfS57YSxzYX0KCSMgd2VyZSBw
  ZXJmZWN0bHkgaW4gc3luYyB0b29rIGNhcmUgb2YgaXQuCgkjCgkjIFRoaXMgd2lsbCBnZW5lcmF0
  ZSBhIGhhcm1sZXNzIFdob2EgVGhlcmUhIG1lc3NhZ2UKCWNhc2UgIiRkX2RibV9vcGVuIiBpbgoJ
  JycpCWNhdCA8PCdFT00nID4mNAoKRGlzYWJsaW5nIG5kYm0uICBUaGlzIHdpbGwgZ2VuZXJhdGUg
  YSBXaG9hIFRoZXJlIG1lc3NhZ2UgaW4gQ29uZmlndXJlLgpSZWFkIGhpbnRzL2xpbnV4LnNoIGZv
  ciBmdXJ0aGVyIGluZm9ybWF0aW9uLgpFT00KCQkjIFlvdSBjYW4gb3ZlcnJpZGUgdGhpcyB3aXRo
  IENvbmZpZ3VyZSAtRGRfZGJtX29wZW4KCQlkX2RibV9vcGVuPXVuZGVmCgkJOzsKCWVzYWMKZmkK
  CnJtIC1mIHRyeS5jIGEub3V0CgppZiAvYmluL3NoIC1jIGV4aXQ7IHRoZW4KICBlY2hvICcnCiAg
  ZWNobyAnWW91IGFwcGVhciB0byBoYXZlIGEgd29ya2luZyBiYXNoLiAgR29vZC4nCmVsc2UKICBj
  YXQgPDwgJ0VPTScgPiY0CgoqKioqKioqKioqKioqKioqKioqKioqKiBXYXJuaW5nISAqKioqKioq
  KioqKioqKioqKioqKioKSXQgd291bGQgYXBwZWFyIHlvdSBoYXZlIGEgZGVmZWN0aXZlIGJhc2gg
  c2hlbGwgaW5zdGFsbGVkLiBUaGlzIGlzIGxpa2VseSB0bwpnaXZlIHlvdSBhIGZhaWx1cmUgb2Yg
  b3AvZXhlYyB0ZXN0ICM1IGR1cmluZyB0aGUgdGVzdCBwaGFzZSBvZiB0aGUgYnVpbGQsClVwZ3Jh
  ZGluZyB0byBhIHJlY2VudCB2ZXJzaW9uICgxLjE0LjQgb3IgbGF0ZXIpIHNob3VsZCBmaXggdGhl
  IHByb2JsZW0uCioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioq
  KioqKioqKgpFT00KCmZpCgojIE9uIFNQQVJDbGludXgsCiMgVGhlIGZvbGxvd2luZyBjc2ggY29u
  c2lzdGVudGx5IGNvcmVkdW1wZWQgaW4gdGhlIHRlc3QgZGlyZWN0b3J5CiMgIi9ob21lL21pa2Vk
  bHIvcGVybDUuMDAzXzk0L3QiLCB0aG91Z2ggbm90IG1vc3Qgb3RoZXIgZGlyZWN0b3JpZXMuCgoj
  TmFtZSAgICAgICAgOiBjc2ggICAgICAgICAgICAgICAgICAgIERpc3RyaWJ1dGlvbjogUmVkIEhh
  dCBMaW51eCAoUmVtYnJhbmR0KQojVmVyc2lvbiAgICAgOiA1LjIuNiAgICAgICAgICAgICAgICAg
  ICAgICAgIFZlbmRvcjogUmVkIEhhdCBTb2Z0d2FyZQojUmVsZWFzZSAgICAgOiAzICAgICAgICAg
  ICAgICAgICAgICAgICAgQnVpbGQgRGF0ZTogRnJpIE1heSAyNCAxOTo0MjoxNCAxOTk2CiNJbnN0
  YWxsIGRhdGU6IFRodSBKdWwgMTEgMTY6MjA6MTQgMTk5NiBCdWlsZCBIb3N0OiBpdGNoeS5yZWRo
  YXQuY29tCiNHcm91cCAgICAgICA6IFNoZWxscyAgICAgICAgICAgICAgICAgICBTb3VyY2UgUlBN
  OiBjc2gtNS4yLjYtMy5zcmMucnBtCiNTaXplICAgICAgICA6IDE4NDQxNwojRGVzY3JpcHRpb24g
  OiBCU0QgYy1zaGVsbAoKIyBGb3IgdGhpcyByZWFzb24gSSBzdWdnZXN0IHVzaW5nIHRoZSBtdWNo
  IGJ1Zy1maXhlZCB0Y3NoIGZvciBnbG9iYmluZwojIHdoZXJlIGF2YWlsYWJsZS4KCiMgTm92ZW1i
  ZXIgMjAwMTogIFRoYXQgd2FybmluZydzIHByZXR0eSBvbGQgbm93IGFuZCBwcm9iYWJseSBub3Qg
  c28KIyByZWxldmFudCwgZXNwZWNpYWxseSBzaW5jZSBwZXJsIG5vdyB1c2VzIEZpbGU6Okdsb2Ig
  Zm9yIGdsb2JiaW5nLgojIFdlJ2xsIHN0aWxsIGxvb2sgZm9yIHRjc2gsIGJ1dCB0b25lIGRvd24g
  dGhlIHdhcm5pbmdzLgojIEFuZHkgRG91Z2hlcnR5LCBOb3YuIDYsIDIwMDEKaWYgJGNzaCAtYyAn
  ZWNobyAkdmVyc2lvbicgPi9kZXYvbnVsbCAyPiYxOyB0aGVuCiAgICBlY2hvICdZb3VyIGNzaCBp
  cyByZWFsbHkgdGNzaC4gIEdvb2QuJwplbHNlCiAgICBpZiB4eHg9YC4vVVUvbG9jIHRjc2ggYmx1
  cmZsICRwdGhgOyAkdGVzdCAtZiAiJHh4eCI7IHRoZW4KCWVjaG8gIkZvdW5kIHRjc2guICBJJ2xs
  IHVzZSBpdCBmb3IgZ2xvYmJpbmcuIgoJIyBXZSBjYW4ndCBjaGFuZ2UgQ29uZmlndXJlJ3Mgc2V0
  dGluZyBvZiAkY3NoLCBkdWUgdG8gdGhlIHdheQoJIyBDb25maWd1cmUgaGFuZGxlcyAkZF9wb3J0
  YWJsZSBhbmQgY29tbWFuZHMgZm91bmQgaW4gJGxvY2xpc3QuCgkjIFdlIGNhbiBzZXQgdGhlIHZh
  bHVlIGZvciBDU0ggaW4gY29uZmlnLmggYnkgc2V0dGluZyBmdWxsX2NzaC4KCWZ1bGxfY3NoPSR4
  eHgKICAgIGVsaWYgWyAtZiAiJGNzaCIgXTsgdGhlbgoJZWNobyAiQ291bGRuJ3QgZmluZCB0Y3No
  LiAgQ3NoLWJhc2VkIGdsb2JiaW5nIG1pZ2h0IGJlIGJyb2tlbi4iCiAgICBmaQpmaQoKIyBTaGlt
  cGVpIFlhbWFzaGl0YSA8c2hpbXBlaUBzb2NyYXRlcy5wYXRuZXQuY2FsdGVjaC5lZHU+CiMgTWVz
  c2FnZS1JZDogPDMzRUYxNjM0LkIzNkI2NTAwQHBvYm94LmNvbT4KIwojIFRoZSBEUjIgb2YgTWtM
  aW51eCAob3NuYW1lPWxpbnV4LGFyY2huYW1lPXBwYy1saW51eCkgbWF5IG5lZWQKIyBzcGVjaWFs
  IGZsYWdzIHBhc3NlZCBpbiBvcmRlciBmb3IgZHluYW1pYyBsb2FkaW5nIHRvIHdvcmsuCiMgaW5z
  dGVhZCBvZiB0aGUgcmVjb21tZW5kZWQ6CiMKIyBjY2RsZmxhZ3M9Jy1yZHluYW1pYycKIwojIGl0
  IHNob3VsZCBiZToKIyBjY2RsZmxhZ3M9Jy1XbCwtRScKIwojIFNvIGlmIHlvdXIgRFIyIChEUjMg
  Y2FtZSBvdXQgc3VtbWVyIDE5OTgsIGNvbnNpZGVyIHVwZ3JhZGluZykKIyBoYXMgcHJvYmxlbXMg
  d2l0aCBkeW5hbWljIGxvYWRpbmcsIHVuY29tbWVudCB0aGUKIyBmb2xsb3dpbmcgdGhyZWUgbGlu
  ZXMsIG1ha2UgZGlzdGNsZWFuLCBhbmQgcmUtQ29uZmlndXJlOgojY2FzZSAiYHVuYW1lIC1yIHwg
  c2VkICdzL15bMC05Li1dKi8vJ2BgYXJjaGAiIGluCiMnb3NmbWFjaDNwcGMnKSBjY2RsZmxhZ3M9
  Jy1XbCwtRScgOzsKI2VzYWMKCmNhc2UgImB1bmFtZSAtbWAiIGluCnNwYXJjKikKCWNhc2UgIiRj
  Y2NkbGZsYWdzIiBpbgoJKi1mcGljKikgY2NjZGxmbGFncz0iYGVjaG8gJGNjY2RsZmxhZ3N8c2Vk
  ICdzLy1mcGljLy1mUElDLydgIiA7OwoJKi1mUElDKikgOzsKCSopCSBjY2NkbGZsYWdzPSIkY2Nj
  ZGxmbGFncyAtZlBJQyIgOzsKCWVzYWMKCTs7CmVzYWMKCiMgU3VTRTguMiBoYXMgL3Vzci9saWIv
  bGlibmRibSogd2hpY2ggYXJlIGxkIHNjcmlwdHMgcmF0aGVyIHRoYW4KIyB0cnVlIGxpYnJhcmll
  cy4gVGhlIHNjcmlwdHMgY2F1c2UgYmluZGluZyBhZ2FpbnN0IHN0YXRpYwojIHZlcnNpb24gb2Yg
  LWxnZGJtIHdoaWNoIGlzIGEgYmFkIGlkZWEuIFNvIGlmIHdlIGhhdmUgJ25tJwojIG1ha2Ugc3Vy
  ZSBpdCBjYW4gcmVhZCB0aGUgZmlsZQojIE5JLVMgMjAwMy8wOC8wNwppZiBbIC1yIC91c3IvbGli
  L2xpYm5kYm0uc28gIC1hICAteCAvdXNyL2Jpbi9ubSBdIDsgdGhlbgogICBpZiAvdXNyL2Jpbi9u
  bSAvdXNyL2xpYi9saWJuZGJtLnNvID4vZGV2L251bGwgMj4mMSA7IHRoZW4KICAgIGVjaG8gJ1lv
  dXIgc2hhcmVkIC1sbmRibSBzZWVtcyB0byBiZSBhIHJlYWwgbGlicmFyeS4nCiAgIGVsc2UKICAg
  IGVjaG8gJ1lvdXIgc2hhcmVkIC1sbmRibSBpcyBub3QgYSByZWFsIGxpYnJhcnkuJwogICAgc2V0
  IGBlY2hvIFggIiRsaWJzd2FudGVkICJ8IHNlZCAtZSAncy8gbmRibSAvIC8nYAogICAgc2hpZnQK
  ICAgIGxpYnN3YW50ZWQ9IiQqIgogICBmaQpmaQoKCiMgVGhpcyBzY3JpcHQgVVUvdXNldGhyZWFk
  cy5jYnUgd2lsbCBnZXQgJ2NhbGxlZC1iYWNrJyBieSBDb25maWd1cmUKIyBhZnRlciBpdCBoYXMg
  cHJvbXB0ZWQgdGhlIHVzZXIgZm9yIHdoZXRoZXIgdG8gdXNlIHRocmVhZHMuCmNhdCA+IFVVL3Vz
  ZXRocmVhZHMuY2J1IDw8J0VPQ0JVJwpjYXNlICIkdXNldGhyZWFkcyIgaW4KJGRlZmluZXx0cnVl
  fFt5WV0qKQogICAgICAgIGNjZmxhZ3M9Ii1EX1JFRU5UUkFOVCAtRF9HTlVfU09VUkNFICRjY2Zs
  YWdzIgogICAgICAgIGlmIGVjaG8gJGxpYnN3YW50ZWQgfCBncmVwIC12IHB0aHJlYWQgPi9kZXYv
  bnVsbAogICAgICAgIHRoZW4KICAgICAgICAgICAgc2V0IGBlY2hvIFggIiRsaWJzd2FudGVkICJ8
  IHNlZCAtZSAncy8gYyAvIHB0aHJlYWQgYyAvJ2AKICAgICAgICAgICAgc2hpZnQKICAgICAgICAg
  ICAgbGlic3dhbnRlZD0iJCoiCiAgICAgICAgZmkKCgkjIFNvbWVob3cgYXQgbGVhc3QgaW4gRGVi
  aWFuIDIuMiB0aGVzZSBtYW5hZ2UgdG8gZXNjYXBlCgkjIHRoZSAjZGVmaW5lIGZvcmVzdCBvZiA8
  ZmVhdHVyZXMuaD4gYW5kIDx0aW1lLmg+IHNvIHRoYXQKCSMgdGhlIGhhc3Byb3RvIG1hY3JvIG9m
  IENvbmZpZ3VyZSBkb2Vzbid0IHNlZSB0aGVzZSBwcm90b3MsCgkjIGV2ZW4gd2l0aCB0aGUgLURf
  R05VX1NPVVJDRS4KCglkX2FzY3RpbWVfcl9wcm90bz0iJGRlZmluZSIKCWRfY3J5cHRfcl9wcm90
  bz0iJGRlZmluZSIKCWRfY3RpbWVfcl9wcm90bz0iJGRlZmluZSIKCWRfZ210aW1lX3JfcHJvdG89
  IiRkZWZpbmUiCglkX2xvY2FsdGltZV9yX3Byb3RvPSIkZGVmaW5lIgoJZF9yYW5kb21fcl9wcm90
  bz0iJGRlZmluZSIKCgk7Owplc2FjCkVPQ0JVCgpjYXQgPiBVVS91c2VsYXJnZWZpbGVzLmNidSA8
  PCdFT0NCVScKIyBUaGlzIHNjcmlwdCBVVS91c2VsYXJnZWZpbGVzLmNidSB3aWxsIGdldCAnY2Fs
  bGVkLWJhY2snIGJ5IENvbmZpZ3VyZQojIGFmdGVyIGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNlciBm
  b3Igd2hldGhlciB0byB1c2UgbGFyZ2UgZmlsZXMuCmNhc2UgIiR1c2VsYXJnZWZpbGVzIiBpbgon
  J3wkZGVmaW5lfHRydWV8W3lZXSopCiMgS2VlcCB0aGlzIGluIHRoZSBsZWZ0IG1hcmdpbi4KY2Nm
  bGFnc191c2VsYXJnZWZpbGVzPSItRF9MQVJHRUZJTEVfU09VUkNFIC1EX0ZJTEVfT0ZGU0VUX0JJ
  VFM9NjQiCgoJY2NmbGFncz0iJGNjZmxhZ3MgJGNjZmxhZ3NfdXNlbGFyZ2VmaWxlcyIKCTs7CmVz
  YWMKRU9DQlUKCiMgUHVyaWZ5IGZhaWxzIHRvIGxpbmsgUGVybCBpZiBhICItbGMiIGlzIHBhc3Nl
  ZCBpbnRvIGl0cyBsaW5rZXIKIyBkdWUgdG8gZHVwbGljYXRlIHN5bWJvbHMuCmNhc2UgIiRQVVJJ
  RlkiIGluCiRkZWZpbmV8dHJ1ZXxbeVldKikKICAgIHNldCBgZWNobyBYICIkbGlic3dhbnRlZCAi
  fCBzZWQgLWUgJ3MvIGMgLyAvJ2AKICAgIHNoaWZ0CiAgICBsaWJzd2FudGVkPSIkKiIKICAgIDs7
  CmVzYWMKCiMgSWYgd2UgYXJlIHVzaW5nIGcrKyB3ZSBtdXN0IHVzZSBubSBhbmQgZm9yY2Ugb3Vy
  c2VsdmVzIHRvIHVzZQojIHRoZSAvdXNyL2xpYi9saWJjLmEgKHJlc2V0dGluZyB0aGUgbGliYyBi
  ZWxvdyB0byBhbiBlbXB0eSBzdHJpbmcKIyBtYWtlcyBDb25maWd1cmUgdG8gbG9vayBmb3IgdGhl
  IHJpZ2h0IG9uZSkgYmVjYXVzZSB0aGUgc3ltYm9sCiMgc2Nhbm5pbmcgdHJpY2tzIG9mIENvbmZp
  Z3VyZSB3aWxsIGNyYXNoIGFuZCBidXJuIGhvcnJpYmx5LgpjYXNlICIkY2MiIGluCipnKysqKSB1
  c2VubT10cnVlCiAgICAgICBsaWJjPScnCiAgICAgICA7Owplc2FjCgojIElmIHVzaW5nIGcrKywg
  dGhlIENvbmZpZ3VyZSBzY2FuIGZvciBkbG9wZW4oKSBhbmQgKGVzcGVjaWFsbHkpCiMgZGxlcnJv
  cigpIG1pZ2h0IGZhaWwsIGVhc2llciBqdXN0IHRvIGZvcmNpYmx5IGhpbnQgdGhlbSBpbi4KY2Fz
  ZSAiJGNjIiBpbgoqZysrKikKICBkX2Rsb3Blbj0nZGVmaW5lJwogIGRfZGxlcnJvcj0nZGVmaW5l
  JwogIDs7CmVzYWMKCiMgVW5kZXIgc29tZSBjaXJjdW1zdGFuY2VzIGxpYmRiIGNhbiBnZXQgYnVp
  bHQgaW4gc3VjaCBhIHdheSBhcyB0bwojIG5lZWQgcHRocmVhZCBleHBsaWNpdGx5IGxpbmtlZC4K
  CmxpYmRiX25lZWRzX3B0aHJlYWQ9Ik4iCgppZiBlY2hvICIgJGxpYnN3YW50ZWQgIiB8IGdyZXAg
  LXYgIiBwdGhyZWFkICIgPi9kZXYvbnVsbAp0aGVuCiAgIGlmIGVjaG8gIiAkbGlic3dhbnRlZCAi
  IHwgZ3JlcCAiIGRiICIgPi9kZXYvbnVsbAogICB0aGVuCiAgICAgZm9yIERCRElSIGluICRnbGli
  cHRoCiAgICAgZG8KICAgICAgIERCTElCPSIkREJESVIvbGliZGIuc28iCiAgICAgICBpZiBbIC1m
  ICREQkxJQiBdCiAgICAgICB0aGVuCiAgICAgICAgIGlmIG5tIC11ICREQkxJQiB8IGdyZXAgcHRo
  cmVhZCA+L2Rldi9udWxsCiAgICAgICAgIHRoZW4KICAgICAgICAgICBpZiBsZGQgJERCTElCIHwg
  Z3JlcCBwdGhyZWFkID4vZGV2L251bGwKICAgICAgICAgICB0aGVuCiAgICAgICAgICAgICBsaWJk
  Yl9uZWVkc19wdGhyZWFkPSJOIgogICAgICAgICAgIGVsc2UKICAgICAgICAgICAgIGxpYmRiX25l
  ZWRzX3B0aHJlYWQ9IlkiCiAgICAgICAgICAgZmkKICAgICAgICAgZmkKICAgICAgIGZpCiAgICAg
  ZG9uZQogICBmaQpmaQoKY2FzZSAiJGxpYmRiX25lZWRzX3B0aHJlYWQiIGluCiAgIlkiKQogICAg
  bGlic3dhbnRlZD0iJGxpYnN3YW50ZWQgcHRocmVhZCIKICAgIDs7CmVzYWMK',
  'freebsd' =>
  'IyBPcmlnaW5hbCBiYXNlZCBvbiBpbmZvIGZyb20KIyBDYXJsIE0uIEZvbmdoZWlzZXIgPGNtZkBp
  bnMuaW5mb25ldC5uZXQ+CiMgRGF0ZTogVGh1LCAyOCBKdWwgMTk5NCAxOToxNzowNSAtMDUwMCAo
  Q0RUKQojCiMgQWRkaXRpb25hbCAxLjEuNSBkZWZpbmVzIGZyb20gCiMgT2xsaXZpZXIgUm9iZXJ0
  IDxPbGxpdmllci5Sb2JlcnRAa2VsdGlhLmZybXVnLmZyLm5ldD4KIyBEYXRlOiBXZWQsIDI4IFNl
  cCAxOTk0IDAwOjM3OjQ2ICswMTAwIChNRVQpCiMKIyBBZGRpdGlvbmFsIDIuKiBkZWZpbmVzIGZy
  b20KIyBPbGxpdmllciBSb2JlcnQgPE9sbGl2aWVyLlJvYmVydEBrZWx0aWEuZnJtdWcuZnIubmV0
  PgojIERhdGU6IFNhdCwgOCBBcHIgMTk5NSAyMDo1Mzo0MSArMDIwMCAoTUVUIERTVCkKIwojIEFk
  ZGl0aW9uYWwgMi4wLjUgYW5kIDIuMSBkZWZpbmVkIGZyb20KIyBPbGxpdmllciBSb2JlcnQgPE9s
  bGl2aWVyLlJvYmVydEBrZWx0aWEuZnJtdWcuZnIubmV0PgojIERhdGU6IEZyaSwgMTIgTWF5IDE5
  OTUgMTQ6MzA6MzggKzAyMDAgKE1FVCBEU1QpCiMKIyBBZGRpdGlvbmFsIDIuMiBkZWZpbmVzIGZy
  b20KIyBNYXJrIE11cnJheSA8bWFya0Bncm9uZGFyLnphPgojIERhdGU6IFdlZCwgNiBOb3YgMTk5
  NiAwOTo0NDo1OCArMDIwMCAoTUVUKQojCiMgTW9kaWZpZWQgdG8gZW5zdXJlIHdlIHJlcGxhY2Ug
  LWxjIHdpdGggLWxjX3IsIGFuZAojIHRvIHB1dCBpbiBwbGFjZS1ob2xkZXJzIGZvciB2YXJpb3Vz
  IHNwZWNpZmljIGhpbnRzLgojIEFuZHkgRG91Z2hlcnR5IDxkb3VnaGVyYUBsYWZheWV0dGUuZWR1
  PgojIERhdGU6IFR1ZSBNYXIgMTAgMTY6MDc6MDAgRVNUIDE5OTgKIwojIFN1cHBvcnQgZm9yIEZy
  ZWVCU0QvRUxGCiMgT2xsaXZpZXIgUm9iZXJ0IDxyb2JlcnRvQGtlbHRpYS5mcmVlbml4LmZyPgoj
  IERhdGU6IFdlZCBTZXAgIDIgMTY6MjI6MTIgQ0VTVCAxOTk4CiMKIyBUaGUgdHdvIGZsYWdzICIt
  ZnBpYyAtRFBJQyIgYXJlIHVzZWQgdG8gaW5kaWNhdGUgYQojIHdpbGwtYmUtc2hhcmVkIG9iamVj
  dC4gIENvbmZpZ3VyZSB3aWxsIGd1ZXNzIHRoZSAtZnBpYywgKGFuZCB0aGUKIyAtRFBJQyBpcyBu
  b3QgdXNlZCBieSBwZXJsIHByb3BlcikgYnV0IHRoZSBmdWxsIGRlZmluZSBpcyBpbmNsdWRlZCB0
  byAKIyBiZSBjb25zaXN0ZW50IHdpdGggdGhlIEZyZWVCU0QgZ2VuZXJhbCBzaGFyZWQgbGlicyBi
  dWlsZGluZyBwcm9jZXNzLgojCiMgc2V0cmV1aWQgYW5kIGZyaWVuZHMgYXJlIGluaGVyZW50bHkg
  YnJva2VuIGluIGFsbCB2ZXJzaW9ucyBvZiBGcmVlQlNECiMgYmVmb3JlIDIuMS1jdXJyZW50IChi
  ZWZvcmUgYXBwcm94IGRhdGUgNC8xNS85NSkuIEl0IGlzIGZpeGVkIGluIDIuMC41CiMgYW5kIHdo
  YXQtd2lsbC1iZS0yLjEKIwoKY2FzZSAiJG9zdmVycyIgaW4KMC4qfDEuMCopCgl1c2VkbD0iJHVu
  ZGVmIgoJOzsKMS4xKikKCW1hbGxvY3R5cGU9J3ZvaWQgKicKCWdyb3Vwc3R5cGU9J2ludCcKCWRf
  c2V0cmVnaWQ9J3VuZGVmJwoJZF9zZXRyZXVpZD0ndW5kZWYnCglkX3NldHJnaWQ9J3VuZGVmJwoJ
  ZF9zZXRydWlkPSd1bmRlZicKCTs7CjIuMC1yZWxlYXNlKikKCWRfc2V0cmVnaWQ9J3VuZGVmJwoJ
  ZF9zZXRyZXVpZD0ndW5kZWYnCglkX3NldHJnaWQ9J3VuZGVmJwoJZF9zZXRydWlkPSd1bmRlZicK
  CTs7CiMKIyBUcnlpbmcgdG8gY292ZXIgMi4wLjUsIDIuMS1jdXJyZW50IGFuZCBmdXR1cmUgMi4x
  LzIuMgojIEl0IGRvZXMgbm90IGNvdmVydCBhbGwgMi4xLWN1cnJlbnQgdmVyc2lvbnMgYXMgdGhl
  IG91dHB1dCBvZiB1bmFtZQojIGNoYW5nZWQgYSBmZXcgdGltZXMuCiMKIyBFdmVuIHRob3VnaCBz
  ZXRldWlkL3NldGVnaWQgYXJlIGF2YWlsYWJsZSwgdGhleSd2ZSBiZWVuIHR1cm5lZCBvZmYKIyBi
  ZWNhdXNlIHBlcmwgaXNuJ3QgY29kZWQgd2l0aCBzYXZlZCBzZXRbdWddaWQgdmFyaWFibGVzIGlu
  IG1pbmQuCiMgSW4gYWRkaXRpb24sIGEgc21hbGwgcGF0Y2ggaXMgcmVxdWlyZWQgdG8gc3VpZHBl
  cmwgdG8gYXZvaWQgYSBzZWN1cml0eQojIHByb2JsZW0gd2l0aCBGcmVlQlNELgojCjIuMC41Knwy
  LjAtYnVpbHQqfDIuMSopCiAJdXNldmZvcms9J3RydWUnCgljYXNlICIkdXNlbXltYWxsb2MiIGlu
  CgkgICAgIiIpIHVzZW15bWFsbG9jPSduJwoJICAgICAgICA7OwoJZXNhYwoJZF9zZXRyZWdpZD0n
  ZGVmaW5lJwoJZF9zZXRyZXVpZD0nZGVmaW5lJwoJZF9zZXRlZ2lkPSd1bmRlZicKCWRfc2V0ZXVp
  ZD0ndW5kZWYnCgl0ZXN0IC1yIC4vYnJva2VuLWRiLm1zZyAmJiAuIC4vYnJva2VuLWRiLm1zZwoJ
  OzsKIwojIDIuMiBhbmQgYWJvdmUgaGF2ZSBwaGttYWxsb2MoMykuCiMgZG9uJ3QgdXNlIC1sbWFs
  bG9jIChtYXliZSB0aGVyZSdzIGFuIG9sZCBvbmUgZnJvbSAxLjEuNS4xIGZsb2F0aW5nIGFyb3Vu
  ZCkKMi4yKikKIAl1c2V2Zm9yaz0ndHJ1ZScKCWNhc2UgIiR1c2VteW1hbGxvYyIgaW4KCSAgICAi
  IikgdXNlbXltYWxsb2M9J24nCgkgICAgICAgIDs7Cgllc2FjCglsaWJzd2FudGVkPWBlY2hvICRs
  aWJzd2FudGVkIHwgc2VkICdzLyBtYWxsb2MgLyAvJ2AKCWxpYnN3YW50ZWQ9YGVjaG8gJGxpYnN3
  YW50ZWQgfCBzZWQgJ3MvIGJpbmQgLyAvJ2AKCSMgaWNvbnYgZ29uZSBpbiBQZXJsIDUuOC4xLCBi
  dXQgaWYgc29tZW9uZSBjb21waWxlcyA1LjguMCBvciBlYXJsaWVyLgoJbGlic3dhbnRlZD1gZWNo
  byAkbGlic3dhbnRlZCB8IHNlZCAncy8gaWNvbnYgLyAvJ2AKCWRfc2V0cmVnaWQ9J2RlZmluZScK
  CWRfc2V0cmV1aWQ9J2RlZmluZScKCWRfc2V0ZWdpZD0nZGVmaW5lJwoJZF9zZXRldWlkPSdkZWZp
  bmUnCgkjIGRfZG9zdWlkPSdkZWZpbmUnICMgT2Jzb2xldGUuCgk7OwoqKQl1c2V2Zm9yaz0ndHJ1
  ZScKCWNhc2UgIiR1c2VteW1hbGxvYyIgaW4KCSAgICAiIikgdXNlbXltYWxsb2M9J24nCgkgICAg
  ICAgIDs7Cgllc2FjCglsaWJzd2FudGVkPWBlY2hvICRsaWJzd2FudGVkIHwgc2VkICdzLyBtYWxs
  b2MgLyAvJ2AKCTs7CmVzYWMKCiMgRHluYW1pYyBMb2FkaW5nIGZsYWdzIGhhdmUgbm90IGNoYW5n
  ZWQgbXVjaCwgc28gdGhleSBhcmUgc2VwYXJhdGVkCiMgb3V0IGhlcmUgdG8gYXZvaWQgZHVwbGlj
  YXRpbmcgdGhlbSBldmVyeXdoZXJlLgpjYXNlICIkb3N2ZXJzIiBpbgowLip8MS4wKikgOzsKCjEu
  KnwyLiopCgljY2NkbGZsYWdzPSctRFBJQyAtZnBpYycKCWxkZGxmbGFncz0iLUJzaGFyZWFibGUg
  JGxkZGxmbGFncyIKCTs7CgozKnw0Knw1Knw2KikKICAgICAgICBvYmpmb3JtYXQ9YC91c3IvYmlu
  L29iamZvcm1hdGAKICAgICAgICBpZiBbIHgkb2JqZm9ybWF0ID0geGFvdXQgXTsgdGhlbgogICAg
  ICAgICAgICBpZiBbIC1lIC91c3IvbGliL2FvdXQgXTsgdGhlbgogICAgICAgICAgICAgICAgbGli
  cHRoPSIvdXNyL2xpYi9hb3V0IC91c3IvbG9jYWwvbGliIC91c3IvbGliIgogICAgICAgICAgICAg
  ICAgZ2xpYnB0aD0iL3Vzci9saWIvYW91dCAvdXNyL2xvY2FsL2xpYiAvdXNyL2xpYiIKICAgICAg
  ICAgICAgZmkKICAgICAgICAgICAgbGRkbGZsYWdzPSctQnNoYXJlYWJsZScKICAgICAgICBlbHNl
  CiAgICAgICAgICAgIGxpYnB0aD0iL3Vzci9saWIgL3Vzci9sb2NhbC9saWIiCiAgICAgICAgICAg
  IGdsaWJwdGg9Ii91c3IvbGliIC91c3IvbG9jYWwvbGliIgogICAgICAgICAgICBsZGZsYWdzPSIt
  V2wsLUUgIgogICAgICAgICAgICBsZGRsZmxhZ3M9Ii1zaGFyZWQgIgogICAgICAgIGZpCiAgICAg
  ICAgY2NjZGxmbGFncz0nLURQSUMgLWZQSUMnCiAgICAgICAgOzsKKikKICAgICAgIGxpYnB0aD0i
  L3Vzci9saWIgL3Vzci9sb2NhbC9saWIiCiAgICAgICBnbGlicHRoPSIvdXNyL2xpYiAvdXNyL2xv
  Y2FsL2xpYiIKICAgICAgIGxkZmxhZ3M9Ii1XbCwtRSAiCiAgICAgICAgbGRkbGZsYWdzPSItc2hh
  cmVkICIKICAgICAgICBjY2NkbGZsYWdzPSctRFBJQyAtZlBJQycKICAgICAgIDs7CmVzYWMKCmNh
  c2UgIiRvc3ZlcnMiIGluCjAuKnwxLip8Mi4qfDMuKikgOzsKCiopCgljY2ZsYWdzPSIke2NjZmxh
  Z3N9IC1ESEFTX0ZQU0VUTUFTSyAtREhBU19GTE9BVElOR1BPSU5UX0giCglpZiAvdXNyL2Jpbi9m
  aWxlIC1MIC91c3IvbGliL2xpYmMuc28gfCAvdXNyL2Jpbi9ncmVwIC12cSAibm90IHN0cmlwcGVk
  IiA7IHRoZW4KCSAgICB1c2VubT1mYWxzZQoJZmkKICAgICAgICA7Owplc2FjCgpjYXQgPDwnRU9N
  JyA+JjQKClNvbWUgdXNlcnMgaGF2ZSByZXBvcnRlZCB0aGF0IENvbmZpZ3VyZSBoYWx0cyB3aGVu
  IHRlc3RpbmcgZm9yCnRoZSBPX05PTkJMT0NLIHN5bWJvbCB3aXRoIGEgc3ludGF4IGVycm9yLiAg
  VGhpcyBpcyBhcHBhcmVudGx5IGEKc2ggZXJyb3IuICBSZXJ1bm5pbmcgQ29uZmlndXJlIHdpdGgg
  a3NoIGFwcGFyZW50bHkgZml4ZXMgdGhlCnByb2JsZW0uICBUcnkKCWtzaCBDb25maWd1cmUgW3lv
  dXIgb3B0aW9uc10KCkVPTQoKIyBGcm9tOiBBbnRvbiBCZXJlemluIDx0b2JlekBwbGFiLmt1LmRr
  PgojIFRvOiBwZXJsNS1wb3J0ZXJzQHBlcmwub3JnCiMgU3ViamVjdDogW1BBVENIIDUuMDA1XzU0
  XSBDb25maWd1cmUgLSBoaW50cy9mcmVlYnNkLnNoIHNpZ25hbCBoYW5kbGVyIHR5cGUKIyBEYXRl
  OiAzMCBOb3YgMTk5OCAxOTo0NjoyNCArMDEwMAojIE1lc3NhZ2UtSUQ6IDw4NjRzcmhodmN2LmZz
  ZkBsaW9uLnBsYWIua3UuZGs+CgpzaWduYWxfdD0ndm9pZCcKZF92b2lkc2lnPSdkZWZpbmUnCgoj
  IHNldCBsaWJwZXJsLnNvLlguWCBmb3IgMi4yLlgKY2FzZSAiJG9zdmVycyIgaW4KMi4yKikKICAg
  ICMgdW5mb3J0dW5hdGVseSB0aGlzIGNvZGUgZ2V0cyBleGVjdXRlZCBiZWZvcmUKICAgICMgdGhl
  IGVxdWl2YWxlbnQgaW4gdGhlIG1haW4gQ29uZmlndXJlIHNvIHdlIGNvcHkgYSBsaXR0bGUKICAg
  ICMgZnJvbSBDb25maWd1cmUgWFhYIENvbmZpZ3VyZSBzaG91bGQgYmUgZml4ZWQuCiAgICBpZiAk
  dGVzdCAtciAkc3JjL3BhdGNobGV2ZWwuaDt0aGVuCiAgICAgICBwYXRjaGxldmVsPWBhd2sgJy9k
  ZWZpbmVbIAldK1BFUkxfVkVSU0lPTi8ge3ByaW50ICQzfScgJHNyYy9wYXRjaGxldmVsLmhgCiAg
  ICAgICBzdWJ2ZXJzaW9uPWBhd2sgJy9kZWZpbmVbIAldK1BFUkxfU1VCVkVSU0lPTi8ge3ByaW50
  ICQzfScgJHNyYy9wYXRjaGxldmVsLmhgCiAgICBlbHNlCiAgICAgICBwYXRjaGxldmVsPTAKICAg
  ICAgIHN1YnZlcnNpb249MAogICAgZmkKICAgIGxpYnBlcmw9ImxpYnBlcmwuc28uJHBhdGNobGV2
  ZWwuJHN1YnZlcnNpb24iCiAgICB1bnNldCBwYXRjaGxldmVsCiAgICB1bnNldCBzdWJ2ZXJzaW9u
  CiAgICA7Owplc2FjCgojIFRoaXMgc2NyaXB0IFVVL3VzZXRocmVhZHMuY2J1IHdpbGwgZ2V0ICdj
  YWxsZWQtYmFjaycgYnkgQ29uZmlndXJlIAojIGFmdGVyIGl0IGhhcyBwcm9tcHRlZCB0aGUgdXNl
  ciBmb3Igd2hldGhlciB0byB1c2UgdGhyZWFkcy4KY2F0ID4gVVUvdXNldGhyZWFkcy5jYnUgPDwn
  RU9DQlUnCmNhc2UgIiR1c2V0aHJlYWRzIiBpbgokZGVmaW5lfHRydWV8W3lZXSopCiAgICAgICAg
  bGNfcj1gL3NiaW4vbGRjb25maWcgLXJ8Z3JlcCAnOi1sY19yJ3xhd2sgJ3twcmludCAkTkZ9J3xz
  ZWQgLW4gJyRwJ2AKICAgICAgICBjYXNlICIkb3N2ZXJzIiBpbiAgCgkwLip8MS4qfDIuMCp8Mi4x
  KikgICBjYXQgPDxFT00gPiY0CkkgZGlkIG5vdCBrbm93IHRoYXQgRnJlZUJTRCAkb3N2ZXJzIHN1
  cHBvcnRzIFBPU0lYIHRocmVhZHMuCgpGZWVsIGZyZWUgdG8gdGVsbCBwZXJsYnVnQHBlcmwub3Jn
  IG90aGVyd2lzZS4KRU9NCgkgICAgICBleGl0IDEKCSAgICAgIDs7CgogICAgICAgIDIuMi5bMC03
  XSopCiAgICAgICAgICAgICAgY2F0IDw8RU9NID4mNApQT1NJWCB0aHJlYWRzIGFyZSBub3Qgc3Vw
  cG9ydGVkIHdlbGwgYnkgRnJlZUJTRCAkb3N2ZXJzLgoKUGxlYXNlIGNvbnNpZGVyIHVwZ3JhZGlu
  ZyB0byBhdCBsZWFzdCBGcmVlQlNEIDIuMi44LApvciBwcmVmZXJhYmx5IHRvIHRoZSBtb3N0IHJl
  Y2VudCAtUkVMRUFTRSBvciAtU1RBQkxFCnZlcnNpb24gKHNlZSBodHRwOi8vd3d3LmZyZWVic2Qu
  b3JnL3JlbGVhc2VzLykuCgooV2hpbGUgMi4yLjcgZG9lcyBoYXZlIHB0aHJlYWRzLCBpdCBoYXMg
  c29tZSBwcm9ibGVtcwogd2l0aCB0aGUgY29tYmluYXRpb24gb2YgdGhyZWFkcyBhbmQgcGlwZXMg
  YW5kIHRoZXJlZm9yZQogbWFueSBQZXJsIHRlc3RzIHdpbGwgZWl0aGVyIGhhbmcgb3IgZmFpbC4p
  CkVPTQoJICAgICAgZXhpdCAxCgkgICAgICA7OwoKCVszLTVdLiopCgkgICAgICBpZiBbICEgLXIg
  IiRsY19yIiBdOyB0aGVuCgkgICAgICBjYXQgPDxFT00gPiY0ClBPU0lYIHRocmVhZHMgc2hvdWxk
  IGJlIHN1cHBvcnRlZCBieSBGcmVlQlNEICRvc3ZlcnMgLS0KYnV0IHlvdXIgc3lzdGVtIGlzIG1p
  c3NpbmcgdGhlIHNoYXJlZCBsaWJjX3IuCigvc2Jpbi9sZGNvbmZpZyAtciBkb2Vzbid0IGZpbmQg
  YW55KS4KCkNvbnNpZGVyIHVzaW5nIHRoZSBsYXRlc3QgU1RBQkxFIHJlbGVhc2UuCkVPTQoJCSBl
  eGl0IDEKCSAgICAgIGZpCgkgICAgICAjIDUwMDAxNiBpcyB0aGUgZmlyc3Qgb3NyZWxkYXRlIGlu
  IHdoaWNoIG9uZSBjb3VsZAoJICAgICAgIyBqdXN0IGxpbmsgYWdhaW5zdCBsaWJjX3Igd2l0aG91
  dCBkaXNwb3Npbmcgb2YgbGliYwoJICAgICAgIyBhdCB0aGUgc2FtZSB0aW1lLiAgNTAwMDE2IC4u
  LiB1cCB0byB3aGF0ZXZlciBpdCB3YXMKCSAgICAgICMgb24gdGhlIDMxc3Qgb2YgQXVndXN0IDIw
  MDMgY2FuIHN0aWxsIGJlIHVzZWQgd2l0aCAtcHRocmVhZCwKCSAgICAgICMgYnV0IGl0IGlzIG5v
  dCBuZWNlc3NhcnkuCgoJICAgICAgIyBBbnRvbiBCZXJlemluIHNheXMgdGhhdCBwb3N0IDUwMHNv
  bWV0aGluZyB3ZSdyZSB3cm9uZyB0byBiZQoJICAgICAgIyB0byBiZSB1c2luZyAtbGNfciwgYW5k
  IHNob3VsZCBqdXN0IGJlIHVzaW5nIC1wdGhyZWFkIG9uIHRoZQoJICAgICAgIyBsaW5rZXIgbGlu
  ZS4KCSAgICAgICMgU28gcHJlc3VtYWJseSByZWFsbHkgd2Ugc2hvdWxkIGJlIGNoZWNraW5nIHRo
  YXQgJG9zdmVyIGlzIDUuKikKCSAgICAgICMgYW5kIHRoYXQgYC9zYmluL3N5c2N0bCAtbiBrZXJu
  Lm9zcmVsZGF0ZWAgLWdlIDUwMDAxNgoJICAgICAgIyBvciAtbHQgNTAwc29tZXRoaW5nIGFuZCBv
  bmx5IGluIHRoYXQgcmFuZ2Ugbm90IGRvaW5nIHRoaXM6CgkgICAgICBsZGZsYWdzPSItcHRocmVh
  ZCAkbGRmbGFncyIKCgkgICAgICAjIEJvdGggaW4gNC54IGFuZCA1LnggZ2V0aG9zdGJ5YWRkcl9y
  IGV4aXN0cyBidXQKCSAgICAgICMgaXQgaXMgIlRlbXBvcmFyeSBmdW5jdGlvbiwgbm90IHRocmVh
  ZHNhZmUiLi4uCgkgICAgICAjIFByZXN1bWFibHkgZWFybGllciBpdCBkaWRuJ3QgZXZlbiBleGlz
  dC4KCSAgICAgIGRfZ2V0aG9zdGJ5YWRkcl9yPSJ1bmRlZiIKCSAgICAgIGRfZ2V0aG9zdGJ5YWRk
  cl9yX3Byb3RvPSIwIgoJICAgICAgOzsKCgkqKQoJICAgICAgIyA3LnggZG9lc24ndCBpbnN0YWxs
  IGxpYmNfciBieSBkZWZhdWx0LCBhbmQgQ29uZmlndXJlCgkgICAgICAjIHdvdWxkIGZhaWwgaW4g
  dGhlIGNvZGUgZm9sbG93aW5nCgkgICAgICAjCgkgICAgICAjIGdldGhvc3RieWFkZHJfcigpIGFw
  cGVhcnMgdG8gaGF2ZSBiZWVuIGltcGxlbWVudGVkIGluIDYueCsKCSAgICAgIGxkZmxhZ3M9Ii1w
  dGhyZWFkICRsZGZsYWdzIgoJICAgICAgOzsKCgllc2FjCgogICAgICAgIGNhc2UgIiRvc3ZlcnMi
  IGluCiAgICAgICAgWzEtNF0qKQoJICAgIHNldCBgZWNobyBYICIkbGlic3dhbnRlZCAifCBzZWQg
  LWUgJ3MvIGMgLyBjX3IgLydgCgkgICAgc2hpZnQKCSAgICBsaWJzd2FudGVkPSIkKiIKCSAgICA7
  OwogICAgICAgICopCgkgICAgc2V0IGBlY2hvIFggIiRsaWJzd2FudGVkICJ8IHNlZCAtZSAncy8g
  YyAvLydgCgkgICAgc2hpZnQKCSAgICBsaWJzd2FudGVkPSIkKiIKCSAgICA7OwoJZXNhYwoJICAg
  IAoJIyBDb25maWd1cmUgd2lsbCBwcm9iYWJseSBwaWNrIHRoZSB3cm9uZyBsaWJjIHRvIHVzZSBm
  b3Igbm0gc2Nhbi4KCSMgVGhlIHNhZmVzdCBxdWljay1maXggaXMganVzdCB0byBub3QgdXNlIG5t
  IGF0IGFsbC4uLgoJdXNlbm09ZmFsc2UKCiAgICAgICAgY2FzZSAiJG9zdmVycyIgaW4KICAgICAg
  ICAyLjIuOCopCiAgICAgICAgICAgICMgLi4uIGJ1dCB0aGlzIGRvZXMgbm90IGFwcGx5IGZvciAy
  LjIuOCAtIHdlIGtub3cgaXQncyBzYWZlCiAgICAgICAgICAgIGxpYmM9IiRsY19yIgogICAgICAg
  ICAgICB1c2VubT10cnVlCiAgICAgICAgICAgOzsKICAgICAgICBlc2FjCgogICAgICAgIHVuc2V0
  IGxjX3IKCgkjIEV2ZW4gd2l0aCB0aGUgbWFsbG9jIG11dGV4ZXMgdGhlIFBlcmwgbWFsbG9jIGRv
  ZXMgbm90CgkjIHNlZW0gdG8gYmUgdGhyZWFkc2FmZSBpbiBGcmVlQlNEPwoJY2FzZSAiJHVzZW15
  bWFsbG9jIiBpbgoJJycpIHVzZW15bWFsbG9jPW4gOzsKCWVzYWMKZXNhYwpFT0NCVQoKIyBtYWxs
  b2Mgd3JhcCB3b3JrcwpjYXNlICIkdXNlbWFsbG9jd3JhcCIgaW4KJycpIHVzZW1hbGxvY3dyYXA9
  J2RlZmluZScgOzsKZXNhYwoKIyBYWFggVW5kZXIgRnJlZUJTRCA2LjAgKGFuZCBwcm9iYWJseSBt
  b3N0IG90aGVyIHNpbWlsYXIgdmVyc2lvbnMpCiMgUGVybF9kaWUoTlVMTCkgZ2VuZXJhdGVzIGEg
  d2FybmluZzoKIyAgICBwcF9zeXMuYzo0OTE6IHdhcm5pbmc6IG51bGwgZm9ybWF0IHN0cmluZwoj
  IENvbmZpZ3VyZSBzdXBwb3NlZGVseSB0ZXN0cyBmb3IgdGhpcywgYnV0IGFwcGFyZW50bHkgdGhl
  IHRlc3QgZG9lc24ndAojIHdvcmsuICBWb2x1bnRlZXJzIHdpdGggRnJlZUJTRCBhcmUgbmVlZGVk
  IHRvIGltcHJvdmluZyB0aGUgQ29uZmlndXJlIHRlc3QuCiMgTWVhbndoaWxlLCB0aGUgZm9sbG93
  aW5nIHdvcmthcm91bmQgc2hvdWxkIGJlIHNhZmUgb24gYWxsIHZlcnNpb25zCiMgb2YgRnJlZUJT
  RC4KZF9wcmludGZfZm9ybWF0X251bGw9J3VuZGVmJwo=',
  );
  
  my %files = (
    'freebsd' => 'freebsd.sh',
    'netbsd'  => 'netbsd.sh',
    'openbsd' => 'openbsd.sh',
    'linux'   => 'linux.sh',
    'dragonfly' => 'dragonfly.sh',
    'darwin' => 'darwin.sh',
    'hpux' => 'hpux.sh',
    'cygwin' => 'cygwin.sh',
  );
  
  sub hint_file {
    my $os = shift;
    $os = shift if eval { $os->isa(__PACKAGE__) };
    $os = $^O unless $os;
    return unless defined $hints{ $os };
    my $content = decode_base64( $hints{ $os } );
    return $content unless wantarray;
    return ( $files{ $os }, $content );
  }
  
  qq'nudge nudge wink wink';
  
  
  __END__
  =pod
  
  =head1 NAME
  
  Devel::PatchPerl::Hints - replacement 'hints' files
  
  =head1 VERSION
  
  version 0.76
  
  =head1 SYNOPSIS
  
    use Devel::PatchPerl::Hints;
  
    if ( my $content = Devel::PatchPerl::Hints->hint_file() ) {
      chmod 0644, 'hints/netbsd.sh' or die "$!";
      open my $hints, '>', 'hints/netbsd.sh' or die "$!";
      print $hints $content;
      close $hints;
    }
  
  =head1 DESCRIPTION
  
  Sometimes there is a problem with Perls C<hints> file for a particular
  perl port. This module provides fixed C<hints> files encoded using
  C<MIME::Base64>.
  
  =head1 FUNCTION
  
  The function is exported, but has to implicitly imported into the
  requesting package.
  
    use Devel::PatchPerl::Hints qw[hint_file];
  
  It may also be called as a class method:
  
    use Devel::PatchPerl::Hints;
  
    my $content = Devel::PatchPerl::Hints->hint_file();
  
  =over
  
  =item C<hint_file>
  
  Takes an optional argument which is the OS name ( as would be returned by C<$^O> ).
  By default it will use C<$^O>.
  
  In a scalar context, Will return the decoded content of the C<hints> file suitable for writing straight to a
  file handle or undef list if there isn't an applicable C<hints> file for the given or derived
  OS.
  
  If called in a list context, will return a list, the first item will be the name of the C<hints> file that
  will need to be amended, the second item will be a string with the decoded content of the C<hints> file suitable
  for writing straight to a file handle. Otherwise an empty list will be returned.
  
  =back
  
  =head1 AUTHOR
  
  Chris Williams <chris@bingosnet.co.uk>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2012 by Chris Williams and Marcus Holland-Moritz.
  
  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
  
DEVEL_PATCHPERL_HINTS

$fatpacked{"Devel/PatchPerl/Plugin.pm"} = <<'DEVEL_PATCHPERL_PLUGIN';
  package Devel::PatchPerl::Plugin;
  {
    $Devel::PatchPerl::Plugin::VERSION = '0.76';
  }
  
  #ABSTRACT: Devel::PatchPerl plugins explained
  
  use strict;
  use warnings;
  
  qq[Plug it in];
  
  
  __END__
  =pod
  
  =head1 NAME
  
  Devel::PatchPerl::Plugin - Devel::PatchPerl plugins explained
  
  =head1 VERSION
  
  version 0.76
  
  =head1 DESCRIPTION
  
  This document explains the L<Devel::PatchPerl> plugin system.
  
  Plugins are a mechanism for providing additional functionality to
  L<Devel::PatchPerl>.
  
  Plugins are searched for in the L<Devel::PatchPerl::Plugin> namespace.
  
  =head1 INITIALISATION
  
  The plugin constructor is C<patchperl>.
  
  A plugin is specified using the C<PERL5_PATCHPERL_PLUGIN> environment
  variable. It may either be specified in full (ie. C<Devel::PatchPerl::Plugin::Feegle>)
  or as the short part (ie. C<Feegle>).
  
    $ export PERL5_PATCHPERL_PLUGIN=Devel::PatchPerl::Plugin::Feegle
  
    $ export PERL5_PATCHPERL_PLUGIN=Feegle
  
  When L<Devel::PatchPerl> has identified the perl source patch and done its patching
  it will attempt to load the plugin identified. It will then call the class method
  C<patchperl> for the plugin package, with the following parameters:
  
    'version', the Perl version of the source tree;
    'source', the absolute path to the Perl source tree;
    'patchexe', the 'patch' utility that can be used;
  
  Plugins are called with the current working directory being the root of the
  Perl source tree, ie. C<source>.
  
  Summarised:
  
    $ENV{PERL5_PATCHPERL_PLUGIN} = 'Devel::PatchPerl::Plugin::Feegle';
  
    my $plugin = $ENV{PERL5_PATCHPERL_PLUGIN};
  
    eval "require $plugin";
  
    eval {
      $plugin->patchperl( version => $vers, source => $srcdir, patchexe => $patch );
    };
  
  =head1 WHAT CAN PLUGINS DO?
  
  Anything you desire to a Perl source tree.
  
  =head1 WHY USE AN ENVIRONMENT VARIABLE TO SPECIFY PLUGINS?
  
  So that indicating a plugin to use can be specified independently of whatever mechanism is
  calling L<Devel::PatchPerl> to do its bidding.
  
  Think L<perlbrew>.
  
  =head1 AUTHOR
  
  Chris Williams <chris@bingosnet.co.uk>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2012 by Chris Williams and Marcus Holland-Moritz.
  
  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
  
DEVEL_PATCHPERL_PLUGIN

$fatpacked{"Exporter.pm"} = <<'EXPORTER';
  package Exporter;
  
  require 5.006;
  
  # Be lean.
  #use strict;
  #no strict 'refs';
  
  our $Debug = 0;
  our $ExportLevel = 0;
  our $Verbose ||= 0;
  our $VERSION = '5.67';
  our (%Cache);
  
  sub as_heavy {
    require Exporter::Heavy;
    # Unfortunately, this does not work if the caller is aliased as *name = \&foo
    # Thus the need to create a lot of identical subroutines
    my $c = (caller(1))[3];
    $c =~ s/.*:://;
    \&{"Exporter::Heavy::heavy_$c"};
  }
  
  sub export {
    goto &{as_heavy()};
  }
  
  sub import {
    my $pkg = shift;
    my $callpkg = caller($ExportLevel);
  
    if ($pkg eq "Exporter" and @_ and $_[0] eq "import") {
      *{$callpkg."::import"} = \&import;
      return;
    }
  
    # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
    my $exports = \@{"$pkg\::EXPORT"};
    # But, avoid creating things if they don't exist, which saves a couple of
    # hundred bytes per package processed.
    my $fail = ${$pkg . '::'}{EXPORT_FAIL} && \@{"$pkg\::EXPORT_FAIL"};
    return export $pkg, $callpkg, @_
      if $Verbose or $Debug or $fail && @$fail > 1;
    my $export_cache = ($Cache{$pkg} ||= {});
    my $args = @_ or @_ = @$exports;
  
    if ($args and not %$export_cache) {
      s/^&//, $export_cache->{$_} = 1
        foreach (@$exports, @{"$pkg\::EXPORT_OK"});
    }
    my $heavy;
    # Try very hard not to use {} and hence have to  enter scope on the foreach
    # We bomb out of the loop with last as soon as heavy is set.
    if ($args or $fail) {
      ($heavy = (/\W/ or $args and not exists $export_cache->{$_}
                 or $fail and @$fail and $_ eq $fail->[0])) and last
                   foreach (@_);
    } else {
      ($heavy = /\W/) and last
        foreach (@_);
    }
    return export $pkg, $callpkg, ($args ? @_ : ()) if $heavy;
    local $SIG{__WARN__} = 
  	sub {require Carp; &Carp::carp} if not $SIG{__WARN__};
    # shortcut for the common case of no type character
    *{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_;
  }
  
  # Default methods
  
  sub export_fail {
      my $self = shift;
      @_;
  }
  
  # Unfortunately, caller(1)[3] "does not work" if the caller is aliased as
  # *name = \&foo.  Thus the need to create a lot of identical subroutines
  # Otherwise we could have aliased them to export().
  
  sub export_to_level {
    goto &{as_heavy()};
  }
  
  sub export_tags {
    goto &{as_heavy()};
  }
  
  sub export_ok_tags {
    goto &{as_heavy()};
  }
  
  sub require_version {
    goto &{as_heavy()};
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Exporter - Implements default import method for modules
  
  =head1 SYNOPSIS
  
  In module F<YourModule.pm>:
  
    package YourModule;
    require Exporter;
    @ISA = qw(Exporter);
    @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
  
  or
  
    package YourModule;
    use Exporter 'import'; # gives you Exporter's import() method directly
    @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
  
  In other files which wish to use C<YourModule>:
  
    use YourModule qw(frobnicate);      # import listed symbols
    frobnicate ($left, $right)          # calls YourModule::frobnicate
  
  Take a look at L</Good Practices> for some variants
  you will like to use in modern Perl code.
  
  =head1 DESCRIPTION
  
  The Exporter module implements an C<import> method which allows a module
  to export functions and variables to its users' namespaces.  Many modules
  use Exporter rather than implementing their own C<import> method because
  Exporter provides a highly flexible interface, with an implementation optimised
  for the common case.
  
  Perl automatically calls the C<import> method when processing a
  C<use> statement for a module.  Modules and C<use> are documented
  in L<perlfunc> and L<perlmod>.  Understanding the concept of
  modules and how the C<use> statement operates is important to
  understanding the Exporter.
  
  =head2 How to Export
  
  The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of
  symbols that are going to be exported into the users name space by
  default, or which they can request to be exported, respectively.  The
  symbols can represent functions, scalars, arrays, hashes, or typeglobs.
  The symbols must be given by full name with the exception that the
  ampersand in front of a function is optional, e.g.
  
      @EXPORT    = qw(afunc $scalar @array);   # afunc is a function
      @EXPORT_OK = qw(&bfunc %hash *typeglob); # explicit prefix on &bfunc
  
  If you are only exporting function names it is recommended to omit the
  ampersand, as the implementation is faster this way.
  
  =head2 Selecting What to Export
  
  Do B<not> export method names!
  
  Do B<not> export anything else by default without a good reason!
  
  Exports pollute the namespace of the module user.  If you must export
  try to use C<@EXPORT_OK> in preference to C<@EXPORT> and avoid short or
  common symbol names to reduce the risk of name clashes.
  
  Generally anything not exported is still accessible from outside the
  module using the C<YourModule::item_name> (or C<< $blessed_ref->method >>)
  syntax.  By convention you can use a leading underscore on names to
  informally indicate that they are 'internal' and not for public use.
  
  (It is actually possible to get private functions by saying:
  
    my $subref = sub { ... };
    $subref->(@args);            # Call it as a function
    $obj->$subref(@args);        # Use it as a method
  
  However if you use them for methods it is up to you to figure out
  how to make inheritance work.)
  
  As a general rule, if the module is trying to be object oriented
  then export nothing.  If it's just a collection of functions then
  C<@EXPORT_OK> anything but use C<@EXPORT> with caution.  For function and
  method names use barewords in preference to names prefixed with
  ampersands for the export lists.
  
  Other module design guidelines can be found in L<perlmod>.
  
  =head2 How to Import
  
  In other files which wish to use your module there are three basic ways for
  them to load your module and import its symbols:
  
  =over 4
  
  =item C<use YourModule;>
  
  This imports all the symbols from YourModule's C<@EXPORT> into the namespace
  of the C<use> statement.
  
  =item C<use YourModule ();>
  
  This causes perl to load your module but does not import any symbols.
  
  =item C<use YourModule qw(...);>
  
  This imports only the symbols listed by the caller into their namespace.
  All listed symbols must be in your C<@EXPORT> or C<@EXPORT_OK>, else an error
  occurs.  The advanced export features of Exporter are accessed like this,
  but with list entries that are syntactically distinct from symbol names.
  
  =back
  
  Unless you want to use its advanced features, this is probably all you
  need to know to use Exporter.
  
  =head1 Advanced Features
  
  =head2 Specialised Import Lists
  
  If any of the entries in an import list begins with !, : or / then
  the list is treated as a series of specifications which either add to
  or delete from the list of names to import.  They are processed left to
  right. Specifications are in the form:
  
      [!]name         This name only
      [!]:DEFAULT     All names in @EXPORT
      [!]:tag         All names in $EXPORT_TAGS{tag} anonymous list
      [!]/pattern/    All names in @EXPORT and @EXPORT_OK which match
  
  A leading ! indicates that matching names should be deleted from the
  list of names to import.  If the first specification is a deletion it
  is treated as though preceded by :DEFAULT.  If you just want to import
  extra names in addition to the default set you will still need to
  include :DEFAULT explicitly.
  
  e.g., F<Module.pm> defines:
  
      @EXPORT      = qw(A1 A2 A3 A4 A5);
      @EXPORT_OK   = qw(B1 B2 B3 B4 B5);
      %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
  
  Note that you cannot use tags in @EXPORT or @EXPORT_OK.
  
  Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
  
  An application using Module can say something like:
  
      use Module qw(:DEFAULT :T2 !B3 A3);
  
  Other examples include:
  
      use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
      use POSIX  qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
  
  Remember that most patterns (using //) will need to be anchored
  with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
  
  You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
  specifications are being processed and what is actually being imported
  into modules.
  
  =head2 Exporting Without Using Exporter's import Method
  
  Exporter has a special method, 'export_to_level' which is used in situations
  where you can't directly call Exporter's
  import method.  The export_to_level
  method looks like:
  
      MyPackage->export_to_level(
  	$where_to_export, $package, @what_to_export
      );
  
  where C<$where_to_export> is an integer telling how far up the calling stack
  to export your symbols, and C<@what_to_export> is an array telling what
  symbols *to* export (usually this is C<@_>).  The C<$package> argument is
  currently unused.
  
  For example, suppose that you have a module, A, which already has an
  import function:
  
      package A;
  
      @ISA = qw(Exporter);
      @EXPORT_OK = qw ($b);
  
      sub import
      {
  	$A::b = 1;     # not a very useful import method
      }
  
  and you want to Export symbol C<$A::b> back to the module that called 
  package A.  Since Exporter relies on the import method to work, via 
  inheritance, as it stands Exporter::import() will never get called. 
  Instead, say the following:
  
      package A;
      @ISA = qw(Exporter);
      @EXPORT_OK = qw ($b);
  
      sub import
      {
  	$A::b = 1;
  	A->export_to_level(1, @_);
      }
  
  This will export the symbols one level 'above' the current package - ie: to 
  the program or module that used package A. 
  
  Note: Be careful not to modify C<@_> at all before you call export_to_level
  - or people using your package will get very unexplained results!
  
  =head2 Exporting Without Inheriting from Exporter
  
  By including Exporter in your C<@ISA> you inherit an Exporter's import() method
  but you also inherit several other helper methods which you probably don't
  want.  To avoid this you can do
  
    package YourModule;
    use Exporter qw( import );
  
  which will export Exporter's own import() method into YourModule.
  Everything will work as before but you won't need to include Exporter in
  C<@YourModule::ISA>.
  
  Note: This feature was introduced in version 5.57
  of Exporter, released with perl 5.8.3.
  
  =head2 Module Version Checking
  
  The Exporter module will convert an attempt to import a number from a
  module into a call to C<< $module_name->VERSION($value) >>.  This can
  be used to validate that the version of the module being used is
  greater than or equal to the required version.
  
  For historical reasons, Exporter supplies a C<require_version> method that
  simply delegates to C<VERSION>.  Originally, before C<UNIVERSAL::VERSION>
  existed, Exporter would call C<require_version>.
  
  Since the C<UNIVERSAL::VERSION> method treats the C<$VERSION> number as
  a simple numeric value it will regard version 1.10 as lower than
  1.9.  For this reason it is strongly recommended that you use numbers
  with at least two decimal places, e.g., 1.09.
  
  =head2 Managing Unknown Symbols
  
  In some situations you may want to prevent certain symbols from being
  exported.  Typically this applies to extensions which have functions
  or constants that may not exist on some systems.
  
  The names of any symbols that cannot be exported should be listed
  in the C<@EXPORT_FAIL> array.
  
  If a module attempts to import any of these symbols the Exporter
  will give the module an opportunity to handle the situation before
  generating an error.  The Exporter will call an export_fail method
  with a list of the failed symbols:
  
    @failed_symbols = $module_name->export_fail(@failed_symbols);
  
  If the C<export_fail> method returns an empty list then no error is
  recorded and all the requested symbols are exported.  If the returned
  list is not empty then an error is generated for each symbol and the
  export fails.  The Exporter provides a default C<export_fail> method which
  simply returns the list unchanged.
  
  Uses for the C<export_fail> method include giving better error messages
  for some symbols and performing lazy architectural checks (put more
  symbols into C<@EXPORT_FAIL> by default and then take them out if someone
  actually tries to use them and an expensive check shows that they are
  usable on that platform).
  
  =head2 Tag Handling Utility Functions
  
  Since the symbols listed within C<%EXPORT_TAGS> must also appear in either
  C<@EXPORT> or C<@EXPORT_OK>, two utility functions are provided which allow
  you to easily add tagged sets of symbols to C<@EXPORT> or C<@EXPORT_OK>:
  
    %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
  
    Exporter::export_tags('foo');     # add aa, bb and cc to @EXPORT
    Exporter::export_ok_tags('bar');  # add aa, cc and dd to @EXPORT_OK
  
  Any names which are not tags are added to C<@EXPORT> or C<@EXPORT_OK>
  unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
  names being silently added to C<@EXPORT> or C<@EXPORT_OK>.  Future versions
  may make this a fatal error.
  
  =head2 Generating Combined Tags
  
  If several symbol categories exist in C<%EXPORT_TAGS>, it's usually
  useful to create the utility ":all" to simplify "use" statements.
  
  The simplest way to do this is:
  
    %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
  
    # add all the other ":class" tags to the ":all" class,
    # deleting duplicates
    {
      my %seen;
  
      push @{$EXPORT_TAGS{all}},
        grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
    }
  
  F<CGI.pm> creates an ":all" tag which contains some (but not really
  all) of its categories.  That could be done with one small
  change:
  
    # add some of the other ":class" tags to the ":all" class,
    # deleting duplicates
    {
      my %seen;
  
      push @{$EXPORT_TAGS{all}},
        grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}}
          foreach qw/html2 html3 netscape form cgi internal/;
    }
  
  Note that the tag names in C<%EXPORT_TAGS> don't have the leading ':'.
  
  =head2 C<AUTOLOAD>ed Constants
  
  Many modules make use of C<AUTOLOAD>ing for constant subroutines to
  avoid having to compile and waste memory on rarely used values (see
  L<perlsub> for details on constant subroutines).  Calls to such
  constant subroutines are not optimized away at compile time because
  they can't be checked at compile time for constancy.
  
  Even if a prototype is available at compile time, the body of the
  subroutine is not (it hasn't been C<AUTOLOAD>ed yet).  perl needs to
  examine both the C<()> prototype and the body of a subroutine at
  compile time to detect that it can safely replace calls to that
  subroutine with the constant value.
  
  A workaround for this is to call the constants once in a C<BEGIN> block:
  
     package My ;
  
     use Socket ;
  
     foo( SO_LINGER );  ## SO_LINGER NOT optimized away; called at runtime
     BEGIN { SO_LINGER }
     foo( SO_LINGER );  ## SO_LINGER optimized away at compile time.
  
  This forces the C<AUTOLOAD> for C<SO_LINGER> to take place before
  SO_LINGER is encountered later in C<My> package.
  
  If you are writing a package that C<AUTOLOAD>s, consider forcing
  an C<AUTOLOAD> for any constants explicitly imported by other packages
  or which are usually used when your package is C<use>d.
  
  =head1 Good Practices
  
  =head2 Declaring C<@EXPORT_OK> and Friends
  
  When using C<Exporter> with the standard C<strict> and C<warnings>
  pragmas, the C<our> keyword is needed to declare the package
  variables C<@EXPORT_OK>, C<@EXPORT>, C<@ISA>, etc.
  
    our @ISA = qw(Exporter);
    our @EXPORT_OK = qw(munge frobnicate);
  
  If backward compatibility for Perls under 5.6 is important,
  one must write instead a C<use vars> statement.
  
    use vars qw(@ISA @EXPORT_OK);
    @ISA = qw(Exporter);
    @EXPORT_OK = qw(munge frobnicate);
  
  =head2 Playing Safe
  
  There are some caveats with the use of runtime statements
  like C<require Exporter> and the assignment to package
  variables, which can very subtle for the unaware programmer.
  This may happen for instance with mutually recursive
  modules, which are affected by the time the relevant
  constructions are executed.
  
  The ideal (but a bit ugly) way to never have to think
  about that is to use C<BEGIN> blocks.  So the first part
  of the L</SYNOPSIS> code could be rewritten as:
  
    package YourModule;
  
    use strict;
    use warnings;
  
    our (@ISA, @EXPORT_OK);
    BEGIN {
       require Exporter;
       @ISA = qw(Exporter);
       @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
    }
  
  The C<BEGIN> will assure that the loading of F<Exporter.pm>
  and the assignments to C<@ISA> and C<@EXPORT_OK> happen
  immediately, leaving no room for something to get awry
  or just plain wrong.
  
  With respect to loading C<Exporter> and inheriting, there
  are alternatives with the use of modules like C<base> and C<parent>.
  
    use base qw( Exporter );
    # or
    use parent qw( Exporter );
  
  Any of these statements are nice replacements for
  C<BEGIN { require Exporter; @ISA = qw(Exporter); }>
  with the same compile-time effect.  The basic difference
  is that C<base> code interacts with declared C<fields>
  while C<parent> is a streamlined version of the older
  C<base> code to just establish the IS-A relationship.
  
  For more details, see the documentation and code of
  L<base> and L<parent>.
  
  Another thorough remedy to that runtime
  vs. compile-time trap is to use L<Exporter::Easy>,
  which is a wrapper of Exporter that allows all
  boilerplate code at a single gulp in the
  use statement.
  
     use Exporter::Easy (
         OK => [ qw(munge frobnicate) ],
     );
     # @ISA setup is automatic
     # all assignments happen at compile time
  
  =head2 What Not to Export
  
  You have been warned already in L</Selecting What to Export>
  to not export:
  
  =over 4
  
  =item *
  
  method names (because you don't need to
  and that's likely to not do what you want),
  
  =item *
  
  anything by default (because you don't want to surprise your users...
  badly)
  
  =item *
  
  anything you don't need to (because less is more)
  
  =back
  
  There's one more item to add to this list.  Do B<not>
  export variable names.  Just because C<Exporter> lets you
  do that, it does not mean you should.
  
    @EXPORT_OK = qw( $svar @avar %hvar ); # DON'T!
  
  Exporting variables is not a good idea.  They can
  change under the hood, provoking horrible
  effects at-a-distance, that are too hard to track
  and to fix.  Trust me: they are not worth it.
  
  To provide the capability to set/get class-wide
  settings, it is best instead to provide accessors
  as subroutines or class methods instead.
  
  =head1 SEE ALSO
  
  C<Exporter> is definitely not the only module with
  symbol exporter capabilities.  At CPAN, you may find
  a bunch of them.  Some are lighter.  Some
  provide improved APIs and features.  Peek the one
  that fits your needs.  The following is
  a sample list of such modules.
  
      Exporter::Easy
      Exporter::Lite
      Exporter::Renaming
      Exporter::Tidy
      Sub::Exporter / Sub::Installer
      Perl6::Export / Perl6::Export::Attrs
  
  =head1 LICENSE
  
  This library is free software.  You can redistribute it
  and/or modify it under the same terms as Perl itself.
  
  =cut
  
  
  
EXPORTER

$fatpacked{"Exporter/Heavy.pm"} = <<'EXPORTER_HEAVY';
  package Exporter::Heavy;
  
  use strict;
  no strict 'refs';
  
  # On one line so MakeMaker will see it.
  require Exporter;  our $VERSION = $Exporter::VERSION;
  
  =head1 NAME
  
  Exporter::Heavy - Exporter guts
  
  =head1 SYNOPSIS
  
  (internal use only)
  
  =head1 DESCRIPTION
  
  No user-serviceable parts inside.
  
  =cut
  
  #
  # We go to a lot of trouble not to 'require Carp' at file scope,
  #  because Carp requires Exporter, and something has to give.
  #
  
  sub _rebuild_cache {
      my ($pkg, $exports, $cache) = @_;
      s/^&// foreach @$exports;
      @{$cache}{@$exports} = (1) x @$exports;
      my $ok = \@{"${pkg}::EXPORT_OK"};
      if (@$ok) {
  	s/^&// foreach @$ok;
  	@{$cache}{@$ok} = (1) x @$ok;
      }
  }
  
  sub heavy_export {
  
      # First make import warnings look like they're coming from the "use".
      local $SIG{__WARN__} = sub {
  	my $text = shift;
  	if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//) {
  	    require Carp;
  	    local $Carp::CarpLevel = 1;	# ignore package calling us too.
  	    Carp::carp($text);
  	}
  	else {
  	    warn $text;
  	}
      };
      local $SIG{__DIE__} = sub {
  	require Carp;
  	local $Carp::CarpLevel = 1;	# ignore package calling us too.
  	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
  	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
      };
  
      my($pkg, $callpkg, @imports) = @_;
      my($type, $sym, $cache_is_current, $oops);
      my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
                                     $Exporter::Cache{$pkg} ||= {});
  
      if (@imports) {
  	if (!%$export_cache) {
  	    _rebuild_cache ($pkg, $exports, $export_cache);
  	    $cache_is_current = 1;
  	}
  
  	if (grep m{^[/!:]}, @imports) {
  	    my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
  	    my $tagdata;
  	    my %imports;
  	    my($remove, $spec, @names, @allexports);
  	    # negated first item implies starting with default set:
  	    unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
  	    foreach $spec (@imports){
  		$remove = $spec =~ s/^!//;
  
  		if ($spec =~ s/^://){
  		    if ($spec eq 'DEFAULT'){
  			@names = @$exports;
  		    }
  		    elsif ($tagdata = $tagsref->{$spec}) {
  			@names = @$tagdata;
  		    }
  		    else {
  			warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
  			++$oops;
  			next;
  		    }
  		}
  		elsif ($spec =~ m:^/(.*)/$:){
  		    my $patn = $1;
  		    @allexports = keys %$export_cache unless @allexports; # only do keys once
  		    @names = grep(/$patn/, @allexports); # not anchored by default
  		}
  		else {
  		    @names = ($spec); # is a normal symbol name
  		}
  
  		warn "Import ".($remove ? "del":"add").": @names "
  		    if $Exporter::Verbose;
  
  		if ($remove) {
  		   foreach $sym (@names) { delete $imports{$sym} } 
  		}
  		else {
  		    @imports{@names} = (1) x @names;
  		}
  	    }
  	    @imports = keys %imports;
  	}
  
          my @carp;
  	foreach $sym (@imports) {
  	    if (!$export_cache->{$sym}) {
  		if ($sym =~ m/^\d/) {
  		    $pkg->VERSION($sym); # inherit from UNIVERSAL
  		    # If the version number was the only thing specified
  		    # then we should act as if nothing was specified:
  		    if (@imports == 1) {
  			@imports = @$exports;
  			last;
  		    }
  		    # We need a way to emulate 'use Foo ()' but still
  		    # allow an easy version check: "use Foo 1.23, ''";
  		    if (@imports == 2 and !$imports[1]) {
  			@imports = ();
  			last;
  		    }
  		} elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
  		    # Last chance - see if they've updated EXPORT_OK since we
  		    # cached it.
  
  		    unless ($cache_is_current) {
  			%$export_cache = ();
  			_rebuild_cache ($pkg, $exports, $export_cache);
  			$cache_is_current = 1;
  		    }
  
  		    if (!$export_cache->{$sym}) {
  			# accumulate the non-exports
  			push @carp,
  			  qq["$sym" is not exported by the $pkg module\n];
  			$oops++;
  		    }
  		}
  	    }
  	}
  	if ($oops) {
  	    require Carp;
  	    Carp::croak("@{carp}Can't continue after import errors");
  	}
      }
      else {
  	@imports = @$exports;
      }
  
      my($fail, $fail_cache) = (\@{"${pkg}::EXPORT_FAIL"},
                                $Exporter::FailCache{$pkg} ||= {});
  
      if (@$fail) {
  	if (!%$fail_cache) {
  	    # Build cache of symbols. Optimise the lookup by adding
  	    # barewords twice... both with and without a leading &.
  	    # (Technique could be applied to $export_cache at cost of memory)
  	    my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @$fail;
  	    warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter::Verbose;
  	    @{$fail_cache}{@expanded} = (1) x @expanded;
  	}
  	my @failed;
  	foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->{$sym} }
  	if (@failed) {
  	    @failed = $pkg->export_fail(@failed);
  	    foreach $sym (@failed) {
                  require Carp;
  		Carp::carp(qq["$sym" is not implemented by the $pkg module ],
  			"on this architecture");
  	    }
  	    if (@failed) {
  		require Carp;
  		Carp::croak("Can't continue after import errors");
  	    }
  	}
      }
  
      warn "Importing into $callpkg from $pkg: ",
  		join(", ",sort @imports) if $Exporter::Verbose;
  
      foreach $sym (@imports) {
  	# shortcut for the common case of no type character
  	(*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
  	    unless $sym =~ s/^(\W)//;
  	$type = $1;
  	no warnings 'once';
  	*{"${callpkg}::$sym"} =
  	    $type eq '&' ? \&{"${pkg}::$sym"} :
  	    $type eq '$' ? \${"${pkg}::$sym"} :
  	    $type eq '@' ? \@{"${pkg}::$sym"} :
  	    $type eq '%' ? \%{"${pkg}::$sym"} :
  	    $type eq '*' ?  *{"${pkg}::$sym"} :
  	    do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
      }
  }
  
  sub heavy_export_to_level
  {
        my $pkg = shift;
        my $level = shift;
        (undef) = shift;			# XXX redundant arg
        my $callpkg = caller($level);
        $pkg->export($callpkg, @_);
  }
  
  # Utility functions
  
  sub _push_tags {
      my($pkg, $var, $syms) = @_;
      my @nontag = ();
      my $export_tags = \%{"${pkg}::EXPORT_TAGS"};
      push(@{"${pkg}::$var"},
  	map { $export_tags->{$_} ? @{$export_tags->{$_}} 
                                   : scalar(push(@nontag,$_),$_) }
  		(@$syms) ? @$syms : keys %$export_tags);
      if (@nontag and $^W) {
  	# This may change to a die one day
  	require Carp;
  	Carp::carp(join(", ", @nontag)." are not tags of $pkg");
      }
  }
  
  sub heavy_require_version {
      my($self, $wanted) = @_;
      my $pkg = ref $self || $self;
      return ${pkg}->VERSION($wanted);
  }
  
  sub heavy_export_tags {
    _push_tags((caller)[0], "EXPORT",    \@_);
  }
  
  sub heavy_export_ok_tags {
    _push_tags((caller)[0], "EXPORT_OK", \@_);
  }
  
  1;
EXPORTER_HEAVY

$fatpacked{"ExtUtils/Command.pm"} = <<'EXTUTILS_COMMAND';
  package ExtUtils::Command;
  
  use 5.00503;
  use strict;
  use Carp;
  use File::Copy;
  use File::Compare;
  use File::Basename;
  use File::Path qw(rmtree);
  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 = '1.16';
  
  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__}; 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();
   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);
  
          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;
  
      croak("Too many arguments") if (@src > 1 && ! -d $dst);
  
      my $nok = 0;
      foreach my $src (@src) {
          $nok ||= !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;
  
      croak("Too many arguments") if (@src > 1 && ! -d $dst);
  
      my $nok = 0;
      foreach my $src (@src) {
          $nok ||= !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) {
          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();
   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 };
          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"} = <<'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);
  our $VERSION = '6.64';
  
  my $Is_VMS = $^O eq 'VMS';
  
  
  =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 undef;
          }
      }
      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'
      );
  
      # 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};
  
      do {{  # so 'next' works
          my ($pod, $man) = splice(@ARGV, 0, 2);
  
          next if ((-e $man) &&
                   (-M $man < -M $pod) &&
                   (-M $man < -M "Makefile"));
  
          print "Manifying $man\n";
  
          my $parser = Pod::Man->new(%options);
          $parser->parse_from_file($pod, $man)
            or do { warn("Could not install $man\n");  next };
  
          if (exists $options{perm_rw}) {
              chmod(oct($options{perm_rw}), $man)
                or do { warn("chmod $options{perm_rw} $man: $!\n"); next };
          }
      }} while @ARGV;
  
      return 1;
  }
  
  
  =item B<warn_if_old_packlist>
  
    perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile>
  
  Displays a warning that an old packlist file was found.  Reads the
  filename from @ARGV.
  
  =cut
  
  sub warn_if_old_packlist {
      my $packlist = $ARGV[0];
  
      return unless -f $packlist;
      print <<"PACKLIST_WARNING";
  WARNING: I have found an old package in
      $packlist.
  Please make sure the two installations are not conflicting
  PACKLIST_WARNING
  
  }
  
  
  =item B<perllocal_install>
  
      perl "-MExtUtils::Command::MM" -e perllocal_install 
          <type> <module name> <key> <value> ...
  
      # VMS only, key|value pairs come on STDIN
      perl "-MExtUtils::Command::MM" -e perllocal_install
          <type> <module name> < <key>|<value> ...
  
  Prints a fragment of POD suitable for appending to perllocal.pod.
  Arguments are read from @ARGV.
  
  'type' is the type of what you're installing.  Usually 'Module'.
  
  'module name' is simply the name of your module.  (Foo::Bar)
  
  Key/value pairs are extra information about the module.  Fields include:
  
      installed into      which directory your module was out into
      LINKTYPE            dynamic or static linking
      VERSION             module version number
      EXE_FILES           any executables installed in a space seperated 
                          list
  
  =cut
  
  sub perllocal_install {
      my($type, $name) = splice(@ARGV, 0, 2);
  
      # VMS feeds args as a piped file on STDIN since it usually can't
      # fit all the args on a single command line.
      my @mod_info = $Is_VMS ? split /\|/, <STDIN>
                             : @ARGV;
  
      my $pod;
      $pod = sprintf <<POD, scalar localtime;
   =head2 %s: C<$type> L<$name|$name>
   
   =over 4
   
  POD
  
      do {
          my($key, $val) = splice(@mod_info, 0, 2);
  
          $pod .= <<POD
   =item *
   
   C<$key: $val>
   
  POD
  
      } while(@mod_info);
  
      $pod .= "=back\n\n";
      $pod =~ s/^ //mg;
      print $pod;
  
      return 1;
  }
  
  =item B<uninstall>
  
      perl "-MExtUtils::Command::MM" -e uninstall <packlist>
  
  A wrapper around ExtUtils::Install::uninstall().  Warns that
  uninstallation is deprecated and doesn't actually perform the
  uninstallation.
  
  =cut
  
  sub uninstall {
      my($packlist) = shift @ARGV;
  
      require ExtUtils::Install;
  
      print <<'WARNING';
  
  Uninstall is unsafe and deprecated, the uninstallation was not performed.
  We will show what would have been done.
  
  WARNING
  
      ExtUtils::Install::uninstall($packlist, 1, 1);
  
      print <<'WARNING';
  
  Uninstall is unsafe and deprecated, the uninstallation was not performed.
  Please check the list above carefully, there may be errors.
  Remove the appropriate files manually.
  Sorry for the inconvenience.
  
  WARNING
  
  }
  
  =back
  
  =cut
  
  1;
EXTUTILS_COMMAND_MM

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

$fatpacked{"ExtUtils/Liblist/Kid.pm"} = <<'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 = '6.64';
  
  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' and $Config{perllibs} ) {
  
          # Dynamic libraries are not transitive, so we may need including
          # the libraries linked against perl.dll again.
  
          $potential_libs .= " " if $potential_libs;
          $potential_libs .= $Config{perllibs};
      }
      return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs;
      warn "Potential libraries are '$potential_libs':\n" if $verbose;
  
      my ( $so ) = $Config{so};
      my ( $libs ) = defined $Config{perllibs} ? $Config{perllibs} : $Config{libs};
      my $Config_libext = $Config{lib_ext} || ".a";
      my $Config_dlext = $Config{dlext};
  
      # compute $extralibs, $bsloadlibs and $ldloadlibs from
      # $potential_libs
      # this is a rewrite of Andy Dougherty's extliblist in perl
  
      my ( @searchpath );    # from "-L/path" entries in $potential_libs
      my ( @libpath ) = split " ", $Config{'libpth'};
      my ( @ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen );
      my ( @libs,       %libs_seen );
      my ( $fullname,   @fullname );
      my ( $pwd )   = cwd();    # from Cwd.pm
      my ( $found ) = 0;
  
      foreach my $thislib ( split ' ', $potential_libs ) {
  
          # Handle possible linker path arguments.
          if ( $thislib =~ s/^(-[LR]|-Wl,-R)// ) {    # 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 eq '-Wl,-R' ) ) {
                  if ( $Config{'lddlflags'} =~ /-Wl,-R/ ) {
                      $rtype = '-Wl,-R';
                  }
                  elsif ( $Config{'lddlflags'} =~ /-R/ ) {
                      $rtype = '-R';
                  }
              }
              unless ( File::Spec->file_name_is_absolute( $thislib ) ) {
                  warn "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n";
                  $thislib = $self->catdir( $pwd, $thislib );
              }
              push( @searchpath, $thislib );
              push( @extralibs,  "$ptype$thislib" );
              push( @ldloadlibs, "$rtype$thislib" );
              next;
          }
  
          # Handle possible library arguments.
          unless ( $thislib =~ s/^-l// ) {
              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]+" ) ) {
  
                  # 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 ( -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.)
              }
              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$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$thislib" )
                        unless ( $in_perl and $^O eq 'sunos' );
                  }
                  else {
                      push( @ldloadlibs, "-l$thislib" );
                  }
              }
              last;    # found one here so don't bother looking further
          }
          warn "Warning (mostly harmless): " . "No library found for -l$thislib\n"
            unless $found_lib > 0;
      }
  
      unless ( $found ) {
          return ( '', '', '', '', ( $give_libs ? \@libs : () ) );
      }
      else {
          return ( "@extralibs", "@bsloadlibs", "@ldloadlibs", join( ":", @ld_run_path ), ( $give_libs ? \@libs : () ) );
      }
  }
  
  sub _win32_ext {
  
      require Text::ParseWords;
  
      my ( $self, $potential_libs, $verbose, $give_libs ) = @_;
      $verbose ||= 0;
  
      # If user did not supply a list, we punt.
      # (caller should probably use the list in $Config{libs})
      return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs;
  
      # TODO: make this use MM_Win32.pm's compiler detection
      my %libs_seen;
      my @extralibs;
      my $cc = $Config{cc} || '';
      my $VC = $cc =~ /\bcl\b/i;
      my $GC = $cc =~ /\bgcc\b/i;
  
      my $libext     = _win32_lib_extensions();
      my @searchpath = ( '' );                                    # from "-L/path" entries in $potential_libs
      my @libpath    = _win32_default_search_paths( $VC, $GC );
      my $pwd        = cwd();                                     # from Cwd.pm
      my $search     = 1;
  
      # compute @extralibs from $potential_libs
      my @lib_search_list = _win32_make_lib_search_list( $potential_libs, $verbose );
      for ( @lib_search_list ) {
  
          my $thislib = $_;
  
          # see if entry is a flag
          if ( /^:\w+$/ ) {
              $search = 0 if lc eq ':nosearch';
              $search = 1 if lc eq ':search';
              _debug( "Ignoring unknown flag '$thislib'\n", $verbose ) if !/^:(no)?(search|default)$/i;
              next;
          }
  
          # if searching is disabled, do compiler-specific translations
          unless ( $search ) {
              s/^-l(.+)$/$1.lib/ unless $GC;
              s/^-L/-libpath:/ if $VC;
              push( @extralibs, $_ );
              next;
          }
  
          # handle possible linker path arguments
          if ( s/^-L// and not -d ) {
              _debug( "$thislib ignored, directory does not exist\n", $verbose );
              next;
          }
          elsif ( -d ) {
              unless ( File::Spec->file_name_is_absolute( $_ ) ) {
                  warn "Warning: '$thislib' changed to '-L$pwd/$_'\n";
                  $_ = $self->catdir( $pwd, $_ );
              }
              push( @searchpath, $_ );
              next;
          }
  
          my @paths = ( @searchpath, @libpath );
          my ( $fullname, $path ) = _win32_search_file( $thislib, $libext, \@paths, $verbose, $GC );
  
          if ( !$fullname ) {
              warn "Warning (mostly harmless): No library found for $thislib\n";
              next;
          }
  
          _debug( "'$thislib' found as '$fullname'\n", $verbose );
          push( @extralibs, $fullname );
          $libs_seen{$fullname} = 1 if $path;    # why is this a special case?
      }
  
      my @libs = keys %libs_seen;
  
      return ( '', '', '', '', ( $give_libs ? \@libs : () ) ) unless @extralibs;
  
      # make sure paths with spaces are properly quoted
      @extralibs = map { /\s/ ? qq["$_"] : $_ } @extralibs;
      @libs      = map { /\s/ ? 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;
      $extensions{ $Config{'lib_ext'} } = 1 if $Config{'lib_ext'};
      $extensions{".lib"} = 1;
      return [ keys %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'
      );
      if ( $Config{'vms_cc_type'} ne 'decc' ) { $libmap{'curses'} = 'VAXCCURSE'; }
  
      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 = $self->fixpath( $dir, 1 );
          }
          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 ) {
  
                  # This has to precede any other CRTLs, so just make it first
                  if ( $cand eq 'VAXCCURSE' ) { unshift @{ $found{$ctype} }, $cand; }
                  else                        { 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;
      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"} = <<'EXTUTILS_MM';
  package ExtUtils::MM;
  
  use strict;
  use ExtUtils::MakeMaker::Config;
  
  our $VERSION = '6.64';
  
  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"} = <<'EXTUTILS_MM_AIX';
  package ExtUtils::MM_AIX;
  
  use strict;
  our $VERSION = '6.64';
  
  require ExtUtils::MM_Unix;
  our @ISA = qw(ExtUtils::MM_Unix);
  
  use ExtUtils::MakeMaker qw(neatvalue);
  
  
  =head1 NAME
  
  ExtUtils::MM_AIX - AIX specific subclass of ExtUtils::MM_Unix
  
  =head1 SYNOPSIS
  
    Don't use this module directly.
    Use ExtUtils::MM and let it choose.
  
  =head1 DESCRIPTION
  
  This is a subclass of ExtUtils::MM_Unix which contains functionality for
  AIX.
  
  Unless otherwise stated it works just like ExtUtils::MM_Unix
  
  =head2 Overridden methods
  
  =head3 dlsyms
  
  Define DL_FUNCS and DL_VARS and write the *.exp files.
  
  =cut
  
  sub dlsyms {
      my($self,%attribs) = @_;
  
      return '' unless $self->needs_linking();
  
      my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
      my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
      my($funclist)  = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
      my(@m);
  
      push(@m,"
  dynamic :: $self->{BASEEXT}.exp
  
  ") unless $self->{SKIPHASH}{'dynamic'}; # dynamic and static are subs, so...
  
      push(@m,"
  static :: $self->{BASEEXT}.exp
  
  ") unless $self->{SKIPHASH}{'static'};  # we avoid a warning if we tick them
  
      push(@m,"
  $self->{BASEEXT}.exp: Makefile.PL
  ",'	$(PERLRUN) -e \'use ExtUtils::Mksymlists; \\
  	Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
  	neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist),
  	', "DL_VARS" => ', neatvalue($vars), ');\'
  ');
  
      join('',@m);
  }
  
  
  =head1 AUTHOR
  
  Michael G Schwern <schwern@pobox.com> with code from ExtUtils::MM_Unix
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker>
  
  =cut
  
  
  1;
EXTUTILS_MM_AIX

$fatpacked{"ExtUtils/MM_Any.pm"} = <<'EXTUTILS_MM_ANY';
  package ExtUtils::MM_Any;
  
  use strict;
  our $VERSION = '6.64';
  
  use Carp;
  use File::Spec;
  use File::Basename;
  BEGIN { our @ISA = qw(File::Spec); }
  
  # We need $Verbose
  use ExtUtils::MakeMaker qw($Verbose);
  
  use ExtUtils::MakeMaker::Config;
  
  
  # So we don't have to keep calling the methods over and over again,
  # we have these globals to cache the values.  Faster and shrtr.
  my $Curdir  = __PACKAGE__->curdir;
  my $Rootdir = __PACKAGE__->rootdir;
  my $Updir   = __PACKAGE__->updir;
  
  
  =head1 NAME
  
  ExtUtils::MM_Any - Platform-agnostic MM methods
  
  =head1 SYNOPSIS
  
    FOR INTERNAL USE ONLY!
  
    package ExtUtils::MM_SomeOS;
  
    # Temporarily, you have to subclass both.  Put MM_Any first.
    require ExtUtils::MM_Any;
    require ExtUtils::MM_Unix;
    @ISA = qw(ExtUtils::MM_Any ExtUtils::Unix);
  
  =head1 DESCRIPTION
  
  B<FOR INTERNAL USE ONLY!>
  
  ExtUtils::MM_Any is a superclass for the ExtUtils::MM_* set of
  modules.  It contains methods which are either inherently
  cross-platform or are written in a cross-platform manner.
  
  Subclass off of ExtUtils::MM_Any I<and> ExtUtils::MM_Unix.  This is a
  temporary solution.
  
  B<THIS MAY BE TEMPORARY!>
  
  
  =head1 METHODS
  
  Any methods marked I<Abstract> must be implemented by subclasses.
  
  
  =head2 Cross-platform helper methods
  
  These are methods which help writing cross-platform code.
  
  
  
  =head3 os_flavor  I<Abstract>
  
      my @os_flavor = $mm->os_flavor;
  
  @os_flavor is the style of operating system this is, usually
  corresponding to the MM_*.pm file we're using.  
  
  The first element of @os_flavor is the major family (ie. Unix,
  Windows, VMS, OS/2, etc...) and the rest are sub families.
  
  Some examples:
  
      Cygwin98       ('Unix',  'Cygwin', 'Cygwin9x')
      Windows        ('Win32')
      Win98          ('Win32', 'Win9x')
      Linux          ('Unix',  'Linux')
      MacOS X        ('Unix',  'Darwin', 'MacOS', 'MacOS X')
      OS/2           ('OS/2')
  
  This is used to write code for styles of operating system.  
  See os_flavor_is() for use.
  
  
  =head3 os_flavor_is
  
      my $is_this_flavor = $mm->os_flavor_is($this_flavor);
      my $is_this_flavor = $mm->os_flavor_is(@one_of_these_flavors);
  
  Checks to see if the current operating system is one of the given flavors.
  
  This is useful for code like:
  
      if( $mm->os_flavor_is('Unix') ) {
          $out = `foo 2>&1`;
      }
      else {
          $out = `foo`;
      }
  
  =cut
  
  sub os_flavor_is {
      my $self = shift;
      my %flavors = map { ($_ => 1) } $self->os_flavor;
      return (grep { $flavors{$_} } @_) ? 1 : 0;
  }
  
  
  =head3 can_load_xs
  
      my $can_load_xs = $self->can_load_xs;
  
  Returns true if we have the ability to load XS.
  
  This is important because miniperl, used to build XS modules in the
  core, can not load XS.
  
  =cut
  
  sub can_load_xs {
      return defined &DynaLoader::boot_DynaLoader ? 1 : 0;
  }
  
  
  =head3 split_command
  
      my @cmds = $MM->split_command($cmd, @args);
  
  Most OS have a maximum command length they can execute at once.  Large
  modules can easily generate commands well past that limit.  Its
  necessary to split long commands up into a series of shorter commands.
  
  C<split_command> will return a series of @cmds each processing part of
  the args.  Collectively they will process all the arguments.  Each
  individual line in @cmds will not be longer than the
  $self->max_exec_len being careful to take into account macro expansion.
  
  $cmd should include any switches and repeated initial arguments.
  
  If no @args are given, no @cmds will be returned.
  
  Pairs of arguments will always be preserved in a single command, this
  is a heuristic for things like pm_to_blib and pod2man which work on
  pairs of arguments.  This makes things like this safe:
  
      $self->split_command($cmd, %pod2man);
  
  
  =cut
  
  sub split_command {
      my($self, $cmd, @args) = @_;
  
      my @cmds = ();
      return(@cmds) unless @args;
  
      # If the command was given as a here-doc, there's probably a trailing
      # newline.
      chomp $cmd;
  
      # set aside 30% for macro expansion.
      my $len_left = int($self->max_exec_len * 0.70);
      $len_left -= length $self->_expand_macros($cmd);
  
      do {
          my $arg_str = '';
          my @next_args;
          while( @next_args = splice(@args, 0, 2) ) {
              # Two at a time to preserve pairs.
              my $next_arg_str = "\t  ". join ' ', @next_args, "\n";
  
              if( !length $arg_str ) {
                  $arg_str .= $next_arg_str
              }
              elsif( length($arg_str) + length($next_arg_str) > $len_left ) {
                  unshift @args, @next_args;
                  last;
              }
              else {
                  $arg_str .= $next_arg_str;
              }
          }
          chop $arg_str;
  
          push @cmds, $self->escape_newlines("$cmd \n$arg_str");
      } while @args;
  
      return @cmds;
  }
  
  
  sub _expand_macros {
      my($self, $cmd) = @_;
  
      $cmd =~ s{\$\((\w+)\)}{
          defined $self->{$1} ? $self->{$1} : "\$($1)"
      }e;
      return $cmd;
  }
  
  
  =head3 echo
  
      my @commands = $MM->echo($text);
      my @commands = $MM->echo($text, $file);
      my @commands = $MM->echo($text, $file, \%opts);
  
  Generates a set of @commands which print the $text to a $file.
  
  If $file is not given, output goes to STDOUT.
  
  If $opts{append} is true the $file will be appended to rather than
  overwritten.  Default is to overwrite.
  
  If $opts{allow_variables} is true, make variables of the form
  C<$(...)> will not be escaped.  Other C<$> will.  Default is to escape
  all C<$>.
  
  Example of use:
  
      my $make = map "\t$_\n", $MM->echo($text, $file);
  
  =cut
  
  sub echo {
      my($self, $text, $file, $opts) = @_;
  
      # Compatibility with old options
      if( !ref $opts ) {
          my $append = $opts;
          $opts = { append => $append || 0 };
      }
      $opts->{allow_variables} = 0 unless defined $opts->{allow_variables};
  
      my $ql_opts = { allow_variables => $opts->{allow_variables} };
      my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) } 
                 split /\n/, $text;
      if( $file ) {
          my $redirect = $opts->{append} ? '>>' : '>';
          $cmds[0] .= " $redirect $file";
          $_ .= " >> $file" foreach @cmds[1..$#cmds];
      }
  
      return @cmds;
  }
  
  
  =head3 wraplist
  
    my $args = $mm->wraplist(@list);
  
  Takes an array of items and turns them into a well-formatted list of
  arguments.  In most cases this is simply something like:
  
      FOO \
      BAR \
      BAZ
  
  =cut
  
  sub wraplist {
      my $self = shift;
      return join " \\\n\t", @_;
  }
  
  
  =head3 maketext_filter
  
      my $filter_make_text = $mm->maketext_filter($make_text);
  
  The text of the Makefile is run through this method before writing to
  disk.  It allows systems a chance to make portability fixes to the
  Makefile.
  
  By default it does nothing.
  
  This method is protected and not intended to be called outside of
  MakeMaker.
  
  =cut
  
  sub maketext_filter { return $_[1] }
  
  
  =head3 cd  I<Abstract>
  
    my $subdir_cmd = $MM->cd($subdir, @cmds);
  
  This will generate a make fragment which runs the @cmds in the given
  $dir.  The rough equivalent to this, except cross platform.
  
    cd $subdir && $cmd
  
  Currently $dir can only go down one level.  "foo" is fine.  "foo/bar" is
  not.  "../foo" is right out.
  
  The resulting $subdir_cmd has no leading tab nor trailing newline.  This
  makes it easier to embed in a make string.  For example.
  
        my $make = sprintf <<'CODE', $subdir_cmd;
    foo :
        $(ECHO) what
        %s
        $(ECHO) mouche
    CODE
  
  
  =head3 oneliner  I<Abstract>
  
    my $oneliner = $MM->oneliner($perl_code);
    my $oneliner = $MM->oneliner($perl_code, \@switches);
  
  This will generate a perl one-liner safe for the particular platform
  you're on based on the given $perl_code and @switches (a -e is
  assumed) suitable for using in a make target.  It will use the proper
  shell quoting and escapes.
  
  $(PERLRUN) will be used as perl.
  
  Any newlines in $perl_code will be escaped.  Leading and trailing
  newlines will be stripped.  Makes this idiom much easier:
  
      my $code = $MM->oneliner(<<'CODE', [...switches...]);
  some code here
  another line here
  CODE
  
  Usage might be something like:
  
      # an echo emulation
      $oneliner = $MM->oneliner('print "Foo\n"');
      $make = '$oneliner > somefile';
  
  All dollar signs must be doubled in the $perl_code if you expect them
  to be interpreted normally, otherwise it will be considered a make
  macro.  Also remember to quote make macros else it might be used as a
  bareword.  For example:
  
      # Assign the value of the $(VERSION_FROM) make macro to $vf.
      $oneliner = $MM->oneliner('$$vf = "$(VERSION_FROM)"');
  
  Its currently very simple and may be expanded sometime in the figure
  to include more flexible code and switches.
  
  
  =head3 quote_literal  I<Abstract>
  
      my $safe_text = $MM->quote_literal($text);
      my $safe_text = $MM->quote_literal($text, \%options);
  
  This will quote $text so it is interpreted literally in the shell.
  
  For example, on Unix this would escape any single-quotes in $text and
  put single-quotes around the whole thing.
  
  If $options{allow_variables} is true it will leave C<'$(FOO)'> make
  variables untouched.  If false they will be escaped like any other
  C<$>.  Defaults to true.
  
  =head3 escape_dollarsigns
  
      my $escaped_text = $MM->escape_dollarsigns($text);
  
  Escapes stray C<$> so they are not interpreted as make variables.
  
  It lets by C<$(...)>.
  
  =cut
  
  sub escape_dollarsigns {
      my($self, $text) = @_;
  
      # Escape dollar signs which are not starting a variable
      $text =~ s{\$ (?!\() }{\$\$}gx;
  
      return $text;
  }
  
  
  =head3 escape_all_dollarsigns
  
      my $escaped_text = $MM->escape_all_dollarsigns($text);
  
  Escapes all C<$> so they are not interpreted as make variables.
  
  =cut
  
  sub escape_all_dollarsigns {
      my($self, $text) = @_;
  
      # Escape dollar signs
      $text =~ s{\$}{\$\$}gx;
  
      return $text;
  }
  
  
  =head3 escape_newlines  I<Abstract>
  
      my $escaped_text = $MM->escape_newlines($text);
  
  Shell escapes newlines in $text.
  
  
  =head3 max_exec_len  I<Abstract>
  
      my $max_exec_len = $MM->max_exec_len;
  
  Calculates the maximum command size the OS can exec.  Effectively,
  this is the max size of a shell command line.
  
  =for _private
  $self->{_MAX_EXEC_LEN} is set by this method, but only for testing purposes.
  
  
  =head3 make
  
      my $make = $MM->make;
  
  Returns the make variant we're generating the Makefile for.  This attempts
  to do some normalization on the information from %Config or the user.
  
  =cut
  
  sub make {
      my $self = shift;
  
      my $make = lc $self->{MAKE};
  
      # Truncate anything like foomake6 to just foomake.
      $make =~ s/^(\w+make).*/$1/;
  
      # Turn gnumake into gmake.
      $make =~ s/^gnu/g/;
  
      return $make;
  }
  
  
  =head2 Targets
  
  These are methods which produce make targets.
  
  
  =head3 all_target
  
  Generate the default target 'all'.
  
  =cut
  
  sub all_target {
      my $self = shift;
  
      return <<'MAKE_EXT';
  all :: pure_all
  	$(NOECHO) $(NOOP)
  MAKE_EXT
  
  }
  
  
  =head3 blibdirs_target
  
      my $make_frag = $mm->blibdirs_target;
  
  Creates the blibdirs target which creates all the directories we use
  in blib/.
  
  The blibdirs.ts target is deprecated.  Depend on blibdirs instead.
  
  
  =cut
  
  sub blibdirs_target {
      my $self = shift;
  
      my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib
                                             autodir archautodir
                                             bin script
                                             man1dir man3dir
                                            );
  
      my @exists = map { $_.'$(DFSEP).exists' } @dirs;
  
      my $make = sprintf <<'MAKE', join(' ', @exists);
  blibdirs : %s
  	$(NOECHO) $(NOOP)
  
  # Backwards compat with 6.18 through 6.25
  blibdirs.ts : blibdirs
  	$(NOECHO) $(NOOP)
  
  MAKE
  
      $make .= $self->dir_target(@dirs);
  
      return $make;
  }
  
  
  =head3 clean (o)
  
  Defines the clean target.
  
  =cut
  
  sub clean {
  # --- Cleanup and Distribution Sections ---
  
      my($self, %attribs) = @_;
      my @m;
      push(@m, '
  # Delete temporary files but do not touch installed files. We don\'t delete
  # the Makefile here so a later make realclean still has a makefile to use.
  
  clean :: clean_subdirs
  ');
  
      my @files = values %{$self->{XS}}; # .c files from *.xs files
      my @dirs  = qw(blib);
  
      # Normally these are all under blib but they might have been
      # redefined.
      # XXX normally this would be a good idea, but the Perl core sets
      # INST_LIB = ../../lib rather than actually installing the files.
      # So a "make clean" in an ext/ directory would blow away lib.
      # Until the core is adjusted let's leave this out.
  #     push @dirs, qw($(INST_ARCHLIB) $(INST_LIB)
  #                    $(INST_BIN) $(INST_SCRIPT)
  #                    $(INST_MAN1DIR) $(INST_MAN3DIR)
  #                    $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR) 
  #                    $(INST_STATIC) $(INST_DYNAMIC) $(INST_BOOT)
  #                 );
                    
  
      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
      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 = keys %f; }
      { my(%d) = map { ($_ => 1) } @dirs;  @dirs  = 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';
  	- $(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);
  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 seperate 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 7;
  %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
  scratchdirectory, and runs 'perl Makefile.PL; make ;make test' in that
  subdirectory.
  
  =cut
  
  sub dist_test {
      my($self) = shift;
  
      my $mpl_args = join " ", map qq["$_"], @ARGV;
  
      my $test = $self->cd('$(DISTVNAME)',
                           '$(ABSPERLRUN) Makefile.PL '.$mpl_args,
                           '$(MAKE) $(PASTHRU)',
                           '$(MAKE) test $(PASTHRU)'
                          );
  
      return sprintf <<'MAKE_FRAG', $test;
  disttest : distdir
  	%s
  
  MAKE_FRAG
  
  
  }
  
  
  =head3 dynamic (o)
  
  Defines the dynamic target.
  
  =cut
  
  sub dynamic {
  # --- Dynamic Loading Sections ---
  
      my($self) = shift;
      '
  dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
  	$(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 (keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}) {
          $dependencies .= " \\\n\t$name";
      }
  
      my $manify = <<END;
  manifypods : pure_all $dependencies
  END
  
      my @man_cmds;
      foreach my $section (qw(1 3)) {
          my $pods = $self->{"MAN${section}PODS"};
          push @man_cmds, $self->split_command(<<CMD, %$pods);
  	\$(NOECHO) \$(POD2MAN) --section=$section --perm_rw=\$(PERM_RW)
  CMD
      }
  
      $manify .= "\t\$(NOECHO) \$(NOOP)\n" unless @man_cmds;
      $manify .= join '', map { "$_\n" } @man_cmds;
  
      return $manify;
  }
  
  sub _has_cpan_meta {
      return eval {
        require CPAN::Meta;
        CPAN::Meta->VERSION(2.112150);
        1;
      };
  }
  
  =head3 metafile_target
  
      my $target = $mm->metafile_target;
  
  Generate the metafile target.
  
  Writes the file META.yml YAML encoded meta-data about the module in
  the distdir.  The format follows Module::Build's as closely as
  possible.
  
  =cut
  
  sub metafile_target {
      my $self = shift;
      return <<'MAKE_FRAG' if $self->{NO_META} or ! _has_cpan_meta();
  metafile :
  	$(NOECHO) $(NOOP)
  MAKE_FRAG
  
      my %metadata   = $self->metafile_data(
          $self->{META_ADD}   || {},
          $self->{META_MERGE} || {},
      );
      
      _fix_metadata_before_conversion( \%metadata );
  
      # paper over validation issues, but still complain, necessary because
      # there's no guarantee that the above will fix ALL errors
      my $meta = eval { CPAN::Meta->create( \%metadata, { lazy_validation => 1 } ) };
      warn $@ if $@ and 
                 $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/;
  
      # use the original metadata straight if the conversion failed
      # or if it can't be stringified.
      if( !$meta                                                  ||
          !eval { $meta->as_string( { version => "1.4" } ) }      ||
          !eval { $meta->as_string }
      )
      {
          $meta = bless \%metadata, 'CPAN::Meta';
      }
  
      my @write_metayml = $self->echo(
        $meta->as_string({version => "1.4"}), 'META_new.yml'
      );
      my @write_metajson = $self->echo(
        $meta->as_string(), 'META_new.json'
      );
  
      my $metayml = join("\n\t", @write_metayml);
      my $metajson = join("\n\t", @write_metajson);
      return sprintf <<'MAKE_FRAG', $metayml, $metajson;
  metafile : create_distdir
  	$(NOECHO) $(ECHO) Generating META.yml
  	%s
  	-$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
  	$(NOECHO) $(ECHO) Generating META.json
  	%s
  	-$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json
  MAKE_FRAG
  
  }
  
  =begin private
  
  =head3 _fix_metadata_before_conversion
  
      _fix_metadata_before_conversion( \%metadata );
  
  Fixes errors in the metadata before it's handed off to CPAN::Meta for
  conversion. This hopefully results in something that can be used further
  on, no guarantee is made though.
  
  =end private
  
  =cut
  
  sub _fix_metadata_before_conversion {
      my ( $metadata ) = @_;
  
      # we should never be called unless this already passed but
      # prefer to be defensive in case somebody else calls this
  
      return unless _has_cpan_meta;
  
      my $bad_version = $metadata->{version} &&
                        !CPAN::Meta::Validator->new->version( 'version', $metadata->{version} );
  
      # just delete all invalid versions
      if( $bad_version ) {
          warn "Can't parse version '$metadata->{version}'\n";
          $metadata->{version} = '';
      }
  
      my $validator = CPAN::Meta::Validator->new( $metadata );
      return if $validator->is_valid;
  
      # fix non-camelcase custom resource keys (only other trick we know)
      for my $error ( $validator->errors ) {
          my ( $key ) = ( $error =~ /Custom resource '(.*)' must be in CamelCase./ );
          next if !$key;
  
          # first try to remove all non-alphabetic chars
          ( my $new_key = $key ) =~ s/[^_a-zA-Z]//g;
  
          # if that doesn't work, uppercase first one
          $new_key = ucfirst $new_key if !$validator->custom_1( $new_key );
  
          # copy to new key if that worked
          $metadata->{resources}{$new_key} = $metadata->{resources}{$key}
            if $validator->custom_1( $new_key );
  
          # and delete old one in any case
          delete $metadata->{resources}{$key};
      }
  
      return;
  }
  
  
  =begin private
  
  =head3 _sort_pairs
  
      my @pairs = _sort_pairs($sort_sub, \%hash);
  
  Sorts the pairs of a hash based on keys ordered according 
  to C<$sort_sub>.
  
  =end private
  
  =cut
  
  sub _sort_pairs {
      my $sort  = shift;
      my $pairs = shift;
      return map  { $_ => $pairs->{$_} }
             sort $sort
             keys %$pairs;
  }
  
  
  # Taken from Module::Build::Base
  sub _hash_merge {
      my ($self, $h, $k, $v) = @_;
      if (ref $h->{$k} eq 'ARRAY') {
          push @{$h->{$k}}, ref $v ? @$v : $v;
      } elsif (ref $h->{$k} eq 'HASH') {
          $self->_hash_merge($h->{$k}, $_, $v->{$_}) foreach keys %$v;
      } else {
          $h->{$k} = $v;
      }
  }
  
  
  =head3 metafile_data
  
      my @metadata_pairs = $mm->metafile_data(\%meta_add, \%meta_merge);
  
  Returns the data which MakeMaker turns into the META.yml file.
  
  Values of %meta_add will overwrite any existing metadata in those
  keys.  %meta_merge will be merged with them.
  
  =cut
  
  sub metafile_data {
      my $self = shift;
      my($meta_add, $meta_merge) = @_;
  
      my %meta = (
          # required
          name         => $self->{DISTNAME},
          version      => _normalize_version($self->{VERSION}),
          abstract     => $self->{ABSTRACT} || 'unknown',
          license      => $self->{LICENSE} || 'unknown',
          dynamic_config => 1,
  
          # optional
          distribution_type => $self->{PM} ? 'module' : 'script',
  
          no_index     => {
              directory   => [qw(t inc)]
          },
  
          generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION",
          'meta-spec'  => {
              url         => 'http://module-build.sourceforge.net/META-spec-v1.4.html', 
              version     => 1.4
          },
      );
  
      # The author key is required and it takes a list.
      $meta{author}   = defined $self->{AUTHOR}    ? $self->{AUTHOR} : [];
  
      # 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}
              = _normalize_prereqs($self->{CONFIGURE_REQUIRES});
      } else {
          $meta{configure_requires} = {
              'ExtUtils::MakeMaker'       => 0,
          };
      }
  
      %meta = $self->_add_requirements_to_meta_v1_4( %meta );
  
      while( my($key, $val) = each %$meta_add ) {
          $meta{$key} = $val;
      }
  
      while( my($key, $val) = each %$meta_merge ) {
          $self->_hash_merge(\%meta, $key, $val);
      }
  
      return %meta;
  }
  
  
  =begin private
  
  =cut
  
  sub _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}{BUILD_REQUIRES} ) {
          $meta{build_requires} = _normalize_prereqs($self->{BUILD_REQUIRES});
      } else {
          $meta{build_requires} = {
              'ExtUtils::MakeMaker'       => 0,
          };
      }
  
      if( $self->{ARGS}{TEST_REQUIRES} ) {
          $meta{build_requires} = {
            %{ $meta{build_requires} },
            %{ _normalize_prereqs($self->{TEST_REQUIRES}) },
          };
      }
  
      $meta{requires} = _normalize_prereqs($self->{PREREQ_PM})
          if defined $self->{PREREQ_PM};
      $meta{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION})
          if $self->{MIN_PERL_VERSION};
  
      return %meta;
  }
  
  sub _add_requirements_to_meta_v2 {
      my ( $self, %meta ) = @_;
  
      # Check the original args so we can tell between the user setting it
      # to an empty hash and it just being initialized.
      if( $self->{ARGS}{BUILD_REQUIRES} ) {
          $meta{prereqs}{build}{requires} = _normalize_prereqs($self->{BUILD_REQUIRES});
      } else {
          $meta{prereqs}{build}{requires} = {
              'ExtUtils::MakeMaker'       => 0,
          };
      }
  
      if( $self->{ARGS}{TEST_REQUIRES} ) {
          $meta{prereqs}{test}{requires} = _normalize_prereqs($self->{TEST_REQUIRES});
      }
  
      $meta{prereqs}{runtime}{requires} = _normalize_prereqs($self->{PREREQ_PM})
          if defined $self->{PREREQ_PM};
      $meta{prereqs}{runtime}{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION})
          if $self->{MIN_PERL_VERSION};
  
      return %meta;
  }
  
  sub _normalize_prereqs {
    my ($hash) = @_;
    my %prereqs;
    while ( my ($k,$v) = each %$hash ) {
      $prereqs{$k} = _normalize_version($v);
    }
    return \%prereqs;
  }
  
  # Adapted from Module::Build::Base
  sub _normalize_version {
    my ($version) = @_;
    $version = 0 unless defined $version;
  
    if ( ref $version eq 'version' ) { # version objects
      $version = $version->is_qv ? $version->normal : $version->stringify;
    }
    elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
      # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
      $version = "v$version";
    }
    else {
      # leave alone
    }
    return $version;
  }
  
  =head3 _dump_hash
  
      $yaml = _dump_hash(\%options, %hash);
  
  Implements a fake YAML dumper for a hash given
  as a list of pairs. No quoting/escaping is done. Keys
  are supposed to be strings. Values are undef, strings, 
  hash refs or array refs of strings.
  
  Supported options are:
  
      delta => STR - indentation delta
      use_header => BOOL - whether to include a YAML header
      indent => STR - a string of spaces 
            default: ''
  
      max_key_length => INT - maximum key length used to align
          keys and values of the same hash
          default: 20
      key_sort => CODE - a sort sub 
              It may be undef, which means no sorting by keys
          default: sub { lc $a cmp lc $b }
  
      customs => HASH - special options for certain keys 
             (whose values are hashes themselves)
          may contain: max_key_length, key_sort, customs
  
  =end private
  
  =cut
  
  sub _dump_hash {
      croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH';
      my $options = shift;
      my %hash = @_;
  
      # Use a list to preserve order.
      my @pairs;
  
      my $k_sort 
          = exists $options->{key_sort} ? $options->{key_sort} 
                                        : sub { lc $a cmp lc $b };
      if ($k_sort) {
          croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE';
          @pairs = _sort_pairs($k_sort, \%hash);
      } else { # list of pairs, no sorting
          @pairs = @_;
      }
  
      my $yaml     = $options->{use_header} ? "--- #YAML:1.0\n" : '';
      my $indent   = $options->{indent} || '';
      my $k_length = min(
          ($options->{max_key_length} || 20),
          max(map { length($_) + 1 } grep { !ref $hash{$_} } keys %hash)
      );
      my $customs  = $options->{customs} || {};
  
      # printf format for key
      my $k_format = "%-${k_length}s";
  
      while( @pairs ) {
          my($key, $val) = splice @pairs, 0, 2;
          $val = '~' unless defined $val;
          if(ref $val eq 'HASH') {
              if ( keys %$val ) {
                  my %k_options = ( # options for recursive call
                      delta => $options->{delta},
                      use_header => 0,
                      indent => $indent . $options->{delta},
                  );
                  if (exists $customs->{$key}) {
                      my %k_custom = %{$customs->{$key}};
                      foreach my $k (qw(key_sort max_key_length customs)) {
                          $k_options{$k} = $k_custom{$k} if exists $k_custom{$k};
                      }
                  }
                  $yaml .= $indent . "$key:\n" 
                    . _dump_hash(\%k_options, %$val);
              }
              else {
                  $yaml .= $indent . "$key:  {}\n";
              }
          }
          elsif (ref $val eq 'ARRAY') {
              if( @$val ) {
                  $yaml .= $indent . "$key:\n";
  
                  for (@$val) {
                      croak "only nested arrays of non-refs are supported" if ref $_;
                      $yaml .= $indent . $options->{delta} . "- $_\n";
                  }
              }
              else {
                  $yaml .= $indent . "$key:  []\n";
              }
          }
          elsif( ref $val and !blessed($val) ) {
              croak "only nested hashes, arrays and objects are supported";
          }
          else {  # if it's an object, just stringify it
              $yaml .= $indent . sprintf "$k_format  %s\n", "$key:", $val;
          }
      };
  
      return $yaml;
  
  }
  
  sub blessed {
      return eval { $_[0]->isa("UNIVERSAL"); };
  }
  
  sub max {
      return (sort { $b <=> $a } @_)[0];
  }
  
  sub min {
      return (sort { $a <=> $b } @_)[0];
  }
  
  =head3 metafile_file
  
      my $meta_yml = $mm->metafile_file(@metadata_pairs);
  
  Turns the @metadata_pairs into YAML.
  
  This method does not implement a complete YAML dumper, being limited
  to dump a hash with values which are strings, undef's or nested hashes
  and arrays of strings. No quoting/escaping is done.
  
  =cut
  
  sub metafile_file {
      my $self = shift;
  
      my %dump_options = (
          use_header => 1, 
          delta      => ' ' x 4, 
          key_sort   => undef,
      );
      return _dump_hash(\%dump_options, @_);
  
  }
  
  
  =head3 distmeta_target
  
      my $make_frag = $mm->distmeta_target;
  
  Generates the distmeta target to add META.yml to the MANIFEST in the
  distdir.
  
  =cut
  
  sub distmeta_target {
      my $self = shift;
  
      my @add_meta = (
        $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']),
  exit unless -e q{META.yml};
  eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }
      or print "Could not add META.yml to MANIFEST: $${'@'}\n"
  CODE
        $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd'])
  exit unless -f q{META.json};
  eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }
      or print "Could not add META.json to MANIFEST: $${'@'}\n"
  CODE
      );
  
      my @add_meta_to_distdir = map { $self->cd('$(DISTVNAME)', $_) } @add_meta;
  
      return sprintf <<'MAKE', @add_meta_to_distdir;
  distmeta : create_distdir metafile
  	$(NOECHO) %s
  	$(NOECHO) %s
  
  MAKE
  
  }
  
  
  =head3 mymeta
  
      my $mymeta = $mm->mymeta;
  
  Generate MYMETA information as a hash either from an existing META.yml
  or from internal data.
  
  =cut
  
  sub mymeta {
      my $self = shift;
      my $file = shift || ''; # for testing
  
      my $mymeta = $self->_mymeta_from_meta($file);
      my $v2 = 1;
  
      unless ( $mymeta ) {
          my @metadata = $self->metafile_data(
              $self->{META_ADD}   || {},
              $self->{META_MERGE} || {},
          );
          $mymeta = {@metadata};
          $v2 = 0;
      }
  
      # Overwrite the non-configure dependency hashes
  
      my $method = $v2
                 ? '_add_requirements_to_meta_v2'
                 : '_add_requirements_to_meta_v1_4';
  
      $mymeta = { $self->$method( %$mymeta ) };
  
      $mymeta->{dynamic_config} = 0;
  
      return $mymeta;
  }
  
  
  sub _mymeta_from_meta {
      my $self = shift;
      my $metafile = shift || ''; # for testing
  
      return unless _has_cpan_meta();
  
      my $meta;
      for my $file ( $metafile, "META.json", "META.yml" ) {
        next unless -e $file;
        eval {
            $meta = CPAN::Meta->load_file($file)->as_struct( { version => 2 } );
        };
        last if $meta;
      }
      return undef 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 undef;
          }
      }
  
      return $meta;
  }
  
  =head3 write_mymeta
  
      $self->write_mymeta( $mymeta );
  
  Write MYMETA information to MYMETA.yml.
  
  This will probably be refactored into a more generic YAML dumping method.
  
  =cut
  
  sub write_mymeta {
      my $self = shift;
      my $mymeta = shift;
  
      return unless _has_cpan_meta();
  
      _fix_metadata_before_conversion( $mymeta );
      
      # this can still blow up
      # not sure if i should just eval this and skip file creation if it
      # blows up
      my $meta_obj = CPAN::Meta->new( $mymeta, { lazy_validation => 1 } );
      $meta_obj->save( 'MYMETA.json' );
      $meta_obj->save( 'MYMETA.yml', { version => "1.4" } );
      return 1;
  }
  
  =head3 realclean (o)
  
  Defines the realclean target.
  
  =cut
  
  sub realclean {
      my($self, %attribs) = @_;
  
      my @dirs  = qw($(DISTVNAME));
      my @files = qw($(FIRST_MAKEFILE) $(MAKEFILE_OLD));
  
      # Special exception for the perl core where INST_* is not in blib.
      # This cleans up the files built from the ext/ directory (all XS).
      if( $self->{PERL_CORE} ) {
          push @dirs, qw($(INST_AUTODIR) $(INST_ARCHAUTODIR));
          push @files, values %{$self->{PM}};
      }
  
      if( $self->has_link_code ){
          push @files, qw($(OBJECT));
      }
  
      if( $attribs{FILES} ) {
          if( ref $attribs{FILES} ) {
              push @dirs, @{ $attribs{FILES} };
          }
          else {
              push @dirs, split /\s+/, $attribs{FILES};
          }
      }
  
      # Occasionally files are repeated several times from different sources
      { my(%f) = map { ($_ => 1) } @files;  @files = keys %f; }
      { my(%d) = map { ($_ => 1) } @dirs;   @dirs  = keys %d; }
  
      my $rm_cmd  = join "\n\t", map { "$_" } 
                      $self->split_command('- $(RM_F)',  @files);
      my $rmf_cmd = join "\n\t", map { "$_" } 
                      $self->split_command('- $(RM_RF)', @dirs);
  
      my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd;
  # Delete temporary files (via clean) and also delete dist files
  realclean purge ::  clean realclean_subdirs
  	%s
  	%s
  MAKE
  
      $m .= "\t$attribs{POSTOP}\n" if $attribs{POSTOP};
  
      return $m;
  }
  
  
  =head3 realclean_subdirs_target
  
    my $make_frag = $MM->realclean_subdirs_target;
  
  Returns the realclean_subdirs target.  This is used by the realclean
  target to call realclean on any subdirectories which contain Makefiles.
  
  =cut
  
  sub realclean_subdirs_target {
      my $self = shift;
  
      return <<'NOOP_FRAG' unless @{$self->{DIR}};
  realclean_subdirs :
  	$(NOECHO) $(NOOP)
  NOOP_FRAG
  
      my $rclean = "realclean_subdirs :\n";
  
      foreach my $dir (@{$self->{DIR}}) {
          foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) {
              my $subrclean .= $self->oneliner(sprintf <<'CODE', $dir, ($makefile) x 2);
  chdir '%s';  system '$(MAKE) $(USEMAKEFILE) %s realclean' if -f '%s';
  CODE
  
              $rclean .= sprintf <<'RCLEAN', $subrclean;
  	- %s
  RCLEAN
  
          }
      }
  
      return $rclean;
  }
  
  
  =head3 signature_target
  
      my $target = $mm->signature_target;
  
  Generate the signature target.
  
  Writes the file SIGNATURE with "cpansign -s".
  
  =cut
  
  sub signature_target {
      my $self = shift;
  
      return <<'MAKE_FRAG';
  signature :
  	cpansign -s
  MAKE_FRAG
  
  }
  
  
  =head3 distsignature_target
  
      my $make_frag = $mm->distsignature_target;
  
  Generates the distsignature target to add SIGNATURE to the MANIFEST in the
  distdir.
  
  =cut
  
  sub distsignature_target {
      my $self = shift;
  
      my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']);
  eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } 
      or print "Could not add SIGNATURE to MANIFEST: $${'@'}\n"
  CODE
  
      my $sign_dist        = $self->cd('$(DISTVNAME)' => 'cpansign -s');
  
      # cpansign -s complains if SIGNATURE is in the MANIFEST yet does not
      # exist
      my $touch_sig        = $self->cd('$(DISTVNAME)' => '$(TOUCH) SIGNATURE');
      my $add_sign_to_dist = $self->cd('$(DISTVNAME)' => $add_sign );
  
      return sprintf <<'MAKE', $add_sign_to_dist, $touch_sig, $sign_dist
  distsignature : create_distdir
  	$(NOECHO) %s
  	$(NOECHO) %s
  	%s
  
  MAKE
  
  }
  
  
  =head3 special_targets
  
    my $make_frag = $mm->special_targets
  
  Returns a make fragment containing any targets which have special
  meaning to make.  For example, .SUFFIXES and .PHONY.
  
  =cut
  
  sub special_targets {
      my $make_frag = <<'MAKE_FRAG';
  .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
  
  .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
  
  MAKE_FRAG
  
      $make_frag .= <<'MAKE_FRAG' if $ENV{CLEARCASE_ROOT};
  .NO_CONFIG_REC: Makefile
  
  MAKE_FRAG
  
      return $make_frag;
  }
  
  
  
  
  =head2 Init methods
  
  Methods which help initialize the MakeMaker object and macros.
  
  
  =head3 init_ABSTRACT
  
      $mm->init_ABSTRACT
  
  =cut
  
  sub init_ABSTRACT {
      my $self = shift;
  
      if( $self->{ABSTRACT_FROM} and $self->{ABSTRACT} ) {
          warn "Both ABSTRACT_FROM and ABSTRACT are set.  ".
               "Ignoring ABSTRACT_FROM.\n";
          return;
      }
  
      if ($self->{ABSTRACT_FROM}){
          $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or
              carp "WARNING: Setting ABSTRACT via file ".
                   "'$self->{ABSTRACT_FROM}' failed\n";
      }
  }
  
  =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}) {
              if (defined $Cross::platform) {
                  $self->{INST_LIB} = $self->{INST_ARCHLIB} = 
                    $self->catdir($self->{PERL_LIB},"..","xlib",
                                       $Cross::platform);
              }
              else {
                  $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
              }
          } else {
              $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib");
          }
      }
  
      my @parentdir = split(/::/, $self->{PARENT_NAME});
      $self->{INST_LIBDIR}      = $self->catdir('$(INST_LIB)',     @parentdir);
      $self->{INST_ARCHLIBDIR}  = $self->catdir('$(INST_ARCHLIB)', @parentdir);
      $self->{INST_AUTODIR}     = $self->catdir('$(INST_LIB)', 'auto', 
                                                '$(FULLEXT)');
      $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto',
                                                '$(FULLEXT)');
  
      $self->{INST_SCRIPT}  ||= $self->catdir($Curdir,'blib','script');
  
      $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1');
      $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3');
  
      return 1;
  }
  
  
  =head3 init_INSTALL
  
      $mm->init_INSTALL;
  
  Called by init_main.  Sets up all INSTALL_* variables (except
  INSTALLDIRS) and *PREFIX.
  
  =cut
  
  sub init_INSTALL {
      my($self) = shift;
  
      if( $self->{ARGS}{INSTALL_BASE} and $self->{ARGS}{PREFIX} ) {
          die "Only one of PREFIX or INSTALL_BASE can be given.  Not both.\n";
      }
  
      if( $self->{ARGS}{INSTALL_BASE} ) {
          $self->init_INSTALL_from_INSTALL_BASE;
      }
      else {
          $self->init_INSTALL_from_PREFIX;
      }
  }
  
  
  =head3 init_INSTALL_from_PREFIX
  
    $mm->init_INSTALL_from_PREFIX;
  
  =cut
  
  sub init_INSTALL_from_PREFIX {
      my $self = shift;
  
      $self->init_lib2arch;
  
      # There are often no Config.pm defaults for these new man variables so 
      # we fall back to the old behavior which is to use installman*dir
      foreach my $num (1, 3) {
          my $k = 'installsiteman'.$num.'dir';
  
          $self->{uc $k} ||= uc "\$(installman${num}dir)"
            unless $Config{$k};
      }
  
      foreach my $num (1, 3) {
          my $k = 'installvendorman'.$num.'dir';
  
          unless( $Config{$k} ) {
              $self->{uc $k}  ||= $Config{usevendorprefix}
                                ? uc "\$(installman${num}dir)"
                                : '';
          }
      }
  
      $self->{INSTALLSITEBIN} ||= '$(INSTALLBIN)'
        unless $Config{installsitebin};
      $self->{INSTALLSITESCRIPT} ||= '$(INSTALLSCRIPT)'
        unless $Config{installsitescript};
  
      unless( $Config{installvendorbin} ) {
          $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix} 
                                      ? $Config{installbin}
                                      : '';
      }
      unless( $Config{installvendorscript} ) {
          $self->{INSTALLVENDORSCRIPT} ||= $Config{usevendorprefix}
                                         ? $Config{installscript}
                                         : '';
      }
  
  
      my $iprefix = $Config{installprefixexp} || $Config{installprefix} || 
                    $Config{prefixexp}        || $Config{prefix} || '';
      my $vprefix = $Config{usevendorprefix}  ? $Config{vendorprefixexp} : '';
      my $sprefix = $Config{siteprefixexp}    || '';
  
      # 5.005_03 doesn't have a siteprefix.
      $sprefix = $iprefix unless $sprefix;
  
  
      $self->{PREFIX}       ||= '';
  
      if( $self->{PREFIX} ) {
          @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} =
            ('$(PREFIX)') x 3;
      }
      else {
          $self->{PERLPREFIX}   ||= $iprefix;
          $self->{SITEPREFIX}   ||= $sprefix;
          $self->{VENDORPREFIX} ||= $vprefix;
  
          # Lots of MM extension authors like to use $(PREFIX) so we
          # put something sensible in there no matter what.
          $self->{PREFIX} = '$('.uc $self->{INSTALLDIRS}.'PREFIX)';
      }
  
      my $arch    = $Config{archname};
      my $version = $Config{version};
  
      # default style
      my $libstyle = $Config{installstyle} || 'lib/perl5';
      my $manstyle = '';
  
      if( $self->{LIBSTYLE} ) {
          $libstyle = $self->{LIBSTYLE};
          $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : '';
      }
  
      # Some systems, like VOS, set installman*dir to '' if they can't
      # read man pages.
      for my $num (1, 3) {
          $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none'
            unless $Config{'installman'.$num.'dir'};
      }
  
      my %bin_layouts = 
      (
          bin         => { s => $iprefix,
                           t => 'perl',
                           d => 'bin' },
          vendorbin   => { s => $vprefix,
                           t => 'vendor',
                           d => 'bin' },
          sitebin     => { s => $sprefix,
                           t => 'site',
                           d => 'bin' },
          script      => { s => $iprefix,
                           t => 'perl',
                           d => 'bin' },
          vendorscript=> { s => $vprefix,
                           t => 'vendor',
                           d => 'bin' },
          sitescript  => { s => $sprefix,
                           t => 'site',
                           d => 'bin' },
      );
      
      my %man_layouts =
      (
          man1dir         => { s => $iprefix,
                               t => 'perl',
                               d => 'man/man1',
                               style => $manstyle, },
          siteman1dir     => { s => $sprefix,
                               t => 'site',
                               d => 'man/man1',
                               style => $manstyle, },
          vendorman1dir   => { s => $vprefix,
                               t => 'vendor',
                               d => 'man/man1',
                               style => $manstyle, },
  
          man3dir         => { s => $iprefix,
                               t => 'perl',
                               d => 'man/man3',
                               style => $manstyle, },
          siteman3dir     => { s => $sprefix,
                               t => 'site',
                               d => 'man/man3',
                               style => $manstyle, },
          vendorman3dir   => { s => $vprefix,
                               t => 'vendor',
                               d => 'man/man3',
                               style => $manstyle, },
      );
  
      my %lib_layouts =
      (
          privlib     => { s => $iprefix,
                           t => 'perl',
                           d => '',
                           style => $libstyle, },
          vendorlib   => { s => $vprefix,
                           t => 'vendor',
                           d => '',
                           style => $libstyle, },
          sitelib     => { s => $sprefix,
                           t => 'site',
                           d => 'site_perl',
                           style => $libstyle, },
          
          archlib     => { s => $iprefix,
                           t => 'perl',
                           d => "$version/$arch",
                           style => $libstyle },
          vendorarch  => { s => $vprefix,
                           t => 'vendor',
                           d => "$version/$arch",
                           style => $libstyle },
          sitearch    => { s => $sprefix,
                           t => 'site',
                           d => "site_perl/$version/$arch",
                           style => $libstyle },
      );
  
  
      # Special case for LIB.
      if( $self->{LIB} ) {
          foreach my $var (keys %lib_layouts) {
              my $Installvar = uc "install$var";
  
              if( $var =~ /arch/ ) {
                  $self->{$Installvar} ||= 
                    $self->catdir($self->{LIB}, $Config{archname});
              }
              else {
                  $self->{$Installvar} ||= $self->{LIB};
              }
          }
      }
  
      my %type2prefix = ( perl    => 'PERLPREFIX',
                          site    => 'SITEPREFIX',
                          vendor  => 'VENDORPREFIX'
                        );
  
      my %layouts = (%bin_layouts, %man_layouts, %lib_layouts);
      while( my($var, $layout) = each(%layouts) ) {
          my($s, $t, $d, $style) = @{$layout}{qw(s t d style)};
          my $r = '$('.$type2prefix{$t}.')';
  
          warn "Prefixing $var\n" if $Verbose >= 2;
  
          my $installvar = "install$var";
          my $Installvar = uc $installvar;
          next if $self->{$Installvar};
  
          $d = "$style/$d" if $style;
          $self->prefixify($installvar, $s, $r, $d);
  
          warn "  $Installvar == $self->{$Installvar}\n" 
            if $Verbose >= 2;
      }
  
      # Generate these if they weren't figured out.
      $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH};
      $self->{VENDORLIBEXP}  ||= $self->{INSTALLVENDORLIB};
  
      return 1;
  }
  
  
  =head3 init_from_INSTALL_BASE
  
      $mm->init_from_INSTALL_BASE
  
  =cut
  
  my %map = (
             lib      => [qw(lib perl5)],
             arch     => [('lib', 'perl5', $Config{archname})],
             bin      => [qw(bin)],
             man1dir  => [qw(man man1)],
             man3dir  => [qw(man man3)]
            );
  $map{script} = $map{bin};
  
  sub init_INSTALL_from_INSTALL_BASE {
      my $self = shift;
  
      @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} = 
                                                           '$(INSTALL_BASE)';
  
      my %install;
      foreach my $thing (keys %map) {
          foreach my $dir (('', 'SITE', 'VENDOR')) {
              my $uc_thing = uc $thing;
              my $key = "INSTALL".$dir.$uc_thing;
  
              $install{$key} ||= 
                $self->catdir('$(INSTALL_BASE)', @{$map{$thing}});
          }
      }
  
      # Adjust for variable quirks.
      $install{INSTALLARCHLIB} ||= delete $install{INSTALLARCH};
      $install{INSTALLPRIVLIB} ||= delete $install{INSTALLLIB};
  
      foreach my $key (keys %install) {
          $self->{$key} ||= $install{$key};
      }
  
      return 1;
  }
  
  
  =head3 init_VERSION  I<Abstract>
  
      $mm->init_VERSION
  
  Initialize macros representing versions of MakeMaker and other tools
  
  MAKEMAKER: path to the MakeMaker module.
  
  MM_VERSION: ExtUtils::MakeMaker Version
  
  MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards 
               compat)
  
  VERSION: version of your module
  
  VERSION_MACRO: which macro represents the version (usually 'VERSION')
  
  VERSION_SYM: like version but safe for use as an RCS revision number
  
  DEFINE_VERSION: -D line to set the module version when compiling
  
  XS_VERSION: version in your .xs file.  Defaults to $(VERSION)
  
  XS_VERSION_MACRO: which macro represents the XS version.
  
  XS_DEFINE_VERSION: -D line to set the xs version when compiling.
  
  Called by init_main.
  
  =cut
  
  sub init_VERSION {
      my($self) = shift;
  
      $self->{MAKEMAKER}  = $ExtUtils::MakeMaker::Filename;
      $self->{MM_VERSION} = $ExtUtils::MakeMaker::VERSION;
      $self->{MM_REVISION}= $ExtUtils::MakeMaker::Revision;
      $self->{VERSION_FROM} ||= '';
  
      if ($self->{VERSION_FROM}){
          $self->{VERSION} = $self->parse_version($self->{VERSION_FROM});
          if( $self->{VERSION} eq 'undef' ) {
              carp("WARNING: Setting VERSION via file ".
                   "'$self->{VERSION_FROM}' failed\n");
          }
      }
  
      # strip blanks
      if (defined $self->{VERSION}) {
          $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 bottomline 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 
    CP                Copy a file                 
    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('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->{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} =~ 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
                      } ) 
      {
          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 seperator 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 seperator between directories.  Some operating
  systems use different seperators 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 mocule.
  (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 seperator 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" }.
             qq{"-e" "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 extra_clean_files
  
      my @files_to_clean = $MM->extra_clean_files;
  
  Returns a list of OS specific files to be removed in the clean target in
  addition to the usual set.
  
  =cut
  
  # An empty method here tickled a perl 5.8.1 bug and would return its object.
  sub extra_clean_files { 
      return;
  }
  
  
  =head3 installvars
  
      my @installvars = $mm->installvars;
  
  A list of all the INSTALL* variables without the INSTALL prefix.  Useful
  for iteration or building related variable sets.
  
  =cut
  
  sub installvars {
      return qw(PRIVLIB SITELIB  VENDORLIB
                ARCHLIB SITEARCH VENDORARCH
                BIN     SITEBIN  VENDORBIN
                SCRIPT  SITESCRIPT  VENDORSCRIPT
                MAN1DIR SITEMAN1DIR VENDORMAN1DIR
                MAN3DIR SITEMAN3DIR VENDORMAN3DIR
               );
  }
  
  
  =head3 libscan
  
    my $wanted = $self->libscan($path);
  
  Takes a path to a file or dir and returns an empty string if we don't
  want to include this file in the library.  Otherwise it returns the
  the $path unchanged.
  
  Mainly used to exclude version control administrative directories from
  installation.
  
  =cut
  
  sub libscan {
      my($self,$path) = @_;
      my($dirs,$file) = ($self->splitpath($path))[1,2];
      return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/, 
                       $self->splitdir($dirs), $file;
  
      return $path;
  }
  
  
  =head3 platform_constants
  
      my $make_frag = $mm->platform_constants
  
  Returns a make fragment defining all the macros initialized in
  init_platform() rather than put them in constants().
  
  =cut
  
  sub platform_constants {
      return '';
  }
  
  =begin private
  
  =head3 _PREREQ_PRINT
  
      $self->_PREREQ_PRINT;
  
  Implements PREREQ_PRINT.
  
  Refactored out of MakeMaker->new().
  
  =end private
  
  =cut
  
  sub _PREREQ_PRINT {
      my $self = shift;
  
      require Data::Dumper;
      my @what = ('PREREQ_PM');
      push @what, 'MIN_PERL_VERSION' if $self->{MIN_PERL_VERSION};
      push @what, 'BUILD_REQUIRES'   if $self->{BUILD_REQUIRES};
      print Data::Dumper->Dump([@{$self}{@what}], \@what);
      exit 0;
  }
  
  
  =begin private
  
  =head3 _PRINT_PREREQ
  
    $mm->_PRINT_PREREQ;
  
  Implements PRINT_PREREQ, a slightly different version of PREREQ_PRINT
  added by Redhat to, I think, support generating RPMs from Perl modules.
  
  Should not include BUILD_REQUIRES as RPMs do not incluide them.
  
  Refactored out of MakeMaker->new().
  
  =end private
  
  =cut
  
  sub _PRINT_PREREQ {
      my $self = shift;
  
      my $prereqs= $self->{PREREQ_PM};
      my @prereq = map { [$_, $prereqs->{$_}] } keys %$prereqs;
  
      if ( $self->{MIN_PERL_VERSION} ) {
          push @prereq, ['perl' => $self->{MIN_PERL_VERSION}];
      }
  
      print join(" ", map { "perl($_->[0])>=$_->[1] " }
                   sort { $a->[0] cmp $b->[0] } @prereq), "\n";
      exit 0;
  }
  
  
  =begin private
  
  =head3 _all_prereqs
  
    my $prereqs = $self->_all_prereqs;
  
  Returns a hash ref of both PREREQ_PM and BUILD_REQUIRES.
  
  =end private
  
  =cut
  
  sub _all_prereqs {
      my $self = shift;
  
      return { %{$self->{PREREQ_PM}}, %{$self->{BUILD_REQUIRES}} };
  }
  
  
  =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"} = <<'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 = '6.64';
  
  
  =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_ARCHIVE_AFTER} ||= '';
      $self->{EXPORT_LIST}  ||= '';
  }
  
  =back
  
  1;
  __END__
  
EXTUTILS_MM_BEOS

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

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

$fatpacked{"ExtUtils/MM_Darwin.pm"} = <<'EXTUTILS_MM_DARWIN';
  package ExtUtils::MM_Darwin;
  
  use strict;
  
  BEGIN {
      require ExtUtils::MM_Unix;
      our @ISA = qw( ExtUtils::MM_Unix );
  }
  
  our $VERSION = '6.64';
  
  
  =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 documention on the
  methods overridden here.
  
  =head2 Overriden Methods
  
  =head3 init_dist
  
  Turn off Apple tar's tendency to copy resource forks as "._foo" files.
  
  =cut
  
  sub init_dist {
      my $self = shift;
      
      # Thank you, Apple, for breaking tar and then breaking the work around.
      # 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE while 10.5 wants
      # COPYFILE_DISABLE.  I'm not going to push my luck and instead just
      # set both.
      $self->{TAR} ||= 
          'COPY_EXTENDED_ATTRIBUTES_DISABLE=1 COPYFILE_DISABLE=1 tar';
      
      $self->SUPER::init_dist(@_);
  }
  
  1;
EXTUTILS_MM_DARWIN

$fatpacked{"ExtUtils/MM_MacOS.pm"} = <<'EXTUTILS_MM_MACOS';
  package ExtUtils::MM_MacOS;
  
  use strict;
  
  our $VERSION = '6.64';
  
  sub new {
      die <<'UNSUPPORTED';
  MacOS Classic (MacPerl) is no longer supported by MakeMaker.
  Please use Module::Build instead.
  UNSUPPORTED
  }
  
  =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.
  
  Those interested in writing modules for MacPerl should use Module::Build
  which works better than MakeMaker ever did.
  
  Anyone interested in resurrecting this file should pull the old version
  from the MakeMaker CVS repository and contact makemaker@perl.org, but we
  really encourage you to work on Module::Build instead.
  
  =cut
  
  1;
EXTUTILS_MM_MACOS

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

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

$fatpacked{"ExtUtils/MM_QNX.pm"} = <<'EXTUTILS_MM_QNX';
  package ExtUtils::MM_QNX;
  
  use strict;
  our $VERSION = '6.64';
  
  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"} = <<'EXTUTILS_MM_UWIN';
  package ExtUtils::MM_UWIN;
  
  use strict;
  our $VERSION = '6.64';
  
  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"} = <<'EXTUTILS_MM_UNIX';
  package ExtUtils::MM_Unix;
  
  require 5.006;
  
  use strict;
  
  use Carp;
  use ExtUtils::MakeMaker::Config;
  use File::Basename qw(basename dirname);
  use DirHandle;
  
  our %Config_Override;
  
  use ExtUtils::MakeMaker qw($Verbose neatvalue);
  
  # If we make $VERSION an our variable parse_version() breaks
  use vars qw($VERSION);
  $VERSION = '6.64';
  $VERSION = eval $VERSION;
  
  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) )
                    );
  }
  
  BEGIN {
      if( $Is{VMS} ) {
          # For things like vmsify()
          require VMS::Filespec;
          VMS::Filespec->import;
      }
  }
  
  
  =head1 NAME
  
  ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
  C<require ExtUtils::MM_Unix;>
  
  =head1 DESCRIPTION
  
  The methods provided by this package are designed to be used in
  conjunction with ExtUtils::MakeMaker. When MakeMaker writes a
  Makefile, it creates one or more objects that inherit their methods
  from a package C<MM>. MM itself doesn't provide any methods, but it
  ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating
  specific packages take the responsibility for all the methods provided
  by MM_Unix. We are trying to reduce the number of the necessary
  overrides by defining rather primitive operations within
  ExtUtils::MM_Unix.
  
  If you are going to write a platform specific MM package, please try
  to limit the necessary overrides to primitive methods, and if it is not
  possible to do so, let's work out how to achieve that gain.
  
  If you are overriding any of these methods in your Makefile.PL (in the
  MY class), please report that to the makemaker mailing list. We are
  trying to minimize the necessary method overrides and switch to data
  driven Makefile.PLs wherever possible. In the long run less methods
  will be overridable via the MY class.
  
  =head1 METHODS
  
  The following description of methods is still under
  development. Please refer to the code for not suitably documented
  sections and complain loudly to the makemaker@perl.org mailing list.
  Better yet, provide a patch.
  
  Not all of the methods below are overridable in a
  Makefile.PL. Overridable methods are marked as (o). All methods are
  overridable by a platform specific MM_*.pm file.
  
  Cross-platform methods are being moved into MM_Any.  If you can't find
  something that used to be in here, look in MM_Any.
  
  =cut
  
  # So we don't have to keep calling the methods over and over again,
  # we have these globals to cache the values.  Faster and shrtr.
  my $Curdir  = __PACKAGE__->curdir;
  my $Rootdir = __PACKAGE__->rootdir;
  my $Updir   = __PACKAGE__->updir;
  
  
  =head2 Methods
  
  =over 4
  
  =item os_flavor
  
  Simply says that we're Unix.
  
  =cut
  
  sub os_flavor {
      return('Unix');
  }
  
  
  =item c_o (o)
  
  Defines the suffix rules to compile different flavors of C files to
  object files.
  
  =cut
  
  sub c_o {
  # --- Translation Sections ---
  
      my($self) = shift;
      return '' unless $self->needs_linking();
      my(@m);
      
      my $command = '$(CCCMD)';
      my $flags   = '$(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE)';
      
      if (my $cpp = $Config{cpprun}) {
          my $cpp_cmd = $self->const_cccmd;
          $cpp_cmd =~ s/^CCCMD\s*=\s*\$\(CC\)/$cpp/;
          push @m, qq{
  .c.i:
  	$cpp_cmd $flags \$*.c > \$*.i
  };
      }
  
      push @m, qq{
  .c.s:
  	$command -S $flags \$*.c
  
  .c\$(OBJ_EXT):
  	$command $flags \$*.c
  
  .cpp\$(OBJ_EXT):
  	$command $flags \$*.cpp
  
  .cxx\$(OBJ_EXT):
  	$command $flags \$*.cxx
  
  .cc\$(OBJ_EXT):
  	$command $flags \$*.cc
  };
  
      push @m, qq{
  .C\$(OBJ_EXT):
  	$command $flags \$*.C
  } if !$Is{OS2} and !$Is{Win32} and !$Is{Dos}; #Case-specific
  
      return join "", @m;
  }
  
  =item cflags (o)
  
  Does very much the same as the cflags script in the perl
  distribution. It doesn't return the whole compiler command line, but
  initializes all of its parts. The const_cccmd method then actually
  returns the definition of the CCCMD macro which uses these parts.
  
  =cut
  
  #'
  
  sub cflags {
      my($self,$libperl)=@_;
      return $self->{CFLAGS} if $self->{CFLAGS};
      return '' unless $self->needs_linking();
  
      my($prog, $uc, $perltype, %cflags);
      $libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ;
      $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/;
  
      @cflags{qw(cc ccflags optimize shellflags)}
  	= @Config{qw(cc ccflags optimize shellflags)};
      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 ';
      }
  
      my $pollute = '';
      if ($Config{usemymalloc} and not $Config{bincompat5005}
  	and not $Config{ccflags} =~ /-DPERL_POLLUTE_MALLOC\b/
  	and $self->{PERL_MALLOC_OK}) {
  	$pollute = '$(PERL_MALLOC_DEF)';
      }
  
      $self->{CCFLAGS}  = quote_paren($self->{CCFLAGS});
      $self->{OPTIMIZE} = quote_paren($self->{OPTIMIZE});
  
      return $self->{CFLAGS} = qq{
  CCFLAGS = $self->{CCFLAGS}
  OPTIMIZE = $self->{OPTIMIZE}
  PERLTYPE = $self->{PERLTYPE}
  MPOLLUTE = $pollute
  };
  
  }
  
  
  =item const_cccmd (o)
  
  Returns the full compiler call for C programs and stores the
  definition in CONST_CCCMD.
  
  =cut
  
  sub const_cccmd {
      my($self,$libperl)=@_;
      return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
      return '' unless $self->needs_linking();
      return $self->{CONST_CCCMD} =
  	q{CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \\
  	$(CCFLAGS) $(OPTIMIZE) \\
  	$(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \\
  	$(XS_DEFINE_VERSION)};
  }
  
  =item const_config (o)
  
  Defines a couple of constants in the Makefile that are imported from
  %Config.
  
  =cut
  
  sub const_config {
  # --- Constants Sections ---
  
      my($self) = shift;
      my @m = <<"END";
  
  # These definitions are from config.sh (via $INC{'Config.pm'}).
  # They may have been overridden via Makefile.PL or on the command line.
  END
  
      my(%once_only);
      foreach my $key (@{$self->{CONFIG}}){
          # SITE*EXP macros are defined in &constants; avoid duplicates here
          next if $once_only{$key};
          $self->{uc $key} = quote_paren($self->{uc $key});
          push @m, uc($key) , ' = ' , $self->{uc $key}, "\n";
          $once_only{$key} = 1;
      }
      join('', @m);
  }
  
  =item const_loadlibs (o)
  
  Defines EXTRALIBS, LDLOADLIBS, BSLOADLIBS, LD_RUN_PATH. See
  L<ExtUtils::Liblist> for details.
  
  =cut
  
  sub const_loadlibs {
      my($self) = shift;
      return "" unless $self->needs_linking;
      my @m;
      push @m, qq{
  # $self->{NAME} might depend on some other libraries:
  # See ExtUtils::Liblist for details
  #
  };
      for my $tmp (qw/
           EXTRALIBS LDLOADLIBS BSLOADLIBS
           /) {
          next unless defined $self->{$tmp};
          push @m, "$tmp = $self->{$tmp}\n";
      }
      # don't set LD_RUN_PATH if empty
      for my $tmp (qw/
           LD_RUN_PATH
           /) {
          next unless $self->{$tmp};
          push @m, "$tmp = $self->{$tmp}\n";
      }
      return join "", @m;
  }
  
  =item constants (o)
  
    my $make_frag = $mm->constants;
  
  Prints out macros for lots of constants.
  
  =cut
  
  sub constants {
      my($self) = @_;
      my @m = ();
  
      $self->{DFSEP} = '$(DIRFILESEP)';  # alias for internal use
  
      for my $macro (qw(
  
                AR_STATIC_ARGS DIRFILESEP DFSEP
                NAME NAME_SYM 
                VERSION    VERSION_MACRO    VERSION_SYM DEFINE_VERSION
                XS_VERSION XS_VERSION_MACRO             XS_DEFINE_VERSION
                INST_ARCHLIB INST_SCRIPT INST_BIN INST_LIB
                INST_MAN1DIR INST_MAN3DIR
                MAN1EXT      MAN3EXT
                INSTALLDIRS INSTALL_BASE DESTDIR PREFIX
                PERLPREFIX      SITEPREFIX      VENDORPREFIX
                     ),
                     (map { ("INSTALL".$_,
                            "DESTINSTALL".$_)
                          } $self->installvars),
                     qw(
                PERL_LIB    
                PERL_ARCHLIB
                LIBPERL_A MYEXTLIB
                FIRST_MAKEFILE MAKEFILE_OLD MAKE_APERL_FILE 
                PERLMAINCC PERL_SRC PERL_INC 
                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;
  	push @m, "$macro = $self->{$macro}\n";
      }
  
      push @m, qq{
  MAKEMAKER   = $self->{MAKEMAKER}
  MM_VERSION  = $self->{MM_VERSION}
  MM_REVISION = $self->{MM_REVISION}
  };
  
      push @m, q{
  # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
  # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
  # PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
  # DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
  };
  
      for my $macro (qw/
                MAKE
  	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
  	      LDFROM LINKTYPE BOOTDEP
  	      /	) 
      {
  	next unless defined $self->{$macro};
  	push @m, "$macro = $self->{$macro}\n";
      }
  
      push @m, "
  # Handy lists of source code files:
  XS_FILES = ".$self->wraplist(sort keys %{$self->{XS}})."
  C_FILES  = ".$self->wraplist(@{$self->{C}})."
  O_FILES  = ".$self->wraplist(@{$self->{O_FILES}})."
  H_FILES  = ".$self->wraplist(@{$self->{H}})."
  MAN1PODS = ".$self->wraplist(sort keys %{$self->{MAN1PODS}})."
  MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})."
  ";
  
  
      push @m, q{
  # Where is the Config information that we are using/depend on
  CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
  };
  
  
      push @m, qq{
  # Where to build things
  INST_LIBDIR      = $self->{INST_LIBDIR}
  INST_ARCHLIBDIR  = $self->{INST_ARCHLIBDIR}
  
  INST_AUTODIR     = $self->{INST_AUTODIR}
  INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR}
  
  INST_STATIC      = $self->{INST_STATIC}
  INST_DYNAMIC     = $self->{INST_DYNAMIC}
  INST_BOOT        = $self->{INST_BOOT}
  };
  
  
      push @m, qq{
  # Extra linker info
  EXPORT_LIST        = $self->{EXPORT_LIST}
  PERL_ARCHIVE       = $self->{PERL_ARCHIVE}
  PERL_ARCHIVE_AFTER = $self->{PERL_ARCHIVE_AFTER}
  };
  
      push @m, "
  
  TO_INST_PM = ".$self->wraplist(sort keys %{$self->{PM}})."
  
  PM_TO_BLIB = ".$self->wraplist(%{$self->{PM}})."
  ";
  
      join('',@m);
  }
  
  
  =item depend (o)
  
  Same as macro for the depend attribute.
  
  =cut
  
  sub depend {
      my($self,%attribs) = @_;
      my(@m,$key,$val);
      while (($key,$val) = each %attribs){
  	last unless defined $key;
  	push @m, "$key : $val\n";
      }
      join "", @m;
  }
  
  
  =item init_DEST
  
    $mm->init_DEST
  
  Defines the DESTDIR and DEST* variables paralleling the INSTALL*.
  
  =cut
  
  sub init_DEST {
      my $self = shift;
  
      # Initialize DESTDIR
      $self->{DESTDIR} ||= '';
  
      # Make DEST variables.
      foreach my $var ($self->installvars) {
          my $destvar = 'DESTINSTALL'.$var;
          $self->{$destvar} ||= '$(DESTDIR)$(INSTALL'.$var.')';
      }
  }
  
  
  =item init_dist
  
    $mm->init_dist;
  
  Defines a lot of macros for distribution support.
  
    macro         description                     default
  
    TAR           tar command to use              tar
    TARFLAGS      flags to pass to TAR            cvf
  
    ZIP           zip command to use              zip
    ZIPFLAGS      flags to pass to ZIP            -r
  
    COMPRESS      compression command to          gzip --best
                  use for tarfiles
    SUFFIX        suffix to put on                .gz 
                  compressed files
  
    SHAR          shar command to use             shar
  
    PREOP         extra commands to run before
                  making the archive 
    POSTOP        extra commands to run after
                  making the archive
  
    TO_UNIX       a command to convert linefeeds
                  to Unix style in your archive 
  
    CI            command to checkin your         ci -u
                  sources to version control
    RCS_LABEL     command to label your sources   rcs -Nv$(VERSION_SYM): -q
                  just after CI is run
  
    DIST_CP       $how argument to manicopy()     best
                  when the distdir is created
  
    DIST_DEFAULT  default target to use to        tardist
                  create a distribution
  
    DISTVNAME     name of the resulting archive   $(DISTNAME)-$(VERSION)
                  (minus suffixes)
  
  =cut
  
  sub init_dist {
      my $self = shift;
  
      $self->{TAR}      ||= 'tar';
      $self->{TARFLAGS} ||= 'cvf';
      $self->{ZIP}      ||= 'zip';
      $self->{ZIPFLAGS} ||= '-r';
      $self->{COMPRESS} ||= 'gzip --best';
      $self->{SUFFIX}   ||= '.gz';
      $self->{SHAR}     ||= 'shar';
      $self->{PREOP}    ||= '$(NOECHO) $(NOOP)'; # eg update MANIFEST
      $self->{POSTOP}   ||= '$(NOECHO) $(NOOP)'; # eg remove the distdir
      $self->{TO_UNIX}  ||= '$(NOECHO) $(NOOP)';
  
      $self->{CI}       ||= 'ci -u';
      $self->{RCS_LABEL}||= 'rcs -Nv$(VERSION_SYM): -q';
      $self->{DIST_CP}  ||= 'best';
      $self->{DIST_DEFAULT} ||= 'tardist';
  
      ($self->{DISTNAME} = $self->{NAME}) =~ s{::}{-}g unless $self->{DISTNAME};
      $self->{DISTVNAME} ||= $self->{DISTNAME}.'-'.$self->{VERSION};
  
  }
  
  =item dist (o)
  
    my $dist_macros = $mm->dist(%overrides);
  
  Generates a make fragment defining all the macros initialized in
  init_dist.
  
  %overrides can be used to override any of the above.
  
  =cut
  
  sub dist {
      my($self, %attribs) = @_;
  
      my $make = '';
      foreach my $key (qw( 
              TAR TARFLAGS ZIP ZIPFLAGS COMPRESS SUFFIX SHAR
              PREOP POSTOP TO_UNIX
              CI RCS_LABEL DIST_CP DIST_DEFAULT
              DISTNAME DISTVNAME
             ))
      {
          my $value = $attribs{$key} || $self->{$key};
          $make .= "$key = $value\n";
      }
  
      return $make;
  }
  
  =item dist_basics (o)
  
  Defines the targets distclean, distcheck, skipcheck, manifest, veryclean.
  
  =cut
  
  sub dist_basics {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  distclean :: realclean distcheck
  	$(NOECHO) $(NOOP)
  
  distcheck :
  	$(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
  
  skipcheck :
  	$(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
  
  manifest :
  	$(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
  
  veryclean : realclean
  	$(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old 
  
  MAKE_FRAG
  
  }
  
  =item dist_ci (o)
  
  Defines a check in target for RCS.
  
  =cut
  
  sub dist_ci {
      my($self) = shift;
      return q{
  ci :
  	$(PERLRUN) "-MExtUtils::Manifest=maniread" \\
  	  -e "@all = keys %{ maniread() };" \\
  	  -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \\
  	  -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
  };
  }
  
  =item dist_core (o)
  
    my $dist_make_fragment = $MM->dist_core;
  
  Puts the targets necessary for 'make dist' together into one make
  fragment.
  
  =cut
  
  sub dist_core {
      my($self) = shift;
  
      my $make_frag = '';
      foreach my $target (qw(dist tardist uutardist tarfile zipdist zipfile 
                             shdist))
      {
          my $method = $target.'_target';
          $make_frag .= "\n";
          $make_frag .= $self->$method();
      }
  
      return $make_frag;
  }
  
  
  =item B<dist_target>
  
    my $make_frag = $MM->dist_target;
  
  Returns the 'dist' target to make an archive for distribution.  This
  target simply checks to make sure the Makefile is up-to-date and
  depends on $(DIST_DEFAULT).
  
  =cut
  
  sub dist_target {
      my($self) = shift;
  
      my $date_check = $self->oneliner(<<'CODE', ['-l']);
  print 'Warning: Makefile possibly out of date with $(VERSION_FROM)'
      if -e '$(VERSION_FROM)' and -M '$(VERSION_FROM)' < -M '$(FIRST_MAKEFILE)';
  CODE
  
      return sprintf <<'MAKE_FRAG', $date_check;
  dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
  	$(NOECHO) %s
  MAKE_FRAG
  }
  
  =item B<tardist_target>
  
    my $make_frag = $MM->tardist_target;
  
  Returns the 'tardist' target which is simply so 'make tardist' works.
  The real work is done by the dynamically named tardistfile_target()
  method, tardist should have that as a dependency.
  
  =cut
  
  sub tardist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  tardist : $(DISTVNAME).tar$(SUFFIX)
  	$(NOECHO) $(NOOP)
  MAKE_FRAG
  }
  
  =item B<zipdist_target>
  
    my $make_frag = $MM->zipdist_target;
  
  Returns the 'zipdist' target which is simply so 'make zipdist' works.
  The real work is done by the dynamically named zipdistfile_target()
  method, zipdist should have that as a dependency.
  
  =cut
  
  sub zipdist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  zipdist : $(DISTVNAME).zip
  	$(NOECHO) $(NOOP)
  MAKE_FRAG
  }
  
  =item B<tarfile_target>
  
    my $make_frag = $MM->tarfile_target;
  
  The name of this target is the name of the tarball generated by
  tardist.  This target does the actual work of turning the distdir into
  a tarball.
  
  =cut
  
  sub tarfile_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  $(DISTVNAME).tar$(SUFFIX) : distdir
  	$(PREOP)
  	$(TO_UNIX)
  	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
  	$(RM_RF) $(DISTVNAME)
  	$(COMPRESS) $(DISTVNAME).tar
  	$(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)
  	$(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
  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)
  	$(POSTOP)
  MAKE_FRAG
  }
  
  
  =item dlsyms (o)
  
  Used by some OS' to define DL_FUNCS and DL_VARS and write the *.exp files.
  
  Normally just returns an empty string.
  
  =cut
  
  sub dlsyms {
      return '';
  }
  
  
  =item dynamic_bs (o)
  
  Defines targets for bootstrap files.
  
  =cut
  
  sub dynamic_bs {
      my($self, %attribs) = @_;
      return '
  BOOTSTRAP =
  ' unless $self->has_link_code();
  
      my $target = $Is{VMS} ? '$(MMS$TARGET)' : '$@';
  
      return sprintf <<'MAKE_FRAG', ($target) x 5;
  BOOTSTRAP = $(BASEEXT).bs
  
  # As Mkbootstrap might not write a file (if none is required)
  # we use touch to prevent make continually trying to remake it.
  # The DynaLoader only reads a non-empty file.
  $(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
  	$(NOECHO) $(PERLRUN) \
  		"-MExtUtils::Mkbootstrap" \
  		-e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
  	$(NOECHO) $(TOUCH) %s
  	$(CHMOD) $(PERM_RW) %s
  
  $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(NOECHO) $(RM_RF) %s
  	- $(CP) $(BOOTSTRAP) %s
  	$(CHMOD) $(PERM_RW) %s
  MAKE_FRAG
  }
  
  =item dynamic_lib (o)
  
  Defines how to produce the *.so (or equivalent) files.
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      return '' unless $self->needs_linking(); #might be because of a subdir
  
      return '' unless $self->has_link_code;
  
      my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
      my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
      my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":";
      my($ldfrom) = '$(LDFROM)';
      $armaybe = 'ar' if ($Is{OSF} and $armaybe eq ':');
      my(@m);
      my $ld_opt = $Is{OS2} ? '$(OPTIMIZE) ' : '';	# Useful on other systems too?
      my $ld_fix = $Is{OS2} ? '|| ( $(RM_F) $@ && sh -c false )' : '';
      push(@m,'
  # This section creates the dynamically loadable $(INST_DYNAMIC)
  # from $(OBJECT) and possibly $(MYEXTLIB).
  ARMAYBE = '.$armaybe.'
  OTHERLDFLAGS = '.$ld_opt.$otherldflags.'
  INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  INST_DYNAMIC_FIX = '.$ld_fix.'
  
  $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
  ');
      if ($armaybe ne ':'){
  	$ldfrom = 'tmp$(LIB_EXT)';
  	push(@m,'	$(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n");
  	push(@m,'	$(RANLIB) '."$ldfrom\n");
      }
      $ldfrom = "-all $ldfrom -none" if $Is{OSF};
  
      # The IRIX linker doesn't use LD_RUN_PATH
      my $ldrun = $Is{IRIX} && $self->{LD_RUN_PATH} ?         
                         qq{-rpath "$self->{LD_RUN_PATH}"} : '';
  
      # For example in AIX the shared objects/libraries from previous builds
      # linger quite a while in the shared dynalinker cache even when nobody
      # is using them.  This is painful if one for instance tries to restart
      # a failed build because the link command will fail unnecessarily 'cos
      # the shared object/library is 'busy'.
      push(@m,'	$(RM_F) $@
  ');
  
      my $libs = '$(LDLOADLIBS)';
  
      if (($Is{NetBSD} || $Is{Interix}) && $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';
          }
      }
  
      my $ld_run_path_shell = "";
      if ($self->{LD_RUN_PATH} ne "") {
  	$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
      }
  
      push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $ldfrom, $libs;
  	%s$(LD) %s $(LDDLFLAGS) %s $(OTHERLDFLAGS) -o $@ $(MYEXTLIB)	\
  	  $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST)	\
  	  $(INST_DYNAMIC_FIX)
  MAKE
  
      push @m, <<'MAKE';
  	$(CHMOD) $(PERM_RWX) $@
  MAKE
  
      return join('',@m);
  }
  
  =item exescan
  
  Deprecated method. Use libscan instead.
  
  =cut
  
  sub exescan {
      my($self,$path) = @_;
      $path;
  }
  
  =item extliblist
  
  Called by init_others, and calls ext ExtUtils::Liblist. See
  L<ExtUtils::Liblist> for details.
  
  =cut
  
  sub extliblist {
      my($self,$libs) = @_;
      require ExtUtils::Liblist;
      $self->ext($libs, $Verbose);
  }
  
  =item find_perl
  
  Finds the executables PERL and FULLPERL
  
  =cut
  
  sub find_perl {
      my($self, $ver, $names, $dirs, $trace) = @_;
  
      if ($trace >= 2){
          print "Looking for perl $ver by these names:
  @$names
  in these dirs:
  @$dirs
  ";
      }
  
      my $stderr_duped = 0;
      local *STDERR_COPY;
  
      unless ($Is{BSD}) {
          # >& and lexical filehandles together give 5.6.2 indigestion
          if( open(STDERR_COPY, '>&STDERR') ) {  ## no critic
              $stderr_duped = 1;
          }
          else {
              warn <<WARNING;
  find_perl() can't dup STDERR: $!
  You might see some garbage while we search for Perl
  WARNING
          }
      }
  
      foreach my $name (@$names){
          foreach my $dir (@$dirs){
              next unless defined $dir; # $self->{PERL_SRC} may be undefined
              my ($abs, $val);
              if ($self->file_name_is_absolute($name)) {     # /foo/bar
                  $abs = $name;
              } elsif ($self->canonpath($name) eq 
                       $self->canonpath(basename($name))) {  # foo
                  $abs = $self->catfile($dir, $name);
              } else {                                            # foo/bar
                  $abs = $self->catfile($Curdir, $name);
              }
              print "Checking $abs\n" if ($trace >= 2);
              next unless $self->maybe_command($abs);
              print "Executing $abs\n" if ($trace >= 2);
  
              my $version_check = qq{$abs -le "require $ver; print qq{VER_OK}"};
              $version_check = "$Config{run} $version_check"
                  if defined $Config{run} and length $Config{run};
  
              # 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 shbang file.
  
          my $shb = $self->_fixin_replace_shebang( $file, $line );
          next unless defined $shb;
  
          open( my $fixout, ">", "$file_new" ) or do {
              warn "Can't create new $file: $!\n";
              next;
          };
  
          # Print out the new #! line (or equivalent).
          local $\;
          local $/;
          print $fixout $shb, <$fixin>;
          close $fixin;
          close $fixout;
  
          chmod 0666, $file_bak;
          unlink $file_bak;
          unless ( _rename( $file, $file_bak ) ) {
              warn "Can't rename $file to $file_bak: $!";
              next;
          }
          unless ( _rename( $file_new, $file ) ) {
              warn "Can't rename $file_new to $file: $!";
              unless ( _rename( $file_bak, $file ) ) {
                  warn "Can't rename $file_bak back to $file either: $!";
                  warn "Leaving $file renamed as $file_bak\n";
              }
              next;
          }
          unlink $file_bak;
      }
      continue {
          system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
      }
  }
  
  
  sub _rename {
      my($old, $new) = @_;
  
      foreach my $file ($old, $new) {
          if( $Is{VMS} and basename($file) !~ /\./ ) {
              # rename() in 5.8.0 on VMS will not rename a file if it
              # does not contain a dot yet it returns success.
              $file = "$file.";
          }
      }
  
      return rename($old, $new);
  }
  
  sub _fixin_replace_shebang {
      my ( $self, $file, $line ) = @_;
  
      # Now figure out the interpreter name.
      my ( $cmd, $arg ) = split ' ', $line, 2;
      $cmd =~ s!^.*/!!;
  
      # Now look (in reverse) for interpreter in absolute PATH (unless perl).
      my $interpreter;
      if ( $cmd =~ m{^perl(?:\z|[^a-z])} ) {
          if ( $Config{startperl} =~ m,^\#!.*/perl, ) {
              $interpreter = $Config{startperl};
              $interpreter =~ s,^\#!,,;
          }
          else {
              $interpreter = $Config{perlpath};
          }
      }
      else {
          my (@absdirs)
              = reverse grep { $self->file_name_is_absolute($_) } $self->path;
          $interpreter = '';
       
           foreach my $dir (@absdirs) {
              if ( $self->maybe_command($cmd) ) {
                  warn "Ignoring $interpreter in $file\n"
                      if $Verbose && $interpreter;
                  $interpreter = $self->catfile( $dir, $cmd );
              }
          }
      }
  
      # Figure out how to invoke interpreter on this machine.
   
      my ($does_shbang) = $Config{'sharpbang'} =~ /^\s*\#\!/;
      my ($shb) = "";
      if ($interpreter) {
          print "Changing sharpbang in $file to $interpreter"
              if $Verbose;
           # this is probably value-free on DOSISH platforms
          if ($does_shbang) {
              $shb .= "$Config{'sharpbang'}$interpreter";
              $shb .= ' ' . $arg if defined $arg;
              $shb .= "\n";
          }
          $shb .= qq{
  eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
      if 0; # not running under some shell
  } unless $Is{Win32};    # this won't work on win32, so don't
      }
      else {
          warn "Can't find $cmd in PATH, $file unchanged"
              if $Verbose;
          return undef;
      }
      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, %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;
  
      @ignore{map lc, keys %ignore} = values %ignore if $Is{VMS};
  
      foreach my $name ($self->lsdir($Curdir)){
  	next if $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}};
      $self->{O_FILES} = [grep s/\.c(pp|xx|c)?\z/$self->{OBJ_EXT}/i, @o_files];
  }
  
  
  =item init_MANPODS
  
  Determines if man pages should be generated and initializes MAN1PODS
  and MAN3PODS as appropriate.
  
  =cut
  
  sub init_MANPODS {
      my $self = shift;
  
      # Set up names of manual pages to generate from pods
      foreach my $man (qw(MAN1 MAN3)) {
          if ( $self->{"${man}PODS"}
               or $self->{"INSTALL${man}DIR"} =~ /^(none|\s*)$/
          ) {
              $self->{"${man}PODS"} ||= {};
          }
          else {
              my $init_method = "init_${man}PODS";
              $self->$init_method();
          }
      }
  }
  
  
  sub _has_pod {
      my($self, $file) = @_;
  
      my($ispod)=0;
      if (open( my $fh, '<', $file )) {
          while (<$fh>) {
              if (/^=(?:head\d+|item|pod)\b/) {
                  $ispod=1;
                  last;
              }
          }
          close $fh;
      } else {
          # If it doesn't exist yet, we assume, it has pods in it
          $ispod = 1;
      }
  
      return $ispod;
  }
  
  
  =item init_MAN1PODS
  
  Initializes MAN1PODS from the list of EXE_FILES.
  
  =cut
  
  sub init_MAN1PODS {
      my($self) = @_;
  
      if ( exists $self->{EXE_FILES} ) {
  	foreach my $name (@{$self->{EXE_FILES}}) {
  	    next unless $self->_has_pod($name);
  
  	    $self->{MAN1PODS}->{$name} =
  		$self->catfile("\$(INST_MAN1DIR)", 
  			       basename($name).".\$(MAN1EXT)");
  	}
      }
  }
  
  
  =item init_MAN3PODS
  
  Initializes MAN3PODS from the list of PM files.
  
  =cut
  
  sub init_MAN3PODS {
      my $self = shift;
  
      my %manifypods = (); # we collect the keys first, i.e. the files
                           # we have to convert to pod
  
      foreach my $name (keys %{$self->{PM}}) {
  	if ($name =~ /\.pod\z/ ) {
  	    $manifypods{$name} = $self->{PM}{$name};
  	} elsif ($name =~ /\.p[ml]\z/ ) {
  	    if( $self->_has_pod($name) ) {
  		$manifypods{$name} = $self->{PM}{$name};
  	    }
  	}
      }
  
      my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}};
  
      # Remove "Configure.pm" and similar, if it's not the only pod listed
      # To force inclusion, just name it "Configure.pod", or override 
      # MAN3PODS
      foreach my $name (keys %manifypods) {
  	if ($self->{PERL_CORE} and $name =~ /(config|setup).*\.pm/is) {
  	    delete $manifypods{$name};
  	    next;
  	}
  	my($manpagename) = $name;
  	$manpagename =~ s/\.p(od|m|l)\z//;
  	# everything below lib is ok
  	unless($manpagename =~ s!^\W*($parentlibs_re)\W+!!s) {
  	    $manpagename = $self->catfile(
  	        split(/::/,$self->{PARENT_NAME}),$manpagename
  	    );
  	}
  	$manpagename = $self->replace_manpage_separator($manpagename);
  	$self->{MAN3PODS}->{$name} =
  	    $self->catfile("\$(INST_MAN3DIR)", "$manpagename.\$(MAN3EXT)");
      }
  }
  
  
  =item init_PM
  
  Initializes PMLIBDIRS and PM from PMLIBDIRS.
  
  =cut
  
  sub init_PM {
      my $self = shift;
  
      # Some larger extensions often wish to install a number of *.pm/pl
      # files into the library in various locations.
  
      # The attribute PMLIBDIRS holds an array reference which lists
      # subdirectories which we should search for library files to
      # install. PMLIBDIRS defaults to [ 'lib', $self->{BASEEXT} ].  We
      # recursively search through the named directories (skipping any
      # which don't exist or contain Makefile.PL files).
  
      # For each *.pm or *.pl file found $self->libscan() is called with
      # the default installation path in $_[1]. The return value of
      # libscan defines the actual installation location.  The default
      # libscan function simply returns the path.  The file is skipped
      # if libscan returns false.
  
      # The default installation location passed to libscan in $_[1] is:
      #
      #  ./*.pm		=> $(INST_LIBDIR)/*.pm
      #  ./xyz/...	=> $(INST_LIBDIR)/xyz/...
      #  ./lib/...	=> $(INST_LIB)/...
      #
      # In this way the 'lib' directory is seen as the root of the actual
      # perl library whereas the others are relative to INST_LIBDIR
      # (which includes PARENT_NAME). This is a subtle distinction but one
      # that's important for nested modules.
  
      unless( $self->{PMLIBDIRS} ) {
          if( $Is{VMS} ) {
              # Avoid logical name vs directory collisions
              $self->{PMLIBDIRS} = ['./lib', "./$self->{BASEEXT}"];
          }
          else {
              $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}];
          }
      }
  
      #only existing directories that aren't in $dir are allowed
  
      # Avoid $_ wherever possible:
      # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}};
      my (@pmlibdirs) = @{$self->{PMLIBDIRS}};
      @{$self->{PMLIBDIRS}} = ();
      my %dir = map { ($_ => $_) } @{$self->{DIR}};
      foreach my $pmlibdir (@pmlibdirs) {
  	-d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir;
      }
  
      unless( $self->{PMLIBPARENTDIRS} ) {
  	@{$self->{PMLIBPARENTDIRS}} = ('lib');
      }
  
      return if $self->{PM} and $self->{ARGS}{PM};
  
      if (@{$self->{PMLIBDIRS}}){
  	print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n"
  	    if ($Verbose >= 2);
  	require File::Find;
          File::Find::find(sub {
              if (-d $_){
                  unless ($self->libscan($_)){
                      $File::Find::prune = 1;
                  }
                  return;
              }
              return if /\#/;
              return if /~$/;             # emacs temp files
              return if /,v$/;            # RCS files
              return if m{\.swp$};        # vim swap files
  
  	    my $path   = $File::Find::name;
              my $prefix = $self->{INST_LIBDIR};
              my $striplibpath;
  
  	    my $parentlibs_re = join '|', @{$self->{PMLIBPARENTDIRS}};
  	    $prefix =  $self->{INST_LIB} 
                  if ($striplibpath = $path) =~ s{^(\W*)($parentlibs_re)\W}
  	                                       {$1}i;
  
  	    my($inst) = $self->catfile($prefix,$striplibpath);
  	    local($_) = $inst; # for backwards compatibility
  	    $inst = $self->libscan($inst);
  	    print "libscan($path) => '$inst'\n" if ($Verbose >= 2);
  	    return unless $inst;
  	    $self->{PM}{$path} = $inst;
  	}, @{$self->{PMLIBDIRS}});
      }
  }
  
  
  =item init_DIRFILESEP
  
  Using / for Unix.  Called by init_main.
  
  =cut
  
  sub init_DIRFILESEP {
      my($self) = shift;
  
      $self->{DIRFILESEP} = '/';
  }
      
  
  =item init_main
  
  Initializes AR, AR_STATIC_ARGS, BASEEXT, CONFIG, DISTNAME, DLBASE,
  EXE_EXT, FULLEXT, FULLPERL, FULLPERLRUN, FULLPERLRUNINST, INST_*,
  INSTALL*, INSTALLDIRS, LIB_EXT, LIBPERL_A, MAP_TARGET, NAME,
  OBJ_EXT, PARENT_NAME, PERL, PERL_ARCHLIB, PERL_INC, PERL_LIB,
  PERL_SRC, PERLRUN, PERLRUNINST, PREFIX, VERSION,
  VERSION_SYM, XS_VERSION.
  
  =cut
  
  sub init_main {
      my($self) = @_;
  
      # --- Initialize Module Name and Paths
  
      # NAME    = Foo::Bar::Oracle
      # FULLEXT = Foo/Bar/Oracle
      # BASEEXT = Oracle
      # PARENT_NAME = Foo::Bar
  ### Only UNIX:
  ###    ($self->{FULLEXT} =
  ###     $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket
      $self->{FULLEXT} = $self->catdir(split /::/, $self->{NAME});
  
  
      # Copied from DynaLoader:
  
      my(@modparts) = split(/::/,$self->{NAME});
      my($modfname) = $modparts[-1];
  
      # Some systems have restrictions on files names for DLL's etc.
      # mod2fname returns appropriate file base name (typically truncated)
      # It may also edit @modparts if required.
      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");
  
          if (defined $Cross::platform) {
              $self->{PERL_ARCHLIB} = 
                $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform);
              $self->{PERL_INC}     = 
                $self->catdir("$self->{PERL_SRC}","xlib",$Cross::platform, 
                                   $Is{Win32}?("CORE"):());
          }
          else {
              $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
  	      }
  	    }
  	}	
      }
  
      # 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->{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_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', 'perl5', "perl$Config{version}");
  
      # miniperl has priority over all but the cannonical 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 );
      # don't check if perl is executable, maybe they have decided to
      # supply switches with perl
  
      # 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)
      ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/$perl_name/i
  	unless $self->{FULLPERL};
  
      # Little hack to get around VMS's find_perl putting "MCR" in front
      # sometimes.
      $self->{ABSPERL} = $self->{PERL};
      my $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;
      }
  
      # Are we building the core?
      $self->{PERL_CORE} = $ENV{PERL_CORE} unless exists $self->{PERL_CORE};
      $self->{PERL_CORE} = 0               unless defined $self->{PERL_CORE};
  
      # How do we run perl?
      foreach my $perl (qw(PERL FULLPERL ABSPERL)) {
          my $run  = $perl.'RUN';
  
          $self->{$run}  = "\$($perl)";
  
          # Make sure perl can find itself before it's installed.
          $self->{$run} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} 
            if $self->{UNINSTALLED_PERL} || $self->{PERL_CORE};
  
          $self->{$perl.'RUNINST'} = 
            sprintf q{$(%sRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"}, $perl;
      }
  
      return 1;
  }
  
  
  =item init_platform
  
  =item platform_constants
  
  Add MM_Unix_VERSION.
  
  =cut
  
  sub init_platform {
      my($self) = shift;
  
      $self->{MM_Unix_VERSION} = $VERSION;
      $self->{PERL_MALLOC_DEF} = '-DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc '.
                                 '-Dfree=Perl_mfree -Drealloc=Perl_realloc '.
                                 '-Dcalloc=Perl_calloc';
  
  }
  
  sub platform_constants {
      my($self) = shift;
      my $make_frag = '';
  
      foreach my $macro (qw(MM_Unix_VERSION PERL_MALLOC_DEF))
      {
          next unless defined $self->{$macro};
          $make_frag .= "$macro = $self->{$macro}\n";
      }
  
      return $make_frag;
  }
  
  
  =item init_PERM
  
    $mm->init_PERM
  
  Called by init_main.  Initializes PERL_*
  
  =cut
  
  sub init_PERM {
      my($self) = shift;
  
      $self->{PERM_DIR} = 755  unless defined $self->{PERM_DIR};
      $self->{PERM_RW}  = 644  unless defined $self->{PERM_RW};
      $self->{PERM_RWX} = 755  unless defined $self->{PERM_RWX};
  
      return 1;
  }
  
  
  =item init_xs
  
      $mm->init_xs
  
  Sets up macros having to do with XS code.  Currently just INST_STATIC,
  INST_DYNAMIC and INST_BOOT.
  
  =cut
  
  sub init_xs {
      my $self = shift;
  
      if ($self->has_link_code()) {
          $self->{INST_STATIC}  = 
            $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT)$(LIB_EXT)');
          $self->{INST_DYNAMIC} = 
            $self->catfile('$(INST_ARCHAUTODIR)', '$(DLBASE).$(DLEXT)');
          $self->{INST_BOOT}    = 
            $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT).bs');
      } else {
          $self->{INST_STATIC}  = '';
          $self->{INST_DYNAMIC} = '';
          $self->{INST_BOOT}    = '';
      }
  }    
  
  =item install (o)
  
  Defines the install target.
  
  =cut
  
  sub install {
      my($self, %attribs) = @_;
      my(@m);
  
      push @m, q{
  install :: pure_install doc_install
  	$(NOECHO) $(NOOP)
  
  install_perl :: pure_perl_install doc_perl_install
  	$(NOECHO) $(NOOP)
  
  install_site :: pure_site_install doc_site_install
  	$(NOECHO) $(NOOP)
  
  install_vendor :: pure_vendor_install doc_vendor_install
  	$(NOECHO) $(NOOP)
  
  pure_install :: pure_$(INSTALLDIRS)_install
  	$(NOECHO) $(NOOP)
  
  doc_install :: doc_$(INSTALLDIRS)_install
  	$(NOECHO) $(NOOP)
  
  pure__install : pure_site_install
  	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  
  doc__install : doc_site_install
  	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
  
  pure_perl_install :: all
  	$(NOECHO) $(MOD_INSTALL) \
  		read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
  		write }.$self->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').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) \
  		read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \
  		write }.$self->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').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) \
  		read }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \
  		write }.$self->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').q{ \
  		$(INST_LIB) $(DESTINSTALLVENDORLIB) \
  		$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
  		$(INST_BIN) $(DESTINSTALLVENDORBIN) \
  		$(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
  		$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
  		$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
  
  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{
  
  };
  
      push @m, q{
  uninstall :: uninstall_from_$(INSTALLDIRS)dirs
  	$(NOECHO) $(NOOP)
  
  uninstall_from_perldirs ::
  	$(NOECHO) $(UNINSTALL) }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{
  
  uninstall_from_sitedirs ::
  	$(NOECHO) $(UNINSTALL) }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{
  
  uninstall_from_vendordirs ::
  	$(NOECHO) $(UNINSTALL) }.$self->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').q{
  };
  
      join("",@m);
  }
  
  =item installbin (o)
  
  Defines targets to make and to install EXE_FILES.
  
  =cut
  
  sub installbin {
      my($self) = shift;
  
      return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
      my @exefiles = @{$self->{EXE_FILES}};
      return "" unless @exefiles;
  
      @exefiles = map vmsify($_), @exefiles if $Is{VMS};
  
      my %fromto;
      for my $from (@exefiles) {
  	my($path)= $self->catfile('$(INST_SCRIPT)', basename($from));
  
  	local($_) = $path; # for backwards compatibility
  	my $to = $self->libscan($path);
  	print "libscan($from) => '$to'\n" if ($Verbose >=2);
  
          $to = vmsify($to) if $Is{VMS};
  	$fromto{$from} = $to;
      }
      my @to   = values %fromto;
  
      my @m;
      push(@m, qq{
  EXE_FILES = @exefiles
  
  pure_all :: @to
  	\$(NOECHO) \$(NOOP)
  
  realclean ::
  });
  
      # realclean can get rather large.
      push @m, map "\t$_\n", $self->split_command('$(RM_F)', @to);
      push @m, "\n";
  
  
      # A target for each exe file.
      while (my($from,$to) = each %fromto) {
  	last unless defined $from;
  
  	push @m, sprintf <<'MAKE', $to, $from, $to, $from, $to, $to, $to;
  %s : %s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
  	$(NOECHO) $(RM_F) %s
  	$(CP) %s %s
  	$(FIXIN) %s
  	-$(NOECHO) $(CHMOD) $(PERM_RWX) %s
  
  MAKE
  
      }
  
      join "", @m;
  }
  
  
  =item linkext (o)
  
  Defines the linkext target which in turn defines the LINKTYPE.
  
  =cut
  
  sub linkext {
      my($self, %attribs) = @_;
      # LINKTYPE => static or dynamic or ''
      my($linktype) = defined $attribs{LINKTYPE} ?
        $attribs{LINKTYPE} : '$(LINKTYPE)';
      "
  linkext :: $linktype
  	\$(NOECHO) \$(NOOP)
  ";
  }
  
  =item lsdir
  
  Takes as arguments a directory name and a regular expression. Returns
  all entries in the directory that match the regular expression.
  
  =cut
  
  sub lsdir {
      my($self) = shift;
      my($dir, $regex) = @_;
      my(@ls);
      my $dh = new DirHandle;
      $dh->open($dir || ".") or return ();
      @ls = $dh->read;
      $dh->close;
      @ls = grep(/$regex/, @ls) if $regex;
      @ls;
  }
  
  =item macro (o)
  
  Simple subroutine to insert the macros defined by the macro attribute
  into the Makefile.
  
  =cut
  
  sub macro {
      my($self,%attribs) = @_;
      my(@m,$key,$val);
      while (($key,$val) = each %attribs){
  	last unless defined $key;
  	push @m, "$key = $val\n";
      }
      join "", @m;
  }
  
  =item makeaperl (o)
  
  Called by staticmake. Defines how to write the Makefile to produce a
  static new perl.
  
  By default the Makefile produced includes all the static extensions in
  the perl library. (Purified versions of library files, e.g.,
  DynaLoader_pure_p1_c0_032.a are automatically ignored to avoid link errors.)
  
  =cut
  
  sub makeaperl {
      my($self, %attribs) = @_;
      my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
  	@attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
      my(@m);
      push @m, "
  # --- MakeMaker makeaperl section ---
  MAP_TARGET    = $target
  FULLPERL      = $self->{FULLPERL}
  ";
      return join '', @m if $self->{PARENT};
  
      my($dir) = join ":", @{$self->{DIR}};
  
      unless ($self->{MAKEAPERL}) {
  	push @m, q{
  $(MAP_TARGET) :: static $(MAKE_APERL_FILE)
  	$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
  
  $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
  	$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
  	$(NOECHO) $(PERLRUNINST) \
  		Makefile.PL DIR=}, $dir, q{ \
  		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
  		MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=};
  
  	foreach (@ARGV){
  		if( /\s/ ){
  			s/=(.*)/='$1'/;
  		}
  		push @m, " \\\n\t\t$_";
  	}
  #	push @m, map( " \\\n\t\t$_", @ARGV );
  	push @m, "\n";
  
  	return join '', @m;
      }
  
  
  
      my($cccmd, $linkcmd, $lperl);
  
  
      $cccmd = $self->const_cccmd($libperl);
      $cccmd =~ s/^CCCMD\s*=\s*//;
      $cccmd =~ s/\$\(INC\)/ "-I$self->{PERL_INC}" /;
      $cccmd .= " $Config{cccdlflags}"
  	if ($Config{useshrplib} eq 'true');
      $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/;
  
      # The front matter of the linkcommand...
      $linkcmd = join ' ', "\$(CC)",
  	    grep($_, @Config{qw(ldflags ccdlflags)});
      $linkcmd =~ s/\s+/ /g;
      $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,;
  
      # Which *.a files could we make use of...
      my %static;
      require File::Find;
      File::Find::find(sub {
  	return unless m/\Q$self->{LIB_EXT}\E$/;
  
          # Skip perl's libraries.
          return if m/^libperl/ or m/^perl\Q$self->{LIB_EXT}\E$/;
  
  	# Skip purified versions of libraries 
          # (e.g., DynaLoader_pure_p1_c0_032.a)
  	return if m/_pure_\w+_\w+_\w+\.\w+$/ and -f "$File::Find::dir/.pure";
  
  	if( exists $self->{INCLUDE_EXT} ){
  		my $found = 0;
  
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,s;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything not explicitly marked for inclusion.
  		# DynaLoader is implied.
  		foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
  			if( $xx eq $incl ){
  				$found++;
  				last;
  			}
  		}
  		return unless $found;
  	}
  	elsif( exists $self->{EXCLUDE_EXT} ){
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,s;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything explicitly marked for exclusion
  		foreach my $excl (@{$self->{EXCLUDE_EXT}}){
  			return if( $xx eq $excl );
  		}
  	}
  
  	# don't include the installed version of this extension. I
  	# leave this line here, although it is not necessary anymore:
  	# I patched minimod.PL instead, so that Miniperl.pm won't
  	# enclude duplicates
  
  	# Once the patch to minimod.PL is in the distribution, I can
  	# drop it
  	return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}\z:;
  	use Cwd 'cwd';
  	$static{cwd() . "/" . $_}++;
      }, grep( -d $_, @{$searchdirs || []}) );
  
      # We trust that what has been handed in as argument, will be buildable
      $static = [] unless $static;
      @static{@{$static}} = (1) x @{$static};
  
      $extra = [] unless $extra && ref $extra eq 'ARRAY';
      for (sort keys %static) {
  	next unless /\Q$self->{LIB_EXT}\E\z/;
  	$_ = dirname($_) . "/extralibs.ld";
  	push @$extra, $_;
      }
  
      s/^(.*)/"-I$1"/ for @{$perlinc || []};
  
      $target ||= "perl";
      $tmp    ||= ".";
  
  # MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we
  # regenerate the Makefiles, MAP_STATIC and the dependencies for
  # extralibs.all are computed correctly
      push @m, "
  MAP_LINKCMD   = $linkcmd
  MAP_PERLINC   = @{$perlinc || []}
  MAP_STATIC    = ",
  join(" \\\n\t", reverse sort keys %static), "
  
  MAP_PRELIBS   = $Config{perllibs} $Config{cryptlib}
  ";
  
      if (defined $libperl) {
  	($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/;
      }
      unless ($libperl && -f $lperl) { # Ilya's code...
  	my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE";
  	$dir = "$self->{PERL_ARCHLIB}/.." if $self->{UNINSTALLED_PERL};
  	$libperl ||= "libperl$self->{LIB_EXT}";
  	$libperl   = "$dir/$libperl";
  	$lperl   ||= "libperl$self->{LIB_EXT}";
  	$lperl     = "$dir/$lperl";
  
          if (! -f $libperl and ! -f $lperl) {
            # We did not find a static libperl. Maybe there is a shared one?
            if ($Is{SunOS}) {
              $lperl  = $libperl = "$dir/$Config{libperl}";
              # SUNOS ld does not take the full path to a shared library
              $libperl = '' if $Is{SunOS4};
            }
          }
  
  	print "Warning: $libperl not found
      If you're going to build a static perl binary, make sure perl is installed
      otherwise ignore this warning\n"
  		unless (-f $lperl || defined($self->{PERL_SRC}));
      }
  
      # SUNOS ld does not take the full path to a shared library
      my $llibperl = $libperl ? '$(MAP_LIBPERL)' : '-lperl';
  
      push @m, "
  MAP_LIBPERL = $libperl
  LLIBPERL    = $llibperl
  ";
  
      push @m, '
  $(INST_ARCHAUTODIR)/extralibs.all : $(INST_ARCHAUTODIR)$(DFSEP).exists '.join(" \\\n\t", @$extra).'
  	$(NOECHO) $(RM_F)  $@
  	$(NOECHO) $(TOUCH) $@
  ';
  
      foreach my $catfile (@$extra){
  	push @m, "\tcat $catfile >> \$\@\n";
      }
  
  push @m, "
  \$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
  	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) \$(LLIBPERL) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
  	\$(NOECHO) \$(ECHO) 'To install the new \"\$(MAP_TARGET)\" binary, call'
  	\$(NOECHO) \$(ECHO) '    \$(MAKE) \$(USEMAKEFILE) $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
  	\$(NOECHO) \$(ECHO) 'To remove the intermediate files say'
  	\$(NOECHO) \$(ECHO) '    \$(MAKE) \$(USEMAKEFILE) $makefilename map_clean'
  
  $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
  ";
      push @m, "\t".$self->cd($tmp, qq[$cccmd "-I\$(PERL_INC)" perlmain.c])."\n";
  
      push @m, qq{
  $tmp/perlmain.c: $makefilename}, q{
  	$(NOECHO) $(ECHO) Writing $@
  	$(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \\
  		-e "writemain(grep s#.*/auto/##s, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@
  
  };
      push @m, "\t", q{$(NOECHO) $(PERL) $(INSTALLSCRIPT)/fixpmain
  } if (defined (&Dos::UseLFN) && Dos::UseLFN()==0);
  
  
      push @m, q{
  doc_inst_perl :
  	$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLARCHLIB)/perllocal.pod
  	-$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  	-$(NOECHO) $(DOC_INSTALL) \
  		"Perl binary" "$(MAP_TARGET)" \
  		MAP_STATIC "$(MAP_STATIC)" \
  		MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \
  		MAP_LIBPERL "$(MAP_LIBPERL)" \
  		>> }.$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q{
  
  };
  
      push @m, q{
  inst_perl : pure_inst_perl doc_inst_perl
  
  pure_inst_perl : $(MAP_TARGET)
  	}.$self->{CP}.q{ $(MAP_TARGET) }.$self->catfile('$(DESTINSTALLBIN)','$(MAP_TARGET)').q{
  
  clean :: map_clean
  
  map_clean :
  	}.$self->{RM_F}.qq{ $tmp/perlmain\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all
  };
  
      join '', @m;
  }
  
  =item makefile (o)
  
  Defines how to rewrite the Makefile.
  
  =cut
  
  sub makefile {
      my($self) = shift;
      my $m;
      # We do not know what target was originally specified so we
      # must force a manual rerun to be sure. But as it should only
      # happen very rarely it is not a significant problem.
      $m = '
  $(OBJECT) : $(FIRST_MAKEFILE)
  
  ' if $self->{OBJECT};
  
      my $newer_than_target = $Is{VMS} ? '$(MMS$SOURCE_LIST)' : '$?';
      my $mpl_args = join " ", map qq["$_"], @ARGV;
  
      $m .= sprintf <<'MAKE_FRAG', $newer_than_target, $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) Makefile.PL %s
  	$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
  	$(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command.  <=="
  	$(FALSE)
  
  MAKE_FRAG
  
      return $m;
  }
  
  
  =item maybe_command
  
  Returns true, if the argument is likely to be a command.
  
  =cut
  
  sub maybe_command {
      my($self,$file) = @_;
      return $file if -x $file && ! -d $file;
      return;
  }
  
  
  =item needs_linking (o)
  
  Does this module need linking? Looks into subdirectory objects (see
  also has_link_code())
  
  =cut
  
  sub needs_linking {
      my($self) = shift;
  
      my $caller = (caller(0))[3];
      confess("needs_linking called too early") if 
        $caller =~ /^ExtUtils::MakeMaker::/;
      return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING};
      if ($self->has_link_code or $self->{MAKEAPERL}){
  	$self->{NEEDS_LINKING} = 1;
  	return 1;
      }
      foreach my $child (keys %{$self->{CHILDREN}}) {
  	if ($self->{CHILDREN}->{$child}->needs_linking) {
  	    $self->{NEEDS_LINKING} = 1;
  	    return 1;
  	}
      }
      return $self->{NEEDS_LINKING} = 0;
  }
  
  
  =item parse_abstract
  
  parse a file and return what you think is the ABSTRACT
  
  =cut
  
  sub parse_abstract {
      my($self,$parsefile) = @_;
      my $result;
  
      local $/ = "\n";
      open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!";
      my $inpod = 0;
      my $package = $self->{DISTNAME};
      $package =~ s/-/::/g;
      while (<$fh>) {
          $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
          next if !$inpod;
          chop;
          next unless /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x;
          $result = $2;
          last;
      }
      close $fh;
  
      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 ) {
              my $eval = qq{
                  package ExtUtils::MakeMaker::_version;
                  no strict;
                  BEGIN { eval {
                      # Ensure any version() routine which might have leaked
                      # into this package has been deleted.  Interferes with
                      # version->import()
                      undef *version;
                      require version;
                      "version"->import;
                  } }
  
                  local $1$2;
                  \$$2=undef;
                  do {
                      $_
                  };
                  \$$2;
              };
              local $^W = 0;
              $result = eval($eval);  ## no critic
              warn "Could not eval '$eval' in $parsefile: $@" if $@;
          }
          else {
            next;
          }
          last if defined $result;
      }
      close $fh;
  
      $result = "undef" unless defined $result;
      return $result;
  }
  
  
  =item pasthru (o)
  
  Defines the string that is passed to recursive make calls in
  subdirectories.
  
  =cut
  
  sub pasthru {
      my($self) = shift;
      my(@m);
  
      my(@pasthru);
      my($sep) = $Is{VMS} ? ',' : '';
      $sep .= "\\\n\t";
  
      foreach my $key (qw(LIB LIBPERL_A LINKTYPE OPTIMIZE
                       PREFIX INSTALL_BASE)
                   ) 
      {
          next unless defined $self->{$key};
  	push @pasthru, "$key=\"\$($key)\"";
      }
  
      foreach my $key (qw(DEFINE INC)) {
          next unless defined $self->{$key};
  	push @pasthru, "PASTHRU_$key=\"\$(PASTHRU_$key)\"";
      }
  
      push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n";
      join "", @m;
  }
  
  =item perl_script
  
  Takes one argument, a file name, and returns the file name, if the
  argument is likely to be a perl script. On MM_Unix this is true for
  any ordinary, readable file.
  
  =cut
  
  sub perl_script {
      my($self,$file) = @_;
      return $file if -r $file && -f _;
      return;
  }
  
  =item perldepend (o)
  
  Defines the dependency from all *.h files that come with the perl
  distribution.
  
  =cut
  
  sub perldepend {
      my($self) = shift;
      my(@m);
  
      my $make_config = $self->cd('$(PERL_SRC)', '$(MAKE) lib/Config.pm');
  
      push @m, sprintf <<'MAKE_FRAG', $make_config if $self->{PERL_SRC};
  # Check for unpropogated config.sh changes. Should never happen.
  # We do NOT just update config.h because that is not sufficient.
  # An out of date config.h is not fatal but complains loudly!
  $(PERL_INC)/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;
  
      push @m, q{
  PERL_HDRS = \
  	$(PERL_INC)/EXTERN.h		\
  	$(PERL_INC)/INTERN.h		\
  	$(PERL_INC)/XSUB.h		\
  	$(PERL_INC)/av.h		\
  	$(PERL_INC)/config.h		\
  	$(PERL_INC)/cop.h		\
  	$(PERL_INC)/cv.h		\
  	$(PERL_INC)/dosish.h		\
  	$(PERL_INC)/embed.h		\
  	$(PERL_INC)/embedvar.h		\
  	$(PERL_INC)/fakethr.h		\
  	$(PERL_INC)/form.h		\
  	$(PERL_INC)/gv.h		\
  	$(PERL_INC)/handy.h		\
  	$(PERL_INC)/hv.h		\
  	$(PERL_INC)/intrpvar.h		\
  	$(PERL_INC)/iperlsys.h		\
  	$(PERL_INC)/keywords.h		\
  	$(PERL_INC)/mg.h		\
  	$(PERL_INC)/nostdio.h		\
  	$(PERL_INC)/op.h		\
  	$(PERL_INC)/opcode.h		\
  	$(PERL_INC)/patchlevel.h	\
  	$(PERL_INC)/perl.h		\
  	$(PERL_INC)/perlio.h		\
  	$(PERL_INC)/perlsdio.h		\
  	$(PERL_INC)/perlsfio.h		\
  	$(PERL_INC)/perlvars.h		\
  	$(PERL_INC)/perly.h		\
  	$(PERL_INC)/pp.h		\
  	$(PERL_INC)/pp_proto.h		\
  	$(PERL_INC)/proto.h		\
  	$(PERL_INC)/regcomp.h		\
  	$(PERL_INC)/regexp.h		\
  	$(PERL_INC)/regnodes.h		\
  	$(PERL_INC)/scope.h		\
  	$(PERL_INC)/sv.h		\
  	$(PERL_INC)/thread.h		\
  	$(PERL_INC)/unixish.h		\
  	$(PERL_INC)/util.h
  
  $(OBJECT) : $(PERL_HDRS)
  } if $self->{OBJECT};
  
      push @m, join(" ", values %{$self->{XS}})." : \$(XSUBPPDEPS)\n"  if %{$self->{XS}};
  
      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, %{$self->{PM}});
  
      $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds;
      $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n};
  
      return $r;
  }
  
  =item post_constants (o)
  
  Returns an empty string per default. Dedicated to overrides from
  within Makefile.PL after all constants have been defined.
  
  =cut
  
  sub post_constants{
      "";
  }
  
  =item post_initialize (o)
  
  Returns an empty string per default. Used in Makefile.PLs to add some
  chunk of text to the Makefile after the object is initialized.
  
  =cut
  
  sub post_initialize {
      "";
  }
  
  =item postamble (o)
  
  Returns an empty string. Can be used in Makefile.PLs to write some
  text to the Makefile at the end.
  
  =cut
  
  sub postamble {
      "";
  }
  
  # transform dot-separated version string into comma-separated quadruple
  # examples:  '1.2.3.4.5' => '1,2,3,4'
  #            '1.2.3'     => '1,2,3,0'
  sub _ppd_version {
      my ($self, $string) = @_;
      return join ',', ((split /\./, $string), (0) x 4)[0..3];
  }
  
  =item ppd
  
  Defines target that creates a PPD (Perl Package Description) file
  for a binary distribution.
  
  =cut
  
  sub ppd {
      my($self) = @_;
  
      my $abstract = $self->{ABSTRACT} || '';
      $abstract =~ s/\n/\\n/sg;
      $abstract =~ s/</&lt;/g;
      $abstract =~ s/>/&gt;/g;
  
      my $author = join(', ',@{$self->{AUTHOR} || []});
      $author =~ s/</&lt;/g;
      $author =~ s/>/&gt;/g;
  
      my $ppd_file = '$(DISTNAME).ppd';
  
      my @ppd_cmds = $self->echo(<<'PPD_HTML', $ppd_file, { append => 0, allow_variables => 1 });
  <SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">
  PPD_HTML
  
      my $ppd_xml = sprintf <<'PPD_HTML', $abstract, $author;
      <ABSTRACT>%s</ABSTRACT>
      <AUTHOR>%s</AUTHOR>
  PPD_HTML
  
      $ppd_xml .= "    <IMPLEMENTATION>\n";
      if ( $self->{MIN_PERL_VERSION} ) {
          my $min_perl_version = $self->_ppd_version($self->{MIN_PERL_VERSION});
          $ppd_xml .= sprintf <<'PPD_PERLVERS', $min_perl_version;
          <PERLCORE VERSION="%s" />
  PPD_PERLVERS
  
      }
  
      # Don't add "perl" to requires.  perl dependencies are
      # handles by ARCHITECTURE.
      my %prereqs = %{$self->{PREREQ_PM}};
      delete $prereqs{perl};
  
      # Build up REQUIRE
      foreach my $prereq (sort keys %prereqs) {
          my $name = $prereq;
          $name .= '::' unless $name =~ /::/;
          my $version = $prereqs{$prereq}+0;  # force numification
  
          my %attrs = ( NAME => $name );
          $attrs{VERSION} = $version if $version;
          my $attrs = join " ", map { qq[$_="$attrs{$_}"] } keys %attrs;
          $ppd_xml .= qq(        <REQUIRE $attrs />\n);
      }
  
      my $archname = $Config{archname};
      if ($] >= 5.008) {
          # archname did not change from 5.6 to 5.8, but those versions may
          # not be not binary compatible so now we append the part of the
          # version that changes when binary compatibility may change
          $archname .= "-$Config{PERL_REVISION}.$Config{PERL_VERSION}";
      }
      $ppd_xml .= sprintf <<'PPD_OUT', $archname;
          <ARCHITECTURE NAME="%s" />
  PPD_OUT
  
      if ($self->{PPM_INSTALL_SCRIPT}) {
          if ($self->{PPM_INSTALL_EXEC}) {
              $ppd_xml .= sprintf qq{        <INSTALL EXEC="%s">%s</INSTALL>\n},
                    $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT};
          }
          else {
              $ppd_xml .= sprintf qq{        <INSTALL>%s</INSTALL>\n}, 
                    $self->{PPM_INSTALL_SCRIPT};
          }
      }
  
      my ($bin_location) = $self->{BINARY_LOCATION} || '';
      $bin_location =~ s/\\/\\\\/g;
  
      $ppd_xml .= sprintf <<'PPD_XML', $bin_location;
          <CODEBASE HREF="%s" />
      </IMPLEMENTATION>
  </SOFTPKG>
  PPD_XML
  
      push @ppd_cmds, $self->echo($ppd_xml, $ppd_file, { append => 1 });
  
      return sprintf <<'PPD_OUT', join "\n\t", @ppd_cmds;
  # Creates a PPD (Perl Package Description) for a binary distribution.
  ppd :
  	%s
  PPD_OUT
  
  }
  
  =item prefixify
  
    $MM->prefixify($var, $prefix, $new_prefix, $default);
  
  Using either $MM->{uc $var} || $Config{lc $var}, it will attempt to
  replace it's $prefix with a $new_prefix.  
  
  Should the $prefix fail to match I<AND> a PREFIX was given as an
  argument to WriteMakefile() it will set it to the $new_prefix +
  $default.  This is for systems whose file layouts don't neatly fit into
  our ideas of prefixes.
  
  This is for heuristics which attempt to create directory structures
  that mirror those of the installed perl.
  
  For example:
  
      $MM->prefixify('installman1dir', '/usr', '/home/foo', 'man/man1');
  
  this will attempt to remove '/usr' from the front of the
  $MM->{INSTALLMAN1DIR} path (initializing it to $Config{installman1dir}
  if necessary) and replace it with '/home/foo'.  If this fails it will
  simply use '/home/foo/man/man1'.
  
  =cut
  
  sub prefixify {
      my($self,$var,$sprefix,$rprefix,$default) = @_;
  
      my $path = $self->{uc $var} || 
                 $Config_Override{lc $var} || $Config{lc $var} || '';
  
      $rprefix .= '/' if $sprefix =~ m|/$|;
  
      warn "  prefixify $var => $path\n" if $Verbose >= 2;
      warn "    from $sprefix to $rprefix\n" if $Verbose >= 2;
  
      if( $self->{ARGS}{PREFIX} &&
          $path !~ s{^\Q$sprefix\E\b}{$rprefix}s ) 
      {
  
          warn "    cannot prefix, using default.\n" if $Verbose >= 2;
          warn "    no default!\n" if !$default && $Verbose >= 2;
  
          $path = $self->catdir($rprefix, $default) if $default;
      }
  
      print "    now $path\n" if $Verbose >= 2;
      return $self->{uc $var} = $path;
  }
  
  
  =item processPL (o)
  
  Defines targets to run *.PL files.
  
  =cut
  
  sub processPL {
      my $self = shift;
      my $pl_files = $self->{PL_FILES};
  
      return "" unless $pl_files;
  
      my $m = '';
      foreach my $plfile (sort keys %$pl_files) {
          my $list = ref($pl_files->{$plfile})
                       ?  $pl_files->{$plfile}
  		     : [$pl_files->{$plfile}];
  
  	foreach my $target (@$list) {
              if( $Is{VMS} ) {
                  $plfile = vmsify($self->eliminate_macros($plfile));
                  $target = vmsify($self->eliminate_macros($target));
              }
  
  	    # Normally a .PL file runs AFTER pm_to_blib so it can have
  	    # blib in its @INC and load the just built modules.  BUT if
  	    # the generated module is something in $(TO_INST_PM) which
  	    # pm_to_blib depends on then it can't depend on pm_to_blib
  	    # else we have a dependency loop.
  	    my $pm_dep;
  	    my $perlrun;
  	    if( defined $self->{PM}{$target} ) {
  		$pm_dep  = '';
  		$perlrun = 'PERLRUN';
  	    }
  	    else {
  		$pm_dep  = 'pm_to_blib';
  		$perlrun = 'PERLRUNINST';
  	    }
  
              $m .= <<MAKE_FRAG;
  
  all :: $target
  	\$(NOECHO) \$(NOOP)
  
  $target :: $plfile $pm_dep
  	\$($perlrun) $plfile $target
  MAKE_FRAG
  
  	}
      }
  
      return $m;
  }
  
  =item quote_paren
  
  Backslashes parentheses C<()> in command line arguments.
  Doesn't handle recursive Makefile C<$(...)> constructs,
  but handles simple ones.
  
  =cut
  
  sub quote_paren {
      my $arg = shift;
      $arg =~ s{\$\((.+?)\)}{\$\\\\($1\\\\)}g;	# protect $(...)
      $arg =~ s{(?<!\\)([()])}{\\$1}g;		# quote unprotected
      $arg =~ s{\$\\\\\((.+?)\\\\\)}{\$($1)}g;	# unprotect $(...)
      return $arg;
  }
  
  =item replace_manpage_separator
  
    my $man_name = $MM->replace_manpage_separator($file_path);
  
  Takes the name of a package, which may be a nested package, in the
  form 'Foo/Bar.pm' and replaces the slash with C<::> or something else
  safe for a man page file name.  Returns the replacement.
  
  =cut
  
  sub replace_manpage_separator {
      my($self,$man) = @_;
  
      $man =~ s,/+,::,g;
      return $man;
  }
  
  
  =item cd
  
  =cut
  
  sub cd {
      my($self, $dir, @cmds) = @_;
  
      # No leading tab and no trailing newline makes for easier embedding
      my $make_frag = join "\n\t", map { "cd $dir && $_" } @cmds;
  
      return $make_frag;
  }
  
  =item oneliner
  
  =cut
  
  sub oneliner {
      my($self, $cmd, $switches) = @_;
      $switches = [] unless defined $switches;
  
      # Strip leading and trailing newlines
      $cmd =~ s{^\n+}{};
      $cmd =~ s{\n+$}{};
  
      my @cmds = split /\n/, $cmd;
      $cmd = join " \n\t  -e ", map $self->quote_literal($_), @cmds;
      $cmd = $self->escape_newlines($cmd);
  
      $switches = join ' ', @$switches;
  
      return qq{\$(ABSPERLRUN) $switches -e $cmd --};   
  }
  
  
  =item quote_literal
  
  =cut
  
  sub quote_literal {
      my($self, $text, $opts) = @_;
      $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
  
      # Quote single quotes
      $text =~ s{'}{'\\''}g;
  
      $text = $opts->{allow_variables}
        ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
  
      return "'$text'";
  }
  
  
  =item escape_newlines
  
  =cut
  
  sub escape_newlines {
      my($self, $text) = @_;
  
      $text =~ s{\n}{\\\n}g;
  
      return $text;
  }
  
  
  =item max_exec_len
  
  Using POSIX::ARG_MAX.  Otherwise falling back to 4096.
  
  =cut
  
  sub max_exec_len {
      my $self = shift;
  
      if (!defined $self->{_MAX_EXEC_LEN}) {
          if (my $arg_max = eval { require POSIX;  &POSIX::ARG_MAX }) {
              $self->{_MAX_EXEC_LEN} = $arg_max;
          }
          else {      # POSIX minimum exec size
              $self->{_MAX_EXEC_LEN} = 4096;
          }
      }
  
      return $self->{_MAX_EXEC_LEN};
  }
  
  
  =item static (o)
  
  Defines the static target.
  
  =cut
  
  sub static {
  # --- Static Loading Sections ---
  
      my($self) = shift;
      '
  ## $(INST_PM) has been moved to the all: target.
  ## It remains here for awhile to allow for old usage: "make static"
  static :: $(FIRST_MAKEFILE) $(INST_STATIC)
  	$(NOECHO) $(NOOP)
  ';
  }
  
  =item static_lib (o)
  
  Defines how to produce the *.a (or equivalent) files.
  
  =cut
  
  sub static_lib {
      my($self) = @_;
      return '' unless $self->has_link_code;
  
      my(@m);
      push(@m, <<'END');
  
  $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(RM_RF) $@
  END
  
      # If this extension has its own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      push(@m, <<'MAKE_FRAG') if $self->{MYEXTLIB};
  	$(CP) $(MYEXTLIB) $@
  MAKE_FRAG
  
      my $ar; 
      if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) {
          # Prefer the absolute pathed ar if available so that PATH
          # doesn't confuse us.  Perl itself is built with the full_ar.  
          $ar = 'FULL_AR';
      } else {
          $ar = 'AR';
      }
      push @m, sprintf <<'MAKE_FRAG', $ar;
  	$(%s) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
  	$(CHMOD) $(PERM_RWX) $@
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
  MAKE_FRAG
  
      # Old mechanism - still available:
      push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs
  MAKE_FRAG
  
      join('', @m);
  }
  
  =item staticmake (o)
  
  Calls makeaperl.
  
  =cut
  
  sub staticmake {
      my($self, %attribs) = @_;
      my(@static);
  
      my(@searchdirs)=($self->{PERL_ARCHLIB}, $self->{SITEARCHEXP},  $self->{INST_ARCHLIB});
  
      # And as it's not yet built, we add the current extension
      # but only if it has some C code (or XS code, which implies C code)
      if (@{$self->{C}}) {
  	@static = $self->catfile($self->{INST_ARCHLIB},
  				 "auto",
  				 $self->{FULLEXT},
  				 "$self->{BASEEXT}$self->{LIB_EXT}"
  				);
      }
  
      # Either we determine now, which libraries we will produce in the
      # subdirectories or we do it at runtime of the make.
  
      # We could ask all subdir objects, but I cannot imagine, why it
      # would be necessary.
  
      # Instead we determine all libraries for the new perl at
      # runtime.
      my(@perlinc) = ($self->{INST_ARCHLIB}, $self->{INST_LIB}, $self->{PERL_ARCHLIB}, $self->{PERL_LIB});
  
      $self->makeaperl(MAKE	=> $self->{MAKEFILE},
  		     DIRS	=> \@searchdirs,
  		     STAT	=> \@static,
  		     INCL	=> \@perlinc,
  		     TARGET	=> $self->{MAP_TARGET},
  		     TMP	=> "",
  		     LIBPERL	=> $self->{LIBPERL_A}
  		    );
  }
  
  =item subdir_x (o)
  
  Helper subroutine for subdirs
  
  =cut
  
  sub subdir_x {
      my($self, $subdir) = @_;
  
      my $subdir_cmd = $self->cd($subdir, 
        '$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASTHRU)'
      );
      return sprintf <<'EOT', $subdir_cmd;
  
  subdirs ::
  	$(NOECHO) %s
  EOT
  
  }
  
  =item subdirs (o)
  
  Defines targets to process subdirectories.
  
  =cut
  
  sub subdirs {
  # --- Sub-directory Sections ---
      my($self) = shift;
      my(@m);
      # This method provides a mechanism to automatically deal with
      # subdirectories containing further Makefile.PL scripts.
      # It calls the subdir_x() method for each subdirectory.
      foreach my $dir (@{$self->{DIR}}){
  	push(@m, $self->subdir_x($dir));
  ####	print "Including $dir subdirectory\n";
      }
      if (@m){
  	unshift(@m, "
  # The default clean, realclean and test targets in this Makefile
  # have automatically been given entries for each subdir.
  
  ");
      } else {
  	push(@m, "\n# none")
      }
      join('',@m);
  }
  
  =item test (o)
  
  Defines the test targets.
  
  =cut
  
  sub test {
  # --- Test and Installation Sections ---
  
      my($self, %attribs) = @_;
      my $tests = $attribs{TESTS} || '';
      if (!$tests && -d 't') {
          $tests = $self->find_tests;
      }
      # note: 'test.pl' name is also hardcoded in init_dirscan()
      my(@m);
      push(@m,"
  TEST_VERBOSE=0
  TEST_TYPE=test_\$(LINKTYPE)
  TEST_FILE = test.pl
  TEST_FILES = $tests
  TESTDB_SW = -d
  
  testdb :: testdb_\$(LINKTYPE)
  
  test :: \$(TEST_TYPE) subdirs-test
  
  subdirs-test ::
  	\$(NOECHO) \$(NOOP)
  
  ");
  
      foreach my $dir (@{ $self->{DIR} }) {
          my $test = $self->cd($dir, '$(MAKE) test $(PASTHRU)');
  
          push @m, <<END
  subdirs-test ::
  	\$(NOECHO) $test
  
  END
      }
  
      push(@m, "\t\$(NOECHO) \$(ECHO) 'No tests defined for \$(NAME) extension.'\n")
  	unless $tests or -f "test.pl" or @{$self->{DIR}};
      push(@m, "\n");
  
      push(@m, "test_dynamic :: pure_all\n");
      push(@m, $self->test_via_harness('$(FULLPERLRUN)', '$(TEST_FILES)')) 
        if $tests;
      push(@m, $self->test_via_script('$(FULLPERLRUN)', '$(TEST_FILE)')) 
        if -f "test.pl";
      push(@m, "\n");
  
      push(@m, "testdb_dynamic :: pure_all\n");
      push(@m, $self->test_via_script('$(FULLPERLRUN) $(TESTDB_SW)', 
                                      '$(TEST_FILE)'));
      push(@m, "\n");
  
      # Occasionally we may face this degenerate target:
      push @m, "test_ : test_dynamic\n\n";
  
      if ($self->needs_linking()) {
  	push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
  	push(@m, $self->test_via_harness('./$(MAP_TARGET)', '$(TEST_FILES)')) if $tests;
  	push(@m, $self->test_via_script('./$(MAP_TARGET)', '$(TEST_FILE)')) if -f "test.pl";
  	push(@m, "\n");
  	push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
  	push(@m, $self->test_via_script('./$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
  	push(@m, "\n");
      } else {
  	push @m, "test_static :: test_dynamic\n";
  	push @m, "testdb_static :: testdb_dynamic\n";
      }
      join("", @m);
  }
  
  =item test_via_harness (override)
  
  For some reason which I forget, Unix machines like to have
  PERL_DL_NONLAZY set for tests.
  
  =cut
  
  sub test_via_harness {
      my($self, $perl, $tests) = @_;
      return $self->SUPER::test_via_harness("PERL_DL_NONLAZY=1 $perl", $tests);
  }
  
  =item test_via_script (override)
  
  Again, the PERL_DL_NONLAZY thing.
  
  =cut
  
  sub test_via_script {
      my($self, $perl, $script) = @_;
      return $self->SUPER::test_via_script("PERL_DL_NONLAZY=1 $perl", $script);
  }
  
  
  =item tool_xsubpp (o)
  
  Determines typemaps, xsubpp version, prototype behaviour.
  
  =cut
  
  sub tool_xsubpp {
      my($self) = shift;
      return "" unless $self->needs_linking;
  
      my $xsdir;
      my @xsubpp_dirs = @INC;
  
      # Make sure we pick up the new xsubpp if we're building perl.
      unshift @xsubpp_dirs, $self->{PERL_LIB} if $self->{PERL_CORE};
  
      foreach my $dir (@xsubpp_dirs) {
          $xsdir = $self->catdir($dir, 'ExtUtils');
          if( -r $self->catfile($xsdir, "xsubpp") ) {
              last;
          }
      }
  
      my $tmdir   = File::Spec->catdir($self->{PERL_LIB},"ExtUtils");
      my(@tmdeps) = $self->catfile($tmdir,'typemap');
      if( $self->{TYPEMAPS} ){
          foreach my $typemap (@{$self->{TYPEMAPS}}){
              if( ! -f  $typemap ) {
                  warn "Typemap $typemap not found.\n";
              }
              else {
                  push(@tmdeps,  $typemap);
              }
          }
      }
      push(@tmdeps, "typemap") if -f "typemap";
      my(@tmargs) = map("-typemap $_", @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};
  
      return qq{
  XSUBPPDIR = $xsdir
  XSUBPP = \$(XSUBPPDIR)\$(DFSEP)xsubpp
  XSUBPPRUN = \$(PERLRUN) \$(XSUBPP)
  XSPROTOARG = $self->{XSPROTOARG}
  XSUBPPDEPS = @tmdeps \$(XSUBPP)
  XSUBPPARGS = @tmargs
  XSUBPP_EXTRA_ARGS = 
  };
  };
  
  
  =item all_target
  
  Build man pages, too
  
  =cut
  
  sub all_target {
      my $self = shift;
  
      return <<'MAKE_EXT';
  all :: pure_all manifypods
  	$(NOECHO) $(NOOP)
  MAKE_EXT
  }
  
  =item top_targets (o)
  
  Defines the targets all, subdirs, config, and O_FILES
  
  =cut
  
  sub top_targets {
  # --- Target Sections ---
  
      my($self) = shift;
      my(@m);
  
      push @m, $self->all_target, "\n" unless $self->{SKIPHASH}{'all'};
  
      push @m, '
  pure_all :: config pm_to_blib subdirs linkext
  	$(NOECHO) $(NOOP)
  
  subdirs :: $(MYEXTLIB)
  	$(NOECHO) $(NOOP)
  
  config :: $(FIRST_MAKEFILE) blibdirs
  	$(NOECHO) $(NOOP)
  ';
  
      push @m, '
  $(O_FILES): $(H_FILES)
  ' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
  
      push @m, q{
  help :
  	perldoc ExtUtils::MakeMaker
  };
  
      join('',@m);
  }
  
  =item writedoc
  
  Obsolete, deprecated method. Not used since Version 5.21.
  
  =cut
  
  sub writedoc {
  # --- perllocal.pod section ---
      my($self,$what,$name,@attribs)=@_;
      my $time = localtime;
      print "=head2 $time: $what C<$name>\n\n=over 4\n\n=item *\n\n";
      print join "\n\n=item *\n\n", map("C<$_>",@attribs);
      print "\n\n=back\n\n";
  }
  
  =item xs_c (o)
  
  Defines the suffix rules to compile XS files to C.
  
  =cut
  
  sub xs_c {
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs.c:
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
  ';
  }
  
  =item xs_cpp (o)
  
  Defines the suffix rules to compile XS files to C++.
  
  =cut
  
  sub xs_cpp {
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs.cpp:
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp
  ';
  }
  
  =item xs_o (o)
  
  Defines suffix rules to go from XS to object files directly. This is
  only intended for broken make implementations.
  
  =cut
  
  sub xs_o {	# many makes are too dumb to use xs_c then c_o
      my($self) = shift;
      return '' unless $self->needs_linking();
      '
  .xs$(OBJ_EXT):
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
  	$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
  ';
  }
  
  
  1;
  
  =back
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker>
  
  =cut
  
  __END__
EXTUTILS_MM_UNIX

$fatpacked{"ExtUtils/MM_VMS.pm"} = <<'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 = '6.64';
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  
  use ExtUtils::MakeMaker qw($Verbose neatvalue);
  our $Revision = $ExtUtils::MakeMaker::Revision;
  
  
  =head1 NAME
  
  ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
    Do not use this directly.
    Instead, use ExtUtils::MM and it will figure out which MM_*
    class to use for you.
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =head2 Methods always loaded
  
  =over 4
  
  =item wraplist
  
  Converts a list into a string wrapped at approximately 80 columns.
  
  =cut
  
  sub wraplist {
      my($self) = shift;
      my($line,$hlen) = ('',0);
  
      foreach my $word (@_) {
        # Perl bug -- seems to occasionally insert extra elements when
        # traversing array (scalar(@array) doesn't show them, but
        # foreach(@array) does) (5.00307)
        next unless $word =~ /\w/;
        $line .= ' ' if length($line);
        if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
        $line .= $word;
        $hlen += length($word) + 2;
      }
      $line;
  }
  
  
  # This isn't really an override.  It's just here because ExtUtils::MM_VMS
  # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext()
  # in MM_VMS, then AUTOLOAD is called, and bad things happen.  So, we just
  # mimic inheritance here and hand off to ExtUtils::Liblist::Kid.
  # XXX This hackery will die soon. --Schwern
  sub ext {
      require ExtUtils::Liblist::Kid;
      goto &ExtUtils::Liblist::Kid::ext;
  }
  
  =back
  
  =head2 Methods
  
  Those methods which override default MM_Unix methods are marked
  "(override)", while methods unique to MM_VMS are marked "(specific)".
  For overridden methods, documentation is limited to an explanation
  of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
  documentation for more details.
  
  =over 4
  
  =item guess_name (override)
  
  Try to determine name of extension being built.  We begin with the name
  of the current directory.  Since VMS filenames are case-insensitive,
  however, we look for a F<.pm> file whose name matches that of the current
  directory (presumably the 'main' F<.pm> file for this extension), and try
  to find a C<package> statement from which to obtain the Mixed::Case
  package name.
  
  =cut
  
  sub guess_name {
      my($self) = @_;
      my($defname,$defpm,@pm,%xs);
      local *PM;
  
      $defname = basename(fileify($ENV{'DEFAULT'}));
      $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
      $defpm = $defname;
      # Fallback in case for some reason a user has copied the files for an
      # extension into a working directory whose name doesn't reflect the
      # extension's name.  We'll use the name of a unique .pm file, or the
      # first .pm file with a matching .xs file.
      if (not -e "${defpm}.pm") {
        @pm = glob('*.pm');
        s/.pm$// for @pm;
        if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
        elsif (@pm) {
          %xs = map { s/.xs$//; ($_,1) } glob('*.xs');  ## no critic
          if (keys %xs) { 
              foreach my $pm (@pm) { 
                  $defpm = $pm, last if exists $xs{$pm}; 
              } 
          }
        }
      }
      if (open(my $pm, '<', "${defpm}.pm")){
          while (<$pm>) {
              if (/^\s*package\s+([^;]+)/i) {
                  $defname = $1;
                  last;
              }
          }
          print "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
                       "defaulting package name to $defname\n"
              if eof($pm);
          close $pm;
      }
      else {
          print "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
                       "defaulting package name to $defname\n";
      }
      $defname =~ s#[\d.\-_]+$##;
      $defname;
  }
  
  =item find_perl (override)
  
  Use VMS file specification syntax and CLI commands to find and
  invoke Perl images.
  
  =cut
  
  sub find_perl {
      my($self, $ver, $names, $dirs, $trace) = @_;
      my($vmsfile,@sdirs,@snames,@cand);
      my($rslt);
      my($inabs) = 0;
      local *TCF;
  
      if( $self->{PERL_CORE} ) {
          # Check in relative directories first, so we pick up the current
          # version of Perl if we're running MakeMaker as part of the main build.
          @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
                          my($absb) = $self->file_name_is_absolute($b);
                          if ($absa && $absb) { return $a cmp $b }
                          else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
                        } @$dirs;
          # Check miniperl before perl, and check names likely to contain
          # version numbers before "generic" names, so we pick up an
          # executable that's less likely to be from an old installation.
          @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
                           my($bb) = $b =~ m!([^:>\]/]+)$!;
                           my($ahasdir) = (length($a) - length($ba) > 0);
                           my($bhasdir) = (length($b) - length($bb) > 0);
                           if    ($ahasdir and not $bhasdir) { return 1; }
                           elsif ($bhasdir and not $ahasdir) { return -1; }
                           else { $bb =~ /\d/ <=> $ba =~ /\d/
                                    or substr($ba,0,1) cmp substr($bb,0,1)
                                    or length($bb) <=> length($ba) } } @$names;
      }
      else {
          @sdirs  = @$dirs;
          @snames = @$names;
      }
  
      # Image names containing Perl version use '_' instead of '.' under VMS
      s/\.(\d+)$/_$1/ for @snames;
      if ($trace >= 2){
          print "Looking for perl $ver by these names:\n";
          print "\t@snames,\n";
          print "in these dirs:\n";
          print "\t@sdirs\n";
      }
      foreach my $dir (@sdirs){
          next unless defined $dir; # $self->{PERL_SRC} may be undefined
          $inabs++ if $self->file_name_is_absolute($dir);
          if ($inabs == 1) {
              # We've covered relative dirs; everything else is an absolute
              # dir (probably an installed location).  First, we'll try 
              # potential command names, to see whether we can avoid a long 
              # MCR expression.
              foreach my $name (@snames) {
                  push(@cand,$name) if $name =~ /^[\w\-\$]+$/;
              }
              $inabs++; # Should happen above in next $dir, but just in case...
          }
          foreach my $name (@snames){
              push @cand, ($name !~ m![/:>\]]!) ? $self->catfile($dir,$name)
                                                : $self->fixpath($name,0);
          }
      }
      foreach my $name (@cand) {
          print "Checking $name\n" if $trace >= 2;
          # If it looks like a potential command, try it without the MCR
          if ($name =~ /^[\w\-\$]+$/) {
              open(my $tcf, ">", "temp_mmvms.com") 
                  or die('unable to open temp file');
              print $tcf "\$ set message/nofacil/nosever/noident/notext\n";
              print $tcf "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n";
              close $tcf;
              $rslt = `\@temp_mmvms.com` ;
              unlink('temp_mmvms.com');
              if ($rslt =~ /VER_OK/) {
                  print "Using PERL=$name\n" if $trace;
                  return $name;
              }
          }
          next unless $vmsfile = $self->maybe_command($name);
          $vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
          print "Executing $vmsfile\n" if ($trace >= 2);
          open(my $tcf, '>', "temp_mmvms.com")
                  or die('unable to open temp file');
          print $tcf "\$ set message/nofacil/nosever/noident/notext\n";
          print $tcf "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n";
          close $tcf;
          $rslt = `\@temp_mmvms.com`;
          unlink('temp_mmvms.com');
          if ($rslt =~ /VER_OK/) {
              print "Using PERL=MCR $vmsfile\n" if $trace;
              return "MCR $vmsfile";
          }
      }
      print "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
      0; # false and not empty
  }
  
  =item _fixin_replace_shebang (override)
  
  Helper routine for MM->fixin(), overridden because there's no such thing as an
  actual shebang line that will be intepreted by the shell, so we just prepend
  $Config{startperl} and preserve the shebang line argument for any switches it
  may contain.
  
  =cut
  
  sub _fixin_replace_shebang {
      my ( $self, $file, $line ) = @_;
  
      my ( undef, $arg ) = split ' ', $line, 2;
  
      return $Config{startperl} . "\n" . $Config{sharpbang} . "perl $arg\n";
  }
  
  =item maybe_command (override)
  
  Follows VMS naming conventions for executable files.
  If the name passed in doesn't exactly match an executable file,
  appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
  to check for DCL procedure.  If this fails, checks directories in DCL$PATH
  and finally F<Sys$System:> for an executable file having the name specified,
  with or without the F<.Exe>-equivalent suffix.
  
  =cut
  
  sub maybe_command {
      my($self,$file) = @_;
      return $file if -x $file && ! -d _;
      my(@dirs) = ('');
      my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
  
      if ($file !~ m![/:>\]]!) {
          for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
              my $dir = $ENV{"DCL\$PATH;$i"};
              $dir .= ':' unless $dir =~ m%[\]:]$%;
              push(@dirs,$dir);
          }
          push(@dirs,'Sys$System:');
          foreach my $dir (@dirs) {
              my $sysfile = "$dir$file";
              foreach my $ext (@exts) {
                  return $file if -x "$sysfile$ext" && ! -d _;
              }
          }
      }
      return 0;
  }
  
  
  =item pasthru (override)
  
  VMS has $(MMSQUALIFIERS) which is a listing of all the original command line
  options.  This is used in every invocation of make in the VMS Makefile so
  PASTHRU should not be necessary.  Using PASTHRU tends to blow commands past
  the 256 character limit.
  
  =cut
  
  sub pasthru {
      return "PASTHRU=\n";
  }
  
  
  =item pm_to_blib (override)
  
  VMS wants a dot in every file so we can't have one called 'pm_to_blib',
  it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when
  you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'.
  
  So in VMS its pm_to_blib.ts.
  
  =cut
  
  sub pm_to_blib {
      my $self = shift;
  
      my $make = $self->SUPER::pm_to_blib;
  
      $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m;
      $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts};
  
      $make = <<'MAKE' . $make;
  # Dummy target to match Unix target name; we use pm_to_blib.ts as
  # timestamp file to avoid repeated invocations under VMS
  pm_to_blib : pm_to_blib.ts
  	$(NOECHO) $(NOOP)
  
  MAKE
  
      return $make;
  }
  
  
  =item perl_script (override)
  
  If name passed in doesn't specify a readable file, appends F<.com> or
  F<.pl> and tries again, since it's customary to have file types on all files
  under VMS.
  
  =cut
  
  sub perl_script {
      my($self,$file) = @_;
      return $file if -r $file && ! -d _;
      return "$file.com" if -r "$file.com";
      return "$file.pl" if -r "$file.pl";
      return '';
  }
  
  
  =item replace_manpage_separator
  
  Use as separator a character which is legal in a VMS-syntax file name.
  
  =cut
  
  sub replace_manpage_separator {
      my($self,$man) = @_;
      $man = unixify($man);
      $man =~ s#/+#__#g;
      $man;
  }
  
  =item init_DEST
  
  (override) Because of the difficulty concatenating VMS filepaths we
  must pre-expand the DEST* variables.
  
  =cut
  
  sub init_DEST {
      my $self = shift;
  
      $self->SUPER::init_DEST;
  
      # Expand DEST variables.
      foreach my $var ($self->installvars) {
          my $destvar = 'DESTINSTALL'.$var;
          $self->{$destvar} = $self->eliminate_macros($self->{$destvar});
      }
  }
  
  
  =item init_DIRFILESEP
  
  No seperator between a directory path and a filename on VMS.
  
  =cut
  
  sub init_DIRFILESEP {
      my($self) = shift;
  
      $self->{DIRFILESEP} = '';
      return 1;
  }
  
  
  =item init_main (override)
  
  
  =cut
  
  sub init_main {
      my($self) = shift;
  
      $self->SUPER::init_main;
  
      $self->{DEFINE} ||= '';
      if ($self->{DEFINE} ne '') {
          my(@terms) = split(/\s+/,$self->{DEFINE});
          my(@defs,@udefs);
          foreach my $def (@terms) {
              next unless $def;
              my $targ = \@defs;
              if ($def =~ s/^-([DU])//) {    # If it was a Unix-style definition
                  $targ = \@udefs if $1 eq 'U';
                  $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
                  $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
              }
              if ($def =~ /=/) {
                  $def =~ s/"/""/g;  # Protect existing " from DCL
                  $def = qq["$def"]; # and quote to prevent parsing of =
              }
              push @$targ, $def;
          }
  
          $self->{DEFINE} = '';
          if (@defs)  { 
              $self->{DEFINE}  = '/Define=(' . join(',',@defs)  . ')'; 
          }
          if (@udefs) { 
              $self->{DEFINE} .= '/Undef=('  . join(',',@udefs) . ')'; 
          }
      }
  }
  
  =item init_tools (override)
  
  Provide VMS-specific forms of various utility commands.
  
  Sets DEV_NULL to nothing because I don't know how to do it on VMS.
  
  Changes EQUALIZE_TIMESTAMP to set revision date of target file to
  one second later than source file, since MMK interprets precisely
  equal revision dates for a source and target file as a sign that the
  target needs to be updated.
  
  =cut
  
  sub init_tools {
      my($self) = @_;
  
      $self->{NOOP}               = 'Continue';
      $self->{NOECHO}             ||= '@ ';
  
      $self->{MAKEFILE}           ||= $self->{FIRST_MAKEFILE} || 'Descrip.MMS';
      $self->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE};
      $self->{MAKE_APERL_FILE}    ||= 'Makeaperl.MMS';
      $self->{MAKEFILE_OLD}       ||= $self->eliminate_macros('$(FIRST_MAKEFILE)_old');
  #
  #   If an extension is not specified, then MMS/MMK assumes an
  #   an extension of .MMS.  If there really is no extension,
  #   then a trailing "." needs to be appended to specify a
  #   a null extension.
  #
      $self->{MAKEFILE} .= '.' unless $self->{MAKEFILE} =~ m/\./;
      $self->{FIRST_MAKEFILE} .= '.' unless $self->{FIRST_MAKEFILE} =~ m/\./;
      $self->{MAKE_APERL_FILE} .= '.' unless $self->{MAKE_APERL_FILE} =~ m/\./;
      $self->{MAKEFILE_OLD} .= '.' unless $self->{MAKEFILE_OLD} =~ m/\./;
  
      $self->{MACROSTART}         ||= '/Macro=(';
      $self->{MACROEND}           ||= ')';
      $self->{USEMAKEFILE}        ||= '/Descrip=';
  
      $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"';
  
      $self->{MOD_INSTALL} ||= 
        $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
  install([ from_to => {split(' ', <STDIN>)}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]);
  CODE
  
      $self->{UMASK_NULL} = '! ';
  
      $self->SUPER::init_tools;
  
      # Use the default shell
      $self->{SHELL}    ||= 'Posix';
  
      # Redirection on VMS goes before the command, not after as on Unix.
      # $(DEV_NULL) is used once and its not worth going nuts over making
      # it work.  However, Unix's DEV_NULL is quite wrong for VMS.
      $self->{DEV_NULL}   = '';
  
      return;
  }
  
  =item init_platform (override)
  
  Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION.
  
  MM_VMS_REVISION is for backwards compatibility before MM_VMS had a
  $VERSION.
  
  =cut
  
  sub init_platform {
      my($self) = shift;
  
      $self->{MM_VMS_REVISION} = $Revision;
      $self->{MM_VMS_VERSION}  = $VERSION;
      $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS')
        if $self->{PERL_SRC};
  }
  
  
  =item platform_constants
  
  =cut
  
  sub platform_constants {
      my($self) = shift;
      my $make_frag = '';
  
      foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION))
      {
          next unless defined $self->{$macro};
          $make_frag .= "$macro = $self->{$macro}\n";
      }
  
      return $make_frag;
  }
  
  
  =item init_VERSION (override)
  
  Override the *DEFINE_VERSION macros with VMS semantics.  Translate the
  MAKEMAKER filepath to VMS style.
  
  =cut
  
  sub init_VERSION {
      my $self = shift;
  
      $self->SUPER::init_VERSION;
  
      $self->{DEFINE_VERSION}    = '"$(VERSION_MACRO)=""$(VERSION)"""';
      $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""';
      $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'});
  }
  
  
  =item constants (override)
  
  Fixes up numerous file and directory macros to insure VMS syntax
  regardless of input syntax.  Also makes lists of files
  comma-separated.
  
  =cut
  
  sub constants {
      my($self) = @_;
  
      # Be kind about case for pollution
      for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }
  
      # Cleanup paths for directories in MMS macros.
      foreach my $macro ( qw [
              INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB 
              PERL_LIB PERL_ARCHLIB
              PERL_INC PERL_SRC ],
                          (map { 'INSTALL'.$_ } $self->installvars)
                        ) 
      {
          next unless defined $self->{$macro};
          next if $macro =~ /MAN/ && $self->{$macro} eq 'none';
          $self->{$macro} = $self->fixpath($self->{$macro},1);
      }
  
      # Cleanup paths for files in MMS macros.
      foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD 
                             MAKE_APERL_FILE MYEXTLIB] ) 
      {
          next unless defined $self->{$macro};
          $self->{$macro} = $self->fixpath($self->{$macro},0);
      }
  
      # Fixup files for MMS macros
      # XXX is this list complete?
      for my $macro (qw/
                     FULLEXT VERSION_FROM
  	      /	) {
          next unless defined $self->{$macro};
          $self->{$macro} = $self->fixpath($self->{$macro},0);
      }
  
  
      for my $macro (qw/
                     OBJECT LDFROM
  	      /	) {
          next unless defined $self->{$macro};
  
          # Must expand macros before splitting on unescaped whitespace.
          $self->{$macro} = $self->eliminate_macros($self->{$macro});
          if ($self->{$macro} =~ /(?<!\^)\s/) {
              $self->{$macro} =~ s/(\\)?\n+\s+/ /g;
              $self->{$macro} = $self->wraplist(
                  map $self->fixpath($_,0), split /,?(?<!\^)\s+/, $self->{$macro}
              );
          }
          else {
              $self->{$macro} = $self->fixpath($self->{$macro},0);
          }
      }
  
      for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) {
          # Where is the space coming from? --jhi
          next unless $self ne " " && defined $self->{$macro};
          my %tmp = ();
          for my $key (keys %{$self->{$macro}}) {
              $tmp{$self->fixpath($key,0)} = 
                                       $self->fixpath($self->{$macro}{$key},0);
          }
          $self->{$macro} = \%tmp;
      }
  
      for my $macro (qw/ C O_FILES H /) {
          next unless defined $self->{$macro};
          my @tmp = ();
          for my $val (@{$self->{$macro}}) {
              push(@tmp,$self->fixpath($val,0));
          }
          $self->{$macro} = \@tmp;
      }
  
      # mms/k does not define a $(MAKE) macro.
      $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)';
  
      return $self->SUPER::constants;
  }
  
  
  =item special_targets
  
  Clear the default .SUFFIXES and put in our own list.
  
  =cut
  
  sub special_targets {
      my $self = shift;
  
      my $make_frag .= <<'MAKE_FRAG';
  .SUFFIXES :
  .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs
  
  MAKE_FRAG
  
      return $make_frag;
  }
  
  =item cflags (override)
  
  Bypass shell script and produce qualifiers for CC directly (but warn
  user if a shell script for this extension exists).  Fold multiple
  /Defines into one, since some C compilers pay attention to only one
  instance of this qualifier on the command line.
  
  =cut
  
  sub cflags {
      my($self,$libperl) = @_;
      my($quals) = $self->{CCFLAGS} || $Config{'ccflags'};
      my($definestr,$undefstr,$flagoptstr) = ('','','');
      my($incstr) = '/Include=($(PERL_INC)';
      my($name,$sys,@m);
  
      ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
      print "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
           " required to modify CC command for $self->{'BASEEXT'}\n"
      if ($Config{$name});
  
      if ($quals =~ / -[DIUOg]/) {
  	while ($quals =~ / -([Og])(\d*)\b/) {
  	    my($type,$lvl) = ($1,$2);
  	    $quals =~ s/ -$type$lvl\b\s*//;
  	    if ($type eq 'g') { $flagoptstr = '/NoOptimize'; }
  	    else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); }
  	}
  	while ($quals =~ / -([DIU])(\S+)/) {
  	    my($type,$def) = ($1,$2);
  	    $quals =~ s/ -$type$def\s*//;
  	    $def =~ s/"/""/g;
  	    if    ($type eq 'D') { $definestr .= qq["$def",]; }
  	    elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
  	    else                 { $undefstr  .= qq["$def",]; }
  	}
      }
      if (length $quals and $quals !~ m!/!) {
  	warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
  	$quals = '';
      }
      $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE};
      if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
      if (length $undefstr)  { chop($undefstr);  $quals .= "/Undef=($undefstr)";   }
      # Deal with $self->{DEFINE} here since some C compilers pay attention
      # to only one /Define clause on command line, so we have to
      # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
      # ($self->{DEFINE} has already been VMSified in constants() above)
      if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; }
      for my $type (qw(Def Undef)) {
  	my(@terms);
  	while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) {
  		my $term = $1;
  		$term =~ s:^\((.+)\)$:$1:;
  		push @terms, $term;
  	    }
  	if ($type eq 'Def') {
  	    push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ];
  	}
  	if (@terms) {
  	    $quals =~ s:/${type}i?n?e?=[^/]+::ig;
  	    $quals .= "/${type}ine=(" . join(',',@terms) . ')';
  	}
      }
  
      $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
  
      # Likewise with $self->{INC} and /Include
      if ($self->{'INC'}) {
  	my(@includes) = split(/\s+/,$self->{INC});
  	foreach (@includes) {
  	    s/^-I//;
  	    $incstr .= ','.$self->fixpath($_,1);
  	}
      }
      $quals .= "$incstr)";
  #    $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g;
      $self->{CCFLAGS} = $quals;
  
      $self->{PERLTYPE} ||= '';
  
      $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
      if ($self->{OPTIMIZE} !~ m!/!) {
  	if    ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
  	elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
  	    $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
  	}
  	else {
  	    warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
  	    $self->{OPTIMIZE} = '/Optimize';
  	}
      }
  
      return $self->{CFLAGS} = qq{
  CCFLAGS = $self->{CCFLAGS}
  OPTIMIZE = $self->{OPTIMIZE}
  PERLTYPE = $self->{PERLTYPE}
  };
  }
  
  =item const_cccmd (override)
  
  Adds directives to point C preprocessor to the right place when
  handling #include E<lt>sys/foo.hE<gt> directives.  Also constructs CC
  command line a bit differently than MM_Unix method.
  
  =cut
  
  sub const_cccmd {
      my($self,$libperl) = @_;
      my(@m);
  
      return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
      return '' unless $self->needs_linking();
      if ($Config{'vms_cc_type'} eq 'gcc') {
          push @m,'
  .FIRST
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
      }
      elsif ($Config{'vms_cc_type'} eq 'vaxc') {
          push @m,'
  .FIRST
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
      }
      else {
          push @m,'
  .FIRST
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
  		($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
  	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
      }
  
      push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
  
      $self->{CONST_CCCMD} = join('',@m);
  }
  
  
  =item tools_other (override)
  
  Throw in some dubious extra macros for Makefile args.
  
  Also keep around the old $(SAY) macro in case somebody's using it.
  
  =cut
  
  sub tools_other {
      my($self) = @_;
  
      # XXX Are these necessary?  Does anyone override them?  They're longer
      # than just typing the literal string.
      my $extra_tools = <<'EXTRA_TOOLS';
  
  # Just in case anyone is using the old macro.
  USEMACROS = $(MACROSTART)
  SAY = $(ECHO)
  
  EXTRA_TOOLS
  
      return $self->SUPER::tools_other . $extra_tools;
  }
  
  =item init_dist (override)
  
  VMSish defaults for some values.
  
    macro         description                     default
  
    ZIPFLAGS      flags to pass to ZIP            -Vu
  
    COMPRESS      compression command to          gzip
                  use for tarfiles
    SUFFIX        suffix to put on                -gz 
                  compressed files
  
    SHAR          shar command to use             vms_share
  
    DIST_DEFAULT  default target to use to        tardist
                  create a distribution
  
    DISTVNAME     Use VERSION_SYM instead of      $(DISTNAME)-$(VERSION_SYM)
                  VERSION for the name
  
  =cut
  
  sub init_dist {
      my($self) = @_;
      $self->{ZIPFLAGS}     ||= '-Vu';
      $self->{COMPRESS}     ||= 'gzip';
      $self->{SUFFIX}       ||= '-gz';
      $self->{SHAR}         ||= 'vms_share';
      $self->{DIST_DEFAULT} ||= 'zipdist';
  
      $self->SUPER::init_dist;
  
      $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION_SYM}"
        unless $self->{ARGS}{DISTVNAME};
  
      return;
  }
  
  =item c_o (override)
  
  Use VMS syntax on command line.  In particular, $(DEFINE) and
  $(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
  
  =cut
  
  sub c_o {
      my($self) = @_;
      return '' unless $self->needs_linking();
      '
  .c$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  
  .cpp$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
  
  .cxx$(OBJ_EXT) :
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
  
  ';
  }
  
  =item xs_c (override)
  
  Use MM[SK] macros.
  
  =cut
  
  sub xs_c {
      my($self) = @_;
      return '' unless $self->needs_linking();
      '
  .xs.c :
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
  ';
  }
  
  =item xs_o (override)
  
  Use MM[SK] macros, and VMS command line for C compiler.
  
  =cut
  
  sub xs_o {	# many makes are too dumb to use xs_c then c_o
      my($self) = @_;
      return '' unless $self->needs_linking();
      '
  .xs$(OBJ_EXT) :
  	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
  	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
  ';
  }
  
  
  =item dlsyms (override)
  
  Create VMS linker options files specifying universal symbols for this
  extension's shareable image, and listing other shareable images or 
  libraries to which it should be linked.
  
  =cut
  
  sub dlsyms {
      my($self,%attribs) = @_;
  
      return '' unless $self->needs_linking();
  
      my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
      my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
      my($funclist)  = $attribs{FUNCLIST}  || $self->{FUNCLIST}  || [];
      my(@m);
  
      unless ($self->{SKIPHASH}{'dynamic'}) {
  	push(@m,'
  dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
  	$(NOECHO) $(NOOP)
  ');
      }
  
      push(@m,'
  static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
  	$(NOECHO) $(NOOP)
  ') unless $self->{SKIPHASH}{'static'};
  
      push @m,'
  $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
  	$(CP) $(MMS$SOURCE) $(MMS$TARGET)
  
  $(BASEEXT).opt : Makefile.PL
  	$(PERLRUN) -e "use ExtUtils::Mksymlists;" -
  	',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
  	neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
  	q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n];
  
      push @m, '	$(PERL) -e "print ""$(INST_STATIC)/Include=';
      if ($self->{OBJECT} =~ /\bBASEEXT\b/ or
          $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { 
          push @m, ($Config{d_vms_case_sensitive_symbols}
  	           ? uc($self->{BASEEXT}) :'$(BASEEXT)');
      }
      else {  # We don't have a "main" object file, so pull 'em all in
          # Upcase module names if linker is being case-sensitive
          my($upcase) = $Config{d_vms_case_sensitive_symbols};
          my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT});
          for (@omods) {
              s/\.[^.]*$//;         # Trim off file type
              s[\$\(\w+_EXT\)][];   # even as a macro
              s/.*[:>\/\]]//;       # Trim off dir spec
              $_ = uc if $upcase;
          };
  
          my(@lines);
          my $tmp = shift @omods;
          foreach my $elt (@omods) {
              $tmp .= ",$elt";
              if (length($tmp) > 80) { push @lines, $tmp;  $tmp = ''; }
          }
          push @lines, $tmp;
          push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')';
      }
      push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n";
  
      if (length $self->{LDLOADLIBS}) {
          my($line) = '';
          foreach my $lib (split ' ', $self->{LDLOADLIBS}) {
              $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
              if (length($line) + length($lib) > 160) {
                  push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
                  $line = $lib . '\n';
              }
              else { $line .= $lib . '\n'; }
          }
          push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
      }
  
      join('',@m);
  
  }
  
  =item dynamic_lib (override)
  
  Use VMS Link command.
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      return '' unless $self->needs_linking(); #might be because of a subdir
  
      return '' unless $self->has_link_code();
  
      my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
      my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
      my $shr = $Config{'dbgprefix'} . 'PerlShr';
      my(@m);
      push @m,"
  
  OTHERLDFLAGS = $otherldflags
  INST_DYNAMIC_DEP = $inst_dynamic_dep
  
  ";
      push @m, '
  $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  	If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
  	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
  ';
  
      join('',@m);
  }
  
  
  =item static_lib (override)
  
  Use VMS commands to manipulate object library.
  
  =cut
  
  sub static_lib {
      my($self) = @_;
      return '' unless $self->needs_linking();
  
      return '
  $(INST_STATIC) :
  	$(NOECHO) $(NOOP)
  ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
  
      my(@m);
      push @m,'
  # Rely on suffix rule for update action
  $(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists
  
  $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
  ';
      # If this extension has its own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
  
      push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
  
      # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
      # 'cause it's a library and you can't stick them in other libraries.
      # In that case, we use $OBJECT instead and hope for the best
      if ($self->{MYEXTLIB}) {
        push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
      } else {
        push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
      }
      
      push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
      foreach my $lib (split ' ', $self->{EXTRALIBS}) {
        push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
      }
      join('',@m);
  }
  
  
  =item extra_clean_files
  
  Clean up some OS specific files.  Plus the temp file used to shorten
  a lot of commands.  And the name mangler database.
  
  =cut
  
  sub extra_clean_files {
      return qw(
                *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso
                .MM_Tmp cxx_repository
               );
  }
  
  
  =item zipfile_target
  
  =item tarfile_target
  
  =item shdist_target
  
  Syntax for invoking shar, tar and zip differs from that for Unix.
  
  =cut
  
  sub zipfile_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  $(DISTVNAME).zip : distdir
  	$(PREOP)
  	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
  	$(RM_RF) $(DISTVNAME)
  	$(POSTOP)
  MAKE_FRAG
  }
  
  sub tarfile_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  $(DISTVNAME).tar$(SUFFIX) : distdir
  	$(PREOP)
  	$(TO_UNIX)
          $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
  	$(RM_RF) $(DISTVNAME)
  	$(COMPRESS) $(DISTVNAME).tar
  	$(POSTOP)
  MAKE_FRAG
  }
  
  sub shdist_target {
      my($self) = shift;
  
      return <<'MAKE_FRAG';
  shdist : distdir
  	$(PREOP)
  	$(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share
  	$(RM_RF) $(DISTVNAME)
  	$(POSTOP)
  MAKE_FRAG
  }
  
  
  # --- Test and Installation Sections ---
  
  =item install (override)
  
  Work around DCL's 255 character limit several times,and use
  VMS-style command line quoting in a few cases.
  
  =cut
  
  sub install {
      my($self, %attribs) = @_;
      my(@m);
  
      push @m, q[
  install :: all pure_install doc_install
  	$(NOECHO) $(NOOP)
  
  install_perl :: all pure_perl_install doc_perl_install
  	$(NOECHO) $(NOOP)
  
  install_site :: all pure_site_install doc_site_install
  	$(NOECHO) $(NOOP)
  
  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 ::
  	$(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
  	$(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 ::
  	$(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
  	$(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 ::
  	$(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
  	$(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
  
  # 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
  
  ];
  
      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[
  	$(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
  	$(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
  	$(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
  
  uninstall_from_sitedirs ::
  	$(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
  	$(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
  	$(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
  	$(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
  ];
  
      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);
  
      push @m, '
  $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h
  $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)config.h
  $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h
  $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h
  $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h
  $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h
  $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h
  $(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
  $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlio.h
  $(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlvars.h
  $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h
  $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h
  $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
  $(OBJECT) : $(PERL_INC)thread.h, $(PERL_INC)util.h, $(PERL_INC)vmsish.h
  
  ' if $self->{OBJECT}; 
  
      if ($self->{PERL_SRC}) {
  	my(@macros);
  	my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
  	push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
  	push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
  	push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
  	push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
  	push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
  	$mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
  	push(@m,q[
  # Check for unpropagated config.sh changes. Should never happen.
  # We do NOT just update config.h because that is not sufficient.
  # An out of date config.h is not fatal but complains loudly!
  $(PERL_INC)config.h : $(PERL_SRC)config.sh
  	$(NOOP)
  
  $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
  	$(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
  	olddef = F$Environment("Default")
  	Set Default $(PERL_SRC)
  	$(MMS)],$mmsquals,);
  	if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
  	    my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
  	    $target =~ s/\Q$prefix/[/;
  	    push(@m," $target");
  	}
  	else { push(@m,' $(MMS$TARGET)'); }
  	push(@m,q[
  	Set Default 'olddef'
  ]);
      }
  
      push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
        if %{$self->{XS}};
  
      join('',@m);
  }
  
  
  =item makeaperl (override)
  
  Undertake to build a new set of Perl images using VMS commands.  Since
  VMS does dynamic loading, it's not necessary to statically link each
  extension into the Perl image, so this isn't the normal build path.
  Consequently, it hasn't really been tested, and may well be incomplete.
  
  =cut
  
  our %olbs;  # needs to be localized
  
  sub makeaperl {
      my($self, %attribs) = @_;
      my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = 
        @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
      my(@m);
      push @m, "
  # --- MakeMaker makeaperl section ---
  MAP_TARGET    = $target
  ";
      return join '', @m if $self->{PARENT};
  
      my($dir) = join ":", @{$self->{DIR}};
  
      unless ($self->{MAKEAPERL}) {
  	push @m, q{
  $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
  	$(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
  	$(NOECHO) $(PERLRUNINST) \
  		Makefile.PL DIR=}, $dir, q{ \
  		FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
  		MAKEAPERL=1 NORECURS=1 };
  
  	push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
  
  $(MAP_TARGET) :: $(MAKE_APERL_FILE)
  	$(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
  };
  	push @m, "\n";
  
  	return join '', @m;
      }
  
  
      my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
      local($_);
  
      # The front matter of the linkcommand...
      $linkcmd = join ' ', $Config{'ld'},
  	    grep($_, @Config{qw(large split ldflags ccdlflags)});
      $linkcmd =~ s/\s+/ /g;
  
      # Which *.olb files could we make use of...
      local(%olbs);       # XXX can this be lexical?
      $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
      require File::Find;
      File::Find::find(sub {
  	return unless m/\Q$self->{LIB_EXT}\E$/;
  	return if m/^libperl/;
  
  	if( exists $self->{INCLUDE_EXT} ){
  		my $found = 0;
  
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything not explicitly marked for inclusion.
  		# DynaLoader is implied.
  		foreach my $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
  			if( $xx eq $incl ){
  				$found++;
  				last;
  			}
  		}
  		return unless $found;
  	}
  	elsif( exists $self->{EXCLUDE_EXT} ){
  		(my $xx = $File::Find::name) =~ s,.*?/auto/,,;
  		$xx =~ s,/?$_,,;
  		$xx =~ s,/,::,g;
  
  		# Throw away anything explicitly marked for exclusion
  		foreach my $excl (@{$self->{EXCLUDE_EXT}}){
  			return if( $xx eq $excl );
  		}
  	}
  
  	$olbs{$ENV{DEFAULT}} = $_;
      }, grep( -d $_, @{$searchdirs || []}));
  
      # We trust that what has been handed in as argument will be buildable
      $static = [] unless $static;
      @olbs{@{$static}} = (1) x @{$static};
   
      $extra = [] unless $extra && ref $extra eq 'ARRAY';
      # Sort the object libraries in inverse order of
      # filespec length to try to insure that dependent extensions
      # will appear before their parents, so the linker will
      # search the parent library to resolve references.
      # (e.g. Intuit::DWIM will precede Intuit, so unresolved
      # references from [.intuit.dwim]dwim.obj can be found
      # in [.intuit]intuit.olb).
      for (sort { length($a) <=> length($b) } keys %olbs) {
  	next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
  	my($dir) = $self->fixpath($_,1);
  	my($extralibs) = $dir . "extralibs.ld";
  	my($extopt) = $dir . $olbs{$_};
  	$extopt =~ s/$self->{LIB_EXT}$/.opt/;
  	push @optlibs, "$dir$olbs{$_}";
  	# Get external libraries this extension will need
  	if (-f $extralibs ) {
  	    my %seenthis;
  	    open my $list, "<", $extralibs or warn $!,next;
  	    while (<$list>) {
  		chomp;
  		# Include a library in the link only once, unless it's mentioned
  		# multiple times within a single extension's options file, in which
  		# case we assume the builder needed to search it again later in the
  		# link.
  		my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
  		$libseen{$_}++;  $seenthis{$_}++;
  		next if $skip;
  		push @$extra,$_;
  	    }
  	}
  	# Get full name of extension for ExtUtils::Miniperl
  	if (-f $extopt) {
  	    open my $opt, '<', $extopt or die $!;
  	    while (<$opt>) {
  		next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
  		my $pkg = $1;
  		$pkg =~ s#__*#::#g;
  		push @staticpkgs,$pkg;
  	    }
  	}
      }
      # Place all of the external libraries after all of the Perl extension
      # libraries in the final link, in order to maximize the opportunity
      # for XS code from multiple extensions to resolve symbols against the
      # same external library while only including that library once.
      push @optlibs, @$extra;
  
      $target = "Perl$Config{'exe_ext'}" unless $target;
      my $shrtarget;
      ($shrtarget,$targdir) = fileparse($target);
      $shrtarget =~ s/^([^.]*)/$1Shr/;
      $shrtarget = $targdir . $shrtarget;
      $target = "Perlshr.$Config{'dlext'}" unless $target;
      $tmpdir = "[]" unless $tmpdir;
      $tmpdir = $self->fixpath($tmpdir,1);
      if (@optlibs) { $extralist = join(' ',@optlibs); }
      else          { $extralist = ''; }
      # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
      # that's what we're building here).
      push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
      if ($libperl) {
  	unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
  	    print "Warning: $libperl not found\n";
  	    undef $libperl;
  	}
      }
      unless ($libperl) {
  	if (defined $self->{PERL_SRC}) {
  	    $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
  	} elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
  	} else {
  	    print "Warning: $libperl not found
      If you're going to build a static perl binary, make sure perl is installed
      otherwise ignore this warning\n";
  	}
      }
      $libperldir = $self->fixpath((fileparse($libperl))[1],1);
  
      push @m, '
  # Fill in the target you want to produce if it\'s not perl
  MAP_TARGET    = ',$self->fixpath($target,0),'
  MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
  MAP_LINKCMD   = $linkcmd
  MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
  MAP_EXTRA     = $extralist
  MAP_LIBPERL = ",$self->fixpath($libperl,0),'
  ';
  
  
      push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
      foreach (@optlibs) {
  	push @m,'	$(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
      }
      push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
      push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
  
      push @m,'
  $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
  	$(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
  $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
  	$(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
  	$(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
  	$(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
  	$(NOECHO) $(ECHO) "To remove the intermediate files, say
  	$(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
  ';
      push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
      push @m, "# More from the 255-char line length limit\n";
      foreach (@staticpkgs) {
  	push @m,'	$(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
      }
  
      push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
  	$(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
  	$(NOECHO) $(RM_F) %sWritemain.tmp
  MAKE_FRAG
  
      push @m, q[
  # Still more from the 255-char line length limit
  doc_inst_perl :
  	$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
  	$(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
  	$(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
  	$(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
  	$(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
  	$(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
  	$(NOECHO) $(RM_F) .MM_tmp
  ];
  
      push @m, "
  inst_perl : pure_inst_perl doc_inst_perl
  	\$(NOECHO) \$(NOOP)
  
  pure_inst_perl : \$(MAP_TARGET)
  	$self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
  	$self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
  
  clean :: map_clean
  	\$(NOECHO) \$(NOOP)
  
  map_clean :
  	\$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
  	\$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
  ";
  
      join '', @m;
  }
  
  
  # --- Output postprocessing section ---
  
  =item maketext_filter (override)
  
  Insure that colons marking targets are preceded by space, in order
  to distinguish the target delimiter from a colon appearing as
  part of a filespec.
  
  =cut
  
  sub maketext_filter {
      my($self, $text) = @_;
  
      $text =~ s/^([^\s:=]+)(:+\s)/$1 $2/mg;
      return $text;
  }
  
  =item prefixify (override)
  
  prefixifying on VMS is simple.  Each should simply be:
  
      perl_root:[some.dir]
  
  which can just be converted to:
  
      volume:[your.prefix.some.dir]
  
  otherwise you get the default layout.
  
  In effect, your search prefix is ignored and $Config{vms_prefix} is
  used instead.
  
  =cut
  
  sub prefixify {
      my($self, $var, $sprefix, $rprefix, $default) = @_;
  
      # Translate $(PERLPREFIX) to a real path.
      $rprefix = $self->eliminate_macros($rprefix);
      $rprefix = vmspath($rprefix) if $rprefix;
      $sprefix = vmspath($sprefix) if $sprefix;
  
      $default = vmsify($default) 
        unless $default =~ /\[.*\]/;
  
      (my $var_no_install = $var) =~ s/^install//;
      my $path = $self->{uc $var} || 
                 $ExtUtils::MM_Unix::Config_Override{lc $var} || 
                 $Config{lc $var} || $Config{lc $var_no_install};
  
      if( !$path ) {
          warn "  no Config found for $var.\n" if $Verbose >= 2;
          $path = $self->_prefixify_default($rprefix, $default);
      }
      elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) {
          # do nothing if there's no prefix or if its relative
      }
      elsif( $sprefix eq $rprefix ) {
          warn "  no new prefix.\n" if $Verbose >= 2;
      }
      else {
  
          warn "  prefixify $var => $path\n"     if $Verbose >= 2;
          warn "    from $sprefix to $rprefix\n" if $Verbose >= 2;
  
          my($path_vol, $path_dirs) = $self->splitpath( $path );
          if( $path_vol eq $Config{vms_prefix}.':' ) {
              warn "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
  
              $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
              $path = $self->_catprefix($rprefix, $path_dirs);
          }
          else {
              $path = $self->_prefixify_default($rprefix, $default);
          }
      }
  
      print "    now $path\n" if $Verbose >= 2;
      return $self->{uc $var} = $path;
  }
  
  
  sub _prefixify_default {
      my($self, $rprefix, $default) = @_;
  
      warn "  cannot prefix, using default.\n" if $Verbose >= 2;
  
      if( !$default ) {
          warn "No default!\n" if $Verbose >= 1;
          return;
      }
      if( !$rprefix ) {
          warn "No replacement prefix!\n" if $Verbose >= 1;
          return '';
      }
  
      return $self->_catprefix($rprefix, $default);
  }
  
  sub _catprefix {
      my($self, $rprefix, $default) = @_;
  
      my($rvol, $rdirs) = $self->splitpath($rprefix);
      if( $rvol ) {
          return $self->catpath($rvol,
                                     $self->catdir($rdirs, $default),
                                     ''
                                    )
      }
      else {
          return $self->catdir($rdirs, $default);
      }
  }
  
  
  =item cd
  
  =cut
  
  sub cd {
      my($self, $dir, @cmds) = @_;
  
      $dir = vmspath($dir);
  
      my $cmd = join "\n\t", map "$_", @cmds;
  
      # No leading tab makes it look right when embedded
      my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
  startdir = F$Environment("Default")
  	Set Default %s
  	%s
  	Set Default 'startdir'
  MAKE_FRAG
  
      # No trailing newline makes this easier to embed
      chomp $make_frag;
  
      return $make_frag;
  }
  
  
  =item oneliner
  
  =cut
  
  sub oneliner {
      my($self, $cmd, $switches) = @_;
      $switches = [] unless defined $switches;
  
      # Strip leading and trailing newlines
      $cmd =~ s{^\n+}{};
      $cmd =~ s{\n+$}{};
  
      $cmd = $self->quote_literal($cmd);
      $cmd = $self->escape_newlines($cmd);
  
      # Switches must be quoted else they will be lowercased.
      $switches = join ' ', map { qq{"$_"} } @$switches;
  
      return qq{\$(ABSPERLRUN) $switches -e $cmd "--"};
  }
  
  
  =item B<echo>
  
  perl trips up on "<foo>" thinking it's an input redirect.  So we use the
  native Write command instead.  Besides, its faster.
  
  =cut
  
  sub echo {
      my($self, $text, $file, $opts) = @_;
  
      # Compatibility with old options
      if( !ref $opts ) {
          my $append = $opts;
          $opts = { append => $append || 0 };
      }
      my $opencmd = $opts->{append} ? 'Open/Append' : 'Open/Write';
  
      $opts->{allow_variables} = 0 unless defined $opts->{allow_variables};
  
      my $ql_opts = { allow_variables => $opts->{allow_variables} };
  
      my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
      push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_, $ql_opts) } 
                  split /\n/, $text;
      push @cmds, '$(NOECHO) Close MMECHOFILE';
      return @cmds;
  }
  
  
  =item quote_literal
  
  =cut
  
  sub quote_literal {
      my($self, $text, $opts) = @_;
      $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
  
      # I believe this is all we should need.
      $text =~ s{"}{""}g;
  
      $text = $opts->{allow_variables}
        ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
  
      return qq{"$text"};
  }
  
  =item escape_dollarsigns
  
  Quote, don't escape.
  
  =cut
  
  sub escape_dollarsigns {
      my($self, $text) = @_;
  
      # Quote dollar signs which are not starting a variable
      $text =~ s{\$ (?!\() }{"\$"}gx;
  
      return $text;
  }
  
  
  =item escape_all_dollarsigns
  
  Quote, don't escape.
  
  =cut
  
  sub escape_all_dollarsigns {
      my($self, $text) = @_;
  
      # Quote dollar signs
      $text =~ s{\$}{"\$\"}gx;
  
      return $text;
  }
  
  =item escape_newlines
  
  =cut
  
  sub escape_newlines {
      my($self, $text) = @_;
  
      $text =~ s{\n}{-\n}g;
  
      return $text;
  }
  
  =item max_exec_len
  
  256 characters.
  
  =cut
  
  sub max_exec_len {
      my $self = shift;
  
      return $self->{_MAX_EXEC_LEN} ||= 256;
  }
  
  =item init_linker
  
  =cut
  
  sub init_linker {
      my $self = shift;
      $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
  
      my $shr = $Config{dbgprefix} . 'PERLSHR';
      if ($self->{PERL_SRC}) {
          $self->{PERL_ARCHIVE} ||=
            $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
      }
      else {
          $self->{PERL_ARCHIVE} ||=
            $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
      }
  
      $self->{PERL_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;
  
      if ($path =~ /\s/) {
        return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
      }
  
      my($npath) = unixify($path);
      # sometimes unixify will return a string with an off-by-one trailing null
      $npath =~ s{\0$}{};
  
      my($complex) = 0;
      my($head,$macro,$tail);
  
      # perform m##g in scalar context so it acts as an iterator
      while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
          if (defined $self->{$2}) {
              ($head,$macro,$tail) = ($1,$2,$3);
              if (ref $self->{$macro}) {
                  if (ref $self->{$macro} eq 'ARRAY') {
                      $macro = join ' ', @{$self->{$macro}};
                  }
                  else {
                      print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
                            "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
                      $macro = "\cB$macro\cB";
                      $complex = 1;
                  }
              }
              else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
              $npath = "$head$macro$tail";
          }
      }
      if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
      $npath;
  }
  
  =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 =~ /[ \t]/) {
        return join ' ',
               map { $self->fixpath($_,$force_path) }
  	     split /[ \t]+/, $path;
      }
  
      if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
          if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
              $fixedpath = vmspath($self->eliminate_macros($path));
          }
          else {
              $fixedpath = vmsify($self->eliminate_macros($path));
          }
      }
      elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
          my($vmspre) = $self->eliminate_macros("\$($prefix)");
          # is it a dir or just a name?
          $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
          $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
          $fixedpath = vmspath($fixedpath) if $force_path;
      }
      else {
          $fixedpath = $path;
          $fixedpath = vmspath($fixedpath) if $force_path;
      }
      # No hints, so we try to guess
      if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
          $fixedpath = vmspath($fixedpath) if -d $fixedpath;
      }
  
      # Trim off root dirname if it's had other dirs inserted in front of it.
      $fixedpath =~ s/\.000000([\]>])/$1/;
      # Special case for VMS absolute directory specs: these will have had device
      # prepended during trip through Unix syntax in eliminate_macros(), since
      # Unix syntax has no way to express "absolute from the top of this device's
      # directory tree".
      if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
  
      return $fixedpath;
  }
  
  
  =item os_flavor
  
  VMS is VMS.
  
  =cut
  
  sub os_flavor {
      return('VMS');
  }
  
  =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"} = <<'EXTUTILS_MM_VOS';
  package ExtUtils::MM_VOS;
  
  use strict;
  our $VERSION = '6.64';
  
  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"} = <<'EXTUTILS_MM_WIN32';
  package ExtUtils::MM_Win32;
  
  use strict;
  
  
  =head1 NAME
  
  ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  
  =head1 SYNOPSIS
  
   use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
  
  =head1 DESCRIPTION
  
  See ExtUtils::MM_Unix for a documentation of the methods provided
  there. This package overrides the implementation of these methods, not
  the semantics.
  
  =cut 
  
  use ExtUtils::MakeMaker::Config;
  use File::Basename;
  use File::Spec;
  use ExtUtils::MakeMaker qw( neatvalue );
  
  require ExtUtils::MM_Any;
  require ExtUtils::MM_Unix;
  our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  our $VERSION = '6.64';
  
  $ENV{EMXSHELL} = 'sh'; # to run `commands`
  
  my ( $BORLAND, $GCC, $DLLTOOL ) = _identify_compiler_environment( \%Config );
  
  sub _identify_compiler_environment {
  	my ( $config ) = @_;
  
  	my $BORLAND = $config->{cc} =~ /^bcc/i ? 1 : 0;
  	my $GCC     = $config->{cc} =~ /\bgcc\b/i ? 1 : 0;
  	my $DLLTOOL = $config->{dlltool} || 'dlltool';
  
  	return ( $BORLAND, $GCC, $DLLTOOL );
  }
  
  
  =head2 Overridden methods
  
  =over 4
  
  =item B<dlsyms>
  
  =cut
  
  sub dlsyms {
      my($self,%attribs) = @_;
  
      my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
      my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
      my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
      my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
      my(@m);
  
      if (not $self->{SKIPHASH}{'dynamic'}) {
  	push(@m,"
  $self->{BASEEXT}.def: Makefile.PL
  ",
       q!	$(PERLRUN) -MExtUtils::Mksymlists \\
       -e "Mksymlists('NAME'=>\"!, $self->{NAME},
       q!\", 'DLBASE' => '!,$self->{DLBASE},
       # The above two lines quoted differently to work around
       # a bug in the 4DOS/4NT command line interpreter.  The visible
       # result of the bug was files named q('extension_name',) *with the
       # single quotes and the comma* in the extension build directories.
       q!', 'DL_FUNCS' => !,neatvalue($funcs),
       q!, 'FUNCLIST' => !,neatvalue($funclist),
       q!, 'IMPORTS' => !,neatvalue($imports),
       q!, 'DL_VARS' => !, neatvalue($vars), q!);"
  !);
      }
      join('',@m);
  }
  
  =item replace_manpage_separator
  
  Changes the path separator with .
  
  =cut
  
  sub replace_manpage_separator {
      my($self,$man) = @_;
      $man =~ s,/+,.,g;
      $man;
  }
  
  
  =item B<maybe_command>
  
  Since Windows has nothing as simple as an executable bit, we check the
  file extension.
  
  The PATHEXT env variable will be used to get a list of extensions that
  might indicate a command, otherwise .com, .exe, .bat and .cmd will be
  used by default.
  
  =cut
  
  sub maybe_command {
      my($self,$file) = @_;
      my @e = exists($ENV{'PATHEXT'})
            ? split(/;/, $ENV{PATHEXT})
  	  : qw(.com .exe .bat .cmd);
      my $e = '';
      for (@e) { $e .= "\Q$_\E|" }
      chop $e;
      # see if file ends in one of the known extensions
      if ($file =~ /($e)$/i) {
  	return $file if -e $file;
      }
      else {
  	for (@e) {
  	    return "$file$_" if -e "$file$_";
  	}
      }
      return;
  }
  
  
  =item B<init_DIRFILESEP>
  
  Using \ for Windows.
  
  =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') ? '\\\\'
                                                         : '\\';
  }
  
  =item init_tools
  
  Override some of the slower, portable commands with Windows specific ones.
  
  =cut
  
  sub init_tools {
      my ($self) = @_;
  
      $self->{NOOP}     ||= 'rem';
      $self->{DEV_NULL} ||= '> NUL';
  
      $self->{FIXIN}    ||= $self->{PERL_CORE} ? 
        "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : 
        'pl2bat.bat';
  
      $self->SUPER::init_tools;
  
      # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
      delete $self->{SHELL};
  
      return;
  }
  
  
  =item init_others
  
  Override the default link and compile tools.
  
  LDLOADLIBS's default is changed to $Config{libs}.
  
  Adjustments are made for Borland's quirks needing -L to come first.
  
  =cut
  
  sub init_others {
      my $self = shift;
  
      $self->{LD}     ||= 'link';
      $self->{AR}     ||= 'lib';
  
      $self->SUPER::init_others;
  
      $self->{LDLOADLIBS} ||= $Config{libs};
      # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
      if ($BORLAND) {
          my $libs = $self->{LDLOADLIBS};
          my $libpath = '';
          while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
              $libpath .= ' ' if length $libpath;
              $libpath .= $1;
          }
          $self->{LDLOADLIBS} = $libs;
          $self->{LDDLFLAGS} ||= $Config{lddlflags};
          $self->{LDDLFLAGS} .= " $libpath";
      }
  
      return;
  }
  
  
  =item init_platform
  
  Add MM_Win32_VERSION.
  
  =item platform_constants
  
  =cut
  
  sub init_platform {
      my($self) = shift;
  
      $self->{MM_Win32_VERSION} = $VERSION;
  
      return;
  }
  
  sub platform_constants {
      my($self) = shift;
      my $make_frag = '';
  
      foreach my $macro (qw(MM_Win32_VERSION))
      {
          next unless defined $self->{$macro};
          $make_frag .= "$macro = $self->{$macro}\n";
      }
  
      return $make_frag;
  }
  
  
  =item constants
  
  Add MAXLINELENGTH for dmake before all the constants are output.
  
  =cut
  
  sub constants {
      my $self = shift;
  
      my $make_text = $self->SUPER::constants;
      return $make_text unless $self->is_make_type('dmake');
  
      # dmake won't read any single "line" (even those with escaped newlines)
      # larger than a certain size which can be as small as 8k.  PM_TO_BLIB
      # on large modules like DateTime::TimeZone can create lines over 32k.
      # So we'll crank it up to a <ironic>WHOPPING</ironic> 64k.
      #
      # This has to come here before all the constants and not in
      # platform_constants which is after constants.
      my $size = $self->{MAXLINELENGTH} || 64 * 1024;
      my $prefix = qq{
  # Get dmake to read long commands like PM_TO_BLIB
  MAXLINELENGTH = $size
  
  };
  
      return $prefix . $make_text;
  }
  
  
  =item special_targets
  
  Add .USESHELL target for dmake.
  
  =cut
  
  sub special_targets {
      my($self) = @_;
  
      my $make_frag = $self->SUPER::special_targets;
  
      $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake');
  .USESHELL :
  MAKE_FRAG
  
      return $make_frag;
  }
  
  
  =item static_lib
  
  Changes how to run the linker.
  
  The rest is duplicate code from MM_Unix.  Should move the linker code
  to its own method.
  
  =cut
  
  sub static_lib {
      my($self) = @_;
      return '' unless $self->has_link_code;
  
      my(@m);
      push(@m, <<'END');
  $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
  	$(RM_RF) $@
  END
  
      # If this extension has its own library (eg SDBM_File)
      # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
      push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
  	$(CP) $(MYEXTLIB) $@
  MAKE_FRAG
  
      push @m,
  q{	$(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
  			  : ($GCC ? '-ru $@ $(OBJECT)'
  			          : '-out:$@ $(OBJECT)')).q{
  	$(CHMOD) $(PERM_RWX) $@
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
  };
  
      # Old mechanism - still available:
      push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  	$(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
  MAKE_FRAG
  
      join('', @m);
  }
  
  
  =item dynamic_lib
  
  Complicated stuff for Win32 that I don't understand. :(
  
  =cut
  
  sub dynamic_lib {
      my($self, %attribs) = @_;
      return '' unless $self->needs_linking(); #might be because of a subdir
  
      return '' unless $self->has_link_code;
  
      my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
      my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
      my($ldfrom) = '$(LDFROM)';
      my(@m);
  
      push(@m,'
  # This section creates the dynamically loadable $(INST_DYNAMIC)
  # from $(OBJECT) and possibly $(MYEXTLIB).
  OTHERLDFLAGS = '.$otherldflags.'
  INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  
  $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  ');
      if ($GCC) {
        push(@m,  
         q{	}.$DLLTOOL.q{ --def $(EXPORT_LIST) --output-exp dll.exp
  	$(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
  	}.$DLLTOOL.q{ --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
  	$(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
      } elsif ($BORLAND) {
        push(@m,
         q{	$(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
         .($self->is_make_type('dmake')
                  ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
  		 .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
  		: q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
  		 .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
         .q{,$(RESFILES)});
      } else {	# VC
        push(@m,
         q{	$(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
        .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
  
        # Embed the manifest file if it exists
        push(@m, q{
  	if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
  	if exist $@.manifest del $@.manifest});
      }
      push @m, '
  	$(CHMOD) $(PERM_RWX) $@
  ';
  
      join('',@m);
  }
  
  =item extra_clean_files
  
  Clean out some extra dll.{base,exp} files which might be generated by
  gcc.  Otherwise, take out all *.pdb files.
  
  =cut
  
  sub extra_clean_files {
      my $self = shift;
  
      return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
  }
  
  =item init_linker
  
  =cut
  
  sub init_linker {
      my $self = shift;
  
      $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
      $self->{PERL_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;
  }
  
  
  =item xs_o
  
  This target is stubbed out.  Not sure why.
  
  =cut
  
  sub xs_o {
      return ''
  }
  
  
  =item pasthru
  
  All we send is -nologo to nmake to prevent it from printing its damned
  banner.
  
  =cut
  
  sub pasthru {
      my($self) = shift;
      return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : "");
  }
  
  
  =item arch_check (override)
  
  Normalize all arguments for consistency of comparison.
  
  =cut
  
  sub arch_check {
      my $self = shift;
  
      # Win32 is an XS module, minperl won't have it.
      # arch_check() is not critical, so just fake it.
      return 1 unless $self->can_load_xs;
      return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_);
  }
  
  sub _normalize_path_name {
      my $self = shift;
      my $file = shift;
  
      require Win32;
      my $short = Win32::GetShortPathName($file);
      return defined $short ? lc $short : lc $file;
  }
  
  
  =item oneliner
  
  These are based on what command.com does on Win98.  They may be wrong
  for other Windows shells, I don't know.
  
  =cut
  
  sub oneliner {
      my($self, $cmd, $switches) = @_;
      $switches = [] unless defined $switches;
  
      # Strip leading and trailing newlines
      $cmd =~ s{^\n+}{};
      $cmd =~ s{\n+$}{};
  
      $cmd = $self->quote_literal($cmd);
      $cmd = $self->escape_newlines($cmd);
  
      $switches = join ' ', @$switches;
  
      return qq{\$(ABSPERLRUN) $switches -e $cmd --};
  }
  
  
  sub quote_literal {
      my($self, $text, $opts) = @_;
      $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
  
      # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP
  
      # Apply the Microsoft C/C++ parsing rules
      $text =~ s{\\\\"}{\\\\\\\\\\"}g;  # \\" -> \\\\\"
      $text =~ s{(?<!\\)\\"}{\\\\\\"}g; # \"  -> \\\"
      $text =~ s{(?<!\\)"}{\\"}g;       # "   -> \"
      $text = qq{"$text"} if $text =~ /[ \t]/;
  
      # Apply the Command Prompt parsing rules (cmd.exe)
      my @text = split /("[^"]*")/, $text;
      # We should also escape parentheses, but it breaks one-liners containing
      # $(MACRO)s in makefiles.
      s{([<>|&^@!])}{^$1}g foreach grep { !/^"[^"]*"$/ } @text;
      $text = join('', @text);
      
      # dmake expands {{ to { and }} to }.
      if( $self->is_make_type('dmake') ) {
          $text =~ s/{/{{/g;
          $text =~ s/}/}}/g;
      }
  
      $text = $opts->{allow_variables}
        ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
  
      return $text;
  }
  
  
  sub escape_newlines {
      my($self, $text) = @_;
  
      # Escape newlines
      $text =~ s{\n}{\\\n}g;
  
      return $text;
  }
  
  
  =item cd
  
  dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
  wants:
  
      cd dir1\dir2
      command
      another_command
      cd ..\..
  
  =cut
  
  sub cd {
      my($self, $dir, @cmds) = @_;
  
      return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
  
      my $cmd = join "\n\t", map "$_", @cmds;
  
      my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
  
      # No leading tab and no trailing newline makes for easier embedding.
      my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
  cd %s
  	%s
  	cd %s
  MAKE_FRAG
  
      chomp $make_frag;
  
      return $make_frag;
  }
  
  
  =item max_exec_len
  
  nmake 1.50 limits command length to 2048 characters.
  
  =cut
  
  sub max_exec_len {
      my $self = shift;
  
      return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
  }
  
  
  =item os_flavor
  
  Windows is Win32.
  
  =cut
  
  sub os_flavor {
      return('Win32');
  }
  
  
  =item cflags
  
  Defines the PERLDLL symbol if we are configured for static building since all
  code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
  defined.
  
  =cut
  
  sub cflags {
      my($self,$libperl)=@_;
      return $self->{CFLAGS} if $self->{CFLAGS};
      return '' unless $self->needs_linking();
  
      my $base = $self->SUPER::cflags($libperl);
      foreach (split /\n/, $base) {
          /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
      };
      $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
  
      return $self->{CFLAGS} = qq{
  CCFLAGS = $self->{CCFLAGS}
  OPTIMIZE = $self->{OPTIMIZE}
  PERLTYPE = $self->{PERLTYPE}
  };
  
  }
  
  sub is_make_type {
      my($self, $type) = @_;
      return !! ($self->make =~ /\b$type(?:\.exe)?$/);
  }
  
  1;
  __END__
  
  =back
  
  =cut 
  
  
EXTUTILS_MM_WIN32

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

$fatpacked{"ExtUtils/MY.pm"} = <<'EXTUTILS_MY';
  package ExtUtils::MY;
  
  use strict;
  require ExtUtils::MM;
  
  our $VERSION = '6.64';
  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"} = <<'EXTUTILS_MAKEMAKER';
  # $Id$
  package ExtUtils::MakeMaker;
  
  use strict;
  
  BEGIN {require 5.006;}
  
  require Exporter;
  use ExtUtils::MakeMaker::Config;
  use Carp;
  use File::Path;
  
  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 $VERSION = '6.64';
  $VERSION = eval $VERSION;
  
  # 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 &writeMakefile $Verbose &prompt);
  our @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists
                      &WriteEmptyMakefile);
  
  # These will go away once the last of the Win32 & VMS specific code is 
  # purged.
  my $Is_VMS     = $^O eq 'VMS';
  my $Is_Win32   = $^O eq 'MSWin32';
  
  full_setup();
  
  require ExtUtils::MM;  # Things like CPAN assume loading ExtUtils::MakeMaker
                         # will give them MM.
  
  require ExtUtils::MY;  # XXX pre-5.8 versions of ExtUtils::Embed expect
                         # loading ExtUtils::MakeMaker will give them MY.
                         # This will go when Embed is its own CPAN module.
  
  
  sub WriteMakefile {
      croak "WriteMakefile: Need even number of args" if @_ % 2;
  
      require ExtUtils::MY;
      my %att = @_;
  
      _convert_compat_attrs(\%att);
      
      _verify_att(\%att);
  
      my $mm = MM->new(\%att);
      $mm->flush;
  
      return $mm;
  }
  
  
  # Basic signatures of the attributes WriteMakefile takes.  Each is the
  # reference type.  Empty value indicate it takes a non-reference
  # scalar.
  my %Att_Sigs;
  my %Special_Sigs = (
   AUTHOR             => 'ARRAY',
   C                  => 'ARRAY',
   CONFIG             => 'ARRAY',
   CONFIGURE          => 'CODE',
   DIR                => 'ARRAY',
   DL_FUNCS           => 'HASH',
   DL_VARS            => 'ARRAY',
   EXCLUDE_EXT        => 'ARRAY',
   EXE_FILES          => 'ARRAY',
   FUNCLIST           => 'ARRAY',
   H                  => 'ARRAY',
   IMPORTS            => 'HASH',
   INCLUDE_EXT        => 'ARRAY',
   LIBS               => ['ARRAY',''],
   MAN1PODS           => 'HASH',
   MAN3PODS           => 'HASH',
   META_ADD           => 'HASH',
   META_MERGE         => 'HASH',
   PL_FILES           => 'HASH',
   PM                 => 'HASH',
   PMLIBDIRS          => 'ARRAY',
   PMLIBPARENTDIRS    => 'ARRAY',
   PREREQ_PM          => 'HASH',
   BUILD_REQUIRES     => 'HASH',
   CONFIGURE_REQUIRES => 'HASH',
   TEST_REQUIRES      => 'HASH',
   SKIP               => 'ARRAY',
   TYPEMAPS           => 'ARRAY',
   XS                 => 'HASH',
   VERSION            => ['version',''],
   _KEEP_AFTER_FLUSH  => '',
  
   clean      => 'HASH',
   depend     => 'HASH',
   dist       => 'HASH',
   dynamic_lib=> 'HASH',
   linkext    => 'HASH',
   macro      => 'HASH',
   postamble  => 'HASH',
   realclean  => 'HASH',
   test       => 'HASH',
   tool_autosplit => 'HASH',
  );
  
  @Att_Sigs{keys %Recognized_Att_Keys} = ('') x keys %Recognized_Att_Keys;
  @Att_Sigs{keys %Special_Sigs} = values %Special_Sigs;
  
  sub _convert_compat_attrs { #result of running several times should be same
      my($att) = @_;
      if (exists $att->{AUTHOR}) {
          if ($att->{AUTHOR}) {
              if (!ref($att->{AUTHOR})) {
                  my $t = $att->{AUTHOR};
                  $att->{AUTHOR} = [$t];
              }
          } else {
                  $att->{AUTHOR} = [];
          }
      }
  }
  
  sub _verify_att {
      my($att) = @_;
  
      while( my($key, $val) = each %$att ) {
          my $sig = $Att_Sigs{$key};
          unless( defined $sig ) {
              warn "WARNING: $key is not a known parameter.\n";
              next;
          }
  
          my @sigs   = ref $sig ? @$sig : $sig;
          my $given  = ref $val;
          unless( grep { _is_of_type($val, $_) } @sigs ) {
              my $takes = join " or ", map { _format_att($_) } @sigs;
  
              my $has = _format_att($given);
              warn "WARNING: $key takes a $takes not a $has.\n".
                   "         Please inform the author.\n";
          }
      }
  }
  
  
  # Check if a given thing is a reference or instance of $type
  sub _is_of_type {
      my($thing, $type) = @_;
  
      return 1 if ref $thing eq $type;
  
      local $SIG{__DIE__};
      return 1 if eval{ $thing->isa($type) };
  
      return 0;
  }
  
  
  sub _format_att {
      my $given = shift;
      
      return $given eq ''        ? "string/number"
           : uc $given eq $given ? "$given reference"
           :                       "$given object"
           ;
  }
  
  
  sub prompt ($;$) {  ## no critic
      my($mess, $def) = @_;
      confess("prompt function called without an argument") 
          unless defined $mess;
  
      my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
  
      my $dispdef = defined $def ? "[$def] " : " ";
      $def = defined $def ? $def : "";
  
      local $|=1;
      local $\;
      print "$mess $dispdef";
  
      my $ans;
      if ($ENV{PERL_MM_USE_DEFAULT} || (!$isa_tty && eof STDIN)) {
          print "$def\n";
      }
      else {
          $ans = <STDIN>;
          if( defined $ans ) {
              chomp $ans;
          }
          else { # user hit ctrl-D
              print "\n";
          }
      }
  
      return (!defined $ans || $ans eq '') ? $def : $ans;
  }
  
  sub eval_in_subdirs {
      my($self) = @_;
      use Cwd qw(cwd abs_path);
      my $pwd = cwd() || die "Can't figure out your cwd!";
  
      local @INC = map eval {abs_path($_) if -e} || $_, @INC;
      push @INC, '.';     # '.' has to always be at the end of @INC
  
      foreach my $dir (@{$self->{DIR}}){
          my($abs) = $self->catdir($pwd,$dir);
          eval { $self->eval_in_x($abs); };
          last if $@;
      }
      chdir $pwd;
      die $@ if $@;
  }
  
  sub eval_in_x {
      my($self,$dir) = @_;
      chdir $dir or carp("Couldn't change to directory $dir: $!");
  
      {
          package main;
          do './Makefile.PL';
      };
      if ($@) {
  #         if ($@ =~ /prerequisites/) {
  #             die "MakeMaker WARNING: $@";
  #         } else {
  #             warn "WARNING from evaluation of $dir/Makefile.PL: $@";
  #         }
          die "ERROR from evaluation of $dir/Makefile.PL: $@";
      }
  }
  
  
  # package name for the classes into which the first object will be blessed
  my $PACKNAME = 'PACK000';
  
  sub full_setup {
      $Verbose ||= 0;
  
      my @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
      FULLPERL FULLPERLRUN FULLPERLRUNINST
      FUNCLIST H IMPORTS
  
      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 
  
      INC INCLUDE_EXT LDFROM LIB LIBPERL_A LIBS LICENSE
      LINKTYPE MAKE 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
      NORECURS NO_VC OBJECT OPTIMIZE PERL_MALLOC_OK PERL PERLMAINCC PERLRUN
      PERLRUNINST PERL_CORE
      PERL_SRC PERM_DIR PERM_RW PERM_RWX
      PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PPM_INSTALL_EXEC
      PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
      SIGN SKIP TEST_REQUIRES TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
      XS_VERSION clean depend dist dynamic_lib linkext macro realclean
      tool_autosplit
  
      MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC
      MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED
          /;
  
      # 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 dynamic_bs
   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 writeMakefile {
      die <<END;
  
  The extension you are trying to build apparently is rather old and
  most probably outdated. We detect that from the fact, that a
  subroutine "writeMakefile" is called, and this subroutine is not
  supported anymore since about October 1994.
  
  Please contact the author or look into CPAN (details about CPAN can be
  found in the FAQ and at http:/www.perl.com) for a more recent version
  of the extension. If you're really desperate, you can try to change
  the subroutine name from writeMakefile to WriteMakefile and rerun
  'perl Makefile.PL', but you're most probably left alone, when you do
  so.
  
  The MakeMaker team
  
  END
  }
  
  sub new {
      my($class,$self) = @_;
      my($key);
  
      _convert_compat_attrs($self) if defined $self && $self;
  
      # Store the original args passed to WriteMakefile()
      foreach my $k (keys %$self) {
          $self->{ARGS}{$k} = $self->{$k};
      }
  
      $self = {} unless defined $self;
  
      # Temporarily bless it into MM so it can be used as an
      # object.  It will be blessed into a temp package later.
      bless $self, "MM";
  
      # Cleanup all the module requirement bits
      for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) {
          $self->{$key}      ||= {};
          $self->clean_versions( $key );
      }
  
  
      if ("@ARGV" =~ /\bPREREQ_PRINT\b/) {
          $self->_PREREQ_PRINT;
      }
  
      # PRINT_PREREQ is RedHatism.
      if ("@ARGV" =~ /\bPRINT_PREREQ\b/) {
          $self->_PRINT_PREREQ;
     }
  
      print "MakeMaker (v$VERSION)\n" if $Verbose;
      if (-f "MANIFEST" && ! -f "Makefile" && ! $ENV{PERL_CORE}){
          check_manifest();
      }
  
      check_hints($self);
  
      # Translate X.Y.Z to X.00Y00Z
      if( defined $self->{MIN_PERL_VERSION} ) {
          $self->{MIN_PERL_VERSION} =~ s{ ^ (\d+) \. (\d+) \. (\d+) $ }
                                        {sprintf "%d.%03d%03d", $1, $2, $3}ex;
      }
  
      my $perl_version_ok = eval {
          local $SIG{__WARN__} = sub { 
              # simulate "use warnings FATAL => 'all'" for vintage perls
              die @_;
          };
          !$self->{MIN_PERL_VERSION} or $self->{MIN_PERL_VERSION} <= $]
      };
      if (!$perl_version_ok) {
          if (!defined $perl_version_ok) {
              die <<'END';
  Warning: MIN_PERL_VERSION is not in a recognized format.
  Recommended is a quoted numerical value like '5.005' or '5.008001'.
  END
          }
          elsif ($self->{PREREQ_FATAL}) {
              die sprintf <<"END", $self->{MIN_PERL_VERSION}, $];
  MakeMaker FATAL: perl version too low for this distribution.
  Required is %s. We run %s.
  END
          }
          else {
              warn sprintf
                  "Warning: Perl version %s or higher required. We run %s.\n",
                  $self->{MIN_PERL_VERSION}, $];
          }
      }
  
      my %configure_att;         # record &{$self->{CONFIGURE}} attributes
      my(%initial_att) = %$self; # record initial attributes
  
      my(%unsatisfied) = ();
      my $prereqs = $self->_all_prereqs;
      foreach my $prereq (sort keys %$prereqs) {
          my $required_version = $prereqs->{$prereq};
  
          my $installed_file = MM->_installed_file_for_module($prereq);
          my $pr_version = 0;
          $pr_version = MM->parse_version($installed_file) if $installed_file;
          $pr_version = 0 if $pr_version eq 'undef';
  
          # convert X.Y_Z alpha version #s to X.YZ for easier comparisons
          $pr_version =~ s/(\d+)\.(\d+)_(\d+)/$1.$2$3/;
  
          if (!$installed_file) {
              warn sprintf "Warning: prerequisite %s %s not found.\n", 
                $prereq, $required_version
                     unless $self->{PREREQ_FATAL}
                         or $ENV{PERL_CORE};
  
              $unsatisfied{$prereq} = 'not installed';
          }
          elsif ($pr_version < $required_version ){
              warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n",
                $prereq, $required_version, ($pr_version || 'unknown version') 
                    unless $self->{PREREQ_FATAL}
                         or $ENV{PERL_CORE};
  
              $unsatisfied{$prereq} = $required_version ? $required_version : 'unknown version' ;
          }
      }
  
      if (%unsatisfied && $self->{PREREQ_FATAL}){
          my $failedprereqs = join "\n", map {"    $_ $unsatisfied{$_}"} 
                              sort { $a cmp $b } keys %unsatisfied;
          die <<"END";
  MakeMaker FATAL: prerequisites not found.
  $failedprereqs
  
  Please install these modules first and rerun 'perl Makefile.PL'.
  END
      }
      
      if (defined $self->{CONFIGURE}) {
          if (ref $self->{CONFIGURE} eq 'CODE') {
              %configure_att = %{&{$self->{CONFIGURE}}};
              _convert_compat_attrs(\%configure_att);
              $self = { %$self, %configure_att };
          } else {
              croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n";
          }
      }
  
      # This is for old Makefiles written pre 5.00, will go away
      if ( Carp::longmess("") =~ /runsubdirpl/s ){
          carp("WARNING: Please rerun 'perl Makefile.PL' to regenerate your Makefiles\n");
      }
  
      my $newclass = ++$PACKNAME;
      local @Parent = @Parent;    # Protect against non-local exits
      {
          print "Blessing Object into class [$newclass]\n" if $Verbose>=2;
          mv_all_methods("MY",$newclass);
          bless $self, $newclass;
          push @Parent, $self;
          require ExtUtils::MY;
  
          no strict 'refs';   ## no critic;
          @{"$newclass\:\:ISA"} = 'MM';
      }
  
      if (defined $Parent[-2]){
          $self->{PARENT} = $Parent[-2];
          for my $key (@Prepend_parent) {
              next unless defined $self->{PARENT}{$key};
  
              # Don't stomp on WriteMakefile() args.
              next if defined $self->{ARGS}{$key} and
                      $self->{ARGS}{$key} eq $self->{$key};
  
              $self->{$key} = $self->{PARENT}{$key};
  
              unless ($Is_VMS && $key =~ /PERL$/) {
                  $self->{$key} = $self->catdir("..",$self->{$key})
                    unless $self->file_name_is_absolute($self->{$key});
              } else {
                  # 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);
              }
          }
          if ($self->{PARENT}) {
              $self->{PARENT}->{CHILDREN}->{$newclass} = $self;
              foreach my $opt (qw(POLLUTE PERL_CORE LINKTYPE)) {
                  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,split(' ', $ENV{PERL_MM_OPT} || ''),@ARGV);
      }
  
  
      $self->{NAME} ||= $self->guess_name;
  
      ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g;
  
      $self->init_MAKE;
      $self->init_main;
      $self->init_VERSION;
      $self->init_dist;
      $self->init_INST;
      $self->init_INSTALL;
      $self->init_DEST;
      $self->init_dirscan;
      $self->init_PM;
      $self->init_MANPODS;
      $self->init_xs;
      $self->init_PERL;
      $self->init_DIRFILESEP;
      $self->init_linker;
      $self->init_ABSTRACT;
  
      $self->arch_check(
          $INC{'Config.pm'},
          $self->catfile($Config{'archlibexp'}, "Config.pm")
      );
  
      $self->init_tools();
      $self->init_others();
      $self->init_platform();
      $self->init_PERM();
      my($argv) = neatvalue(\@ARGV);
      $argv =~ s/^\[/(/;
      $argv =~ s/\]$/)/;
  
      push @{$self->{RESULT}}, <<END;
  # This Makefile is for the $self->{NAME} extension to perl.
  #
  # It was generated automatically by MakeMaker version
  # $VERSION (Revision: $Revision) from the contents of
  # Makefile.PL. Don't edit this file, edit Makefile.PL instead.
  #
  #       ANY CHANGES MADE HERE WILL BE LOST!
  #
  #   MakeMaker ARGV: $argv
  #
  END
  
      push @{$self->{RESULT}}, $self->_MakeMaker_Parameters_section(\%initial_att);
  
      if (defined $self->{CONFIGURE}) {
         push @{$self->{RESULT}}, <<END;
  
  #   MakeMaker 'CONFIGURE' Parameters:
  END
          if (scalar(keys %configure_att) > 0) {
              foreach my $key (sort keys %configure_att){
                 next if $key eq 'ARGS';
                 my($v) = neatvalue($configure_att{$key});
                 $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
                 $v =~ tr/\n/ /s;
                 push @{$self->{RESULT}}, "#     $key => $v";
              }
          }
          else
          {
             push @{$self->{RESULT}}, "# no values returned";
          }
          undef %configure_att;  # free memory
      }
  
      # turn the SKIP array into a SKIPHASH hash
      for my $skip (@{$self->{SKIP} || []}) {
          $self->{SKIPHASH}{$skip} = 1;
      }
      delete $self->{SKIP}; # free memory
  
      if ($self->{PARENT}) {
          for (qw/install dist dist_basics dist_core distdir dist_test dist_ci/) {
              $self->{SKIPHASH}{$_} = 1;
          }
      }
  
      # We run all the subdirectories now. They don't have much to query
      # from the parent, but the parent has to query them: if they need linking!
      unless ($self->{NORECURS}) {
          $self->eval_in_subdirs if @{$self->{DIR}};
      }
  
      foreach my $section ( @MM_Sections ){
          # Support for new foo_target() methods.
          my $method = $section;
          $method .= '_target' unless $self->can($method);
  
          print "Processing Makefile '$section' section\n" if ($Verbose >= 2);
          my($skipit) = $self->skipcheck($section);
          if ($skipit){
              push @{$self->{RESULT}}, "\n# --- MakeMaker $section section $skipit.";
          } else {
              my(%a) = %{$self->{$section} || {}};
              push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:";
              push @{$self->{RESULT}}, "# " . join ", ", %a if $Verbose && %a;
              push @{$self->{RESULT}}, $self->maketext_filter(
                  $self->$method( %a )
              );
          }
      }
  
      push @{$self->{RESULT}}, "\n# End.";
  
      $self;
  }
  
  sub WriteEmptyMakefile {
      croak "WriteEmptyMakefile: Need an even number of args" if @_ % 2;
  
      my %att = @_;
      my $self = MM->new(\%att);
  
      my $new = $self->{MAKEFILE};
      my $old = $self->{MAKEFILE_OLD};
      if (-f $old) {
          _unlink($old) or warn "unlink $old: $!";
      }
      if ( -f $new ) {
          _rename($new, $old) or warn "rename $new => $old: $!"
      }
      open my $mfh, '>', $new or die "open $new for write: $!";
      print $mfh <<'EOP';
  all :
  
  clean :
  
  install :
  
  makemakerdflt :
  
  test :
  
  EOP
      close $mfh or die "close $new for write: $!";
  }
  
  
  =begin private
  
  =head3 _installed_file_for_module
  
    my $file = MM->_installed_file_for_module($module);
  
  Return the first installed .pm $file associated with the $module.  The
  one which will show up when you C<use $module>.
  
  $module is something like "strict" or "Test::More".
  
  =end private
  
  =cut
  
  sub _installed_file_for_module {
      my $class  = shift;
      my $prereq = shift;
  
      my $file = "$prereq.pm";
      $file =~ s{::}{/}g;
  
      my $path;
      for my $dir (@INC) {
          my $tmp = File::Spec->catfile($dir, $file);
          if ( -r $tmp ) {
              $path = $tmp;
              last;
          }
      }
  
      return $path;
  }
  
  
  # Extracted from MakeMaker->new so we can test it
  sub _MakeMaker_Parameters_section {
      my $self = shift;
      my $att  = shift;
  
      my @result = <<'END';
  #   MakeMaker Parameters:
  END
  
      foreach my $key (sort keys %$att){
          next if $key eq 'ARGS';
          my ($v) = neatvalue($att->{$key});
          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;
  }
  
  
  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) = @_;
      foreach (@args) {
          unless (m/(.*?)=(.*)/) {
              ++$Verbose if m/^verb/;
              next;
          }
          my($name, $value) = ($1, $2);
          if ($value =~ m/^~(\w+)?/) { # tilde with optional username
              $value =~ s [^~(\w*)]
                  [$1 ?
                   ((getpwnam($1))[7] || "~$1") :
                   (getpwuid($>))[7]
                   ]ex;
          }
  
          # Remember the original args passed it.  It will be useful later.
          $self->{ARGS}{uc $name} = $self->{uc $name} = $value;
      }
  
      # catch old-style 'potential_libs' and inform user how to 'upgrade'
      if (defined $self->{potential_libs}){
          my($msg)="'potential_libs' => '$self->{potential_libs}' should be";
          if ($self->{potential_libs}){
              print "$msg changed to:\n\t'LIBS' => ['$self->{potential_libs}']\n";
          } else {
              print "$msg deleted.\n";
          }
          $self->{LIBS} = [$self->{potential_libs}];
          delete $self->{potential_libs};
      }
      # catch old-style 'ARMAYBE' and inform user how to 'upgrade'
      if (defined $self->{ARMAYBE}){
          my($armaybe) = $self->{ARMAYBE};
          print "ARMAYBE => '$armaybe' should be changed to:\n",
                          "\t'dynamic_lib' => {ARMAYBE => '$armaybe'}\n";
          my(%dl) = %{$self->{dynamic_lib} || {}};
          $self->{dynamic_lib} = { %dl, ARMAYBE => $armaybe};
          delete $self->{ARMAYBE};
      }
      if (defined $self->{LDTARGET}){
          print "LDTARGET should be changed to LDFROM\n";
          $self->{LDFROM} = $self->{LDTARGET};
          delete $self->{LDTARGET};
      }
      # Turn a DIR argument on the command line into an array
      if (defined $self->{DIR} && ref \$self->{DIR} eq 'SCALAR') {
          # So they can choose from the command line, which extensions they want
          # the grep enables them to have some colons too much in case they
          # have to build a list with the shell
          $self->{DIR} = [grep $_, split ":", $self->{DIR}];
      }
      # Turn a INCLUDE_EXT argument on the command line into an array
      if (defined $self->{INCLUDE_EXT} && ref \$self->{INCLUDE_EXT} eq 'SCALAR') {
          $self->{INCLUDE_EXT} = [grep $_, split '\s+', $self->{INCLUDE_EXT}];
      }
      # Turn a EXCLUDE_EXT argument on the command line into an array
      if (defined $self->{EXCLUDE_EXT} && ref \$self->{EXCLUDE_EXT} eq 'SCALAR') {
          $self->{EXCLUDE_EXT} = [grep $_, split '\s+', $self->{EXCLUDE_EXT}];
      }
  
      foreach my $mmkey (sort keys %$self){
          next if $mmkey eq 'ARGS';
          print "  $mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose;
          print "'$mmkey' is not a known MakeMaker parameter name.\n"
              unless exists $Recognized_Att_Keys{$mmkey};
      }
      $| = 1 if $Verbose;
  }
  
  sub check_hints {
      my($self) = @_;
      # We allow extension-specific hints files.
  
      require File::Spec;
      my $curdir = File::Spec->curdir;
  
      my $hint_dir = File::Spec->catdir($curdir, "hints");
      return unless -d $hint_dir;
  
      # First we look for the best hintsfile we have
      my($hint)="${^O}_$Config{osvers}";
      $hint =~ s/\./_/g;
      $hint =~ s/_$//;
      return unless $hint;
  
      # Also try without trailing minor version numbers.
      while (1) {
          last if -f File::Spec->catfile($hint_dir, "$hint.pl");  # found
      } continue {
          last unless $hint =~ s/_[^_]*$//; # nothing to cut off
      }
      my $hint_file = File::Spec->catfile($hint_dir, "$hint.pl");
  
      return unless -f $hint_file;    # really there
  
      _run_hintfile($self, $hint_file);
  }
  
  sub _run_hintfile {
      our $self;
      local($self) = shift;       # make $self available to the hint file.
      my($hint_file) = shift;
  
      local($@, $!);
      warn "Processing hints file $hint_file\n";
  
      # Just in case the ./ isn't on the hint file, which File::Spec can
      # often strip off, we bung the curdir into @INC
      local @INC = (File::Spec->curdir, @INC);
      my $ret = do $hint_file;
      if( !defined $ret ) {
          my $error = $@ || $!;
          warn $error;
      }
  }
  
  sub mv_all_methods {
      my($from,$to) = @_;
  
      # Here you see the *current* list of methods that are overridable
      # from Makefile.PL via MY:: subroutines. As of VERSION 5.07 I'm
      # still trying to reduce the list to some reasonable minimum --
      # because I want to make it easier for the user. A.K.
  
      local $SIG{__WARN__} = sub { 
          # can't use 'no warnings redefined', 5.6 only
          warn @_ unless $_[0] =~ /^Subroutine .* redefined/ 
      };
      foreach my $method (@Overridable) {
  
          # We cannot say "next" here. Nick might call MY->makeaperl
          # which isn't defined right now
  
          # Above statement was written at 4.23 time when Tk-b8 was
          # around. As Tk-b9 only builds with 5.002something and MM 5 is
          # standard, we try to enable the next line again. It was
          # commented out until MM 5.23
  
          next unless defined &{"${from}::$method"};
  
          {
              no strict 'refs';   ## no critic
              *{"${to}::$method"} = \&{"${from}::$method"};
  
              # If we delete a method, then it will be undefined and cannot
              # be called.  But as long as we have Makefile.PLs that rely on
              # %MY:: being intact, we have to fill the hole with an
              # inheriting method:
  
              {
                  package MY;
                  my $super = "SUPER::".$method;
                  *{$method} = sub {
                      shift->$super(@_);
                  };
              }
          }
      }
  
      # We have to clean out %INC also, because the current directory is
      # changed frequently and Graham Barr prefers to get his version
      # out of a History.pl file which is "required" so woudn't get
      # loaded again in another extension requiring a History.pl
  
      # With perl5.002_01 the deletion of entries in %INC caused Tk-b11
      # to core dump in the middle of a require statement. The required
      # file was Tk/MMutil.pm.  The consequence is, we have to be
      # extremely careful when we try to give perl a reason to reload a
      # library with same name.  The workaround prefers to drop nothing
      # from %INC and teach the writers not to use such libraries.
  
  #    my $inc;
  #    foreach $inc (keys %INC) {
  #       #warn "***$inc*** deleted";
  #       delete $INC{$inc};
  #    }
  }
  
  sub skipcheck {
      my($self) = shift;
      my($section) = @_;
      if ($section eq 'dynamic') {
          print "Warning (non-fatal): Target 'dynamic' depends on targets ",
          "in skipped section 'dynamic_bs'\n"
              if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
          print "Warning (non-fatal): Target 'dynamic' depends on targets ",
          "in skipped section 'dynamic_lib'\n"
              if $self->{SKIPHASH}{dynamic_lib} && $Verbose;
      }
      if ($section eq 'dynamic_lib') {
          print "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on ",
          "targets in skipped section 'dynamic_bs'\n"
              if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
      }
      if ($section eq 'static') {
          print "Warning (non-fatal): Target 'static' depends on targets ",
          "in skipped section 'static_lib'\n"
              if $self->{SKIPHASH}{static_lib} && $Verbose;
      }
      return 'skipped' if $self->{SKIPHASH}{$section};
      return '';
  }
  
  sub flush {
      my $self = shift;
  
      my $finalname = $self->{MAKEFILE};
      print "Writing $finalname for $self->{NAME}\n";
  
      unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ());
      open(my $fh,">", "MakeMaker.tmp")
          or die "Unable to open MakeMaker.tmp: $!";
  
      for my $chunk (@{$self->{RESULT}}) {
          print $fh "$chunk\n"
              or die "Can't write to MakeMaker.tmp: $!";
      }
  
      close $fh
          or die "Can't write to MakeMaker.tmp: $!";
      _rename("MakeMaker.tmp", $finalname) or
        warn "rename MakeMaker.tmp => $finalname: $!";
      chmod 0644, $finalname unless $Is_VMS;
  
      unless ($self->{NO_MYMETA}) {
          # Write MYMETA.yml to communicate metadata up to the CPAN clients
          if ( $self->write_mymeta( $self->mymeta ) ) {
              print "Writing MYMETA.yml and MYMETA.json\n";
          }
  
      }
      my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE);
      if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) {
          foreach (keys %$self) { # safe memory
              delete $self->{$_} unless $keep{$_};
          }
      }
  
      system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":";
  }
  
  # This is a rename for OS's where the target must be unlinked first.
  sub _rename {
      my($src, $dest) = @_;
      chmod 0666, $dest;
      unlink $dest;
      return rename $src, $dest;
  }
  
  # This is an unlink for OS's where the target must be writable first.
  sub _unlink {
      my @files = @_;
      chmod 0666, @files;
      return unlink @files;
  }
  
  
  # The following mkbootstrap() is only for installations that are calling
  # the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker
  # writes Makefiles, that use ExtUtils::Mkbootstrap directly.
  sub mkbootstrap {
      die <<END;
  !!! Your Makefile has been built such a long time ago, !!!
  !!! that is unlikely to work with current MakeMaker.   !!!
  !!! Please rebuild your Makefile                       !!!
  END
  }
  
  # Ditto for mksymlists() as of MakeMaker 5.17
  sub mksymlists {
      die <<END;
  !!! Your Makefile has been built such a long time ago, !!!
  !!! that is unlikely to work with current MakeMaker.   !!!
  !!! Please rebuild your Makefile                       !!!
  END
  }
  
  sub neatvalue {
      my($v) = @_;
      return "undef" unless defined $v;
      my($t) = ref $v;
      return "q[$v]" unless $t;
      if ($t eq 'ARRAY') {
          my(@m, @neat);
          push @m, "[";
          foreach my $elem (@$v) {
              push @neat, "q[$elem]";
          }
          push @m, join ", ", @neat;
          push @m, "]";
          return join "", @m;
      }
      return "$v" unless $t eq 'HASH';
      my(@m, $key, $val);
      while (($key,$val) = each %$v){
          last unless defined $key; # cautious programming in case (undef,undef) is true
          push(@m,"$key=>".neatvalue($val)) ;
      }
      return "{ ".join(', ',@m)." }";
  }
  
  # Look for weird version numbers, warn about them and set them to 0
  # before CPAN::Meta chokes.
  sub clean_versions {
      my($self, $key) = @_;
  
      my $reqs = $self->{$key};
      for my $module (keys %$reqs) {
          my $version = $reqs->{$module};
  
          if( !defined $version or $version !~ /^[\d_\.]+$/ ) {
              carp "Unparsable version '$version' for prerequisite $module";
              $reqs->{$module} = 0;
          }
      }
  }
  
  sub selfdocument {
      my($self) = @_;
      my(@m);
      if ($Verbose){
          push @m, "\n# Full list of MakeMaker attribute values:";
          foreach my $key (sort keys %$self){
              next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/;
              my($v) = neatvalue($self->{$key});
              $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
              $v =~ tr/\n/ /s;
              push @m, "# $key => $v";
          }
      }
      join "\n", @m;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  ExtUtils::MakeMaker - Create a module Makefile
  
  =head1 SYNOPSIS
  
    use ExtUtils::MakeMaker;
  
    WriteMakefile(
        NAME              => "Foo::Bar",
        VERSION_FROM      => "lib/Foo/Bar.pm",
    );
  
  =head1 DESCRIPTION
  
  This utility is designed to write a Makefile for an extension module
  from a Makefile.PL. It is based on the Makefile.SH model provided by
  Andy Dougherty and the perl5-porters.
  
  It splits the task of generating the Makefile into several subroutines
  that can be individually overridden.  Each subroutine returns the text
  it wishes to have written to the Makefile.
  
  As there are various Make programs with incompatible syntax, which
  use operating system shells, again with incompatible syntax, it is
  important for users of this module to know which flavour of Make
  a Makefile has been written for so they'll use the correct one and
  won't have to face the possibly bewildering errors resulting from
  using the wrong one.
  
  On POSIX systems, that program will likely be GNU Make; on Microsoft
  Windows, it will be either Microsoft NMake or DMake. Note that this
  module does not support generating Makefiles for GNU Make on Windows.
  See the section on the L</"MAKE"> parameter for details.
  
  MakeMaker 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().
  
  =head2 How To Write A Makefile.PL
  
  See 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 execute the script with the
  proper set of perl C<-I> options.
  
  MakeMaker also checks for any files matching glob("t/*.t"). It will
  execute all matching files in alphabetical order via the
  L<Test::Harness> module with the C<-I> switches set correctly.
  
  If you'd like to see the raw output of your tests, set the
  C<TEST_VERBOSE> variable to true.
  
    make test TEST_VERBOSE=1
  
  =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 per 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 Makefile.aperl (may be system dependent). If you
  want to force the creation of a new perl, it is recommended, that you
  delete this 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 per 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 to mention,
  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.
  
  =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
  
  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 CPAN Meta file.
  (F<META.yml> or F<META.json>).
  
  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
  
  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 CPAN Meta file
  (F<META.yml> or F<META.json>)
  
  Defaults to C<<< { "ExtUtils::MakeMaker" => 0 } >>>
  
  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 above 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 DL_FUNCS
  
  Hashref of symbol names for routines to be made available as universal
  symbols.  Each key/value pair consists of the package name and an
  array of routine names in that package.  Used only under AIX, OS/2,
  VMS and Win32 at present.  The routine names supplied will be expanded
  in the same way as XSUB names are expanded by the XS() macro.
  Defaults to
  
    {"$(NAME)" => ["boot_$(NAME)" ] }
  
  e.g.
  
    {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )],
     "NetconfigPtr" => [ 'DESTROY'] }
  
  Please see the L<ExtUtils::Mksymlists> documentation for more information
  about the DL_FUNCS, DL_VARS and FUNCLIST attributes.
  
  =item DL_VARS
  
  Array of symbol names for variables to be made available as universal symbols.
  Used only under AIX, OS/2, VMS and Win32 at present.  Defaults to [].
  (e.g. [ qw(Foo_version Foo_numstreams Foo_tree ) ])
  
  =item EXCLUDE_EXT
  
  Array of extension names to exclude when doing a static build.  This
  is ignored if INCLUDE_EXT is present.  Consult INCLUDE_EXT for more
  details.  (e.g.  [ qw( Socket POSIX ) ] )
  
  This attribute may be most useful when specified as a string on the
  command line:  perl Makefile.PL EXCLUDE_EXT='Socket Safe'
  
  =item EXE_FILES
  
  Ref to array of executable files. The files will be copied to the
  INST_SCRIPT directory. Make realclean will delete them from there
  again.
  
  If your executables start with something like #!perl or
  #!/usr/bin/perl MakeMaker will change this to the path of the perl
  'Makefile.PL' was invoked with so the programs will be sure to run
  properly even if perl is not in /usr/bin/perl.
  
  =item FIRST_MAKEFILE
  
  The name of the Makefile to be produced.  This is used for the second
  Makefile that will be produced for the MAP_TARGET.
  
  Defaults to 'Makefile' or 'Descrip.MMS' on VMS.
  
  (Note: we couldn't use MAKEFILE because dmake uses this for something
  else).
  
  =item FULLPERL
  
  Perl binary able to run this extension, load XS modules, etc...
  
  =item FULLPERLRUN
  
  Like PERLRUN, except it uses FULLPERL.
  
  =item FULLPERLRUNINST
  
  Like PERLRUNINST, except it uses FULLPERL.
  
  =item FUNCLIST
  
  This provides an alternate means to specify function names to be
  exported from the extension.  Its value is a reference to an
  array of function names to be exported by the extension.  These
  names are passed through unaltered to the linker options file.
  
  =item H
  
  Ref to array of *.h file names. Similar to C.
  
  =item IMPORTS
  
  This attribute is used to specify names to be imported into the
  extension. Takes a hash ref.
  
  It is only used on OS/2 and Win32.
  
  =item INC
  
  Include file dirs eg: C<"-I/usr/5include -I/path/to/inc">
  
  =item INCLUDE_EXT
  
  Array of extension names to be included when doing a static build.
  MakeMaker will normally build with all of the installed extensions when
  doing a static build, and that is usually the desired behavior.  If
  INCLUDE_EXT is present then MakeMaker will build only with those extensions
  which are explicitly mentioned. (e.g.  [ qw( Socket POSIX ) ])
  
  It is not necessary to mention DynaLoader or the current extension when
  filling in INCLUDE_EXT.  If the INCLUDE_EXT is mentioned but is empty then
  only DynaLoader and the current extension will be included in the build.
  
  This attribute may be most useful when specified as a string on the
  command line:  perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
  
  =item INSTALLARCHLIB
  
  Used by 'make install', which copies files from INST_ARCHLIB to this
  directory if INSTALLDIRS is set to perl.
  
  =item INSTALLBIN
  
  Directory to install binary files (e.g. tkperl) into if
  INSTALLDIRS=perl.
  
  =item INSTALLDIRS
  
  Determines which of the sets of installation directories to choose:
  perl, site or vendor.  Defaults to site.
  
  =item INSTALLMAN1DIR
  
  =item INSTALLMAN3DIR
  
  These directories get the man pages at 'make install' time if
  INSTALLDIRS=perl.  Defaults to $Config{installman*dir}.
  
  If set to 'none', no man pages will be installed.
  
  =item INSTALLPRIVLIB
  
  Used by 'make install', which copies files from INST_LIB to this
  directory if INSTALLDIRS is set to perl.
  
  Defaults to $Config{installprivlib}.
  
  =item INSTALLSCRIPT
  
  Used by 'make install' which copies files from INST_SCRIPT to this
  directory if INSTALLDIRS=perl.
  
  =item INSTALLSITEARCH
  
  Used by 'make install', which copies files from INST_ARCHLIB to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLSITEBIN
  
  Used by 'make install', which copies files from INST_BIN to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLSITELIB
  
  Used by 'make install', which copies files from INST_LIB to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLSITEMAN1DIR
  
  =item INSTALLSITEMAN3DIR
  
  These directories get the man pages at 'make install' time if
  INSTALLDIRS=site (default).  Defaults to 
  $(SITEPREFIX)/man/man$(MAN*EXT).
  
  If set to 'none', no man pages will be installed.
  
  =item INSTALLSITESCRIPT
  
  Used by 'make install' which copies files from INST_SCRIPT to this
  directory if INSTALLDIRS is set to site (default).
  
  =item INSTALLVENDORARCH
  
  Used by 'make install', which copies files from INST_ARCHLIB to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INSTALLVENDORBIN
  
  Used by 'make install', which copies files from INST_BIN to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INSTALLVENDORLIB
  
  Used by 'make install', which copies files from INST_LIB to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INSTALLVENDORMAN1DIR
  
  =item INSTALLVENDORMAN3DIR
  
  These directories get the man pages at 'make install' time if
  INSTALLDIRS=vendor.  Defaults to $(VENDORPREFIX)/man/man$(MAN*EXT).
  
  If set to 'none', no man pages will be installed.
  
  =item INSTALLVENDORSCRIPT
  
  Used by 'make install' which copies files from INST_SCRIPT to this
  directory if INSTALLDIRS is set to vendor.
  
  =item INST_ARCHLIB
  
  Same as INST_LIB for architecture dependent files.
  
  =item INST_BIN
  
  Directory to put real binary files during 'make'. These will be copied
  to INSTALLBIN during 'make install'
  
  =item INST_LIB
  
  Directory where we put library files of this extension while building
  it.
  
  =item INST_MAN1DIR
  
  Directory to hold the man pages at 'make' time
  
  =item INST_MAN3DIR
  
  Directory to hold the man pages at 'make' time
  
  =item INST_SCRIPT
  
  Directory, where executable files should be installed during
  'make'. Defaults to "./blib/script", just to have a dummy location during
  testing. make install will copy the files in INST_SCRIPT to
  INSTALLSCRIPT.
  
  =item LD
  
  Program to be used to link libraries for dynamic loading.
  
  Defaults to $Config{ld}.
  
  =item LDDLFLAGS
  
  Any special flags that might need to be passed to ld to create a
  shared library suitable for dynamic loading.  It is up to the makefile
  to use it.  (See L<Config/lddlflags>)
  
  Defaults to $Config{lddlflags}.
  
  =item LDFROM
  
  Defaults to "$(OBJECT)" and is used in the ld command to specify
  what files to link/load from (also see dynamic_lib below for how to
  specify ld flags)
  
  =item LIB
  
  LIB should only be set at C<perl Makefile.PL> time but is allowed as a
  MakeMaker argument. It has the effect of setting both INSTALLPRIVLIB
  and INSTALLSITELIB to that value regardless any explicit setting of
  those arguments (or of PREFIX).  INSTALLARCHLIB and INSTALLSITEARCH
  are set to the corresponding architecture subdirectory.
  
  =item LIBPERL_A
  
  The filename of the perllibrary that will be used together with this
  extension. Defaults to libperl.a.
  
  =item LIBS
  
  An anonymous array of alternative library
  specifications to be searched for (in order) until
  at least one library is found. E.g.
  
    'LIBS' => ["-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs"]
  
  Mind, that any element of the array
  contains a complete set of arguments for the ld
  command. So do not specify
  
    'LIBS' => ["-ltcl", "-ltk", "-lX11"]
  
  See ODBM_File/Makefile.PL for an example, where an array is needed. If
  you specify a scalar as in
  
    'LIBS' => "-ltcl -ltk -lX11"
  
  MakeMaker will turn it into an array with one element.
  
  =item LICENSE
  
  The licensing terms of your distribution.  Generally its "perl" for the
  same license as Perl itself.
  
  See L<Module::Build::API> 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 MAKE
  
  Variant of make you intend to run the generated Makefile with.  This
  parameter lets Makefile.PL know what make quirks to account for when
  generating the Makefile.
  
  MakeMaker also honors the MAKE environment variable.  This parameter
  takes precedent.
  
  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
  
  A hashrefs 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.
  
  =item MIN_PERL_VERSION
  
  The minimum required version of Perl for this distribution.
  
  Either 5.006001 or 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 its running.
  
  By setting it to an empty string you can generate a Makefile that
  prints all commands. Mainly used in debugging MakeMaker itself.
  
  Defaults to C<@>.
  
  =item NORECURS
  
  Boolean.  Attribute to inhibit descending into subdirectories.
  
  =item NO_META
  
  When true, suppresses the generation and addition to the MANIFEST of
  the META.yml and META.json module meta-data files during 'make distdir'.
  
  Defaults to false.
  
  =item NO_MYMETA
  
  When true, suppresses the generation of MYMETA.yml and MYMETA.json module
  meta-data files during 'perl Makefile.PL'.
  
  Defaults to false.
  
  =item NO_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 containing all object files, e.g. "tkpBind.o
  tkpButton.o tkpCanvas.o"
  
  (Where BASEEXT is the last component of NAME, and OBJ_EXT is $Config{obj_ext}.)
  
  =item OPTIMIZE
  
  Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is
  passed to subdirectory makes.
  
  =item PERL
  
  Perl binary for tasks that can be done by miniperl
  
  =item PERL_CORE
  
  Set only when MakeMaker is building the extensions of the Perl core
  distribution.
  
  =item PERLMAINCC
  
  The call to the program that is able to compile perlmain.c. Defaults
  to $(CC).
  
  =item PERL_ARCHLIB
  
  Same as for PERL_LIB, but for architecture dependent files.
  
  Used only when MakeMaker is building the extensions of the Perl core
  distribution (because normally $(PERL_ARCHLIB) is automatically in @INC,
  and adding it would get in the way of PERL5LIB).
  
  =item PERL_LIB
  
  Directory containing the Perl library to use.
  
  Used only when MakeMaker is building the extensions of the Perl core
  distribution (because normally $(PERL_LIB) is automatically in @INC,
  and adding it would get in the way of PERL5LIB).
  
  =item PERL_MALLOC_OK
  
  defaults to 0.  Should be set to TRUE if the extension can work with
  the memory allocation routines substituted by the Perl malloc() subsystem.
  This should be applicable to most extensions with exceptions of those
  
  =over 4
  
  =item *
  
  with bugs in memory allocations which are caught by Perl's malloc();
  
  =item *
  
  which interact with the memory allocator in other ways than via
  malloc(), realloc(), free(), calloc(), sbrk() and brk();
  
  =item *
  
  which rely on special alignment which is not provided by Perl's malloc().
  
  =back
  
  B<NOTE.>  Negligence to set this flag in I<any one> of loaded extension
  nullifies many advantages of Perl's malloc(), such as better usage of
  system resources, error detection, memory usage reporting, catchable failure
  of memory allocations, etc.
  
  =item PERLPREFIX
  
  Directory under which core modules are to be installed.
  
  Defaults to $Config{installprefixexp} falling back to
  $Config{installprefix}, $Config{prefixexp} or $Config{prefix} should
  $Config{installprefixexp} not exist.
  
  Overridden by PREFIX.
  
  =item PERLRUN
  
  Use this instead of $(PERL) when you wish to run perl.  It will set up
  extra necessary flags for you.
  
  =item PERLRUNINST
  
  Use this instead of $(PERL) when you wish to run perl to work with
  modules.  It will add things like -I$(INST_ARCH) and other necessary
  flags so perl can see the modules you're about to install.
  
  =item PERL_SRC
  
  Directory containing the Perl source code (use of this should be
  avoided, it may be undefined)
  
  =item PERM_DIR
  
  Desired permission for directories. Defaults to C<755>.
  
  =item PERM_RW
  
  Desired permission for read/writable files. Defaults to C<644>.
  
  =item PERM_RWX
  
  Desired permission for executable files. Defaults to C<755>.
  
  =item PL_FILES
  
  MakeMaker can run programs to generate files for you at build time.
  By default any file named *.PL (except Makefile.PL and Build.PL) in
  the top level directory will be assumed to be a Perl program and run
  passing its own basename in as an argument.  For example...
  
      perl foo.PL foo
  
  This behavior can be overridden by supplying your own set of files to
  search.  PL_FILES accepts a hash ref, the key being the file to run
  and the value is passed in as the first argument when the PL file is run.
  
      PL_FILES => {'bin/foobar.PL' => 'bin/foobar'}
  
  Would run bin/foobar.PL like this:
  
      perl bin/foobar.PL bin/foobar
  
  If multiple files from one program are desired an array ref can be used.
  
      PL_FILES => {'bin/foobar.PL' => [qw(bin/foobar1 bin/foobar2)]}
  
  In this case the program will be run multiple times using each target file.
  
      perl bin/foobar.PL bin/foobar1
      perl bin/foobar.PL bin/foobar2
  
  PL files are normally run B<after> pm_to_blib and include INST_LIB and
  INST_ARCH in its 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 its somewhat DWIM).
  
  
  =item PM
  
  Hashref of .pm files and *.pl files to be installed.  e.g.
  
    {'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'}
  
  By default this will include *.pm and *.pl and the files found in
  the PMLIBDIRS directories.  Defining PM in the
  Makefile.PL will override PMLIBDIRS.
  
  =item PMLIBDIRS
  
  Ref to array of subdirectories containing library files.  Defaults to
  [ 'lib', $(BASEEXT) ]. The directories will be scanned and I<any> files
  they contain will be installed in the corresponding location in the
  library.  A libscan() method can be used to alter the behaviour.
  Defining PM in the Makefile.PL will override PMLIBDIRS.
  
  (Where BASEEXT is the last component of NAME.)
  
  =item PM_FILTER
  
  A filter program, in the traditional Unix sense (input from stdin, output
  to stdout) that is passed on each .pm file during the build (in the
  pm_to_blib() phase).  It is empty by default, meaning no filtering is done.
  
  Great care is necessary when defining the command if quoting needs to be
  done.  For instance, you would need to say:
  
    {'PM_FILTER' => 'grep -v \\"^\\#\\"'}
  
  to remove all the leading comments on the fly during the build.  The
  extra \\ are necessary, unfortunately, because this variable is interpolated
  within the context of a Perl program built on the command line, and double
  quotes are what is used with the -e switch to build that command line.  The
  # is escaped for the Makefile, since what is going to be generated will then
  be:
  
    PM_FILTER = grep -v \"^\#\"
  
  Without the \\ before the #, we'd have the start of a Makefile comment,
  and the macro would be incorrectly defined.
  
  =item POLLUTE
  
  Release 5.005 grandfathered old global symbol names by providing preprocessor
  macros for extension source compatibility.  As of release 5.6, these
  preprocessor definitions are not available by default.  The POLLUTE flag
  specifies that the old names should still be defined:
  
    perl Makefile.PL POLLUTE=1
  
  Please inform the module author if this is necessary to successfully install
  a module under 5.6 or later.
  
  =item PPM_INSTALL_EXEC
  
  Name of the executable used to run C<PPM_INSTALL_SCRIPT> below. (e.g. perl)
  
  =item PPM_INSTALL_SCRIPT
  
  Name of the script that gets executed by the Perl Package Manager after
  the installation of a package.
  
  =item 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 effected
  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.
  
  Module installation tools have ways of resolving umet dependencies but
  to do that they need a F<Makefile>.  Using C<PREREQ_FATAL> breaks this.
  That's bad.
  
  Assuming you have good test coverage, your tests should fail with
  missing dependencies informing the user more strongly that something
  is wrong.  You can write a F<t/00compile.t> test which will simply
  check that your code compiles and stop "make test" prematurely if it
  doesn't.  See L<Test::More/BAIL_OUT> for more details.
  
  
  =item PREREQ_PM
  
  A hash of modules that are needed to run your module.  The keys are
  the module names ie. Test::More, and the minimum version is the
  value. If the required version number is 0 any version will do.
  
  This will go into the C<requires> field of your CPAN Meta file
  (F<META.yml> or 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 hasref.
  
  =item PRINT_PREREQ
  
  RedHatism for C<PREREQ_PRINT>.  The output format is different, though:
  
      perl(A::B)>=Vers1 perl(C::D)>=Vers2 ...
  
  A minimal required perl version, if present, will look like this:
  
      perl(perl)>=5.008001
  
  =item SITEPREFIX
  
  Like PERLPREFIX, but only for the site install locations.
  
  Defaults to $Config{siteprefixexp}.  Perls prior to 5.6.0 didn't have
  an explicit siteprefix in the Config.  In those cases
  $Config{installprefix} will be used.
  
  Overridable by PREFIX
  
  =item SIGN
  
  When true, perform the generation and addition to the MANIFEST of the
  SIGNATURE file in the distdir during 'make distdir', via 'cpansign
  -s'.
  
  Note that you need to install the Module::Signature module to
  perform this operation.
  
  Defaults to false.
  
  =item SKIP
  
  Arrayref. E.g. [qw(name1 name2)] skip (do not write) sections of the
  Makefile. Caution! Do not use the SKIP attribute for the negligible
  speedup. It may seriously damage the resulting Makefile. Only use it
  if you really need it.
  
  =item TEST_REQUIRES
  
  A hash of modules that are needed to test your module but not run or
  build it.
  
  This will go into the C<test_requires> field of your CPAN Meta file.
  (F<META.yml> or 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';
  
  "Version strings" are incompatible 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);
  
  (Putting C<my> or C<local> on the preceding line will work o.k.)
  
  The file named in VERSION_FROM is not added as a dependency to
  Makefile. This is not really correct, but it would be a major pain
  during development to have to rewrite the Makefile for any smallish
  change in that file. If you want to make sure that the Makefile
  contains the correct VERSION macro after any change of the file, you
  would have to do something like
  
      depend => { Makefile => '$(VERSION_FROM)' }
  
  See attribute C<depend> below.
  
  =item VERSION_SYM
  
  A sanitized VERSION with . replaced by _.  For places where . has
  special meaning (some filesystems, RCS labels, etc...)
  
  =item XS
  
  Hashref of .xs files. MakeMaker will default this.  e.g.
  
    {'name_of_file.xs' => 'name_of_file.c'}
  
  The .c files will automatically be included in the list of files
  deleted by a make clean.
  
  =item XSOPT
  
  String of options to pass to xsubpp.  This might include C<-C++> or
  C<-extern>.  Do not include typemaps here; the TYPEMAP parameter exists for
  that purpose.
  
  =item XSPROTOARG
  
  May be set to an empty string, which is identical to C<-prototypes>, 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
  
    {TESTS => 't/*.t'}
  
  =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 manifest
  
  rewrites the MANIFEST file, adding all remaining files found (See
  ExtUtils::Manifest::mkmanifest() for details)
  
  =item    make distdir
  
  Copies all the files that are in the MANIFEST file to a newly created
  directory with the name C<$(DISTNAME)-$(VERSION)>. If that directory
  exists, it will be removed first.
  
  Additionally, it will create META.yml and META.json module meta-data file
  in the distdir and add this to the distdir's MANIFEST.  You can shut this
  behavior off with the NO_META flag.
  
  =item   make disttest
  
  Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and
  a make test in that directory.
  
  =item    make tardist
  
  First does a distdir. Then a command $(PREOP) which defaults to a null
  command, followed by $(TO_UNIX), which defaults to a null command under
  UNIX, and will convert files in distribution directory to UNIX format
  otherwise. Next it runs C<tar> on that directory into a tarfile and
  deletes the directory. Finishes with a command $(POSTOP) which
  defaults to a null command.
  
  =item    make dist
  
  Defaults to $(DIST_DEFAULT) which in turn defaults to tardist.
  
  =item    make uutardist
  
  Runs a tardist first and uuencodes the tarfile.
  
  =item    make shdist
  
  First does a distdir. Then a command $(PREOP) which defaults to a null
  command. Next it runs C<shar> on that directory into a sharfile and
  deletes the intermediate directory again. Finishes with a command
  $(POSTOP) which defaults to a null command.  Note: For shdist to work
  properly a C<shar> program that can handle directories is mandatory.
  
  =item    make zipdist
  
  First does a distdir. Then a command $(PREOP) which defaults to a null
  command. Runs C<$(ZIP) $(ZIPFLAGS)> on that directory into a
  zipfile. Then deletes that directory. Finishes with a command
  $(POSTOP) which defaults to a null command.
  
  =item    make ci
  
  Does a $(CI) and a $(RCS_LABEL) on all files in the MANIFEST file.
  
  =back
  
  Customization of the dist targets can be done by specifying a hash
  reference to the dist attribute of the WriteMakefile call. The
  following parameters are recognized:
  
      CI           ('ci -u')
      COMPRESS     ('gzip --best')
      POSTOP       ('@ :')
      PREOP        ('@ :')
      TO_UNIX      (depends on the system)
      RCS_LABEL    ('rcs -q -Nv$(VERSION_SYM):')
      SHAR         ('shar')
      SUFFIX       ('.gz')
      TAR          ('tar')
      TARFLAGS     ('cvf')
      ZIP          ('zip')
      ZIPFLAGS     ('-r')
  
  An example:
  
      WriteMakefile(
          ...other options...
          dist => {
              COMPRESS => "bzip2",
              SUFFIX   => ".bz2"
          }
      );
  
  
  =head2 Module Meta-Data (META and MYMETA)
  
  Long plaguing users of MakeMaker based modules has been the problem of
  getting basic information about the module out of the sources
  I<without> running the F<Makefile.PL> and doing a bunch of messy
  heuristics on the resulting F<Makefile>.  Over the years, it has become
  standard to keep this information in one or more CPAN Meta files
  distributed with each distribution.
  
  The original format of CPAN Meta files was L<YAML> and the corresponding
  file was called F<META.yml>.  In 2010, version 2 of the L<CPAN::Meta::Spec>
  was released, which mandates JSON format for the metadata in order to
  overcome certain compatibility issues between YAML serializers and to
  avoid breaking older clients unable to handle a new version of the spec.
  The L<CPAN::Meta> library is now standard for accessing old and new-style
  Meta files.
  
  If L<CPAN::Meta> is installed, MakeMaker will automatically generate
  F<META.json> and F<META.yml> files for you and add them to your F<MANIFEST> as
  part of the 'distdir' target (and thus the 'dist' target).  This is intended to
  seamlessly and rapidly populate CPAN with module meta-data.  If you wish to
  shut this feature off, set the C<NO_META> C<WriteMakefile()> flag to true.
  
  At the 2008 QA Hackathon in Oslo, Perl module toolchain maintainers agrees
  to use the CPAN Meta format to communicate post-configuration requirements
  between toolchain components.  These files, F<MYMETA.json> and F<MYMETA.yml>,
  are generated when F<Makefile.PL> generates a F<Makefile> (if L<CPAN::Meta>
  is installed).  Clients like L<CPAN> or L<CPANPLUS> will read this
  files to see what prerequisites must be fulfilled before building or testing
  the distribution.  If you with to shut this feature off, set the C<NO_MYMETA>
  C<WriteMakeFile()> flag to true.
  
  =head2 Disabling an extension
  
  If some events detected in F<Makefile.PL> imply that there is no way
  to create the Module, but this is a normal state of things, then you
  can create a F<Makefile> which does nothing, but succeeds on all the
  "usual" build targets.  To do so, use
  
      use ExtUtils::MakeMaker qw(WriteEmptyMakefile);
      WriteEmptyMakefile();
  
  instead of WriteMakefile().
  
  This may be useful if other modules expect this module to be I<built>
  OK, as opposed to I<work> OK (say, this system-dependent module builds
  in a subdirectory of some other distribution, or is listed as a
  dependency in a CPAN::Bundle, but the functionality is supported by
  different means on the current architecture).
  
  =head2 Other Handy Functions
  
  =over 4
  
  =item prompt
  
      my $value = prompt($message);
      my $value = prompt($message, $default);
  
  The C<prompt()> function provides an easy way to request user input
  used to write a makefile.  It displays the $message as a prompt for
  input.  If a $default is provided it will be used as a default.  The
  function returns the $value selected by the user.
  
  If C<prompt()> detects that it is not running interactively and there
  is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable
  is set to true, the $default will be used without prompting.  This
  prevents automated processes from blocking on user input. 
  
  If no $default is provided an empty string will be used instead.
  
  =back
  
  
  =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 on whitespace, and the result
  is processed before any actual command line arguments are processed.
  
  =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.
  
  =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<http://www.makemaker.org>.
  
  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"} = <<'EXTUTILS_MAKEMAKER_CONFIG';
  package ExtUtils::MakeMaker::Config;
  
  use strict;
  
  our $VERSION = '6.64';
  
  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/Manifest.pm"} = <<'EXTUTILS_MANIFEST';
  package ExtUtils::Manifest;
  
  require Exporter;
  use Config;
  use File::Basename;
  use File::Copy 'copy';
  use File::Find;
  use File::Spec;
  use Carp;
  use strict;
  
  use vars qw($VERSION @ISA @EXPORT_OK 
            $Is_MacOS $Is_VMS $Is_VMS_mode $Is_VMS_lc $Is_VMS_nodot
            $Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
  
  $VERSION = '1.60';
  @ISA=('Exporter');
  @EXPORT_OK = qw(mkmanifest
                  manicheck  filecheck  fullcheck  skipcheck
                  manifind   maniread   manicopy   maniadd
                  maniskip
                 );
  
  $Is_MacOS = $^O eq 'MacOS';
  $Is_VMS   = $^O eq 'VMS';
  $Is_VMS_mode = 0;
  $Is_VMS_lc = 0;
  $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);
  }
  
  $Debug   = $ENV{PERL_MM_MANIFEST_DEBUG} || 0;
  $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ?
                     $ENV{PERL_MM_MANIFEST_VERBOSE} : 1;
  $Quiet = 0;
  $MANIFEST = 'MANIFEST';
  
  $DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" );
  
  
  =head1 NAME
  
  ExtUtils::Manifest - utilities to write and check a MANIFEST file
  
  =head1 SYNOPSIS
  
      use ExtUtils::Manifest qw(...funcs to import...);
  
      mkmanifest();
  
      my @missing_files    = manicheck;
      my @skipped          = skipcheck;
      my @extra_files      = filecheck;
      my($missing, $extra) = fullcheck;
  
      my $found    = manifind();
  
      my $manifest = maniread();
  
      manicopy($read,$target);
  
      maniadd({$file => $comment, ...});
  
  
  =head1 DESCRIPTION
  
  =head2 Functions
  
  ExtUtils::Manifest exports no functions by default.  The following are
  exported on request
  
  =over 4
  
  =item mkmanifest
  
      mkmanifest();
  
  Writes all files in and below the current directory to your F<MANIFEST>.
  It works similar to the result of the Unix command
  
      find . > MANIFEST
  
  All files that match any regular expression in a file F<MANIFEST.SKIP>
  (if it exists) are ignored.
  
  Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.
  
  =cut
  
  sub _sort {
      return sort { lc $a cmp lc $b } @_;
  }
  
  sub mkmanifest {
      my $manimiss = 0;
      my $read = (-r 'MANIFEST' && maniread()) or $manimiss++;
      $read = {} if $manimiss;
      local *M;
      my $bakbase = $MANIFEST;
      $bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots
      rename $MANIFEST, "$bakbase.bak" unless $manimiss;
      open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!";
      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;
    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 $_;
  
          if( $Is_VMS_lc ) {
              $name =~ s#(.*)\.$#\L$1#;
              $name = uc($name) if $name =~ /^MANIFEST(\.SKIP)?$/i;
          }
  	$found->{$name} = "";
      };
  
      # We have to use "$File::Find::dir/$_" in preprocess, because 
      # $File::Find::name is unavailable.
      # Also, it's okay to use / here, because MANIFEST files use Unix-style 
      # paths.
      find({wanted => $wanted},
  	 $Is_MacOS ? ":" : ".");
  
      return $found;
  }
  
  
  =item manicheck
  
      my @missing_files = manicheck();
  
  checks if all the files within a C<MANIFEST> in the current directory
  really do exist. If C<MANIFEST> and the tree below the current
  directory are in sync it silently returns an empty list.
  Otherwise it returns a list of files which are listed in the
  C<MANIFEST> but missing from the directory, and by default also
  outputs these names to STDERR.
  
  =cut
  
  sub manicheck {
      return _check_files();
  }
  
  
  =item filecheck
  
      my @extra_files = filecheck();
  
  finds files below the current directory that are not mentioned in the
  C<MANIFEST> file. An optional file C<MANIFEST.SKIP> will be
  consulted. Any file matching a regular expression in such a file will
  not be reported as missing in the C<MANIFEST> file. The list of any
  extraneous files found is returned, and by default also reported to
  STDERR.
  
  =cut
  
  sub filecheck {
      return _check_manifest();
  }
  
  
  =item fullcheck
  
      my($missing, $extra) = fullcheck();
  
  does both a manicheck() and a filecheck(), returning then as two array
  refs.
  
  =cut
  
  sub fullcheck {
      return [_check_files()], [_check_manifest()];
  }
  
  
  =item skipcheck
  
      my @skipped = skipcheck();
  
  lists all the files that are skipped due to your C<MANIFEST.SKIP>
  file.
  
  =cut
  
  sub skipcheck {
      my($p) = @_;
      my $found = manifind();
      my $matches = maniskip();
  
      my @skipped = ();
      foreach my $file (_sort keys %$found){
          if (&$matches($file)){
              warn "Skipping $file\n" unless $Quiet;
              push @skipped, $file;
              next;
          }
      }
  
      return @skipped;
  }
  
  
  sub _check_files {
      my $p = shift;
      my $dosnames=(defined(&Dos::UseLFN) && Dos::UseLFN()==0);
      my $read = maniread() || {};
      my $found = manifind($p);
  
      my(@missfile) = ();
      foreach my $file (_sort keys %$read){
          warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
          if ($dosnames){
              $file = lc $file;
              $file =~ s=(\.(\w|-)+)=substr ($1,0,4)=ge;
              $file =~ s=((\w|-)+)=substr ($1,0,8)=ge;
          }
          unless ( exists $found->{$file} ) {
              warn "No such file: $file\n" unless $Quiet;
              push @missfile, $file;
          }
      }
  
      return @missfile;
  }
  
  
  sub _check_manifest {
      my($p) = @_;
      my $read = maniread() || {};
      my $found = manifind($p);
      my $skip  = maniskip();
  
      my @missentry = ();
      foreach my $file (_sort keys %$found){
          next if $skip->($file);
          warn "Debug: manicheck checking from disk $file\n" if $Debug;
          unless ( exists $read->{$file} ) {
              my $canon = $Is_MacOS ? "\t" . _unmacify($file) : '';
              warn "Not in $MANIFEST: $file$canon\n" unless $Quiet;
              push @missentry, $file;
          }
      }
  
      return @missentry;
  }
  
  
  =item maniread
  
      my $manifest = maniread();
      my $manifest = maniread($manifest_file);
  
  reads a named C<MANIFEST> file (defaults to C<MANIFEST> in the current
  directory) and returns a HASH reference with files being the keys and
  comments being the values of the HASH.  Blank lines and lines which
  start with C<#> in the C<MANIFEST> file are discarded.
  
  =cut
  
  sub maniread {
      my ($mfile) = @_;
      $mfile ||= $MANIFEST;
      my $read = {};
      local *M;
      unless (open M, "< $mfile"){
          warn "Problem opening $mfile: $!";
          return $read;
      }
      local $_;
      while (<M>){
          chomp;
          next if /^\s*#/;
  
          my($file, $comment);
  
          # filename may contain spaces if enclosed in ''
          # (in which case, \\ and \' are escapes)
          if (($file, $comment) = /^'(\\[\\']|.+)+'\s*(.*)/) {
              $file =~ s/\\([\\'])/$1/g;
          }
          else {
              ($file, $comment) = /^(\S+)\s*(.*)/;
          }
          next unless $file;
  
          if ($Is_MacOS) {
              $file = _macify($file);
              $file =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge;
          }
          elsif ($Is_VMS_mode) {
              require File::Basename;
              my($base,$dir) = File::Basename::fileparse($file);
              # Resolve illegal file specifications in the same way as tar
              if ($Is_VMS_nodot) {
                  $dir =~ tr/./_/;
                  my(@pieces) = split(/\./,$base);
                  if (@pieces > 2)
                      { $base = shift(@pieces) . '.' . join('_',@pieces); }
                  my $okfile = "$dir$base";
                  warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
                  $file = $okfile;
              } 
              $file = lc($file)
                  unless $Is_VMS_lc &&($file =~ /^MANIFEST(\.SKIP)?$/);
          }
  
          $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;
      }
      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: $!";
  
      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: $!";
          for (my $i=0; $i<=$#manifest; $i+=2) {
              print MANIFEST "$manifest[$i]\n";
          }
          close MANIFEST or die "could not write $MANIFEST: $!";
      }
  }
  
  
  # UNIMPLEMENTED
  sub _normalize {
      return;
  }
  
  
  =back
  
  =head2 MANIFEST
  
  A list of files in the distribution, one file per line.  The MANIFEST
  always uses Unix filepath conventions even if you're not on Unix.  This
  means F<foo/bar> style not F<foo\bar>.
  
  Anything between white space and an end of line within a C<MANIFEST>
  file is considered to be a comment.  Any line beginning with # is also
  a comment. Beginning with ExtUtils::Manifest 1.52, a filename may
  contain whitespace characters if it is enclosed in single quotes; single
  quotes or backslashes in that filename must be backslash-escaped.
  
      # this a comment
      some/file
      some/other/file            comment about some/file
      'some/third file'          comment
  
  
  =head2 MANIFEST.SKIP
  
  The file MANIFEST.SKIP may contain regular expressions of files that
  should be ignored by mkmanifest() and filecheck(). The regular
  expressions should appear one on each line. Blank lines and lines
  which start with C<#> are skipped.  Use C<\#> if you need a regular
  expression to start with a C<#>.
  
  For example:
  
      # Version control files and dirs.
      \bRCS\b
      \bCVS\b
      ,v$
      \B\.svn\b
  
      # Makemaker generated files and dirs.
      ^MANIFEST\.
      ^Makefile$
      ^blib/
      ^MakeMaker-\d
  
      # Temp, old and emacs backup files.
      ~$
      \.old$
      ^#.*#$
      ^\.#
  
  If no MANIFEST.SKIP file is found, a default set of skips will be
  used, similar to the example above.  If you want nothing skipped,
  simply make an empty MANIFEST.SKIP file.
  
  In one's own MANIFEST.SKIP file, certain directives
  can be used to include the contents of other MANIFEST.SKIP
  files. At present two such directives are recognized.
  
  =over 4
  
  =item #!include_default
  
  This inserts the contents of the default MANIFEST.SKIP file
  
  =item #!include /Path/to/another/manifest.skip
  
  This inserts the contents of the specified external file
  
  =back
  
  The included contents will be inserted into the MANIFEST.SKIP
  file in between I<#!start included /path/to/manifest.skip>
  and I<#!end included /path/to/manifest.skip> markers.
  The original MANIFEST.SKIP is saved as MANIFEST.SKIP.bak.
  
  =head2 EXPORT_OK
  
  C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
  C<&maniread>, and C<&manicopy> are exportable.
  
  =head2 GLOBAL VARIABLES
  
  C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
  results in both a different C<MANIFEST> and a different
  C<MANIFEST.SKIP> file. This is useful if you want to maintain
  different distributions for different audiences (say a user version
  and a developer version including RCS).
  
  C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
  all functions act silently.
  
  C<$ExtUtils::Manifest::Debug> defaults to 0.  If set to a true value,
  or if PERL_MM_MANIFEST_DEBUG is true, debugging output will be
  produced.
  
  =head1 DIAGNOSTICS
  
  All diagnostic output is sent to C<STDERR>.
  
  =over 4
  
  =item C<Not in MANIFEST:> I<file>
  
  is reported if a file is found which is not in C<MANIFEST>.
  
  =item C<Skipping> I<file>
  
  is reported if a file is skipped due to an entry in C<MANIFEST.SKIP>.
  
  =item C<No such file:> I<file>
  
  is reported if a file mentioned in a C<MANIFEST> file does not
  exist.
  
  =item C<MANIFEST:> I<$!>
  
  is reported if C<MANIFEST> could not be opened.
  
  =item C<Added to MANIFEST:> I<file>
  
  is reported by mkmanifest() if $Verbose is set and a file is added
  to MANIFEST. $Verbose is set to 1 by default.
  
  =back
  
  =head1 ENVIRONMENT
  
  =over 4
  
  =item B<PERL_MM_MANIFEST_DEBUG>
  
  Turns on debugging
  
  =back
  
  =head1 SEE ALSO
  
  L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
  
  =head1 AUTHOR
  
  Andreas Koenig C<andreas.koenig@anima.de>
  
  Maintained by Michael G Schwern C<schwern@pobox.com> within the
  ExtUtils-MakeMaker package and, as a separate CPAN package, by
  Randy Kobes C<r.kobes@uwinnipeg.ca>.
  
  =cut
  
  1;
EXTUTILS_MANIFEST

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

$fatpacked{"ExtUtils/Mksymlists.pm"} = <<'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 = '6.64';
  
  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 (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}};
      if (%{$data->{IMPORTS}}) {
          print $def "IMPORTS\n";
          my ($name, $exp);
          while (($name, $exp)= each %{$data->{IMPORTS}}) {
              print $def "  $name=$exp\n";
          }
      }
      close $def;
  }
  
  sub _write_win32 {
      my($data) = @_;
  
      require Config;
      if (not $data->{DLBASE}) {
          ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
          $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
      }
      rename "$data->{FILE}.def", "$data->{FILE}_def.old";
  
      open( my $def, ">", "$data->{FILE}.def" )
          or croak("Can't create $data->{FILE}.def: $!\n");
      # put library name in quotes (it could be a keyword, like 'Alias')
      if ($Config::Config{'cc'} !~ /^gcc/i) {
          print $def "LIBRARY \"$data->{DLBASE}\"\n";
      }
      print $def "EXPORTS\n  ";
      my @syms;
      # Export public symbols both with and without underscores to
      # ensure compatibility between DLLs from different compilers
      # 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
      if ($Config::Config{'cc'} =~ /^bcc/i) {
          for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
              push @syms, "_$_", "$_ = _$_";
          }
      }
      else {
          for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
              push @syms, "$_", "_$_ = $_";
          }
      }
      print $def join("\n  ",@syms, "\n") if @syms;
      if (%{$data->{IMPORTS}}) {
          print $def "IMPORTS\n";
          my ($name, $exp);
          while (($name, $exp)= each %{$data->{IMPORTS}}) {
              print $def "  $name=$exp\n";
          }
      }
      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"} = <<'EXTUTILS_PACKLIST';
  package ExtUtils::Packlist;
  
  use 5.00503;
  use strict;
  use Carp qw();
  use Config;
  use vars qw($VERSION $Relocations);
  $VERSION = '1.43';
  $VERSION = eval $VERSION;
  
  # Used for generating filehandle globs.  IO::File might not be available!
  my $fhname = "FH1";
  
  =begin _undocumented
  
  =item mkfh()
  
  Make a filehandle. Same kind of idea as Symbol::gensym().
  
  =cut
  
  sub mkfh()
  {
  no strict;
  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
  
  =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"} = <<'EXTUTILS_TESTLIB';
  package ExtUtils::testlib;
  
  use strict;
  use warnings;
  
  our $VERSION = '6.64';
  
  use Cwd;
  use File::Spec;
  
  # So the tests can chdir around and not break @INC.
  # We use getcwd() because otherwise rel2abs will blow up under taint
  # mode pre-5.8.  We detaint is so @INC won't be tainted.  This is
  # no worse, and probably better, than just shoving an untainted, 
  # relative "blib/lib" onto @INC.
  my $cwd;
  BEGIN {
      ($cwd) = getcwd() =~ /(.*)/;
  }
  use lib map { File::Spec->rel2abs($_, $cwd) } qw(blib/arch blib/lib);
  1;
  __END__
  
  =head1 NAME
  
  ExtUtils::testlib - add blib/* directories to @INC
  
  =head1 SYNOPSIS
  
    use ExtUtils::testlib;
  
  =head1 DESCRIPTION
  
  After an extension has been built and before it is installed it may be
  desirable to test it bypassing C<make test>. By adding
  
      use ExtUtils::testlib;
  
  to a test program the intermediate directories used by C<make> are
  added to @INC.
  
EXTUTILS_TESTLIB

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

$fatpacked{"File/Path.pm"} = <<'FILE_PATH';
  package File::Path;
  
  use 5.005_04;
  use strict;
  
  use Cwd 'getcwd';
  use File::Basename ();
  use File::Spec     ();
  
  BEGIN {
      if ($] < 5.006) {
          # can't say 'opendir my $dh, $dirname'
          # need to initialise $dh
          eval "use Symbol";
      }
  }
  
  use Exporter ();
  use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  $VERSION   = '2.09';
  @ISA       = qw(Exporter);
  @EXPORT    = qw(mkpath rmtree);
  @EXPORT_OK = qw(make_path remove_tree);
  
  my $Is_VMS     = $^O eq 'VMS';
  my $Is_MacOS   = $^O eq 'MacOS';
  
  # These OSes complain if you want to remove a file that you have no
  # write permission to:
  my $Force_Writeable = grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2);
  
  # Unix-like systems need to stat each directory in order to detect
  # race condition. MS-Windows is immune to this particular attack.
  my $Need_Stat_Check = !($^O eq 'MSWin32');
  
  sub _carp {
      require Carp;
      goto &Carp::carp;
  }
  
  sub _croak {
      require Carp;
      goto &Carp::croak;
  }
  
  sub _error {
      my $arg     = shift;
      my $message = shift;
      my $object  = shift;
  
      if ($arg->{error}) {
          $object = '' unless defined $object;
          $message .= ": $!" if $!;
          push @{${$arg->{error}}}, {$object => $message};
      }
      else {
          _carp(defined($object) ? "$message for $object: $!" : "$message: $!");
      }
  }
  
  sub make_path {
      push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
      goto &mkpath;
  }
  
  sub mkpath {
      my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
  
      my $arg;
      my $paths;
  
      if ($old_style) {
          my ($verbose, $mode);
          ($paths, $verbose, $mode) = @_;
          $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
          $arg->{verbose} = $verbose;
          $arg->{mode}    = defined $mode ? $mode : 0777;
      }
      else {
          $arg = pop @_;
          $arg->{mode}      = delete $arg->{mask} if exists $arg->{mask};
          $arg->{mode}      = 0777 unless exists $arg->{mode};
          ${$arg->{error}}  = [] if exists $arg->{error};
          $arg->{owner}     = delete $arg->{user} if exists $arg->{user};
          $arg->{owner}     = delete $arg->{uid}  if exists $arg->{uid};
          if (exists $arg->{owner} and $arg->{owner} =~ /\D/) {
              my $uid = (getpwnam $arg->{owner})[2];
              if (defined $uid) {
                  $arg->{owner} = $uid;
              }
              else {
                  _error($arg, "unable to map $arg->{owner} to a uid, ownership not changed");
                  delete $arg->{owner};
              }
          }
          if (exists $arg->{group} and $arg->{group} =~ /\D/) {
              my $gid = (getgrnam $arg->{group})[2];
              if (defined $gid) {
                  $arg->{group} = $gid;
              }
              else {
                  _error($arg, "unable to map $arg->{group} to a gid, group ownership not changed");
                  delete $arg->{group};
              }
          }
          if (exists $arg->{owner} and not exists $arg->{group}) {
              $arg->{group} = -1; # chown will leave group unchanged
          }
          if (exists $arg->{group} and not exists $arg->{owner}) {
              $arg->{owner} = -1; # chown will leave owner unchanged
          }
          $paths = [@_];
      }
      return _mkpath($arg, $paths);
  }
  
  sub _mkpath {
      my $arg   = shift;
      my $paths = shift;
  
      my(@created,$path);
      foreach $path (@$paths) {
          next unless defined($path) and length($path);
          $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 
          # Logic wants Unix paths, so go with the flow.
          if ($Is_VMS) {
              next if $path eq '/';
              $path = VMS::Filespec::unixify($path);
          }
          next if -d $path;
          my $parent = File::Basename::dirname($path);
          unless (-d $parent or $path eq $parent) {
              push(@created,_mkpath($arg, [$parent]));
          }
          print "mkdir $path\n" if $arg->{verbose};
          if (mkdir($path,$arg->{mode})) {
              push(@created, $path);
              if (exists $arg->{owner}) {
  				# NB: $arg->{group} guaranteed to be set during initialisation
                  if (!chown $arg->{owner}, $arg->{group}, $path) {
                      _error($arg, "Cannot change ownership of $path to $arg->{owner}:$arg->{group}");
                  }
              }
          }
          else {
              my $save_bang = $!;
              my ($e, $e1) = ($save_bang, $^E);
              $e .= "; $e1" if $e ne $e1;
              # allow for another process to have created it meanwhile
              if (!-d $path) {
                  $! = $save_bang;
                  if ($arg->{error}) {
                      push @{${$arg->{error}}}, {$path => $e};
                  }
                  else {
                      _croak("mkdir $path: $e");
                  }
              }
          }
      }
      return @created;
  }
  
  sub remove_tree {
      push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
      goto &rmtree;
  }
  
  sub _is_subdir {
      my($dir, $test) = @_;
  
      my($dv, $dd) = File::Spec->splitpath($dir, 1);
      my($tv, $td) = File::Spec->splitpath($test, 1);
  
      # not on same volume
      return 0 if $dv ne $tv;
  
      my @d = File::Spec->splitdir($dd);
      my @t = File::Spec->splitdir($td);
  
      # @t can't be a subdir if it's shorter than @d
      return 0 if @t < @d;
  
      return join('/', @d) eq join('/', splice @t, 0, +@d);
  }
  
  sub rmtree {
      my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
  
      my $arg;
      my $paths;
  
      if ($old_style) {
          my ($verbose, $safe);
          ($paths, $verbose, $safe) = @_;
          $arg->{verbose} = $verbose;
          $arg->{safe}    = defined $safe    ? $safe    : 0;
  
          if (defined($paths) and length($paths)) {
              $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
          }
          else {
              _carp ("No root path(s) specified\n");
              return 0;
          }
      }
      else {
          $arg = pop @_;
          ${$arg->{error}}  = [] if exists $arg->{error};
          ${$arg->{result}} = [] if exists $arg->{result};
          $paths = [@_];
      }
  
      $arg->{prefix} = '';
      $arg->{depth}  = 0;
  
      my @clean_path;
      $arg->{cwd} = getcwd() or do {
          _error($arg, "cannot fetch initial working directory");
          return 0;
      };
      for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint
  
      for my $p (@$paths) {
          # need to fixup case and map \ to / on Windows
          my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p)          : $p;
          my $ortho_cwd  = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd};
          my $ortho_root_length = length($ortho_root);
          $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']'
          if ($ortho_root_length && _is_subdir($ortho_root, $ortho_cwd)) {
              local $! = 0;
              _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p);
              next;
          }
  
          if ($Is_MacOS) {
              $p  = ":$p" unless $p =~ /:/;
              $p .= ":"   unless $p =~ /:\z/;
          }
          elsif ($^O eq 'MSWin32') {
              $p =~ s{[/\\]\z}{};
          }
          else {
              $p =~ s{/\z}{};
          }
          push @clean_path, $p;
      }
  
      @{$arg}{qw(device inode perm)} = (lstat $arg->{cwd})[0,1] or do {
          _error($arg, "cannot stat initial working directory", $arg->{cwd});
          return 0;
      };
  
      return _rmtree($arg, \@clean_path);
  }
  
  sub _rmtree {
      my $arg   = shift;
      my $paths = shift;
  
      my $count  = 0;
      my $curdir = File::Spec->curdir();
      my $updir  = File::Spec->updir();
  
      my (@files, $root);
      ROOT_DIR:
      foreach $root (@$paths) {
          # since we chdir into each directory, it may not be obvious
          # to figure out where we are if we generate a message about
          # a file name. We therefore construct a semi-canonical
          # filename, anchored from the directory being unlinked (as
          # opposed to being truly canonical, anchored from the root (/).
  
          my $canon = $arg->{prefix}
              ? File::Spec->catfile($arg->{prefix}, $root)
              : $root
          ;
  
          my ($ldev, $lino, $perm) = (lstat $root)[0,1,2] or next ROOT_DIR;
  
          if ( -d _ ) {
              $root = VMS::Filespec::vmspath(VMS::Filespec::pathify($root)) if $Is_VMS;
  
              if (!chdir($root)) {
                  # see if we can escalate privileges to get in
                  # (e.g. funny protection mask such as -w- instead of rwx)
                  $perm &= 07777;
                  my $nperm = $perm | 0700;
                  if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $root))) {
                      _error($arg, "cannot make child directory read-write-exec", $canon);
                      next ROOT_DIR;
                  }
                  elsif (!chdir($root)) {
                      _error($arg, "cannot chdir to child", $canon);
                      next ROOT_DIR;
                  }
              }
  
              my ($cur_dev, $cur_inode, $perm) = (stat $curdir)[0,1,2] or do {
                  _error($arg, "cannot stat current working directory", $canon);
                  next ROOT_DIR;
              };
  
              if ($Need_Stat_Check) {
                  ($ldev eq $cur_dev and $lino eq $cur_inode)
                      or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
              }
  
              $perm &= 07777; # don't forget setuid, setgid, sticky bits
              my $nperm = $perm | 0700;
  
              # notabene: 0700 is for making readable in the first place,
              # it's also intended to change it to writable in case we have
              # to recurse in which case we are better than rm -rf for 
              # subtrees with strange permissions
  
              if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $curdir))) {
                  _error($arg, "cannot make directory read+writeable", $canon);
                  $nperm = $perm;
              }
  
              my $d;
              $d = gensym() if $] < 5.006;
              if (!opendir $d, $curdir) {
                  _error($arg, "cannot opendir", $canon);
                  @files = ();
              }
              else {
                  no strict 'refs';
                  if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
                      # Blindly untaint dir names if taint mode is
                      # active, or any perl < 5.006
                      @files = map { /\A(.*)\z/s; $1 } readdir $d;
                  }
                  else {
                      @files = readdir $d;
                  }
                  closedir $d;
              }
  
              if ($Is_VMS) {
                  # Deleting large numbers of files from VMS Files-11
                  # filesystems is faster if done in reverse ASCIIbetical order.
                  # include '.' to '.;' from blead patch #31775
                  @files = map {$_ eq '.' ? '.;' : $_} reverse @files;
              }
  
              @files = grep {$_ ne $updir and $_ ne $curdir} @files;
  
              if (@files) {
                  # remove the contained files before the directory itself
                  my $narg = {%$arg};
                  @{$narg}{qw(device inode cwd prefix depth)}
                      = ($cur_dev, $cur_inode, $updir, $canon, $arg->{depth}+1);
                  $count += _rmtree($narg, \@files);
              }
  
              # restore directory permissions of required now (in case the rmdir
              # below fails), while we are still in the directory and may do so
              # without a race via '.'
              if ($nperm != $perm and not chmod($perm, $curdir)) {
                  _error($arg, "cannot reset chmod", $canon);
              }
  
              # don't leave the client code in an unexpected directory
              chdir($arg->{cwd})
                  or _croak("cannot chdir to $arg->{cwd} from $canon: $!, aborting.");
  
              # ensure that a chdir upwards didn't take us somewhere other
              # than we expected (see CVE-2002-0435)
              ($cur_dev, $cur_inode) = (stat $curdir)[0,1]
                  or _croak("cannot stat prior working directory $arg->{cwd}: $!, aborting.");
  
              if ($Need_Stat_Check) {
                  ($arg->{device} eq $cur_dev and $arg->{inode} eq $cur_inode)
                      or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
              }
  
              if ($arg->{depth} or !$arg->{keep_root}) {
                  if ($arg->{safe} &&
                      ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
                      print "skipped $root\n" if $arg->{verbose};
                      next ROOT_DIR;
                  }
                  if ($Force_Writeable and !chmod $perm | 0700, $root) {
                      _error($arg, "cannot make directory writeable", $canon);
                  }
                  print "rmdir $root\n" if $arg->{verbose};
                  if (rmdir $root) {
                      push @{${$arg->{result}}}, $root if $arg->{result};
                      ++$count;
                  }
                  else {
                      _error($arg, "cannot remove directory", $canon);
                      if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
                      ) {
                          _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
                      }
                  }
              }
          }
          else {
              # not a directory
              $root = VMS::Filespec::vmsify("./$root")
                  if $Is_VMS
                     && !File::Spec->file_name_is_absolute($root)
                     && ($root !~ m/(?<!\^)[\]>]+/);  # not already in VMS syntax
  
              if ($arg->{safe} &&
                  ($Is_VMS ? !&VMS::Filespec::candelete($root)
                           : !(-l $root || -w $root)))
              {
                  print "skipped $root\n" if $arg->{verbose};
                  next ROOT_DIR;
              }
  
              my $nperm = $perm & 07777 | 0600;
              if ($Force_Writeable and $nperm != $perm and not chmod $nperm, $root) {
                  _error($arg, "cannot make file writeable", $canon);
              }
              print "unlink $canon\n" if $arg->{verbose};
              # delete all versions under VMS
              for (;;) {
                  if (unlink $root) {
                      push @{${$arg->{result}}}, $root if $arg->{result};
                  }
                  else {
                      _error($arg, "cannot unlink file", $canon);
                      $Force_Writeable and chmod($perm, $root) or
                          _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
                      last;
                  }
                  ++$count;
                  last unless $Is_VMS && lstat $root;
              }
          }
      }
      return $count;
  }
  
  sub _slash_lc {
      # fix up slashes and case on MSWin32 so that we can determine that
      # c:\path\to\dir is underneath C:/Path/To
      my $path = shift;
      $path =~ tr{\\}{/};
      return lc($path);
  }
  
  1;
  __END__
  
  =head1 NAME
  
  File::Path - Create or remove directory trees
  
  =head1 VERSION
  
  This document describes version 2.09 of File::Path, released
  2013-01-17.
  
  =head1 SYNOPSIS
  
    use File::Path qw(make_path remove_tree);
  
    make_path('foo/bar/baz', '/zug/zwang');
    make_path('foo/bar/baz', '/zug/zwang', {
        verbose => 1,
        mode => 0711,
    });
  
    remove_tree('foo/bar/baz', '/zug/zwang');
    remove_tree('foo/bar/baz', '/zug/zwang', {
        verbose => 1,
        error  => \my $err_list,
    });
  
    # legacy (interface promoted before v2.00)
    mkpath('/foo/bar/baz');
    mkpath('/foo/bar/baz', 1, 0711);
    mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
    rmtree('foo/bar/baz', 1, 1);
    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
  
    # legacy (interface promoted before v2.06)
    mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
    rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
  
  =head1 DESCRIPTION
  
  This module provide a convenient way to create directories of
  arbitrary depth and to delete an entire directory subtree from the
  filesystem.
  
  The following functions are provided:
  
  =over
  
  =item make_path( $dir1, $dir2, .... )
  
  =item make_path( $dir1, $dir2, ...., \%opts )
  
  The C<make_path> function creates the given directories if they don't
  exists before, much like the Unix command C<mkdir -p>.
  
  The function accepts a list of directories to be created. Its
  behaviour may be tuned by an optional hashref appearing as the last
  parameter on the call.
  
  The function returns the list of directories actually created during
  the call; in scalar context the number of directories created.
  
  The following keys are recognised in the option hash:
  
  =over
  
  =item mode => $num
  
  The numeric permissions mode to apply to each created directory
  (defaults to 0777), to be modified by the current C<umask>. If the
  directory already exists (and thus does not need to be created),
  the permissions will not be modified.
  
  C<mask> is recognised as an alias for this parameter.
  
  =item verbose => $bool
  
  If present, will cause C<make_path> to print the name of each directory
  as it is created. By default nothing is printed.
  
  =item error => \$err
  
  If present, it should be a reference to a scalar.
  This scalar will be made to reference an array, which will
  be used to store any errors that are encountered.  See the L</"ERROR
  HANDLING"> section for more information.
  
  If this parameter is not used, certain error conditions may raise
  a fatal error that will cause the program will halt, unless trapped
  in an C<eval> block.
  
  =item owner => $owner
  
  =item user => $owner
  
  =item uid => $owner
  
  If present, will cause any created directory to be owned by C<$owner>.
  If the value is numeric, it will be interpreted as a uid, otherwise
  as username is assumed. An error will be issued if the username cannot be
  mapped to a uid, or the uid does not exist, or the process lacks the
  privileges to change ownership.
  
  Ownwership of directories that already exist will not be changed.
  
  C<user> and C<uid> are aliases of C<owner>.
  
  =item group => $group
  
  If present, will cause any created directory to be owned by the group C<$group>.
  If the value is numeric, it will be interpreted as a gid, otherwise
  as group name is assumed. An error will be issued if the group name cannot be
  mapped to a gid, or the gid does not exist, or the process lacks the
  privileges to change group ownership.
  
  Group ownwership of directories that already exist will not be changed.
  
      make_path '/var/tmp/webcache', {owner=>'nobody', group=>'nogroup'};
  
  =back
  
  =item mkpath( $dir )
  
  =item mkpath( $dir, $verbose, $mode )
  
  =item mkpath( [$dir1, $dir2,...], $verbose, $mode )
  
  =item mkpath( $dir1, $dir2,..., \%opt )
  
  The mkpath() function provide the legacy interface of make_path() with
  a different interpretation of the arguments passed.  The behaviour and
  return value of the function is otherwise identical to make_path().
  
  =item remove_tree( $dir1, $dir2, .... )
  
  =item remove_tree( $dir1, $dir2, ...., \%opts )
  
  The C<remove_tree> function deletes the given directories and any
  files and subdirectories they might contain, much like the Unix
  command C<rm -r> or C<del /s> on Windows.
  
  The function accepts a list of directories to be
  removed. Its behaviour may be tuned by an optional hashref
  appearing as the last parameter on the call.
  
  The functions returns the number of files successfully deleted.
  
  The following keys are recognised in the option hash:
  
  =over
  
  =item verbose => $bool
  
  If present, will cause C<remove_tree> to print the name of each file as
  it is unlinked. By default nothing is printed.
  
  =item safe => $bool
  
  When set to a true value, will cause C<remove_tree> to skip the files
  for which the process lacks the required privileges needed to delete
  files, such as delete privileges on VMS. In other words, the code
  will make no attempt to alter file permissions. Thus, if the process
  is interrupted, no filesystem object will be left in a more
  permissive mode.
  
  =item keep_root => $bool
  
  When set to a true value, will cause all files and subdirectories
  to be removed, except the initially specified directories. This comes
  in handy when cleaning out an application's scratch directory.
  
    remove_tree( '/tmp', {keep_root => 1} );
  
  =item result => \$res
  
  If present, it should be a reference to a scalar.
  This scalar will be made to reference an array, which will
  be used to store all files and directories unlinked
  during the call. If nothing is unlinked, the array will be empty.
  
    remove_tree( '/tmp', {result => \my $list} );
    print "unlinked $_\n" for @$list;
  
  This is a useful alternative to the C<verbose> key.
  
  =item error => \$err
  
  If present, it should be a reference to a scalar.
  This scalar will be made to reference an array, which will
  be used to store any errors that are encountered.  See the L</"ERROR
  HANDLING"> section for more information.
  
  Removing things is a much more dangerous proposition than
  creating things. As such, there are certain conditions that
  C<remove_tree> may encounter that are so dangerous that the only
  sane action left is to kill the program.
  
  Use C<error> to trap all that is reasonable (problems with
  permissions and the like), and let it die if things get out
  of hand. This is the safest course of action.
  
  =back
  
  =item rmtree( $dir )
  
  =item rmtree( $dir, $verbose, $safe )
  
  =item rmtree( [$dir1, $dir2,...], $verbose, $safe )
  
  =item rmtree( $dir1, $dir2,..., \%opt )
  
  The rmtree() function provide the legacy interface of remove_tree()
  with a different interpretation of the arguments passed. The behaviour
  and return value of the function is otherwise identical to
  remove_tree().
  
  =back
  
  =head2 ERROR HANDLING
  
  =over 4
  
  =item B<NOTE:>
  
  The following error handling mechanism is considered
  experimental and is subject to change pending feedback from
  users.
  
  =back
  
  If C<make_path> or C<remove_tree> encounter an error, a diagnostic
  message will be printed to C<STDERR> via C<carp> (for non-fatal
  errors), or via C<croak> (for fatal errors).
  
  If this behaviour is not desirable, the C<error> attribute may be
  used to hold a reference to a variable, which will be used to store
  the diagnostics. The variable is made a reference to an array of hash
  references.  Each hash contain a single key/value pair where the key
  is the name of the file, and the value is the error message (including
  the contents of C<$!> when appropriate).  If a general error is
  encountered the diagnostic key will be empty.
  
  An example usage looks like:
  
    remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} );
    if (@$err) {
        for my $diag (@$err) {
            my ($file, $message) = %$diag;
            if ($file eq '') {
                print "general error: $message\n";
            }
            else {
                print "problem unlinking $file: $message\n";
            }
        }
    }
    else {
        print "No error encountered\n";
    }
  
  Note that if no errors are encountered, C<$err> will reference an
  empty array.  This means that C<$err> will always end up TRUE; so you
  need to test C<@$err> to determine if errors occured.
  
  =head2 NOTES
  
  C<File::Path> blindly exports C<mkpath> and C<rmtree> into the
  current namespace. These days, this is considered bad style, but
  to change it now would break too much code. Nonetheless, you are
  invited to specify what it is you are expecting to use:
  
    use File::Path 'rmtree';
  
  The routines C<make_path> and C<remove_tree> are B<not> exported
  by default. You must specify which ones you want to use.
  
    use File::Path 'remove_tree';
  
  Note that a side-effect of the above is that C<mkpath> and C<rmtree>
  are no longer exported at all. This is due to the way the C<Exporter>
  module works. If you are migrating a codebase to use the new
  interface, you will have to list everything explicitly. But that's
  just good practice anyway.
  
    use File::Path qw(remove_tree rmtree);
  
  =head3 API CHANGES
  
  The API was changed in the 2.0 branch. For a time, C<mkpath> and
  C<rmtree> tried, unsuccessfully, to deal with the two different
  calling mechanisms. This approach was considered a failure.
  
  The new semantics are now only available with C<make_path> and
  C<remove_tree>. The old semantics are only available through
  C<mkpath> and C<rmtree>. Users are strongly encouraged to upgrade
  to at least 2.08 in order to avoid surprises.
  
  =head3 SECURITY CONSIDERATIONS
  
  There were race conditions 1.x implementations of File::Path's
  C<rmtree> function (although sometimes patched depending on the OS
  distribution or platform). The 2.0 version contains code to avoid the
  problem mentioned in CVE-2002-0435.
  
  See the following pages for more information:
  
    http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905
    http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html
    http://www.debian.org/security/2005/dsa-696
  
  Additionally, unless the C<safe> parameter is set (or the
  third parameter in the traditional interface is TRUE), should a
  C<remove_tree> be interrupted, files that were originally in read-only
  mode may now have their permissions set to a read-write (or "delete
  OK") mode.
  
  =head1 DIAGNOSTICS
  
  FATAL errors will cause the program to halt (C<croak>), since the
  problem is so severe that it would be dangerous to continue. (This
  can always be trapped with C<eval>, but it's not a good idea. Under
  the circumstances, dying is the best thing to do).
  
  SEVERE errors may be trapped using the modern interface. If the
  they are not trapped, or the old interface is used, such an error
  will cause the program will halt.
  
  All other errors may be trapped using the modern interface, otherwise
  they will be C<carp>ed about. Program execution will not be halted.
  
  =over 4
  
  =item mkdir [path]: [errmsg] (SEVERE)
  
  C<make_path> was unable to create the path. Probably some sort of
  permissions error at the point of departure, or insufficient resources
  (such as free inodes on Unix).
  
  =item No root path(s) specified
  
  C<make_path> was not given any paths to create. This message is only
  emitted if the routine is called with the traditional interface.
  The modern interface will remain silent if given nothing to do.
  
  =item No such file or directory
  
  On Windows, if C<make_path> gives you this warning, it may mean that
  you have exceeded your filesystem's maximum path length.
  
  =item cannot fetch initial working directory: [errmsg]
  
  C<remove_tree> attempted to determine the initial directory by calling
  C<Cwd::getcwd>, but the call failed for some reason. No attempt
  will be made to delete anything.
  
  =item cannot stat initial working directory: [errmsg]
  
  C<remove_tree> attempted to stat the initial directory (after having
  successfully obtained its name via C<getcwd>), however, the call
  failed for some reason. No attempt will be made to delete anything.
  
  =item cannot chdir to [dir]: [errmsg]
  
  C<remove_tree> attempted to set the working directory in order to
  begin deleting the objects therein, but was unsuccessful. This is
  usually a permissions issue. The routine will continue to delete
  other things, but this directory will be left intact.
  
  =item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
  
  C<remove_tree> recorded the device and inode of a directory, and then
  moved into it. It then performed a C<stat> on the current directory
  and detected that the device and inode were no longer the same. As
  this is at the heart of the race condition problem, the program
  will die at this point.
  
  =item cannot make directory [dir] read+writeable: [errmsg]
  
  C<remove_tree> attempted to change the permissions on the current directory
  to ensure that subsequent unlinkings would not run into problems,
  but was unable to do so. The permissions remain as they were, and
  the program will carry on, doing the best it can.
  
  =item cannot read [dir]: [errmsg]
  
  C<remove_tree> tried to read the contents of the directory in order
  to acquire the names of the directory entries to be unlinked, but
  was unsuccessful. This is usually a permissions issue. The
  program will continue, but the files in this directory will remain
  after the call.
  
  =item cannot reset chmod [dir]: [errmsg]
  
  C<remove_tree>, after having deleted everything in a directory, attempted
  to restore its permissions to the original state but failed. The
  directory may wind up being left behind.
  
  =item cannot remove [dir] when cwd is [dir]
  
  The current working directory of the program is F</some/path/to/here>
  and you are attempting to remove an ancestor, such as F</some/path>.
  The directory tree is left untouched.
  
  The solution is to C<chdir> out of the child directory to a place
  outside the directory tree to be removed.
  
  =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL)
  
  C<remove_tree>, after having deleted everything and restored the permissions
  of a directory, was unable to chdir back to the parent. The program
  halts to avoid a race condition from occurring.
  
  =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL)
  
  C<remove_tree> was unable to stat the parent directory after have returned
  from the child. Since there is no way of knowing if we returned to
  where we think we should be (by comparing device and inode) the only
  way out is to C<croak>.
  
  =item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
  
  When C<remove_tree> returned from deleting files in a child directory, a
  check revealed that the parent directory it returned to wasn't the one
  it started out from. This is considered a sign of malicious activity.
  
  =item cannot make directory [dir] writeable: [errmsg]
  
  Just before removing a directory (after having successfully removed
  everything it contained), C<remove_tree> attempted to set the permissions
  on the directory to ensure it could be removed and failed. Program
  execution continues, but the directory may possibly not be deleted.
  
  =item cannot remove directory [dir]: [errmsg]
  
  C<remove_tree> attempted to remove a directory, but failed. This may because
  some objects that were unable to be removed remain in the directory, or
  a permissions issue. The directory will be left behind.
  
  =item cannot restore permissions of [dir] to [0nnn]: [errmsg]
  
  After having failed to remove a directory, C<remove_tree> was unable to
  restore its permissions from a permissive state back to a possibly
  more restrictive setting. (Permissions given in octal).
  
  =item cannot make file [file] writeable: [errmsg]
  
  C<remove_tree> attempted to force the permissions of a file to ensure it
  could be deleted, but failed to do so. It will, however, still attempt
  to unlink the file.
  
  =item cannot unlink file [file]: [errmsg]
  
  C<remove_tree> failed to remove a file. Probably a permissions issue.
  
  =item cannot restore permissions of [file] to [0nnn]: [errmsg]
  
  After having failed to remove a file, C<remove_tree> was also unable
  to restore the permissions on the file to a possibly less permissive
  setting. (Permissions given in octal).
  
  =item unable to map [owner] to a uid, ownership not changed");
  
  C<make_path> was instructed to give the ownership of created
  directories to the symbolic name [owner], but C<getpwnam> did
  not return the corresponding numeric uid. The directory will
  be created, but ownership will not be changed.
  
  =item unable to map [group] to a gid, group ownership not changed
  
  C<make_path> was instructed to give the group ownership of created
  directories to the symbolic name [group], but C<getgrnam> did
  not return the corresponding numeric gid. The directory will
  be created, but group ownership will not be changed.
  
  =back
  
  =head1 SEE ALSO
  
  =over 4
  
  =item *
  
  L<File::Remove>
  
  Allows files and directories to be moved to the Trashcan/Recycle
  Bin (where they may later be restored if necessary) if the operating
  system supports such functionality. This feature may one day be
  made available directly in C<File::Path>.
  
  =item *
  
  L<File::Find::Rule>
  
  When removing directory trees, if you want to examine each file to
  decide whether to delete it (and possibly leaving large swathes
  alone), F<File::Find::Rule> offers a convenient and flexible approach
  to examining directory trees.
  
  =back
  
  =head1 BUGS
  
  Please report all bugs on the RT queue:
  
  L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Path>
  
  You can also send pull requests to the Github repository:
  
  L<https://github.com/dland/File-Path>
  
  =head1 ACKNOWLEDGEMENTS
  
  Paul Szabo identified the race condition originally, and Brendan
  O'Dea wrote an implementation for Debian that addressed the problem.
  That code was used as a basis for the current code. Their efforts
  are greatly appreciated.
  
  Gisle Aas made a number of improvements to the documentation for
  2.07 and his advice and assistance is also greatly appreciated.
  
  =head1 AUTHORS
  
  Tim Bunce and Charles Bailey. Currently maintained by David Landgren
  <F<david@landgren.net>>.
  
  =head1 COPYRIGHT
  
  This module is copyright (C) Charles Bailey, Tim Bunce and
  David Landgren 1995-2013. All rights reserved.
  
  =head1 LICENSE
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself.
  
  =cut
FILE_PATH

$fatpacked{"File/Temp.pm"} = <<'FILE_TEMP';
  package File::Temp;
  
  =head1 NAME
  
  File::Temp - return name and handle of a temporary file safely
  
  =begin __INTERNALS
  
  =head1 PORTABILITY
  
  This section is at the top in order to provide easier access to
  porters.  It is not expected to be rendered by a standard pod
  formatting tool. Please skip straight to the SYNOPSIS section if you
  are not trying to port this module to a new platform.
  
  This module is designed to be portable across operating systems and it
  currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
  (Classic). When porting to a new OS there are generally three main
  issues that have to be solved:
  
  =over 4
  
  =item *
  
  Can the OS unlink an open file? If it can not then the
  C<_can_unlink_opened_file> method should be modified.
  
  =item *
  
  Are the return values from C<stat> reliable? By default all the
  return values from C<stat> are compared when unlinking a temporary
  file using the filename and the handle. Operating systems other than
  unix do not always have valid entries in all fields. If C<unlink0> fails
  then the C<stat> comparison should be modified accordingly.
  
  =item *
  
  Security. Systems that can not support a test for the sticky bit
  on a directory can not use the MEDIUM and HIGH security tests.
  The C<_can_do_level> method should be modified accordingly.
  
  =back
  
  =end __INTERNALS
  
  =head1 SYNOPSIS
  
    use File::Temp qw/ tempfile tempdir /;
  
    $fh = tempfile();
    ($fh, $filename) = tempfile();
  
    ($fh, $filename) = tempfile( $template, DIR => $dir);
    ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
    ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
  
    binmode( $fh, ":utf8" );
  
    $dir = tempdir( CLEANUP => 1 );
    ($fh, $filename) = tempfile( DIR => $dir );
  
  Object interface:
  
    require File::Temp;
    use File::Temp ();
    use File::Temp qw/ :seekable /;
  
    $fh = File::Temp->new();
    $fname = $fh->filename;
  
    $fh = File::Temp->new(TEMPLATE => $template);
    $fname = $fh->filename;
  
    $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
    print $tmp "Some data\n";
    print "Filename is $tmp\n";
    $tmp->seek( 0, SEEK_END );
  
  The following interfaces are provided for compatibility with
  existing APIs. They should not be used in new code.
  
  MkTemp family:
  
    use File::Temp qw/ :mktemp  /;
  
    ($fh, $file) = mkstemp( "tmpfileXXXXX" );
    ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
  
    $tmpdir = mkdtemp( $template );
  
    $unopened_file = mktemp( $template );
  
  POSIX functions:
  
    use File::Temp qw/ :POSIX /;
  
    $file = tmpnam();
    $fh = tmpfile();
  
    ($fh, $file) = tmpnam();
  
  Compatibility functions:
  
    $unopened_file = File::Temp::tempnam( $dir, $pfx );
  
  =head1 DESCRIPTION
  
  C<File::Temp> can be used to create and open temporary files in a safe
  way.  There is both a function interface and an object-oriented
  interface.  The File::Temp constructor or the tempfile() function can
  be used to return the name and the open filehandle of a temporary
  file.  The tempdir() function can be used to create a temporary
  directory.
  
  The security aspect of temporary file creation is emphasized such that
  a filehandle and filename are returned together.  This helps guarantee
  that a race condition can not occur where the temporary file is
  created by another process between checking for the existence of the
  file and its opening.  Additional security levels are provided to
  check, for example, that the sticky bit is set on world writable
  directories.  See L<"safe_level"> for more information.
  
  For compatibility with popular C library functions, Perl implementations of
  the mkstemp() family of functions are provided. These are, mkstemp(),
  mkstemps(), mkdtemp() and mktemp().
  
  Additionally, implementations of the standard L<POSIX|POSIX>
  tmpnam() and tmpfile() functions are provided if required.
  
  Implementations of mktemp(), tmpnam(), and tempnam() are provided,
  but should be used with caution since they return only a filename
  that was valid when function was called, so cannot guarantee
  that the file will not exist by the time the caller opens the filename.
  
  Filehandles returned by these functions support the seekable methods.
  
  =cut
  
  # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
  # People would like a version on 5.004 so give them what they want :-)
  use 5.004;
  use strict;
  use Carp;
  use File::Spec 0.8;
  use File::Path qw/ rmtree /;
  use Fcntl 1.03;
  use IO::Seekable;               # For SEEK_*
  use Errno;
  require VMS::Stdio if $^O eq 'VMS';
  
  # pre-emptively load Carp::Heavy. If we don't when we run out of file
  # handles and attempt to call croak() we get an error message telling
  # us that Carp::Heavy won't load rather than an error telling us we
  # have run out of file handles. We either preload croak() or we
  # switch the calls to croak from _gettemp() to use die.
  eval { require Carp::Heavy; };
  
  # Need the Symbol package if we are running older perl
  require Symbol if $] < 5.006;
  
  ### For the OO interface
  use base qw/ IO::Handle IO::Seekable /;
  use overload '""' => "STRINGIFY", fallback => 1;
  
  # use 'our' on v5.6.0
  use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
  
  $DEBUG = 0;
  $KEEP_ALL = 0;
  
  # We are exporting functions
  
  use base qw/Exporter/;
  
  # Export list - to allow fine tuning of export table
  
  @EXPORT_OK = qw{
                   tempfile
                   tempdir
                   tmpnam
                   tmpfile
                   mktemp
                   mkstemp
                   mkstemps
                   mkdtemp
                   unlink0
                   cleanup
                   SEEK_SET
                   SEEK_CUR
                   SEEK_END
               };
  
  # Groups of functions for export
  
  %EXPORT_TAGS = (
                  'POSIX' => [qw/ tmpnam tmpfile /],
                  'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
                  'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
                 );
  
  # add contents of these tags to @EXPORT
  Exporter::export_tags('POSIX','mktemp','seekable');
  
  # Version number
  
  $VERSION = '0.22';
  
  # This is a list of characters that can be used in random filenames
  
  my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
                   a b c d e f g h i j k l m n o p q r s t u v w x y z
                   0 1 2 3 4 5 6 7 8 9 _
                 /);
  
  # Maximum number of tries to make a temp file before failing
  
  use constant MAX_TRIES => 1000;
  
  # Minimum number of X characters that should be in a template
  use constant MINX => 4;
  
  # Default template when no template supplied
  
  use constant TEMPXXX => 'X' x 10;
  
  # Constants for the security level
  
  use constant STANDARD => 0;
  use constant MEDIUM   => 1;
  use constant HIGH     => 2;
  
  # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
  # us an optimisation when many temporary files are requested
  
  my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
  my $LOCKFLAG;
  
  unless ($^O eq 'MacOS') {
    for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
      my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
      no strict 'refs';
      $OPENFLAGS |= $bit if eval {
        # Make sure that redefined die handlers do not cause problems
        # e.g. CGI::Carp
        local $SIG{__DIE__} = sub {};
        local $SIG{__WARN__} = sub {};
        $bit = &$func();
        1;
      };
    }
    # Special case O_EXLOCK
    $LOCKFLAG = eval {
      local $SIG{__DIE__} = sub {};
      local $SIG{__WARN__} = sub {};
      &Fcntl::O_EXLOCK();
    };
  }
  
  # On some systems the O_TEMPORARY flag can be used to tell the OS
  # to automatically remove the file when it is closed. This is fine
  # in most cases but not if tempfile is called with UNLINK=>0 and
  # the filename is requested -- in the case where the filename is to
  # be passed to another routine. This happens on windows. We overcome
  # this by using a second open flags variable
  
  my $OPENTEMPFLAGS = $OPENFLAGS;
  unless ($^O eq 'MacOS') {
    for my $oflag (qw/ TEMPORARY /) {
      my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
      local($@);
      no strict 'refs';
      $OPENTEMPFLAGS |= $bit if eval {
        # Make sure that redefined die handlers do not cause problems
        # e.g. CGI::Carp
        local $SIG{__DIE__} = sub {};
        local $SIG{__WARN__} = sub {};
        $bit = &$func();
        1;
      };
    }
  }
  
  # Private hash tracking which files have been created by each process id via the OO interface
  my %FILES_CREATED_BY_OBJECT;
  
  # INTERNAL ROUTINES - not to be used outside of package
  
  # Generic routine for getting a temporary filename
  # modelled on OpenBSD _gettemp() in mktemp.c
  
  # The template must contain X's that are to be replaced
  # with the random values
  
  #  Arguments:
  
  #  TEMPLATE   - string containing the XXXXX's that is converted
  #           to a random filename and opened if required
  
  # Optionally, a hash can also be supplied containing specific options
  #   "open" => if true open the temp file, else just return the name
  #             default is 0
  #   "mkdir"=> if true, we are creating a temp directory rather than tempfile
  #             default is 0
  #   "suffixlen" => number of characters at end of PATH to be ignored.
  #                  default is 0.
  #   "unlink_on_close" => indicates that, if possible,  the OS should remove
  #                        the file as soon as it is closed. Usually indicates
  #                        use of the O_TEMPORARY flag to sysopen.
  #                        Usually irrelevant on unix
  #   "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
  
  # Optionally a reference to a scalar can be passed into the function
  # On error this will be used to store the reason for the error
  #   "ErrStr"  => \$errstr
  
  # "open" and "mkdir" can not both be true
  # "unlink_on_close" is not used when "mkdir" is true.
  
  # The default options are equivalent to mktemp().
  
  # Returns:
  #   filehandle - open file handle (if called with doopen=1, else undef)
  #   temp name  - name of the temp file or directory
  
  # For example:
  #   ($fh, $name) = _gettemp($template, "open" => 1);
  
  # for the current version, failures are associated with
  # stored in an error string and returned to give the reason whilst debugging
  # This routine is not called by any external function
  sub _gettemp {
  
    croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
      unless scalar(@_) >= 1;
  
    # the internal error string - expect it to be overridden
    # Need this in case the caller decides not to supply us a value
    # need an anonymous scalar
    my $tempErrStr;
  
    # Default options
    my %options = (
                   "open" => 0,
                   "mkdir" => 0,
                   "suffixlen" => 0,
                   "unlink_on_close" => 0,
                   "use_exlock" => 1,
                   "ErrStr" => \$tempErrStr,
                  );
  
    # Read the template
    my $template = shift;
    if (ref($template)) {
      # Use a warning here since we have not yet merged ErrStr
      carp "File::Temp::_gettemp: template must not be a reference";
      return ();
    }
  
    # Check that the number of entries on stack are even
    if (scalar(@_) % 2 != 0) {
      # Use a warning here since we have not yet merged ErrStr
      carp "File::Temp::_gettemp: Must have even number of options";
      return ();
    }
  
    # Read the options and merge with defaults
    %options = (%options, @_)  if @_;
  
    # Make sure the error string is set to undef
    ${$options{ErrStr}} = undef;
  
    # Can not open the file and make a directory in a single call
    if ($options{"open"} && $options{"mkdir"}) {
      ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
      return ();
    }
  
    # Find the start of the end of the  Xs (position of last X)
    # Substr starts from 0
    my $start = length($template) - 1 - $options{"suffixlen"};
  
    # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
    # (taking suffixlen into account). Any fewer is insecure.
  
    # Do it using substr - no reason to use a pattern match since
    # we know where we are looking and what we are looking for
  
    if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
      ${$options{ErrStr}} = "The template must end with at least ".
        MINX . " 'X' characters\n";
      return ();
    }
  
    # Replace all the X at the end of the substring with a
    # random character or just all the XX at the end of a full string.
    # Do it as an if, since the suffix adjusts which section to replace
    # and suffixlen=0 returns nothing if used in the substr directly
    # and generate a full path from the template
  
    my $path = _replace_XX($template, $options{"suffixlen"});
  
  
    # Split the path into constituent parts - eventually we need to check
    # whether the directory exists
    # We need to know whether we are making a temp directory
    # or a tempfile
  
    my ($volume, $directories, $file);
    my $parent;                   # parent directory
    if ($options{"mkdir"}) {
      # There is no filename at the end
      ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
  
      # The parent is then $directories without the last directory
      # Split the directory and put it back together again
      my @dirs = File::Spec->splitdir($directories);
  
      # If @dirs only has one entry (i.e. the directory template) that means
      # we are in the current directory
      if ($#dirs == 0) {
        $parent = File::Spec->curdir;
      } else {
  
        if ($^O eq 'VMS') {     # need volume to avoid relative dir spec
          $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
          $parent = 'sys$disk:[]' if $parent eq '';
        } else {
  
          # Put it back together without the last one
          $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
  
          # ...and attach the volume (no filename)
          $parent = File::Spec->catpath($volume, $parent, '');
        }
  
      }
  
    } else {
  
      # Get rid of the last filename (use File::Basename for this?)
      ($volume, $directories, $file) = File::Spec->splitpath( $path );
  
      # Join up without the file part
      $parent = File::Spec->catpath($volume,$directories,'');
  
      # If $parent is empty replace with curdir
      $parent = File::Spec->curdir
        unless $directories ne '';
  
    }
  
    # Check that the parent directories exist
    # Do this even for the case where we are simply returning a name
    # not a file -- no point returning a name that includes a directory
    # that does not exist or is not writable
  
    unless (-e $parent) {
      ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
      return ();
    }
    unless (-d $parent) {
      ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
      return ();
    }
  
    # Check the stickiness of the directory and chown giveaway if required
    # If the directory is world writable the sticky bit
    # must be set
  
    if (File::Temp->safe_level == MEDIUM) {
      my $safeerr;
      unless (_is_safe($parent,\$safeerr)) {
        ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
        return ();
      }
    } elsif (File::Temp->safe_level == HIGH) {
      my $safeerr;
      unless (_is_verysafe($parent, \$safeerr)) {
        ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
        return ();
      }
    }
  
  
    # Now try MAX_TRIES time to open the file
    for (my $i = 0; $i < MAX_TRIES; $i++) {
  
      # Try to open the file if requested
      if ($options{"open"}) {
        my $fh;
  
        # If we are running before perl5.6.0 we can not auto-vivify
        if ($] < 5.006) {
          $fh = &Symbol::gensym;
        }
  
        # Try to make sure this will be marked close-on-exec
        # XXX: Win32 doesn't respect this, nor the proper fcntl,
        #      but may have O_NOINHERIT. This may or may not be in Fcntl.
        local $^F = 2;
  
        # Attempt to open the file
        my $open_success = undef;
        if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
          # make it auto delete on close by setting FAB$V_DLT bit
          $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
          $open_success = $fh;
        } else {
          my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
                        $OPENTEMPFLAGS :
                        $OPENFLAGS );
          $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
          $open_success = sysopen($fh, $path, $flags, 0600);
        }
        if ( $open_success ) {
  
          # in case of odd umask force rw
          chmod(0600, $path);
  
          # Opened successfully - return file handle and name
          return ($fh, $path);
  
        } else {
  
          # Error opening file - abort with error
          # if the reason was anything but EEXIST
          unless ($!{EEXIST}) {
            ${$options{ErrStr}} = "Could not create temp file $path: $!";
            return ();
          }
  
          # Loop round for another try
  
        }
      } elsif ($options{"mkdir"}) {
  
        # Open the temp directory
        if (mkdir( $path, 0700)) {
          # in case of odd umask
          chmod(0700, $path);
  
          return undef, $path;
        } else {
  
          # Abort with error if the reason for failure was anything
          # except EEXIST
          unless ($!{EEXIST}) {
            ${$options{ErrStr}} = "Could not create directory $path: $!";
            return ();
          }
  
          # Loop round for another try
  
        }
  
      } else {
  
        # Return true if the file can not be found
        # Directory has been checked previously
  
        return (undef, $path) unless -e $path;
  
        # Try again until MAX_TRIES
  
      }
  
      # Did not successfully open the tempfile/dir
      # so try again with a different set of random letters
      # No point in trying to increment unless we have only
      # 1 X say and the randomness could come up with the same
      # file MAX_TRIES in a row.
  
      # Store current attempt - in principal this implies that the
      # 3rd time around the open attempt that the first temp file
      # name could be generated again. Probably should store each
      # attempt and make sure that none are repeated
  
      my $original = $path;
      my $counter = 0;            # Stop infinite loop
      my $MAX_GUESS = 50;
  
      do {
  
        # Generate new name from original template
        $path = _replace_XX($template, $options{"suffixlen"});
  
        $counter++;
  
      } until ($path ne $original || $counter > $MAX_GUESS);
  
      # Check for out of control looping
      if ($counter > $MAX_GUESS) {
        ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
        return ();
      }
  
    }
  
    # If we get here, we have run out of tries
    ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
      . MAX_TRIES . ") to open temp file/dir";
  
    return ();
  
  }
  
  # Internal routine to replace the XXXX... with random characters
  # This has to be done by _gettemp() every time it fails to
  # open a temp file/dir
  
  # Arguments:  $template (the template with XXX),
  #             $ignore   (number of characters at end to ignore)
  
  # Returns:    modified template
  
  sub _replace_XX {
  
    croak 'Usage: _replace_XX($template, $ignore)'
      unless scalar(@_) == 2;
  
    my ($path, $ignore) = @_;
  
    # Do it as an if, since the suffix adjusts which section to replace
    # and suffixlen=0 returns nothing if used in the substr directly
    # Alternatively, could simply set $ignore to length($path)-1
    # Don't want to always use substr when not required though.
    my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
  
    if ($ignore) {
      substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
    } else {
      $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
    }
    return $path;
  }
  
  # Internal routine to force a temp file to be writable after
  # it is created so that we can unlink it. Windows seems to occassionally
  # force a file to be readonly when written to certain temp locations
  sub _force_writable {
    my $file = shift;
    chmod 0600, $file;
  }
  
  
  # internal routine to check to see if the directory is safe
  # First checks to see if the directory is not owned by the
  # current user or root. Then checks to see if anyone else
  # can write to the directory and if so, checks to see if
  # it has the sticky bit set
  
  # Will not work on systems that do not support sticky bit
  
  #Args:  directory path to check
  #       Optionally: reference to scalar to contain error message
  # Returns true if the path is safe and false otherwise.
  # Returns undef if can not even run stat() on the path
  
  # This routine based on version written by Tom Christiansen
  
  # Presumably, by the time we actually attempt to create the
  # file or directory in this directory, it may not be safe
  # anymore... Have to run _is_safe directly after the open.
  
  sub _is_safe {
  
    my $path = shift;
    my $err_ref = shift;
  
    # Stat path
    my @info = stat($path);
    unless (scalar(@info)) {
      $$err_ref = "stat(path) returned no values";
      return 0;
    }
    ;
    return 1 if $^O eq 'VMS';     # owner delete control at file level
  
    # Check to see whether owner is neither superuser (or a system uid) nor me
    # Use the effective uid from the $> variable
    # UID is in [4]
    if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
  
      Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
                  File::Temp->top_system_uid());
  
      $$err_ref = "Directory owned neither by root nor the current user"
        if ref($err_ref);
      return 0;
    }
  
    # check whether group or other can write file
    # use 066 to detect either reading or writing
    # use 022 to check writability
    # Do it with S_IWOTH and S_IWGRP for portability (maybe)
    # mode is in info[2]
    if (($info[2] & &Fcntl::S_IWGRP) ||  # Is group writable?
        ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
      # Must be a directory
      unless (-d $path) {
        $$err_ref = "Path ($path) is not a directory"
          if ref($err_ref);
        return 0;
      }
      # Must have sticky bit set
      unless (-k $path) {
        $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
          if ref($err_ref);
        return 0;
      }
    }
  
    return 1;
  }
  
  # Internal routine to check whether a directory is safe
  # for temp files. Safer than _is_safe since it checks for
  # the possibility of chown giveaway and if that is a possibility
  # checks each directory in the path to see if it is safe (with _is_safe)
  
  # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
  # directory anyway.
  
  # Takes optional second arg as scalar ref to error reason
  
  sub _is_verysafe {
  
    # Need POSIX - but only want to bother if really necessary due to overhead
    require POSIX;
  
    my $path = shift;
    print "_is_verysafe testing $path\n" if $DEBUG;
    return 1 if $^O eq 'VMS';     # owner delete control at file level
  
    my $err_ref = shift;
  
    # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
    # and If it is not there do the extensive test
    local($@);
    my $chown_restricted;
    $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
      if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
  
    # If chown_resticted is set to some value we should test it
    if (defined $chown_restricted) {
  
      # Return if the current directory is safe
      return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
  
    }
  
    # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
    # was not avialable or the symbol was there but chown giveaway
    # is allowed. Either way, we now have to test the entire tree for
    # safety.
  
    # Convert path to an absolute directory if required
    unless (File::Spec->file_name_is_absolute($path)) {
      $path = File::Spec->rel2abs($path);
    }
  
    # Split directory into components - assume no file
    my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
  
    # Slightly less efficient than having a function in File::Spec
    # to chop off the end of a directory or even a function that
    # can handle ../ in a directory tree
    # Sometimes splitdir() returns a blank at the end
    # so we will probably check the bottom directory twice in some cases
    my @dirs = File::Spec->splitdir($directories);
  
    # Concatenate one less directory each time around
    foreach my $pos (0.. $#dirs) {
      # Get a directory name
      my $dir = File::Spec->catpath($volume,
                                    File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
                                    ''
                                   );
  
      print "TESTING DIR $dir\n" if $DEBUG;
  
      # Check the directory
      return 0 unless _is_safe($dir,$err_ref);
  
    }
  
    return 1;
  }
  
  
  
  # internal routine to determine whether unlink works on this
  # platform for files that are currently open.
  # Returns true if we can, false otherwise.
  
  # Currently WinNT, OS/2 and VMS can not unlink an opened file
  # On VMS this is because the O_EXCL flag is used to open the
  # temporary file. Currently I do not know enough about the issues
  # on VMS to decide whether O_EXCL is a requirement.
  
  sub _can_unlink_opened_file {
  
    if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
      return 0;
    } else {
      return 1;
    }
  
  }
  
  # internal routine to decide which security levels are allowed
  # see safe_level() for more information on this
  
  # Controls whether the supplied security level is allowed
  
  #   $cando = _can_do_level( $level )
  
  sub _can_do_level {
  
    # Get security level
    my $level = shift;
  
    # Always have to be able to do STANDARD
    return 1 if $level == STANDARD;
  
    # Currently, the systems that can do HIGH or MEDIUM are identical
    if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
      return 0;
    } else {
      return 1;
    }
  
  }
  
  # This routine sets up a deferred unlinking of a specified
  # filename and filehandle. It is used in the following cases:
  #  - Called by unlink0 if an opened file can not be unlinked
  #  - Called by tempfile() if files are to be removed on shutdown
  #  - Called by tempdir() if directories are to be removed on shutdown
  
  # Arguments:
  #   _deferred_unlink( $fh, $fname, $isdir );
  #
  #   - filehandle (so that it can be expclicitly closed if open
  #   - filename   (the thing we want to remove)
  #   - isdir      (flag to indicate that we are being given a directory)
  #                 [and hence no filehandle]
  
  # Status is not referred to since all the magic is done with an END block
  
  {
    # Will set up two lexical variables to contain all the files to be
    # removed. One array for files, another for directories They will
    # only exist in this block.
  
    #  This means we only have to set up a single END block to remove
    #  all files. 
  
    # in order to prevent child processes inadvertently deleting the parent
    # temp files we use a hash to store the temp files and directories
    # created by a particular process id.
  
    # %files_to_unlink contains values that are references to an array of
    # array references containing the filehandle and filename associated with
    # the temp file.
    my (%files_to_unlink, %dirs_to_unlink);
  
    # Set up an end block to use these arrays
    END {
      local($., $@, $!, $^E, $?);
      cleanup();
    }
  
    # Cleanup function. Always triggered on END but can be invoked
    # manually.
    sub cleanup {
      if (!$KEEP_ALL) {
        # Files
        my @files = (exists $files_to_unlink{$$} ?
                     @{ $files_to_unlink{$$} } : () );
        foreach my $file (@files) {
          # close the filehandle without checking its state
          # in order to make real sure that this is closed
          # if its already closed then I dont care about the answer
          # probably a better way to do this
          close($file->[0]);      # file handle is [0]
  
          if (-f $file->[1]) {       # file name is [1]
            _force_writable( $file->[1] ); # for windows
            unlink $file->[1] or warn "Error removing ".$file->[1];
          }
        }
        # Dirs
        my @dirs = (exists $dirs_to_unlink{$$} ?
                    @{ $dirs_to_unlink{$$} } : () );
        foreach my $dir (@dirs) {
          if (-d $dir) {
            # Some versions of rmtree will abort if you attempt to remove
            # the directory you are sitting in. We protect that and turn it
            # into a warning. We do this because this occurs during
            # cleanup and so can not be caught by the user.
            eval { rmtree($dir, $DEBUG, 0); };
            warn $@ if ($@ && $^W);
          }
        }
  
        # clear the arrays
        @{ $files_to_unlink{$$} } = ()
          if exists $files_to_unlink{$$};
        @{ $dirs_to_unlink{$$} } = ()
          if exists $dirs_to_unlink{$$};
      }
    }
  
  
    # This is the sub called to register a file for deferred unlinking
    # This could simply store the input parameters and defer everything
    # until the END block. For now we do a bit of checking at this
    # point in order to make sure that (1) we have a file/dir to delete
    # and (2) we have been called with the correct arguments.
    sub _deferred_unlink {
  
      croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
        unless scalar(@_) == 3;
  
      my ($fh, $fname, $isdir) = @_;
  
      warn "Setting up deferred removal of $fname\n"
        if $DEBUG;
  
      # If we have a directory, check that it is a directory
      if ($isdir) {
  
        if (-d $fname) {
  
          # Directory exists so store it
          # first on VMS turn []foo into [.foo] for rmtree
          $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
          $dirs_to_unlink{$$} = [] 
            unless exists $dirs_to_unlink{$$};
          push (@{ $dirs_to_unlink{$$} }, $fname);
  
        } else {
          carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
        }
  
      } else {
  
        if (-f $fname) {
  
          # file exists so store handle and name for later removal
          $files_to_unlink{$$} = []
            unless exists $files_to_unlink{$$};
          push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
  
        } else {
          carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
        }
  
      }
  
    }
  
  
  }
  
  =head1 OBJECT-ORIENTED INTERFACE
  
  This is the primary interface for interacting with
  C<File::Temp>. Using the OO interface a temporary file can be created
  when the object is constructed and the file can be removed when the
  object is no longer required.
  
  Note that there is no method to obtain the filehandle from the
  C<File::Temp> object. The object itself acts as a filehandle. Also,
  the object is configured such that it stringifies to the name of the
  temporary file, and can be compared to a filename directly. The object
  isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
  available.
  
  =over 4
  
  =item B<new>
  
  Create a temporary file object.
  
    my $tmp = File::Temp->new();
  
  by default the object is constructed as if C<tempfile>
  was called without options, but with the additional behaviour
  that the temporary file is removed by the object destructor
  if UNLINK is set to true (the default).
  
  Supported arguments are the same as for C<tempfile>: UNLINK
  (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
  template is specified using the TEMPLATE option. The OPEN option
  is not supported (the file is always opened).
  
   $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
                          DIR => 'mydir',
                          SUFFIX => '.dat');
  
  Arguments are case insensitive.
  
  Can call croak() if an error occurs.
  
  =cut
  
  sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
  
    # read arguments and convert keys to upper case
    my %args = @_;
    %args = map { uc($_), $args{$_} } keys %args;
  
    # see if they are unlinking (defaulting to yes)
    my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
    delete $args{UNLINK};
  
    # template (store it in an array so that it will
    # disappear from the arg list of tempfile)
    my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
    delete $args{TEMPLATE};
  
    # Protect OPEN
    delete $args{OPEN};
  
    # Open the file and retain file handle and file name
    my ($fh, $path) = tempfile( @template, %args );
  
    print "Tmp: $fh - $path\n" if $DEBUG;
  
    # Store the filename in the scalar slot
    ${*$fh} = $path;
  
    # Cache the filename by pid so that the destructor can decide whether to remove it
    $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
  
    # Store unlink information in hash slot (plus other constructor info)
    %{*$fh} = %args;
  
    # create the object
    bless $fh, $class;
  
    # final method-based configuration
    $fh->unlink_on_destroy( $unlink );
  
    return $fh;
  }
  
  =item B<newdir>
  
  Create a temporary directory using an object oriented interface.
  
    $dir = File::Temp->newdir();
  
  By default the directory is deleted when the object goes out of scope.
  
  Supports the same options as the C<tempdir> function. Note that directories
  created with this method default to CLEANUP => 1.
  
    $dir = File::Temp->newdir( $template, %options );
  
  =cut
  
  sub newdir {
    my $self = shift;
  
    # need to handle args as in tempdir because we have to force CLEANUP
    # default without passing CLEANUP to tempdir
    my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
    my %options = @_;
    my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );
  
    delete $options{CLEANUP};
  
    my $tempdir;
    if (defined $template) {
      $tempdir = tempdir( $template, %options );
    } else {
      $tempdir = tempdir( %options );
    }
    return bless { DIRNAME => $tempdir,
                   CLEANUP => $cleanup,
                   LAUNCHPID => $$,
                 }, "File::Temp::Dir";
  }
  
  =item B<filename>
  
  Return the name of the temporary file associated with this object
  (if the object was created using the "new" constructor).
  
    $filename = $tmp->filename;
  
  This method is called automatically when the object is used as
  a string.
  
  =cut
  
  sub filename {
    my $self = shift;
    return ${*$self};
  }
  
  sub STRINGIFY {
    my $self = shift;
    return $self->filename;
  }
  
  =item B<dirname>
  
  Return the name of the temporary directory associated with this
  object (if the object was created using the "newdir" constructor).
  
    $dirname = $tmpdir->dirname;
  
  This method is called automatically when the object is used in string context.
  
  =item B<unlink_on_destroy>
  
  Control whether the file is unlinked when the object goes out of scope.
  The file is removed if this value is true and $KEEP_ALL is not.
  
   $fh->unlink_on_destroy( 1 );
  
  Default is for the file to be removed.
  
  =cut
  
  sub unlink_on_destroy {
    my $self = shift;
    if (@_) {
      ${*$self}{UNLINK} = shift;
    }
    return ${*$self}{UNLINK};
  }
  
  =item B<DESTROY>
  
  When the object goes out of scope, the destructor is called. This
  destructor will attempt to unlink the file (using C<unlink1>)
  if the constructor was called with UNLINK set to 1 (the default state
  if UNLINK is not specified).
  
  No error is given if the unlink fails.
  
  If the object has been passed to a child process during a fork, the
  file will be deleted when the object goes out of scope in the parent.
  
  For a temporary directory object the directory will be removed
  unless the CLEANUP argument was used in the constructor (and set to
  false) or C<unlink_on_destroy> was modified after creation.
  
  If the global variable $KEEP_ALL is true, the file or directory
  will not be removed.
  
  =cut
  
  sub DESTROY {
    local($., $@, $!, $^E, $?);
    my $self = shift;
  
    # Make sure we always remove the file from the global hash
    # on destruction. This prevents the hash from growing uncontrollably
    # and post-destruction there is no reason to know about the file.
    my $file = $self->filename;
    my $was_created_by_proc;
    if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) {
      $was_created_by_proc = 1;
      delete $FILES_CREATED_BY_OBJECT{$$}{$file};
    }
  
    if (${*$self}{UNLINK} && !$KEEP_ALL) {
      print "# --------->   Unlinking $self\n" if $DEBUG;
  
      # only delete if this process created it
      return unless $was_created_by_proc;
  
      # The unlink1 may fail if the file has been closed
      # by the caller. This leaves us with the decision
      # of whether to refuse to remove the file or simply
      # do an unlink without test. Seems to be silly
      # to do this when we are trying to be careful
      # about security
      _force_writable( $file ); # for windows
      unlink1( $self, $file )
        or unlink($file);
    }
  }
  
  =back
  
  =head1 FUNCTIONS
  
  This section describes the recommended interface for generating
  temporary files and directories.
  
  =over 4
  
  =item B<tempfile>
  
  This is the basic function to generate temporary files.
  The behaviour of the file can be changed using various options:
  
    $fh = tempfile();
    ($fh, $filename) = tempfile();
  
  Create a temporary file in  the directory specified for temporary
  files, as specified by the tmpdir() function in L<File::Spec>.
  
    ($fh, $filename) = tempfile($template);
  
  Create a temporary file in the current directory using the supplied
  template.  Trailing `X' characters are replaced with random letters to
  generate the filename.  At least four `X' characters must be present
  at the end of the template.
  
    ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
  
  Same as previously, except that a suffix is added to the template
  after the `X' translation.  Useful for ensuring that a temporary
  filename has a particular extension when needed by other applications.
  But see the WARNING at the end.
  
    ($fh, $filename) = tempfile($template, DIR => $dir);
  
  Translates the template as before except that a directory name
  is specified.
  
    ($fh, $filename) = tempfile($template, TMPDIR => 1);
  
  Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
  into the same temporary directory as would be used if no template was
  specified at all.
  
    ($fh, $filename) = tempfile($template, UNLINK => 1);
  
  Return the filename and filehandle as before except that the file is
  automatically removed when the program exits (dependent on
  $KEEP_ALL). Default is for the file to be removed if a file handle is
  requested and to be kept if the filename is requested. In a scalar
  context (where no filename is returned) the file is always deleted
  either (depending on the operating system) on exit or when it is
  closed (unless $KEEP_ALL is true when the temp file is created).
  
  Use the object-oriented interface if fine-grained control of when
  a file is removed is required.
  
  If the template is not specified, a template is always
  automatically generated. This temporary file is placed in tmpdir()
  (L<File::Spec>) unless a directory is specified explicitly with the
  DIR option.
  
    $fh = tempfile( DIR => $dir );
  
  If called in scalar context, only the filehandle is returned and the
  file will automatically be deleted when closed on operating systems
  that support this (see the description of tmpfile() elsewhere in this
  document).  This is the preferred mode of operation, as if you only
  have a filehandle, you can never create a race condition by fumbling
  with the filename. On systems that can not unlink an open file or can
  not mark a file as temporary when it is opened (for example, Windows
  NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
  the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
  flag is ignored if present.
  
    (undef, $filename) = tempfile($template, OPEN => 0);
  
  This will return the filename based on the template but
  will not open this file.  Cannot be used in conjunction with
  UNLINK set to true. Default is to always open the file
  to protect from possible race conditions. A warning is issued
  if warnings are turned on. Consider using the tmpnam()
  and mktemp() functions described elsewhere in this document
  if opening the file is not required.
  
  If the operating system supports it (for example BSD derived systems), the 
  filehandle will be opened with O_EXLOCK (open with exclusive file lock). 
  This can sometimes cause problems if the intention is to pass the filename 
  to another system that expects to take an exclusive lock itself (such as 
  DBD::SQLite) whilst ensuring that the tempfile is not reused. In this 
  situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK 
  will be true (this retains compatibility with earlier releases).
  
    ($fh, $filename) = tempfile($template, EXLOCK => 0);
  
  Options can be combined as required.
  
  Will croak() if there is an error.
  
  =cut
  
  sub tempfile {
  
    # Can not check for argument count since we can have any
    # number of args
  
    # Default options
    my %options = (
                   "DIR"    => undef, # Directory prefix
                   "SUFFIX" => '',    # Template suffix
                   "UNLINK" => 0,     # Do not unlink file on exit
                   "OPEN"   => 1,     # Open file
                   "TMPDIR" => 0, # Place tempfile in tempdir if template specified
                   "EXLOCK" => 1, # Open file with O_EXLOCK
                  );
  
    # Check to see whether we have an odd or even number of arguments
    my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
  
    # Read the options and merge with defaults
    %options = (%options, @_)  if @_;
  
    # First decision is whether or not to open the file
    if (! $options{"OPEN"}) {
  
      warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
        if $^W;
  
    }
  
    if ($options{"DIR"} and $^O eq 'VMS') {
  
      # on VMS turn []foo into [.foo] for concatenation
      $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
    }
  
    # Construct the template
  
    # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
    # functions or simply constructing a template and using _gettemp()
    # explicitly. Go for the latter
  
    # First generate a template if not defined and prefix the directory
    # If no template must prefix the temp directory
    if (defined $template) {
      # End up with current directory if neither DIR not TMPDIR are set
      if ($options{"DIR"}) {
  
        $template = File::Spec->catfile($options{"DIR"}, $template);
  
      } elsif ($options{TMPDIR}) {
  
        $template = File::Spec->catfile(File::Spec->tmpdir, $template );
  
      }
  
    } else {
  
      if ($options{"DIR"}) {
  
        $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
  
      } else {
  
        $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
  
      }
  
    }
  
    # Now add a suffix
    $template .= $options{"SUFFIX"};
  
    # Determine whether we should tell _gettemp to unlink the file
    # On unix this is irrelevant and can be worked out after the file is
    # opened (simply by unlinking the open filehandle). On Windows or VMS
    # we have to indicate temporary-ness when we open the file. In general
    # we only want a true temporary file if we are returning just the
    # filehandle - if the user wants the filename they probably do not
    # want the file to disappear as soon as they close it (which may be
    # important if they want a child process to use the file)
    # For this reason, tie unlink_on_close to the return context regardless
    # of OS.
    my $unlink_on_close = ( wantarray ? 0 : 1);
  
    # Create the file
    my ($fh, $path, $errstr);
    croak "Error in tempfile() using $template: $errstr"
      unless (($fh, $path) = _gettemp($template,
                                      "open" => $options{'OPEN'},
                                      "mkdir"=> 0 ,
                                      "unlink_on_close" => $unlink_on_close,
                                      "suffixlen" => length($options{'SUFFIX'}),
                                      "ErrStr" => \$errstr,
                                      "use_exlock" => $options{EXLOCK},
                                     ) );
  
    # Set up an exit handler that can do whatever is right for the
    # system. This removes files at exit when requested explicitly or when
    # system is asked to unlink_on_close but is unable to do so because
    # of OS limitations.
    # The latter should be achieved by using a tied filehandle.
    # Do not check return status since this is all done with END blocks.
    _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
  
    # Return
    if (wantarray()) {
  
      if ($options{'OPEN'}) {
        return ($fh, $path);
      } else {
        return (undef, $path);
      }
  
    } else {
  
      # Unlink the file. It is up to unlink0 to decide what to do with
      # this (whether to unlink now or to defer until later)
      unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
  
      # Return just the filehandle.
      return $fh;
    }
  
  
  }
  
  =item B<tempdir>
  
  This is the recommended interface for creation of temporary
  directories.  By default the directory will not be removed on exit
  (that is, it won't be temporary; this behaviour can not be changed
  because of issues with backwards compatibility). To enable removal
  either use the CLEANUP option which will trigger removal on program
  exit, or consider using the "newdir" method in the object interface which
  will allow the directory to be cleaned up when the object goes out of
  scope.
  
  The behaviour of the function depends on the arguments:
  
    $tempdir = tempdir();
  
  Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
  
    $tempdir = tempdir( $template );
  
  Create a directory from the supplied template. This template is
  similar to that described for tempfile(). `X' characters at the end
  of the template are replaced with random letters to construct the
  directory name. At least four `X' characters must be in the template.
  
    $tempdir = tempdir ( DIR => $dir );
  
  Specifies the directory to use for the temporary directory.
  The temporary directory name is derived from an internal template.
  
    $tempdir = tempdir ( $template, DIR => $dir );
  
  Prepend the supplied directory name to the template. The template
  should not include parent directory specifications itself. Any parent
  directory specifications are removed from the template before
  prepending the supplied directory.
  
    $tempdir = tempdir ( $template, TMPDIR => 1 );
  
  Using the supplied template, create the temporary directory in
  a standard location for temporary files. Equivalent to doing
  
    $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
  
  but shorter. Parent directory specifications are stripped from the
  template itself. The C<TMPDIR> option is ignored if C<DIR> is set
  explicitly.  Additionally, C<TMPDIR> is implied if neither a template
  nor a directory are supplied.
  
    $tempdir = tempdir( $template, CLEANUP => 1);
  
  Create a temporary directory using the supplied template, but
  attempt to remove it (and all files inside it) when the program
  exits. Note that an attempt will be made to remove all files from
  the directory even if they were not created by this module (otherwise
  why ask to clean it up?). The directory removal is made with
  the rmtree() function from the L<File::Path|File::Path> module.
  Of course, if the template is not specified, the temporary directory
  will be created in tmpdir() and will also be removed at program exit.
  
  Will croak() if there is an error.
  
  =cut
  
  # '
  
  sub tempdir  {
  
    # Can not check for argument count since we can have any
    # number of args
  
    # Default options
    my %options = (
                   "CLEANUP"    => 0, # Remove directory on exit
                   "DIR"        => '', # Root directory
                   "TMPDIR"     => 0,  # Use tempdir with template
                  );
  
    # Check to see whether we have an odd or even number of arguments
    my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
  
    # Read the options and merge with defaults
    %options = (%options, @_)  if @_;
  
    # Modify or generate the template
  
    # Deal with the DIR and TMPDIR options
    if (defined $template) {
  
      # Need to strip directory path if using DIR or TMPDIR
      if ($options{'TMPDIR'} || $options{'DIR'}) {
  
        # Strip parent directory from the filename
        #
        # There is no filename at the end
        $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
        my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
  
        # Last directory is then our template
        $template = (File::Spec->splitdir($directories))[-1];
  
        # Prepend the supplied directory or temp dir
        if ($options{"DIR"}) {
  
          $template = File::Spec->catdir($options{"DIR"}, $template);
  
        } elsif ($options{TMPDIR}) {
  
          # Prepend tmpdir
          $template = File::Spec->catdir(File::Spec->tmpdir, $template);
  
        }
  
      }
  
    } else {
  
      if ($options{"DIR"}) {
  
        $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
  
      } else {
  
        $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
  
      }
  
    }
  
    # Create the directory
    my $tempdir;
    my $suffixlen = 0;
    if ($^O eq 'VMS') {           # dir names can end in delimiters
      $template =~ m/([\.\]:>]+)$/;
      $suffixlen = length($1);
    }
    if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
      # dir name has a trailing ':'
      ++$suffixlen;
    }
  
    my $errstr;
    croak "Error in tempdir() using $template: $errstr"
      unless ((undef, $tempdir) = _gettemp($template,
                                           "open" => 0,
                                           "mkdir"=> 1 ,
                                           "suffixlen" => $suffixlen,
                                           "ErrStr" => \$errstr,
                                          ) );
  
    # Install exit handler; must be dynamic to get lexical
    if ( $options{'CLEANUP'} && -d $tempdir) {
      _deferred_unlink(undef, $tempdir, 1);
    }
  
    # Return the dir name
    return $tempdir;
  
  }
  
  =back
  
  =head1 MKTEMP FUNCTIONS
  
  The following functions are Perl implementations of the
  mktemp() family of temp file generation system calls.
  
  =over 4
  
  =item B<mkstemp>
  
  Given a template, returns a filehandle to the temporary file and the name
  of the file.
  
    ($fh, $name) = mkstemp( $template );
  
  In scalar context, just the filehandle is returned.
  
  The template may be any filename with some number of X's appended
  to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
  with unique alphanumeric combinations.
  
  Will croak() if there is an error.
  
  =cut
  
  
  
  sub mkstemp {
  
    croak "Usage: mkstemp(template)"
      if scalar(@_) != 1;
  
    my $template = shift;
  
    my ($fh, $path, $errstr);
    croak "Error in mkstemp using $template: $errstr"
      unless (($fh, $path) = _gettemp($template,
                                      "open" => 1,
                                      "mkdir"=> 0 ,
                                      "suffixlen" => 0,
                                      "ErrStr" => \$errstr,
                                     ) );
  
    if (wantarray()) {
      return ($fh, $path);
    } else {
      return $fh;
    }
  
  }
  
  
  =item B<mkstemps>
  
  Similar to mkstemp(), except that an extra argument can be supplied
  with a suffix to be appended to the template.
  
    ($fh, $name) = mkstemps( $template, $suffix );
  
  For example a template of C<testXXXXXX> and suffix of C<.dat>
  would generate a file similar to F<testhGji_w.dat>.
  
  Returns just the filehandle alone when called in scalar context.
  
  Will croak() if there is an error.
  
  =cut
  
  sub mkstemps {
  
    croak "Usage: mkstemps(template, suffix)"
      if scalar(@_) != 2;
  
  
    my $template = shift;
    my $suffix   = shift;
  
    $template .= $suffix;
  
    my ($fh, $path, $errstr);
    croak "Error in mkstemps using $template: $errstr"
      unless (($fh, $path) = _gettemp($template,
                                      "open" => 1,
                                      "mkdir"=> 0 ,
                                      "suffixlen" => length($suffix),
                                      "ErrStr" => \$errstr,
                                     ) );
  
    if (wantarray()) {
      return ($fh, $path);
    } else {
      return $fh;
    }
  
  }
  
  =item B<mkdtemp>
  
  Create a directory from a template. The template must end in
  X's that are replaced by the routine.
  
    $tmpdir_name = mkdtemp($template);
  
  Returns the name of the temporary directory created.
  
  Directory must be removed by the caller.
  
  Will croak() if there is an error.
  
  =cut
  
  #' # for emacs
  
  sub mkdtemp {
  
    croak "Usage: mkdtemp(template)"
      if scalar(@_) != 1;
  
    my $template = shift;
    my $suffixlen = 0;
    if ($^O eq 'VMS') {           # dir names can end in delimiters
      $template =~ m/([\.\]:>]+)$/;
      $suffixlen = length($1);
    }
    if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
      # dir name has a trailing ':'
      ++$suffixlen;
    }
    my ($junk, $tmpdir, $errstr);
    croak "Error creating temp directory from template $template\: $errstr"
      unless (($junk, $tmpdir) = _gettemp($template,
                                          "open" => 0,
                                          "mkdir"=> 1 ,
                                          "suffixlen" => $suffixlen,
                                          "ErrStr" => \$errstr,
                                         ) );
  
    return $tmpdir;
  
  }
  
  =item B<mktemp>
  
  Returns a valid temporary filename but does not guarantee
  that the file will not be opened by someone else.
  
    $unopened_file = mktemp($template);
  
  Template is the same as that required by mkstemp().
  
  Will croak() if there is an error.
  
  =cut
  
  sub mktemp {
  
    croak "Usage: mktemp(template)"
      if scalar(@_) != 1;
  
    my $template = shift;
  
    my ($tmpname, $junk, $errstr);
    croak "Error getting name to temp file from template $template: $errstr"
      unless (($junk, $tmpname) = _gettemp($template,
                                           "open" => 0,
                                           "mkdir"=> 0 ,
                                           "suffixlen" => 0,
                                           "ErrStr" => \$errstr,
                                          ) );
  
    return $tmpname;
  }
  
  =back
  
  =head1 POSIX FUNCTIONS
  
  This section describes the re-implementation of the tmpnam()
  and tmpfile() functions described in L<POSIX>
  using the mkstemp() from this module.
  
  Unlike the L<POSIX|POSIX> implementations, the directory used
  for the temporary file is not specified in a system include
  file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
  returned by L<File::Spec|File::Spec>. On some implementations this
  location can be set using the C<TMPDIR> environment variable, which
  may not be secure.
  If this is a problem, simply use mkstemp() and specify a template.
  
  =over 4
  
  =item B<tmpnam>
  
  When called in scalar context, returns the full name (including path)
  of a temporary file (uses mktemp()). The only check is that the file does
  not already exist, but there is no guarantee that that condition will
  continue to apply.
  
    $file = tmpnam();
  
  When called in list context, a filehandle to the open file and
  a filename are returned. This is achieved by calling mkstemp()
  after constructing a suitable template.
  
    ($fh, $file) = tmpnam();
  
  If possible, this form should be used to prevent possible
  race conditions.
  
  See L<File::Spec/tmpdir> for information on the choice of temporary
  directory for a particular operating system.
  
  Will croak() if there is an error.
  
  =cut
  
  sub tmpnam {
  
    # Retrieve the temporary directory name
    my $tmpdir = File::Spec->tmpdir;
  
    croak "Error temporary directory is not writable"
      if $tmpdir eq '';
  
    # Use a ten character template and append to tmpdir
    my $template = File::Spec->catfile($tmpdir, TEMPXXX);
  
    if (wantarray() ) {
      return mkstemp($template);
    } else {
      return mktemp($template);
    }
  
  }
  
  =item B<tmpfile>
  
  Returns the filehandle of a temporary file.
  
    $fh = tmpfile();
  
  The file is removed when the filehandle is closed or when the program
  exits. No access to the filename is provided.
  
  If the temporary file can not be created undef is returned.
  Currently this command will probably not work when the temporary
  directory is on an NFS file system.
  
  Will croak() if there is an error.
  
  =cut
  
  sub tmpfile {
  
    # Simply call tmpnam() in a list context
    my ($fh, $file) = tmpnam();
  
    # Make sure file is removed when filehandle is closed
    # This will fail on NFS
    unlink0($fh, $file)
      or return undef;
  
    return $fh;
  
  }
  
  =back
  
  =head1 ADDITIONAL FUNCTIONS
  
  These functions are provided for backwards compatibility
  with common tempfile generation C library functions.
  
  They are not exported and must be addressed using the full package
  name.
  
  =over 4
  
  =item B<tempnam>
  
  Return the name of a temporary file in the specified directory
  using a prefix. The file is guaranteed not to exist at the time
  the function was called, but such guarantees are good for one
  clock tick only.  Always use the proper form of C<sysopen>
  with C<O_CREAT | O_EXCL> if you must open such a filename.
  
    $filename = File::Temp::tempnam( $dir, $prefix );
  
  Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
  (using unix file convention as an example)
  
  Because this function uses mktemp(), it can suffer from race conditions.
  
  Will croak() if there is an error.
  
  =cut
  
  sub tempnam {
  
    croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
  
    my ($dir, $prefix) = @_;
  
    # Add a string to the prefix
    $prefix .= 'XXXXXXXX';
  
    # Concatenate the directory to the file
    my $template = File::Spec->catfile($dir, $prefix);
  
    return mktemp($template);
  
  }
  
  =back
  
  =head1 UTILITY FUNCTIONS
  
  Useful functions for dealing with the filehandle and filename.
  
  =over 4
  
  =item B<unlink0>
  
  Given an open filehandle and the associated filename, make a safe
  unlink. This is achieved by first checking that the filename and
  filehandle initially point to the same file and that the number of
  links to the file is 1 (all fields returned by stat() are compared).
  Then the filename is unlinked and the filehandle checked once again to
  verify that the number of links on that file is now 0.  This is the
  closest you can come to making sure that the filename unlinked was the
  same as the file whose descriptor you hold.
  
    unlink0($fh, $path)
       or die "Error unlinking file $path safely";
  
  Returns false on error but croaks() if there is a security
  anomaly. The filehandle is not closed since on some occasions this is
  not required.
  
  On some platforms, for example Windows NT, it is not possible to
  unlink an open file (the file must be closed first). On those
  platforms, the actual unlinking is deferred until the program ends and
  good status is returned. A check is still performed to make sure that
  the filehandle and filename are pointing to the same thing (but not at
  the time the end block is executed since the deferred removal may not
  have access to the filehandle).
  
  Additionally, on Windows NT not all the fields returned by stat() can
  be compared. For example, the C<dev> and C<rdev> fields seem to be
  different.  Also, it seems that the size of the file returned by stat()
  does not always agree, with C<stat(FH)> being more accurate than
  C<stat(filename)>, presumably because of caching issues even when
  using autoflush (this is usually overcome by waiting a while after
  writing to the tempfile before attempting to C<unlink0> it).
  
  Finally, on NFS file systems the link count of the file handle does
  not always go to zero immediately after unlinking. Currently, this
  command is expected to fail on NFS disks.
  
  This function is disabled if the global variable $KEEP_ALL is true
  and an unlink on open file is supported. If the unlink is to be deferred
  to the END block, the file is still registered for removal.
  
  This function should not be called if you are using the object oriented
  interface since the it will interfere with the object destructor deleting
  the file.
  
  =cut
  
  sub unlink0 {
  
    croak 'Usage: unlink0(filehandle, filename)'
      unless scalar(@_) == 2;
  
    # Read args
    my ($fh, $path) = @_;
  
    cmpstat($fh, $path) or return 0;
  
    # attempt remove the file (does not work on some platforms)
    if (_can_unlink_opened_file()) {
  
      # return early (Without unlink) if we have been instructed to retain files.
      return 1 if $KEEP_ALL;
  
      # XXX: do *not* call this on a directory; possible race
      #      resulting in recursive removal
      croak "unlink0: $path has become a directory!" if -d $path;
      unlink($path) or return 0;
  
      # Stat the filehandle
      my @fh = stat $fh;
  
      print "Link count = $fh[3] \n" if $DEBUG;
  
      # Make sure that the link count is zero
      # - Cygwin provides deferred unlinking, however,
      #   on Win9x the link count remains 1
      # On NFS the link count may still be 1 but we cant know that
      # we are on NFS
      return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
  
    } else {
      _deferred_unlink($fh, $path, 0);
      return 1;
    }
  
  }
  
  =item B<cmpstat>
  
  Compare C<stat> of filehandle with C<stat> of provided filename.  This
  can be used to check that the filename and filehandle initially point
  to the same file and that the number of links to the file is 1 (all
  fields returned by stat() are compared).
  
    cmpstat($fh, $path)
       or die "Error comparing handle with file";
  
  Returns false if the stat information differs or if the link count is
  greater than 1. Calls croak if there is a security anomaly.
  
  On certain platforms, for example Windows, not all the fields returned by stat()
  can be compared. For example, the C<dev> and C<rdev> fields seem to be
  different in Windows.  Also, it seems that the size of the file
  returned by stat() does not always agree, with C<stat(FH)> being more
  accurate than C<stat(filename)>, presumably because of caching issues
  even when using autoflush (this is usually overcome by waiting a while
  after writing to the tempfile before attempting to C<unlink0> it).
  
  Not exported by default.
  
  =cut
  
  sub cmpstat {
  
    croak 'Usage: cmpstat(filehandle, filename)'
      unless scalar(@_) == 2;
  
    # Read args
    my ($fh, $path) = @_;
  
    warn "Comparing stat\n"
      if $DEBUG;
  
    # Stat the filehandle - which may be closed if someone has manually
    # closed the file. Can not turn off warnings without using $^W
    # unless we upgrade to 5.006 minimum requirement
    my @fh;
    {
      local ($^W) = 0;
      @fh = stat $fh;
    }
    return unless @fh;
  
    if ($fh[3] > 1 && $^W) {
      carp "unlink0: fstat found too many links; SB=@fh" if $^W;
    }
  
    # Stat the path
    my @path = stat $path;
  
    unless (@path) {
      carp "unlink0: $path is gone already" if $^W;
      return;
    }
  
    # this is no longer a file, but may be a directory, or worse
    unless (-f $path) {
      confess "panic: $path is no longer a file: SB=@fh";
    }
  
    # Do comparison of each member of the array
    # On WinNT dev and rdev seem to be different
    # depending on whether it is a file or a handle.
    # Cannot simply compare all members of the stat return
    # Select the ones we can use
    my @okstat = (0..$#fh);       # Use all by default
    if ($^O eq 'MSWin32') {
      @okstat = (1,2,3,4,5,7,8,9,10);
    } elsif ($^O eq 'os2') {
      @okstat = (0, 2..$#fh);
    } elsif ($^O eq 'VMS') {      # device and file ID are sufficient
      @okstat = (0, 1);
    } elsif ($^O eq 'dos') {
      @okstat = (0,2..7,11..$#fh);
    } elsif ($^O eq 'mpeix') {
      @okstat = (0..4,8..10);
    }
  
    # Now compare each entry explicitly by number
    for (@okstat) {
      print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
      # Use eq rather than == since rdev, blksize, and blocks (6, 11,
      # and 12) will be '' on platforms that do not support them.  This
      # is fine since we are only comparing integers.
      unless ($fh[$_] eq $path[$_]) {
        warn "Did not match $_ element of stat\n" if $DEBUG;
        return 0;
      }
    }
  
    return 1;
  }
  
  =item B<unlink1>
  
  Similar to C<unlink0> except after file comparison using cmpstat, the
  filehandle is closed prior to attempting to unlink the file. This
  allows the file to be removed without using an END block, but does
  mean that the post-unlink comparison of the filehandle state provided
  by C<unlink0> is not available.
  
    unlink1($fh, $path)
       or die "Error closing and unlinking file";
  
  Usually called from the object destructor when using the OO interface.
  
  Not exported by default.
  
  This function is disabled if the global variable $KEEP_ALL is true.
  
  Can call croak() if there is a security anomaly during the stat()
  comparison.
  
  =cut
  
  sub unlink1 {
    croak 'Usage: unlink1(filehandle, filename)'
      unless scalar(@_) == 2;
  
    # Read args
    my ($fh, $path) = @_;
  
    cmpstat($fh, $path) or return 0;
  
    # Close the file
    close( $fh ) or return 0;
  
    # Make sure the file is writable (for windows)
    _force_writable( $path );
  
    # return early (without unlink) if we have been instructed to retain files.
    return 1 if $KEEP_ALL;
  
    # remove the file
    return unlink($path);
  }
  
  =item B<cleanup>
  
  Calling this function will cause any temp files or temp directories
  that are registered for removal to be removed. This happens automatically
  when the process exits but can be triggered manually if the caller is sure
  that none of the temp files are required. This method can be registered as
  an Apache callback.
  
  On OSes where temp files are automatically removed when the temp file
  is closed, calling this function will have no effect other than to remove
  temporary directories (which may include temporary files).
  
    File::Temp::cleanup();
  
  Not exported by default.
  
  =back
  
  =head1 PACKAGE VARIABLES
  
  These functions control the global state of the package.
  
  =over 4
  
  =item B<safe_level>
  
  Controls the lengths to which the module will go to check the safety of the
  temporary file or directory before proceeding.
  Options are:
  
  =over 8
  
  =item STANDARD
  
  Do the basic security measures to ensure the directory exists and is
  writable, that temporary files are opened only if they do not already
  exist, and that possible race conditions are avoided.  Finally the
  L<unlink0|"unlink0"> function is used to remove files safely.
  
  =item MEDIUM
  
  In addition to the STANDARD security, the output directory is checked
  to make sure that it is owned either by root or the user running the
  program. If the directory is writable by group or by other, it is then
  checked to make sure that the sticky bit is set.
  
  Will not work on platforms that do not support the C<-k> test
  for sticky bit.
  
  =item HIGH
  
  In addition to the MEDIUM security checks, also check for the
  possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
  sysconf() function. If this is a possibility, each directory in the
  path is checked in turn for safeness, recursively walking back to the
  root directory.
  
  For platforms that do not support the L<POSIX|POSIX>
  C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
  assumed that ``chown() giveaway'' is possible and the recursive test
  is performed.
  
  =back
  
  The level can be changed as follows:
  
    File::Temp->safe_level( File::Temp::HIGH );
  
  The level constants are not exported by the module.
  
  Currently, you must be running at least perl v5.6.0 in order to
  run with MEDIUM or HIGH security. This is simply because the
  safety tests use functions from L<Fcntl|Fcntl> that are not
  available in older versions of perl. The problem is that the version
  number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
  they are different versions.
  
  On systems that do not support the HIGH or MEDIUM safety levels
  (for example Win NT or OS/2) any attempt to change the level will
  be ignored. The decision to ignore rather than raise an exception
  allows portable programs to be written with high security in mind
  for the systems that can support this without those programs failing
  on systems where the extra tests are irrelevant.
  
  If you really need to see whether the change has been accepted
  simply examine the return value of C<safe_level>.
  
    $newlevel = File::Temp->safe_level( File::Temp::HIGH );
    die "Could not change to high security"
        if $newlevel != File::Temp::HIGH;
  
  =cut
  
  {
    # protect from using the variable itself
    my $LEVEL = STANDARD;
    sub safe_level {
      my $self = shift;
      if (@_) {
        my $level = shift;
        if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
          carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
        } else {
          # Dont allow this on perl 5.005 or earlier
          if ($] < 5.006 && $level != STANDARD) {
            # Cant do MEDIUM or HIGH checks
            croak "Currently requires perl 5.006 or newer to do the safe checks";
          }
          # Check that we are allowed to change level
          # Silently ignore if we can not.
          $LEVEL = $level if _can_do_level($level);
        }
      }
      return $LEVEL;
    }
  }
  
  =item TopSystemUID
  
  This is the highest UID on the current system that refers to a root
  UID. This is used to make sure that the temporary directory is
  owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
  simply by root.
  
  This is required since on many unix systems C</tmp> is not owned
  by root.
  
  Default is to assume that any UID less than or equal to 10 is a root
  UID.
  
    File::Temp->top_system_uid(10);
    my $topid = File::Temp->top_system_uid;
  
  This value can be adjusted to reduce security checking if required.
  The value is only relevant when C<safe_level> is set to MEDIUM or higher.
  
  =cut
  
  {
    my $TopSystemUID = 10;
    $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
    sub top_system_uid {
      my $self = shift;
      if (@_) {
        my $newuid = shift;
        croak "top_system_uid: UIDs should be numeric"
          unless $newuid =~ /^\d+$/s;
        $TopSystemUID = $newuid;
      }
      return $TopSystemUID;
    }
  }
  
  =item B<$KEEP_ALL>
  
  Controls whether temporary files and directories should be retained
  regardless of any instructions in the program to remove them
  automatically.  This is useful for debugging but should not be used in
  production code.
  
    $File::Temp::KEEP_ALL = 1;
  
  Default is for files to be removed as requested by the caller.
  
  In some cases, files will only be retained if this variable is true
  when the file is created. This means that you can not create a temporary
  file, set this variable and expect the temp file to still be around
  when the program exits.
  
  =item B<$DEBUG>
  
  Controls whether debugging messages should be enabled.
  
    $File::Temp::DEBUG = 1;
  
  Default is for debugging mode to be disabled.
  
  =back
  
  =head1 WARNING
  
  For maximum security, endeavour always to avoid ever looking at,
  touching, or even imputing the existence of the filename.  You do not
  know that that filename is connected to the same file as the handle
  you have, and attempts to check this can only trigger more race
  conditions.  It's far more secure to use the filehandle alone and
  dispense with the filename altogether.
  
  If you need to pass the handle to something that expects a filename
  then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
  programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
  programs.  You will have to clear the close-on-exec bit on that file
  descriptor before passing it to another process.
  
      use Fcntl qw/F_SETFD F_GETFD/;
      fcntl($tmpfh, F_SETFD, 0)
          or die "Can't clear close-on-exec flag on temp fh: $!\n";
  
  =head2 Temporary files and NFS
  
  Some problems are associated with using temporary files that reside
  on NFS file systems and it is recommended that a local filesystem
  is used whenever possible. Some of the security tests will most probably
  fail when the temp file is not local. Additionally, be aware that
  the performance of I/O operations over NFS will not be as good as for
  a local disk.
  
  =head2 Forking
  
  In some cases files created by File::Temp are removed from within an
  END block. Since END blocks are triggered when a child process exits
  (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
  to only remove those temp files created by a particular process ID. This
  means that a child will not attempt to remove temp files created by the
  parent process.
  
  If you are forking many processes in parallel that are all creating
  temporary files, you may need to reset the random number seed using
  srand(EXPR) in each child else all the children will attempt to walk
  through the same set of random file names and may well cause
  themselves to give up if they exceed the number of retry attempts.
  
  =head2 Directory removal
  
  Note that if you have chdir'ed into the temporary directory and it is
  subsequently cleaned up (either in the END block or as part of object
  destruction), then you will get a warning from File::Path::rmtree().
  
  =head2 BINMODE
  
  The file returned by File::Temp will have been opened in binary mode
  if such a mode is available. If that is not correct, use the C<binmode()>
  function to change the mode of the filehandle.
  
  Note that you can modify the encoding of a file opened by File::Temp
  also by using C<binmode()>.
  
  =head1 HISTORY
  
  Originally began life in May 1999 as an XS interface to the system
  mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
  translated to Perl for total control of the code's
  security checking, to ensure the presence of the function regardless of
  operating system and to help with portability. The module was shipped
  as a standard part of perl from v5.6.1.
  
  =head1 SEE ALSO
  
  L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
  
  See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
  different implementations of temporary file handling.
  
  See L<File::Tempdir> for an alternative object-oriented wrapper for
  the C<tempdir> function.
  
  =head1 AUTHOR
  
  Tim Jenness E<lt>tjenness@cpan.orgE<gt>
  
  Copyright (C) 2007-2009 Tim Jenness.
  Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
  Astronomy Research Council. All Rights Reserved.  This program is free
  software; you can redistribute it and/or modify it under the same
  terms as Perl itself.
  
  Original Perl implementation loosely based on the OpenBSD C code for
  mkstemp(). Thanks to Tom Christiansen for suggesting that this module
  should be written and providing ideas for code improvements and
  security enhancements.
  
  =cut
  
  package File::Temp::Dir;
  
  use File::Path qw/ rmtree /;
  use strict;
  use overload '""' => "STRINGIFY", fallback => 1;
  
  # private class specifically to support tempdir objects
  # created by File::Temp->newdir
  
  # ostensibly the same method interface as File::Temp but without
  # inheriting all the IO::Seekable methods and other cruft
  
  # Read-only - returns the name of the temp directory
  
  sub dirname {
    my $self = shift;
    return $self->{DIRNAME};
  }
  
  sub STRINGIFY {
    my $self = shift;
    return $self->dirname;
  }
  
  sub unlink_on_destroy {
    my $self = shift;
    if (@_) {
      $self->{CLEANUP} = shift;
    }
    return $self->{CLEANUP};
  }
  
  sub DESTROY {
    my $self = shift;
    local($., $@, $!, $^E, $?);
    if ($self->unlink_on_destroy && 
        $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
      if (-d $self->{DIRNAME}) {
        # Some versions of rmtree will abort if you attempt to remove
        # the directory you are sitting in. We protect that and turn it
        # into a warning. We do this because this occurs during object
        # destruction and so can not be caught by the user.
        eval { rmtree($self->{DIRNAME}, $File::Temp::DEBUG, 0); };
        warn $@ if ($@ && $^W);
      }
    }
  }
  
  
  1;
FILE_TEMP

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

$fatpacked{"Getopt/Long.pm"} = <<'GETOPT_LONG';
  # Getopt::Long.pm -- Universal options parsing
  
  package Getopt::Long;
  
  # RCS Status      : $Id: Long.pm,v 2.76 2009/03/30 20:54:30 jv Exp $
  # Author          : Johan Vromans
  # Created On      : Tue Sep 11 15:00:12 1990
  # Last Modified By: Johan Vromans
  # Last Modified On: Mon Mar 30 22:51:17 2009
  # Update Count    : 1601
  # Status          : Released
  
  ################ Module Preamble ################
  
  use 5.004;
  
  use strict;
  
  use vars qw($VERSION);
  $VERSION        =  2.38;
  # For testing versions only.
  #use vars qw($VERSION_STRING);
  #$VERSION_STRING = "2.38";
  
  use Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK);
  @ISA = qw(Exporter);
  
  # Exported subroutines.
  sub GetOptions(@);		# always
  sub GetOptionsFromArray(@);	# on demand
  sub GetOptionsFromString(@);	# on demand
  sub Configure(@);		# on demand
  sub HelpMessage(@);		# on demand
  sub VersionMessage(@);		# in demand
  
  BEGIN {
      # Init immediately so their contents can be used in the 'use vars' below.
      @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
      @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
  		    &GetOptionsFromArray &GetOptionsFromString);
  }
  
  # User visible variables.
  use vars @EXPORT, @EXPORT_OK;
  use vars qw($error $debug $major_version $minor_version);
  # Deprecated visible variables.
  use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
  	    $passthrough);
  # Official invisible variables.
  use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
  
  # Public subroutines.
  sub config(@);			# deprecated name
  
  # Private subroutines.
  sub ConfigDefaults();
  sub ParseOptionSpec($$);
  sub OptCtl($);
  sub FindOption($$$$$);
  sub ValidValue ($$$$$);
  
  ################ Local Variables ################
  
  # $requested_version holds the version that was mentioned in the 'use'
  # or 'require', if any. It can be used to enable or disable specific
  # features.
  my $requested_version = 0;
  
  ################ Resident subroutines ################
  
  sub ConfigDefaults() {
      # Handle POSIX compliancy.
      if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  	$genprefix = "(--|-)";
  	$autoabbrev = 0;		# no automatic abbrev of options
  	$bundling = 0;			# no bundling of single letter switches
  	$getopt_compat = 0;		# disallow '+' to start options
  	$order = $REQUIRE_ORDER;
      }
      else {
  	$genprefix = "(--|-|\\+)";
  	$autoabbrev = 1;		# automatic abbrev of options
  	$bundling = 0;			# bundling off by default
  	$getopt_compat = 1;		# allow '+' to start options
  	$order = $PERMUTE;
      }
      # Other configurable settings.
      $debug = 0;			# for debugging
      $error = 0;			# error tally
      $ignorecase = 1;		# ignore case when matching options
      $passthrough = 0;		# leave unrecognized options alone
      $gnu_compat = 0;		# require --opt=val if value is optional
      $longprefix = "(--)";       # what does a long prefix look like
  }
  
  # Override import.
  sub import {
      my $pkg = shift;		# package
      my @syms = ();		# symbols to import
      my @config = ();		# configuration
      my $dest = \@syms;		# symbols first
      for ( @_ ) {
  	if ( $_ eq ':config' ) {
  	    $dest = \@config;	# config next
  	    next;
  	}
  	push(@$dest, $_);	# push
      }
      # Hide one level and call super.
      local $Exporter::ExportLevel = 1;
      push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
      $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;
  
      # 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::GetOptions (@_);
      };
  
      # Restore saved settings.
      Getopt::Long::Configure ($save);
  
      # Handle errors and return value.
      die ($@) if $@;
      return $ret;
  }
  
  package Getopt::Long;
  
  ################ Back to Normal ################
  
  # Indices in option control info.
  # Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
  use constant CTL_TYPE    => 0;
  #use constant   CTL_TYPE_FLAG   => '';
  #use constant   CTL_TYPE_NEG    => '!';
  #use constant   CTL_TYPE_INCR   => '+';
  #use constant   CTL_TYPE_INT    => 'i';
  #use constant   CTL_TYPE_INTINC => 'I';
  #use constant   CTL_TYPE_XINT   => 'o';
  #use constant   CTL_TYPE_FLOAT  => 'f';
  #use constant   CTL_TYPE_STRING => 's';
  
  use constant CTL_CNAME   => 1;
  
  use constant CTL_DEFAULT => 2;
  
  use constant CTL_DEST    => 3;
   use constant   CTL_DEST_SCALAR => 0;
   use constant   CTL_DEST_ARRAY  => 1;
   use constant   CTL_DEST_HASH   => 2;
   use constant   CTL_DEST_CODE   => 3;
  
  use constant CTL_AMIN    => 4;
  use constant CTL_AMAX    => 5;
  
  # FFU.
  #use constant CTL_RANGE   => ;
  #use constant CTL_REPEAT  => ;
  
  # Rather liberal patterns to match numbers.
  use constant PAT_INT   => "[-+]?_*[0-9][0-9_]*";
  use constant PAT_XINT  =>
    "(?:".
  	  "[-+]?_*[1-9][0-9_]*".
    "|".
  	  "0x_*[0-9a-f][0-9a-f_]*".
    "|".
  	  "0b_*[01][01_]*".
    "|".
  	  "0[0-7_]*".
    ")";
  use constant PAT_FLOAT => "[-+]?[0-9._]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
  
  sub GetOptions(@) {
      # Shift in default array.
      unshift(@_, \@ARGV);
      # Try to keep caller() and Carp consitent.
      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 (",
  	   '$Revision: 2.76 $', ") ",
  	   "called from package \"$pkg\".",
  	   "\n  ",
  	   "argv: (@$argv)",
  	   "\n  ",
  	   "autoabbrev=$autoabbrev,".
  	   "bundling=$bundling,",
  	   "getopt_compat=$getopt_compat,",
  	   "gnu_compat=$gnu_compat,",
  	   "order=$order,",
  	   "\n  ",
  	   "ignorecase=$ignorecase,",
  	   "requested_version=$requested_version,",
  	   "passthrough=$passthrough,",
  	   "genprefix=\"$genprefix\",",
  	   "longprefix=\"$longprefix\".",
  	   "\n");
      }
  
      # Check for ref HASH as first argument.
      # First argument may be an object. It's OK to use this as long
      # as it is really a hash underneath.
      $userlinkage = undef;
      if ( @optionlist && ref($optionlist[0]) and
  	 UNIVERSAL::isa($optionlist[0],'HASH') ) {
  	$userlinkage = shift (@optionlist);
  	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
      }
  
      # See if the first element of the optionlist contains option
      # starter characters.
      # Be careful not to interpret '<>' as option starters.
      if ( @optionlist && $optionlist[0] =~ /^\W+$/
  	 && !($optionlist[0] eq '<>'
  	      && @optionlist > 0
  	      && ref($optionlist[1])) ) {
  	$prefix = shift (@optionlist);
  	# Turn into regexp. Needs to be parenthesized!
  	$prefix =~ s/(\W)/\\$1/g;
  	$prefix = "([" . $prefix . "])";
  	print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
      }
  
      # Verify correctness of optionlist.
      %opctl = ();
      while ( @optionlist ) {
  	my $opt = shift (@optionlist);
  
  	unless ( defined($opt) ) {
  	    $error .= "Undefined argument in option spec\n";
  	    next;
  	}
  
  	# Strip leading prefix so people can specify "--foo=i" if they like.
  	$opt = $+ if $opt =~ /^$prefix+(.*)$/s;
  
  	if ( $opt eq '<>' ) {
  	    if ( (defined $userlinkage)
  		&& !(@optionlist > 0 && ref($optionlist[0]))
  		&& (exists $userlinkage->{$opt})
  		&& ref($userlinkage->{$opt}) ) {
  		unshift (@optionlist, $userlinkage->{$opt});
  	    }
  	    unless ( @optionlist > 0
  		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
  		$error .= "Option spec <> requires a reference to a subroutine\n";
  		# Kill the linkage (to avoid another error).
  		shift (@optionlist)
  		  if @optionlist && ref($optionlist[0]);
  		next;
  	    }
  	    $linkage{'<>'} = shift (@optionlist);
  	    next;
  	}
  
  	# Parse option spec.
  	my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
  	unless ( defined $name ) {
  	    # Failed. $orig contains the error message. Sorry for the abuse.
  	    $error .= $orig;
  	    # Kill the linkage (to avoid another error).
  	    shift (@optionlist)
  	      if @optionlist && ref($optionlist[0]);
  	    next;
  	}
  
  	# If no linkage is supplied in the @optionlist, copy it from
  	# the userlinkage if available.
  	if ( defined $userlinkage ) {
  	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
  		if ( exists $userlinkage->{$orig} &&
  		     ref($userlinkage->{$orig}) ) {
  		    print STDERR ("=> found userlinkage for \"$orig\": ",
  				  "$userlinkage->{$orig}\n")
  			if $debug;
  		    unshift (@optionlist, $userlinkage->{$orig});
  		}
  		else {
  		    # Do nothing. Being undefined will be handled later.
  		    next;
  		}
  	    }
  	}
  
  	# Copy the linkage. If omitted, link to global variable.
  	if ( @optionlist > 0 && ref($optionlist[0]) ) {
  	    print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
  		if $debug;
  	    my $rl = ref($linkage{$orig} = shift (@optionlist));
  
  	    if ( $rl eq "ARRAY" ) {
  		$opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
  	    }
  	    elsif ( $rl eq "HASH" ) {
  		$opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
  	    }
  	    elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
  #		if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
  #		    my $t = $linkage{$orig};
  #		    $$t = $linkage{$orig} = [];
  #		}
  #		elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
  #		}
  #		else {
  		    # Ok.
  #		}
  	    }
  	    elsif ( $rl eq "CODE" ) {
  		# Ok.
  	    }
  	    else {
  		$error .= "Invalid option linkage for \"$opt\"\n";
  	    }
  	}
  	else {
  	    # Link to global $opt_XXX variable.
  	    # Make sure a valid perl identifier results.
  	    my $ov = $orig;
  	    $ov =~ s/\W/_/g;
  	    if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
  		print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
  	    }
  	    elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
  		print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
  	    }
  	    else {
  		print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
  	    }
  	}
  
  	if ( $opctl{$name}[CTL_TYPE] eq 'I'
  	     && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
  		  || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
  	   ) {
  	    $error .= "Invalid option linkage for \"$opt\"\n";
  	}
  
      }
  
      # Bail out if errors found.
      die ($error) if $error;
      $error = 0;
  
      # Supply --version and --help support, if needed and allowed.
      if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
  	if ( !defined($opctl{version}) ) {
  	    $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
  	    $linkage{version} = \&VersionMessage;
  	}
  	$auto_version = 1;
      }
      if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
  	if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
  	    $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
  	    $linkage{help} = \&HelpMessage;
  	}
  	$auto_help = 1;
      }
  
      # Show the options tables if debugging.
      if ( $debug ) {
  	my ($arrow, $k, $v);
  	$arrow = "=> ";
  	while ( ($k,$v) = each(%opctl) ) {
  	    print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
  	    $arrow = "   ";
  	}
      }
  
      # Process argument list
      my $goon = 1;
      while ( $goon && @$argv > 0 ) {
  
  	# Get next argument.
  	$opt = shift (@$argv);
  	print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
  
  	# Double dash is option list terminator.
  	if ( $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);
  			    $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIo]$/;
  			    ($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);
  		    $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIo]$/;
  		    ($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 {
  			&$cb
  			  (Getopt::Long::CallBack->new
  			   (name    => $tryopt,
  			    ctl     => $ctl,
  			    opctl   => \%opctl,
  			    linkage => \%linkage,
  			    prefix  => $prefix,
  			   ));
  		    };
  		    $@;
  		};
  		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]* ) )*
  		   )?
  		   (
  		     # 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 $opt =~ /^$prefix(.*)$/s;
      return (0) if $opt eq "-" && !defined $opctl->{''};
  
      $opt = $+;
      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)))
  	  && $opt =~ /^([^=]+)=(.*)$/s ) {
  	$opt = $1;
  	$optarg = $2;
  	print STDERR ("=> option \"", $opt,
  		      "\", optarg = \"$optarg\"\n") if $debug;
      }
  
      #### Look it up ###
  
      my $tryopt = $opt;		# option to try
  
      if ( $bundling && $starter eq '-' ) {
  
  	# To try overrides, obey case ignore.
  	$tryopt = $ignorecase ? lc($opt) : $opt;
  
  	# If bundling == 2, long options can override bundles.
  	if ( $bundling == 2 && length($tryopt) > 1
  	     && defined ($opctl->{$tryopt}) ) {
  	    print STDERR ("=> $starter$tryopt overrides unbundling\n")
  	      if $debug;
  	}
  	else {
  	    $tryopt = $opt;
  	    # Unbundle single letter option.
  	    $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
  	    $tryopt = substr ($tryopt, 0, 1);
  	    $tryopt = lc ($tryopt) if $ignorecase > 1;
  	    print STDERR ("=> $starter$tryopt unbundled from ",
  			  "$starter$tryopt$rest\n") if $debug;
  	    $rest = undef unless $rest ne '';
  	}
      }
  
      # Try auto-abbreviation.
      elsif ( $autoabbrev && $opt ne "" ) {
  	# Sort the possible long option names.
  	my @names = sort(keys (%$opctl));
  	# Downcase if allowed.
  	$opt = lc ($opt) if $ignorecase;
  	$tryopt = $opt;
  	# Turn option name into pattern.
  	my $pat = quotemeta ($opt);
  	# Look up in option names.
  	my @hits = grep (/^$pat/, @names);
  	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
  		      "out of ", scalar(@names), "\n") if $debug;
  
  	# Check for ambiguous results.
  	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
  	    # See if all matches are for the same option.
  	    my %hit;
  	    foreach ( @hits ) {
  		my $hit = $_;
  		$hit = $opctl->{$hit}->[CTL_CNAME]
  		  if defined $opctl->{$hit}->[CTL_CNAME];
  		$hit{$hit} = 1;
  	    }
  	    # Remove auto-supplied options (version, help).
  	    if ( keys(%hit) == 2 ) {
  		if ( $auto_version && exists($hit{version}) ) {
  		    delete $hit{version};
  		}
  		elsif ( $auto_help && exists($hit{help}) ) {
  		    delete $hit{help};
  		}
  	    }
  	    # Now see if it really is ambiguous.
  	    unless ( keys(%hit) == 1 ) {
  		return (0) if $passthrough;
  		warn ("Option ", $opt, " is ambiguous (",
  		      join(", ", @hits), ")\n");
  		$error++;
  		return (1, undef);
  	    }
  	    @hits = keys(%hit);
  	}
  
  	# Complete the option name, if appropriate.
  	if ( @hits == 1 && $hits[0] ne $opt ) {
  	    $tryopt = $hits[0];
  	    $tryopt = lc ($tryopt) if $ignorecase;
  	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
  		if $debug;
  	}
      }
  
      # Map to all lowercase if ignoring case.
      elsif ( $ignorecase ) {
  	$tryopt = lc ($opt);
      }
  
      # Check validity by fetching the info.
      my $ctl = $opctl->{$tryopt};
      unless  ( defined $ctl ) {
  	return (0) if $passthrough;
  	# Pretend one char when bundling.
  	if ( $bundling == 1 && length($starter) == 1 ) {
  	    $opt = substr($opt,0,1);
              unshift (@$argv, $starter.$rest) if defined $rest;
  	}
  	if ( $opt eq "" ) {
  	    warn ("Missing option after ", $starter, "\n");
  	}
  	else {
  	    warn ("Unknown option: ", $opt, "\n");
  	}
  	$error++;
  	return (1, undef);
      }
      # Apparently valid.
      $opt = $tryopt;
      print STDERR ("=> found ", OptCtl($ctl),
  		  " for \"", $opt, "\"\n") if $debug;
  
      #### Determine argument status ####
  
      # If it is an option w/o argument, we're almost finished with it.
      my $type = $ctl->[CTL_TYPE];
      my $arg;
  
      if ( $type eq '' || $type eq '!' || $type eq '+' ) {
  	if ( defined $optarg ) {
  	    return (0) if $passthrough;
  	    warn ("Option ", $opt, " does not take an argument\n");
  	    $error++;
  	    undef $opt;
  	}
  	elsif ( $type eq '' || $type eq '+' ) {
  	    # Supply explicit value.
  	    $arg = 1;
  	}
  	else {
  	    $opt =~ s/^no-?//i;	# strip NO prefix
  	    $arg = 0;		# supply explicit value
  	}
  	unshift (@$argv, $starter.$rest) if defined $rest;
  	return (1, $opt, $ctl, $arg);
      }
  
      # Get mandatory status and type info.
      my $mand = $ctl->[CTL_AMIN];
  
      # Check if there is an option argument available.
      if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
  	return (1, $opt, $ctl, $type eq 's' ? '' : 0) ;#unless $mand;
  	$optarg = 0 unless $type eq 's';
      }
  
      # Check if there is an option argument available.
      if ( defined $optarg
  	 ? ($optarg eq '')
  	 : !(defined $rest || @$argv > 0) ) {
  	# Complain if this option needs an argument.
  #	if ( $mand && !($type eq 's' ? defined($optarg) : 0) ) {
  	if ( $mand ) {
  	    return (0) if $passthrough;
  	    warn ("Option ", $opt, " requires an argument\n");
  	    $error++;
  	    return (1, undef);
  	}
  	if ( $type eq 'I' ) {
  	    # Fake incremental type.
  	    my @c = @$ctl;
  	    $c[CTL_TYPE] = '+';
  	    return (1, $opt, \@c, 1);
  	}
  	return (1, $opt, $ctl,
  		defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
  		$type eq 's' ? '' : 0);
      }
  
      # Get (possibly optional) argument.
      $arg = (defined $rest ? $rest
  	    : (defined $optarg ? $optarg : shift (@$argv)));
  
      # Get key if this is a "name=value" pair for a hash option.
      my $key;
      if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
  	($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
  	  : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
  	     ($mand ? undef : ($type eq 's' ? "" : 1)));
  	if (! defined $arg) {
  	    warn ("Option $opt, key \"$key\", requires a value\n");
  	    $error++;
  	    # Push back.
  	    unshift (@$argv, $starter.$rest) if defined $rest;
  	    return (1, undef);
  	}
      }
  
      #### Check if the argument is valid for this option ####
  
      my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
  
      if ( $type eq 's' ) {	# string
  	# A mandatory string takes anything.
  	return (1, $opt, $ctl, $arg, $key) if $mand;
  
  	# Same for optional string as a hash value
  	return (1, $opt, $ctl, $arg, $key)
  	  if $ctl->[CTL_DEST] == CTL_DEST_HASH;
  
  	# An optional string takes almost anything.
  	return (1, $opt, $ctl, $arg, $key)
  	  if defined $optarg || defined $rest;
  	return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
  
  	# Check for option or option list terminator.
  	if ($arg eq $argend ||
  	    $arg =~ /^$prefix.+/) {
  	    # Push back.
  	    unshift (@$argv, $arg);
  	    # Supply empty value.
  	    $arg = '';
  	}
      }
  
      elsif ( $type eq 'i'	# numeric/integer
              || $type eq 'I'	# numeric/integer w/ incr default
  	    || $type eq 'o' ) { # dec/oct/hex/bin value
  
  	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
  
  	if ( $bundling && defined $rest
  	     && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
  	    ($key, $arg, $rest) = ($1, $2, $+);
  	    chop($key) if $key;
  	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
  	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
  	}
  	elsif ( $arg =~ /^$o_valid$/si ) {
  	    $arg =~ tr/_//d;
  	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
  	}
  	else {
  	    if ( defined $optarg || $mand ) {
  		if ( $passthrough ) {
  		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
  		      unless defined $optarg;
  		    return (0);
  		}
  		warn ("Value \"", $arg, "\" invalid for option ",
  		      $opt, " (",
  		      $type eq 'o' ? "extended " : '',
  		      "number expected)\n");
  		$error++;
  		# Push back.
  		unshift (@$argv, $starter.$rest) if defined $rest;
  		return (1, undef);
  	    }
  	    else {
  		# Push back.
  		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
  		if ( $type eq 'I' ) {
  		    # Fake incremental type.
  		    my @c = @$ctl;
  		    $c[CTL_TYPE] = '+';
  		    return (1, $opt, \@c, 1);
  		}
  		# Supply default value.
  		$arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
  	    }
  	}
      }
  
      elsif ( $type eq 'f' ) { # real number, int is also ok
  	# We require at least one digit before a point or 'e',
  	# and at least one digit following the point and 'e'.
  	# [-]NN[.NN][eNN]
  	my $o_valid = PAT_FLOAT;
  	if ( $bundling && defined $rest &&
  	     $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
  	    $arg =~ tr/_//d;
  	    ($key, $arg, $rest) = ($1, $2, $+);
  	    chop($key) if $key;
  	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
  	}
  	elsif ( $arg =~ /^$o_valid$/ ) {
  	    $arg =~ tr/_//d;
  	}
  	else {
  	    if ( defined $optarg || $mand ) {
  		if ( $passthrough ) {
  		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
  		      unless defined $optarg;
  		    return (0);
  		}
  		warn ("Value \"", $arg, "\" invalid for option ",
  		      $opt, " (real number expected)\n");
  		$error++;
  		# Push back.
  		unshift (@$argv, $starter.$rest) if defined $rest;
  		return (1, undef);
  	    }
  	    else {
  		# Push back.
  		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
  		# Supply default value.
  		$arg = 0.0;
  	    }
  	}
      }
      else {
  	die("Getopt::Long internal error (Can't happen)\n");
      }
      return (1, $opt, $ctl, $arg, $key);
  }
  
  sub ValidValue ($$$$$) {
      my ($ctl, $arg, $mand, $argend, $prefix) = @_;
  
      if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  	return 0 unless $arg =~ /[^=]+=(.*)/;
  	$arg = $1;
      }
  
      my $type = $ctl->[CTL_TYPE];
  
      if ( $type eq 's' ) {	# string
  	# A mandatory string takes anything.
  	return (1) if $mand;
  
  	return (1) if $arg eq "-";
  
  	# Check for option or option list terminator.
  	return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
  	return 1;
      }
  
      elsif ( $type eq 'i'	# numeric/integer
              || $type eq 'I'	# numeric/integer w/ incr default
  	    || $type eq 'o' ) { # dec/oct/hex/bin value
  
  	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
  	return $arg =~ /^$o_valid$/si;
      }
  
      elsif ( $type eq 'f' ) { # real number, int is also ok
  	# We require at least one digit before a point or 'e',
  	# and at least one digit following the point and 'e'.
  	# [-]NN[.NN][eNN]
  	my $o_valid = PAT_FLOAT;
  	return $arg =~ /^$o_valid$/;
      }
      die("ValidValue: Cannot happen\n");
  }
  
  # Getopt::Long Configuration.
  sub Configure (@) {
      my (@options) = @_;
  
      my $prevconfig =
        [ $error, $debug, $major_version, $minor_version,
  	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
  	$longprefix ];
  
      if ( ref($options[0]) eq 'ARRAY' ) {
  	( $error, $debug, $major_version, $minor_version,
  	  $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  	  $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
  	  $longprefix ) = @{shift(@options)};
      }
  
      my $opt;
      foreach $opt ( @options ) {
  	my $try = lc ($opt);
  	my $action = 1;
  	if ( $try =~ /^no_?(.*)$/s ) {
  	    $action = 0;
  	    $try = $+;
  	}
  	if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
  	    ConfigDefaults ();
  	}
  	elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
  	    local $ENV{POSIXLY_CORRECT};
  	    $ENV{POSIXLY_CORRECT} = 1 if $action;
  	    ConfigDefaults ();
  	}
  	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
  	    $autoabbrev = $action;
  	}
  	elsif ( $try eq 'getopt_compat' ) {
  	    $getopt_compat = $action;
              $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
  	}
  	elsif ( $try eq 'gnu_getopt' ) {
  	    if ( $action ) {
  		$gnu_compat = 1;
  		$bundling = 1;
  		$getopt_compat = 0;
                  $genprefix = "(--|-)";
  		$order = $PERMUTE;
  	    }
  	}
  	elsif ( $try eq 'gnu_compat' ) {
  	    $gnu_compat = $action;
  	}
  	elsif ( $try =~ /^(auto_?)?version$/ ) {
  	    $auto_version = $action;
  	}
  	elsif ( $try =~ /^(auto_?)?help$/ ) {
  	    $auto_help = $action;
  	}
  	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
  	    $ignorecase = $action;
  	}
  	elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
  	    $ignorecase = $action ? 2 : 0;
  	}
  	elsif ( $try eq 'bundling' ) {
  	    $bundling = $action;
  	}
  	elsif ( $try eq 'bundling_override' ) {
  	    $bundling = $action ? 2 : 0;
  	}
  	elsif ( $try eq 'require_order' ) {
  	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
  	}
  	elsif ( $try eq 'permute' ) {
  	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
  	}
  	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
  	    $passthrough = $action;
  	}
  	elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
  	    $genprefix = $1;
  	    # Turn into regexp. Needs to be parenthesized!
  	    $genprefix = "(" . quotemeta($genprefix) . ")";
  	    eval { '' =~ /$genprefix/; };
  	    die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  	}
  	elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
  	    $genprefix = $1;
  	    # Parenthesize if needed.
  	    $genprefix = "(" . $genprefix . ")"
  	      unless $genprefix =~ /^\(.*\)$/;
  	    eval { '' =~ m"$genprefix"; };
  	    die("Getopt::Long: invalid pattern \"$genprefix\"") 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\"") if $@;
  	}
  	elsif ( $try eq 'debug' ) {
  	    $debug = $action;
  	}
  	else {
  	    die("Getopt::Long: unknown config parameter \"$opt\"")
  	}
      }
      $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;
    $result = GetOptions ("length=i" => \$length,    # numeric
                          "file=s"   => \$data,      # string
  			"verbose"  => \$verbose);  # flag
  
  =head1 DESCRIPTION
  
  The Getopt::Long module implements an extended getopt function called
  GetOptions(). 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, hence the name Getopt::Long. This module also
  supports single-character options and bundling. Single character
  options may be any alphabetic character, a question mark, and a dash.
  Long options may consist of a series of letters, digits, and dashes.
  Although this is currently not enforced by Getopt::Long, multiple
  consecutive dashes are not allowed, and the option name must not end
  with a dash.
  
  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 to
  STDERR, and return a false result.
  
  =head2 A little bit less simple options
  
  Getopt::Long supports two useful variants of simple options:
  I<negatable> options and I<incremental> options.
  
  A negatable option is specified with an exclamation mark C<!> after the
  option name:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose!' => \$verbose);
  
  Now, using C<--verbose> on the command line will enable C<$verbose>,
  as expected. But it is also allowed to use C<--noverbose>, which will
  disable C<$verbose> by setting its value to C<0>. Using a suitable
  default value, the program can find out whether C<$verbose> is false
  by default, or disabled by using C<--noverbose>.
  
  An incremental option is specified with a plus C<+> after the
  option name:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose+' => \$verbose);
  
  Using C<--verbose> on the command line will increment the value of
  C<$verbose>. This way the program can keep track of how many times the
  option occurred on the command line. For example, each occurrence of
  C<--verbose> could increase the verbosity level of the program.
  
  =head2 Mixing command line option with other arguments
  
  Usually programs take command line options as well as other arguments,
  for example, file names. It is good practice to always specify the
  options first, and the other arguments last. Getopt::Long will,
  however, allow the options and arguments to be mixed and 'filter out'
  all the options before passing the rest of the arguments to the
  program. To stop Getopt::Long from processing further arguments,
  insert a double dash C<--> on the command line:
  
      --size 24 -- --all
  
  In this example, C<--all> will I<not> be treated as an option, but
  passed to the program unharmed, in C<@ARGV>.
  
  =head2 Options with values
  
  For options that take values it must be specified whether the option
  value is required or not, and what kind of value the option expects.
  
  Three kinds of values are supported: integer numbers, floating point
  numbers, and strings.
  
  If the option value is required, Getopt::Long will take the
  command line argument that follows the option and assign this to the
  option variable. If, however, the option value is specified as
  optional, this will only be done if that value does not look like a
  valid command line option itself.
  
      my $tag = '';	# option variable with default value
      GetOptions ('tag=s' => \$tag);
  
  In the option specification, the option name is followed by an equals
  sign C<=> and the letter C<s>. The equals sign indicates that this
  option requires a value. The letter C<s> indicates that this value is
  an arbitrary string. Other possible value types are C<i> for integer
  values, and C<f> for floating point values. Using a colon C<:> instead
  of the equals sign indicates that the option value is optional. In
  this case, if no suitable value is supplied, string valued options get
  an empty string C<''> assigned, while numeric options are set to C<0>.
  
  =head2 Options with multiple values
  
  Options sometimes take several values. For example, a program could
  use multiple directories to search for library files:
  
      --library lib/stdlib --library lib/extlib
  
  To accomplish this behaviour, simply specify an array reference as the
  destination for the option:
  
      GetOptions ("library=s" => \@libfiles);
  
  Alternatively, you can specify that the option can have multiple
  values by adding a "@", and pass a scalar reference as the
  destination:
  
      GetOptions ("library=s@" => \$libfiles);
  
  Used with the example above, C<@libfiles> (or C<@$libfiles>) would
  contain two strings upon completion: C<"lib/srdlib"> 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{,}> 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 arguments 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.
  
  =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 = new Getopt::Long::Parser;
      $p->configure(...configuration options...);
      if ($p->getoptions(...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(-exitstatus => 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, the global C<@ARGV> is not touched at all.
  
  The following two calls behave identically:
  
      $ret = GetOptions( ... );
      $ret = GetOptionsFromArray(\@ARGV, ... );
  
  =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.
  
  =head2 Storing options values in a hash
  
  Sometimes, for example when there are a lot of options, having a
  separate variable for each of them can be cumbersome. GetOptions()
  supports, as an alternative mechanism, storing options values in a
  hash.
  
  To obtain this, a reference to a hash must be passed I<as the first
  argument> to GetOptions(). For each option that is specified on the
  command line, the option value will be stored in the hash with the
  option name as key. Options that are not actually used on the command
  line will not be put in the hash, on other words,
  C<exists($h{option})> (or defined()) can be used to test if an option
  was used. The drawback is that warnings will be issued if the program
  runs under C<use strict> and uses C<$h{option}> without testing with
  exists() or defined() first.
  
      my %h = ();
      GetOptions (\%h, 'length=i');	# will store in $h{length}
  
  For options that take list or hash values, it is necessary to indicate
  this by appending an C<@> or C<%> sign after the type:
  
      GetOptions (\%h, 'colours=s@');	# will push to @{$h{colours}}
  
  To make things more complicated, the hash may contain references to
  the actual destinations, for example:
  
      my $len = 0;
      my %h = ('length' => \$len);
      GetOptions (\%h, 'length=i');	# will store in $len
  
  This example is fully equivalent with:
  
      my $len = 0;
      GetOptions ('length=i' => \$len);	# will store in $len
  
  Any mixture is possible. For example, the most frequently used options
  could be stored in variables while all other options get stored in the
  hash:
  
      my $verbose = 0;			# frequently referred
      my $debug = 0;			# frequently referred
      my %h = ('verbose' => \$verbose, 'debug' => \$debug);
      GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
      if ( $verbose ) { ... }
      if ( exists $h{filter} ) { ... option 'filter' was specified ... }
  
  =head2 Bundling
  
  With bundling it is possible to set several single-character options
  at once. For example if C<a>, C<v> and C<x> are all valid options,
  
      -vax
  
  would set all three.
  
  Getopt::Long supports two levels of bundling. To enable bundling, a
  call to Getopt::Long::Configure is required.
  
  The first level of bundling can be enabled with:
  
      Getopt::Long::Configure ("bundling");
  
  Configured this way, single-character options can be bundled but long
  options B<must> always start with a double dash C<--> to avoid
  ambiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
  options,
  
      -vax
  
  would set C<a>, C<v> and C<x>, but
  
      --vax
  
  would set C<vax>.
  
  The second level of bundling lifts this restriction. It can be enabled
  with:
  
      Getopt::Long::Configure ("bundling_override");
  
  Now, C<-vax> would set the option C<vax>.
  
  When any level of bundling is enabled, option values may be inserted
  in the bundle. For example:
  
      -h24w80
  
  is equivalent to
  
      -h 24 -w 80
  
  When configured for bundling, single-character options are matched
  case sensitive while long options are matched case insensitive. To
  have the single-character options matched case insensitive as well,
  use:
  
      Getopt::Long::Configure ("bundling", "ignorecase_always");
  
  It goes without saying that bundling can be quite confusing.
  
  =head2 The lonesome dash
  
  Normally, a lone dash C<-> on the command line will not be considered
  an option. Option processing will terminate (unless "permute" is
  configured) and the dash will be left in C<@ARGV>.
  
  It is possible to get special treatment for a lone dash. This can be
  achieved by adding an option specification with an empty name, for
  example:
  
      GetOptions ('' => \$stdio);
  
  A lone dash on the command line will now be a legal option, and using
  it will set variable C<$stdio>.
  
  =head2 Argument callback
  
  A special option 'name' C<< <> >> can be used to designate a subroutine
  to handle non-option arguments. When GetOptions() encounters an
  argument that does not look like an option, it will immediately call this
  subroutine and passes it one parameter: the argument name. Well, actually
  it is an object that stringifies to the argument name.
  
  For example:
  
      my $width = 80;
      sub process { ... }
      GetOptions ('width=i' => \$width, '<>' => \&process);
  
  When applied to the following command line:
  
      arg1 --width=72 arg2 --width=60 arg3
  
  This will call
  C<process("arg1")> while C<$width> is C<80>,
  C<process("arg2")> while C<$width> is C<72>, and
  C<process("arg3")> while C<$width> is C<60>.
  
  This feature requires configuration option B<permute>, see section
  L<Configuring Getopt::Long>.
  
  =head1 Configuring Getopt::Long
  
  Getopt::Long can be configured by calling subroutine
  Getopt::Long::Configure(). This subroutine takes a list of quoted
  strings, each specifying a configuration option to be enabled, e.g.
  C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
  matter. Multiple calls to Configure() are possible.
  
  Alternatively, as of version 2.24, the configuration options may be
  passed together with the C<use> statement:
  
      use Getopt::Long qw(:config no_ignore_case bundling);
  
  The following options are available:
  
  =over 12
  
  =item default
  
  This option causes all configuration options to be reset to their
  default values.
  
  =item posix_default
  
  This option causes all configuration options to be reset to their
  default values as if the environment variable POSIXLY_CORRECT had
  been set.
  
  =item auto_abbrev
  
  Allow option names to be abbreviated to uniqueness.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
  
  =item getopt_compat
  
  Allow C<+> to start options.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
  
  =item gnu_compat
  
  C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
  do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
  C<--opt=> will give option C<opt> and empty value.
  This is the way GNU getopt_long() does it.
  
  =item gnu_getopt
  
  This is a short way of setting C<gnu_compat> C<bundling> C<permute>
  C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
  fully compatible with GNU getopt_long().
  
  =item require_order
  
  Whether command line arguments are allowed to be mixed with options.
  Default is disabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
  
  See also C<permute>, which is the opposite of C<require_order>.
  
  =item permute
  
  Whether command line arguments are allowed to be mixed with options.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
  Note that C<permute> is the opposite of C<require_order>.
  
  If C<permute> is enabled, this means that
  
      --foo arg1 --bar arg2 arg3
  
  is equivalent to
  
      --foo --bar arg1 arg2 arg3
  
  If an argument callback routine is specified, C<@ARGV> will always be
  empty upon successful return of GetOptions() since all options have been
  processed. The only exception is when C<--> is used:
  
      --foo arg1 --bar arg2 -- arg3
  
  This will call the callback routine for arg1 and arg2, and then
  terminate GetOptions() leaving C<"arg3"> in C<@ARGV>.
  
  If C<require_order> is enabled, options processing
  terminates when the first non-option is encountered.
  
      --foo arg1 --bar arg2 arg3
  
  is equivalent to
  
      --foo -- arg1 --bar arg2 arg3
  
  If C<pass_through> is also enabled, options processing will terminate
  at the first unrecognized option, or non-option, whichever comes
  first.
  
  =item bundling (default: disabled)
  
  Enabling this option will allow single-character options to be
  bundled. To distinguish bundles from long option names, long options
  I<must> be introduced with C<--> and bundles with C<->.
  
  Note that, if you have options C<a>, C<l> and C<all>, and
  auto_abbrev enabled, possible arguments and option settings are:
  
      using argument               sets option(s)
      ------------------------------------------
      -a, --a                      a
      -l, --l                      l
      -al, -la, -ala, -all,...     a, l
      --al, --all                  all
  
  The surprising part is that C<--a> sets option C<a> (due to auto
  completion), not C<all>.
  
  Note: disabling C<bundling> also disables C<bundling_override>.
  
  =item bundling_override (default: disabled)
  
  If C<bundling_override> is enabled, bundling is enabled as with
  C<bundling> but now long option names override option bundles.
  
  Note: disabling C<bundling_override> also disables C<bundling>.
  
  B<Note:> Using option bundling can easily lead to unexpected results,
  especially when mixing long options and bundles. Caveat emptor.
  
  =item ignore_case  (default: enabled)
  
  If enabled, case is ignored when matching long option names. If,
  however, bundling is enabled as well, single character options will be
  treated case-sensitive.
  
  With C<ignore_case>, option specifications for options that only
  differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
  duplicates.
  
  Note: disabling C<ignore_case> also disables C<ignore_case_always>.
  
  =item ignore_case_always (default: disabled)
  
  When bundling is in effect, case is ignored on single-character
  options also.
  
  Note: disabling C<ignore_case_always> also disables C<ignore_case>.
  
  =item auto_version (default:disabled)
  
  Automatically provide support for the B<--version> option if
  the application did not specify a handler for this option itself.
  
  Getopt::Long will provide a standard version message that includes the
  program name, its version (if $main::VERSION is defined), and the
  versions of Getopt::Long and Perl. The message will be written to
  standard output and processing will terminate.
  
  C<auto_version> will be enabled if the calling program explicitly
  specified a version number higher than 2.32 in the C<use> or
  C<require> statement.
  
  =item auto_help (default:disabled)
  
  Automatically provide support for the B<--help> and B<-?> options if
  the application did not specify a handler for this option itself.
  
  Getopt::Long will provide a help message using module L<Pod::Usage>. The
  message, derived from the SYNOPSIS POD section, will be written to
  standard output and processing will terminate.
  
  C<auto_help> will be enabled if the calling program explicitly
  specified a version number higher than 2.32 in the C<use> or
  C<require> statement.
  
  =item pass_through (default: disabled)
  
  Options that are unknown, ambiguous or supplied with an invalid option
  value are passed through in C<@ARGV> instead of being flagged as
  errors. This makes it possible to write wrapper scripts that process
  only part of the user supplied command line arguments, and pass the
  remaining options to some other program.
  
  If C<require_order> is enabled, options processing will terminate at
  the first unrecognized option, or non-option, whichever comes first.
  However, if C<permute> is enabled instead, results can become confusing.
  
  Note that the options terminator (default C<-->), if present, will
  also be passed through in C<@ARGV>.
  
  =item prefix
  
  The string that starts options. If a constant string is not
  sufficient, see C<prefix_pattern>.
  
  =item prefix_pattern
  
  A Perl pattern that identifies the strings that introduce options.
  Default is C<--|-|\+> unless environment variable
  POSIXLY_CORRECT has been set, in which case it is C<--|->.
  
  =item long_prefix_pattern
  
  A Perl pattern that allows the disambiguation of long and short
  prefixes. Default is C<-->.
  
  Typically you only need to set this if you are using nonstandard
  prefixes and want some or all of them to have the same semantics as
  '--' does under normal circumstances.
  
  For example, setting prefix_pattern to C<--|-|\+|\/> and
  long_prefix_pattern to C<--|\/> would add Win32 style argument
  handling.
  
  =item debug (default: disabled)
  
  Enable debugging output.
  
  =back
  
  =head1 Exportable Methods
  
  =over
  
  =item VersionMessage
  
  This subroutine provides a standard version message. Its argument can be:
  
  =over 4
  
  =item *
  
  A string containing the text of a message to print I<before> printing
  the standard message.
  
  =item *
  
  A numeric value corresponding to the desired exit status.
  
  =item *
  
  A reference to a hash.
  
  =back
  
  If more than one argument is given then the entire argument list is
  assumed to be a hash.  If a hash is supplied (either as a reference or
  as a list) it should contain one or more elements with the following
  keys:
  
  =over 4
  
  =item C<-message>
  
  =item C<-msg>
  
  The text of a message to print immediately prior to printing the
  program's usage message.
  
  =item C<-exitval>
  
  The desired exit status to pass to the B<exit()> function.
  This should be an integer, or else the string "NOEXIT" to
  indicate that control should simply be returned without
  terminating the invoking process.
  
  =item C<-output>
  
  A reference to a filehandle, or the pathname of a file to which the
  usage message should be written. The default is C<\*STDERR> unless the
  exit value is less than 2 (in which case the default is C<\*STDOUT>).
  
  =back
  
  You cannot tie this routine directly to an option, e.g.:
  
      GetOptions("version" => \&VersionMessage);
  
  Use this instead:
  
      GetOptions("version" => sub { VersionMessage() });
  
  =item HelpMessage
  
  This subroutine produces a standard help message, derived from the
  program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
  arguments as VersionMessage(). In particular, you cannot tie it
  directly to an option, e.g.:
  
      GetOptions("help" => \&HelpMessage);
  
  Use this instead:
  
      GetOptions("help" => sub { HelpMessage() });
  
  =back
  
  =head1 Return values and Errors
  
  Configuration errors and errors in the option definitions are
  signalled using die() and will terminate the calling program unless
  the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
  }>, or die() was trapped using C<$SIG{__DIE__}>.
  
  GetOptions returns true to indicate success.
  It returns false when the function detected one or more errors during
  option parsing. These errors are signalled using warn() and can be
  trapped with C<$SIG{__WARN__}>.
  
  =head1 Legacy
  
  The earliest development of C<newgetopt.pl> started in 1990, with Perl
  version 4. As a result, its development, and the development of
  Getopt::Long, has gone through several stages. Since backward
  compatibility has always been extremely important, the current version
  of Getopt::Long still supports a lot of constructs that nowadays are
  no longer necessary or otherwise unwanted. This section describes
  briefly some of these 'features'.
  
  =head2 Default destinations
  
  When no destination is specified for an option, GetOptions will store
  the resultant value in a global variable named C<opt_>I<XXX>, where
  I<XXX> is the primary name of this option. When a progam 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
  
  =head1 AUTHOR
  
  Johan Vromans <jvromans@squirrel.nl>
  
  =head1 COPYRIGHT AND DISCLAIMER
  
  This program is Copyright 1990,2009 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"} = <<'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.025'; # VERSION
  
  use Carp ();
  
  
  my @attributes;
  BEGIN {
      @attributes = qw(agent default_headers local_address max_redirect max_size proxy timeout SSL_options verify_SSL);
      no strict 'refs';
      for my $accessor ( @attributes ) {
          *{$accessor} = sub {
              @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
          };
      }
  }
  
  sub new {
      my($class, %args) = @_;
  
      (my $default_agent = $class) =~ s{::}{-}g;
      $default_agent .= "/" . ($class->VERSION || 0);
  
      my $self = {
          agent        => $default_agent,
          max_redirect => 5,
          timeout      => 60,
          verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
      };
  
      $args{agent} .= $default_agent
          if defined $args{agent} && $args{agent} =~ / $/;
  
      for my $key ( @attributes ) {
          $self->{$key} = $args{$key} if exists $args{$key}
      }
  
      # Never override proxy argument as this breaks backwards compat.
      if (!exists $self->{proxy} && (my $http_proxy = $ENV{http_proxy})) {
          if ($http_proxy =~ m{\Ahttp://[^/?#:@]+:\d+/?\z}) {
              $self->{proxy} = $http_proxy;
          }
          else {
              Carp::croak(qq{Environment 'http_proxy' must be in format http://<host>:<port>/\n});
          }
      }
  
      return bless $self, $class;
  }
  
  
  for my $sub_name ( qw/get head put post delete/ ) {
      my $req_method = uc $sub_name;
      no strict 'refs';
      eval <<"HERE"; ## no critic
      sub $sub_name {
          my (\$self, \$url, \$args) = \@_;
          \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
          or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
          return \$self->request('$req_method', \$url, \$args || {});
      }
  HERE
  }
  
  
  sub post_form {
      my ($self, $url, $data, $args) = @_;
      (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
          or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
  
      my $headers = {};
      while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
          $headers->{lc $key} = $value;
      }
      delete $args->{headers};
  
      return $self->request('POST', $url, {
              %$args,
              content => $self->www_form_urlencode($data),
              headers => {
                  %$headers,
                  'content-type' => 'application/x-www-form-urlencoded'
              },
          }
      );
  }
  
  
  sub mirror {
      my ($self, $url, $file, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
      if ( -e $file and my $mtime = (stat($file))[9] ) {
          $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
      }
      my $tempfile = $file . int(rand(2**31));
      open my $fh, ">", $tempfile
          or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!\n/);
      binmode $fh;
      $args->{data_callback} = sub { print {$fh} $_[0] };
      my $response = $self->request('GET', $url, $args);
      close $fh
          or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!\n/);
      if ( $response->{success} ) {
          rename $tempfile, $file
              or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
          my $lm = $response->{headers}{'last-modified'};
          if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
              utime $mtime, $mtime, $file;
          }
      }
      $response->{success} ||= $response->{status} eq '304';
      unlink $tempfile;
      return $response;
  }
  
  
  my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
  
  sub request {
      my ($self, $method, $url, $args) = @_;
      @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
      $args ||= {}; # we keep some state in this during _request
  
      # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
      my $response;
      for ( 0 .. 1 ) {
          $response = eval { $self->_request($method, $url, $args) };
          last unless $@ && $idempotent{$method}
              && $@ =~ m{^(?:Socket closed|Unexpected end)};
      }
  
      if (my $e = "$@") {
          $response = {
              url     => $url,
              success => q{},
              status  => 599,
              reason  => 'Internal Exception',
              content => $e,
              headers => {
                  'content-type'   => 'text/plain',
                  'content-length' => length $e,
              }
          };
      }
      return $response;
  }
  
  
  sub www_form_urlencode {
      my ($self, $data) = @_;
      (@_ == 2 && ref $data)
          or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
      (ref $data eq 'HASH' || ref $data eq 'ARRAY')
          or Carp::croak("form data must be a hash or array reference");
  
      my @params = ref $data eq 'HASH' ? %$data : @$data;
      @params % 2 == 0
          or Carp::croak("form data reference must have an even number of terms\n");
  
      my @terms;
      while( @params ) {
          my ($key, $value) = splice(@params, 0, 2);
          if ( ref $value eq 'ARRAY' ) {
              unshift @params, map { $key => $_ } @$value;
          }
          else {
              push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
          }
      }
  
      return join("&", sort @terms);
  }
  
  #--------------------------------------------------------------------------#
  # private methods
  #--------------------------------------------------------------------------#
  
  my %DefaultPort = (
      http => 80,
      https => 443,
  );
  
  sub _request {
      my ($self, $method, $url, $args) = @_;
  
      my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
  
      my $request = {
          method    => $method,
          scheme    => $scheme,
          host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
          uri       => $path_query,
          headers   => {},
      };
  
      my $handle  = HTTP::Tiny::Handle->new(
          timeout         => $self->{timeout},
          SSL_options     => $self->{SSL_options},
          verify_SSL      => $self->{verify_SSL},
          local_address   => $self->{local_address},
      );
  
      if ($self->{proxy}) {
          $request->{uri} = "$scheme://$request->{host_port}$path_query";
          die(qq/HTTPS via proxy is not supported\n/)
              if $request->{scheme} eq 'https';
          $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
      }
      else {
          $handle->connect($scheme, $host, $port);
      }
  
      $self->_prepare_headers_and_cb($request, $args);
      $handle->write_request($request);
  
      my $response;
      do { $response = $handle->read_response_header }
          until (substr($response->{status},0,1) ne '1');
  
      if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
          $handle->close;
          return $self->_request(@redir_args, $args);
      }
  
      if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
          # response has no message body
      }
      else {
          my $data_cb = $self->_prepare_data_cb($response, $args);
          $handle->read_body($data_cb, $response);
      }
  
      $handle->close;
      $response->{success} = substr($response->{status},0,1) eq '2';
      $response->{url} = $url;
      return $response;
  }
  
  sub _prepare_headers_and_cb {
      my ($self, $request, $args) = @_;
  
      for ($self->{default_headers}, $args->{headers}) {
          next unless defined;
          while (my ($k, $v) = each %$_) {
              $request->{headers}{lc $k} = $v;
          }
      }
      $request->{headers}{'host'}         = $request->{host_port};
      $request->{headers}{'connection'}   = "close";
      $request->{headers}{'user-agent'} ||= $self->{agent};
  
      if (defined $args->{content}) {
          $request->{headers}{'content-type'} ||= "application/octet-stream";
          if (ref $args->{content} eq 'CODE') {
              $request->{headers}{'transfer-encoding'} = 'chunked'
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = $args->{content};
          }
          else {
              my $content = $args->{content};
              if ( $] ge '5.008' ) {
                  utf8::downgrade($content, 1)
                      or die(qq/Wide character in request message body\n/);
              }
              $request->{headers}{'content-length'} = length $content
                unless $request->{headers}{'content-length'}
                    || $request->{headers}{'transfer-encoding'};
              $request->{cb} = sub { substr $content, 0, length $content, '' };
          }
          $request->{trailer_cb} = $args->{trailer_callback}
              if ref $args->{trailer_callback} eq 'CODE';
      }
      return;
  }
  
  sub _prepare_data_cb {
      my ($self, $response, $args) = @_;
      my $data_cb = $args->{data_callback};
      $response->{content} = '';
  
      if (!$data_cb || $response->{status} !~ /^2/) {
          if (defined $self->{max_size}) {
              $data_cb = sub {
                  $_[1]->{content} .= $_[0];
                  die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
                    if length $_[1]->{content} > $self->{max_size};
              };
          }
          else {
              $data_cb = sub { $_[1]->{content} .= $_[0] };
          }
      }
      return $data_cb;
  }
  
  sub _maybe_redirect {
      my ($self, $request, $response, $args) = @_;
      my $headers = $response->{headers};
      my ($status, $method) = ($response->{status}, $request->{method});
      if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
          and $headers->{location}
          and ++$args->{redirects} <= $self->{max_redirect}
      ) {
          my $location = ($headers->{location} =~ /^\//)
              ? "$request->{scheme}://$request->{host_port}$headers->{location}"
              : $headers->{location} ;
          return (($status eq '303' ? 'GET' : $method), $location);
      }
      return;
  }
  
  sub _split_url {
      my $url = pop;
  
      # URI regex adapted from the URI module
      my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
        or die(qq/Cannot parse URL: '$url'\n/);
  
      $scheme     = lc $scheme;
      $path_query = "/$path_query" unless $path_query =~ m<\A/>;
  
      my $host = (length($authority)) ? lc $authority : 'localhost';
         $host =~ s/\A[^@]*@//;   # userinfo
      my $port = do {
         $host =~ s/:([0-9]*)\z// && length $1
           ? $1
           : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef);
      };
  
      return ($scheme, $host, $port, $path_query);
  }
  
  # Date conversions adapted from HTTP::Date
  my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
  my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
  sub _http_date {
      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
      return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
          substr($DoW,$wday*4,3),
          $mday, substr($MoY,$mon*4,3), $year+1900,
          $hour, $min, $sec
      );
  }
  
  sub _parse_http_date {
      my ($self, $str) = @_;
      require Time::Local;
      my @tl_parts;
      if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
          @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
      }
      elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
          @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
      }
      return eval {
          my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
          $t < 0 ? undef : $t;
      };
  }
  
  # URI escaping adapted from URI::Escape
  # c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
  # perl 5.6 ready UTF-8 encoding adapted from JSON::PP
  my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
  $escapes{' '}="+";
  my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
  
  sub _uri_escape {
      my ($self, $str) = @_;
      if ( $] ge '5.008' ) {
          utf8::encode($str);
      }
      else {
          $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
              if ( length $str == do { use bytes; length $str } );
          $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
      }
      $str =~ s/($unsafe_char)/$escapes{$1}/ge;
      return $str;
  }
  
  package
      HTTP::Tiny::Handle; # hide from PAUSE/indexers
  use strict;
  use warnings;
  
  use Errno      qw[EINTR EPIPE];
  use IO::Socket qw[SOCK_STREAM];
  
  sub BUFSIZE () { 32768 } ## no critic
  
  my $Printable = sub {
      local $_ = shift;
      s/\r/\\r/g;
      s/\n/\\n/g;
      s/\t/\\t/g;
      s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
      $_;
  };
  
  my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
  
  sub new {
      my ($class, %args) = @_;
      return bless {
          rbuf             => '',
          timeout          => 60,
          max_line_size    => 16384,
          max_header_lines => 64,
          verify_SSL       => 0,
          SSL_options      => {},
          %args
      }, $class;
  }
  
  sub connect {
      @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
      my ($self, $scheme, $host, $port) = @_;
  
      if ( $scheme eq 'https' ) {
          die(qq/IO::Socket::SSL 1.56 must be installed for https support\n/)
              unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.56)};
          die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
              unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
      }
      elsif ( $scheme ne 'http' ) {
        die(qq/Unsupported URL scheme '$scheme'\n/);
      }
      $self->{fh} = 'IO::Socket::INET'->new(
          PeerHost  => $host,
          PeerPort  => $port,
          $self->{local_address} ?
              ( LocalAddr => $self->{local_address} ) : (),
          Proto     => 'tcp',
          Type      => SOCK_STREAM,
          Timeout   => $self->{timeout}
      ) or die(qq/Could not connect to '$host:$port': $@\n/);
  
      binmode($self->{fh})
        or die(qq/Could not binmode() socket: '$!'\n/);
  
      if ( $scheme eq 'https') {
          my $ssl_args = $self->_ssl_args($host);
          IO::Socket::SSL->start_SSL(
              $self->{fh},
              %$ssl_args,
              SSL_create_ctx_callback => sub {
                  my $ctx = shift;
                  Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
              },
          );
  
          unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
              my $ssl_err = IO::Socket::SSL->errstr;
              die(qq/SSL connection failed for $host: $ssl_err\n/);
          }
      }
  
      $self->{host} = $host;
      $self->{port} = $port;
  
      return $self;
  }
  
  sub close {
      @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
      my ($self) = @_;
      CORE::close($self->{fh})
        or die(qq/Could not close socket: '$!'\n/);
  }
  
  sub write {
      @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
      my ($self, $buf) = @_;
  
      if ( $] ge '5.008' ) {
          utf8::downgrade($buf, 1)
              or die(qq/Wide character in write()\n/);
      }
  
      my $len = length $buf;
      my $off = 0;
  
      local $SIG{PIPE} = 'IGNORE';
  
      while () {
          $self->can_write
            or die(qq/Timed out while waiting for socket to become ready for writing\n/);
          my $r = syswrite($self->{fh}, $buf, $len, $off);
          if (defined $r) {
              $len -= $r;
              $off += $r;
              last unless $len > 0;
          }
          elsif ($! == EPIPE) {
              die(qq/Socket closed by remote server: $!\n/);
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not write to SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not write to socket: '$!'\n/);
              }
  
          }
      }
      return $off;
  }
  
  sub read {
      @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
      my ($self, $len, $allow_partial) = @_;
  
      my $buf  = '';
      my $got = length $self->{rbuf};
  
      if ($got) {
          my $take = ($got < $len) ? $got : $len;
          $buf  = substr($self->{rbuf}, 0, $take, '');
          $len -= $take;
      }
  
      while ($len > 0) {
          $self->can_read
            or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
          my $r = sysread($self->{fh}, $buf, $len, length $buf);
          if (defined $r) {
              last unless $r;
              $len -= $r;
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not read from SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not read from socket: '$!'\n/);
              }
          }
      }
      if ($len && !$allow_partial) {
          die(qq/Unexpected end of stream\n/);
      }
      return $buf;
  }
  
  sub readline {
      @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
      my ($self) = @_;
  
      while () {
          if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
              return $1;
          }
          if (length $self->{rbuf} >= $self->{max_line_size}) {
              die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
          }
          $self->can_read
            or die(qq/Timed out while waiting for socket to become ready for reading\n/);
          my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
          if (defined $r) {
              last unless $r;
          }
          elsif ($! != EINTR) {
              if ($self->{fh}->can('errstr')){
                  my $err = $self->{fh}->errstr();
                  die (qq/Could not read from SSL socket: '$err'\n /);
              }
              else {
                  die(qq/Could not read from socket: '$!'\n/);
              }
          }
      }
      die(qq/Unexpected end of stream while looking for line\n/);
  }
  
  sub read_header_lines {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
      my ($self, $headers) = @_;
      $headers ||= {};
      my $lines   = 0;
      my $val;
  
      while () {
           my $line = $self->readline;
  
           if (++$lines >= $self->{max_header_lines}) {
               die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
           }
           elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
               my ($field_name) = lc $1;
               if (exists $headers->{$field_name}) {
                   for ($headers->{$field_name}) {
                       $_ = [$_] unless ref $_ eq "ARRAY";
                       push @$_, $2;
                       $val = \$_->[-1];
                   }
               }
               else {
                   $val = \($headers->{$field_name} = $2);
               }
           }
           elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
               $val
                 or die(qq/Unexpected header continuation line\n/);
               next unless length $1;
               $$val .= ' ' if length $$val;
               $$val .= $1;
           }
           elsif ($line =~ /\A \x0D?\x0A \z/x) {
              last;
           }
           else {
              die(q/Malformed header line: / . $Printable->($line) . "\n");
           }
      }
      return $headers;
  }
  
  sub write_request {
      @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
      my($self, $request) = @_;
      $self->write_request_header(@{$request}{qw/method uri headers/});
      $self->write_body($request) if $request->{cb};
      return;
  }
  
  my %HeaderCase = (
      'content-md5'      => 'Content-MD5',
      'etag'             => 'ETag',
      'te'               => 'TE',
      'www-authenticate' => 'WWW-Authenticate',
      'x-xss-protection' => 'X-XSS-Protection',
  );
  
  sub write_header_lines {
      (@_ == 2 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers)/ . "\n");
      my($self, $headers) = @_;
  
      my $buf = '';
      while (my ($k, $v) = each %$headers) {
          my $field_name = lc $k;
          if (exists $HeaderCase{$field_name}) {
              $field_name = $HeaderCase{$field_name};
          }
          else {
              $field_name =~ /\A $Token+ \z/xo
                or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
              $field_name =~ s/\b(\w)/\u$1/g;
              $HeaderCase{lc $field_name} = $field_name;
          }
          for (ref $v eq 'ARRAY' ? @$v : $v) {
              /[^\x0D\x0A]/
                or die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n");
              $buf .= "$field_name: $_\x0D\x0A";
          }
      }
      $buf .= "\x0D\x0A";
      return $self->write($buf);
  }
  
  sub read_body {
      @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
      my ($self, $cb, $response) = @_;
      my $te = $response->{headers}{'transfer-encoding'} || '';
      if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
          $self->read_chunked_body($cb, $response);
      }
      else {
          $self->read_content_body($cb, $response);
      }
      return;
  }
  
  sub write_body {
      @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
      my ($self, $request) = @_;
      if ($request->{headers}{'content-length'}) {
          return $self->write_content_body($request);
      }
      else {
          return $self->write_chunked_body($request);
      }
  }
  
  sub read_content_body {
      @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
      my ($self, $cb, $response, $content_length) = @_;
      $content_length ||= $response->{headers}{'content-length'};
  
      if ( $content_length ) {
          my $len = $content_length;
          while ($len > 0) {
              my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
              $cb->($self->read($read, 0), $response);
              $len -= $read;
          }
      }
      else {
          my $chunk;
          $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
      }
  
      return;
  }
  
  sub write_content_body {
      @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
      my ($self, $request) = @_;
  
      my ($len, $content_length) = (0, $request->{headers}{'content-length'});
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or die(qq/Wide character in write_content()\n/);
          }
  
          $len += $self->write($data);
      }
  
      $len == $content_length
        or die(qq/Content-Length missmatch (got: $len expected: $content_length)\n/);
  
      return $len;
  }
  
  sub read_chunked_body {
      @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
      my ($self, $cb, $response) = @_;
  
      while () {
          my $head = $self->readline;
  
          $head =~ /\A ([A-Fa-f0-9]+)/x
            or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
  
          my $len = hex($1)
            or last;
  
          $self->read_content_body($cb, $response, $len);
  
          $self->read(2) eq "\x0D\x0A"
            or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
      }
      $self->read_header_lines($response->{headers});
      return;
  }
  
  sub write_chunked_body {
      @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
      my ($self, $request) = @_;
  
      my $len = 0;
      while () {
          my $data = $request->{cb}->();
  
          defined $data && length $data
            or last;
  
          if ( $] ge '5.008' ) {
              utf8::downgrade($data, 1)
                  or die(qq/Wide character in write_chunked_body()\n/);
          }
  
          $len += length $data;
  
          my $chunk  = sprintf '%X', length $data;
             $chunk .= "\x0D\x0A";
             $chunk .= $data;
             $chunk .= "\x0D\x0A";
  
          $self->write($chunk);
      }
      $self->write("0\x0D\x0A");
      $self->write_header_lines($request->{trailer_cb}->())
          if ref $request->{trailer_cb} eq 'CODE';
      return $len;
  }
  
  sub read_response_header {
      @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
      my ($self) = @_;
  
      my $line = $self->readline;
  
      $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
        or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
  
      my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
  
      die (qq/Unsupported HTTP protocol: $protocol\n/)
          unless $version =~ /0*1\.0*[01]/;
  
      return {
          status   => $status,
          reason   => $reason,
          headers  => $self->read_header_lines,
          protocol => $protocol,
      };
  }
  
  sub write_request_header {
      @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
      my ($self, $method, $request_uri, $headers) = @_;
  
      return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
           + $self->write_header_lines($headers);
  }
  
  sub _do_timeout {
      my ($self, $type, $timeout) = @_;
      $timeout = $self->{timeout}
          unless defined $timeout && $timeout >= 0;
  
      my $fd = fileno $self->{fh};
      defined $fd && $fd >= 0
        or die(qq/select(2): 'Bad file descriptor'\n/);
  
      my $initial = time;
      my $pending = $timeout;
      my $nfound;
  
      vec(my $fdset = '', $fd, 1) = 1;
  
      while () {
          $nfound = ($type eq 'read')
              ? select($fdset, undef, undef, $pending)
              : select(undef, $fdset, undef, $pending) ;
          if ($nfound == -1) {
              $! == EINTR
                or die(qq/select(2): '$!'\n/);
              redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
              $nfound = 0;
          }
          last;
      }
      $! = 0;
      return $nfound;
  }
  
  sub can_read {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
      my $self = shift;
      return $self->_do_timeout('read', @_)
  }
  
  sub can_write {
      @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
      my $self = shift;
      return $self->_do_timeout('write', @_)
  }
  
  # Try to find a CA bundle to validate the SSL cert,
  # prefer Mozilla::CA or fallback to a system file
  sub _find_CA_file {
      my $self = shift();
  
      return $self->{SSL_options}->{SSL_ca_file}
          if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file};
  
      return Mozilla::CA::SSL_ca_file()
          if eval { require Mozilla::CA };
  
      foreach my $ca_bundle (qw{
          /etc/ssl/certs/ca-certificates.crt
          /etc/pki/tls/certs/ca-bundle.crt
          /etc/ssl/ca-bundle.pem
          }
      ) {
          return $ca_bundle if -e $ca_bundle;
      }
  
      die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
        . qq/Try installing Mozilla::CA from CPAN\n/;
  }
  
  sub _ssl_args {
      my ($self, $host) = @_;
  
      my %ssl_args = (
          SSL_hostname        => $host,  # SNI
      );
  
      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
  
  =head1 NAME
  
  HTTP::Tiny - A small, simple, correct HTTP/1.1 client
  
  =head1 VERSION
  
  version 0.025
  
  =head1 SYNOPSIS
  
      use HTTP::Tiny;
  
      my $response = HTTP::Tiny->new->get('http://example.com/');
  
      die "Failed!\n" unless $response->{success};
  
      print "$response->{status} $response->{reason}\n";
  
      while (my ($k, $v) = each %{$response->{headers}}) {
          for (ref $v eq 'ARRAY' ? @$v : $v) {
              print "$k: $_\n";
          }
      }
  
      print $response->{content} if length $response->{content};
  
  =head1 DESCRIPTION
  
  This is a very simple HTTP/1.1 client, designed for doing simple GET
  requests without the overhead of a large framework like L<LWP::UserAgent>.
  
  It is more correct and more complete than L<HTTP::Lite>.  It supports
  proxies (currently only non-authenticating ones) and redirection.  It
  also correctly resumes after EINTR.
  
  =head1 METHODS
  
  =head2 new
  
      $http = HTTP::Tiny->new( %attributes );
  
  This constructor returns a new HTTP::Tiny object.  Valid attributes include:
  
  =over 4
  
  =item *
  
  C<agent>
  
  A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended.
  
  =item *
  
  C<default_headers>
  
  A hashref of default headers to apply to requests
  
  =item *
  
  C<local_address>
  
  The local IP address to bind to
  
  =item *
  
  C<max_redirect>
  
  Maximum number of redirects allowed (defaults to 5)
  
  =item *
  
  C<max_size>
  
  Maximum response size (only when not using a data callback).  If defined,
  responses larger than this will return an exception.
  
  =item *
  
  C<proxy>
  
  URL of a proxy server to use (default is C<$ENV{http_proxy}> if set)
  
  =item *
  
  C<timeout>
  
  Request timeout in seconds (default is 60)
  
  =item *
  
  C<verify_SSL>
  
  A boolean that indicates whether to validate the SSL certificate of an C<https>
  connection (default is false)
  
  =item *
  
  C<SSL_options>
  
  A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
  
  =back
  
  Exceptions from C<max_size>, C<timeout> or other errors will result in a
  pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
  content field in the response will contain the text of the exception.
  
  See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
  
  =head2 get|head|put|post|delete
  
      $response = $http->get($url);
      $response = $http->get($url, \%options);
      $response = $http->head($url);
  
  These methods are shorthand for calling C<request()> for the given method.  The
  URL must have unsafe characters escaped and international domain names encoded.
  See C<request()> for valid options and a description of the response.
  
  The C<success> field of the response will be true if the status code is 2XX.
  
  =head2 post_form
  
      $response = $http->post_form($url, $form_data);
      $response = $http->post_form($url, $form_data, \%options);
  
  This method executes a C<POST> request and sends the key/value pairs from a
  form data hash or array reference to the given URL with a C<content-type> of
  C<application/x-www-form-urlencoded>.  See documentation for the
  C<www_form_urlencode> method for details on the encoding.
  
  The URL must have unsafe characters escaped and international domain names
  encoded.  See C<request()> for valid options and a description of the response.
  Any C<content-type> header or content in the options hashref will be ignored.
  
  The C<success> field of the response will be true if the status code is 2XX.
  
  =head2 mirror
  
      $response = $http->mirror($url, $file, \%options)
      if ( $response->{success} ) {
          print "$file is up to date\n";
      }
  
  Executes a C<GET> request for the URL and saves the response body to the file
  name provided.  The URL must have unsafe characters escaped and international
  domain names encoded.  If the file already exists, the request will includes 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.  A hashref of options may be appended to
  modify the request.
  
  Valid options are:
  
  =over 4
  
  =item *
  
  C<headers>
  
  A hashref containing headers to include with the request.  If the value for
  a header is an array reference, the header will be output multiple times with
  each value in the array.  These headers over-write any default headers.
  
  =item *
  
  C<content>
  
  A scalar to include as the body of the request OR a code reference
  that will be called iteratively to produce the body of the request
  
  =item *
  
  C<trailer_callback>
  
  A code reference that will be called if it exists to provide a hashref
  of trailing headers (only used with chunked transfer-encoding)
  
  =item *
  
  C<data_callback>
  
  A code reference that will be called for each chunks of the response
  body received.
  
  =back
  
  If the C<content> option is a code reference, it will be called iteratively
  to provide the content body of the request.  It should return the empty
  string or undef when the iterator is exhausted.
  
  If the C<data_callback> option is provided, it will be called iteratively until
  the entire response body is received.  The first argument will be a string
  containing a chunk of the response body, the second argument will be the
  in-progress response hash reference, as described below.  (This allows
  customizing the action of the callback based on the C<status> or C<headers>
  received prior to the content body.)
  
  The C<request> method returns a hashref containing the response.  The hashref
  will have the following keys:
  
  =over 4
  
  =item *
  
  C<success>
  
  Boolean indicating whether the operation returned a 2XX status code
  
  =item *
  
  C<url>
  
  URL that provided the response. This is the URL of the request unless
  there were redirections, in which case it is the last URL queried
  in a redirection chain
  
  =item *
  
  C<status>
  
  The HTTP status code of the response
  
  =item *
  
  C<reason>
  
  The response phrase returned by the server
  
  =item *
  
  C<content>
  
  The body of the response.  If the response does not have any content
  or if a data callback is provided to consume the response body,
  this will be the empty string
  
  =item *
  
  C<headers>
  
  A hashref of header fields.  All header field names will be normalized
  to be lower case. If a header is repeated, the value will be an arrayref;
  it will otherwise be a scalar string containing the value
  
  =back
  
  On an exception during the execution of the request, the C<status> field will
  contain 599, and the C<content> field will contain the text of the exception.
  
  =head2 www_form_urlencode
  
      $params = $http->www_form_urlencode( $data );
      $response = $http->get("http://example.com/query?$params");
  
  This method converts the key/value pairs from a data hash or array reference
  into a C<x-www-form-urlencoded> string.  The keys and values from the data
  reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
  array reference, the key will be repeated with each of the values of the array
  reference.  The key/value pairs in the resulting string will be sorted by key
  and value.
  
  =for Pod::Coverage agent
  default_headers
  local_address
  max_redirect
  max_size
  proxy
  timeout
  verify_SSL
  SSL_options
  
  =head1 SSL SUPPORT
  
  Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
  greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
  thrown if a new enough versions of these modules not installed or if the SSL
  encryption fails. There is no support for C<https> connections via proxy (i.e.
  RFC 2817).
  
  SSL provides two distinct capabilities:
  
  =over 4
  
  =item *
  
  Encrypted communication channel
  
  =item *
  
  Verification of server identity
  
  =back
  
  B<By default, HTTP::Tiny does not verify server identity>.
  
  Server identity verification is controversial and potentially tricky because it
  depends on a (usually paid) third-party Certificate Authority (CA) trust model
  to validate a certificate as legitimate.  This discriminates against servers
  with self-signed certificates or certificates signed by free, community-driven
  CA's such as L<CAcert.org|http://cacert.org>.
  
  By default, HTTP::Tiny does not make any assumptions about your trust model,
  threat level or risk tolerance.  It just aims to give you an encrypted channel
  when you need one.
  
  Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
  that an SSL connection has a valid SSL certificate corresponding to the host
  name of the connection and that the SSL certificate has been verified by a CA.
  Assuming you trust the CA, this will protect against a L<man-in-the-middle
  attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
  concerned about security, you should enable this option.
  
  Certificate verification requires a file containing trusted CA certificates.
  If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
  included with it as a source of trusted CA's.  (This means you trust Mozilla,
  the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
  toolchain used to install it, and your operating system security, right?)
  
  If that module is not available, then HTTP::Tiny will search several
  system-specific default locations for a CA certificate file:
  
  =over 4
  
  =item *
  
  /etc/ssl/certs/ca-certificates.crt
  
  =item *
  
  /etc/pki/tls/certs/ca-bundle.crt
  
  =item *
  
  /etc/ssl/ca-bundle.pem
  
  =back
  
  An exception will be raised if C<verify_SSL> is true and no CA certificate file
  is available.
  
  If you desire complete control over SSL connections, the C<SSL_options> attribute
  lets you provide a hash reference that will be passed through to
  C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
  example, to provide your own trusted CA file:
  
      SSL_options => {
          SSL_ca_file => $file_path,
      }
  
  The C<SSL_options> attribute could also be used for such things as providing a
  client certificate for authentication to a server or controlling the choice of
  cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
  details.
  
  =head1 LIMITATIONS
  
  HTTP::Tiny is I<conditionally compliant> with the
  L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>.
  It attempts to meet all "MUST" requirements of the specification, but does not
  implement all "SHOULD" requirements.
  
  Some particular limitations of note include:
  
  =over
  
  =item *
  
  HTTP::Tiny focuses on correct transport.  Users are responsible for ensuring
  that user-defined headers and content are compliant with the HTTP/1.1
  specification.
  
  =item *
  
  Users must ensure that URLs are properly escaped for unsafe characters and that
  international domain names are properly encoded to ASCII. See L<URI::Escape>,
  L<URI::_punycode> and L<Net::IDN::Encode>.
  
  =item *
  
  Redirection is very strict against the specification.  Redirection is only
  automatic for response codes 301, 302 and 307 if the request method is 'GET' or
  'HEAD'.  Response code 303 is always converted into a 'GET' redirection, as
  mandated by the specification.  There is no automatic support for status 305
  ("Use proxy") redirections.
  
  =item *
  
  Persistent connections are not supported.  The C<Connection> header will
  always be set to C<close>.
  
  =item *
  
  Cookies are not directly supported.  Users that set a C<Cookie> header
  should also set C<max_redirect> to zero to ensure cookies are not
  inappropriately re-transmitted.
  
  =item *
  
  Only the C<http_proxy> environment variable is supported in the format
  C<http://HOST:PORT/>.  If a C<proxy> argument is passed to C<new> (including
  undef), then the C<http_proxy> environment variable is ignored.
  
  =item *
  
  There is no provision for delaying a request body using an C<Expect> header.
  Unexpected C<1XX> responses are silently ignored as per the specification.
  
  =item *
  
  Only 'chunked' C<Transfer-Encoding> is supported.
  
  =item *
  
  There is no support for a Request-URI of '*' for the 'OPTIONS' request.
  
  =item *
  
  There is no support for IPv6 of any kind.
  
  =back
  
  =head1 SEE ALSO
  
  =over 4
  
  =item *
  
  L<LWP::UserAgent>
  
  =item *
  
  L<IO::Socket::SSL>
  
  =item *
  
  L<Mozilla::CA>
  
  =item *
  
  L<Net::SSLeay>
  
  =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://rt.cpan.org/Public/Dist/Display.html?Name=HTTP-Tiny>.
  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/http-tiny>
  
    git clone git://github.com/dagolden/http-tiny.git
  
  =head1 AUTHORS
  
  =over 4
  
  =item *
  
  Christian Hansen <chansen@cpan.org>
  
  =item *
  
  David Golden <dagolden@cpan.org>
  
  =item *
  
  Mike Doherty <doherty@cpan.org>
  
  =back
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2012 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{"IPC/Cmd.pm"} = <<'IPC_CMD';
  package IPC::Cmd;
  
  use strict;
  
  BEGIN {
  
      use constant IS_VMS         => $^O eq 'VMS'                       ? 1 : 0;
      use constant IS_WIN32       => $^O eq 'MSWin32'                   ? 1 : 0;
      use constant IS_WIN98       => (IS_WIN32 and !Win32::IsWinNT())   ? 1 : 0;
      use constant ALARM_CLASS    => __PACKAGE__ . '::TimeOut';
      use constant SPECIAL_CHARS  => qw[< > | &];
      use constant QUOTE          => do { IS_WIN32 ? q["] : q['] };
  
      use Exporter    ();
      use vars        qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG
                          $USE_IPC_RUN $USE_IPC_OPEN3 $CAN_USE_RUN_FORKED $WARN
                          $INSTANCES $ALLOW_NULL_ARGS
                      ];
  
      $VERSION        = '0.78';
      $VERBOSE        = 0;
      $DEBUG          = 0;
      $WARN           = 1;
      $USE_IPC_RUN    = IS_WIN32 && !IS_WIN98;
      $USE_IPC_OPEN3  = not IS_VMS;
      $ALLOW_NULL_ARGS = 0;
  
      $CAN_USE_RUN_FORKED = 0;
      eval {
          require POSIX; POSIX->import();
          require IPC::Open3; IPC::Open3->import();
          require IO::Select; IO::Select->import();
          require IO::Handle; IO::Handle->import();
          require FileHandle; FileHandle->import();
          require Socket; Socket->import();
          require Time::HiRes; Time::HiRes->import();
          require Win32 if IS_WIN32;
      };
      $CAN_USE_RUN_FORKED = $@ || !IS_VMS && !IS_WIN32;
  
      @ISA            = qw[Exporter];
      @EXPORT_OK      = qw[can_run run run_forked QUOTE];
  }
  
  require Carp;
  use Socket;
  use File::Spec;
  use Params::Check               qw[check];
  use Text::ParseWords            ();             # import ONLY if needed!
  use Module::Load::Conditional   qw[can_load];
  use Locale::Maketext::Simple    Style => 'gettext';
  
  =pod
  
  =head1 NAME
  
  IPC::Cmd - finding and running system commands made easy
  
  =head1 SYNOPSIS
  
      use IPC::Cmd qw[can_run run run_forked];
  
      my $full_path = can_run('wget') or warn 'wget is not installed!';
  
      ### commands can be arrayrefs or strings ###
      my $cmd = "$full_path -b theregister.co.uk";
      my $cmd = [$full_path, '-b', 'theregister.co.uk'];
  
      ### in scalar context ###
      my $buffer;
      if( scalar run( command => $cmd,
                      verbose => 0,
                      buffer  => \$buffer,
                      timeout => 20 )
      ) {
          print "fetched webpage successfully: $buffer\n";
      }
  
  
      ### in list context ###
      my( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
              run( command => $cmd, verbose => 0 );
  
      if( $success ) {
          print "this is what the command printed:\n";
          print join "", @$full_buf;
      }
  
      ### check for features
      print "IPC::Open3 available: "  . IPC::Cmd->can_use_ipc_open3;
      print "IPC::Run available: "    . IPC::Cmd->can_use_ipc_run;
      print "Can capture buffer: "    . IPC::Cmd->can_capture_buffer;
  
      ### don't have IPC::Cmd be verbose, ie don't print to stdout or
      ### stderr when running commands -- default is '0'
      $IPC::Cmd::VERBOSE = 0;
  
  
  =head1 DESCRIPTION
  
  IPC::Cmd allows you to run commands platform independently,
  interactively if desired, but have them still work.
  
  The C<can_run> function can tell you if a certain binary is installed
  and if so where, whereas the C<run> function can actually execute any
  of the commands you give it and give you a clear return value, as well
  as adhere to your verbosity settings.
  
  =head1 CLASS METHODS
  
  =head2 $ipc_run_version = IPC::Cmd->can_use_ipc_run( [VERBOSE] )
  
  Utility function that tells you if C<IPC::Run> is available.
  If the C<verbose> flag is passed, it will print diagnostic messages
  if L<IPC::Run> can not be found or loaded.
  
  =cut
  
  
  sub can_use_ipc_run     {
      my $self    = shift;
      my $verbose = shift || 0;
  
      ### IPC::Run doesn't run on win98
      return if IS_WIN98;
  
      ### if we dont have ipc::run, we obviously can't use it.
      return unless can_load(
                          modules => { 'IPC::Run' => '0.55' },
                          verbose => ($WARN && $verbose),
                      );
  
      ### otherwise, we're good to go
      return $IPC::Run::VERSION;
  }
  
  =head2 $ipc_open3_version = IPC::Cmd->can_use_ipc_open3( [VERBOSE] )
  
  Utility function that tells you if C<IPC::Open3> is available.
  If the verbose flag is passed, it will print diagnostic messages
  if C<IPC::Open3> can not be found or loaded.
  
  =cut
  
  
  sub can_use_ipc_open3   {
      my $self    = shift;
      my $verbose = shift || 0;
  
      ### IPC::Open3 is not working on VMS because of a lack of fork.
      return if IS_VMS;
  
      ### IPC::Open3 works on every non-VMS platform platform, but it can't
      ### capture buffers on win32 :(
      return unless can_load(
          modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| },
          verbose => ($WARN && $verbose),
      );
  
      return $IPC::Open3::VERSION;
  }
  
  =head2 $bool = IPC::Cmd->can_capture_buffer
  
  Utility function that tells you if C<IPC::Cmd> is capable of
  capturing buffers in it's current configuration.
  
  =cut
  
  sub can_capture_buffer {
      my $self    = shift;
  
      return 1 if $USE_IPC_RUN    && $self->can_use_ipc_run;
      return 1 if $USE_IPC_OPEN3  && $self->can_use_ipc_open3;
      return;
  }
  
  =head2 $bool = IPC::Cmd->can_use_run_forked
  
  Utility function that tells you if C<IPC::Cmd> is capable of
  providing C<run_forked> on the current platform.
  
  =head1 FUNCTIONS
  
  =head2 $path = can_run( PROGRAM );
  
  C<can_run> takes only one argument: the name of a binary you wish
  to locate. C<can_run> works much like the unix binary C<which> or the bash
  command C<type>, which scans through your path, looking for the requested
  binary.
  
  Unlike C<which> and C<type>, this function is platform independent and
  will also work on, for example, Win32.
  
  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 and the global variable C<$INSTANCES> is a true
  value, 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.
  
  =cut
  
  sub can_run {
      my $command = shift;
  
      # 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 );
      }
  
      require Config;
      require File::Spec;
      require ExtUtils::MakeMaker;
  
      my @possibles;
  
      if( File::Spec->file_name_is_absolute($command) ) {
          return MM->maybe_command($command);
  
      } else {
          for my $dir (
              (split /\Q$Config::Config{path_sep}\E/, $ENV{PATH}),
              File::Spec->curdir
          ) {
              next if ! $dir || ! -d $dir;
              my $abs = File::Spec->catfile( IS_WIN32 ? Win32::GetShortPathName( $dir ) : $dir, $command);
              push @possibles, $abs if $abs = MM->maybe_command($abs);
          }
      }
      return @possibles if wantarray and $INSTANCES;
      return shift @possibles;
  }
  
  =head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR, timeout => DIGIT] );
  
  C<run> takes 4 arguments:
  
  =over 4
  
  =item command
  
  This is the command to execute. It may be either a string or an array
  reference.
  This is a required argument.
  
  See L<"Caveats"> for remarks on how commands are parsed and their
  limitations.
  
  =item verbose
  
  This controls whether all output of a command should also be printed
  to STDOUT/STDERR or should only be trapped in buffers (NOTE: buffers
  require L<IPC::Run> to be installed, or your system able to work with
  L<IPC::Open3>).
  
  It will default to the global setting of C<$IPC::Cmd::VERBOSE>,
  which by default is 0.
  
  =item buffer
  
  This will hold all the output of a command. It needs to be a reference
  to a scalar.
  Note that this will hold both the STDOUT and STDERR messages, and you
  have no way of telling which is which.
  If you require this distinction, run the C<run> command in list context
  and inspect the individual buffers.
  
  Of course, this requires that the underlying call supports buffers. See
  the note on buffers above.
  
  =item timeout
  
  Sets the maximum time the command is allowed to run before aborting,
  using the built-in C<alarm()> call. If the timeout is triggered, the
  C<errorcode> in the return value will be set to an object of the
  C<IPC::Cmd::TimeOut> class. See the L<"error message"> section below for
  details.
  
  Defaults to C<0>, meaning no timeout is set.
  
  =back
  
  C<run> will return a simple C<true> or C<false> when called in scalar
  context.
  In list context, you will be returned a list of the following items:
  
  =over 4
  
  =item success
  
  A simple boolean indicating if the command executed without errors or
  not.
  
  =item error message
  
  If the first element of the return value (C<success>) was 0, then some
  error occurred. This second element is the error message the command
  you requested exited with, if available. This is generally a pretty
  printed value of C<$?> or C<$@>. See C<perldoc perlvar> for details on
  what they can contain.
  If the error was a timeout, the C<error message> will be prefixed with
  the string C<IPC::Cmd::TimeOut>, the timeout class.
  
  =item full_buffer
  
  This is an array reference containing all the output the command
  generated.
  Note that buffers are only available if you have L<IPC::Run> installed,
  or if your system is able to work with L<IPC::Open3> -- see below).
  Otherwise, this element will be C<undef>.
  
  =item out_buffer
  
  This is an array reference containing all the output sent to STDOUT the
  command generated. The notes from L<"full_buffer"> apply.
  
  =item error_buffer
  
  This is an arrayreference containing all the output sent to STDERR the
  command generated. The notes from L<"full_buffer"> apply.
  
  
  =back
  
  See the L<"HOW IT WORKS"> section below to see how C<IPC::Cmd> decides
  what modules or function calls to use when issuing a command.
  
  =cut
  
  {   my @acc = qw[ok error _fds];
  
      ### autogenerate accessors ###
      for my $key ( @acc ) {
          no strict 'refs';
          *{__PACKAGE__."::$key"} = sub {
              $_[0]->{$key} = $_[1] if @_ > 1;
              return $_[0]->{$key};
          }
      }
  }
  
  sub can_use_run_forked {
      return $CAN_USE_RUN_FORKED eq "1";
  }
  
  # incompatible with POSIX::SigAction
  #
  sub install_layered_signal {
    my ($s, $handler_code) = @_;
  
    my %available_signals = map {$_ => 1} keys %SIG;
  
    die("install_layered_signal got nonexistent signal name [$s]")
      unless defined($available_signals{$s});
    die("install_layered_signal expects coderef")
      if !ref($handler_code) || ref($handler_code) ne 'CODE';
  
    my $previous_handler = $SIG{$s};
  
    my $sig_handler = sub {
      my ($called_sig_name, @sig_param) = @_;
  
      # $s is a closure referring to real signal name
      # for which this handler is being installed.
      # it is used to distinguish between
      # real signal handlers and aliased signal handlers
      my $signal_name = $s;
  
      # $called_sig_name is a signal name which
      # was passed to this signal handler;
      # it doesn't equal $signal_name in case
      # some signal handlers in %SIG point
      # to other signal handler (CHLD and CLD,
      # ABRT and IOT)
      #
      # initial signal handler for aliased signal
      # calls some other signal handler which
      # should not execute the same handler_code again
      if ($called_sig_name eq $signal_name) {
        $handler_code->($signal_name);
      }
  
      # run original signal handler if any (including aliased)
      #
      if (ref($previous_handler)) {
        $previous_handler->($called_sig_name, @sig_param);
      }
    };
  
    $SIG{$s} = $sig_handler;
  }
  
  # give process a chance sending TERM,
  # waiting for a while (2 seconds)
  # and killing it with KILL
  sub kill_gently {
    my ($pid, $opts) = @_;
  
    require POSIX;
  
    $opts = {} unless $opts;
    $opts->{'wait_time'} = 2 unless defined($opts->{'wait_time'});
    $opts->{'first_kill_type'} = 'just_process' unless $opts->{'first_kill_type'};
    $opts->{'final_kill_type'} = 'just_process' unless $opts->{'final_kill_type'};
  
    if ($opts->{'first_kill_type'} eq 'just_process') {
      kill(15, $pid);
    }
    elsif ($opts->{'first_kill_type'} eq 'process_group') {
      kill(-15, $pid);
    }
  
    my $child_finished = 0;
    my $wait_start_time = time();
  
    while (!$child_finished && $wait_start_time + $opts->{'wait_time'} > time()) {
      my $waitpid = waitpid($pid, POSIX::WNOHANG);
      if ($waitpid eq -1) {
        $child_finished = 1;
      }
      Time::HiRes::usleep(250000); # quarter of a second
    }
  
    if (!$child_finished) {
      if ($opts->{'final_kill_type'} eq 'just_process') {
        kill(9, $pid);
      }
      elsif ($opts->{'final_kill_type'} eq 'process_group') {
        kill(-9, $pid);
      }
    }
  }
  
  sub open3_run {
    my ($cmd, $opts) = @_;
  
    $opts = {} unless $opts;
  
    my $child_in = FileHandle->new;
    my $child_out = FileHandle->new;
    my $child_err = FileHandle->new;
    $child_out->autoflush(1);
    $child_err->autoflush(1);
  
    my $pid = open3($child_in, $child_out, $child_err, $cmd);
  
    # push my child's pid to our parent
    # so in case i am killed parent
    # could stop my child (search for
    # child_child_pid in parent code)
    if ($opts->{'parent_info'}) {
      my $ps = $opts->{'parent_info'};
      print $ps "spawned $pid\n";
    }
  
    if ($child_in && $child_out->opened && $opts->{'child_stdin'}) {
  
      # If the child process dies for any reason,
      # the next write to CHLD_IN is likely to generate
      # a SIGPIPE in the parent, which is fatal by default.
      # So you may wish to handle this signal.
      #
      # from http://perldoc.perl.org/IPC/Open3.html,
      # absolutely needed to catch piped commands errors.
      #
      local $SIG{'PIPE'} = sub { 1; };
  
      print $child_in $opts->{'child_stdin'};
    }
    close($child_in);
  
    my $child_output = {
      'out' => $child_out->fileno,
      'err' => $child_err->fileno,
      $child_out->fileno => {
        'parent_socket' => $opts->{'parent_stdout'},
        'scalar_buffer' => "",
        'child_handle' => $child_out,
        'block_size' => ($child_out->stat)[11] || 1024,
        },
      $child_err->fileno => {
        'parent_socket' => $opts->{'parent_stderr'},
        'scalar_buffer' => "",
        'child_handle' => $child_err,
        'block_size' => ($child_err->stat)[11] || 1024,
        },
      };
  
    my $select = IO::Select->new();
    $select->add($child_out, $child_err);
  
    # pass any signal to the child
    # effectively creating process
    # strongly attached to the child:
    # it will terminate only after child
    # has terminated (except for SIGKILL,
    # which is specially handled)
    foreach my $s (keys %SIG) {
      my $sig_handler;
      $sig_handler = sub {
        kill("$s", $pid);
        $SIG{$s} = $sig_handler;
      };
      $SIG{$s} = $sig_handler;
    }
  
    my $child_finished = 0;
  
    my $got_sig_child = 0;
    $SIG{'CHLD'} = sub { $got_sig_child = time(); };
  
    while(!$child_finished && ($child_out->opened || $child_err->opened)) {
  
      # parent was killed otherwise we would have got
      # the same signal as parent and process it same way
      if (getppid() eq "1") {
  
        # end my process group with all the children
        # (i am the process group leader, so my pid
        # equals to the process group id)
        #
        # same thing which is done
        # with $opts->{'clean_up_children'}
        # in run_forked
        #
        kill(-9, $$);
  
        POSIX::_exit 1;
      }
  
      if ($got_sig_child) {
        if (time() - $got_sig_child > 1) {
          # select->can_read doesn't return 0 after SIG_CHLD
          #
          # "On POSIX-compliant platforms, SIGCHLD is the signal
          # sent to a process when a child process terminates."
          # http://en.wikipedia.org/wiki/SIGCHLD
          #
          # nevertheless kill KILL wouldn't break anything here
          #
          kill (9, $pid);
          $child_finished = 1;
        }
      }
  
      Time::HiRes::usleep(1);
  
      foreach my $fd ($select->can_read(1/100)) {
        my $str = $child_output->{$fd->fileno};
        psSnake::die("child stream not found: $fd") unless $str;
  
        my $data;
        my $count = $fd->sysread($data, $str->{'block_size'});
  
        if ($count) {
          if ($str->{'parent_socket'}) {
            my $ph = $str->{'parent_socket'};
            print $ph $data;
          }
          else {
            $str->{'scalar_buffer'} .= $data;
          }
        }
        elsif ($count eq 0) {
          $select->remove($fd);
          $fd->close();
        }
        else {
          psSnake::die("error during sysread: " . $!);
        }
      }
    }
  
    my $waitpid_ret = waitpid($pid, 0);
    my $real_exit = $?;
    my $exit_value  = $real_exit >> 8;
  
    # since we've successfully reaped the child,
    # let our parent know about this.
    #
    if ($opts->{'parent_info'}) {
      my $ps = $opts->{'parent_info'};
  
      # child was killed, inform parent
      if ($real_exit & 127) {
        print $ps "$pid killed with " . ($real_exit & 127) . "\n";
      }
  
      print $ps "reaped $pid\n";
    }
  
    if ($opts->{'parent_stdout'} || $opts->{'parent_stderr'}) {
      return $exit_value;
    }
    else {
      return {
        'stdout' => $child_output->{$child_output->{'out'}}->{'scalar_buffer'},
        'stderr' => $child_output->{$child_output->{'err'}}->{'scalar_buffer'},
        'exit_code' => $exit_value,
        };
    }
  }
  
  =head2 $hashref = run_forked( COMMAND, { child_stdin => SCALAR, timeout => DIGIT, stdout_handler => CODEREF, stderr_handler => CODEREF} );
  
  C<run_forked> is used to execute some program or a coderef,
  optionally feed it with some input, get its return code
  and output (both stdout and stderr into separate buffers).
  In addition, it allows to terminate the program
  if it takes too long to finish.
  
  The important and distinguishing feature of run_forked
  is execution timeout which at first seems to be
  quite a simple task but if you think
  that the program which you're spawning
  might spawn some children itself (which
  in their turn could do the same and so on)
  it turns out to be not a simple issue.
  
  C<run_forked> is designed to survive and
  successfully terminate almost any long running task,
  even a fork bomb in case your system has the resources
  to survive during given timeout.
  
  This is achieved by creating separate watchdog process
  which spawns the specified program in a separate
  process session and supervises it: optionally
  feeds it with input, stores its exit code,
  stdout and stderr, terminates it in case
  it runs longer than specified.
  
  Invocation requires the command to be executed or a coderef and optionally a hashref of options:
  
  =over
  
  =item C<timeout>
  
  Specify in seconds how long to run the command before it is killed with with SIG_KILL (9),
  which effectively terminates it and all of its children (direct or indirect).
  
  =item C<child_stdin>
  
  Specify some text that will be passed into the C<STDIN> of the executed program.
  
  =item C<stdout_handler>
  
  Coderef of a subroutine to call when a portion of data is received on
  STDOUT from the executing program.
  
  =item C<stderr_handler>
  
  Coderef of a subroutine to call when a portion of data is received on
  STDERR from the executing program.
  
  
  =item C<discard_output>
  
  Discards the buffering of the standard output and standard errors for return by run_forked().
  With this option you have to use the std*_handlers to read what the command outputs.
  Useful for commands that send a lot of output.
  
  =item C<terminate_on_parent_sudden_death>
  
  Enable this option if you wish all spawned processes to be killed if the initially spawned
  process (the parent) is killed or dies without waiting for child processes.
  
  =back
  
  C<run_forked> will return a HASHREF with the following keys:
  
  =over
  
  =item C<exit_code>
  
  The exit code of the executed program.
  
  =item C<timeout>
  
  The number of seconds the program ran for before being terminated, or 0 if no timeout occurred.
  
  =item C<stdout>
  
  Holds the standard output of the executed command (or empty string if
  there was no STDOUT output or if C<discard_output> was used; it's always defined!)
  
  =item C<stderr>
  
  Holds the standard error of the executed command (or empty string if
  there was no STDERR output or if C<discard_output> was used; it's always defined!)
  
  =item C<merged>
  
  Holds the standard output and error of the executed command merged into one stream
  (or empty string if there was no output at all or if C<discard_output> was used; it's always defined!)
  
  =item C<err_msg>
  
  Holds some explanation in the case of an error.
  
  =back
  
  =cut
  
  sub run_forked {
      ### container to store things in
      my $self = bless {}, __PACKAGE__;
  
      require POSIX;
  
      if (!can_use_run_forked()) {
          Carp::carp("run_forked is not available: $CAN_USE_RUN_FORKED");
          return;
      }
  
      my ($cmd, $opts) = @_;
  
      if (!$cmd) {
          Carp::carp("run_forked expects command to run");
          return;
      }
  
      $opts = {} unless $opts;
      $opts->{'timeout'} = 0 unless $opts->{'timeout'};
      $opts->{'terminate_wait_time'} = 2 unless defined($opts->{'terminate_wait_time'});
  
      # turned on by default
      $opts->{'clean_up_children'} = 1 unless defined($opts->{'clean_up_children'});
  
      # sockets to pass child stdout to parent
      my $child_stdout_socket;
      my $parent_stdout_socket;
  
      # sockets to pass child stderr to parent
      my $child_stderr_socket;
      my $parent_stderr_socket;
  
      # sockets for child -> parent internal communication
      my $child_info_socket;
      my $parent_info_socket;
  
      socketpair($child_stdout_socket, $parent_stdout_socket, AF_UNIX, SOCK_STREAM, PF_UNSPEC) ||
        die ("socketpair: $!");
      socketpair($child_stderr_socket, $parent_stderr_socket, AF_UNIX, SOCK_STREAM, PF_UNSPEC) ||
        die ("socketpair: $!");
      socketpair($child_info_socket, $parent_info_socket, AF_UNIX, SOCK_STREAM, PF_UNSPEC) ||
        die ("socketpair: $!");
  
      $child_stdout_socket->autoflush(1);
      $parent_stdout_socket->autoflush(1);
      $child_stderr_socket->autoflush(1);
      $parent_stderr_socket->autoflush(1);
      $child_info_socket->autoflush(1);
      $parent_info_socket->autoflush(1);
  
      my $start_time = time();
  
      my $pid;
      if ($pid = fork) {
  
        # we are a parent
        close($parent_stdout_socket);
        close($parent_stderr_socket);
        close($parent_info_socket);
  
        my $flags;
  
        # prepare sockets to read from child
  
        $flags = 0;
        fcntl($child_stdout_socket, POSIX::F_GETFL, $flags) || die "can't fnctl F_GETFL: $!";
        $flags |= POSIX::O_NONBLOCK;
        fcntl($child_stdout_socket, POSIX::F_SETFL, $flags) || die "can't fnctl F_SETFL: $!";
  
        $flags = 0;
        fcntl($child_stderr_socket, POSIX::F_GETFL, $flags) || die "can't fnctl F_GETFL: $!";
        $flags |= POSIX::O_NONBLOCK;
        fcntl($child_stderr_socket, POSIX::F_SETFL, $flags) || die "can't fnctl F_SETFL: $!";
  
        $flags = 0;
        fcntl($child_info_socket, POSIX::F_GETFL, $flags) || die "can't fnctl F_GETFL: $!";
        $flags |= POSIX::O_NONBLOCK;
        fcntl($child_info_socket, POSIX::F_SETFL, $flags) || die "can't fnctl F_SETFL: $!";
  
    #    print "child $pid started\n";
  
        my $child_timedout = 0;
        my $child_finished = 0;
        my $child_stdout = '';
        my $child_stderr = '';
        my $child_merged = '';
        my $child_exit_code = 0;
        my $child_killed_by_signal = 0;
        my $parent_died = 0;
  
        my $got_sig_child = 0;
        my $got_sig_quit = 0;
        my $orig_sig_child = $SIG{'CHLD'};
  
        $SIG{'CHLD'} = sub { $got_sig_child = time(); };
  
        if ($opts->{'terminate_on_signal'}) {
          install_layered_signal($opts->{'terminate_on_signal'}, sub { $got_sig_quit = time(); });
        }
  
        my $child_child_pid;
  
        while (!$child_finished) {
          my $now = time();
  
          if ($opts->{'terminate_on_parent_sudden_death'}) {
            $opts->{'runtime'}->{'last_parent_check'} = 0
              unless defined($opts->{'runtime'}->{'last_parent_check'});
  
            # check for parent once each five seconds
            if ($now - $opts->{'runtime'}->{'last_parent_check'} > 5) {
              if (getppid() eq "1") {
                kill_gently ($pid, {
                  'first_kill_type' => 'process_group',
                  'final_kill_type' => 'process_group',
                  'wait_time' => $opts->{'terminate_wait_time'}
                  });
                $parent_died = 1;
              }
  
              $opts->{'runtime'}->{'last_parent_check'} = $now;
            }
          }
  
          # user specified timeout
          if ($opts->{'timeout'}) {
            if ($now - $start_time > $opts->{'timeout'}) {
              kill_gently ($pid, {
                'first_kill_type' => 'process_group',
                'final_kill_type' => 'process_group',
                'wait_time' => $opts->{'terminate_wait_time'}
                });
              $child_timedout = 1;
            }
          }
  
          # give OS 10 seconds for correct return of waitpid,
          # kill process after that and finish wait loop;
          # shouldn't ever happen -- remove this code?
          if ($got_sig_child) {
            if ($now - $got_sig_child > 10) {
              print STDERR "waitpid did not return -1 for 10 seconds after SIG_CHLD, killing [$pid]\n";
              kill (-9, $pid);
              $child_finished = 1;
            }
          }
  
          if ($got_sig_quit) {
            kill_gently ($pid, {
              'first_kill_type' => 'process_group',
              'final_kill_type' => 'process_group',
              'wait_time' => $opts->{'terminate_wait_time'}
              });
            $child_finished = 1;
          }
  
          my $waitpid = waitpid($pid, POSIX::WNOHANG);
  
          # child finished, catch it's exit status
          if ($waitpid ne 0 && $waitpid ne -1) {
            $child_exit_code = $? >> 8;
          }
  
          if ($waitpid eq -1) {
            $child_finished = 1;
            next;
          }
  
          # child -> parent simple internal communication protocol
          while (my $l = <$child_info_socket>) {
            if ($l =~ /^spawned ([0-9]+?)\n(.*?)/so) {
              $child_child_pid = $1;
              $l = $2;
            }
            if ($l =~ /^reaped ([0-9]+?)\n(.*?)/so) {
              $child_child_pid = undef;
              $l = $2;
            }
            if ($l =~ /^[\d]+ killed with ([0-9]+?)\n(.*?)/so) {
              $child_killed_by_signal = $1;
              $l = $2;
            }
          }
  
          while (my $l = <$child_stdout_socket>) {
            if (!$opts->{'discard_output'}) {
              $child_stdout .= $l;
              $child_merged .= $l;
            }
  
            if ($opts->{'stdout_handler'} && ref($opts->{'stdout_handler'}) eq 'CODE') {
              $opts->{'stdout_handler'}->($l);
            }
          }
          while (my $l = <$child_stderr_socket>) {
            if (!$opts->{'discard_output'}) {
              $child_stderr .= $l;
              $child_merged .= $l;
            }
            if ($opts->{'stderr_handler'} && ref($opts->{'stderr_handler'}) eq 'CODE') {
              $opts->{'stderr_handler'}->($l);
            }
          }
  
          Time::HiRes::usleep(1);
        }
  
        # $child_pid_pid is not defined in two cases:
        #  * when our child was killed before
        #    it had chance to tell us the pid
        #    of the child it spawned. we can do
        #    nothing in this case :(
        #  * our child successfully reaped its child,
        #    we have nothing left to do in this case
        #
        # defined $child_pid_pid means child's child
        # has not died but nobody is waiting for it,
        # killing it brutally.
        #
        if ($child_child_pid) {
          kill_gently($child_child_pid);
        }
  
        # in case there are forks in child which
        # do not forward or process signals (TERM) correctly
        # kill whole child process group, effectively trying
        # not to return with some children or their parts still running
        #
        # to be more accurate -- we need to be sure
        # that this is process group created by our child
        # (and not some other process group with the same pgid,
        # created just after death of our child) -- fortunately
        # this might happen only when process group ids
        # are reused quickly (there are lots of processes
        # spawning new process groups for example)
        #
        if ($opts->{'clean_up_children'}) {
          kill(-9, $pid);
        }
  
    #    print "child $pid finished\n";
  
        close($child_stdout_socket);
        close($child_stderr_socket);
        close($child_info_socket);
  
        my $o = {
          'stdout' => $child_stdout,
          'stderr' => $child_stderr,
          'merged' => $child_merged,
          'timeout' => $child_timedout ? $opts->{'timeout'} : 0,
          'exit_code' => $child_exit_code,
          'parent_died' => $parent_died,
          'killed_by_signal' => $child_killed_by_signal,
          'child_pgid' => $pid,
          };
  
        my $err_msg = '';
        if ($o->{'exit_code'}) {
          $err_msg .= "exited with code [$o->{'exit_code'}]\n";
        }
        if ($o->{'timeout'}) {
          $err_msg .= "ran more than [$o->{'timeout'}] seconds\n";
        }
        if ($o->{'parent_died'}) {
          $err_msg .= "parent died\n";
        }
        if ($o->{'stdout'}) {
          $err_msg .= "stdout:\n" . $o->{'stdout'} . "\n";
        }
        if ($o->{'stderr'}) {
          $err_msg .= "stderr:\n" . $o->{'stderr'} . "\n";
        }
        if ($o->{'killed_by_signal'}) {
          $err_msg .= "killed by signal [" . $o->{'killed_by_signal'} . "]\n";
        }
        $o->{'err_msg'} = $err_msg;
  
        if ($orig_sig_child) {
          $SIG{'CHLD'} = $orig_sig_child;
        }
        else {
          delete($SIG{'CHLD'});
        }
  
        return $o;
      }
      else {
        die("cannot fork: $!") unless defined($pid);
  
        # create new process session for open3 call,
        # so we hopefully can kill all the subprocesses
        # which might be spawned in it (except for those
        # which do setsid theirselves -- can't do anything
        # with those)
  
        POSIX::setsid() || die("Error running setsid: " . $!);
  
        if ($opts->{'child_BEGIN'} && ref($opts->{'child_BEGIN'}) eq 'CODE') {
          $opts->{'child_BEGIN'}->();
        }
  
        close($child_stdout_socket);
        close($child_stderr_socket);
        close($child_info_socket);
  
        my $child_exit_code;
  
        # allow both external programs
        # and internal perl calls
        if (!ref($cmd)) {
          $child_exit_code = open3_run($cmd, {
            'parent_info' => $parent_info_socket,
            'parent_stdout' => $parent_stdout_socket,
            'parent_stderr' => $parent_stderr_socket,
            'child_stdin' => $opts->{'child_stdin'},
            });
        }
        elsif (ref($cmd) eq 'CODE') {
          $child_exit_code = $cmd->({
            'opts' => $opts,
            'parent_info' => $parent_info_socket,
            'parent_stdout' => $parent_stdout_socket,
            'parent_stderr' => $parent_stderr_socket,
            'child_stdin' => $opts->{'child_stdin'},
            });
        }
        else {
          print $parent_stderr_socket "Invalid command reference: " . ref($cmd) . "\n";
          $child_exit_code = 1;
        }
  
        close($parent_stdout_socket);
        close($parent_stderr_socket);
        close($parent_info_socket);
  
        if ($opts->{'child_END'} && ref($opts->{'child_END'}) eq 'CODE') {
          $opts->{'child_END'}->();
        }
  
        POSIX::_exit $child_exit_code;
      }
  }
  
  sub run {
      ### container to store things in
      my $self = bless {}, __PACKAGE__;
  
      my %hash = @_;
  
      ### if the user didn't provide a buffer, we'll store it here.
      my $def_buf = '';
  
      my($verbose,$cmd,$buffer,$timeout);
      my $tmpl = {
          verbose => { default  => $VERBOSE,  store => \$verbose },
          buffer  => { default  => \$def_buf, store => \$buffer },
          command => { required => 1,         store => \$cmd,
                       allow    => sub { !ref($_[0]) or ref($_[0]) eq 'ARRAY' },
          },
          timeout => { default  => 0,         store => \$timeout },
      };
  
      unless( check( $tmpl, \%hash, $VERBOSE ) ) {
          Carp::carp( loc( "Could not validate input: %1",
                           Params::Check->last_error ) );
          return;
      };
  
      $cmd = _quote_args_vms( $cmd ) if IS_VMS;
  
      ### strip any empty elements from $cmd if present
      if ( $ALLOW_NULL_ARGS ) {
        $cmd = [ grep { defined } @$cmd ] if ref $cmd;
      }
      else {
        $cmd = [ grep { defined && length } @$cmd ] if ref $cmd;
      }
  
      my $pp_cmd = (ref $cmd ? "@$cmd" : $cmd);
      print loc("Running [%1]...\n", $pp_cmd ) if $verbose;
  
      ### did the user pass us a buffer to fill or not? if so, set this
      ### flag so we know what is expected of us
      ### XXX this is now being ignored. in the future, we could add diagnostic
      ### messages based on this logic
      #my $user_provided_buffer = $buffer == \$def_buf ? 0 : 1;
  
      ### buffers that are to be captured
      my( @buffer, @buff_err, @buff_out );
  
      ### capture STDOUT
      my $_out_handler = sub {
          my $buf = shift;
          return unless defined $buf;
  
          print STDOUT $buf if $verbose;
          push @buffer,   $buf;
          push @buff_out, $buf;
      };
  
      ### capture STDERR
      my $_err_handler = sub {
          my $buf = shift;
          return unless defined $buf;
  
          print STDERR $buf if $verbose;
          push @buffer,   $buf;
          push @buff_err, $buf;
      };
  
  
      ### flag to indicate we have a buffer captured
      my $have_buffer = $self->can_capture_buffer ? 1 : 0;
  
      ### flag indicating if the subcall went ok
      my $ok;
  
      ### dont look at previous errors:
      local $?;
      local $@;
      local $!;
  
      ### we might be having a timeout set
      eval {
          local $SIG{ALRM} = sub { die bless sub {
              ALARM_CLASS .
              qq[: Command '$pp_cmd' aborted by alarm after $timeout seconds]
          }, ALARM_CLASS } if $timeout;
          alarm $timeout || 0;
  
          ### IPC::Run is first choice if $USE_IPC_RUN is set.
          if( !IS_WIN32 and $USE_IPC_RUN and $self->can_use_ipc_run( 1 ) ) {
              ### ipc::run handlers needs the command as a string or an array ref
  
              $self->_debug( "# Using IPC::Run. Have buffer: $have_buffer" )
                  if $DEBUG;
  
              $ok = $self->_ipc_run( $cmd, $_out_handler, $_err_handler );
  
          ### since IPC::Open3 works on all platforms, and just fails on
          ### win32 for capturing buffers, do that ideally
          } elsif ( $USE_IPC_OPEN3 and $self->can_use_ipc_open3( 1 ) ) {
  
              $self->_debug("# Using IPC::Open3. Have buffer: $have_buffer")
                  if $DEBUG;
  
              ### in case there are pipes in there;
              ### IPC::Open3 will call exec and exec will do the right thing
  
              my $method = IS_WIN32 ? '_open3_run_win32' : '_open3_run';
  
              $ok = $self->$method(
                                      $cmd, $_out_handler, $_err_handler, $verbose
                                  );
  
          ### if we are allowed to run verbose, just dispatch the system command
          } else {
              $self->_debug( "# Using system(). Have buffer: $have_buffer" )
                  if $DEBUG;
              $ok = $self->_system_run( $cmd, $verbose );
          }
  
          alarm 0;
      };
  
      ### restore STDIN after duping, or STDIN will be closed for
      ### this current perl process!
      $self->__reopen_fds( @{ $self->_fds} ) if $self->_fds;
  
      my $err;
      unless( $ok ) {
          ### alarm happened
          if ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) {
              $err = $@->();  # the error code is an expired alarm
  
          ### another error happened, set by the dispatchub
          } else {
              $err = $self->error;
          }
      }
  
      ### fill the buffer;
      $$buffer = join '', @buffer if @buffer;
  
      ### return a list of flags and buffers (if available) in list
      ### context, or just a simple 'ok' in scalar
      return wantarray
                  ? $have_buffer
                      ? ($ok, $err, \@buffer, \@buff_out, \@buff_err)
                      : ($ok, $err )
                  : $ok
  
  
  }
  
  sub _open3_run_win32 {
    my $self    = shift;
    my $cmd     = shift;
    my $outhand = shift;
    my $errhand = shift;
  
    my $pipe = sub {
      socketpair($_[0], $_[1], AF_UNIX, SOCK_STREAM, PF_UNSPEC)
          or return undef;
      shutdown($_[0], 1);  # No more writing for reader
      shutdown($_[1], 0);  # No more reading for writer
      return 1;
    };
  
    my $open3 = sub {
      local (*TO_CHLD_R,     *TO_CHLD_W);
      local (*FR_CHLD_R,     *FR_CHLD_W);
      local (*FR_CHLD_ERR_R, *FR_CHLD_ERR_W);
  
      $pipe->(*TO_CHLD_R,     *TO_CHLD_W    ) or die $^E;
      $pipe->(*FR_CHLD_R,     *FR_CHLD_W    ) or die $^E;
      $pipe->(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $^E;
  
      my $pid = IPC::Open3::open3('>&TO_CHLD_R', '<&FR_CHLD_W', '<&FR_CHLD_ERR_W', @_);
  
      return ( $pid, *TO_CHLD_W, *FR_CHLD_R, *FR_CHLD_ERR_R );
    };
  
    $cmd = [ grep { defined && length } @$cmd ] if ref $cmd;
    $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );
  
    my ($pid, $to_chld, $fr_chld, $fr_chld_err) =
      $open3->( ( ref $cmd ? @$cmd : $cmd ) );
  
    my $in_sel  = IO::Select->new();
    my $out_sel = IO::Select->new();
  
    my %objs;
  
    $objs{ fileno( $fr_chld ) } = $outhand;
    $objs{ fileno( $fr_chld_err ) } = $errhand;
    $in_sel->add( $fr_chld );
    $in_sel->add( $fr_chld_err );
  
    close($to_chld);
  
    while ($in_sel->count() + $out_sel->count()) {
      my ($ins, $outs) = IO::Select::select($in_sel, $out_sel, undef);
  
      for my $fh (@$ins) {
          my $obj = $objs{ fileno($fh) };
          my $buf;
          my $bytes_read = sysread($fh, $buf, 64*1024 ); #, length($buf));
          if (!$bytes_read) {
              $in_sel->remove($fh);
          }
          else {
  	          $obj->( "$buf" );
  	      }
        }
  
        for my $fh (@$outs) {
        }
    }
  
    waitpid($pid, 0);
  
    ### some error occurred
    if( $? ) {
          $self->error( $self->_pp_child_error( $cmd, $? ) );
          $self->ok( 0 );
          return;
    } else {
          return $self->ok( 1 );
    }
  }
  
  sub _open3_run {
      my $self            = shift;
      my $cmd             = shift;
      my $_out_handler    = shift;
      my $_err_handler    = shift;
      my $verbose         = shift || 0;
  
      ### Following code are adapted from Friar 'abstracts' in the
      ### Perl Monastery (http://www.perlmonks.org/index.pl?node_id=151886).
      ### XXX that code didn't work.
      ### we now use the following code, thanks to theorbtwo
  
      ### define them beforehand, so we always have defined FH's
      ### to read from.
      use Symbol;
      my $kidout      = Symbol::gensym();
      my $kiderror    = Symbol::gensym();
  
      ### Dup the filehandle so we can pass 'our' STDIN to the
      ### child process. This stops us from having to pump input
      ### from ourselves to the childprocess. However, we will need
      ### to revive the FH afterwards, as IPC::Open3 closes it.
      ### We'll do the same for STDOUT and STDERR. It works without
      ### duping them on non-unix derivatives, but not on win32.
      my @fds_to_dup = ( IS_WIN32 && !$verbose
                              ? qw[STDIN STDOUT STDERR]
                              : qw[STDIN]
                          );
      $self->_fds( \@fds_to_dup );
      $self->__dup_fds( @fds_to_dup );
  
      ### pipes have to come in a quoted string, and that clashes with
      ### whitespace. This sub fixes up such commands so they run properly
      $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );
  
      ### dont stringify @$cmd, so spaces in filenames/paths are
      ### treated properly
      my $pid = eval {
          IPC::Open3::open3(
                      '<&STDIN',
                      (IS_WIN32 ? '>&STDOUT' : $kidout),
                      (IS_WIN32 ? '>&STDERR' : $kiderror),
                      ( ref $cmd ? @$cmd : $cmd ),
                  );
      };
  
      ### open3 error occurred
      if( $@ and $@ =~ /^open3:/ ) {
          $self->ok( 0 );
          $self->error( $@ );
          return;
      };
  
      ### use OUR stdin, not $kidin. Somehow,
      ### we never get the input.. so jump through
      ### some hoops to do it :(
      my $selector = IO::Select->new(
                          (IS_WIN32 ? \*STDERR : $kiderror),
                          \*STDIN,
                          (IS_WIN32 ? \*STDOUT : $kidout)
                      );
  
      STDOUT->autoflush(1);   STDERR->autoflush(1);   STDIN->autoflush(1);
      $kidout->autoflush(1)   if UNIVERSAL::can($kidout,   'autoflush');
      $kiderror->autoflush(1) if UNIVERSAL::can($kiderror, 'autoflush');
  
      ### add an explicit break statement
      ### code courtesy of theorbtwo from #london.pm
      my $stdout_done = 0;
      my $stderr_done = 0;
      OUTER: while ( my @ready = $selector->can_read ) {
  
          for my $h ( @ready ) {
              my $buf;
  
              ### $len is the amount of bytes read
              my $len = sysread( $h, $buf, 4096 );    # try to read 4096 bytes
  
              ### see perldoc -f sysread: it returns undef on error,
              ### so bail out.
              if( not defined $len ) {
                  warn(loc("Error reading from process: %1", $!));
                  last OUTER;
              }
  
              ### check for $len. it may be 0, at which point we're
              ### done reading, so don't try to process it.
              ### if we would print anyway, we'd provide bogus information
              $_out_handler->( "$buf" ) if $len && $h == $kidout;
              $_err_handler->( "$buf" ) if $len && $h == $kiderror;
  
              ### Wait till child process is done printing to both
              ### stdout and stderr.
              $stdout_done = 1 if $h == $kidout   and $len == 0;
              $stderr_done = 1 if $h == $kiderror and $len == 0;
              last OUTER if ($stdout_done && $stderr_done);
          }
      }
  
      waitpid $pid, 0; # wait for it to die
  
      ### restore STDIN after duping, or STDIN will be closed for
      ### this current perl process!
      ### done in the parent call now
      # $self->__reopen_fds( @fds_to_dup );
  
      ### some error occurred
      if( $? ) {
          $self->error( $self->_pp_child_error( $cmd, $? ) );
          $self->ok( 0 );
          return;
      } else {
          return $self->ok( 1 );
      }
  }
  
  ### Text::ParseWords::shellwords() uses unix semantics. that will break
  ### on win32
  {   my $parse_sub = IS_WIN32
                          ? __PACKAGE__->can('_split_like_shell_win32')
                          : Text::ParseWords->can('shellwords');
  
      sub _ipc_run {
          my $self            = shift;
          my $cmd             = shift;
          my $_out_handler    = shift;
          my $_err_handler    = shift;
  
          STDOUT->autoflush(1); STDERR->autoflush(1);
  
          ### a command like:
          # [
          #     '/usr/bin/gzip',
          #     '-cdf',
          #     '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz',
          #     '|',
          #     '/usr/bin/tar',
          #     '-tf -'
          # ]
          ### needs to become:
          # [
          #     ['/usr/bin/gzip', '-cdf',
          #       '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz']
          #     '|',
          #     ['/usr/bin/tar', '-tf -']
          # ]
  
  
          my @command;
          my $special_chars;
  
          my $re = do { my $x = join '', SPECIAL_CHARS; qr/([$x])/ };
          if( ref $cmd ) {
              my $aref = [];
              for my $item (@$cmd) {
                  if( $item =~ $re ) {
                      push @command, $aref, $item;
                      $aref = [];
                      $special_chars .= $1;
                  } else {
                      push @$aref, $item;
                  }
              }
              push @command, $aref;
          } else {
              @command = map { if( $_ =~ $re ) {
                                  $special_chars .= $1; $_;
                               } else {
  #                                [ split /\s+/ ]
                                   [ map { m/[ ]/ ? qq{'$_'} : $_ } $parse_sub->($_) ]
                               }
                          } split( /\s*$re\s*/, $cmd );
          }
  
          ### if there's a pipe in the command, *STDIN needs to
          ### be inserted *BEFORE* the pipe, to work on win32
          ### this also works on *nix, so we should do it when possible
          ### this should *also* work on multiple pipes in the command
          ### if there's no pipe in the command, append STDIN to the back
          ### of the command instead.
          ### XXX seems IPC::Run works it out for itself if you just
          ### dont pass STDIN at all.
          #     if( $special_chars and $special_chars =~ /\|/ ) {
          #         ### only add STDIN the first time..
          #         my $i;
          #         @command = map { ($_ eq '|' && not $i++)
          #                             ? ( \*STDIN, $_ )
          #                             : $_
          #                         } @command;
          #     } else {
          #         push @command, \*STDIN;
          #     }
  
          # \*STDIN is already included in the @command, see a few lines up
          my $ok = eval { IPC::Run::run(   @command,
                                  fileno(STDOUT).'>',
                                  $_out_handler,
                                  fileno(STDERR).'>',
                                  $_err_handler
                              )
                          };
  
          ### all is well
          if( $ok ) {
              return $self->ok( $ok );
  
          ### some error occurred
          } else {
              $self->ok( 0 );
  
              ### if the eval fails due to an exception, deal with it
              ### unless it's an alarm
              if( $@ and not UNIVERSAL::isa( $@, ALARM_CLASS ) ) {
                  $self->error( $@ );
  
              ### if it *is* an alarm, propagate
              } elsif( $@ ) {
                  die $@;
  
              ### some error in the sub command
              } else {
                  $self->error( $self->_pp_child_error( $cmd, $? ) );
              }
  
              return;
          }
      }
  }
  
  sub _system_run {
      my $self    = shift;
      my $cmd     = shift;
      my $verbose = shift || 0;
  
      ### pipes have to come in a quoted string, and that clashes with
      ### whitespace. This sub fixes up such commands so they run properly
      $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );
  
      my @fds_to_dup = $verbose ? () : qw[STDOUT STDERR];
      $self->_fds( \@fds_to_dup );
      $self->__dup_fds( @fds_to_dup );
  
      ### system returns 'true' on failure -- the exit code of the cmd
      $self->ok( 1 );
      system( ref $cmd ? @$cmd : $cmd ) == 0 or do {
          $self->error( $self->_pp_child_error( $cmd, $? ) );
          $self->ok( 0 );
      };
  
      ### done in the parent call now
      #$self->__reopen_fds( @fds_to_dup );
  
      return unless $self->ok;
      return $self->ok;
  }
  
  {   my %sc_lookup = map { $_ => $_ } SPECIAL_CHARS;
  
  
      sub __fix_cmd_whitespace_and_special_chars {
          my $self = shift;
          my $cmd  = shift;
  
          ### command has a special char in it
          if( ref $cmd and grep { $sc_lookup{$_} } @$cmd ) {
  
              ### since we have special chars, we have to quote white space
              ### this *may* conflict with the parsing :(
              my $fixed;
              my @cmd = map { / / ? do { $fixed++; QUOTE.$_.QUOTE } : $_ } @$cmd;
  
              $self->_debug( "# Quoted $fixed arguments containing whitespace" )
                      if $DEBUG && $fixed;
  
              ### stringify it, so the special char isn't escaped as argument
              ### to the program
              $cmd = join ' ', @cmd;
          }
  
          return $cmd;
      }
  }
  
  ### Command-line arguments (but not the command itself) must be quoted
  ### to ensure case preservation. Borrowed from Module::Build with adaptations.
  ### Patch for this supplied by Craig Berry, see RT #46288: [PATCH] Add argument
  ### quoting for run() on VMS
  sub _quote_args_vms {
    ### Returns a command string with proper quoting so that the subprocess
    ### sees this same list of args, or if we get a single arg that is an
    ### array reference, quote the elements of it (except for the first)
    ### and return the reference.
    my @args = @_;
    my $got_arrayref = (scalar(@args) == 1
                        && UNIVERSAL::isa($args[0], 'ARRAY'))
                     ? 1
                     : 0;
  
    @args = split(/\s+/, $args[0]) unless $got_arrayref || scalar(@args) > 1;
  
    my $cmd = $got_arrayref ? shift @{$args[0]} : shift @args;
  
    ### Do not quote qualifiers that begin with '/' or previously quoted args.
    map { if (/^[^\/\"]/) {
            $_ =~ s/\"/""/g;     # escape C<"> by doubling
            $_ = q(").$_.q(");
          }
    }
      ($got_arrayref ? @{$args[0]}
                     : @args
      );
  
    $got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd);
  
    return $got_arrayref ? $args[0]
                         : join(' ', @args);
  }
  
  
  ### XXX this is cribbed STRAIGHT from M::B 0.30 here:
  ### http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell
  ### XXX this *should* be integrated into text::parsewords
  sub _split_like_shell_win32 {
    # As it turns out, Windows command-parsing is very different from
    # Unix command-parsing.  Double-quotes mean different things,
    # backslashes don't necessarily mean escapes, and so on.  So we
    # can't use Text::ParseWords::shellwords() to break a command string
    # into words.  The algorithm below was bashed out by Randy and Ken
    # (mostly Randy), and there are a lot of regression tests, so we
    # should feel free to adjust if desired.
  
    local $_ = shift;
  
    my @argv;
    return @argv unless defined() && length();
  
    my $arg = '';
    my( $i, $quote_mode ) = ( 0, 0 );
  
    while ( $i < length() ) {
  
      my $ch      = substr( $_, $i  , 1 );
      my $next_ch = substr( $_, $i+1, 1 );
  
      if ( $ch eq '\\' && $next_ch eq '"' ) {
        $arg .= '"';
        $i++;
      } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
        $arg .= '\\';
        $i++;
      } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
        $quote_mode = !$quote_mode;
        $arg .= '"';
        $i++;
      } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
            ( $i + 2 == length()  ||
          substr( $_, $i + 2, 1 ) eq ' ' )
          ) { # for cases like: a"" => [ 'a' ]
        push( @argv, $arg );
        $arg = '';
        $i += 2;
      } elsif ( $ch eq '"' ) {
        $quote_mode = !$quote_mode;
      } elsif ( $ch eq ' ' && !$quote_mode ) {
        push( @argv, $arg ) if defined( $arg ) && length( $arg );
        $arg = '';
        ++$i while substr( $_, $i + 1, 1 ) eq ' ';
      } else {
        $arg .= $ch;
      }
  
      $i++;
    }
  
    push( @argv, $arg ) if defined( $arg ) && length( $arg );
    return @argv;
  }
  
  
  
  {   use File::Spec;
      use Symbol;
  
      my %Map = (
          STDOUT => [qw|>&|, \*STDOUT, Symbol::gensym() ],
          STDERR => [qw|>&|, \*STDERR, Symbol::gensym() ],
          STDIN  => [qw|<&|, \*STDIN,  Symbol::gensym() ],
      );
  
      ### dups FDs and stores them in a cache
      sub __dup_fds {
          my $self    = shift;
          my @fds     = @_;
  
          __PACKAGE__->_debug( "# Closing the following fds: @fds" ) if $DEBUG;
  
          for my $name ( @fds ) {
              my($redir, $fh, $glob) = @{$Map{$name}} or (
                  Carp::carp(loc("No such FD: '%1'", $name)), next );
  
              ### MUST use the 2-arg version of open for dup'ing for
              ### 5.6.x compatibility. 5.8.x can use 3-arg open
              ### see perldoc5.6.2 -f open for details
              open $glob, $redir . fileno($fh) or (
                          Carp::carp(loc("Could not dup '$name': %1", $!)),
                          return
                      );
  
              ### we should re-open this filehandle right now, not
              ### just dup it
              ### Use 2-arg version of open, as 5.5.x doesn't support
              ### 3-arg version =/
              if( $redir eq '>&' ) {
                  open( $fh, '>' . File::Spec->devnull ) or (
                      Carp::carp(loc("Could not reopen '$name': %1", $!)),
                      return
                  );
              }
          }
  
          return 1;
      }
  
      ### reopens FDs from the cache
      sub __reopen_fds {
          my $self    = shift;
          my @fds     = @_;
  
          __PACKAGE__->_debug( "# Reopening the following fds: @fds" ) if $DEBUG;
  
          for my $name ( @fds ) {
              my($redir, $fh, $glob) = @{$Map{$name}} or (
                  Carp::carp(loc("No such FD: '%1'", $name)), next );
  
              ### MUST use the 2-arg version of open for dup'ing for
              ### 5.6.x compatibility. 5.8.x can use 3-arg open
              ### see perldoc5.6.2 -f open for details
              open( $fh, $redir . fileno($glob) ) or (
                      Carp::carp(loc("Could not restore '$name': %1", $!)),
                      return
                  );
  
              ### close this FD, we're not using it anymore
              close $glob;
          }
          return 1;
  
      }
  }
  
  sub _debug {
      my $self    = shift;
      my $msg     = shift or return;
      my $level   = shift || 0;
  
      local $Carp::CarpLevel += $level;
      Carp::carp($msg);
  
      return 1;
  }
  
  sub _pp_child_error {
      my $self    = shift;
      my $cmd     = shift or return;
      my $ce      = shift or return;
      my $pp_cmd  = ref $cmd ? "@$cmd" : $cmd;
  
  
      my $str;
      if( $ce == -1 ) {
          ### Include $! in the error message, so that the user can
          ### see 'No such file or directory' versus 'Permission denied'
          ### versus 'Cannot fork' or whatever the cause was.
          $str = "Failed to execute '$pp_cmd': $!";
  
      } elsif ( $ce & 127 ) {
          ### some signal
          $str = loc( "'%1' died with signal %d, %s coredump\n",
                 $pp_cmd, ($ce & 127), ($ce & 128) ? 'with' : 'without');
  
      } else {
          ### Otherwise, the command run but gave error status.
          $str = "'$pp_cmd' exited with value " . ($ce >> 8);
      }
  
      $self->_debug( "# Child error '$ce' translated to: $str" ) if $DEBUG;
  
      return $str;
  }
  
  1;
  
  =head2 $q = QUOTE
  
  Returns the character used for quoting strings on this platform. This is
  usually a C<'> (single quote) on most systems, but some systems use different
  quotes. For example, C<Win32> uses C<"> (double quote).
  
  You can use it as follows:
  
    use IPC::Cmd qw[run QUOTE];
    my $cmd = q[echo ] . QUOTE . q[foo bar] . QUOTE;
  
  This makes sure that C<foo bar> is treated as a string, rather than two
  separate arguments to the C<echo> function.
  
  __END__
  
  =head1 HOW IT WORKS
  
  C<run> will try to execute your command using the following logic:
  
  =over 4
  
  =item *
  
  If you have C<IPC::Run> installed, and the variable C<$IPC::Cmd::USE_IPC_RUN>
  is set to true (See the L<"Global Variables"> section) use that to execute
  the command. You will have the full output available in buffers, interactive commands
  are sure to work  and you are guaranteed to have your verbosity
  settings honored cleanly.
  
  =item *
  
  Otherwise, if the variable C<$IPC::Cmd::USE_IPC_OPEN3> is set to true
  (See the L<"Global Variables"> section), try to execute the command using
  L<IPC::Open3>. Buffers will be available on all platforms,
  interactive commands will still execute cleanly, and also your verbosity
  settings will be adhered to nicely;
  
  =item *
  
  Otherwise, if you have the C<verbose> argument set to true, we fall back
  to a simple C<system()> call. We cannot capture any buffers, but
  interactive commands will still work.
  
  =item *
  
  Otherwise we will try and temporarily redirect STDERR and STDOUT, do a
  C<system()> call with your command and then re-open STDERR and STDOUT.
  This is the method of last resort and will still allow you to execute
  your commands cleanly. However, no buffers will be available.
  
  =back
  
  =head1 Global Variables
  
  The behaviour of IPC::Cmd can be altered by changing the following
  global variables:
  
  =head2 $IPC::Cmd::VERBOSE
  
  This controls whether IPC::Cmd will print any output from the
  commands to the screen or not. The default is 0.
  
  =head2 $IPC::Cmd::USE_IPC_RUN
  
  This variable controls whether IPC::Cmd will try to use L<IPC::Run>
  when available and suitable.
  
  =head2 $IPC::Cmd::USE_IPC_OPEN3
  
  This variable controls whether IPC::Cmd will try to use L<IPC::Open3>
  when available and suitable. Defaults to true.
  
  =head2 $IPC::Cmd::WARN
  
  This variable controls whether run-time warnings should be issued, like
  the failure to load an C<IPC::*> module you explicitly requested.
  
  Defaults to true. Turn this off at your own risk.
  
  =head2 $IPC::Cmd::INSTANCES
  
  This variable controls whether C<can_run> will return all instances of
  the binary it finds in the C<PATH> when called in a list context.
  
  Defaults to false, set to true to enable the described behaviour.
  
  =head2 $IPC::Cmd::ALLOW_NULL_ARGS
  
  This variable controls whether C<run> will remove any empty/null arguments
  it finds in command arguments.
  
  Defaults to false, so it will remove null arguments. Set to true to allow
  them.
  
  =head1 Caveats
  
  =over 4
  
  =item Whitespace and IPC::Open3 / system()
  
  When using C<IPC::Open3> or C<system>, if you provide a string as the
  C<command> argument, it is assumed to be appropriately escaped. You can
  use the C<QUOTE> constant to use as a portable quote character (see above).
  However, if you provide an array reference, special rules apply:
  
  If your command contains B<special characters> (< > | &), it will
  be internally stringified before executing the command, to avoid that these
  special characters are escaped and passed as arguments instead of retaining
  their special meaning.
  
  However, if the command contained arguments that contained whitespace,
  stringifying the command would loose the significance of the whitespace.
  Therefore, C<IPC::Cmd> will quote any arguments containing whitespace in your
  command if the command is passed as an arrayref and contains special characters.
  
  =item Whitespace and IPC::Run
  
  When using C<IPC::Run>, if you provide a string as the C<command> argument,
  the string will be split on whitespace to determine the individual elements
  of your command. Although this will usually just Do What You Mean, it may
  break if you have files or commands with whitespace in them.
  
  If you do not wish this to happen, you should provide an array
  reference, where all parts of your command are already separated out.
  Note however, if there are extra or spurious whitespaces in these parts,
  the parser or underlying code may not interpret it correctly, and
  cause an error.
  
  Example:
  The following code
  
      gzip -cdf foo.tar.gz | tar -xf -
  
  should either be passed as
  
      "gzip -cdf foo.tar.gz | tar -xf -"
  
  or as
  
      ['gzip', '-cdf', 'foo.tar.gz', '|', 'tar', '-xf', '-']
  
  But take care not to pass it as, for example
  
      ['gzip -cdf foo.tar.gz', '|', 'tar -xf -']
  
  Since this will lead to issues as described above.
  
  
  =item IO Redirect
  
  Currently it is too complicated to parse your command for IO
  redirections. For capturing STDOUT or STDERR there is a work around
  however, since you can just inspect your buffers for the contents.
  
  =item Interleaving STDOUT/STDERR
  
  Neither IPC::Run nor IPC::Open3 can interleave STDOUT and STDERR. For short
  bursts of output from a program, e.g. this sample,
  
      for ( 1..4 ) {
          $_ % 2 ? print STDOUT $_ : print STDERR $_;
      }
  
  IPC::[Run|Open3] will first read all of STDOUT, then all of STDERR, meaning
  the output looks like '13' on STDOUT and '24' on STDERR, instead of
  
      1
      2
      3
      4
  
  This has been recorded in L<rt.cpan.org> as bug #37532: Unable to interleave
  STDOUT and STDERR.
  
  =back
  
  =head1 See Also
  
  L<IPC::Run>, L<IPC::Open3>
  
  =head1 ACKNOWLEDGEMENTS
  
  Thanks to James Mastros and Martijn van der Streek for their
  help in getting L<IPC::Open3> to behave nicely.
  
  Thanks to Petya Kohts for the C<run_forked> code.
  
  =head1 BUG REPORTS
  
  Please report bugs or other issues to E<lt>bug-ipc-cmd@rt.cpan.orgE<gt>.
  
  =head1 AUTHOR
  
  Original author: Jos Boumans E<lt>kane@cpan.orgE<gt>.
  Current maintainer: Chris Williams E<lt>bingos@cpan.orgE<gt>.
  
  =head1 COPYRIGHT
  
  This library is free software; you may redistribute and/or modify it
  under the same terms as Perl itself.
  
  =cut
IPC_CMD

$fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
  package JSON::PP;
  
  # JSON-2.0
  
  use 5.005;
  use strict;
  use base qw(Exporter);
  use overload ();
  
  use Carp ();
  use B ();
  #use Devel::Peek;
  
  $JSON::PP::VERSION = '2.27200';
  
  @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
  
  # instead of hash-access, i tried index-access for speed.
  # but this method is not faster than what i expected. so it will be changed.
  
  use constant P_ASCII                => 0;
  use constant P_LATIN1               => 1;
  use constant P_UTF8                 => 2;
  use constant P_INDENT               => 3;
  use constant P_CANONICAL            => 4;
  use constant P_SPACE_BEFORE         => 5;
  use constant P_SPACE_AFTER          => 6;
  use constant P_ALLOW_NONREF         => 7;
  use constant P_SHRINK               => 8;
  use constant P_ALLOW_BLESSED        => 9;
  use constant P_CONVERT_BLESSED      => 10;
  use constant P_RELAXED              => 11;
  
  use constant P_LOOSE                => 12;
  use constant P_ALLOW_BIGNUM         => 13;
  use constant P_ALLOW_BAREKEY        => 14;
  use constant P_ALLOW_SINGLEQUOTE    => 15;
  use constant P_ESCAPE_SLASH         => 16;
  use constant P_AS_NONBLESSED        => 17;
  
  use constant P_ALLOW_UNKNOWN        => 18;
  
  use constant OLD_PERL => $] < 5.008 ? 1 : 0;
  
  BEGIN {
      my @xs_compati_bit_properties = qw(
              latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
              allow_blessed convert_blessed relaxed allow_unknown
      );
      my @pp_bit_properties = qw(
              allow_singlequote allow_bignum loose
              allow_barekey escape_slash as_nonblessed
      );
  
      # Perl version check, Unicode handling is enable?
      # Helper module sets @JSON::PP::_properties.
      if ($] < 5.008 ) {
          my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
          eval qq| require $helper |;
          if ($@) { Carp::croak $@; }
      }
  
      for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
          my $flag_name = 'P_' . uc($name);
  
          eval qq/
              sub $name {
                  my \$enable = defined \$_[1] ? \$_[1] : 1;
  
                  if (\$enable) {
                      \$_[0]->{PROPS}->[$flag_name] = 1;
                  }
                  else {
                      \$_[0]->{PROPS}->[$flag_name] = 0;
                  }
  
                  \$_[0];
              }
  
              sub get_$name {
                  \$_[0]->{PROPS}->[$flag_name] ? 1 : '';
              }
          /;
      }
  
  }
  
  
  
  # Functions
  
  my %encode_allow_method
       = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash
                            allow_blessed convert_blessed indent indent_length allow_bignum
                            as_nonblessed
                          /;
  my %decode_allow_method
       = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum
                            allow_barekey max_size relaxed/;
  
  
  my $JSON; # cache
  
  sub encode_json ($) { # encode
      ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
  }
  
  
  sub decode_json { # decode
      ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
  }
  
  # Obsoleted
  
  sub to_json($) {
     Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
  }
  
  
  sub from_json($) {
     Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
  }
  
  
  # Methods
  
  sub new {
      my $class = shift;
      my $self  = {
          max_depth   => 512,
          max_size    => 0,
          indent      => 0,
          FLAGS       => 0,
          fallback      => sub { encode_error('Invalid value. JSON can only reference.') },
          indent_length => 3,
      };
  
      bless $self, $class;
  }
  
  
  sub encode {
      return $_[0]->PP_encode_json($_[1]);
  }
  
  
  sub decode {
      return $_[0]->PP_decode_json($_[1], 0x00000000);
  }
  
  
  sub decode_prefix {
      return $_[0]->PP_decode_json($_[1], 0x00000001);
  }
  
  
  # accessor
  
  
  # pretty printing
  
  sub pretty {
      my ($self, $v) = @_;
      my $enable = defined $v ? $v : 1;
  
      if ($enable) { # indent_length(3) for JSON::XS compatibility
          $self->indent(1)->indent_length(3)->space_before(1)->space_after(1);
      }
      else {
          $self->indent(0)->space_before(0)->space_after(0);
      }
  
      $self;
  }
  
  # etc
  
  sub max_depth {
      my $max  = defined $_[1] ? $_[1] : 0x80000000;
      $_[0]->{max_depth} = $max;
      $_[0];
  }
  
  
  sub get_max_depth { $_[0]->{max_depth}; }
  
  
  sub max_size {
      my $max  = defined $_[1] ? $_[1] : 0;
      $_[0]->{max_size} = $max;
      $_[0];
  }
  
  
  sub get_max_size { $_[0]->{max_size}; }
  
  
  sub filter_json_object {
      $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0;
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
  
  sub filter_json_single_key_object {
      if (@_ > 1) {
          $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
      }
      $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
      $_[0];
  }
  
  sub indent_length {
      if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
          Carp::carp "The acceptable range of indent_length() is 0 to 15.";
      }
      else {
          $_[0]->{indent_length} = $_[1];
      }
      $_[0];
  }
  
  sub get_indent_length {
      $_[0]->{indent_length};
  }
  
  sub sort_by {
      $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
      $_[0];
  }
  
  sub allow_bigint {
      Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.");
  }
  
  ###############################
  
  ###
  ### Perl => JSON
  ###
  
  
  { # Convert
  
      my $max_depth;
      my $indent;
      my $ascii;
      my $latin1;
      my $utf8;
      my $space_before;
      my $space_after;
      my $canonical;
      my $allow_blessed;
      my $convert_blessed;
  
      my $indent_length;
      my $escape_slash;
      my $bignum;
      my $as_nonblessed;
  
      my $depth;
      my $indent_count;
      my $keysort;
  
  
      sub PP_encode_json {
          my $self = shift;
          my $obj  = shift;
  
          $indent_count = 0;
          $depth        = 0;
  
          my $idx = $self->{PROPS};
  
          ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
              $convert_blessed, $escape_slash, $bignum, $as_nonblessed)
           = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
                      P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED];
  
          ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};
  
          $keysort = $canonical ? sub { $a cmp $b } : undef;
  
          if ($self->{sort_by}) {
              $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
                       : $self->{sort_by} =~ /\D+/       ? $self->{sort_by}
                       : sub { $a cmp $b };
          }
  
          encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
               if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]);
  
          my $str  = $self->object_to_json($obj);
  
          $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible
  
          unless ($ascii or $latin1 or $utf8) {
              utf8::upgrade($str);
          }
  
          if ($idx->[ P_SHRINK ]) {
              utf8::downgrade($str, 1);
          }
  
          return $str;
      }
  
  
      sub object_to_json {
          my ($self, $obj) = @_;
          my $type = ref($obj);
  
          if($type eq 'HASH'){
              return $self->hash_to_json($obj);
          }
          elsif($type eq 'ARRAY'){
              return $self->array_to_json($obj);
          }
          elsif ($type) { # blessed object?
              if (blessed($obj)) {
  
                  return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );
  
                  if ( $convert_blessed and $obj->can('TO_JSON') ) {
                      my $result = $obj->TO_JSON();
                      if ( defined $result and ref( $result ) ) {
                          if ( refaddr( $obj ) eq refaddr( $result ) ) {
                              encode_error( sprintf(
                                  "%s::TO_JSON method returned same object as was passed instead of a new one",
                                  ref $obj
                              ) );
                          }
                      }
  
                      return $self->object_to_json( $result );
                  }
  
                  return "$obj" if ( $bignum and _is_bignum($obj) );
                  return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed.
  
                  encode_error( sprintf("encountered object '%s', but neither allow_blessed "
                      . "nor convert_blessed settings are enabled", $obj)
                  ) unless ($allow_blessed);
  
                  return 'null';
              }
              else {
                  return $self->value_to_json($obj);
              }
          }
          else{
              return $self->value_to_json($obj);
          }
      }
  
  
      sub hash_to_json {
          my ($self, $obj) = @_;
          my @res;
  
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
  
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
          my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');
  
          for my $k ( _sort( $obj ) ) {
              if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
              push @res, string_to_json( $self, $k )
                            .  $del
                            . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) );
          }
  
          --$depth;
          $self->_down_indent() if ($indent);
  
          return   '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' )  . '}';
      }
  
  
      sub array_to_json {
          my ($self, $obj) = @_;
          my @res;
  
          encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                           if (++$depth > $max_depth);
  
          my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
  
          for my $v (@$obj){
              push @res, $self->object_to_json($v) || $self->value_to_json($v);
          }
  
          --$depth;
          $self->_down_indent() if ($indent);
  
          return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']';
      }
  
  
      sub value_to_json {
          my ($self, $value) = @_;
  
          return 'null' if(!defined $value);
  
          my $b_obj = B::svref_2object(\$value);  # for round trip problem
          my $flags = $b_obj->FLAGS;
  
          return $value # as is 
              if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
  
          my $type = ref($value);
  
          if(!$type){
              return string_to_json($self, $value);
          }
          elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
              return $$value == 1 ? 'true' : 'false';
          }
          elsif ($type) {
              if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
                  return $self->value_to_json("$value");
              }
  
              if ($type eq 'SCALAR' and defined $$value) {
                  return   $$value eq '1' ? 'true'
                         : $$value eq '0' ? 'false'
                         : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
                         : encode_error("cannot encode reference to scalar");
              }
  
               if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
                   return 'null';
               }
               else {
                   if ( $type eq 'SCALAR' or $type eq 'REF' ) {
                      encode_error("cannot encode reference to scalar");
                   }
                   else {
                      encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
                   }
               }
  
          }
          else {
              return $self->{fallback}->($value)
                   if ($self->{fallback} and ref($self->{fallback}) eq 'CODE');
              return 'null';
          }
  
      }
  
  
      my %esc = (
          "\n" => '\n',
          "\r" => '\r',
          "\t" => '\t',
          "\f" => '\f',
          "\b" => '\b',
          "\"" => '\"',
          "\\" => '\\\\',
          "\'" => '\\\'',
      );
  
  
      sub string_to_json {
          my ($self, $arg) = @_;
  
          $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
          $arg =~ s/\//\\\//g if ($escape_slash);
          $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
  
          if ($ascii) {
              $arg = JSON_PP_encode_ascii($arg);
          }
  
          if ($latin1) {
              $arg = JSON_PP_encode_latin1($arg);
          }
  
          if ($utf8) {
              utf8::encode($arg);
          }
  
          return '"' . $arg . '"';
      }
  
  
      sub blessed_to_json {
          my $reftype = reftype($_[1]) || '';
          if ($reftype eq 'HASH') {
              return $_[0]->hash_to_json($_[1]);
          }
          elsif ($reftype eq 'ARRAY') {
              return $_[0]->array_to_json($_[1]);
          }
          else {
              return 'null';
          }
      }
  
  
      sub encode_error {
          my $error  = shift;
          Carp::croak "$error";
      }
  
  
      sub _sort {
          defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
      }
  
  
      sub _up_indent {
          my $self  = shift;
          my $space = ' ' x $indent_length;
  
          my ($pre,$post) = ('','');
  
          $post = "\n" . $space x $indent_count;
  
          $indent_count++;
  
          $pre = "\n" . $space x $indent_count;
  
          return ($pre,$post);
      }
  
  
      sub _down_indent { $indent_count--; }
  
  
      sub PP_encode_box {
          {
              depth        => $depth,
              indent_count => $indent_count,
          };
      }
  
  } # Convert
  
  
  sub _encode_ascii {
      join('',
          map {
              $_ <= 127 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
  
  
  sub _encode_latin1 {
      join('',
          map {
              $_ <= 255 ?
                  chr($_) :
              $_ <= 65535 ?
                  sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
          } unpack('U*', $_[0])
      );
  }
  
  
  sub _encode_surrogates { # from perlunicode
      my $uni = $_[0] - 0x10000;
      return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
  }
  
  
  sub _is_bignum {
      $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
  }
  
  
  
  #
  # JSON => Perl
  #
  
  my $max_intsize;
  
  BEGIN {
      my $checkint = 1111;
      for my $d (5..64) {
          $checkint .= 1;
          my $int   = eval qq| $checkint |;
          if ($int =~ /[eE]/) {
              $max_intsize = $d - 1;
              last;
          }
      }
  }
  
  { # PARSE 
  
      my %escapes = ( #  by Jeremy Muhlich <jmuhlich [at] bitflood.org>
          b    => "\x8",
          t    => "\x9",
          n    => "\xA",
          f    => "\xC",
          r    => "\xD",
          '\\' => '\\',
          '"'  => '"',
          '/'  => '/',
      );
  
      my $text; # json data
      my $at;   # offset
      my $ch;   # 1chracter
      my $len;  # text length (changed according to UTF8 or NON UTF8)
      # INTERNAL
      my $depth;          # nest counter
      my $encoding;       # json text encoding
      my $is_valid_utf8;  # temp variable
      my $utf8_len;       # utf8 byte length
      # FLAGS
      my $utf8;           # must be utf8
      my $max_depth;      # max nest nubmer of objects and arrays
      my $max_size;
      my $relaxed;
      my $cb_object;
      my $cb_sk_object;
  
      my $F_HOOK;
  
      my $allow_bigint;   # using Math::BigInt
      my $singlequote;    # loosely quoting
      my $loose;          # 
      my $allow_barekey;  # bareKey
  
      # $opt flag
      # 0x00000001 .... decode_prefix
      # 0x10000000 .... incr_parse
  
      sub PP_decode_json {
          my ($self, $opt); # $opt is an effective flag during this decode_json.
  
          ($self, $text, $opt) = @_;
  
          ($at, $ch, $depth) = (0, '', 0);
  
          if ( !defined $text or ref $text ) {
              decode_error("malformed JSON string, neither array, object, number, string or atom");
          }
  
          my $idx = $self->{PROPS};
  
          ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote)
              = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE];
  
          if ( $utf8 ) {
              utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
          }
          else {
              utf8::upgrade( $text );
          }
  
          $len = length $text;
  
          ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
               = @{$self}{qw/max_depth  max_size cb_object cb_sk_object F_HOOK/};
  
          if ($max_size > 1) {
              use bytes;
              my $bytes = length $text;
              decode_error(
                  sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
                      , $bytes, $max_size), 1
              ) if ($bytes > $max_size);
          }
  
          # Currently no effect
          # should use regexp
          my @octets = unpack('C4', $text);
          $encoding =   ( $octets[0] and  $octets[1]) ? 'UTF-8'
                      : (!$octets[0] and  $octets[1]) ? 'UTF-16BE'
                      : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
                      : ( $octets[2]                ) ? 'UTF-16LE'
                      : (!$octets[2]                ) ? 'UTF-32LE'
                      : 'unknown';
  
          white(); # remove head white space
  
          my $valid_start = defined $ch; # Is there a first character for JSON structure?
  
          my $result = value();
  
          return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse
  
          decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start;
  
          if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) {
                  decode_error(
                  'JSON text must be an object or array (but found number, string, true, false or null,'
                         . ' use allow_nonref to allow this)', 1);
          }
  
          Carp::croak('something wrong.') if $len < $at; # we won't arrive here.
  
          my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length
  
          white(); # remove tail white space
  
          if ( $ch ) {
              return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix
              decode_error("garbage after JSON object");
          }
  
          ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result;
      }
  
  
      sub next_chr {
          return $ch = undef if($at >= $len);
          $ch = substr($text, $at++, 1);
      }
  
  
      sub value {
          white();
          return          if(!defined $ch);
          return object() if($ch eq '{');
          return array()  if($ch eq '[');
          return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
          return number() if($ch =~ /[0-9]/ or $ch eq '-');
          return word();
      }
  
      sub string {
          my ($i, $s, $t, $u);
          my $utf16;
          my $is_utf8;
  
          ($is_valid_utf8, $utf8_len) = ('', 0);
  
          $s = ''; # basically UTF8 flag on
  
          if($ch eq '"' or ($singlequote and $ch eq "'")){
              my $boundChar = $ch;
  
              OUTER: while( defined(next_chr()) ){
  
                  if($ch eq $boundChar){
                      next_chr();
  
                      if ($utf16) {
                          decode_error("missing low surrogate character in surrogate pair");
                      }
  
                      utf8::decode($s) if($is_utf8);
  
                      return $s;
                  }
                  elsif($ch eq '\\'){
                      next_chr();
                      if(exists $escapes{$ch}){
                          $s .= $escapes{$ch};
                      }
                      elsif($ch eq 'u'){ # UNICODE handling
                          my $u = '';
  
                          for(1..4){
                              $ch = next_chr();
                              last OUTER if($ch !~ /[0-9a-fA-F]/);
                              $u .= $ch;
                          }
  
                          # U+D800 - U+DBFF
                          if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
                              $utf16 = $u;
                          }
                          # U+DC00 - U+DFFF
                          elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
                              unless (defined $utf16) {
                                  decode_error("missing high surrogate character in surrogate pair");
                              }
                              $is_utf8 = 1;
                              $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
                              $utf16 = undef;
                          }
                          else {
                              if (defined $utf16) {
                                  decode_error("surrogate pair expected");
                              }
  
                              if ( ( my $hex = hex( $u ) ) > 127 ) {
                                  $is_utf8 = 1;
                                  $s .= JSON_PP_decode_unicode($u) || next;
                              }
                              else {
                                  $s .= chr $hex;
                              }
                          }
  
                      }
                      else{
                          unless ($loose) {
                              $at -= 2;
                              decode_error('illegal backslash escape sequence in string');
                          }
                          $s .= $ch;
                      }
                  }
                  else{
  
                      if ( ord $ch  > 127 ) {
                          if ( $utf8 ) {
                              unless( $ch = is_valid_utf8($ch) ) {
                                  $at -= 1;
                                  decode_error("malformed UTF-8 character in JSON string");
                              }
                              else {
                                  $at += $utf8_len - 1;
                              }
                          }
                          else {
                              utf8::encode( $ch );
                          }
  
                          $is_utf8 = 1;
                      }
  
                      if (!$loose) {
                          if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
                              $at--;
                              decode_error('invalid character encountered while parsing JSON string');
                          }
                      }
  
                      $s .= $ch;
                  }
              }
          }
  
          decode_error("unexpected end of string while parsing JSON string");
      }
  
  
      sub white {
          while( defined $ch  ){
              if($ch le ' '){
                  next_chr();
              }
              elsif($ch eq '/'){
                  next_chr();
                  if(defined $ch and $ch eq '/'){
                      1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
                  }
                  elsif(defined $ch and $ch eq '*'){
                      next_chr();
                      while(1){
                          if(defined $ch){
                              if($ch eq '*'){
                                  if(defined(next_chr()) and $ch eq '/'){
                                      next_chr();
                                      last;
                                  }
                              }
                              else{
                                  next_chr();
                              }
                          }
                          else{
                              decode_error("Unterminated comment");
                          }
                      }
                      next;
                  }
                  else{
                      $at--;
                      decode_error("malformed JSON string, neither array, object, number, string or atom");
                  }
              }
              else{
                  if ($relaxed and $ch eq '#') { # correctly?
                      pos($text) = $at;
                      $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
                      $at = pos($text);
                      next_chr;
                      next;
                  }
  
                  last;
              }
          }
      }
  
  
      sub array {
          my $a  = $_[0] || []; # you can use this code to use another array ref object.
  
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                      if (++$depth > $max_depth);
  
          next_chr();
          white();
  
          if(defined $ch and $ch eq ']'){
              --$depth;
              next_chr();
              return $a;
          }
          else {
              while(defined($ch)){
                  push @$a, value();
  
                  white();
  
                  if (!defined $ch) {
                      last;
                  }
  
                  if($ch eq ']'){
                      --$depth;
                      next_chr();
                      return $a;
                  }
  
                  if($ch ne ','){
                      last;
                  }
  
                  next_chr();
                  white();
  
                  if ($relaxed and $ch eq ']') {
                      --$depth;
                      next_chr();
                      return $a;
                  }
  
              }
          }
  
          decode_error(", or ] expected while parsing array");
      }
  
  
      sub object {
          my $o = $_[0] || {}; # you can use this code to use another hash ref object.
          my $k;
  
          decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                  if (++$depth > $max_depth);
          next_chr();
          white();
  
          if(defined $ch and $ch eq '}'){
              --$depth;
              next_chr();
              if ($F_HOOK) {
                  return _json_object_hook($o);
              }
              return $o;
          }
          else {
              while (defined $ch) {
                  $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
                  white();
  
                  if(!defined $ch or $ch ne ':'){
                      $at--;
                      decode_error("':' expected");
                  }
  
                  next_chr();
                  $o->{$k} = value();
                  white();
  
                  last if (!defined $ch);
  
                  if($ch eq '}'){
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
  
                  if($ch ne ','){
                      last;
                  }
  
                  next_chr();
                  white();
  
                  if ($relaxed and $ch eq '}') {
                      --$depth;
                      next_chr();
                      if ($F_HOOK) {
                          return _json_object_hook($o);
                      }
                      return $o;
                  }
  
              }
  
          }
  
          $at--;
          decode_error(", or } expected while parsing object/hash");
      }
  
  
      sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
          my $key;
          while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
              $key .= $ch;
              next_chr();
          }
          return $key;
      }
  
  
      sub word {
          my $word =  substr($text,$at-1,4);
  
          if($word eq 'true'){
              $at += 3;
              next_chr;
              return $JSON::PP::true;
          }
          elsif($word eq 'null'){
              $at += 3;
              next_chr;
              return undef;
          }
          elsif($word eq 'fals'){
              $at += 3;
              if(substr($text,$at,1) eq 'e'){
                  $at++;
                  next_chr;
                  return $JSON::PP::false;
              }
          }
  
          $at--; # for decode_error report
  
          decode_error("'null' expected")  if ($word =~ /^n/);
          decode_error("'true' expected")  if ($word =~ /^t/);
          decode_error("'false' expected") if ($word =~ /^f/);
          decode_error("malformed JSON string, neither array, object, number, string or atom");
      }
  
  
      sub number {
          my $n    = '';
          my $v;
  
          # According to RFC4627, hex or oct digts are invalid.
          if($ch eq '0'){
              my $peek = substr($text,$at,1);
              my $hex  = $peek =~ /[xX]/; # 0 or 1
  
              if($hex){
                  decode_error("malformed number (leading zero must not be followed by another digit)");
                  ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/);
              }
              else{ # oct
                  ($n) = ( substr($text, $at) =~ /^([0-7]+)/);
                  if (defined $n and length $n > 1) {
                      decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
              }
  
              if(defined $n and length($n)){
                  if (!$hex and length($n) == 1) {
                     decode_error("malformed number (leading zero must not be followed by another digit)");
                  }
                  $at += length($n) + $hex;
                  next_chr;
                  return $hex ? hex($n) : oct($n);
              }
          }
  
          if($ch eq '-'){
              $n = '-';
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after initial minus)");
              }
          }
  
          while(defined $ch and $ch =~ /\d/){
              $n .= $ch;
              next_chr;
          }
  
          if(defined $ch and $ch eq '.'){
              $n .= '.';
  
              next_chr;
              if (!defined $ch or $ch !~ /\d/) {
                  decode_error("malformed number (no digits after decimal point)");
              }
              else {
                  $n .= $ch;
              }
  
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
          }
  
          if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
              $n .= $ch;
              next_chr;
  
              if(defined($ch) and ($ch eq '+' or $ch eq '-')){
                  $n .= $ch;
                  next_chr;
                  if (!defined $ch or $ch =~ /\D/) {
                      decode_error("malformed number (no digits after exp sign)");
                  }
                  $n .= $ch;
              }
              elsif(defined($ch) and $ch =~ /\d/){
                  $n .= $ch;
              }
              else {
                  decode_error("malformed number (no digits after exp sign)");
              }
  
              while(defined(next_chr) and $ch =~ /\d/){
                  $n .= $ch;
              }
  
          }
  
          $v .= $n;
  
          if ($v !~ /[.eE]/ and length $v > $max_intsize) {
              if ($allow_bigint) { # from Adam Sussman
                  require Math::BigInt;
                  return Math::BigInt->new($v);
              }
              else {
                  return "$v";
              }
          }
          elsif ($allow_bigint) {
              require Math::BigFloat;
              return Math::BigFloat->new($v);
          }
  
          return 0+$v;
      }
  
  
      sub is_valid_utf8 {
  
          $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
                    : $_[0] =~ /[\xC2-\xDF]/  ? 2
                    : $_[0] =~ /[\xE0-\xEF]/  ? 3
                    : $_[0] =~ /[\xF0-\xF4]/  ? 4
                    : 0
                    ;
  
          return unless $utf8_len;
  
          my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);
  
          return ( $is_valid_utf8 =~ /^(?:
               [\x00-\x7F]
              |[\xC2-\xDF][\x80-\xBF]
              |[\xE0][\xA0-\xBF][\x80-\xBF]
              |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
              |[\xED][\x80-\x9F][\x80-\xBF]
              |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
              |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
              |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
          )$/x )  ? $is_valid_utf8 : '';
      }
  
  
      sub decode_error {
          my $error  = shift;
          my $no_rep = shift;
          my $str    = defined $text ? substr($text, $at) : '';
          my $mess   = '';
          my $type   = $] >= 5.008           ? 'U*'
                     : $] <  5.006           ? 'C*'
                     : utf8::is_utf8( $str ) ? 'U*' # 5.6
                     : 'C*'
                     ;
  
          for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
              $mess .=  $c == 0x07 ? '\a'
                      : $c == 0x09 ? '\t'
                      : $c == 0x0a ? '\n'
                      : $c == 0x0d ? '\r'
                      : $c == 0x0c ? '\f'
                      : $c <  0x20 ? sprintf('\x{%x}', $c)
                      : $c == 0x5c ? '\\\\'
                      : $c <  0x80 ? chr($c)
                      : sprintf('\x{%x}', $c)
                      ;
              if ( length $mess >= 20 ) {
                  $mess .= '...';
                  last;
              }
          }
  
          unless ( length $mess ) {
              $mess = '(end of string)';
          }
  
          Carp::croak (
              $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
          );
  
      }
  
  
      sub _json_object_hook {
          my $o    = $_[0];
          my @ks = keys %{$o};
  
          if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
              my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
              if (@val == 1) {
                  return $val[0];
              }
          }
  
          my @val = $cb_object->($o) if ($cb_object);
          if (@val == 0 or @val > 1) {
              return $o;
          }
          else {
              return $val[0];
          }
      }
  
  
      sub PP_decode_box {
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
      }
  
  } # PARSE
  
  
  sub _decode_surrogates { # from perlunicode
      my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
      my $un  = pack('U*', $uni);
      utf8::encode( $un );
      return $un;
  }
  
  
  sub _decode_unicode {
      my $un = pack('U', hex shift);
      utf8::encode( $un );
      return $un;
  }
  
  #
  # Setup for various Perl versions (the code from JSON::PP58)
  #
  
  BEGIN {
  
      unless ( defined &utf8::is_utf8 ) {
         require Encode;
         *utf8::is_utf8 = *Encode::is_utf8;
      }
  
      if ( $] >= 5.008 ) {
          *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
          *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
          *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
          *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
      }
  
      if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
          package JSON::PP;
          require subs;
          subs->import('join');
          eval q|
              sub join {
                  return '' if (@_ < 2);
                  my $j   = shift;
                  my $str = shift;
                  for (@_) { $str .= $j . $_; }
                  return $str;
              }
          |;
      }
  
  
      sub JSON::PP::incr_parse {
          local $Carp::CarpLevel = 1;
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
      }
  
  
      sub JSON::PP::incr_skip {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
      }
  
  
      sub JSON::PP::incr_reset {
          ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
      }
  
      eval q{
          sub JSON::PP::incr_text : lvalue {
              $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
  
              if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
                  Carp::croak("incr_text can not be called when the incremental parser already started parsing");
              }
              $_[0]->{_incr_parser}->{incr_text};
          }
      } if ( $] >= 5.006 );
  
  } # Setup for various Perl versions (the code from JSON::PP58)
  
  
  ###############################
  # Utilities
  #
  
  BEGIN {
      eval 'require Scalar::Util';
      unless($@){
          *JSON::PP::blessed = \&Scalar::Util::blessed;
          *JSON::PP::reftype = \&Scalar::Util::reftype;
          *JSON::PP::refaddr = \&Scalar::Util::refaddr;
      }
      else{ # This code is from Sclar::Util.
          # warn $@;
          eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
          *JSON::PP::blessed = sub {
              local($@, $SIG{__DIE__}, $SIG{__WARN__});
              ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
          };
          my %tmap = qw(
              B::NULL   SCALAR
              B::HV     HASH
              B::AV     ARRAY
              B::CV     CODE
              B::IO     IO
              B::GV     GLOB
              B::REGEXP REGEXP
          );
          *JSON::PP::reftype = sub {
              my $r = shift;
  
              return undef unless length(ref($r));
  
              my $t = ref(B::svref_2object($r));
  
              return
                  exists $tmap{$t} ? $tmap{$t}
                : length(ref($$r)) ? 'REF'
                :                    'SCALAR';
          };
          *JSON::PP::refaddr = sub {
            return undef unless length(ref($_[0]));
  
            my $addr;
            if(defined(my $pkg = blessed($_[0]))) {
              $addr .= bless $_[0], 'Scalar::Util::Fake';
              bless $_[0], $pkg;
            }
            else {
              $addr .= $_[0]
            }
  
            $addr =~ /0x(\w+)/;
            local $^W;
            #no warnings 'portable';
            hex($1);
          }
      }
  }
  
  
  # shamely copied and modified from JSON::XS code.
  
  $JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
  $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
  
  sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); }
  
  sub true  { $JSON::PP::true  }
  sub false { $JSON::PP::false }
  sub null  { undef; }
  
  ###############################
  
  package JSON::PP::Boolean;
  
  use overload (
     "0+"     => sub { ${$_[0]} },
     "++"     => sub { $_[0] = ${$_[0]} + 1 },
     "--"     => sub { $_[0] = ${$_[0]} - 1 },
     fallback => 1,
  );
  
  
  ###############################
  
  package JSON::PP::IncrParser;
  
  use strict;
  
  use constant INCR_M_WS   => 0; # initial whitespace skipping
  use constant INCR_M_STR  => 1; # inside string
  use constant INCR_M_BS   => 2; # inside backslash
  use constant INCR_M_JSON => 3; # outside anything, count nesting
  use constant INCR_M_C0   => 4;
  use constant INCR_M_C1   => 5;
  
  $JSON::PP::IncrParser::VERSION = '1.01';
  
  my $unpack_format = $] < 5.006 ? 'C*' : 'U*';
  
  sub new {
      my ( $class ) = @_;
  
      bless {
          incr_nest    => 0,
          incr_text    => undef,
          incr_parsing => 0,
          incr_p       => 0,
      }, $class;
  }
  
  
  sub incr_parse {
      my ( $self, $coder, $text ) = @_;
  
      $self->{incr_text} = '' unless ( defined $self->{incr_text} );
  
      if ( defined $text ) {
          if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
              utf8::upgrade( $self->{incr_text} ) ;
              utf8::decode( $self->{incr_text} ) ;
          }
          $self->{incr_text} .= $text;
      }
  
  
      my $max_size = $coder->get_max_size;
  
      if ( defined wantarray ) {
  
          $self->{incr_mode} = INCR_M_WS unless defined $self->{incr_mode};
  
          if ( wantarray ) {
              my @ret;
  
              $self->{incr_parsing} = 1;
  
              do {
                  push @ret, $self->_incr_parse( $coder, $self->{incr_text} );
  
                  unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) {
                      $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR;
                  }
  
              } until ( length $self->{incr_text} >= $self->{incr_p} );
  
              $self->{incr_parsing} = 0;
  
              return @ret;
          }
          else { # in scalar context
              $self->{incr_parsing} = 1;
              my $obj = $self->_incr_parse( $coder, $self->{incr_text} );
              $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans
              return $obj ? $obj : undef; # $obj is an empty string, parsing was completed.
          }
  
      }
  
  }
  
  
  sub _incr_parse {
      my ( $self, $coder, $text, $skip ) = @_;
      my $p = $self->{incr_p};
      my $restore = $p;
  
      my @obj;
      my $len = length $text;
  
      if ( $self->{incr_mode} == INCR_M_WS ) {
          while ( $len > $p ) {
              my $s = substr( $text, $p, 1 );
              $p++ and next if ( 0x20 >= unpack($unpack_format, $s) );
              $self->{incr_mode} = INCR_M_JSON;
              last;
         }
      }
  
      while ( $len > $p ) {
          my $s = substr( $text, $p++, 1 );
  
          if ( $s eq '"' ) {
              if (substr( $text, $p - 2, 1 ) eq '\\' ) {
                  next;
              }
  
              if ( $self->{incr_mode} != INCR_M_STR  ) {
                  $self->{incr_mode} = INCR_M_STR;
              }
              else {
                  $self->{incr_mode} = INCR_M_JSON;
                  unless ( $self->{incr_nest} ) {
                      last;
                  }
              }
          }
  
          if ( $self->{incr_mode} == INCR_M_JSON ) {
  
              if ( $s eq '[' or $s eq '{' ) {
                  if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
                      Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
                  }
              }
              elsif ( $s eq ']' or $s eq '}' ) {
                  last if ( --$self->{incr_nest} <= 0 );
              }
              elsif ( $s eq '#' ) {
                  while ( $len > $p ) {
                      last if substr( $text, $p++, 1 ) eq "\n";
                  }
              }
  
          }
  
      }
  
      $self->{incr_p} = $p;
  
      return if ( $self->{incr_mode} == INCR_M_STR and not $self->{incr_nest} );
      return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 );
  
      return '' unless ( length substr( $self->{incr_text}, 0, $p ) );
  
      local $Carp::CarpLevel = 2;
  
      $self->{incr_p} = $restore;
      $self->{incr_c} = $p;
  
      my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 );
  
      $self->{incr_text} = substr( $self->{incr_text}, $p );
      $self->{incr_p} = 0;
  
      return $obj or '';
  }
  
  
  sub incr_text {
      if ( $_[0]->{incr_parsing} ) {
          Carp::croak("incr_text can not be called when the incremental parser already started parsing");
      }
      $_[0]->{incr_text};
  }
  
  
  sub incr_skip {
      my $self  = shift;
      $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} );
      $self->{incr_p} = 0;
  }
  
  
  sub incr_reset {
      my $self = shift;
      $self->{incr_text}    = undef;
      $self->{incr_p}       = 0;
      $self->{incr_mode}    = 0;
      $self->{incr_nest}    = 0;
      $self->{incr_parsing} = 0;
  }
  
  ###############################
  
  
  1;
  __END__
  =pod
  
  =head1 NAME
  
  JSON::PP - JSON::XS compatible pure-Perl module.
  
  =head1 SYNOPSIS
  
   use JSON::PP;
  
   # exported functions, they croak on error
   # and expect/generate UTF-8
  
   $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
   $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;
  
   # OO-interface
  
   $coder = JSON::PP->new->ascii->pretty->allow_nonref;
   
   $json_text   = $json->encode( $perl_scalar );
   $perl_scalar = $json->decode( $json_text );
   
   $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing
   
   # Note that JSON version 2.0 and above will automatically use
   # JSON::XS or JSON::PP, so you should be able to just:
   
   use JSON;
  
  
  =head1 VERSION
  
      2.27200
  
  L<JSON::XS> 2.27 (~2.30) compatible.
  
  =head1 NOTE
  
  JSON::PP was inculded in JSON distribution (CPAN module).
  It comes to be a perl core module in Perl 5.14.
  
      [STEPS]
  
      * release this module as JSON::PPdev.
  
      * release other PP::* modules as JSON::PP::Compat*.
  
      * JSON distribution will inculde yet another JSON::PP modules.
        They are JSNO::backportPP. So JSON.pm should work as it did at all!
  
      * remove JSON::PP and JSON::PP::* modules from JSON distribution
         and release it as developer version.
  
      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
      * release JSON distribution as stable version.
  
      * rename JSON::PPdev into JSON::PP and release on CPAN. <<<< HERE
  
  =head1 DESCRIPTION
  
  This module is L<JSON::XS> compatible pure Perl module.
  (Perl 5.8 or later is recommended)
  
  JSON::XS is the fastest and most proper JSON module on CPAN.
  It is written by Marc Lehmann in C, so must be compiled and
  installed in the used environment.
  
  JSON::PP is a pure-Perl module and has compatibility to JSON::XS.
  
  
  =head2 FEATURES
  
  =over
  
  =item * correct unicode handling
  
  This module knows how to handle Unicode (depending on Perl version).
  
  See to L<JSON::XS/A FEW NOTES ON UNICODE AND PERL> and L<UNICODE HANDLING ON PERLS>.
  
  
  =item * round-trip integrity
  
  When you serialise a perl data structure using only data types supported
  by JSON and Perl, the deserialised data structure is identical on the Perl
  level. (e.g. the string "2.0" doesn't suddenly become "2" just because
  it looks like a number). There I<are> minor exceptions to this, read the
  MAPPING section below to learn about those.
  
  
  =item * strict checking of JSON correctness
  
  There is no guessing, no generating of illegal JSON texts by default,
  and only JSON is accepted as input by default (the latter is a security feature).
  But when some options are set, loose chcking features are available.
  
  =back
  
  =head1 FUNCTIONAL INTERFACE
  
  Some documents are copied and modified from L<JSON::XS/FUNCTIONAL INTERFACE>.
  
  =head2 encode_json
  
      $json_text = encode_json $perl_scalar
  
  Converts the given Perl data structure to a UTF-8 encoded, binary string.
  
  This function call is functionally identical to:
  
      $json_text = JSON::PP->new->utf8->encode($perl_scalar)
  
  =head2 decode_json
  
      $perl_scalar = decode_json $json_text
  
  The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
  to parse that as an UTF-8 encoded JSON text, returning the resulting
  reference.
  
  This function call is functionally identical to:
  
      $perl_scalar = JSON::PP->new->utf8->decode($json_text)
  
  =head2 JSON::PP::is_bool
  
      $is_boolean = JSON::PP::is_bool($scalar)
  
  Returns true if the passed scalar represents either JSON::PP::true or
  JSON::PP::false, two constants that act like C<1> and C<0> respectively
  and are also used to represent JSON C<true> and C<false> in Perl strings.
  
  =head2 JSON::PP::true
  
  Returns JSON true value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
  
  =head2 JSON::PP::false
  
  Returns JSON false value which is blessed object.
  It C<isa> JSON::PP::Boolean object.
  
  =head2 JSON::PP::null
  
  Returns C<undef>.
  
  See L<MAPPING>, below, for more information on how JSON values are mapped to
  Perl.
  
  
  =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER
  
  This section supposes that your perl vresion is 5.8 or later.
  
  If you know a JSON text from an outer world - a network, a file content, and so on,
  is encoded in UTF-8, you should use C<decode_json> or C<JSON> module object
  with C<utf8> enable. And the decoded result will contain UNICODE characters.
  
    # from network
    my $json        = JSON::PP->new->utf8;
    my $json_text   = CGI->new->param( 'json_data' );
    my $perl_scalar = $json->decode( $json_text );
    
    # from file content
    local $/;
    open( my $fh, '<', 'json.data' );
    $json_text   = <$fh>;
    $perl_scalar = decode_json( $json_text );
  
  If an outer data is not encoded in UTF-8, firstly you should C<decode> it.
  
    use Encode;
    local $/;
    open( my $fh, '<', 'json.data' );
    my $encoding = 'cp932';
    my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE
    
    # or you can write the below code.
    #
    # open( my $fh, "<:encoding($encoding)", 'json.data' );
    # $unicode_json_text = <$fh>;
  
  In this case, C<$unicode_json_text> is of course UNICODE string.
  So you B<cannot> use C<decode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
  
    $perl_scalar = $json->utf8(0)->decode( $unicode_json_text );
  
  Or C<encode 'utf8'> and C<decode_json>:
  
    $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) );
    # this way is not efficient.
  
  And now, you want to convert your C<$perl_scalar> into JSON data and
  send it to an outer world - a network or a file content, and so on.
  
  Your data usually contains UNICODE strings and you want the converted data to be encoded
  in UTF-8, you should use C<encode_json> or C<JSON> module object with C<utf8> enable.
  
    print encode_json( $perl_scalar ); # to a network? file? or display?
    # or
    print $json->utf8->encode( $perl_scalar );
  
  If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings
  for some reason, then its characters are regarded as B<latin1> for perl
  (because it does not concern with your $encoding).
  You B<cannot> use C<encode_json> nor C<JSON> module object with C<utf8> enable.
  Instead of them, you use C<JSON> module object with C<utf8> disable.
  Note that the resulted text is a UNICODE string but no problem to print it.
  
    # $perl_scalar contains $encoding encoded string values
    $unicode_json_text = $json->utf8(0)->encode( $perl_scalar );
    # $unicode_json_text consists of characters less than 0x100
    print $unicode_json_text;
  
  Or C<decode $encoding> all string values and C<encode_json>:
  
    $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } );
    # ... do it to each string values, then encode_json
    $json_text = encode_json( $perl_scalar );
  
  This method is a proper way but probably not efficient.
  
  See to L<Encode>, L<perluniintro>.
  
  
  =head1 METHODS
  
  Basically, check to L<JSON> or L<JSON::XS>.
  
  =head2 new
  
      $json = JSON::PP->new
  
  Rturns a new JSON::PP object that can be used to de/encode JSON
  strings.
  
  All boolean flags described below are by default I<disabled>.
  
  The mutators for flags all return the JSON object again and thus calls can
  be chained:
  
     my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
     => {"a": [1, 2]}
  
  =head2 ascii
  
      $json = $json->ascii([$enable])
      
      $enabled = $json->get_ascii
  
  If $enable is true (or missing), then the encode method will not generate characters outside
  the code range 0..127. Any Unicode characters outside that range will be escaped using either
  a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627.
  (See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>).
  
  In Perl 5.005, there is no character having high value (more than 255).
  See to L<UNICODE HANDLING ON PERLS>.
  
  If $enable is false, then the encode method will not escape Unicode characters unless
  required by the JSON syntax or other flags. This results in a faster and more compact format.
  
    JSON::PP->new->ascii(1)->encode([chr 0x10401])
    => ["\ud801\udc01"]
  
  =head2 latin1
  
      $json = $json->latin1([$enable])
      
      $enabled = $json->get_latin1
  
  If $enable is true (or missing), then the encode method will encode the resulting JSON
  text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255.
  
  If $enable is false, then the encode method will not escape Unicode characters
  unless required by the JSON syntax or other flags.
  
    JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
    => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)
  
  See to L<UNICODE HANDLING ON PERLS>.
  
  =head2 utf8
  
      $json = $json->utf8([$enable])
      
      $enabled = $json->get_utf8
  
  If $enable is true (or missing), then the encode method will encode the JSON result
  into UTF-8, as required by many protocols, while the decode method expects to be handled
  an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any
  characters outside the range 0..255, they are thus useful for bytewise/binary I/O.
  
  (In Perl 5.005, any character outside the range 0..255 does not exist.
  See to L<UNICODE HANDLING ON PERLS>.)
  
  In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32
  encoding families, as described in RFC4627.
  
  If $enable is false, then the encode method will return the JSON string as a (non-encoded)
  Unicode string, while decode expects thus a Unicode string. Any decoding or encoding
  (e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module.
  
  Example, output UTF-16BE-encoded JSON:
  
    use Encode;
    $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);
  
  Example, decode UTF-32LE-encoded JSON:
  
    use Encode;
    $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);
  
  
  =head2 pretty
  
      $json = $json->pretty([$enable])
  
  This enables (or disables) all of the C<indent>, C<space_before> and
  C<space_after> flags in one call to generate the most readable
  (or most compact) form possible.
  
  Equivalent to:
  
     $json->indent->space_before->space_after
  
  =head2 indent
  
      $json = $json->indent([$enable])
      
      $enabled = $json->get_indent
  
  The default indent space length is three.
  You can use C<indent_length> to change the length.
  
  =head2 space_before
  
      $json = $json->space_before([$enable])
      
      $enabled = $json->get_space_before
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space before the C<:> separating keys from values in JSON objects.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before enabled, space_after and indent disabled:
  
     {"key" :"value"}
  
  =head2 space_after
  
      $json = $json->space_after([$enable])
      
      $enabled = $json->get_space_after
  
  If C<$enable> is true (or missing), then the C<encode> method will add an extra
  optional space after the C<:> separating keys from values in JSON objects
  and extra whitespace after the C<,> separating key-value pairs and array
  members.
  
  If C<$enable> is false, then the C<encode> method will not add any extra
  space at those places.
  
  This setting has no effect when decoding JSON texts.
  
  Example, space_before and indent disabled, space_after enabled:
  
     {"key": "value"}
  
  =head2 relaxed
  
      $json = $json->relaxed([$enable])
      
      $enabled = $json->get_relaxed
  
  If C<$enable> is true (or missing), then C<decode> will accept some
  extensions to normal JSON syntax (see below). C<encode> will not be
  affected in anyway. I<Be aware that this option makes you accept invalid
  JSON texts as if they were valid!>. I suggest only to use this option to
  parse application-specific files written by humans (configuration files,
  resource files etc.)
  
  If C<$enable> is false (the default), then C<decode> will only accept
  valid JSON texts.
  
  Currently accepted extensions are:
  
  =over 4
  
  =item * list items can have an end-comma
  
  JSON I<separates> array elements and key-value pairs with commas. This
  can be annoying if you write JSON texts manually and want to be able to
  quickly append elements, so this extension accepts comma at the end of
  such items not just between them:
  
     [
        1,
        2, <- this comma not normally allowed
     ]
     {
        "k1": "v1",
        "k2": "v2", <- this comma not normally allowed
     }
  
  =item * shell-style '#'-comments
  
  Whenever JSON allows whitespace, shell-style comments are additionally
  allowed. They are terminated by the first carriage-return or line-feed
  character, after which more white-space and comments are allowed.
  
    [
       1, # this comment not allowed in JSON
          # neither this one...
    ]
  
  =back
  
  =head2 canonical
  
      $json = $json->canonical([$enable])
      
      $enabled = $json->get_canonical
  
  If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
  by sorting their keys. This is adding a comparatively high overhead.
  
  If C<$enable> is false, then the C<encode> method will output key-value
  pairs in the order Perl stores them (which will likely change between runs
  of the same script).
  
  This option is useful if you want the same data structure to be encoded as
  the same JSON text (given the same overall settings). If it is disabled,
  the same hash might be encoded differently even if contains the same data,
  as key-value pairs have no inherent ordering in Perl.
  
  This setting has no effect when decoding JSON texts.
  
  If you want your own sorting routine, you can give a code referece
  or a subroutine name to C<sort_by>. See to C<JSON::PP OWN METHODS>.
  
  =head2 allow_nonref
  
      $json = $json->allow_nonref([$enable])
      
      $enabled = $json->get_allow_nonref
  
  If C<$enable> is true (or missing), then the C<encode> method can convert a
  non-reference into its corresponding string, number or null JSON value,
  which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
  values instead of croaking.
  
  If C<$enable> is false, then the C<encode> method will croak if it isn't
  passed an arrayref or hashref, as JSON texts must either be an object
  or array. Likewise, C<decode> will croak if given something that is not a
  JSON object or array.
  
     JSON::PP->new->allow_nonref->encode ("Hello, World!")
     => "Hello, World!"
  
  =head2 allow_unknown
  
      $json = $json->allow_unknown ([$enable])
      
      $enabled = $json->get_allow_unknown
  
  If $enable is true (or missing), then "encode" will *not* throw an
  exception when it encounters values it cannot represent in JSON (for
  example, filehandles) but instead will encode a JSON "null" value.
  Note that blessed objects are not included here and are handled
  separately by c<allow_nonref>.
  
  If $enable is false (the default), then "encode" will throw an
  exception when it encounters anything it cannot encode as JSON.
  
  This option does not affect "decode" in any way, and it is
  recommended to leave it off unless you know your communications
  partner.
  
  =head2 allow_blessed
  
      $json = $json->allow_blessed([$enable])
      
      $enabled = $json->get_allow_blessed
  
  If C<$enable> is true (or missing), then the C<encode> method will not
  barf when it encounters a blessed reference. Instead, the value of the
  B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
  disabled or no C<TO_JSON> method found) or a representation of the
  object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
  encoded. Has no effect on C<decode>.
  
  If C<$enable> is false (the default), then C<encode> will throw an
  exception when it encounters a blessed object.
  
  =head2 convert_blessed
  
      $json = $json->convert_blessed([$enable])
      
      $enabled = $json->get_convert_blessed
  
  If C<$enable> is true (or missing), then C<encode>, upon encountering a
  blessed object, will check for the availability of the C<TO_JSON> method
  on the object's class. If found, it will be called in scalar context
  and the resulting scalar will be encoded instead of the object. If no
  C<TO_JSON> method is found, the value of C<allow_blessed> will decide what
  to do.
  
  The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
  returns other blessed objects, those will be handled in the same
  way. C<TO_JSON> must take care of not causing an endless recursion cycle
  (== crash) in this case. The name of C<TO_JSON> was chosen because other
  methods called by the Perl core (== not by the user of the object) are
  usually in upper case letters and to avoid collisions with the C<to_json>
  function or method.
  
  This setting does not yet influence C<decode> in any way.
  
  If C<$enable> is false, then the C<allow_blessed> setting will decide what
  to do when a blessed object is found.
  
  =head2 filter_json_object
  
      $json = $json->filter_json_object([$coderef])
  
  When C<$coderef> is specified, it will be called from C<decode> each
  time it decodes a JSON object. The only argument passed to the coderef
  is a reference to the newly-created hash. If the code references returns
  a single scalar (which need not be a reference), this value
  (i.e. a copy of that scalar to avoid aliasing) is inserted into the
  deserialised data structure. If it returns an empty list
  (NOTE: I<not> C<undef>, which is a valid scalar), the original deserialised
  hash will be inserted. This setting can slow down decoding considerably.
  
  When C<$coderef> is omitted or undefined, any existing callback will
  be removed and C<decode> will not change the deserialised hash in any
  way.
  
  Example, convert all JSON objects into the integer 5:
  
     my $js = JSON::PP->new->filter_json_object (sub { 5 });
     # returns [5]
     $js->decode ('[{}]'); # the given subroutine takes a hash reference.
     # throw an exception because allow_nonref is not enabled
     # so a lone 5 is not allowed.
     $js->decode ('{"a":1, "b":2}');
  
  =head2 filter_json_single_key_object
  
      $json = $json->filter_json_single_key_object($key [=> $coderef])
  
  Works remotely similar to C<filter_json_object>, but is only called for
  JSON objects having a single key named C<$key>.
  
  This C<$coderef> is called before the one specified via
  C<filter_json_object>, if any. It gets passed the single value in the JSON
  object. If it returns a single value, it will be inserted into the data
  structure. If it returns nothing (not even C<undef> but the empty list),
  the callback from C<filter_json_object> will be called next, as if no
  single-key callback were specified.
  
  If C<$coderef> is omitted or undefined, the corresponding callback will be
  disabled. There can only ever be one callback for a given key.
  
  As this callback gets called less often then the C<filter_json_object>
  one, decoding speed will not usually suffer as much. Therefore, single-key
  objects make excellent targets to serialise Perl objects into, especially
  as single-key JSON objects are as close to the type-tagged value concept
  as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
  support this in any way, so you need to make sure your data never looks
  like a serialised Perl hash.
  
  Typical names for the single object key are C<__class_whatever__>, or
  C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
  things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
  with real hashes.
  
  Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
  into the corresponding C<< $WIDGET{<id>} >> object:
  
     # return whatever is in $WIDGET{5}:
     JSON::PP
        ->new
        ->filter_json_single_key_object (__widget__ => sub {
              $WIDGET{ $_[0] }
           })
        ->decode ('{"__widget__": 5')
  
     # this can be used with a TO_JSON method in some "widget" class
     # for serialisation to json:
     sub WidgetBase::TO_JSON {
        my ($self) = @_;
  
        unless ($self->{id}) {
           $self->{id} = ..get..some..id..;
           $WIDGET{$self->{id}} = $self;
        }
  
        { __widget__ => $self->{id} }
     }
  
  =head2 shrink
  
      $json = $json->shrink([$enable])
      
      $enabled = $json->get_shrink
  
  In JSON::XS, this flag resizes strings generated by either
  C<encode> or C<decode> to their minimum size possible.
  It will also try to downgrade any strings to octet-form if possible.
  
  In JSON::PP, it is noop about resizing strings but tries
  C<utf8::downgrade> to the returned string by C<encode>.
  See to L<utf8>.
  
  See to L<JSON::XS/OBJECT-ORIENTED INTERFACE>
  
  =head2 max_depth
  
      $json = $json->max_depth([$maximum_nesting_depth])
      
      $max_depth = $json->get_max_depth
  
  Sets the maximum nesting level (default C<512>) accepted while encoding
  or decoding. If a higher nesting level is detected in JSON text or a Perl
  data structure, then the encoder and decoder will stop and croak at that
  point.
  
  Nesting level is defined by number of hash- or arrayrefs that the encoder
  needs to traverse to reach a given point or the number of C<{> or C<[>
  characters without their matching closing parenthesis crossed to reach a
  given character in a string.
  
  If no argument is given, the highest possible setting will be used, which
  is rarely useful.
  
  See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
  
  When a large value (100 or more) was set and it de/encodes a deep nested object/text,
  it may raise a warning 'Deep recursion on subroutin' at the perl runtime phase.
  
  =head2 max_size
  
      $json = $json->max_size([$maximum_string_size])
      
      $max_size = $json->get_max_size
  
  Set the maximum length a JSON text may have (in bytes) where decoding is
  being attempted. The default is C<0>, meaning no limit. When C<decode>
  is called on a string that is longer then this many bytes, it will not
  attempt to decode the string but throw an exception. This setting has no
  effect on C<encode> (yet).
  
  If no argument is given, the limit check will be deactivated (same as when
  C<0> is specified).
  
  See L<JSON::XS/SSECURITY CONSIDERATIONS> for more info on why this is useful.
  
  =head2 encode
  
      $json_text = $json->encode($perl_scalar)
  
  Converts the given Perl data structure (a simple scalar or a reference
  to a hash or array) to its JSON representation. Simple scalars will be
  converted into JSON string or number sequences, while references to arrays
  become JSON arrays and references to hashes become JSON objects. Undefined
  Perl values (e.g. C<undef>) become JSON C<null> values.
  References to the integers C<0> and C<1> are converted into C<true> and C<false>.
  
  =head2 decode
  
      $perl_scalar = $json->decode($json_text)
  
  The opposite of C<encode>: expects a JSON text and tries to parse it,
  returning the resulting simple scalar or reference. Croaks on error.
  
  JSON numbers and strings become simple Perl scalars. JSON arrays become
  Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
  C<1> (C<JSON::true>), C<false> becomes C<0> (C<JSON::false>) and
  C<null> becomes C<undef>.
  
  =head2 decode_prefix
  
      ($perl_scalar, $characters) = $json->decode_prefix($json_text)
  
  This works like the C<decode> method, but instead of raising an exception
  when there is trailing garbage after the first JSON object, it will
  silently stop parsing there and return the number of characters consumed
  so far.
  
     JSON->new->decode_prefix ("[1] the tail")
     => ([], 3)
  
  =head1 INCREMENTAL PARSING
  
  Most of this section are copied and modified from L<JSON::XS/INCREMENTAL PARSING>.
  
  In some cases, there is the need for incremental parsing of JSON texts.
  This module does allow you to parse a JSON stream incrementally.
  It does so by accumulating text until it has a full JSON object, which
  it then can decode. This process is similar to using C<decode_prefix>
  to see if a full JSON object is available, but is much more efficient
  (and can be implemented with a minimum of method calls).
  
  This module will only attempt to parse the JSON text once it is sure it
  has enough text to get a decisive result, using a very simple but
  truly incremental parser. This means that it sometimes won't stop as
  early as the full parser, for example, it doesn't detect parenthese
  mismatches. The only thing it guarantees is that it starts decoding as
  soon as a syntactically valid JSON text has been seen. This means you need
  to set resource limits (e.g. C<max_size>) to ensure the parser will stop
  parsing in the presence if syntax errors.
  
  The following methods implement this incremental parser.
  
  =head2 incr_parse
  
      $json->incr_parse( [$string] ) # void context
      
      $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
      
      @obj_or_empty = $json->incr_parse( [$string] ) # list context
  
  This is the central parsing function. It can both append new text and
  extract objects from the stream accumulated so far (both of these
  functions are optional).
  
  If C<$string> is given, then this string is appended to the already
  existing JSON fragment stored in the C<$json> object.
  
  After that, if the function is called in void context, it will simply
  return without doing anything further. This can be used to add more text
  in as many chunks as you want.
  
  If the method is called in scalar context, then it will try to extract
  exactly I<one> JSON object. If that is successful, it will return this
  object, otherwise it will return C<undef>. If there is a parse error,
  this method will croak just as C<decode> would do (one can then use
  C<incr_skip> to skip the errornous part). This is the most common way of
  using the method.
  
  And finally, in list context, it will try to extract as many objects
  from the stream as it can find and return them, or the empty list
  otherwise. For this to work, there must be no separators between the JSON
  objects or arrays, instead they must be concatenated back-to-back. If
  an error occurs, an exception will be raised as in the scalar context
  case. Note that in this case, any previously-parsed JSON texts will be
  lost.
  
  Example: Parse some JSON arrays/objects in a given string and return them.
  
      my @objs = JSON->new->incr_parse ("[5][7][1,2]");
  
  =head2 incr_text
  
      $lvalue_string = $json->incr_text
  
  This method returns the currently stored JSON fragment as an lvalue, that
  is, you can manipulate it. This I<only> works when a preceding call to
  C<incr_parse> in I<scalar context> successfully returned an object. Under
  all other circumstances you must not call this function (I mean it.
  although in simple tests it might actually work, it I<will> fail under
  real world conditions). As a special exception, you can also call this
  method before having parsed anything.
  
  This function is useful in two cases: a) finding the trailing text after a
  JSON object or b) parsing multiple JSON objects separated by non-JSON text
  (such as commas).
  
      $json->incr_text =~ s/\s*,\s*//;
  
  In Perl 5.005, C<lvalue> attribute is not available.
  You must write codes like the below:
  
      $string = $json->incr_text;
      $string =~ s/\s*,\s*//;
      $json->incr_text( $string );
  
  =head2 incr_skip
  
      $json->incr_skip
  
  This will reset the state of the incremental parser and will remove the
  parsed text from the input buffer. This is useful after C<incr_parse>
  died, in which case the input buffer and incremental parser state is left
  unchanged, to skip the text parsed so far and to reset the parse state.
  
  =head2 incr_reset
  
      $json->incr_reset
  
  This completely resets the incremental parser, that is, after this call,
  it will be as if the parser had never parsed anything.
  
  This is useful if you want ot repeatedly parse JSON objects and want to
  ignore any trailing data, which means you have to reset the parser after
  each successful decode.
  
  See to L<JSON::XS/INCREMENTAL PARSING> for examples.
  
  
  =head1 JSON::PP OWN METHODS
  
  =head2 allow_singlequote
  
      $json = $json->allow_singlequote([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  JSON strings quoted by single quotations that are invalid JSON
  format.
  
      $json->allow_singlequote->decode({"foo":'bar'});
      $json->allow_singlequote->decode({'foo':"bar"});
      $json->allow_singlequote->decode({'foo':'bar'});
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
  
  =head2 allow_barekey
  
      $json = $json->allow_barekey([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will accept
  bare keys of JSON object that are invalid JSON format.
  
  As same as the C<relaxed> option, this option may be used to parse
  application-specific files written by humans.
  
      $json->allow_barekey->decode('{foo:"bar"}');
  
  =head2 allow_bignum
  
      $json = $json->allow_bignum([$enable])
  
  If C<$enable> is true (or missing), then C<decode> will convert
  the big integer Perl cannot handle as integer into a L<Math::BigInt>
  object and convert a floating number (any) into a L<Math::BigFloat>.
  
  On the contary, C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers with C<allow_blessed> enable.
  
     $json->allow_nonref->allow_blessed->allow_bignum;
     $bigfloat = $json->decode('2.000000000000000000000000001');
     print $json->encode($bigfloat);
     # => 2.000000000000000000000000001
  
  See to L<JSON::XS/MAPPING> aboout the normal conversion of JSON number.
  
  =head2 loose
  
      $json = $json->loose([$enable])
  
  The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings
  and the module doesn't allow to C<decode> to these (except for \x2f).
  If C<$enable> is true (or missing), then C<decode>  will accept these
  unescaped strings.
  
      $json->loose->decode(qq|["abc
                                     def"]|);
  
  See L<JSON::XS/SSECURITY CONSIDERATIONS>.
  
  =head2 escape_slash
  
      $json = $json->escape_slash([$enable])
  
  According to JSON Grammar, I<slash> (U+002F) is escaped. But default
  JSON::PP (as same as JSON::XS) encodes strings without escaping slash.
  
  If C<$enable> is true (or missing), then C<encode> will escape slashes.
  
  =head2 indent_length
  
      $json = $json->indent_length($length)
  
  JSON::XS indent space length is 3 and cannot be changed.
  JSON::PP set the indent space length with the given $length.
  The default is 3. The acceptable range is 0 to 15.
  
  =head2 sort_by
  
      $json = $json->sort_by($function_name)
      $json = $json->sort_by($subroutine_ref)
  
  If $function_name or $subroutine_ref are set, its sort routine are used
  in encoding JSON objects.
  
     $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     $js = $pc->sort_by('own_sort')->encode($obj);
     # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|);
  
     sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b }
  
  As the sorting routine runs in the JSON::PP scope, the given
  subroutine name and the special variables C<$a>, C<$b> will begin
  'JSON::PP::'.
  
  If $integer is set, then the effect is same as C<canonical> on.
  
  =head1 INTERNAL
  
  For developers.
  
  =over
  
  =item PP_encode_box
  
  Returns
  
          {
              depth        => $depth,
              indent_count => $indent_count,
          }
  
  
  =item PP_decode_box
  
  Returns
  
          {
              text    => $text,
              at      => $at,
              ch      => $ch,
              len     => $len,
              depth   => $depth,
              encoding      => $encoding,
              is_valid_utf8 => $is_valid_utf8,
          };
  
  =back
  
  =head1 MAPPING
  
  This section is copied from JSON::XS and modified to C<JSON::PP>.
  JSON::XS and JSON::PP mapping mechanisms are almost equivalent.
  
  See to L<JSON::XS/MAPPING>.
  
  =head2 JSON -> PERL
  
  =over 4
  
  =item object
  
  A JSON object becomes a reference to a hash in Perl. No ordering of object
  keys is preserved (JSON does not preserver object key ordering itself).
  
  =item array
  
  A JSON array becomes a reference to an array in Perl.
  
  =item string
  
  A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
  are represented by the same codepoints in the Perl string, so no manual
  decoding is necessary.
  
  =item number
  
  A JSON number becomes either an integer, numeric (floating point) or
  string scalar in perl, depending on its range and any fractional parts. On
  the Perl level, there is no difference between those as Perl handles all
  the conversion details, but an integer may take slightly less memory and
  might represent more values exactly than floating point numbers.
  
  If the number consists of digits only, C<JSON> will try to represent
  it as an integer value. If that fails, it will try to represent it as
  a numeric (floating point) value if that is possible without loss of
  precision. Otherwise it will preserve the number as a string value (in
  which case you lose roundtripping ability, as the JSON number will be
  re-encoded toa JSON string).
  
  Numbers containing a fractional or exponential part will always be
  represented as numeric (floating point) values, possibly at a loss of
  precision (in which case you might lose perfect roundtripping ability, but
  the JSON number will still be re-encoded as a JSON number).
  
  Note that precision is not accuracy - binary floating point values cannot
  represent most decimal fractions exactly, and when converting from and to
  floating point, C<JSON> only guarantees precision up to but not including
  the leats significant bit.
  
  When C<allow_bignum> is enable, the big integers 
  and the numeric can be optionally converted into L<Math::BigInt> and
  L<Math::BigFloat> objects.
  
  =item true, false
  
  These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
  respectively. They are overloaded to act almost exactly like the numbers
  C<1> and C<0>. You can check wether a scalar is a JSON boolean by using
  the C<JSON::is_bool> function.
  
     print JSON::PP::true . "\n";
      => true
     print JSON::PP::true + 1;
      => 1
  
     ok(JSON::true eq  '1');
     ok(JSON::true == 1);
  
  C<JSON> will install these missing overloading features to the backend modules.
  
  
  =item null
  
  A JSON null atom becomes C<undef> in Perl.
  
  C<JSON::PP::null> returns C<unddef>.
  
  =back
  
  
  =head2 PERL -> JSON
  
  The mapping from Perl to JSON is slightly more difficult, as Perl is a
  truly typeless language, so we can only guess which JSON type is meant by
  a Perl value.
  
  =over 4
  
  =item hash references
  
  Perl hash references become JSON objects. As there is no inherent ordering
  in hash keys (or JSON objects), they will usually be encoded in a
  pseudo-random order that can change between runs of the same program but
  stays generally the same within a single run of a program. C<JSON>
  optionally sort the hash keys (determined by the I<canonical> flag), so
  the same datastructure will serialise to the same JSON text (given same
  settings and version of JSON::XS), but this incurs a runtime overhead
  and is only rarely useful, e.g. when you want to compare some JSON text
  against another for equality.
  
  
  =item array references
  
  Perl array references become JSON arrays.
  
  =item other references
  
  Other unblessed references are generally not allowed and will cause an
  exception to be thrown, except for references to the integers C<0> and
  C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
  also use C<JSON::false> and C<JSON::true> to improve readability.
  
     to_json [\0,JSON::PP::true]      # yields [false,true]
  
  =item JSON::PP::true, JSON::PP::false, JSON::PP::null
  
  These special values become JSON true and JSON false values,
  respectively. You can also use C<\1> and C<\0> directly if you want.
  
  JSON::PP::null returns C<undef>.
  
  =item blessed objects
  
  Blessed objects are not directly representable in JSON. See the
  C<allow_blessed> and C<convert_blessed> methods on various options on
  how to deal with this: basically, you can choose between throwing an
  exception, encoding the reference as if it weren't blessed, or provide
  your own serialiser method.
  
  See to L<convert_blessed>.
  
  =item simple scalars
  
  Simple Perl scalars (any scalar that is not a reference) are the most
  difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as
  JSON C<null> values, scalars that have last been used in a string context
  before encoding as JSON strings, and anything else as number value:
  
     # dump as number
     encode_json [2]                      # yields [2]
     encode_json [-3.0e17]                # yields [-3e+17]
     my $value = 5; encode_json [$value]  # yields [5]
  
     # used as string, so dump as string
     print $value;
     encode_json [$value]                 # yields ["5"]
  
     # undef becomes null
     encode_json [undef]                  # yields [null]
  
  You can force the type to be a string by stringifying it:
  
     my $x = 3.1; # some variable containing a number
     "$x";        # stringified
     $x .= "";    # another, more awkward way to stringify
     print $x;    # perl does it for you, too, quite often
  
  You can force the type to be a number by numifying it:
  
     my $x = "3"; # some variable containing a string
     $x += 0;     # numify it, ensuring it will be dumped as a number
     $x *= 1;     # same thing, the choise is yours.
  
  You can not currently force the type in other, less obscure, ways.
  
  Note that numerical precision has the same meaning as under Perl (so
  binary to decimal conversion follows the same rules as in Perl, which
  can differ to other languages). Also, your perl interpreter might expose
  extensions to the floating point numbers of your platform, such as
  infinities or NaN's - these cannot be represented in JSON, and it is an
  error to pass those in.
  
  =item Big Number
  
  When C<allow_bignum> is enable, 
  C<encode> converts C<Math::BigInt> objects and C<Math::BigFloat>
  objects into JSON numbers.
  
  
  =back
  
  =head1 UNICODE HANDLING ON PERLS
  
  If you do not know about Unicode on Perl well,
  please check L<JSON::XS/A FEW NOTES ON UNICODE AND PERL>.
  
  =head2 Perl 5.8 and later
  
  Perl can handle Unicode and the JSON::PP de/encode methods also work properly.
  
      $json->allow_nonref->encode(chr hex 3042);
      $json->allow_nonref->encode(chr hex 12345);
  
  Reuturns C<"\u3042"> and C<"\ud808\udf45"> respectively.
  
      $json->allow_nonref->decode('"\u3042"');
      $json->allow_nonref->decode('"\ud808\udf45"');
  
  Returns UTF-8 encoded strings with UTF8 flag, regarded as C<U+3042> and C<U+12345>.
  
  Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C<join> was broken,
  so JSON::PP wraps the C<join> with a subroutine. Thus JSON::PP works slow in the versions.
  
  
  =head2 Perl 5.6
  
  Perl can handle Unicode and the JSON::PP de/encode methods also work.
  
  =head2 Perl 5.005
  
  Perl 5.005 is a byte sementics world -- all strings are sequences of bytes.
  That means the unicode handling is not available.
  
  In encoding,
  
      $json->allow_nonref->encode(chr hex 3042);  # hex 3042 is 12354.
      $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565.
  
  Returns C<B> and C<E>, as C<chr> takes a value more than 255, it treats
  as C<$value % 256>, so the above codes are equivalent to :
  
      $json->allow_nonref->encode(chr 66);
      $json->allow_nonref->encode(chr 69);
  
  In decoding,
  
      $json->decode('"\u00e3\u0081\u0082"');
  
  The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded
  japanese character (C<HIRAGANA LETTER A>).
  And if it is represented in Unicode code point, C<U+3042>.
  
  Next, 
  
      $json->decode('"\u3042"');
  
  We ordinary expect the returned value is a Unicode character C<U+3042>.
  But here is 5.005 world. This is C<0xE3 0x81 0x82>.
  
      $json->decode('"\ud808\udf45"');
  
  This is not a character C<U+12345> but bytes - C<0xf0 0x92 0x8d 0x85>.
  
  
  =head1 TODO
  
  =over
  
  =item speed
  
  =item memory saving
  
  =back
  
  
  =head1 SEE ALSO
  
  Most of the document are copied and modified from JSON::XS doc.
  
  L<JSON::XS>
  
  RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)
  
  =head1 AUTHOR
  
  Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  
  
  =head1 COPYRIGHT AND LICENSE
  
  Copyright 2007-2011 by Makamaka Hannyaharamitu
  
  This library is free software; you can redistribute it and/or modify
  it under the same terms as Perl itself. 
  
  =cut
JSON_PP

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

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

$fatpacked{"Locale/Maketext/Simple.pm"} = <<'LOCALE_MAKETEXT_SIMPLE';
  package Locale::Maketext::Simple;
  $Locale::Maketext::Simple::VERSION = '0.21';
  
  use strict;
  use 5.005;
  
  =head1 NAME
  
  Locale::Maketext::Simple - Simple interface to Locale::Maketext::Lexicon
  
  =head1 VERSION
  
  This document describes version 0.18 of Locale::Maketext::Simple,
  released Septermber 8, 2006.
  
  =head1 SYNOPSIS
  
  Minimal setup (looks for F<auto/Foo/*.po> and F<auto/Foo/*.mo>):
  
      package Foo;
      use Locale::Maketext::Simple;	# exports 'loc'
      loc_lang('fr');			# set language to French
      sub hello {
  	print loc("Hello, [_1]!", "World");
      }
  
  More sophisticated example:
  
      package Foo::Bar;
      use Locale::Maketext::Simple (
  	Class	    => 'Foo',	    # search in auto/Foo/
  	Style	    => 'gettext',   # %1 instead of [_1]
  	Export	    => 'maketext',  # maketext() instead of loc()
  	Subclass    => 'L10N',	    # Foo::L10N instead of Foo::I18N
  	Decode	    => 1,	    # decode entries to unicode-strings
  	Encoding    => 'locale',    # but encode lexicons in current locale
  				    # (needs Locale::Maketext::Lexicon 0.36)
      );
      sub japh {
  	print maketext("Just another %1 hacker", "Perl");
      }
  
  =head1 DESCRIPTION
  
  This module is a simple wrapper around B<Locale::Maketext::Lexicon>,
  designed to alleviate the need of creating I<Language Classes> for
  module authors.
  
  The language used is chosen from the loc_lang call. If a lookup is not
  possible, the i-default language will be used. If the lookup is not in the
  i-default language, then the key will be returned.
  
  If B<Locale::Maketext::Lexicon> is not present, it implements a
  minimal localization function by simply interpolating C<[_1]> with
  the first argument, C<[_2]> with the second, etc.  Interpolated
  function like C<[quant,_1]> are treated as C<[_1]>, with the sole
  exception of C<[tense,_1,X]>, which will append C<ing> to C<_1> when
  X is C<present>, or appending C<ed> to <_1> otherwise.
  
  =head1 OPTIONS
  
  All options are passed either via the C<use> statement, or via an
  explicit C<import>.
  
  =head2 Class
  
  By default, B<Locale::Maketext::Simple> draws its source from the
  calling package's F<auto/> directory; you can override this behaviour
  by explicitly specifying another package as C<Class>.
  
  =head2 Path
  
  If your PO and MO files are under a path elsewhere than C<auto/>,
  you may specify it using the C<Path> option.
  
  =head2 Style
  
  By default, this module uses the C<maketext> style of C<[_1]> and
  C<[quant,_1]> for interpolation.  Alternatively, you can specify the
  C<gettext> style, which uses C<%1> and C<%quant(%1)> for interpolation.
  
  This option is case-insensitive.
  
  =head2 Export
  
  By default, this module exports a single function, C<loc>, into its
  caller's namespace.  You can set it to another name, or set it to
  an empty string to disable exporting.
  
  =head2 Subclass
  
  By default, this module creates an C<::I18N> subclass under the
  caller's package (or the package specified by C<Class>), and stores
  lexicon data in its subclasses.  You can assign a name other than
  C<I18N> via this option.
  
  =head2 Decode
  
  If set to a true value, source entries will be converted into
  utf8-strings (available in Perl 5.6.1 or later).  This feature
  needs the B<Encode> or B<Encode::compat> module.
  
  =head2 Encoding
  
  Specifies an encoding to store lexicon entries, instead of
  utf8-strings.  If set to C<locale>, the encoding from the current
  locale setting is used.  Implies a true value for C<Decode>.
  
  =cut
  
  sub import {
      my ($class, %args) = @_;
  
      $args{Class}    ||= caller;
      $args{Style}    ||= 'maketext';
      $args{Export}   ||= 'loc';
      $args{Subclass} ||= 'I18N';
  
      my ($loc, $loc_lang) = $class->load_loc(%args);
      $loc ||= $class->default_loc(%args);
  
      no strict 'refs';
      *{caller(0) . "::$args{Export}"} = $loc if $args{Export};
      *{caller(0) . "::$args{Export}_lang"} = $loc_lang || sub { 1 };
  }
  
  my %Loc;
  
  sub reload_loc { %Loc = () }
  
  sub load_loc {
      my ($class, %args) = @_;
  
      my $pkg = join('::', grep { defined and length } $args{Class}, $args{Subclass});
      return $Loc{$pkg} if exists $Loc{$pkg};
  
      eval { require Locale::Maketext::Lexicon; 1 }   or return;
      $Locale::Maketext::Lexicon::VERSION > 0.20	    or return;
      eval { require File::Spec; 1 }		    or return;
  
      my $path = $args{Path} || $class->auto_path($args{Class}) or return;
      my $pattern = File::Spec->catfile($path, '*.[pm]o');
      my $decode = $args{Decode} || 0;
      my $encoding = $args{Encoding} || undef;
  
      $decode = 1 if $encoding;
  
      $pattern =~ s{\\}{/}g; # to counter win32 paths
  
      eval "
  	package $pkg;
  	use base 'Locale::Maketext';
  	Locale::Maketext::Lexicon->import({
  	    'i-default' => [ 'Auto' ],
  	    '*'	=> [ Gettext => \$pattern ],
  	    _decode => \$decode,
  	    _encoding => \$encoding,
  	});
  	*${pkg}::Lexicon = \\%${pkg}::i_default::Lexicon;
  	*tense = sub { \$_[1] . ((\$_[2] eq 'present') ? 'ing' : 'ed') }
  	    unless defined &tense;
  
  	1;
      " or die $@;
  
      my $lh = eval { $pkg->get_handle } or return;
      my $style = lc($args{Style});
      if ($style eq 'maketext') {
  	$Loc{$pkg} = sub {
  	    $lh->maketext(@_)
  	};
      }
      elsif ($style eq 'gettext') {
  	$Loc{$pkg} = sub {
  	    my $str = shift;
              $str =~ s{([\~\[\]])}{~$1}g;
              $str =~ s{
                  ([%\\]%)                        # 1 - escaped sequence
              |
                  %   (?:
                          ([A-Za-z#*]\w*)         # 2 - function call
                              \(([^\)]*)\)        # 3 - arguments
                      |
                          ([1-9]\d*|\*)           # 4 - variable
                      )
              }{
                  $1 ? $1
                     : $2 ? "\[$2,"._unescape($3)."]"
                          : "[_$4]"
              }egx;
  	    return $lh->maketext($str, @_);
  	};
      }
      else {
  	die "Unknown Style: $style";
      }
  
      return $Loc{$pkg}, sub {
  	$lh = $pkg->get_handle(@_);
      };
  }
  
  sub default_loc {
      my ($self, %args) = @_;
      my $style = lc($args{Style});
      if ($style eq 'maketext') {
  	return sub {
  	    my $str = shift;
              $str =~ s{((?<!~)(?:~~)*)\[_([1-9]\d*|\*)\]}
                       {$1%$2}g;
              $str =~ s{((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]}
                       {"$1%$2(" . _escape($3) . ')'}eg;
  	    _default_gettext($str, @_);
  	};
      }
      elsif ($style eq 'gettext') {
  	return \&_default_gettext;
      }
      else {
  	die "Unknown Style: $style";
      }
  }
  
  sub _default_gettext {
      my $str = shift;
      $str =~ s{
  	%			# leading symbol
  	(?:			# either one of
  	    \d+			#   a digit, like %1
  	    |			#     or
  	    (\w+)\(		#   a function call -- 1
  		(?:		#     either
  		    %\d+	#	an interpolation
  		    |		#     or
  		    ([^,]*)	#	some string -- 2
  		)		#     end either
  		(?:		#     maybe followed
  		    ,		#       by a comma
  		    ([^),]*)	#       and a param -- 3
  		)?		#     end maybe
  		(?:		#     maybe followed
  		    ,		#       by another comma
  		    ([^),]*)	#       and a param -- 4
  		)?		#     end maybe
  		[^)]*		#     and other ignorable params
  	    \)			#   closing function call
  	)			# closing either one of
      }{
  	my $digit = $2 || shift;
  	$digit . (
  	    $1 ? (
  		($1 eq 'tense') ? (($3 eq 'present') ? 'ing' : 'ed') :
  		($1 eq 'quant') ? ' ' . (($digit > 1) ? ($4 || "$3s") : $3) :
  		''
  	    ) : ''
  	);
      }egx;
      return $str;
  };
  
  sub _escape {
      my $text = shift;
      $text =~ s/\b_([1-9]\d*)/%$1/g;
      return $text;
  }
  
  sub _unescape {
      join(',', map {
          /\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_
      } split(/,/, $_[0]));
  }
  
  sub auto_path {
      my ($self, $calldir) = @_;
      $calldir =~ s#::#/#g;
      my $path = $INC{$calldir . '.pm'} or return;
  
      # Try absolute path name.
      if ($^O eq 'MacOS') {
  	(my $malldir = $calldir) =~ tr#/#:#;
  	$path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:#s;
      } else {
  	$path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/#;
      }
  
      return $path if -d $path;
  
      # If that failed, try relative path with normal @INC searching.
      $path = "auto/$calldir/";
      foreach my $inc (@INC) {
  	return "$inc/$path" if -d "$inc/$path";
      }
  
      return;
  }
  
  1;
  
  =head1 ACKNOWLEDGMENTS
  
  Thanks to Jos I. Boumans for suggesting this module to be written.
  
  Thanks to Chia-Liang Kao for suggesting C<Path> and C<loc_lang>.
  
  =head1 SEE ALSO
  
  L<Locale::Maketext>, L<Locale::Maketext::Lexicon>
  
  =head1 AUTHORS
  
  Audrey Tang E<lt>cpan@audreyt.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2003, 2004, 2005, 2006 by Audrey Tang E<lt>cpan@audreyt.orgE<gt>.
  
  This software is released under the MIT license cited below.  Additionally,
  when this software is distributed with B<Perl Kit, Version 5>, you may also
  redistribute it and/or modify it under the same terms as Perl itself.
  
  =head2 The "MIT" License
  
  Permission is hereby granted, free of charge, to any person obtaining a copy
  of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction, including without limitation the rights
  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:
  
  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.
  
  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
  OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
  THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  DEALINGS IN THE SOFTWARE.
  
  =cut
LOCALE_MAKETEXT_SIMPLE

$fatpacked{"Module/Load.pm"} = <<'MODULE_LOAD';
  package Module::Load;
  
  $VERSION = '0.22';
  
  use strict;
  use File::Spec ();
  
  sub import {
      my $who = _who();
  
      {   no strict 'refs';
          *{"${who}::load"} = *load;
      }
  }
  
  sub load (*;@)  {
      my $mod = shift or return;
      my $who = _who();
  
      if( _is_file( $mod ) ) {
          require $mod;
      } else {
          LOAD: {
              my $err;
              for my $flag ( qw[1 0] ) {
                  my $file = _to_file( $mod, $flag);
                  eval { require $file };
                  $@ ? $err .= $@ : last LOAD;
              }
              die $err if $err;
          }
      }
  
      ### This addresses #41883: Module::Load cannot import
      ### non-Exporter module. ->import() routines weren't
      ### properly called when load() was used.
      {   no strict 'refs';
          my $import;
          if (@_ and $import = $mod->can('import')) {
              unshift @_, $mod;
              goto &$import;
          }
      }
  }
  
  sub _to_file{
      local $_    = shift;
      my $pm      = shift || '';
  
      ## trailing blanks ignored by default. [rt #69886]
      my @parts = split /::/, $_, -1;
      ## make sure that we can't hop out of @INC
      shift @parts if @parts && !$parts[0];
  
      ### because of [perl #19213], see caveats ###
      my $file = $^O eq 'MSWin32'
                      ? join "/", @parts
                      : File::Spec->catfile( @parts );
  
      $file   .= '.pm' if $pm;
  
      ### on perl's before 5.10 (5.9.5@31746) if you require
      ### a file in VMS format, it's stored in %INC in VMS
      ### format. Therefor, better unixify it first
      ### Patch in reply to John Malmbergs patch (as mentioned
      ### above) on p5p Tue 21 Aug 2007 04:55:07
      $file = VMS::Filespec::unixify($file) if $^O eq 'VMS';
  
      return $file;
  }
  
  sub _who { (caller(1))[0] }
  
  sub _is_file {
      local $_ = shift;
      return  /^\./               ? 1 :
              /[^\w:']/           ? 1 :
              undef
      #' silly bbedit..
  }
  
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  Module::Load - runtime require of both modules and files
  
  =head1 SYNOPSIS
  
  	use Module::Load;
  
      my $module = 'Data:Dumper';
      load Data::Dumper;      # loads that module
      load 'Data::Dumper';    # ditto
      load $module            # tritto
  
      my $script = 'some/script.pl'
      load $script;
      load 'some/script.pl';	# use quotes because of punctuations
  
      load thing;             # try 'thing' first, then 'thing.pm'
  
      load CGI, ':standard'   # like 'use CGI qw[:standard]'
  
  
  =head1 DESCRIPTION
  
  C<load> eliminates the need to know whether you are trying to require
  either a file or a module.
  
  If you consult C<perldoc -f require> you will see that C<require> will
  behave differently when given a bareword or a string.
  
  In the case of a string, C<require> assumes you are wanting to load a
  file. But in the case of a bareword, it assumes you mean a module.
  
  This gives nasty overhead when you are trying to dynamically require
  modules at runtime, since you will need to change the module notation
  (C<Acme::Comment>) to a file notation fitting the particular platform
  you are on.
  
  C<load> eliminates the need for this overhead and will just DWYM.
  
  =head1 Rules
  
  C<load> has the following rules to decide what it thinks you want:
  
  =over 4
  
  =item *
  
  If the argument has any characters in it other than those matching
  C<\w>, C<:> or C<'>, it must be a file
  
  =item *
  
  If the argument matches only C<[\w:']>, it must be a module
  
  =item *
  
  If the argument matches only C<\w>, it could either be a module or a
  file. We will try to find C<file.pm> first in C<@INC> and if that
  fails, we will try to find C<file> in @INC.  If both fail, we die with
  the respective error messages.
  
  =back
  
  =head1 Caveats
  
  Because of a bug in perl (#19213), at least in version 5.6.1, we have
  to hardcode the path separator for a require on Win32 to be C</>, like
  on Unix rather than the Win32 C<\>. Otherwise perl will not read its
  own %INC accurately double load files if they are required again, or
  in the worst case, core dump.
  
  C<Module::Load> cannot do implicit imports, only explicit imports.
  (in other words, you always have to specify explicitly what you wish
  to import from a module, even if the functions are in that modules'
  C<@EXPORT>)
  
  =head1 ACKNOWLEDGEMENTS
  
  Thanks to Jonas B. Nielsen for making explicit imports work.
  
  =head1 BUG REPORTS
  
  Please report bugs or other issues to E<lt>bug-module-load@rt.cpan.org<gt>.
  
  =head1 AUTHOR
  
  This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
  
  =head1 COPYRIGHT
  
  This library is free software; you may redistribute and/or modify it
  under the same terms as Perl itself.
  
  
  =cut
MODULE_LOAD

$fatpacked{"Module/Load/Conditional.pm"} = <<'MODULE_LOAD_CONDITIONAL';
  package Module::Load::Conditional;
  
  use strict;
  
  use Module::Load;
  use Params::Check                       qw[check];
  use Locale::Maketext::Simple Style  => 'gettext';
  
  use Carp        ();
  use File::Spec  ();
  use FileHandle  ();
  use version;
  
  use Module::Metadata ();
  
  use constant ON_VMS  => $^O eq 'VMS';
  
  BEGIN {
      use vars        qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED
                          $FIND_VERSION $ERROR $CHECK_INC_HASH];
      use Exporter;
      @ISA            = qw[Exporter];
      $VERSION        = '0.54';
      $VERBOSE        = 0;
      $DEPRECATED     = 0;
      $FIND_VERSION   = 1;
      $CHECK_INC_HASH = 0;
      @EXPORT_OK      = qw[check_install can_load requires];
  }
  
  =pod
  
  =head1 NAME
  
  Module::Load::Conditional - Looking up module information / loading at runtime
  
  =head1 SYNOPSIS
  
      use Module::Load::Conditional qw[can_load check_install requires];
  
  
      my $use_list = {
              CPANPLUS        => 0.05,
              LWP             => 5.60,
              'Test::More'    => undef,
      };
  
      print can_load( modules => $use_list )
              ? 'all modules loaded successfully'
              : 'failed to load required modules';
  
  
      my $rv = check_install( module => 'LWP', version => 5.60 )
                  or print 'LWP is not installed!';
  
      print 'LWP up to date' if $rv->{uptodate};
      print "LWP version is $rv->{version}\n";
      print "LWP is installed as file $rv->{file}\n";
  
  
      print "LWP requires the following modules to be installed:\n";
      print join "\n", requires('LWP');
  
      ### allow M::L::C to peek in your %INC rather than just
      ### scanning @INC
      $Module::Load::Conditional::CHECK_INC_HASH = 1;
  
      ### reset the 'can_load' cache
      undef $Module::Load::Conditional::CACHE;
  
      ### don't have Module::Load::Conditional issue warnings --
      ### default is '1'
      $Module::Load::Conditional::VERBOSE = 0;
  
      ### The last error that happened during a call to 'can_load'
      my $err = $Module::Load::Conditional::ERROR;
  
  
  =head1 DESCRIPTION
  
  Module::Load::Conditional provides simple ways to query and possibly load any of
  the modules you have installed on your system during runtime.
  
  It is able to load multiple modules at once or none at all if one of
  them was not able to load. It also takes care of any error checking
  and so forth.
  
  =head1 Methods
  
  =head2 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );
  
  C<check_install> allows you to verify if a certain module is installed
  or not. You may call it with the following arguments:
  
  =over 4
  
  =item module
  
  The name of the module you wish to verify -- this is a required key
  
  =item version
  
  The version this module needs to be -- this is optional
  
  =item verbose
  
  Whether or not to be verbose about what it is doing -- it will default
  to $Module::Load::Conditional::VERBOSE
  
  =back
  
  It will return undef if it was not able to find where the module was
  installed, or a hash reference with the following keys if it was able
  to find the file:
  
  =over 4
  
  =item file
  
  Full path to the file that contains the module
  
  =item dir
  
  Directory, or more exact the C<@INC> entry, where the module was
  loaded from.
  
  =item version
  
  The version number of the installed module - this will be C<undef> if
  the module had no (or unparsable) version number, or if the variable
  C<$Module::Load::Conditional::FIND_VERSION> was set to true.
  (See the C<GLOBAL VARIABLES> section below for details)
  
  =item uptodate
  
  A boolean value indicating whether or not the module was found to be
  at least the version you specified. If you did not specify a version,
  uptodate will always be true if the module was found.
  If no parsable version was found in the module, uptodate will also be
  true, since C<check_install> had no way to verify clearly.
  
  See also C<$Module::Load::Conditional::DEPRECATED>, which affects
  the outcome of this value.
  
  =back
  
  =cut
  
  ### this checks if a certain module is installed already ###
  ### if it returns true, the module in question is already installed
  ### or we found the file, but couldn't open it, OR there was no version
  ### to be found in the module
  ### it will return 0 if the version in the module is LOWER then the one
  ### we are looking for, or if we couldn't find the desired module to begin with
  ### if the installed version is higher or equal to the one we want, it will return
  ### a hashref with he module name and version in it.. so 'true' as well.
  sub check_install {
      my %hash = @_;
  
      my $tmpl = {
              version => { default    => '0.0'    },
              module  => { required   => 1        },
              verbose => { default    => $VERBOSE },
      };
  
      my $args;
      unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
          warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
          return;
      }
  
      my $file     = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
      my $file_inc = File::Spec::Unix->catfile(
                          split /::/, $args->{module}
                      ) . '.pm';
  
      ### where we store the return value ###
      my $href = {
              file        => undef,
              version     => undef,
              uptodate    => undef,
      };
  
      my $filename;
  
      ### check the inc hash if we're allowed to
      if( $CHECK_INC_HASH ) {
          $filename = $href->{'file'} =
              $INC{ $file_inc } if defined $INC{ $file_inc };
  
          ### find the version by inspecting the package
          if( defined $filename && $FIND_VERSION ) {
              no strict 'refs';
              $href->{version} = ${ "$args->{module}"."::VERSION" };
          }
      }
  
      ### we didnt find the filename yet by looking in %INC,
      ### so scan the dirs
      unless( $filename ) {
  
          DIR: for my $dir ( @INC ) {
  
              my $fh;
  
              if ( ref $dir ) {
                  ### @INC hook -- we invoke it and get the filehandle back
                  ### this is actually documented behaviour as of 5.8 ;)
  
                  my $existed_in_inc = $INC{$file_inc};
  
                  if (UNIVERSAL::isa($dir, 'CODE')) {
                      ($fh) = $dir->($dir, $file);
  
                  } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
                      ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
  
                  } elsif (UNIVERSAL::can($dir, 'INC')) {
                      ($fh) = $dir->INC($file);
                  }
  
                  if (!UNIVERSAL::isa($fh, 'GLOB')) {
                      warn loc(q[Cannot open file '%1': %2], $file, $!)
                              if $args->{verbose};
                      next;
                  }
  
                  $filename = $INC{$file_inc} || $file;
  
                  delete $INC{$file_inc} if not $existed_in_inc;
  
              } else {
                  $filename = File::Spec->catfile($dir, $file);
                  next unless -e $filename;
  
                  $fh = new FileHandle;
                  if (!$fh->open($filename)) {
                      warn loc(q[Cannot open file '%1': %2], $file, $!)
                              if $args->{verbose};
                      next;
                  }
              }
  
              ### store the directory we found the file in
              $href->{dir} = $dir;
  
              ### files need to be in unix format under vms,
              ### or they might be loaded twice
              $href->{file} = ON_VMS
                  ? VMS::Filespec::unixify( $filename )
                  : $filename;
  
              ### if we don't need the version, we're done
              last DIR unless $FIND_VERSION;
  
              ### otherwise, the user wants us to find the version from files
              my $mod_info = Module::Metadata->new_from_handle( $fh, $filename );
              my $ver      = $mod_info->version( $args->{module} );
  
              if( defined $ver ) {
                  $href->{version} = $ver;
  
                  last DIR;
              }
          }
      }
  
      ### if we couldn't find the file, return undef ###
      return unless defined $href->{file};
  
      ### only complain if we're expected to find a version higher than 0.0 anyway
      if( $FIND_VERSION and not defined $href->{version} ) {
          {   ### don't warn about the 'not numeric' stuff ###
              local $^W;
  
              ### if we got here, we didn't find the version
              warn loc(q[Could not check version on '%1'], $args->{module} )
                      if $args->{verbose} and $args->{version} > 0;
          }
          $href->{uptodate} = 1;
  
      } else {
          ### don't warn about the 'not numeric' stuff ###
          local $^W;
  
          ### use qv(), as it will deal with developer release number
          ### ie ones containing _ as well. This addresses bug report
          ### #29348: Version compare logic doesn't handle alphas?
          ###
          ### Update from JPeacock: apparently qv() and version->new
          ### are different things, and we *must* use version->new
          ### here, or things like #30056 might start happening
  
          ### We have to wrap this in an eval as version-0.82 raises
          ### exceptions and not warnings now *sigh*
  
          eval {
  
            $href->{uptodate} =
              version->new( $args->{version} ) <= version->new( $href->{version} )
                  ? 1
                  : 0;
  
          };
      }
  
      if ( $DEPRECATED and "$]" >= 5.011 ) {
          require Module::CoreList;
          require Config;
  
          $href->{uptodate} = 0 if
             exists $Module::CoreList::version{ 0+$] }{ $args->{module} } and
             Module::CoreList::is_deprecated( $args->{module} ) and
             $Config::Config{privlibexp} eq $href->{dir};
      }
  
      return $href;
  }
  
  =head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )
  
  C<can_load> will take a list of modules, optionally with version
  numbers and determine if it is able to load them. If it can load *ALL*
  of them, it will. If one or more are unloadable, none will be loaded.
  
  This is particularly useful if you have More Than One Way (tm) to
  solve a problem in a program, and only wish to continue down a path
  if all modules could be loaded, and not load them if they couldn't.
  
  This function uses the C<load> function from Module::Load under the
  hood.
  
  C<can_load> takes the following arguments:
  
  =over 4
  
  =item modules
  
  This is a hashref of module/version pairs. The version indicates the
  minimum version to load. If no version is provided, any version is
  assumed to be good enough.
  
  =item verbose
  
  This controls whether warnings should be printed if a module failed
  to load.
  The default is to use the value of $Module::Load::Conditional::VERBOSE.
  
  =item nocache
  
  C<can_load> keeps its results in a cache, so it will not load the
  same module twice, nor will it attempt to load a module that has
  already failed to load before. By default, C<can_load> will check its
  cache, but you can override that by setting C<nocache> to true.
  
  =cut
  
  sub can_load {
      my %hash = @_;
  
      my $tmpl = {
          modules     => { default => {}, strict_type => 1 },
          verbose     => { default => $VERBOSE },
          nocache     => { default => 0 },
      };
  
      my $args;
  
      unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
          $ERROR = loc(q[Problem validating arguments!]);
          warn $ERROR if $VERBOSE;
          return;
      }
  
      ### layout of $CACHE:
      ### $CACHE = {
      ###     $ module => {
      ###             usable  => BOOL,
      ###             version => \d,
      ###             file    => /path/to/file,
      ###     },
      ### };
  
      $CACHE ||= {}; # in case it was undef'd
  
      my $error;
      BLOCK: {
          my $href = $args->{modules};
  
          my @load;
          for my $mod ( keys %$href ) {
  
              next if $CACHE->{$mod}->{usable} && !$args->{nocache};
  
              ### else, check if the hash key is defined already,
              ### meaning $mod => 0,
              ### indicating UNSUCCESSFUL prior attempt of usage
  
              ### use qv(), as it will deal with developer release number
              ### ie ones containing _ as well. This addresses bug report
              ### #29348: Version compare logic doesn't handle alphas?
              ###
              ### Update from JPeacock: apparently qv() and version->new
              ### are different things, and we *must* use version->new
              ### here, or things like #30056 might start happening
              if (    !$args->{nocache}
                      && defined $CACHE->{$mod}->{usable}
                      && (version->new( $CACHE->{$mod}->{version}||0 )
                          >= version->new( $href->{$mod} ) )
              ) {
                  $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
                  last BLOCK;
              }
  
              my $mod_data = check_install(
                                      module  => $mod,
                                      version => $href->{$mod}
                                  );
  
              if( !$mod_data or !defined $mod_data->{file} ) {
                  $error = loc(q[Could not find or check module '%1'], $mod);
                  $CACHE->{$mod}->{usable} = 0;
                  last BLOCK;
              }
  
              map {
                  $CACHE->{$mod}->{$_} = $mod_data->{$_}
              } qw[version file uptodate];
  
              push @load, $mod;
          }
  
          for my $mod ( @load ) {
  
              if ( $CACHE->{$mod}->{uptodate} ) {
  
                  eval { load $mod };
  
                  ### in case anything goes wrong, log the error, the fact
                  ### we tried to use this module and return 0;
                  if( $@ ) {
                      $error = $@;
                      $CACHE->{$mod}->{usable} = 0;
                      last BLOCK;
                  } else {
                      $CACHE->{$mod}->{usable} = 1;
                  }
  
              ### module not found in @INC, store the result in
              ### $CACHE and return 0
              } else {
  
                  $error = loc(q[Module '%1' is not uptodate!], $mod);
                  $CACHE->{$mod}->{usable} = 0;
                  last BLOCK;
              }
          }
  
      } # BLOCK
  
      if( defined $error ) {
          $ERROR = $error;
          Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
          return;
      } else {
          return 1;
      }
  }
  
  =back
  
  =head2 @list = requires( MODULE );
  
  C<requires> can tell you what other modules a particular module
  requires. This is particularly useful when you're intending to write
  a module for public release and are listing its prerequisites.
  
  C<requires> takes but one argument: the name of a module.
  It will then first check if it can actually load this module, and
  return undef if it can't.
  Otherwise, it will return a list of modules and pragmas that would
  have been loaded on the module's behalf.
  
  Note: The list C<require> returns has originated from your current
  perl and your current install.
  
  =cut
  
  sub requires {
      my $who = shift;
  
      unless( check_install( module => $who ) ) {
          warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE;
          return undef;
      }
  
      my $lib = join " ", map { qq["-I$_"] } @INC;
      my $cmd = qq["$^X" $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];
  
      return  sort
                  grep { !/^$who$/  }
                  map  { chomp; s|/|::|g; $_ }
                  grep { s|\.pm$||i; }
              `$cmd`;
  }
  
  1;
  
  __END__
  
  =head1 Global Variables
  
  The behaviour of Module::Load::Conditional can be altered by changing the
  following global variables:
  
  =head2 $Module::Load::Conditional::VERBOSE
  
  This controls whether Module::Load::Conditional will issue warnings and
  explanations as to why certain things may have failed. If you set it
  to 0, Module::Load::Conditional will not output any warnings.
  The default is 0;
  
  =head2 $Module::Load::Conditional::FIND_VERSION
  
  This controls whether Module::Load::Conditional will try to parse
  (and eval) the version from the module you're trying to load.
  
  If you don't wish to do this, set this variable to C<false>. Understand
  then that version comparisons are not possible, and Module::Load::Conditional
  can not tell you what module version you have installed.
  This may be desirable from a security or performance point of view.
  Note that C<$FIND_VERSION> code runs safely under C<taint mode>.
  
  The default is 1;
  
  =head2 $Module::Load::Conditional::CHECK_INC_HASH
  
  This controls whether C<Module::Load::Conditional> checks your
  C<%INC> hash to see if a module is available. By default, only
  C<@INC> is scanned to see if a module is physically on your
  filesystem, or available via an C<@INC-hook>. Setting this variable
  to C<true> will trust any entries in C<%INC> and return them for
  you.
  
  The default is 0;
  
  =head2 $Module::Load::Conditional::CACHE
  
  This holds the cache of the C<can_load> function. If you explicitly
  want to remove the current cache, you can set this variable to
  C<undef>
  
  =head2 $Module::Load::Conditional::ERROR
  
  This holds a string of the last error that happened during a call to
  C<can_load>. It is useful to inspect this when C<can_load> returns
  C<undef>.
  
  =head2 $Module::Load::Conditional::DEPRECATED
  
  This controls whether C<Module::Load::Conditional> checks if
  a dual-life core module has been deprecated. If this is set to
  true C<check_install> will return false to C<uptodate>, if
  a dual-life module is found to be loaded from C<$Config{privlibexp}>
  
  The default is 0;
  
  =head1 See Also
  
  C<Module::Load>
  
  =head1 BUG REPORTS
  
  Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>.
  
  =head1 AUTHOR
  
  This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
  
  =head1 COPYRIGHT
  
  This library is free software; you may redistribute and/or modify it
  under the same terms as Perl itself.
  
  =cut
MODULE_LOAD_CONDITIONAL

$fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
  # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
  # vim:ts=8:sw=2:et:sta:sts=2
  package Module::Metadata;
  
  # Adapted from Perl-licensed code originally distributed with
  # Module-Build by Ken Williams
  
  # This module provides routines to gather information about
  # perl modules (assuming this may be expanded in the distant
  # parrot future to look at other types of modules).
  
  use strict;
  use vars qw($VERSION);
  $VERSION = '1.000011';
  $VERSION = eval $VERSION;
  
  use Carp qw/croak/;
  use File::Spec;
  use IO::File;
  use version 0.87;
  BEGIN {
    if ($INC{'Log/Contextual.pm'}) {
      Log::Contextual->import('log_info');
    } else {
      *log_info = sub (&) { warn $_[0]->() };
    }
  }
  use File::Find qw(find);
  
  my $V_NUM_REGEXP = qr{v?[0-9._]+};  # crudely, a v-string or decimal
  
  my $PKG_REGEXP  = qr{   # match a package declaration
    ^[\s\{;]*             # intro chars on a line
    package               # the word 'package'
    \s+                   # whitespace
    ([\w:]+)              # a package name
    \s*                   # optional whitespace
    ($V_NUM_REGEXP)?        # optional version number
    \s*                   # optional whitesapce
    [;\{]                 # semicolon line terminator or block start (since 5.16)
  }x;
  
  my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
    ([\$*])         # sigil - $ or *
    (
      (             # optional leading package name
        (?:::|\')?  # possibly starting like just :: (  la $::VERSION)
        (?:\w+(?:::|\'))*  # Foo::Bar:: ...
      )?
      VERSION
    )\b
  }x;
  
  my $VERS_REGEXP = qr{ # match a VERSION definition
    (?:
      \(\s*$VARNAME_REGEXP\s*\) # with parens
    |
      $VARNAME_REGEXP           # without parens
    )
    \s*
    =[^=~]  # = but not ==, nor =~
  }x;
  
  sub new_from_file {
    my $class    = shift;
    my $filename = File::Spec->rel2abs( shift );
  
    return undef unless defined( $filename ) && -f $filename;
    return $class->_init(undef, $filename, @_);
  }
  
  sub new_from_handle {
    my $class    = shift;
    my $handle   = shift;
    my $filename = shift;
    return undef unless defined($handle) && defined($filename);
    $filename = File::Spec->rel2abs( $filename );
  
    return $class->_init(undef, $filename, @_, handle => $handle);
  
  }
  
  
  sub new_from_module {
    my $class   = shift;
    my $module  = shift;
    my %props   = @_;
  
    $props{inc} ||= \@INC;
    my $filename = $class->find_module_by_name( $module, $props{inc} );
    return undef unless defined( $filename ) && -f $filename;
    return $class->_init($module, $filename, %props);
  }
  
  {
    
    my $compare_versions = sub {
      my ($v1, $op, $v2) = @_;
      $v1 = version->new($v1)
        unless UNIVERSAL::isa($v1,'version');
    
      my $eval_str = "\$v1 $op \$v2";
      my $result   = eval $eval_str;
      log_info { "error comparing versions: '$eval_str' $@" } if $@;
    
      return $result;
    };
  
    my $normalize_version = sub {
      my ($version) = @_;
      if ( $version =~ /[=<>!,]/ ) { # logic, not just version
        # take as is without modification
      }
      elsif ( ref $version eq 'version' ) { # version objects
        $version = $version->is_qv ? $version->normal : $version->stringify;
      }
      elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
        # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
        $version = "v$version";
      }
      else {
        # leave alone
      }
      return $version;
    };
  
    # separate out some of the conflict resolution logic
  
    my $resolve_module_versions = sub {
      my $packages = shift;
    
      my( $file, $version );
      my $err = '';
        foreach my $p ( @$packages ) {
          if ( defined( $p->{version} ) ) {
    	if ( defined( $version ) ) {
     	  if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
    	    $err .= "  $p->{file} ($p->{version})\n";
    	  } else {
    	    # same version declared multiple times, ignore
    	  }
    	} else {
    	  $file    = $p->{file};
    	  $version = $p->{version};
    	}
          }
          $file ||= $p->{file} if defined( $p->{file} );
        }
    
      if ( $err ) {
        $err = "  $file ($version)\n" . $err;
      }
    
      my %result = (
        file    => $file,
        version => $version,
        err     => $err
      );
    
      return \%result;
    };
  
    sub provides {
      my $class = shift;
  
      croak "provides() requires key/value pairs \n" if @_ % 2;
      my %args = @_;
  
      croak "provides() takes only one of 'dir' or 'files'\n"
        if $args{dir} && $args{files};
  
      croak "provides() requires a 'version' argument"
        unless defined $args{version};
  
      croak "provides() does not support version '$args{version}' metadata"
          unless grep { $args{version} eq $_ } qw/1.4 2/;
  
      $args{prefix} = 'lib' unless defined $args{prefix};
  
      my $p;
      if ( $args{dir} ) {
        $p = $class->package_versions_from_directory($args{dir});
      }
      else {
        croak "provides() requires 'files' to be an array reference\n"
          unless ref $args{files} eq 'ARRAY';
        $p = $class->package_versions_from_directory($args{files});
      }
  
      # Now, fix up files with prefix
      if ( length $args{prefix} ) { # check in case disabled with q{}
        $args{prefix} =~ s{/$}{};
        for my $v ( values %$p ) {
          $v->{file} = "$args{prefix}/$v->{file}";
        }
      }
  
      return $p
    }
  
    sub package_versions_from_directory {
      my ( $class, $dir, $files ) = @_;
  
      my @files;
  
      if ( $files ) {
        @files = @$files;
      } else {
        find( {
          wanted => sub {
            push @files, $_ if -f $_ && /\.pm$/;
          },
          no_chdir => 1,
        }, $dir );
      }
  
      # First, we enumerate all packages & versions,
      # separating into primary & alternative candidates
      my( %prime, %alt );
      foreach my $file (@files) {
        my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir );
        my @path = split( /\//, $mapped_filename );
        (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
    
        my $pm_info = $class->new_from_file( $file );
    
        foreach my $package ( $pm_info->packages_inside ) {
          next if $package eq 'main';  # main can appear numerous times, ignore
          next if $package eq 'DB';    # special debugging package, ignore
          next if grep /^_/, split( /::/, $package ); # private package, ignore
    
          my $version = $pm_info->version( $package );
    
          $prime_package = $package if lc($prime_package) eq lc($package);
          if ( $package eq $prime_package ) {
            if ( exists( $prime{$package} ) ) {
              croak "Unexpected conflict in '$package'; multiple versions found.\n";
            } else {
              $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename);
              $prime{$package}{file} = $mapped_filename;
              $prime{$package}{version} = $version if defined( $version );
            }
          } else {
            push( @{$alt{$package}}, {
                                      file    => $mapped_filename,
                                      version => $version,
                                     } );
          }
        }
      }
    
      # Then we iterate over all the packages found above, identifying conflicts
      # and selecting the "best" candidate for recording the file & version
      # for each package.
      foreach my $package ( keys( %alt ) ) {
        my $result = $resolve_module_versions->( $alt{$package} );
    
        if ( exists( $prime{$package} ) ) { # primary package selected
    
          if ( $result->{err} ) {
    	# Use the selected primary package, but there are conflicting
    	# errors among multiple alternative packages that need to be
    	# reported
            log_info {
    	    "Found conflicting versions for package '$package'\n" .
    	    "  $prime{$package}{file} ($prime{$package}{version})\n" .
    	    $result->{err}
            };
    
          } elsif ( defined( $result->{version} ) ) {
    	# There is a primary package selected, and exactly one
    	# alternative package
    
    	if ( exists( $prime{$package}{version} ) &&
    	     defined( $prime{$package}{version} ) ) {
    	  # Unless the version of the primary package agrees with the
    	  # version of the alternative package, report a conflict
    	  if ( $compare_versions->(
                   $prime{$package}{version}, '!=', $result->{version}
                 )
               ) {
  
              log_info {
                "Found conflicting versions for package '$package'\n" .
    	      "  $prime{$package}{file} ($prime{$package}{version})\n" .
    	      "  $result->{file} ($result->{version})\n"
              };
    	  }
    
    	} else {
    	  # The prime package selected has no version so, we choose to
    	  # use any alternative package that does have a version
    	  $prime{$package}{file}    = $result->{file};
    	  $prime{$package}{version} = $result->{version};
    	}
    
          } else {
    	# no alt package found with a version, but we have a prime
    	# package so we use it whether it has a version or not
          }
    
        } else { # No primary package was selected, use the best alternative
    
          if ( $result->{err} ) {
            log_info {
              "Found conflicting versions for package '$package'\n" .
    	    $result->{err}
            };
          }
    
          # Despite possible conflicting versions, we choose to record
          # something rather than nothing
          $prime{$package}{file}    = $result->{file};
          $prime{$package}{version} = $result->{version}
    	  if defined( $result->{version} );
        }
      }
    
      # Normalize versions.  Can't use exists() here because of bug in YAML::Node.
      # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
      for (grep defined $_->{version}, values %prime) {
        $_->{version} = $normalize_version->( $_->{version} );
      }
    
      return \%prime;
    }
  } 
    
  
  sub _init {
    my $class    = shift;
    my $module   = shift;
    my $filename = shift;
    my %props = @_;
  
    my $handle = delete $props{handle};
    my( %valid_props, @valid_props );
    @valid_props = qw( collect_pod inc );
    @valid_props{@valid_props} = delete( @props{@valid_props} );
    warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
  
    my %data = (
      module       => $module,
      filename     => $filename,
      version      => undef,
      packages     => [],
      versions     => {},
      pod          => {},
      pod_headings => [],
      collect_pod  => 0,
  
      %valid_props,
    );
  
    my $self = bless(\%data, $class);
  
    if ( $handle ) {
      $self->_parse_fh($handle);
    }
    else {
      $self->_parse_file();
    }
  
    unless($self->{module} and length($self->{module})) {
      my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
      if($f =~ /\.pm$/) {
        $f =~ s/\..+$//;
        my @candidates = grep /$f$/, @{$self->{packages}};
        $self->{module} = shift(@candidates); # punt
      }
      else {
        if(grep /main/, @{$self->{packages}}) {
          $self->{module} = 'main';
        }
        else {
          $self->{module} = $self->{packages}[0] || '';
        }
      }
    }
  
    $self->{version} = $self->{versions}{$self->{module}}
        if defined( $self->{module} );
  
    return $self;
  }
  
  # class method
  sub _do_find_module {
    my $class   = shift;
    my $module  = shift || croak 'find_module_by_name() requires a package name';
    my $dirs    = shift || \@INC;
  
    my $file = File::Spec->catfile(split( /::/, $module));
    foreach my $dir ( @$dirs ) {
      my $testfile = File::Spec->catfile($dir, $file);
      return [ File::Spec->rel2abs( $testfile ), $dir ]
  	if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
      return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
  	if -e "$testfile.pm";
    }
    return;
  }
  
  # class method
  sub find_module_by_name {
    my $found = shift()->_do_find_module(@_) or return;
    return $found->[0];
  }
  
  # class method
  sub find_module_dir_by_name {
    my $found = shift()->_do_find_module(@_) or return;
    return $found->[1];
  }
  
  
  # given a line of perl code, attempt to parse it if it looks like a
  # $VERSION assignment, returning sigil, full name, & package name
  sub _parse_version_expression {
    my $self = shift;
    my $line = shift;
  
    my( $sig, $var, $pkg );
    if ( $line =~ /$VERS_REGEXP/o ) {
      ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
      if ( $pkg ) {
        $pkg = ($pkg eq '::') ? 'main' : $pkg;
        $pkg =~ s/::$//;
      }
    }
  
    return ( $sig, $var, $pkg );
  }
  
  sub _parse_file {
    my $self = shift;
  
    my $filename = $self->{filename};
    my $fh = IO::File->new( $filename )
      or croak( "Can't open '$filename': $!" );
  
    $self->_handle_bom($fh, $filename);
  
    $self->_parse_fh($fh);
  }
  
  # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
  # If there's one, then skip it and set the :encoding layer appropriately.
  sub _handle_bom {
    my ($self, $fh, $filename) = @_;
  
    my $pos = $fh->getpos;
    return unless defined $pos;
  
    my $buf = ' ' x 2;
    my $count = $fh->read( $buf, length $buf );
    return unless defined $count and $count >= 2;
  
    my $encoding;
    if ( $buf eq "\x{FE}\x{FF}" ) {
      $encoding = 'UTF-16BE';
    } elsif ( $buf eq "\x{FF}\x{FE}" ) {
      $encoding = 'UTF-16LE';
    } elsif ( $buf eq "\x{EF}\x{BB}" ) {
      $buf = ' ';
      $count = $fh->read( $buf, length $buf );
      if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
        $encoding = 'UTF-8';
      }
    }
  
    if ( defined $encoding ) {
      if ( "$]" >= 5.008 ) {
        # $fh->binmode requires perl 5.10
        binmode( $fh, ":encoding($encoding)" );
      }
    } else {
      $fh->setpos($pos)
        or croak( sprintf "Can't reset position to the top of '$filename'" );
    }
  
    return $encoding;
  }
  
  sub _parse_fh {
    my ($self, $fh) = @_;
  
    my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
    my( @pkgs, %vers, %pod, @pod );
    my $pkg = 'main';
    my $pod_sect = '';
    my $pod_data = '';
  
    while (defined( my $line = <$fh> )) {
      my $line_num = $.;
  
      chomp( $line );
  
      # From toke.c : any line that begins by "=X", where X is an alphabetic
      # character, introduces a POD segment.
      my $is_cut;
      if ( $line =~ /^=([a-zA-Z].*)/ ) {
        my $cmd = $1;
        # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
        # character (which includes the newline, but here we chomped it away).
        $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
        $in_pod = !$is_cut;
      }
  
      if ( $in_pod ) {
  
        if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
  	push( @pod, $1 );
  	if ( $self->{collect_pod} && length( $pod_data ) ) {
            $pod{$pod_sect} = $pod_data;
            $pod_data = '';
          }
  	$pod_sect = $1;
  
        } elsif ( $self->{collect_pod} ) {
  	$pod_data .= "$line\n";
  
        }
  
      } elsif ( $is_cut ) {
  
        if ( $self->{collect_pod} && length( $pod_data ) ) {
          $pod{$pod_sect} = $pod_data;
          $pod_data = '';
        }
        $pod_sect = '';
  
      } else {
  
        # Skip comments in code
        next if $line =~ /^\s*#/;
  
        # Would be nice if we could also check $in_string or something too
        last if $line =~ /^__(?:DATA|END)__$/;
  
        # parse $line to see if it's a $VERSION declaration
        my( $vers_sig, $vers_fullname, $vers_pkg ) =
            ($line =~ /VERSION/)
                ? $self->_parse_version_expression( $line )
                : ();
  
        if ( $line =~ /$PKG_REGEXP/o ) {
          $pkg = $1;
          push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
          $vers{$pkg} = $2 unless exists( $vers{$pkg} );
          $need_vers = defined $2 ? 0 : 1;
  
        # VERSION defined with full package spec, i.e. $Module::VERSION
        } elsif ( $vers_fullname && $vers_pkg ) {
  	push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
  	$need_vers = 0 if $vers_pkg eq $pkg;
  
  	unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
  	  $vers{$vers_pkg} =
  	    $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
  	}
  
        # first non-comment line in undeclared package main is VERSION
        } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
  	$need_vers = 0;
  	my $v =
  	  $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
  	$vers{$pkg} = $v;
  	push( @pkgs, 'main' );
  
        # first non-comment line in undeclared package defines package main
        } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
  	$need_vers = 1;
  	$vers{main} = '';
  	push( @pkgs, 'main' );
  
        # only keep if this is the first $VERSION seen
        } elsif ( $vers_fullname && $need_vers ) {
  	$need_vers = 0;
  	my $v =
  	  $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
  
  
  	unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
  	  $vers{$pkg} = $v;
  	} 
  
        }
  
      }
  
    }
  
    if ( $self->{collect_pod} && length($pod_data) ) {
      $pod{$pod_sect} = $pod_data;
    }
  
    $self->{versions} = \%vers;
    $self->{packages} = \@pkgs;
    $self->{pod} = \%pod;
    $self->{pod_headings} = \@pod;
  }
  
  {
  my $pn = 0;
  sub _evaluate_version_line {
    my $self = shift;
    my( $sigil, $var, $line ) = @_;
  
    # Some of this code came from the ExtUtils:: hierarchy.
  
    # We compile into $vsub because 'use version' would cause
    # compiletime/runtime issues with local()
    my $vsub;
    $pn++; # everybody gets their own package
    my $eval = qq{BEGIN { q#  Hide from _packages_inside()
      #; package Module::Metadata::_version::p$pn;
      use version;
      no strict;
  
        \$vsub = sub {
          local $sigil$var;
          \$$var=undef;
          $line;
          \$$var
        };
    }};
  
    local $^W;
    # Try to get the $VERSION
    eval $eval;
    # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
    # installed, so we need to hunt in ./lib for it
    if ( $@ =~ /Can't locate/ && -d 'lib' ) {
      local @INC = ('lib',@INC);
      eval $eval;
    }
    warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
      if $@;
    (ref($vsub) eq 'CODE') or
      croak "failed to build version sub for $self->{filename}";
    my $result = eval { $vsub->() };
    croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
      if $@;
  
    # Upgrade it into a version object
    my $version = eval { _dwim_version($result) };
  
    croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
      unless defined $version; # "0" is OK!
  
    return $version;
  }
  }
  
  # Try to DWIM when things fail the lax version test in obvious ways
  {
    my @version_prep = (
      # Best case, it just works
      sub { return shift },
  
      # If we still don't have a version, try stripping any
      # trailing junk that is prohibited by lax rules
      sub {
        my $v = shift;
        $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
        return $v;
      },
  
      # Activestate apparently creates custom versions like '1.23_45_01', which
      # cause version.pm to think it's an invalid alpha.  So check for that
      # and strip them
      sub {
        my $v = shift;
        my $num_dots = () = $v =~ m{(\.)}g;
        my $num_unders = () = $v =~ m{(_)}g;
        my $leading_v = substr($v,0,1) eq 'v';
        if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
          $v =~ s{_}{}g;
          $num_unders = () = $v =~ m{(_)}g;
        }
        return $v;
      },
  
      # Worst case, try numifying it like we would have before version objects
      sub {
        my $v = shift;
        no warnings 'numeric';
        return 0 + $v;
      },
  
    );
  
    sub _dwim_version {
      my ($result) = shift;
  
      return $result if ref($result) eq 'version';
  
      my ($version, $error);
      for my $f (@version_prep) {
        $result = $f->($result);
        $version = eval { version->new($result) };
        $error ||= $@ if $@; # capture first failure
        last if defined $version;
      }
  
      croak $error unless defined $version;
  
      return $version;
    }
  }
  
  ############################################################
  
  # accessors
  sub name            { $_[0]->{module}           }
  
  sub filename        { $_[0]->{filename}         }
  sub packages_inside { @{$_[0]->{packages}}      }
  sub pod_inside      { @{$_[0]->{pod_headings}}  }
  sub contains_pod    { $#{$_[0]->{pod_headings}} }
  
  sub version {
      my $self = shift;
      my $mod  = shift || $self->{module};
      my $vers;
      if ( defined( $mod ) && length( $mod ) &&
  	 exists( $self->{versions}{$mod} ) ) {
  	return $self->{versions}{$mod};
      } else {
  	return undef;
      }
  }
  
  sub pod {
      my $self = shift;
      my $sect = shift;
      if ( defined( $sect ) && length( $sect ) &&
  	 exists( $self->{pod}{$sect} ) ) {
  	return $self->{pod}{$sect};
      } else {
  	return undef;
      }
  }
  
  1;
  
  =head1 NAME
  
  Module::Metadata - Gather package and POD information from perl module files
  
  =head1 SYNOPSIS
  
    use Module::Metadata;
  
    # information about a .pm file
    my $info = Module::Metadata->new_from_file( $file );
    my $version = $info->version;
  
    # CPAN META 'provides' field for .pm files in a directory
    my $provides = Module::Metadata->provides(
      dir => 'lib', version => 2
    );
  
  =head1 DESCRIPTION
  
  This module provides a standard way to gather metadata about a .pm file
  without executing unsafe code.
  
  =head1 USAGE
  
  =head2 Class methods
  
  =over 4
  
  =item C<< new_from_file($filename, collect_pod => 1) >>
  
  Constructs a C<Module::Metadata> object given the path to a file.  Returns
  undef if the filename does not exist.
  
  C<collect_pod> is a optional boolean argument that determines whether POD
  data is collected and stored for reference.  POD data is not collected by
  default.  POD headings are always collected.
  
  If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then
  it is skipped before processing, and the content of the file is also decoded
  appropriately starting from perl 5.8.
  
  =item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
  
  This works just like C<new_from_file>, except that a handle can be provided
  as the first argument.
  
  Note that there is no validation to confirm that the handle is a handle or
  something that can act like one.  Passing something that isn't a handle will
  cause a exception when trying to read from it.  The C<filename> argument is
  mandatory or undef will be returned.
  
  You are responsible for setting the decoding layers on C<$handle> if
  required.
  
  =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
  
  Constructs a C<Module::Metadata> object given a module or package name.
  Returns undef if the module cannot be found.
  
  In addition to accepting the C<collect_pod> argument as described above,
  this method accepts a C<inc> argument which is a reference to an array of
  directories to search for the module.  If none are given, the default is
  @INC.
  
  If the file that contains the module begins by an UTF-8, UTF-16BE or
  UTF-16LE byte-order mark, then it is skipped before processing, and the
  content of the file is also decoded appropriately starting from perl 5.8.
  
  =item C<< find_module_by_name($module, \@dirs) >>
  
  Returns the path to a module given the module or package name. A list
  of directories can be passed in as an optional parameter, otherwise
  @INC is searched.
  
  Can be called as either an object or a class method.
  
  =item C<< find_module_dir_by_name($module, \@dirs) >>
  
  Returns the entry in C<@dirs> (or C<@INC> by default) that contains
  the module C<$module>. A list of directories can be passed in as an
  optional parameter, otherwise @INC is searched.
  
  Can be called as either an object or a class method.
  
  =item C<< provides( %options ) >>
  
  This is a convenience wrapper around C<package_versions_from_directory>
  to generate a CPAN META C<provides> data structure.  It takes key/value
  pairs.  Valid option keys include:
  
  =over
  
  =item version B<(required)>
  
  Specifies which version of the L<CPAN::Meta::Spec> should be used as
  the format of the C<provides> output.  Currently only '1.4' and '2'
  are supported (and their format is identical).  This may change in
  the future as the definition of C<provides> changes.
  
  The C<version> option is required.  If it is omitted or if
  an unsupported version is given, then C<provides> will throw an error.
  
  =item dir
  
  Directory to search recursively for F<.pm> files.  May not be specified with
  C<files>.
  
  =item files
  
  Array reference of files to examine.  May not be specified with C<dir>.
  
  =item prefix
  
  String to prepend to the C<file> field of the resulting output. This defaults
  to F<lib>, which is the common case for most CPAN distributions with their
  F<.pm> files in F<lib>.  This option ensures the META information has the
  correct relative path even when the C<dir> or C<files> arguments are
  absolute or have relative paths from a location other than the distribution
  root.
  
  =back
  
  For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
  is a hashref of the form:
  
    {
      'Package::Name' => {
        version => '0.123',
        file => 'lib/Package/Name.pm'
      },
      'OtherPackage::Name' => ...
    }
  
  =item C<< package_versions_from_directory($dir, \@files?) >>
  
  Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
  for those files in C<$dir> - and reads each file for packages and versions,
  returning a hashref of the form:
  
    {
      'Package::Name' => {
        version => '0.123',
        file => 'Package/Name.pm'
      },
      'OtherPackage::Name' => ...
    }
  
  The C<DB> and C<main> packages are always omitted, as are any "private"
  packages that have leading underscores in the namespace (e.g.
  C<Foo::_private>)
  
  Note that the file path is relative to C<$dir> if that is specified.
  This B<must not> be used directly for CPAN META C<provides>.  See
  the C<provides> method instead.
  
  =item C<< log_info (internal) >>
  
  Used internally to perform logging; imported from Log::Contextual if
  Log::Contextual has already been loaded, otherwise simply calls warn.
  
  =back
  
  =head2 Object methods
  
  =over 4
  
  =item C<< name() >>
  
  Returns the name of the package represented by this module. If there
  are more than one packages, it makes a best guess based on the
  filename. If it's a script (i.e. not a *.pm) the package name is
  'main'.
  
  =item C<< version($package) >>
  
  Returns the version as defined by the $VERSION variable for the
  package as returned by the C<name> method if no arguments are
  given. If given the name of a package it will attempt to return the
  version of that package if it is specified in the file.
  
  =item C<< filename() >>
  
  Returns the absolute path to the file.
  
  =item C<< packages_inside() >>
  
  Returns a list of packages. Note: this is a raw list of packages
  discovered (or assumed, in the case of C<main>).  It is not
  filtered for C<DB>, C<main> or private packages the way the
  C<provides> method does.
  
  =item C<< pod_inside() >>
  
  Returns a list of POD sections.
  
  =item C<< contains_pod() >>
  
  Returns true if there is any POD in the file.
  
  =item C<< pod($section) >>
  
  Returns the POD data in the given section.
  
  =back
  
  =head1 AUTHOR
  
  Original code from Module::Build::ModuleInfo by Ken Williams
  <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
  
  Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
  assistance from David Golden (xdg) <dagolden@cpan.org>.
  
  =head1 COPYRIGHT & LICENSE
  
  Original code Copyright (c) 2001-2011 Ken Williams.
  Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
  All rights reserved.
  
  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
  
MODULE_METADATA

$fatpacked{"Module/Pluggable.pm"} = <<'MODULE_PLUGGABLE';
  package Module::Pluggable;
  
  use strict;
  use vars qw($VERSION $FORCE_SEARCH_ALL_PATHS);
  use Module::Pluggable::Object;
  
  # ObQuote:
  # Bob Porter: Looks like you've been missing a lot of work lately. 
  # Peter Gibbons: I wouldn't say I've been missing it, Bob! 
  
  
  $VERSION = '4.5'; # core release only!
  $FORCE_SEARCH_ALL_PATHS = 0;
  
  sub import {
      my $class        = shift;
      my %opts         = @_;
  
      my ($pkg, $file) = caller; 
      # the default name for the method is 'plugins'
      my $sub          = $opts{'sub_name'}  || 'plugins';
      # get our package 
      my ($package)    = $opts{'package'} || $pkg;
      $opts{filename}  = $file;
      $opts{package}   = $package;
      $opts{force_search_all_paths} = $FORCE_SEARCH_ALL_PATHS unless exists $opts{force_search_all_paths};
  
  
      my $finder       = Module::Pluggable::Object->new(%opts);
      my $subroutine   = sub { my $self = shift; return $finder->plugins(@_) };
  
      my $searchsub = sub {
                my $self = shift;
                my ($action,@paths) = @_;
  
                $finder->{'search_path'} = ["${package}::Plugin"] if ($action eq 'add'  and not   $finder->{'search_path'} );
                push @{$finder->{'search_path'}}, @paths      if ($action eq 'add');
                $finder->{'search_path'}       = \@paths      if ($action eq 'new');
                return $finder->{'search_path'};
      };
  
  
      my $onlysub = sub {
          my ($self, $only) = @_;
  
          if (defined $only) {
              $finder->{'only'} = $only;
          };
          
          return $finder->{'only'};
      };
  
      my $exceptsub = sub {
          my ($self, $except) = @_;
  
          if (defined $except) {
              $finder->{'except'} = $except;
          };
          
          return $finder->{'except'};
      };
  
  
      no strict 'refs';
      no warnings qw(redefine prototype);
      
      *{"$package\::$sub"}        = $subroutine;
      *{"$package\::search_path"} = $searchsub;
      *{"$package\::only"}        = $onlysub;
      *{"$package\::except"}      = $exceptsub;
  
  }
  
  1;
  
  =pod
  
  =head1 NAME
  
  Module::Pluggable - automatically give your module the ability to have plugins
  
  =head1 SYNOPSIS
  
  
  Simple use Module::Pluggable -
  
      package MyClass;
      use Module::Pluggable;
      
  
  and then later ...
  
      use MyClass;
      my $mc = MyClass->new();
      # returns the names of all plugins installed under MyClass::Plugin::*
      my @plugins = $mc->plugins(); 
  
  =head1 EXAMPLE
  
  Why would you want to do this? Say you have something that wants to pass an
  object to a number of different plugins in turn. For example you may 
  want to extract meta-data from every email you get sent and do something
  with it. Plugins make sense here because then you can keep adding new 
  meta data parsers and all the logic and docs for each one will be 
  self contained and new handlers are easy to add without changing the 
  core code. For that, you might do something like ...
  
      package Email::Examiner;
  
      use strict;
      use Email::Simple;
      use Module::Pluggable require => 1;
  
      sub handle_email {
          my $self  = shift;
          my $email = shift;
  
          foreach my $plugin ($self->plugins) {
              $plugin->examine($email);
          }
  
          return 1;
      }
  
  
  
  .. and all the plugins will get a chance in turn to look at it.
  
  This can be trivally extended so that plugins could save the email
  somewhere and then no other plugin should try and do that. 
  Simply have it so that the C<examine> method returns C<1> if 
  it has saved the email somewhere. You might also wnat to be paranoid
  and check to see if the plugin has an C<examine> method.
  
          foreach my $plugin ($self->plugins) {
              next unless $plugin->can('examine');
              last if     $plugin->examine($email);
          }
  
  
  And so on. The sky's the limit.
  
  
  =head1 DESCRIPTION
  
  Provides a simple but, hopefully, extensible way of having 'plugins' for 
  your module. Obviously this isn't going to be the be all and end all of
  solutions but it works for me.
  
  Essentially all it does is export a method into your namespace that 
  looks through a search path for .pm files and turn those into class names. 
  
  Optionally it instantiates those classes for you.
  
  =head1 ADVANCED USAGE
  
  Alternatively, if you don't want to use 'plugins' as the method ...
  
      package MyClass;
      use Module::Pluggable sub_name => 'foo';
  
  
  and then later ...
  
      my @plugins = $mc->foo();
  
  
  Or if you want to look in another namespace
  
      package MyClass;
      use Module::Pluggable search_path => ['Acme::MyClass::Plugin', 'MyClass::Extend'];
  
  or directory 
  
      use Module::Pluggable search_dirs => ['mylibs/Foo'];
  
  
  Or if you want to instantiate each plugin rather than just return the name
  
      package MyClass;
      use Module::Pluggable instantiate => 'new';
  
  and then
  
      # whatever is passed to 'plugins' will be passed 
      # to 'new' for each plugin 
      my @plugins = $mc->plugins(@options); 
  
  
  alternatively you can just require the module without instantiating it
  
      package MyClass;
      use Module::Pluggable require => 1;
  
  since requiring automatically searches inner packages, which may not be desirable, you can turn this off
  
  
      package MyClass;
      use Module::Pluggable require => 1, inner => 0;
  
  
  You can limit the plugins loaded using the except option, either as a string,
  array ref or regex
  
      package MyClass;
      use Module::Pluggable except => 'MyClass::Plugin::Foo';
  
  or
  
      package MyClass;
      use Module::Pluggable except => ['MyClass::Plugin::Foo', 'MyClass::Plugin::Bar'];
  
  or
  
      package MyClass;
      use Module::Pluggable except => qr/^MyClass::Plugin::(Foo|Bar)$/;
  
  
  and similarly for only which will only load plugins which match.
  
  Remember you can use the module more than once
  
      package MyClass;
      use Module::Pluggable search_path => 'MyClass::Filters' sub_name => 'filters';
      use Module::Pluggable search_path => 'MyClass::Plugins' sub_name => 'plugins';
  
  and then later ...
  
      my @filters = $self->filters;
      my @plugins = $self->plugins;
      
  =head1 PLUGIN SEARCHING
  
  Every time you call 'plugins' the whole search path is walked again. This allows 
  for dynamically loading plugins even at run time. However this can get expensive 
  and so if you don't expect to want to add new plugins at run time you could do
  
  
    package Foo;
    use strict;
    use Module::Pluggable sub_name => '_plugins';
  
    our @PLUGINS;
    sub plugins { @PLUGINS ||= shift->_plugins }
    1;
  
  =head1 INNER PACKAGES
  
  If you have, for example, a file B<lib/Something/Plugin/Foo.pm> that
  contains package definitions for both C<Something::Plugin::Foo> and 
  C<Something::Plugin::Bar> then as long as you either have either 
  the B<require> or B<instantiate> option set then we'll also find 
  C<Something::Plugin::Bar>. Nifty!
  
  =head1 OPTIONS
  
  You can pass a hash of options when importing this module.
  
  The options can be ...
  
  =head2 sub_name
  
  The name of the subroutine to create in your namespace. 
  
  By default this is 'plugins'
  
  =head2 search_path
  
  An array ref of namespaces to look in. 
  
  =head2 search_dirs 
  
  An array ref of directorys to look in before @INC.
  
  =head2 instantiate
  
  Call this method on the class. In general this will probably be 'new'
  but it can be whatever you want. Whatever arguments are passed to 'plugins' 
  will be passed to the method.
  
  The default is 'undef' i.e just return the class name.
  
  =head2 require
  
  Just require the class, don't instantiate (overrides 'instantiate');
  
  =head2 inner
  
  If set to 0 will B<not> search inner packages. 
  If set to 1 will override C<require>.
  
  =head2 only
  
  Takes a string, array ref or regex describing the names of the only plugins to 
  return. Whilst this may seem perverse ... well, it is. But it also 
  makes sense. Trust me.
  
  =head2 except
  
  Similar to C<only> it takes a description of plugins to exclude 
  from returning. This is slightly less perverse.
  
  =head2 package
  
  This is for use by extension modules which build on C<Module::Pluggable>:
  passing a C<package> option allows you to place the plugin method in a
  different package other than your own.
  
  =head2 file_regex
  
  By default C<Module::Pluggable> only looks for I<.pm> files.
  
  By supplying a new C<file_regex> then you can change this behaviour e.g
  
      file_regex => qr/\.plugin$/
  
  =head2 include_editor_junk
  
  By default C<Module::Pluggable> ignores files that look like they were
  left behind by editors. Currently this means files ending in F<~> (~),
  the extensions F<.swp> or F<.swo>, or files beginning with F<.#>.
  
  Setting C<include_editor_junk> changes C<Module::Pluggable> so it does
  not ignore any files it finds.
  
  =head2 follow_symlinks
  
  Whether, when searching directories, to follow symlinks.
  
  Defaults to 1 i.e do follow symlinks.
  
  =head2 min_depth, max_depth
  
  This will allow you to set what 'depth' of plugin will be allowed.
  
  So, for example, C<MyClass::Plugin::Foo> will have a depth of 3 and 
  C<MyClass::Plugin::Foo::Bar> will have a depth of 4 so to only get the former 
  (i.e C<MyClass::Plugin::Foo>) do
  
          package MyClass;
          use Module::Pluggable max_depth => 3;
          
  and to only get the latter (i.e C<MyClass::Plugin::Foo::Bar>)
  
          package MyClass;
          use Module::Pluggable min_depth => 4;
  
  
  =head1 TRIGGERS
  
  Various triggers can also be passed in to the options.
  
  If any of these triggers return 0 then the plugin will not be returned.
  
  =head2 before_require <plugin>
  
  Gets passed the plugin name. 
  
  If 0 is returned then this plugin will not be required either.
  
  =head2 on_require_error <plugin> <err>
  
  Gets called when there's an error on requiring the plugin.
  
  Gets passed the plugin name and the error. 
  
  The default on_require_error handler is to C<carp> the error and return 0.
  
  =head2 on_instantiate_error <plugin> <err>
  
  Gets called when there's an error on instantiating the plugin.
  
  Gets passed the plugin name and the error. 
  
  The default on_instantiate_error handler is to C<carp> the error and return 0.
  
  =head2 after_require <plugin>
  
  Gets passed the plugin name. 
  
  If 0 is returned then this plugin will be required but not returned as a plugin.
  
  =head1 METHODs
  
  =head2 search_path
  
  The method C<search_path> is exported into you namespace as well. 
  You can call that at any time to change or replace the 
  search_path.
  
      $self->search_path( add => "New::Path" ); # add
      $self->search_path( new => "New::Path" ); # replace
  
  =head1 BEHAVIOUR UNDER TEST ENVIRONMENT
  
  In order to make testing reliable we exclude anything not from blib if blib.pm is 
  in %INC. 
  
  However if the module being tested used another module that itself used C<Module::Pluggable> 
  then the second module would fail. This was fixed by checking to see if the caller 
  had (^|/)blib/ in their filename.
  
  There's an argument that this is the wrong behaviour and that modules should explicitly
  trigger this behaviour but that particular code has been around for 7 years now and I'm 
  reluctant to change the default behaviour.
  
  You can now (as of version 4.1) force Module::Pluggable to look outside blib in a test environment by doing either
  
          require Module::Pluggable;
          $Module::Pluggable::FORCE_SEARCH_ALL_PATHS = 1;
          import Module::Pluggable;
  
  or
  
          use Module::Pluggable force_search_all_paths => 1;
          
  
  =head1 FUTURE PLANS
  
  This does everything I need and I can't really think of any other 
  features I want to add. Famous last words of course
  
  Recently tried fixed to find inner packages and to make it 
  'just work' with PAR but there are still some issues.
  
  
  However suggestions (and patches) are welcome.
  
  =head1 DEVELOPMENT
  
  The master repo for this module is at
  
  https://github.com/simonwistow/Module-Pluggable
  
  =head1 AUTHOR
  
  Simon Wistow <simon@thegestalt.org>
  
  =head1 COPYING
  
  Copyright, 2006 Simon Wistow
  
  Distributed under the same terms as Perl itself.
  
  =head1 BUGS
  
  None known.
  
  =head1 SEE ALSO
  
  L<File::Spec>, L<File::Find>, L<File::Basename>, L<Class::Factory::Util>, L<Module::Pluggable::Ordered>
  
  =cut 
  
  
MODULE_PLUGGABLE

$fatpacked{"Module/Pluggable/Object.pm"} = <<'MODULE_PLUGGABLE_OBJECT';
  package Module::Pluggable::Object;
  
  use strict;
  use File::Find ();
  use File::Basename;
  use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel);
  use Carp qw(croak carp confess);
  use Devel::InnerPackage;
  use vars qw($VERSION);
  
  $VERSION = '4.5';
  
  
  sub new {
      my $class = shift;
      my %opts  = @_;
  
      return bless \%opts, $class;
  
  }
  
  ### Eugggh, this code smells 
  ### This is what happens when you keep adding patches
  ### *sigh*
  
  
  sub plugins {
      my $self = shift;
      my @args = @_;
  
      # override 'require'
      $self->{'require'} = 1 if $self->{'inner'};
  
      my $filename   = $self->{'filename'};
      my $pkg        = $self->{'package'};
  
      # Get the exception params instantiated
      $self->_setup_exceptions;
  
      # automatically turn a scalar search path or namespace into a arrayref
      for (qw(search_path search_dirs)) {
          $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_});
      }
  
      # default search path is '<Module>::<Name>::Plugin'
      $self->{'search_path'} ||= ["${pkg}::Plugin"]; 
  
      # default error handler
      $self->{'on_require_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't require $plugin : $err"; return 0 };
      $self->{'on_instantiate_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't instantiate $plugin: $err"; return 0 };
  
      # default whether to follow symlinks
      $self->{'follow_symlinks'} = 1 unless exists $self->{'follow_symlinks'};
  
      # check to see if we're running under test
      my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! && !$self->{'force_search_all_paths'} ? grep {/blib/} @INC : @INC;
  
      # add any search_dir params
      unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'};
  
      # set our @INC up to include and prefer our search_dirs if necessary
      my @tmp = @INC;
      unshift @tmp, @{$self->{'search_dirs'} || []};
      local @INC = @tmp if defined $self->{'search_dirs'};
  
      my @plugins = $self->search_directories(@SEARCHDIR);
      push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}};
      
      # return blank unless we've found anything
      return () unless @plugins;
  
      # remove duplicates
      # probably not necessary but hey ho
      my %plugins;
      for(@plugins) {
          next unless $self->_is_legit($_);
          $plugins{$_} = 1;
      }
  
      # are we instantiating or requring?
      if (defined $self->{'instantiate'}) {
          my $method = $self->{'instantiate'};
          my @objs   = ();
          foreach my $package (keys %plugins) {
  			next unless $package->can($method);
              my $obj = eval { $package->$method(@_) };
  	        $self->{'on_instantiate_error'}->($package, $@) if $@;
              push @objs, $obj if $obj;           
          }
          return @objs;
      } else { 
          # no? just return the names
          return keys %plugins;
      }
  }
  
  sub _setup_exceptions {
      my $self = shift;
  
      my %only;   
      my %except; 
      my $only;
      my $except;
  
      if (defined $self->{'only'}) {
          if (ref($self->{'only'}) eq 'ARRAY') {
              %only   = map { $_ => 1 } @{$self->{'only'}};
          } elsif (ref($self->{'only'}) eq 'Regexp') {
              $only = $self->{'only'}
          } elsif (ref($self->{'only'}) eq '') {
              $only{$self->{'only'}} = 1;
          }
      }
          
  
      if (defined $self->{'except'}) {
          if (ref($self->{'except'}) eq 'ARRAY') {
              %except   = map { $_ => 1 } @{$self->{'except'}};
          } elsif (ref($self->{'except'}) eq 'Regexp') {
              $except = $self->{'except'}
          } elsif (ref($self->{'except'}) eq '') {
              $except{$self->{'except'}} = 1;
          }
      }
      $self->{_exceptions}->{only_hash}   = \%only;
      $self->{_exceptions}->{only}        = $only;
      $self->{_exceptions}->{except_hash} = \%except;
      $self->{_exceptions}->{except}      = $except;
          
  }
  
  sub _is_legit {
      my $self   = shift;
      my $plugin = shift;
      my %only   = %{$self->{_exceptions}->{only_hash}||{}};
      my %except = %{$self->{_exceptions}->{except_hash}||{}};
      my $only   = $self->{_exceptions}->{only};
      my $except = $self->{_exceptions}->{except};
      my $depth  = () = split '::', $plugin, -1;
  
      return 0 if     (keys %only   && !$only{$plugin}     );
      return 0 unless (!defined $only || $plugin =~ m!$only!     );
  
      return 0 if     (keys %except &&  $except{$plugin}   );
      return 0 if     (defined $except &&  $plugin =~ m!$except! );
      
      return 0 if     defined $self->{max_depth} && $depth>$self->{max_depth};
      return 0 if     defined $self->{min_depth} && $depth<$self->{min_depth};
  
      return 1;
  }
  
  sub search_directories {
      my $self      = shift;
      my @SEARCHDIR = @_;
  
      my @plugins;
      # go through our @INC
      foreach my $dir (@SEARCHDIR) {
          push @plugins, $self->search_paths($dir);
      }
      return @plugins;
  }
  
  
  sub search_paths {
      my $self = shift;
      my $dir  = shift;
      my @plugins;
  
      my $file_regex = $self->{'file_regex'} || qr/\.pm$/;
  
  
      # and each directory in our search path
      foreach my $searchpath (@{$self->{'search_path'}}) {
          # create the search directory in a cross platform goodness way
          my $sp = catdir($dir, (split /::/, $searchpath));
  
          # if it doesn't exist or it's not a dir then skip it
          next unless ( -e $sp && -d _ ); # Use the cached stat the second time
  
          my @files = $self->find_files($sp);
  
          # foreach one we've found 
          foreach my $file (@files) {
              # untaint the file; accept .pm only
              next unless ($file) = ($file =~ /(.*$file_regex)$/); 
              # parse the file to get the name
              my ($name, $directory, $suffix) = fileparse($file, $file_regex);
  
              next if (!$self->{include_editor_junk} && $self->_is_editor_junk($name));
  
              $directory = abs2rel($directory, $sp);
  
              # If we have a mixed-case package name, assume case has been preserved
              # correctly.  Otherwise, root through the file to locate the case-preserved
              # version of the package name.
              my @pkg_dirs = ();
              if ( $name eq lc($name) || $name eq uc($name) ) {
                  my $pkg_file = catfile($sp, $directory, "$name$suffix");
                  open PKGFILE, "<$pkg_file" or die "search_paths: Can't open $pkg_file: $!";
                  my $in_pod = 0;
                  while ( my $line = <PKGFILE> ) {
                      $in_pod = 1 if $line =~ m/^=\w/;
                      $in_pod = 0 if $line =~ /^=cut/;
                      next if ($in_pod || $line =~ /^=cut/);  # skip pod text
                      next if $line =~ /^\s*#/;               # and comments
                      if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) {
                          @pkg_dirs = split /::/, $1 if defined $1;;
                          $name = $2;
                          last;
                      }
                  }
                  close PKGFILE;
              }
  
              # then create the class name in a cross platform way
              $directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/);       # remove volume
              my @dirs = ();
              if ($directory) {
                  ($directory) = ($directory =~ /(.*)/);
                  @dirs = grep(length($_), splitdir($directory)) 
                      unless $directory eq curdir();
                  for my $d (reverse @dirs) {
                      my $pkg_dir = pop @pkg_dirs; 
                      last unless defined $pkg_dir;
                      $d =~ s/\Q$pkg_dir\E/$pkg_dir/i;  # Correct case
                  }
              } else {
                  $directory = "";
              }
              my $plugin = join '::', $searchpath, @dirs, $name;
  
              next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i;
  
              $self->handle_finding_plugin($plugin, \@plugins)
          }
  
          # now add stuff that may have been in package
          # NOTE we should probably use all the stuff we've been given already
          # but then we can't unload it :(
          push @plugins, $self->handle_innerpackages($searchpath);
      } # foreach $searchpath
  
      return @plugins;
  }
  
  sub _is_editor_junk {
      my $self = shift;
      my $name = shift;
  
      # Emacs (and other Unix-y editors) leave temp files ending in a
      # tilde as a backup.
      return 1 if $name =~ /~$/;
      # Emacs makes these files while a buffer is edited but not yet
      # saved.
      return 1 if $name =~ /^\.#/;
      # Vim can leave these files behind if it crashes.
      return 1 if $name =~ /\.sw[po]$/;
  
      return 0;
  }
  
  sub handle_finding_plugin {
      my $self    = shift;
      my $plugin  = shift;
      my $plugins = shift;
      my $no_req  = shift || 0;
      
      return unless $self->_is_legit($plugin);
      unless (defined $self->{'instantiate'} || $self->{'require'}) {
          push @$plugins, $plugin;
          return;
      } 
  
      $self->{before_require}->($plugin) || return if defined $self->{before_require};
      unless ($no_req) {
          my $tmp = $@;
          my $res = eval { $self->_require($plugin) };
          my $err = $@;
          $@      = $tmp;
          if ($err) {
              if (defined $self->{on_require_error}) {
                  $self->{on_require_error}->($plugin, $err) || return; 
              } else {
                  return;
              }
          }
      }
      $self->{after_require}->($plugin) || return if defined $self->{after_require};
      push @$plugins, $plugin;
  }
  
  sub find_files {
      my $self         = shift;
      my $search_path  = shift;
      my $file_regex   = $self->{'file_regex'} || qr/\.pm$/;
  
  
      # find all the .pm files in it
      # this isn't perfect and won't find multiple plugins per file
      #my $cwd = Cwd::getcwd;
      my @files = ();
      { # for the benefit of perl 5.6.1's Find, localize topic
          local $_;
          File::Find::find( { no_chdir => 1, 
                              follow   => $self->{'follow_symlinks'}, 
                              wanted   => sub { 
                               # Inlined from File::Find::Rule C< name => '*.pm' >
                               return unless $File::Find::name =~ /$file_regex/;
                               (my $path = $File::Find::name) =~ s#^\\./##;
                               push @files, $path;
                             }
                        }, $search_path );
      }
      #chdir $cwd;
      return @files;
  
  }
  
  sub handle_innerpackages {
      my $self = shift;
      return () if (exists $self->{inner} && !$self->{inner});
  
      my $path = shift;
      my @plugins;
  
      foreach my $plugin (Devel::InnerPackage::list_packages($path)) {
          $self->handle_finding_plugin($plugin, \@plugins, 1);
      }
      return @plugins;
  
  }
  
  
  sub _require {
      my $self   = shift;
      my $pack   = shift;
      eval "CORE::require $pack";
      die ($@) if $@;
      return 1;
  }
  
  
  1;
  
  =pod
  
  =head1 NAME
  
  Module::Pluggable::Object - automatically give your module the ability to have plugins
  
  =head1 SYNOPSIS
  
  
  Simple use Module::Pluggable -
  
      package MyClass;
      use Module::Pluggable::Object;
      
      my $finder = Module::Pluggable::Object->new(%opts);
      print "My plugins are: ".join(", ", $finder->plugins)."\n";
  
  =head1 DESCRIPTION
  
  Provides a simple but, hopefully, extensible way of having 'plugins' for 
  your module. Obviously this isn't going to be the be all and end all of
  solutions but it works for me.
  
  Essentially all it does is export a method into your namespace that 
  looks through a search path for .pm files and turn those into class names. 
  
  Optionally it instantiates those classes for you.
  
  This object is wrapped by C<Module::Pluggable>. If you want to do something
  odd or add non-general special features you're probably best to wrap this
  and produce your own subclass.
  
  =head1 OPTIONS
  
  See the C<Module::Pluggable> docs.
  
  =head1 AUTHOR
  
  Simon Wistow <simon@thegestalt.org>
  
  =head1 COPYING
  
  Copyright, 2006 Simon Wistow
  
  Distributed under the same terms as Perl itself.
  
  =head1 BUGS
  
  None known.
  
  =head1 SEE ALSO
  
  L<Module::Pluggable>
  
  =cut 
  
MODULE_PLUGGABLE_OBJECT

$fatpacked{"Params/Check.pm"} = <<'PARAMS_CHECK';
  package Params::Check;
  
  use strict;
  
  use Carp                        qw[carp croak];
  use Locale::Maketext::Simple    Style => 'gettext';
  
  BEGIN {
      use Exporter    ();
      use vars        qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $ALLOW_UNKNOWN
                          $STRICT_TYPE $STRIP_LEADING_DASHES $NO_DUPLICATES
                          $PRESERVE_CASE $ONLY_ALLOW_DEFINED $WARNINGS_FATAL
                          $SANITY_CHECK_TEMPLATE $CALLER_DEPTH $_ERROR_STRING
                      ];
  
      @ISA        =   qw[ Exporter ];
      @EXPORT_OK  =   qw[check allow last_error];
  
      $VERSION                = '0.36';
      $VERBOSE                = $^W ? 1 : 0;
      $NO_DUPLICATES          = 0;
      $STRIP_LEADING_DASHES   = 0;
      $STRICT_TYPE            = 0;
      $ALLOW_UNKNOWN          = 0;
      $PRESERVE_CASE          = 0;
      $ONLY_ALLOW_DEFINED     = 0;
      $SANITY_CHECK_TEMPLATE  = 1;
      $WARNINGS_FATAL         = 0;
      $CALLER_DEPTH           = 0;
  }
  
  my %known_keys = map { $_ => 1 }
                      qw| required allow default strict_type no_override
                          store defined |;
  
  =pod
  
  =head1 NAME
  
  Params::Check - A generic input parsing/checking mechanism.
  
  =head1 SYNOPSIS
  
      use Params::Check qw[check allow last_error];
  
      sub fill_personal_info {
          my %hash = @_;
          my $x;
  
          my $tmpl = {
              firstname   => { required   => 1, defined => 1 },
              lastname    => { required   => 1, store => \$x },
              gender      => { required   => 1,
                               allow      => [qr/M/i, qr/F/i],
                             },
              married     => { allow      => [0,1] },
              age         => { default    => 21,
                               allow      => qr/^\d+$/,
                             },
  
              phone       => { allow => [ sub { return 1 if /$valid_re/ },
                                          '1-800-PERL' ]
                             },
              id_list     => { default        => [],
                               strict_type    => 1
                             },
              employer    => { default => 'NSA', no_override => 1 },
          };
  
          ### check() returns a hashref of parsed args on success ###
          my $parsed_args = check( $tmpl, \%hash, $VERBOSE )
                              or die qw[Could not parse arguments!];
  
          ... other code here ...
      }
  
      my $ok = allow( $colour, [qw|blue green yellow|] );
  
      my $error = Params::Check::last_error();
  
  
  =head1 DESCRIPTION
  
  Params::Check is a generic input parsing/checking mechanism.
  
  It allows you to validate input via a template. The only requirement
  is that the arguments must be named.
  
  Params::Check can do the following things for you:
  
  =over 4
  
  =item *
  
  Convert all keys to lowercase
  
  =item *
  
  Check if all required arguments have been provided
  
  =item *
  
  Set arguments that have not been provided to the default
  
  =item *
  
  Weed out arguments that are not supported and warn about them to the
  user
  
  =item *
  
  Validate the arguments given by the user based on strings, regexes,
  lists or even subroutines
  
  =item *
  
  Enforce type integrity if required
  
  =back
  
  Most of Params::Check's power comes from its template, which we'll
  discuss below:
  
  =head1 Template
  
  As you can see in the synopsis, based on your template, the arguments
  provided will be validated.
  
  The template can take a different set of rules per key that is used.
  
  The following rules are available:
  
  =over 4
  
  =item default
  
  This is the default value if none was provided by the user.
  This is also the type C<strict_type> will look at when checking type
  integrity (see below).
  
  =item required
  
  A boolean flag that indicates if this argument was a required
  argument. If marked as required and not provided, check() will fail.
  
  =item strict_type
  
  This does a C<ref()> check on the argument provided. The C<ref> of the
  argument must be the same as the C<ref> of the default value for this
  check to pass.
  
  This is very useful if you insist on taking an array reference as
  argument for example.
  
  =item defined
  
  If this template key is true, enforces that if this key is provided by
  user input, its value is C<defined>. This just means that the user is
  not allowed to pass C<undef> as a value for this key and is equivalent
  to:
      allow => sub { defined $_[0] && OTHER TESTS }
  
  =item no_override
  
  This allows you to specify C<constants> in your template. ie, they
  keys that are not allowed to be altered by the user. It pretty much
  allows you to keep all your C<configurable> data in one place; the
  C<Params::Check> template.
  
  =item store
  
  This allows you to pass a reference to a scalar, in which the data
  will be stored:
  
      my $x;
      my $args = check(foo => { default => 1, store => \$x }, $input);
  
  This is basically shorthand for saying:
  
      my $args = check( { foo => { default => 1 }, $input );
      my $x    = $args->{foo};
  
  You can alter the global variable $Params::Check::NO_DUPLICATES to
  control whether the C<store>'d key will still be present in your
  result set. See the L<Global Variables> section below.
  
  =item allow
  
  A set of criteria used to validate a particular piece of data if it
  has to adhere to particular rules.
  
  See the C<allow()> function for details.
  
  =back
  
  =head1 Functions
  
  =head2 check( \%tmpl, \%args, [$verbose] );
  
  This function is not exported by default, so you'll have to ask for it
  via:
  
      use Params::Check qw[check];
  
  or use its fully qualified name instead.
  
  C<check> takes a list of arguments, as follows:
  
  =over 4
  
  =item Template
  
  This is a hashreference which contains a template as explained in the
  C<SYNOPSIS> and C<Template> section.
  
  =item Arguments
  
  This is a reference to a hash of named arguments which need checking.
  
  =item Verbose
  
  A boolean to indicate whether C<check> should be verbose and warn
  about what went wrong in a check or not.
  
  You can enable this program wide by setting the package variable
  C<$Params::Check::VERBOSE> to a true value. For details, see the
  section on C<Global Variables> below.
  
  =back
  
  C<check> will return when it fails, or a hashref with lowercase
  keys of parsed arguments when it succeeds.
  
  So a typical call to check would look like this:
  
      my $parsed = check( \%template, \%arguments, $VERBOSE )
                      or warn q[Arguments could not be parsed!];
  
  A lot of the behaviour of C<check()> can be altered by setting
  package variables. See the section on C<Global Variables> for details
  on this.
  
  =cut
  
  sub check {
      my ($utmpl, $href, $verbose) = @_;
  
      ### clear the current error string ###
      _clear_error();
  
      ### did we get the arguments we need? ###
      if ( !$utmpl or !$href ) {
        _store_error(loc('check() expects two arguments'));
        return unless $WARNINGS_FATAL;
        croak(__PACKAGE__->last_error);
      }
  
      ### sensible defaults ###
      $verbose ||= $VERBOSE || 0;
  
      ### XXX what type of template is it? ###
      ### { key => { } } ?
      #if (ref $args eq 'HASH') {
      #    1;
      #}
  
      ### clean up the template ###
      my $args;
  
      ### don't even bother to loop, if there's nothing to clean up ###
      if( $PRESERVE_CASE and !$STRIP_LEADING_DASHES ) {
          $args = $href;
      } else {
          ### keys are not aliased ###
          for my $key (keys %$href) {
              my $org = $key;
              $key = lc $key unless $PRESERVE_CASE;
              $key =~ s/^-// if $STRIP_LEADING_DASHES;
              $args->{$key} = $href->{$org};
          }
      }
  
      my %defs;
  
      ### which template entries have a 'store' member
      my @want_store;
  
      ### sanity check + defaults + required keys set? ###
      my $fail;
      for my $key (keys %$utmpl) {
          my $tmpl = $utmpl->{$key};
  
          ### check if required keys are provided
          ### keys are now lower cased, unless preserve case was enabled
          ### at which point, the utmpl keys must match, but that's the users
          ### problem.
          if( $tmpl->{'required'} and not exists $args->{$key} ) {
              _store_error(
                  loc(q|Required option '%1' is not provided for %2 by %3|,
                      $key, _who_was_it(), _who_was_it(1)), $verbose );
  
              ### mark the error ###
              $fail++;
              next;
          }
  
          ### next, set the default, make sure the key exists in %defs ###
          $defs{$key} = $tmpl->{'default'}
                          if exists $tmpl->{'default'};
  
          if( $SANITY_CHECK_TEMPLATE ) {
              ### last, check if they provided any weird template keys
              ### -- do this last so we don't always execute this code.
              ### just a small optimization.
              map {   _store_error(
                          loc(q|Template type '%1' not supported [at key '%2']|,
                          $_, $key), 1, 0 );
              } grep {
                  not $known_keys{$_}
              } keys %$tmpl;
  
              ### make sure you passed a ref, otherwise, complain about it!
              if ( exists $tmpl->{'store'} ) {
                  _store_error( loc(
                      q|Store variable for '%1' is not a reference!|, $key
                  ), 1, 0 ) unless ref $tmpl->{'store'};
              }
          }
  
          push @want_store, $key if $tmpl->{'store'};
      }
  
      ### errors found ###
      return if $fail;
  
      ### flag to see if anything went wrong ###
      my $wrong;
  
      ### flag to see if we warned for anything, needed for warnings_fatal
      my $warned;
  
      for my $key (keys %$args) {
          my $arg = $args->{$key};
  
          ### you gave us this key, but it's not in the template ###
          unless( $utmpl->{$key} ) {
  
              ### but we'll allow it anyway ###
              if( $ALLOW_UNKNOWN ) {
                  $defs{$key} = $arg;
  
              ### warn about the error ###
              } else {
                  _store_error(
                      loc("Key '%1' is not a valid key for %2 provided by %3",
                          $key, _who_was_it(), _who_was_it(1)), $verbose);
                  $warned ||= 1;
              }
              next;
          }
  
          ### copy of this keys template instructions, to save derefs ###
          my %tmpl = %{$utmpl->{$key}};
  
          ### check if you're even allowed to override this key ###
          if( $tmpl{'no_override'} ) {
              _store_error(
                  loc(q[You are not allowed to override key '%1'].
                      q[for %2 from %3], $key, _who_was_it(), _who_was_it(1)),
                  $verbose
              );
              $warned ||= 1;
              next;
          }
  
          ### check if you were supposed to provide defined() values ###
          if( ($tmpl{'defined'} || $ONLY_ALLOW_DEFINED) and not defined $arg ) {
              _store_error(loc(q|Key '%1' must be defined when passed|, $key),
                  $verbose );
              $wrong ||= 1;
              next;
          }
  
          ### check if they should be of a strict type, and if it is ###
          if( ($tmpl{'strict_type'} || $STRICT_TYPE) and
              (ref $arg ne ref $tmpl{'default'})
          ) {
              _store_error(loc(q|Key '%1' needs to be of type '%2'|,
                          $key, ref $tmpl{'default'} || 'SCALAR'), $verbose );
              $wrong ||= 1;
              next;
          }
  
          ### check if we have an allow handler, to validate against ###
          ### allow() will report its own errors ###
          if( exists $tmpl{'allow'} and not do {
                  local $_ERROR_STRING;
                  allow( $arg, $tmpl{'allow'} )
              }
          ) {
              ### stringify the value in the error report -- we don't want dumps
              ### of objects, but we do want to see *roughly* what we passed
              _store_error(loc(q|Key '%1' (%2) is of invalid type for '%3' |.
                               q|provided by %4|,
                              $key, "$arg", _who_was_it(),
                              _who_was_it(1)), $verbose);
              $wrong ||= 1;
              next;
          }
  
          ### we got here, then all must be OK ###
          $defs{$key} = $arg;
  
      }
  
      ### croak with the collected errors if there were errors and
      ### we have the fatal flag toggled.
      croak(__PACKAGE__->last_error) if ($wrong || $warned) && $WARNINGS_FATAL;
  
      ### done with our loop... if $wrong is set, something went wrong
      ### and the user is already informed, just return...
      return if $wrong;
  
      ### check if we need to store any of the keys ###
      ### can't do it before, because something may go wrong later,
      ### leaving the user with a few set variables
      for my $key (@want_store) {
          next unless exists $defs{$key};
          my $ref = $utmpl->{$key}{'store'};
          $$ref = $NO_DUPLICATES ? delete $defs{$key} : $defs{$key};
      }
  
      return \%defs;
  }
  
  =head2 allow( $test_me, \@criteria );
  
  The function that handles the C<allow> key in the template is also
  available for independent use.
  
  The function takes as first argument a key to test against, and
  as second argument any form of criteria that are also allowed by
  the C<allow> key in the template.
  
  You can use the following types of values for allow:
  
  =over 4
  
  =item string
  
  The provided argument MUST be equal to the string for the validation
  to pass.
  
  =item regexp
  
  The provided argument MUST match the regular expression for the
  validation to pass.
  
  =item subroutine
  
  The provided subroutine MUST return true in order for the validation
  to pass and the argument accepted.
  
  (This is particularly useful for more complicated data).
  
  =item array ref
  
  The provided argument MUST equal one of the elements of the array
  ref for the validation to pass. An array ref can hold all the above
  values.
  
  =back
  
  It returns true if the key matched the criteria, or false otherwise.
  
  =cut
  
  sub allow {
      ### use $_[0] and $_[1] since this is hot code... ###
      #my ($val, $ref) = @_;
  
      ### it's a regexp ###
      if( ref $_[1] eq 'Regexp' ) {
          local $^W;  # silence warnings if $val is undef #
          return if $_[0] !~ /$_[1]/;
  
      ### it's a sub ###
      } elsif ( ref $_[1] eq 'CODE' ) {
          return unless $_[1]->( $_[0] );
  
      ### it's an array ###
      } elsif ( ref $_[1] eq 'ARRAY' ) {
  
          ### loop over the elements, see if one of them says the
          ### value is OK
          ### also, short-circuit when possible
          for ( @{$_[1]} ) {
              return 1 if allow( $_[0], $_ );
          }
  
          return;
  
      ### fall back to a simple, but safe 'eq' ###
      } else {
          return unless _safe_eq( $_[0], $_[1] );
      }
  
      ### we got here, no failures ###
      return 1;
  }
  
  ### helper functions ###
  
  sub _safe_eq {
      ### only do a straight 'eq' if they're both defined ###
      return defined($_[0]) && defined($_[1])
                  ? $_[0] eq $_[1]
                  : defined($_[0]) eq defined($_[1]);
  }
  
  sub _who_was_it {
      my $level = $_[0] || 0;
  
      return (caller(2 + $CALLER_DEPTH + $level))[3] || 'ANON'
  }
  
  =head2 last_error()
  
  Returns a string containing all warnings and errors reported during
  the last time C<check> was called.
  
  This is useful if you want to report then some other way than
  C<carp>'ing when the verbose flag is on.
  
  It is exported upon request.
  
  =cut
  
  {   $_ERROR_STRING = '';
  
      sub _store_error {
          my($err, $verbose, $offset) = @_[0..2];
          $verbose ||= 0;
          $offset  ||= 0;
          my $level   = 1 + $offset;
  
          local $Carp::CarpLevel = $level;
  
          carp $err if $verbose;
  
          $_ERROR_STRING .= $err . "\n";
      }
  
      sub _clear_error {
          $_ERROR_STRING = '';
      }
  
      sub last_error { $_ERROR_STRING }
  }
  
  1;
  
  =head1 Global Variables
  
  The behaviour of Params::Check can be altered by changing the
  following global variables:
  
  =head2 $Params::Check::VERBOSE
  
  This controls whether Params::Check will issue warnings and
  explanations as to why certain things may have failed.
  If you set it to 0, Params::Check will not output any warnings.
  
  The default is 1 when L<warnings> are enabled, 0 otherwise;
  
  =head2 $Params::Check::STRICT_TYPE
  
  This works like the C<strict_type> option you can pass to C<check>,
  which will turn on C<strict_type> globally for all calls to C<check>.
  
  The default is 0;
  
  =head2 $Params::Check::ALLOW_UNKNOWN
  
  If you set this flag, unknown options will still be present in the
  return value, rather than filtered out. This is useful if your
  subroutine is only interested in a few arguments, and wants to pass
  the rest on blindly to perhaps another subroutine.
  
  The default is 0;
  
  =head2 $Params::Check::STRIP_LEADING_DASHES
  
  If you set this flag, all keys passed in the following manner:
  
      function( -key => 'val' );
  
  will have their leading dashes stripped.
  
  =head2 $Params::Check::NO_DUPLICATES
  
  If set to true, all keys in the template that are marked as to be
  stored in a scalar, will also be removed from the result set.
  
  Default is false, meaning that when you use C<store> as a template
  key, C<check> will put it both in the scalar you supplied, as well as
  in the hashref it returns.
  
  =head2 $Params::Check::PRESERVE_CASE
  
  If set to true, L<Params::Check> will no longer convert all keys from
  the user input to lowercase, but instead expect them to be in the
  case the template provided. This is useful when you want to use
  similar keys with different casing in your templates.
  
  Understand that this removes the case-insensitivity feature of this
  module.
  
  Default is 0;
  
  =head2 $Params::Check::ONLY_ALLOW_DEFINED
  
  If set to true, L<Params::Check> will require all values passed to be
  C<defined>. If you wish to enable this on a 'per key' basis, use the
  template option C<defined> instead.
  
  Default is 0;
  
  =head2 $Params::Check::SANITY_CHECK_TEMPLATE
  
  If set to true, L<Params::Check> will sanity check templates, validating
  for errors and unknown keys. Although very useful for debugging, this
  can be somewhat slow in hot-code and large loops.
  
  To disable this check, set this variable to C<false>.
  
  Default is 1;
  
  =head2 $Params::Check::WARNINGS_FATAL
  
  If set to true, L<Params::Check> will C<croak> when an error during
  template validation occurs, rather than return C<false>.
  
  Default is 0;
  
  =head2 $Params::Check::CALLER_DEPTH
  
  This global modifies the argument given to C<caller()> by
  C<Params::Check::check()> and is useful if you have a custom wrapper
  function around C<Params::Check::check()>. The value must be an
  integer, indicating the number of wrapper functions inserted between
  the real function call and C<Params::Check::check()>.
  
  Example wrapper function, using a custom stacktrace:
  
      sub check {
          my ($template, $args_in) = @_;
  
          local $Params::Check::WARNINGS_FATAL = 1;
          local $Params::Check::CALLER_DEPTH = $Params::Check::CALLER_DEPTH + 1;
          my $args_out = Params::Check::check($template, $args_in);
  
          my_stacktrace(Params::Check::last_error) unless $args_out;
  
          return $args_out;
      }
  
  Default is 0;
  
  =head1 Acknowledgements
  
  Thanks to Richard Soderberg for his performance improvements.
  
  =head1 BUG REPORTS
  
  Please report bugs or other issues to E<lt>bug-params-check@rt.cpan.orgE<gt>.
  
  =head1 AUTHOR
  
  This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
  
  =head1 COPYRIGHT
  
  This library is free software; you may redistribute and/or modify it
  under the same terms as Perl itself.
  
  
  =cut
  
  # Local variables:
  # c-indentation-style: bsd
  # c-basic-offset: 4
  # indent-tabs-mode: nil
  # End:
  # vim: expandtab shiftwidth=4:
PARAMS_CHECK

$fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
  package Parse::CPAN::Meta;
  
  use strict;
  use Carp 'croak';
  
  # UTF Support?
  sub HAVE_UTF8 () { $] >= 5.007003 }
  sub IO_LAYER () { $] >= 5.008001 ? ":utf8" : "" }  
  
  BEGIN {
  	if ( HAVE_UTF8 ) {
  		# The string eval helps hide this from Test::MinimumVersion
  		eval "require utf8;";
  		die "Failed to load UTF-8 support" if $@;
  	}
  
  	# Class structure
  	require 5.004;
  	require Exporter;
  	$Parse::CPAN::Meta::VERSION   = '1.4401';
  	@Parse::CPAN::Meta::ISA       = qw{ Exporter      };
  	@Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
  }
  
  sub load_file {
    my ($class, $filename) = @_;
  
    if ($filename =~ /\.ya?ml$/) {
      return $class->load_yaml_string(_slurp($filename));
    }
  
    if ($filename =~ /\.json$/) {
      return $class->load_json_string(_slurp($filename));
    }
  
    croak("file type cannot be determined by filename");
  }
  
  sub load_yaml_string {
    my ($class, $string) = @_;
    my $backend = $class->yaml_backend();
    my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
    if ( $@ ) { 
      croak $backend->can('errstr') ? $backend->errstr : $@
    }
    return $data || {}; # in case document was valid but empty
  }
  
  sub load_json_string {
    my ($class, $string) = @_;
    return $class->json_backend()->new->decode($string);
  }
  
  sub yaml_backend {
    local $Module::Load::Conditional::CHECK_INC_HASH = 1;
    if (! defined $ENV{PERL_YAML_BACKEND} ) {
      _can_load( 'CPAN::Meta::YAML', 0.002 )
        or croak "CPAN::Meta::YAML 0.002 is not available\n";
      return "CPAN::Meta::YAML";
    }
    else {
      my $backend = $ENV{PERL_YAML_BACKEND};
      _can_load( $backend )
        or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
      $backend->can("Load")
        or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
      return $backend;
    }
  }
  
  sub json_backend {
    local $Module::Load::Conditional::CHECK_INC_HASH = 1;
    if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
      _can_load( 'JSON::PP' => 2.27103 )
        or croak "JSON::PP 2.27103 is not available\n";
      return 'JSON::PP';
    }
    else {
      _can_load( 'JSON' => 2.5 )
        or croak  "JSON 2.5 is required for " .
                  "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
      return "JSON";
    }
  }
  
  sub _slurp {
    open my $fh, "<" . IO_LAYER, "$_[0]"
      or die "can't open $_[0] for reading: $!";
    return do { local $/; <$fh> };
  }
    
  sub _can_load {
    my ($module, $version) = @_;
    (my $file = $module) =~ s{::}{/}g;
    $file .= ".pm";
    return 1 if $INC{$file};
    return 0 if exists $INC{$file}; # prior load failed
    eval { require $file; 1 }
      or return 0;
    if ( defined $version ) {
      eval { $module->VERSION($version); 1 }
        or return 0;
    }
    return 1;
  }
  
  # Kept for backwards compatibility only
  # Create an object from a file
  sub LoadFile ($) {
    require CPAN::Meta::YAML;
    return CPAN::Meta::YAML::LoadFile(shift)
      or die CPAN::Meta::YAML->errstr;
  }
  
  # Parse a document from a string.
  sub Load ($) {
    require CPAN::Meta::YAML;
    return CPAN::Meta::YAML::Load(shift)
      or die CPAN::Meta::YAML->errstr;
  }
  
  1;
  
  __END__
  
  =pod
  
  =head1 NAME
  
  Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
  
  =head1 SYNOPSIS
  
      #############################################
      # In your file
      
      ---
      name: My-Distribution
      version: 1.23
      resources:
        homepage: "http://example.com/dist/My-Distribution"
      
      
      #############################################
      # In your program
      
      use Parse::CPAN::Meta;
      
      my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
      
      # Reading properties
      my $name     = $distmeta->{name};
      my $version  = $distmeta->{version};
      my $homepage = $distmeta->{resources}{homepage};
  
  =head1 DESCRIPTION
  
  B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
  L<JSON::PP> and/or L<CPAN::Meta::YAML>.
  
  B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
  and C<load_yaml_string>.  These will read and deserialize CPAN metafiles, and
  are described below in detail.
  
  B<Parse::CPAN::Meta> provides a legacy API of only two functions,
  based on the YAML functions of the same name. Wherever possible,
  identical calling semantics are used.  These may only be used with YAML sources.
  
  All error reporting is done with exceptions (die'ing).
  
  Note that META files are expected to be in UTF-8 encoding, only.  When
  converted string data, it must first be decoded from UTF-8.
  
  =head1 METHODS
  
  =head2 load_file
  
    my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
  
    my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
  
  This method will read the named file and deserialize it to a data structure,
  determining whether it should be JSON or YAML based on the filename.  On
  Perl 5.8.1 or later, the file will be read using the ":utf8" IO layer.
  
  =head2 load_yaml_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
  
  This method deserializes the given string of YAML and returns the first
  document in it.  (CPAN metadata files should always have only one document.)
  If the source was UTF-8 encoded, the string must be decoded before calling
  C<load_yaml_string>.
  
  =head2 load_json_string
  
    my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
  
  This method deserializes the given string of JSON and the result.  
  If the source was UTF-8 encoded, the string must be decoded before calling
  C<load_json_string>.
  
  =head2 yaml_backend
  
    my $backend = Parse::CPAN::Meta->yaml_backend;
  
  Returns the module name of the YAML serializer. See L</ENVIRONMENT>
  for details.
  
  =head2 json_backend
  
    my $backend = Parse::CPAN::Meta->json_backend;
  
  Returns the module name of the JSON serializer.  This will either
  be L<JSON::PP> or L<JSON>.  Even if C<PERL_JSON_BACKEND> is set,
  this will return L<JSON> as further delegation is handled by
  the L<JSON> module.  See L</ENVIRONMENT> for details.
  
  =head1 FUNCTIONS
  
  For maintenance clarity, no functions are exported.  These functions are
  available for backwards compatibility only and are best avoided in favor of
  C<load_file>.
  
  =head2 Load
  
    my @yaml = Parse::CPAN::Meta::Load( $string );
  
  Parses a string containing a valid YAML stream into a list of Perl data
  structures.
  
  =head2 LoadFile
  
    my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
  
  Reads the YAML stream from a file instead of a string.
  
  =head1 ENVIRONMENT
  
  =head2 PERL_JSON_BACKEND
  
  By default, L<JSON::PP> will be used for deserializing JSON data. If the
  C<PERL_JSON_BACKEND> environment variable exists, is true and is not
  "JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
  used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
  old, an exception will be thrown.
  
  =head2 PERL_YAML_BACKEND
  
  By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
  the C<PERL_YAML_BACKEND> environment variable is defined, then it is intepreted
  as a module to use for deserialization.  The given module must be installed,
  must load correctly and must implement the C<Load()> function or an exception
  will be thrown.
  
  =head1 SUPPORT
  
  Bugs should be reported via the CPAN bug tracker at
  
  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
  
  =head1 AUTHOR
  
  Adam Kennedy E<lt>adamk@cpan.orgE<gt>
  
  =head1 COPYRIGHT
  
  Copyright 2006 - 2010 Adam Kennedy.
  
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
  
  The full text of the license can be found in the
  LICENSE file included with this module.
  
  =cut
PARSE_CPAN_META

$fatpacked{"Perl/Build.pm"} = <<'PERL_BUILD';
  package Perl::Build;
  use strict;
  use warnings;
  use utf8;
  
  use 5.008002;
  our $VERSION = '0.09';
  
  use Carp ();
  use File::Basename;
  use File::Spec::Functions qw(catfile catdir rel2abs);
  use CPAN::Perl::Releases;
  use File::pushd qw(pushd);
  use File::Temp;
  use HTTP::Tiny;
  use Devel::PatchPerl;
  
  our $CPAN_MIRROR = $ENV{PERL_BUILD_CPAN_MIRROR} || 'http://search.cpan.org/CPAN';
  
  sub available_perls {
      my ( $class, $dist ) = @_;
  
      my $url = "http://www.cpan.org/src/README.html";
      my $html = http_get( $url );
  
      unless($html) {
          die "\nERROR: Unable to retrieve the list of perls.\n\n";
      }
  
      my @available_versions;
  
      for ( split "\n", $html ) {
          push @available_versions, $1
            if m|<td><a href="http://www.cpan.org/src/.+?">(.+?)</a></td>|;
      }
      s/\.tar\.gz// for @available_versions;
  
      return @available_versions;
  }
  
  # @return extracted source directory
  sub extract_tarball {
      my ($class, $dist_tarball, $destdir) = @_;
  
      # Was broken on Solaris, where GNU tar is probably
      # installed as 'gtar' - RT #61042
      my $tarx =
          ($^O eq 'solaris' ? 'gtar ' : 'tar ') .
          ( $dist_tarball =~ m/bz2$/ ? 'xjf' : 'xzf' );
      my $extract_command = "cd @{[ $destdir ]}; $tarx @{[ File::Spec->rel2abs($dist_tarball) ]}";
      system($extract_command) == 0
          or die "Failed to extract $dist_tarball";
      $dist_tarball =~ s{(?:.*/)?([^/]+)\.tar\.(?:gz|bz2)$}{$1};
      return "$destdir/$dist_tarball"; # Note that this is incorrect for blead
  }
  
  sub perl_release {
      my ($class, $version) = @_;
  
      # TODO: switch to metacpan API?
      my $tarballs = CPAN::Perl::Releases::perl_tarballs($version);
  
      my $x = (values %$tarballs)[0];
  
      if ($x) {
          my $dist_tarball = (split("/", $x))[-1];
          my $dist_tarball_url = $CPAN_MIRROR . "/authors/id/$x";
          return ($dist_tarball, $dist_tarball_url);
      }
  
      my $html = http_get("http://search.cpan.org/dist/perl-${version}");
  
      unless ($html) {
          die "ERROR: Failed to download perl-${version} tarball.";
      }
  
      my ($dist_path, $dist_tarball) =
          $html =~ m[<a href="(/CPAN/authors/id/.+/(perl-${version}.tar.(gz|bz2)))">Download</a>];
      die "ERROR: Cannot find the tarball for perl-$version\n"
          if !$dist_path and !$dist_tarball;
      my $dist_tarball_url = "http://search.cpan.org${dist_path}";
      return ($dist_tarball, $dist_tarball_url);
  }
  
  sub http_get {
      my ($url) = @_;
  
      my $http = HTTP::Tiny->new();
      my $response = $http->get($url);
      if ($response->{success}) {
          return $response->{content};
      } else {
          return "Cannot get content from $url: $response->{status} $response->{reason}";
      }
  }
  
  sub http_mirror {
      my ($url, $path) = @_;
  
      my $http = HTTP::Tiny->new();
      my $response = $http->mirror($url, $path);
      if ($response->{success}) {
          print "Downloaded $url to $path.\n";
      } else {
          die "Cannot get file from $url: $response->{status} $response->{reason}";
      }
  }
  
  sub install_from_cpan {
      my ($class, $version, %args) = @_;
  
      $args{patchperl} && Carp::croak "The patchperl argument was deprected.";
  
      my $tarball_dir = $args{tarball_dir}
          || File::Temp::tempdir( CLEANUP => 1 );
      my $build_dir = $args{build_dir}
          || File::Temp::tempdir( CLEANUP => 1 );
      my $dst_path = $args{dst_path}
          or die "Missing mandatory parameter: dst_path";
      my $configure_options = $args{configure_options}
          || ['-de'];
  
      # download tar ball
      my ($dist_tarball, $dist_tarball_url) = Perl::Build->perl_release($version);
      my $dist_tarball_path = catfile($tarball_dir, $dist_tarball);
      if (-f $dist_tarball_path) {
          print "Use the previously fetched ${dist_tarball}\n";
      }
      else {
          print "Fetching $version as $dist_tarball_path ($dist_tarball_url)\n";
          http_mirror( $dist_tarball_url, $dist_tarball_path );
      }
  
      # and extract tar ball.
      my $dist_extracted_path = Perl::Build->extract_tarball($dist_tarball_path, $build_dir);
      Perl::Build->install(
          src_path          => $dist_extracted_path,
          dst_path          => $dst_path,
          configure_options => $configure_options,
          test              => $args{test},
      );
  }
  
  sub install_from_tarball {
      my ($class, $dist_tarball_path, %args) = @_;
      $args{patchperl} && Carp::croak "The patchperl argument was deprected.";
  
      my $build_dir = $args{build_dir}
          || File::Temp::tempdir( CLEANUP => 1 );
      my $dst_path = $args{dst_path}
          or die "Missing mandatory parameter: dst_path";
      my $configure_options = $args{configure_options}
          || ['-de'];
  
      my $dist_extracted_path = Perl::Build->extract_tarball($dist_tarball_path, $build_dir);
      Perl::Build->install(
          src_path          => $dist_extracted_path,
          dst_path          => $dst_path,
          configure_options => $configure_options,
          test              => $args{test},
      );
  }
  
  sub install {
      my ($class, %args) = @_;
      $args{patchperl} && Carp::croak "The patchperl argument was deprected.";
  
      my $src_path = $args{src_path}
          or die "Missing mandatory parameter: src_path";
      my $dst_path = $args{dst_path}
          or die "Missing mandatory parameter: dst_path";
      my $configure_options = $args{configure_options}
          or die "Missing mandatory parameter: configure_options";
  
      unshift @$configure_options, qq(-Dprefix=$dst_path);
  
      # Perl5 installs public executable scripts(like `prove`) to /usr/local/share/
      # if it exists.
      #
      # This -A'eval:scriptdir=$prefix/bin' option avoid this feature.
      unless (grep { /eval:scriptdir=/} @$configure_options) {
          push @$configure_options, "-A'eval:scriptdir=${dst_path}/bin'";
      }
  
      # clean up environment
      delete $ENV{$_} for qw(PERL5LIB PERL5OPT);
  
      {
          my $dir = pushd($src_path);
  
          # clean up
          $class->do_system("rm -f config.sh Policy.sh");
  
          # apply patches
          Devel::PatchPerl->patch_source();
  
          # configure
          $class->do_system(['sh', 'Configure', @$configure_options]);
          # patch for older perls
          # XXX is this needed? patchperl do this?
          # if (Perl::Build->perl_version_to_integer($dist_version) < Perl::Build->perl_version_to_integer( '5.8.9' )) {
          #     $class->do_system("$^X -i -nle 'print unless /command-line/' makefile x2p/makefile");
          # }
  
          # build
          $class->do_system('make');
          if ($args{test}) {
              $class->do_system('make test');
          }
          $class->do_system('make install');
      }
  }
  
  sub do_system {
      my ($class, $cmd) = @_;
  
      if (ref $cmd eq 'ARRAY') {
          $class->info(join(' ', @$cmd));
          system(@$cmd) == 0
              or die "Installation failure: @$cmd";
      } else {
          $class->info($cmd);
          system($cmd) == 0
              or die "Installation failure: $cmd";
      }
  }
  
  sub symlink_devel_executables {
      my ($class, $bin_dir) = @_;
  
      for my $executable (glob("$bin_dir/*")) {
          my ($name, $version) = $executable =~ m/bin\/(.+?)(5\.\d.*)?$/;
          if ($version) {
              my $cmd = "ln -fs $executable $bin_dir/$name";
              $class->info($cmd);
              system($cmd);
          }
      }
  }
  
  sub info {
      my ($class, @msg) = @_;
      print @msg, "\n";
  }
  
  1;
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  Perl::Build - perl builder
  
  =head1 SYNOPSIS
  
  =head1 CLI interface without dependencies
  
      # perl-build command is FatPacker ready
      % curl https://raw.github.com/tokuhirom/Perl-Build/master/perl-build | perl - 5.16.2 /opt/perl-5.16/
  
  =head1 CLI interface
  
      % cpanm Perl::Build
      % perl-build 5.16.2 /opt/perl-5.16/
  
  =head2 Programmable interface
  
      # install perl from CPAN
      Perl::Build->install_from_cpan(
          '5.16.2' => (
              dst_path          => '/path/to/perl-5.16.2/',
              configure_options => ['-des'],
          )
      );
  
      # install perl from tar ball
      Perl::Build->install_from_cpan(
          'path/to/perl-5.16.2.tar.gz' => (
              dst_path          => '/path/to/perl-5.16.2/',
              configure_options => ['-des'],
          )
      );
  
  =head1 DESCRIPTION
  
  This is yet another perl builder module.
  
  B<THIS IS A DEVELOPMENT RELEASE. API MAY CHANGE WITHOUT NOTICE>.
  
  =head1 METHODS
  
  =over 4
  
  =item Perl::Build->install_from_cpan($version, %args)
  
  Install $version perl from CPAN. This method fetches tar ball from CPAN, build, and install it.
  
  You can pass following options in %args.
  
  =over 4
  
  =item dst_path
  
  Destination directory to install perl.
  
  =item configure_options : ArrayRef(Optional)
  
  Command line arguments for ./Configure.
  
  (Default: C<< ['-de'] >>)
  
  =item tarball_dir(Optional)
  
  Temporary directory to put tar ball.
  
  =item build_dir(Optional)
  
  Temporary directory to build binary.
  
  =back
  
  =item Perl::Build->install_from_tarball($dist_tarball_path, %args)
  
  Install perl from tar ball. This method extracts tar ball, build, and install.
  
  You can pass following options in %args.
  
  =over 4
  
  =item dst_path(Required)
  
  Destination directory to install perl.
  
  =item configure_options : ArrayRef(Optional)
  
  Command line arguments for ./Configure.
  
  (Default: C<< ['-de'] >>)
  
  =item build_dir(Optional)
  
  Temporary directory to build binary.
  
  =back
  
  =item Perl::Build->install(%args)
  
  Build and install Perl5 from extracted source directory.
  
  =over 4
  
  =item src_path(Required)
  
  Source code directory to build.  That contains extracted Perl5 source code.
  
  =item dst_path(Required)
  
  Destination directory to install perl.
  
  =item configure_options : ArrayRef(Optional)
  
  Command line arguments for ./Configure.
  
  (Default: C<< ['-de'] >>)
  
  =item test: Bool(Optional)
  
  If you set this value as true, Perl::Build runs C<< make test >> after building.
  
  (Default: 0)
  
  =back
  
  =item Perl::Build->symlink_devel_executables($bin_dir:Str)
  
  Perl5 binary generated with C< -Dusedevel >, is "perl-5.12.2" form. This method symlinks "perl-5.12.2" to "perl".
  
  =back
  
  =head1 FAQ
  
  =over 4
  
  =item How can I use patchperl plugins?
  
  If you want to use patchperl plugins, please google "PERL5_PATCHPERL_PLUGIN".
  
  =back
  
  =head1 THANKS TO
  
  Most of the code was taken from L<App::perlbrew>.
  
  TYPESTER - suggests C<< --patches >> option
  
  Thanks
  
  =head1 AUTHOR
  
  Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>
  
  
  =head1 LICENSE
  
  This software takes most of the code from L<App::perlbrew>.
  
  Perl::Build uses same license with perlbrew.
  
PERL_BUILD

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

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

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

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

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

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

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

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

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

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

$fatpacked{"darwin-2level/IO.pm"} = <<'DARWIN-2LEVEL_IO';
  #
  
  package IO;
  
  use XSLoader ();
  use Carp;
  use strict;
  use warnings;
  
  our $VERSION = "1.25";
  XSLoader::load 'IO', $VERSION;
  
  sub import {
      shift;
  
      warnings::warnif('deprecated', qq{Parameterless "use IO" deprecated})
          if @_ == 0 ;
      
      my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir);
  
      eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l)
  	or croak $@;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  IO - load various IO modules
  
  =head1 SYNOPSIS
  
      use IO qw(Handle File);  # loads IO modules, here IO::Handle, IO::File
      use IO;                  # DEPRECATED
  
  =head1 DESCRIPTION
  
  C<IO> provides a simple mechanism to load several of the IO modules
  in one go.  The IO modules belonging to the core are:
  
        IO::Handle
        IO::Seekable
        IO::File
        IO::Pipe
        IO::Socket
        IO::Dir
        IO::Select
        IO::Poll
  
  Some other IO modules don't belong to the perl core but can be loaded
  as well if they have been installed from CPAN.  You can discover which
  ones exist by searching for "^IO::" on http://search.cpan.org.
  
  For more information on any of these modules, please see its respective
  documentation.
  
  =head1 DEPRECATED
  
      use IO;                # loads all the modules listed below
  
  The loaded modules are IO::Handle, IO::Seekable, IO::File, IO::Pipe,
  IO::Socket, IO::Dir.  You should instead explicitly import the IO
  modules you want.
  
  =cut
  
DARWIN-2LEVEL_IO

$fatpacked{"darwin-2level/IO/Dir.pm"} = <<'DARWIN-2LEVEL_IO_DIR';
  # IO::Dir.pm
  #
  # Copyright (c) 1997-8 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 IO::Dir;
  
  use 5.006;
  
  use strict;
  use Carp;
  use Symbol;
  use Exporter;
  use IO::File;
  our(@ISA, $VERSION, @EXPORT_OK);
  use Tie::Hash;
  use File::stat;
  use File::Spec;
  
  @ISA = qw(Tie::Hash Exporter);
  $VERSION = "1.07";
  $VERSION = eval $VERSION;
  @EXPORT_OK = qw(DIR_UNLINK);
  
  sub DIR_UNLINK () { 1 }
  
  sub new {
      @_ >= 1 && @_ <= 2 or croak 'usage: new IO::Dir [DIRNAME]';
      my $class = shift;
      my $dh = gensym;
      if (@_) {
  	IO::Dir::open($dh, $_[0])
  	    or return undef;
      }
      bless $dh, $class;
  }
  
  sub DESTROY {
      my ($dh) = @_;
      local($., $@, $!, $^E, $?);
      no warnings 'io';
      closedir($dh);
  }
  
  sub open {
      @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
      my ($dh, $dirname) = @_;
      return undef
  	unless opendir($dh, $dirname);
      # a dir name should always have a ":" in it; assume dirname is
      # in current directory
      $dirname = ':' .  $dirname if ( ($^O eq 'MacOS') && ($dirname !~ /:/) );
      ${*$dh}{io_dir_path} = $dirname;
      1;
  }
  
  sub close {
      @_ == 1 or croak 'usage: $dh->close()';
      my ($dh) = @_;
      closedir($dh);
  }
  
  sub read {
      @_ == 1 or croak 'usage: $dh->read()';
      my ($dh) = @_;
      readdir($dh);
  }
  
  sub seek {
      @_ == 2 or croak 'usage: $dh->seek(POS)';
      my ($dh,$pos) = @_;
      seekdir($dh,$pos);
  }
  
  sub tell {
      @_ == 1 or croak 'usage: $dh->tell()';
      my ($dh) = @_;
      telldir($dh);
  }
  
  sub rewind {
      @_ == 1 or croak 'usage: $dh->rewind()';
      my ($dh) = @_;
      rewinddir($dh);
  }
  
  sub TIEHASH {
      my($class,$dir,$options) = @_;
  
      my $dh = $class->new($dir)
  	or return undef;
  
      $options ||= 0;
  
      ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK;
      $dh;
  }
  
  sub FIRSTKEY {
      my($dh) = @_;
      $dh->rewind;
      scalar $dh->read;
  }
  
  sub NEXTKEY {
      my($dh) = @_;
      scalar $dh->read;
  }
  
  sub EXISTS {
      my($dh,$key) = @_;
      -e File::Spec->catfile(${*$dh}{io_dir_path}, $key);
  }
  
  sub FETCH {
      my($dh,$key) = @_;
      &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key));
  }
  
  sub STORE {
      my($dh,$key,$data) = @_;
      my($atime,$mtime) = ref($data) ? @$data : ($data,$data);
      my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
      unless(-e $file) {
  	my $io = IO::File->new($file,O_CREAT | O_RDWR);
  	$io->close if $io;
      }
      utime($atime,$mtime, $file);
  }
  
  sub DELETE {
      my($dh,$key) = @_;
  
      # Only unlink if unlink-ing is enabled
      return 0
  	unless ${*$dh}{io_dir_unlink};
  
      my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
  
      -d $file
  	? rmdir($file)
  	: unlink($file);
  }
  
  1;
  
  __END__
  
  =head1 NAME 
  
  IO::Dir - supply object methods for directory handles
  
  =head1 SYNOPSIS
  
      use IO::Dir;
      $d = IO::Dir->new(".");
      if (defined $d) {
          while (defined($_ = $d->read)) { something($_); }
          $d->rewind;
          while (defined($_ = $d->read)) { something_else($_); }
          undef $d;
      }
  
      tie %dir, 'IO::Dir', ".";
      foreach (keys %dir) {
  	print $_, " " , $dir{$_}->size,"\n";
      }
  
  =head1 DESCRIPTION
  
  The C<IO::Dir> package provides two interfaces to perl's directory reading
  routines.
  
  The first interface is an object approach. C<IO::Dir> provides an object
  constructor and methods, which are just wrappers around perl's built in
  directory reading routines.
  
  =over 4
  
  =item new ( [ DIRNAME ] )
  
  C<new> is the constructor for C<IO::Dir> objects. It accepts one optional
  argument which,  if given, C<new> will pass to C<open>
  
  =back
  
  The following methods are wrappers for the directory related functions built
  into perl (the trailing `dir' has been removed from the names). See L<perlfunc>
  for details of these functions.
  
  =over 4
  
  =item open ( DIRNAME )
  
  =item read ()
  
  =item seek ( POS )
  
  =item tell ()
  
  =item rewind ()
  
  =item close ()
  
  =back
  
  C<IO::Dir> also provides an interface to reading directories via a tied
  hash. The tied hash extends the interface beyond just the directory
  reading routines by the use of C<lstat>, from the C<File::stat> package,
  C<unlink>, C<rmdir> and C<utime>.
  
  =over 4
  
  =item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ]
  
  =back
  
  The keys of the hash will be the names of the entries in the directory. 
  Reading a value from the hash will be the result of calling
  C<File::stat::lstat>.  Deleting an element from the hash will 
  delete the corresponding file or subdirectory,
  provided that C<DIR_UNLINK> is included in the C<OPTIONS>.
  
  Assigning to an entry in the hash will cause the time stamps of the file
  to be modified. If the file does not exist then it will be created. Assigning
  a single integer to a hash element will cause both the access and 
  modification times to be changed to that value. Alternatively a reference to
  an array of two values can be passed. The first array element will be used to
  set the access time and the second element will be used to set the modification
  time.
  
  =head1 SEE ALSO
  
  L<File::stat>
  
  =head1 AUTHOR
  
  Graham Barr. Currently maintained by the Perl Porters.  Please report all
  bugs to <perl5-porters@perl.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-2003 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.
  
  =cut
DARWIN-2LEVEL_IO_DIR

$fatpacked{"darwin-2level/IO/File.pm"} = <<'DARWIN-2LEVEL_IO_FILE';
  #
  
  package IO::File;
  
  =head1 NAME
  
  IO::File - supply object methods for filehandles
  
  =head1 SYNOPSIS
  
      use IO::File;
  
      $fh = new IO::File;
      if ($fh->open("< file")) {
          print <$fh>;
          $fh->close;
      }
  
      $fh = new IO::File "> file";
      if (defined $fh) {
          print $fh "bar\n";
          $fh->close;
      }
  
      $fh = new IO::File "file", "r";
      if (defined $fh) {
          print <$fh>;
          undef $fh;       # automatically closes the file
      }
  
      $fh = new IO::File "file", O_WRONLY|O_APPEND;
      if (defined $fh) {
          print $fh "corge\n";
  
          $pos = $fh->getpos;
          $fh->setpos($pos);
  
          undef $fh;       # automatically closes the file
      }
  
      autoflush STDOUT 1;
  
  =head1 DESCRIPTION
  
  C<IO::File> inherits from C<IO::Handle> and C<IO::Seekable>. It extends
  these classes with methods that are specific to file handles.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new ( FILENAME [,MODE [,PERMS]] )
  
  Creates an C<IO::File>.  If it receives any parameters, they are passed to
  the method C<open>; if the open fails, the object is destroyed.  Otherwise,
  it is returned to the caller.
  
  =item new_tmpfile
  
  Creates an C<IO::File> opened for read/write on a newly created temporary
  file.  On systems where this is possible, the temporary file is anonymous
  (i.e. it is unlinked after creation, but held open).  If the temporary
  file cannot be created or opened, the C<IO::File> object is destroyed.
  Otherwise, it is returned to the caller.
  
  =back
  
  =head1 METHODS
  
  =over 4
  
  =item open( FILENAME [,MODE [,PERMS]] )
  
  =item open( FILENAME, IOLAYERS )
  
  C<open> accepts one, two or three parameters.  With one parameter,
  it is just a front end for the built-in C<open> function.  With two or three
  parameters, the first parameter is a filename that may include
  whitespace or other special characters, and the second parameter is
  the open mode, optionally followed by a file permission value.
  
  If C<IO::File::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.)
  or an ANSI C fopen() mode string ("w", "r+", etc.), it uses the basic
  Perl C<open> operator (but protects any special characters).
  
  If C<IO::File::open> is given a numeric mode, it passes that mode
  and the optional permissions value to the Perl C<sysopen> operator.
  The permissions default to 0666.
  
  If C<IO::File::open> is given a mode that includes the C<:> character,
  it passes all the three arguments to the three-argument C<open> operator.
  
  For convenience, C<IO::File> exports the O_XXX constants from the
  Fcntl module, if this module is available.
  
  =item binmode( [LAYER] )
  
  C<binmode> sets C<binmode> on the underlying C<IO> object, as documented
  in C<perldoc -f binmode>.
  
  C<binmode> accepts one optional parameter, which is the layer to be
  passed on to the C<binmode> call.
  
  =back
  
  =head1 NOTE
  
  Some operating systems may perform  C<IO::File::new()> or C<IO::File::open()>
  on a directory without errors.  This behavior is not portable and not
  suggested for use.  Using C<opendir()> and C<readdir()> or C<IO::Dir> are
  suggested instead.
  
  =head1 SEE ALSO
  
  L<perlfunc>, 
  L<perlop/"I/O Operators">,
  L<IO::Handle>,
  L<IO::Seekable>,
  L<IO::Dir>
  
  =head1 HISTORY
  
  Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>.
  
  =cut
  
  use 5.006_001;
  use strict;
  our($VERSION, @EXPORT, @EXPORT_OK, @ISA);
  use Carp;
  use Symbol;
  use SelectSaver;
  use IO::Seekable;
  use File::Spec;
  
  require Exporter;
  
  @ISA = qw(IO::Handle IO::Seekable Exporter);
  
  $VERSION = "1.14";
  
  @EXPORT = @IO::Seekable::EXPORT;
  
  eval {
      # Make all Fcntl O_XXX constants available for importing
      require Fcntl;
      my @O = grep /^O_/, @Fcntl::EXPORT;
      Fcntl->import(@O);  # first we import what we want to export
      push(@EXPORT, @O);
  };
  
  ################################################
  ## Constructor
  ##
  
  sub new {
      my $type = shift;
      my $class = ref($type) || $type || "IO::File";
      @_ >= 0 && @_ <= 3
  	or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]";
      my $fh = $class->SUPER::new();
      if (@_) {
  	$fh->open(@_)
  	    or return undef;
      }
      $fh;
  }
  
  ################################################
  ## Open
  ##
  
  sub open {
      @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
      my ($fh, $file) = @_;
      if (@_ > 2) {
  	my ($mode, $perms) = @_[2, 3];
  	if ($mode =~ /^\d+$/) {
  	    defined $perms or $perms = 0666;
  	    return sysopen($fh, $file, $mode, $perms);
  	} elsif ($mode =~ /:/) {
  	    return open($fh, $mode, $file) if @_ == 3;
  	    croak 'usage: $fh->open(FILENAME, IOLAYERS)';
  	} else {
              return open($fh, IO::Handle::_open_mode_string($mode), $file);
          }
      }
      open($fh, $file);
  }
  
  ################################################
  ## Binmode
  ##
  
  sub binmode {
      ( @_ == 1 or @_ == 2 ) or croak 'usage $fh->binmode([LAYER])';
  
      my($fh, $layer) = @_;
  
      return binmode $$fh unless $layer;
      return binmode $$fh, $layer;
  }
  
  1;
DARWIN-2LEVEL_IO_FILE

$fatpacked{"darwin-2level/IO/Handle.pm"} = <<'DARWIN-2LEVEL_IO_HANDLE';
  package IO::Handle;
  
  =head1 NAME
  
  IO::Handle - supply object methods for I/O handles
  
  =head1 SYNOPSIS
  
      use IO::Handle;
  
      $io = new IO::Handle;
      if ($io->fdopen(fileno(STDIN),"r")) {
          print $io->getline;
          $io->close;
      }
  
      $io = new IO::Handle;
      if ($io->fdopen(fileno(STDOUT),"w")) {
          $io->print("Some text\n");
      }
  
      # setvbuf is not available by default on Perls 5.8.0 and later.
      use IO::Handle '_IOLBF';
      $io->setvbuf($buffer_var, _IOLBF, 1024);
  
      undef $io;       # automatically closes the file if it's open
  
      autoflush STDOUT 1;
  
  =head1 DESCRIPTION
  
  C<IO::Handle> is the base class for all other IO handle classes. It is
  not intended that objects of C<IO::Handle> would be created directly,
  but instead C<IO::Handle> is inherited from by several other classes
  in the IO hierarchy.
  
  If you are reading this documentation, looking for a replacement for
  the C<FileHandle> package, then I suggest you read the documentation
  for C<IO::File> too.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new ()
  
  Creates a new C<IO::Handle> object.
  
  =item new_from_fd ( FD, MODE )
  
  Creates an C<IO::Handle> like C<new> does.
  It requires two parameters, which are passed to the method C<fdopen>;
  if the fdopen fails, the object is destroyed. Otherwise, it is returned
  to the caller.
  
  =back
  
  =head1 METHODS
  
  See L<perlfunc> for complete descriptions of each of the following
  supported C<IO::Handle> methods, which are just front ends for the
  corresponding built-in functions:
  
      $io->close
      $io->eof
      $io->fcntl( FUNCTION, SCALAR )
      $io->fileno
      $io->format_write( [FORMAT_NAME] )
      $io->getc
      $io->ioctl( FUNCTION, SCALAR )
      $io->read ( BUF, LEN, [OFFSET] )
      $io->print ( ARGS )
      $io->printf ( FMT, [ARGS] )
      $io->say ( ARGS )
      $io->stat
      $io->sysread ( BUF, LEN, [OFFSET] )
      $io->syswrite ( BUF, [LEN, [OFFSET]] )
      $io->truncate ( LEN )
  
  See L<perlvar> for complete descriptions of each of the following
  supported C<IO::Handle> methods.  All of them return the previous
  value of the attribute and takes an optional single argument that when
  given will set the value.  If no argument is given the previous value
  is unchanged (except for $io->autoflush will actually turn ON
  autoflush by default).
  
      $io->autoflush ( [BOOL] )                         $|
      $io->format_page_number( [NUM] )                  $%
      $io->format_lines_per_page( [NUM] )               $=
      $io->format_lines_left( [NUM] )                   $-
      $io->format_name( [STR] )                         $~
      $io->format_top_name( [STR] )                     $^
      $io->input_line_number( [NUM])                    $.
  
  The following methods are not supported on a per-filehandle basis.
  
      IO::Handle->format_line_break_characters( [STR] ) $:
      IO::Handle->format_formfeed( [STR])               $^L
      IO::Handle->output_field_separator( [STR] )       $,
      IO::Handle->output_record_separator( [STR] )      $\
  
      IO::Handle->input_record_separator( [STR] )       $/
  
  Furthermore, for doing normal I/O you might need these:
  
  =over 4
  
  =item $io->fdopen ( FD, MODE )
  
  C<fdopen> is like an ordinary C<open> except that its first parameter
  is not a filename but rather a file handle name, an IO::Handle object,
  or a file descriptor number.  (For the documentation of the C<open>
  method, see L<IO::File>.)
  
  =item $io->opened
  
  Returns true if the object is currently a valid file descriptor, false
  otherwise.
  
  =item $io->getline
  
  This works like <$io> described in L<perlop/"I/O Operators">
  except that it's more readable and can be safely called in a
  list context but still returns just one line.  If used as the conditional
  +within a C<while> or C-style C<for> loop, however, you will need to
  +emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>.
  
  =item $io->getlines
  
  This works like <$io> when called in a list context to read all
  the remaining lines in a file, except that it's more readable.
  It will also croak() if accidentally called in a scalar context.
  
  =item $io->ungetc ( ORD )
  
  Pushes a character with the given ordinal value back onto the given
  handle's input stream.  Only one character of pushback per handle is
  guaranteed.
  
  =item $io->write ( BUF, LEN [, OFFSET ] )
  
  This C<write> is like C<write> found in C, that is it is the
  opposite of read. The wrapper for the perl C<write> function is
  called C<format_write>.
  
  =item $io->error
  
  Returns a true value if the given handle has experienced any errors
  since it was opened or since the last call to C<clearerr>, or if the
  handle is invalid. It only returns false for a valid handle with no
  outstanding errors.
  
  =item $io->clearerr
  
  Clear the given handle's error indicator. Returns -1 if the handle is
  invalid, 0 otherwise.
  
  =item $io->sync
  
  C<sync> synchronizes a file's in-memory state  with  that  on the
  physical medium. C<sync> does not operate at the perlio api level, but
  operates on the file descriptor (similar to sysread, sysseek and
  systell). This means that any data held at the perlio api level will not
  be synchronized. To synchronize data that is buffered at the perlio api
  level you must use the flush method. C<sync> is not implemented on all
  platforms. Returns "0 but true" on success, C<undef> on error, C<undef>
  for an invalid handle. See L<fsync(3c)>.
  
  =item $io->flush
  
  C<flush> causes perl to flush any buffered data at the perlio api level.
  Any unread data in the buffer will be discarded, and any unwritten data
  will be written to the underlying file descriptor. Returns "0 but true"
  on success, C<undef> on error.
  
  =item $io->printflush ( ARGS )
  
  Turns on autoflush, print ARGS and then restores the autoflush status of the
  C<IO::Handle> object. Returns the return value from print.
  
  =item $io->blocking ( [ BOOL ] )
  
  If called with an argument C<blocking> will turn on non-blocking IO if
  C<BOOL> is false, and turn it off if C<BOOL> is true.
  
  C<blocking> will return the value of the previous setting, or the
  current setting if C<BOOL> is not given. 
  
  If an error occurs C<blocking> will return undef and C<$!> will be set.
  
  =back
  
  
  If the C functions setbuf() and/or setvbuf() are available, then
  C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
  policy for an IO::Handle.  The calling sequences for the Perl functions
  are the same as their C counterparts--including the constants C<_IOFBF>,
  C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
  specifies a scalar variable to use as a buffer. You should only
  change the buffer before any I/O, or immediately after calling flush.
  
  WARNING: The IO::Handle::setvbuf() is not available by default on
  Perls 5.8.0 and later because setvbuf() is rather specific to using
  the stdio library, while Perl prefers the new perlio subsystem instead.
  
  WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not
  be modified> in any way until the IO::Handle is closed or C<setbuf> or
  C<setvbuf> is called again, or memory corruption may result! Remember that
  the order of global destruction is undefined, so even if your buffer
  variable remains in scope until program termination, it may be undefined
  before the file IO::Handle is closed. Note that you need to import the
  constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf
  returns nothing. setvbuf returns "0 but true", on success, C<undef> on
  failure.
  
  Lastly, there is a special method for working under B<-T> and setuid/gid
  scripts:
  
  =over 4
  
  =item $io->untaint
  
  Marks the object as taint-clean, and as such data read from it will also
  be considered taint-clean. Note that this is a very trusting action to
  take, and appropriate consideration for the data source and potential
  vulnerability should be kept in mind. Returns 0 on success, -1 if setting
  the taint-clean flag failed. (eg invalid handle)
  
  =back
  
  =head1 NOTE
  
  An C<IO::Handle> object is a reference to a symbol/GLOB reference (see
  the C<Symbol> package).  Some modules that
  inherit from C<IO::Handle> may want to keep object related variables
  in the hash table part of the GLOB. In an attempt to prevent modules
  trampling on each other I propose the that any such module should prefix
  its variables with its own name separated by _'s. For example the IO::Socket
  module keeps a C<timeout> variable in 'io_socket_timeout'.
  
  =head1 SEE ALSO
  
  L<perlfunc>, 
  L<perlop/"I/O Operators">,
  L<IO::File>
  
  =head1 BUGS
  
  Due to backwards compatibility, all filehandles resemble objects
  of class C<IO::Handle>, or actually classes derived from that class.
  They actually aren't.  Which means you can't derive your own 
  class from C<IO::Handle> and inherit those methods.
  
  =head1 HISTORY
  
  Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
  
  =cut
  
  use 5.006_001;
  use strict;
  our($VERSION, @EXPORT_OK, @ISA);
  use Carp;
  use Symbol;
  use SelectSaver;
  use IO ();	# Load the XS module
  
  require Exporter;
  @ISA = qw(Exporter);
  
  $VERSION = "1.28";
  $VERSION = eval $VERSION;
  
  @EXPORT_OK = qw(
      autoflush
      output_field_separator
      output_record_separator
      input_record_separator
      input_line_number
      format_page_number
      format_lines_per_page
      format_lines_left
      format_name
      format_top_name
      format_line_break_characters
      format_formfeed
      format_write
  
      print
      printf
      say
      getline
      getlines
  
      printflush
      flush
  
      SEEK_SET
      SEEK_CUR
      SEEK_END
      _IOFBF
      _IOLBF
      _IONBF
  );
  
  ################################################
  ## Constructors, destructors.
  ##
  
  sub new {
      my $class = ref($_[0]) || $_[0] || "IO::Handle";
      @_ == 1 or croak "usage: new $class";
      my $io = gensym;
      bless $io, $class;
  }
  
  sub new_from_fd {
      my $class = ref($_[0]) || $_[0] || "IO::Handle";
      @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
      my $io = gensym;
      shift;
      IO::Handle::fdopen($io, @_)
  	or return undef;
      bless $io, $class;
  }
  
  #
  # There is no need for DESTROY to do anything, because when the
  # last reference to an IO object is gone, Perl automatically
  # closes its associated files (if any).  However, to avoid any
  # attempts to autoload DESTROY, we here define it to do nothing.
  #
  sub DESTROY {}
  
  
  ################################################
  ## Open and close.
  ##
  
  sub _open_mode_string {
      my ($mode) = @_;
      $mode =~ /^\+?(<|>>?)$/
        or $mode =~ s/^r(\+?)$/$1</
        or $mode =~ s/^w(\+?)$/$1>/
        or $mode =~ s/^a(\+?)$/$1>>/
        or croak "IO::Handle: bad open mode: $mode";
      $mode;
  }
  
  sub fdopen {
      @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
      my ($io, $fd, $mode) = @_;
      local(*GLOB);
  
      if (ref($fd) && "".$fd =~ /GLOB\(/o) {
  	# It's a glob reference; Alias it as we cannot get name of anon GLOBs
  	my $n = qualify(*GLOB);
  	*GLOB = *{*$fd};
  	$fd =  $n;
      } elsif ($fd =~ m#^\d+$#) {
  	# It's an FD number; prefix with "=".
  	$fd = "=$fd";
      }
  
      open($io, _open_mode_string($mode) . '&' . $fd)
  	? $io : undef;
  }
  
  sub close {
      @_ == 1 or croak 'usage: $io->close()';
      my($io) = @_;
  
      close($io);
  }
  
  ################################################
  ## Normal I/O functions.
  ##
  
  # flock
  # select
  
  sub opened {
      @_ == 1 or croak 'usage: $io->opened()';
      defined fileno($_[0]);
  }
  
  sub fileno {
      @_ == 1 or croak 'usage: $io->fileno()';
      fileno($_[0]);
  }
  
  sub getc {
      @_ == 1 or croak 'usage: $io->getc()';
      getc($_[0]);
  }
  
  sub eof {
      @_ == 1 or croak 'usage: $io->eof()';
      eof($_[0]);
  }
  
  sub print {
      @_ or croak 'usage: $io->print(ARGS)';
      my $this = shift;
      print $this @_;
  }
  
  sub printf {
      @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
      my $this = shift;
      printf $this @_;
  }
  
  sub say {
      @_ or croak 'usage: $io->say(ARGS)';
      my $this = shift;
      local $\ = "\n";
      print $this @_;
  }
  
  sub getline {
      @_ == 1 or croak 'usage: $io->getline()';
      my $this = shift;
      return scalar <$this>;
  } 
  
  *gets = \&getline;  # deprecated
  
  sub getlines {
      @_ == 1 or croak 'usage: $io->getlines()';
      wantarray or
  	croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
      my $this = shift;
      return <$this>;
  }
  
  sub truncate {
      @_ == 2 or croak 'usage: $io->truncate(LEN)';
      truncate($_[0], $_[1]);
  }
  
  sub read {
      @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
      read($_[0], $_[1], $_[2], $_[3] || 0);
  }
  
  sub sysread {
      @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
      sysread($_[0], $_[1], $_[2], $_[3] || 0);
  }
  
  sub write {
      @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
      local($\) = "";
      $_[2] = length($_[1]) unless defined $_[2];
      print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
  }
  
  sub syswrite {
      @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
      if (defined($_[2])) {
  	syswrite($_[0], $_[1], $_[2], $_[3] || 0);
      } else {
  	syswrite($_[0], $_[1]);
      }
  }
  
  sub stat {
      @_ == 1 or croak 'usage: $io->stat()';
      stat($_[0]);
  }
  
  ################################################
  ## State modification functions.
  ##
  
  sub autoflush {
      my $old = new SelectSaver qualify($_[0], caller);
      my $prev = $|;
      $| = @_ > 1 ? $_[1] : 1;
      $prev;
  }
  
  sub output_field_separator {
      carp "output_field_separator is not supported on a per-handle basis"
  	if ref($_[0]);
      my $prev = $,;
      $, = $_[1] if @_ > 1;
      $prev;
  }
  
  sub output_record_separator {
      carp "output_record_separator is not supported on a per-handle basis"
  	if ref($_[0]);
      my $prev = $\;
      $\ = $_[1] if @_ > 1;
      $prev;
  }
  
  sub input_record_separator {
      carp "input_record_separator is not supported on a per-handle basis"
  	if ref($_[0]);
      my $prev = $/;
      $/ = $_[1] if @_ > 1;
      $prev;
  }
  
  sub input_line_number {
      local $.;
      () = tell qualify($_[0], caller) if ref($_[0]);
      my $prev = $.;
      $. = $_[1] if @_ > 1;
      $prev;
  }
  
  sub format_page_number {
      my $old;
      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
      my $prev = $%;
      $% = $_[1] if @_ > 1;
      $prev;
  }
  
  sub format_lines_per_page {
      my $old;
      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
      my $prev = $=;
      $= = $_[1] if @_ > 1;
      $prev;
  }
  
  sub format_lines_left {
      my $old;
      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
      my $prev = $-;
      $- = $_[1] if @_ > 1;
      $prev;
  }
  
  sub format_name {
      my $old;
      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
      my $prev = $~;
      $~ = qualify($_[1], caller) if @_ > 1;
      $prev;
  }
  
  sub format_top_name {
      my $old;
      $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
      my $prev = $^;
      $^ = qualify($_[1], caller) if @_ > 1;
      $prev;
  }
  
  sub format_line_break_characters {
      carp "format_line_break_characters is not supported on a per-handle basis"
  	if ref($_[0]);
      my $prev = $:;
      $: = $_[1] if @_ > 1;
      $prev;
  }
  
  sub format_formfeed {
      carp "format_formfeed is not supported on a per-handle basis"
  	if ref($_[0]);
      my $prev = $^L;
      $^L = $_[1] if @_ > 1;
      $prev;
  }
  
  sub formline {
      my $io = shift;
      my $picture = shift;
      local($^A) = $^A;
      local($\) = "";
      formline($picture, @_);
      print $io $^A;
  }
  
  sub format_write {
      @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
      if (@_ == 2) {
  	my ($io, $fmt) = @_;
  	my $oldfmt = $io->format_name(qualify($fmt,caller));
  	CORE::write($io);
  	$io->format_name($oldfmt);
      } else {
  	CORE::write($_[0]);
      }
  }
  
  sub fcntl {
      @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
      my ($io, $op) = @_;
      return fcntl($io, $op, $_[2]);
  }
  
  sub ioctl {
      @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
      my ($io, $op) = @_;
      return ioctl($io, $op, $_[2]);
  }
  
  # this sub is for compatability with older releases of IO that used
  # a sub called constant to detemine if a constant existed -- GMB
  #
  # The SEEK_* and _IO?BF constants were the only constants at that time
  # any new code should just chech defined(&CONSTANT_NAME)
  
  sub constant {
      no strict 'refs';
      my $name = shift;
      (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
  	? &{$name}() : undef;
  }
  
  
  # so that flush.pl can be deprecated
  
  sub printflush {
      my $io = shift;
      my $old;
      $old = new SelectSaver qualify($io, caller) if ref($io);
      local $| = 1;
      if(ref($io)) {
          print $io @_;
      }
      else {
  	print @_;
      }
  }
  
  1;
DARWIN-2LEVEL_IO_HANDLE

$fatpacked{"darwin-2level/IO/Pipe.pm"} = <<'DARWIN-2LEVEL_IO_PIPE';
  # IO::Pipe.pm
  #
  # Copyright (c) 1996-8 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 IO::Pipe;
  
  use 5.006_001;
  
  use IO::Handle;
  use strict;
  our($VERSION);
  use Carp;
  use Symbol;
  
  $VERSION = "1.13";
  
  sub new {
      my $type = shift;
      my $class = ref($type) || $type || "IO::Pipe";
      @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
  
      my $me = bless gensym(), $class;
  
      my($readfh,$writefh) = @_ ? @_ : $me->handles;
  
      pipe($readfh, $writefh)
  	or return undef;
  
      @{*$me} = ($readfh, $writefh);
  
      $me;
  }
  
  sub handles {
      @_ == 1 or croak 'usage: $pipe->handles()';
      (IO::Pipe::End->new(), IO::Pipe::End->new());
  }
  
  my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
  
  sub _doit {
      my $me = shift;
      my $rw = shift;
  
      my $pid = $do_spawn ? 0 : fork();
  
      if($pid) { # Parent
          return $pid;
      }
      elsif(defined $pid) { # Child or spawn
          my $fh;
          my $io = $rw ? \*STDIN : \*STDOUT;
          my ($mode, $save) = $rw ? "r" : "w";
          if ($do_spawn) {
            require Fcntl;
            $save = IO::Handle->new_from_fd($io, $mode);
  	  my $handle = shift;
            # Close in child:
  	  unless ($^O eq 'MSWin32') {
              fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
  	  }
            $fh = $rw ? ${*$me}[0] : ${*$me}[1];
          } else {
            shift;
            $fh = $rw ? $me->reader() : $me->writer(); # close the other end
          }
          bless $io, "IO::Handle";
          $io->fdopen($fh, $mode);
  	$fh->close;
  
          if ($do_spawn) {
            $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
            my $err = $!;
      
            $io->fdopen($save, $mode);
            $save->close or croak "Cannot close $!";
            croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
            return $pid;
          } else {
            exec @_ or
              croak "IO::Pipe: Cannot exec: $!";
          }
      }
      else {
          croak "IO::Pipe: Cannot fork: $!";
      }
  
      # NOT Reached
  }
  
  sub reader {
      @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )';
      my $me = shift;
  
      return undef
  	unless(ref($me) || ref($me = $me->new));
  
      my $fh  = ${*$me}[0];
      my $pid;
      $pid = $me->_doit(0, $fh, @_)
          if(@_);
  
      close ${*$me}[1];
      bless $me, ref($fh);
      *$me = *$fh;          # Alias self to handle
      $me->fdopen($fh->fileno,"r")
  	unless defined($me->fileno);
      bless $fh;                  # Really wan't un-bless here
      ${*$me}{'io_pipe_pid'} = $pid
          if defined $pid;
  
      $me;
  }
  
  sub writer {
      @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )';
      my $me = shift;
  
      return undef
  	unless(ref($me) || ref($me = $me->new));
  
      my $fh  = ${*$me}[1];
      my $pid;
      $pid = $me->_doit(1, $fh, @_)
          if(@_);
  
      close ${*$me}[0];
      bless $me, ref($fh);
      *$me = *$fh;          # Alias self to handle
      $me->fdopen($fh->fileno,"w")
  	unless defined($me->fileno);
      bless $fh;                  # Really wan't un-bless here
      ${*$me}{'io_pipe_pid'} = $pid
          if defined $pid;
  
      $me;
  }
  
  package IO::Pipe::End;
  
  our(@ISA);
  
  @ISA = qw(IO::Handle);
  
  sub close {
      my $fh = shift;
      my $r = $fh->SUPER::close(@_);
  
      waitpid(${*$fh}{'io_pipe_pid'},0)
  	if(defined ${*$fh}{'io_pipe_pid'});
  
      $r;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  IO::Pipe - supply object methods for pipes
  
  =head1 SYNOPSIS
  
  	use IO::Pipe;
  
  	$pipe = new IO::Pipe;
  
  	if($pid = fork()) { # Parent
  	    $pipe->reader();
  
  	    while(<$pipe>) {
  		...
  	    }
  
  	}
  	elsif(defined $pid) { # Child
  	    $pipe->writer();
  
  	    print $pipe ...
  	}
  
  	or
  
  	$pipe = new IO::Pipe;
  
  	$pipe->reader(qw(ls -l));
  
  	while(<$pipe>) {
  	    ...
  	}
  
  =head1 DESCRIPTION
  
  C<IO::Pipe> provides an interface to creating pipes between
  processes.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new ( [READER, WRITER] )
  
  Creates an C<IO::Pipe>, which is a reference to a newly created symbol
  (see the C<Symbol> package). C<IO::Pipe::new> optionally takes two
  arguments, which should be objects blessed into C<IO::Handle>, or a
  subclass thereof. These two objects will be used for the system call
  to C<pipe>. If no arguments are given then method C<handles> is called
  on the new C<IO::Pipe> object.
  
  These two handles are held in the array part of the GLOB until either
  C<reader> or C<writer> is called.
  
  =back
  
  =head1 METHODS
  
  =over 4
  
  =item reader ([ARGS])
  
  The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
  is called and C<ARGS> are passed to exec.
  
  =item writer ([ARGS])
  
  The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
  is called and C<ARGS> are passed to exec.
  
  =item handles ()
  
  This method is called during construction by C<IO::Pipe::new>
  on the newly created C<IO::Pipe> object. It returns an array of two objects
  blessed into C<IO::Pipe::End>, or a subclass thereof.
  
  =back
  
  =head1 SEE ALSO
  
  L<IO::Handle>
  
  =head1 AUTHOR
  
  Graham Barr. Currently maintained by the Perl Porters.  Please report all
  bugs to <perl5-porters@perl.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1996-8 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.
  
  =cut
DARWIN-2LEVEL_IO_PIPE

$fatpacked{"darwin-2level/IO/Poll.pm"} = <<'DARWIN-2LEVEL_IO_POLL';
  
  # IO::Poll.pm
  #
  # Copyright (c) 1997-8 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 IO::Poll;
  
  use strict;
  use IO::Handle;
  use Exporter ();
  our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
  
  @ISA = qw(Exporter);
  $VERSION = "0.07";
  
  @EXPORT = qw( POLLIN
  	      POLLOUT
  	      POLLERR
  	      POLLHUP
  	      POLLNVAL
  	    );
  
  @EXPORT_OK = qw(
   POLLPRI   
   POLLRDNORM
   POLLWRNORM
   POLLRDBAND
   POLLWRBAND
   POLLNORM  
  	       );
  
  # [0] maps fd's to requested masks
  # [1] maps fd's to returned  masks
  # [2] maps fd's to handles
  sub new {
      my $class = shift;
  
      my $self = bless [{},{},{}], $class;
  
      $self;
  }
  
  sub mask {
      my $self = shift;
      my $io = shift;
      my $fd = fileno($io);
      return unless defined $fd;
      if (@_) {
  	my $mask = shift;
  	if($mask) {
  	  $self->[0]{$fd}{$io} = $mask; # the error events are always returned
  	  $self->[1]{$fd}      = 0;     # output mask
  	  $self->[2]{$io}      = $io;   # remember handle
  	} else {
            delete $self->[0]{$fd}{$io};
            unless(%{$self->[0]{$fd}}) {
              # We no longer have any handles for this FD
              delete $self->[1]{$fd};
              delete $self->[0]{$fd};
            }
            delete $self->[2]{$io};
  	}
      }
      
      return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
  	return $self->[0]{$fd}{$io};
  }
  
  
  sub poll {
      my($self,$timeout) = @_;
  
      $self->[1] = {};
  
      my($fd,$mask,$iom);
      my @poll = ();
  
      while(($fd,$iom) = each %{$self->[0]}) {
  	$mask   = 0;
  	$mask  |= $_ for values(%$iom);
  	push(@poll,$fd => $mask);
      }
  
      my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
  
      return $ret
  	unless $ret > 0;
  
      while(@poll) {
  	my($fd,$got) = splice(@poll,0,2);
  	$self->[1]{$fd} = $got if $got;
      }
  
      return $ret;  
  }
  
  sub events {
      my $self = shift;
      my $io = shift;
      my $fd = fileno($io);
      exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} 
                  ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
  	: 0;
  }
  
  sub remove {
      my $self = shift;
      my $io = shift;
      $self->mask($io,0);
  }
  
  sub handles {
      my $self = shift;
      return values %{$self->[2]} unless @_;
  
      my $events = shift || 0;
      my($fd,$ev,$io,$mask);
      my @handles = ();
  
      while(($fd,$ev) = each %{$self->[1]}) {
  	while (($io,$mask) = each %{$self->[0]{$fd}}) {
  	    $mask |= POLLHUP|POLLERR|POLLNVAL;  # must allow these
  	    push @handles,$self->[2]{$io} if ($ev & $mask) & $events;
  	}
      }
      return @handles;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  IO::Poll - Object interface to system poll call
  
  =head1 SYNOPSIS
  
      use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP);
  
      $poll = new IO::Poll;
  
      $poll->mask($input_handle => POLLIN);
      $poll->mask($output_handle => POLLOUT);
  
      $poll->poll($timeout);
  
      $ev = $poll->events($input);
  
  =head1 DESCRIPTION
  
  C<IO::Poll> is a simple interface to the system level poll routine.
  
  =head1 METHODS
  
  =over 4
  
  =item mask ( IO [, EVENT_MASK ] )
  
  If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the
  list of file descriptors and the next call to poll will check for
  any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be
  removed from the list of file descriptors.
  
  If EVENT_MASK is not given then the return value will be the current
  event mask value for IO.
  
  =item poll ( [ TIMEOUT ] )
  
  Call the system level poll routine. If TIMEOUT is not specified then the
  call will block. Returns the number of handles which had events
  happen, or -1 on error.
  
  =item events ( IO )
  
  Returns the event mask which represents the events that happened on IO
  during the last call to C<poll>.
  
  =item remove ( IO )
  
  Remove IO from the list of file descriptors for the next poll.
  
  =item handles( [ EVENT_MASK ] )
  
  Returns a list of handles. If EVENT_MASK is not given then a list of all
  handles known will be returned. If EVENT_MASK is given then a list
  of handles will be returned which had one of the events specified by
  EVENT_MASK happen during the last call ti C<poll>
  
  =back
  
  =head1 SEE ALSO
  
  L<poll(2)>, L<IO::Handle>, L<IO::Select>
  
  =head1 AUTHOR
  
  Graham Barr. Currently maintained by the Perl Porters.  Please report all
  bugs to <perl5-porters@perl.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-8 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.
  
  =cut
DARWIN-2LEVEL_IO_POLL

$fatpacked{"darwin-2level/IO/Seekable.pm"} = <<'DARWIN-2LEVEL_IO_SEEKABLE';
  #
  
  package IO::Seekable;
  
  =head1 NAME
  
  IO::Seekable - supply seek based methods for I/O objects
  
  =head1 SYNOPSIS
  
      use IO::Seekable;
      package IO::Something;
      @ISA = qw(IO::Seekable);
  
  =head1 DESCRIPTION
  
  C<IO::Seekable> does not have a constructor of its own as it is intended to
  be inherited by other C<IO::Handle> based objects. It provides methods
  which allow seeking of the file descriptors.
  
  =over 4
  
  =item $io->getpos
  
  Returns an opaque value that represents the current position of the
  IO::File, or C<undef> if this is not possible (eg an unseekable stream such
  as a terminal, pipe or socket). If the fgetpos() function is available in
  your C library it is used to implements getpos, else perl emulates getpos
  using C's ftell() function.
  
  =item $io->setpos
  
  Uses the value of a previous getpos call to return to a previously visited
  position. Returns "0 but true" on success, C<undef> on failure.
  
  =back
  
  See L<perlfunc> for complete descriptions of each of the following
  supported C<IO::Seekable> methods, which are just front ends for the
  corresponding built-in functions:
  
  =over 4
  
  =item $io->seek ( POS, WHENCE )
  
  Seek the IO::File to position POS, relative to WHENCE:
  
  =over 8
  
  =item WHENCE=0 (SEEK_SET)
  
  POS is absolute position. (Seek relative to the start of the file)
  
  =item WHENCE=1 (SEEK_CUR)
  
  POS is an offset from the current position. (Seek relative to current)
  
  =item WHENCE=2 (SEEK_END)
  
  POS is an offset from the end of the file. (Seek relative to end)
  
  =back
  
  The SEEK_* constants can be imported from the C<Fcntl> module if you
  don't wish to use the numbers C<0> C<1> or C<2> in your code.
  
  Returns C<1> upon success, C<0> otherwise.
  
  =item $io->sysseek( POS, WHENCE )
  
  Similar to $io->seek, but sets the IO::File's position using the system
  call lseek(2) directly, so will confuse most perl IO operators except
  sysread and syswrite (see L<perlfunc> for full details)
  
  Returns the new position, or C<undef> on failure.  A position
  of zero is returned as the string C<"0 but true">
  
  =item $io->tell
  
  Returns the IO::File's current position, or -1 on error.
  
  =back
  
  =head1 SEE ALSO
  
  L<perlfunc>, 
  L<perlop/"I/O Operators">,
  L<IO::Handle>
  L<IO::File>
  
  =head1 HISTORY
  
  Derived from FileHandle.pm by Graham Barr E<lt>gbarr@pobox.comE<gt>
  
  =cut
  
  use 5.006_001;
  use Carp;
  use strict;
  our($VERSION, @EXPORT, @ISA);
  use IO::Handle ();
  # XXX we can't get these from IO::Handle or we'll get prototype
  # mismatch warnings on C<use POSIX; use IO::File;> :-(
  use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END);
  require Exporter;
  
  @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
  @ISA = qw(Exporter);
  
  $VERSION = "1.10";
  $VERSION = eval $VERSION;
  
  sub seek {
      @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)';
      seek($_[0], $_[1], $_[2]);
  }
  
  sub sysseek {
      @_ == 3 or croak 'usage: $io->sysseek(POS, WHENCE)';
      sysseek($_[0], $_[1], $_[2]);
  }
  
  sub tell {
      @_ == 1 or croak 'usage: $io->tell()';
      tell($_[0]);
  }
  
  1;
DARWIN-2LEVEL_IO_SEEKABLE

$fatpacked{"darwin-2level/IO/Select.pm"} = <<'DARWIN-2LEVEL_IO_SELECT';
  # IO::Select.pm
  #
  # Copyright (c) 1997-8 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 IO::Select;
  
  use     strict;
  use warnings::register;
  use     vars qw($VERSION @ISA);
  require Exporter;
  
  $VERSION = "1.17";
  
  @ISA = qw(Exporter); # This is only so we can do version checking
  
  sub VEC_BITS () {0}
  sub FD_COUNT () {1}
  sub FIRST_FD () {2}
  
  sub new
  {
   my $self = shift;
   my $type = ref($self) || $self;
  
   my $vec = bless [undef,0], $type;
  
   $vec->add(@_)
      if @_;
  
   $vec;
  }
  
  sub add
  {
   shift->_update('add', @_);
  }
  
  
  sub remove
  {
   shift->_update('remove', @_);
  }
  
  
  sub exists
  {
   my $vec = shift;
   my $fno = $vec->_fileno(shift);
   return undef unless defined $fno;
   $vec->[$fno + FIRST_FD];
  }
  
  
  sub _fileno
  {
   my($self, $f) = @_;
   return unless defined $f;
   $f = $f->[0] if ref($f) eq 'ARRAY';
   ($f =~ /^\d+$/) ? $f : fileno($f);
  }
  
  sub _update
  {
   my $vec = shift;
   my $add = shift eq 'add';
  
   my $bits = $vec->[VEC_BITS];
   $bits = '' unless defined $bits;
  
   my $count = 0;
   my $f;
   foreach $f (@_)
    {
     my $fn = $vec->_fileno($f);
     next unless defined $fn;
     my $i = $fn + FIRST_FD;
     if ($add) {
       if (defined $vec->[$i]) {
  	 $vec->[$i] = $f;  # if array rest might be different, so we update
  	 next;
       }
       $vec->[FD_COUNT]++;
       vec($bits, $fn, 1) = 1;
       $vec->[$i] = $f;
     } else {      # remove
       next unless defined $vec->[$i];
       $vec->[FD_COUNT]--;
       vec($bits, $fn, 1) = 0;
       $vec->[$i] = undef;
     }
     $count++;
    }
   $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
   $count;
  }
  
  sub can_read
  {
   my $vec = shift;
   my $timeout = shift;
   my $r = $vec->[VEC_BITS];
  
   defined($r) && (select($r,undef,undef,$timeout) > 0)
      ? handles($vec, $r)
      : ();
  }
  
  sub can_write
  {
   my $vec = shift;
   my $timeout = shift;
   my $w = $vec->[VEC_BITS];
  
   defined($w) && (select(undef,$w,undef,$timeout) > 0)
      ? handles($vec, $w)
      : ();
  }
  
  sub has_exception
  {
   my $vec = shift;
   my $timeout = shift;
   my $e = $vec->[VEC_BITS];
  
   defined($e) && (select(undef,undef,$e,$timeout) > 0)
      ? handles($vec, $e)
      : ();
  }
  
  sub has_error
  {
   warnings::warn("Call to deprecated method 'has_error', use 'has_exception'")
  	if warnings::enabled();
   goto &has_exception;
  }
  
  sub count
  {
   my $vec = shift;
   $vec->[FD_COUNT];
  }
  
  sub bits
  {
   my $vec = shift;
   $vec->[VEC_BITS];
  }
  
  sub as_string  # for debugging
  {
   my $vec = shift;
   my $str = ref($vec) . ": ";
   my $bits = $vec->bits;
   my $count = $vec->count;
   $str .= defined($bits) ? unpack("b*", $bits) : "undef";
   $str .= " $count";
   my @handles = @$vec;
   splice(@handles, 0, FIRST_FD);
   for (@handles) {
       $str .= " " . (defined($_) ? "$_" : "-");
   }
   $str;
  }
  
  sub _max
  {
   my($a,$b,$c) = @_;
   $a > $b
      ? $a > $c
          ? $a
          : $c
      : $b > $c
          ? $b
          : $c;
  }
  
  sub select
  {
   shift
     if defined $_[0] && !ref($_[0]);
  
   my($r,$w,$e,$t) = @_;
   my @result = ();
  
   my $rb = defined $r ? $r->[VEC_BITS] : undef;
   my $wb = defined $w ? $w->[VEC_BITS] : undef;
   my $eb = defined $e ? $e->[VEC_BITS] : undef;
  
   if(select($rb,$wb,$eb,$t) > 0)
    {
     my @r = ();
     my @w = ();
     my @e = ();
     my $i = _max(defined $r ? scalar(@$r)-1 : 0,
                  defined $w ? scalar(@$w)-1 : 0,
                  defined $e ? scalar(@$e)-1 : 0);
  
     for( ; $i >= FIRST_FD ; $i--)
      {
       my $j = $i - FIRST_FD;
       push(@r, $r->[$i])
          if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
       push(@w, $w->[$i])
          if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
       push(@e, $e->[$i])
          if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
      }
  
     @result = (\@r, \@w, \@e);
    }
   @result;
  }
  
  
  sub handles
  {
   my $vec = shift;
   my $bits = shift;
   my @h = ();
   my $i;
   my $max = scalar(@$vec) - 1;
  
   for ($i = FIRST_FD; $i <= $max; $i++)
    {
     next unless defined $vec->[$i];
     push(@h, $vec->[$i])
        if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
    }
   
   @h;
  }
  
  1;
  __END__
  
  =head1 NAME
  
  IO::Select - OO interface to the select system call
  
  =head1 SYNOPSIS
  
      use IO::Select;
  
      $s = IO::Select->new();
  
      $s->add(\*STDIN);
      $s->add($some_handle);
  
      @ready = $s->can_read($timeout);
  
      @ready = IO::Select->new(@handles)->can_read(0);
  
  =head1 DESCRIPTION
  
  The C<IO::Select> package implements an object approach to the system C<select>
  function call. It allows the user to see what IO handles, see L<IO::Handle>,
  are ready for reading, writing or have an exception pending.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new ( [ HANDLES ] )
  
  The constructor creates a new object and optionally initialises it with a set
  of handles.
  
  =back
  
  =head1 METHODS
  
  =over 4
  
  =item add ( HANDLES )
  
  Add the list of handles to the C<IO::Select> object. It is these values that
  will be returned when an event occurs. C<IO::Select> keeps these values in a
  cache which is indexed by the C<fileno> of the handle, so if more than one
  handle with the same C<fileno> is specified then only the last one is cached.
  
  Each handle can be an C<IO::Handle> object, an integer or an array
  reference where the first element is an C<IO::Handle> or an integer.
  
  =item remove ( HANDLES )
  
  Remove all the given handles from the object. This method also works
  by the C<fileno> of the handles. So the exact handles that were added
  need not be passed, just handles that have an equivalent C<fileno>
  
  =item exists ( HANDLE )
  
  Returns a true value (actually the handle itself) if it is present.
  Returns undef otherwise.
  
  =item handles
  
  Return an array of all registered handles.
  
  =item can_read ( [ TIMEOUT ] )
  
  Return an array of handles that are ready for reading. C<TIMEOUT> is
  the maximum amount of time to wait before returning an empty list, in
  seconds, possibly fractional. If C<TIMEOUT> is not given and any
  handles are registered then the call will block.
  
  =item can_write ( [ TIMEOUT ] )
  
  Same as C<can_read> except check for handles that can be written to.
  
  =item has_exception ( [ TIMEOUT ] )
  
  Same as C<can_read> except check for handles that have an exception
  condition, for example pending out-of-band data.
  
  =item count ()
  
  Returns the number of handles that the object will check for when
  one of the C<can_> methods is called or the object is passed to
  the C<select> static method.
  
  =item bits()
  
  Return the bit string suitable as argument to the core select() call.
  
  =item select ( READ, WRITE, EXCEPTION [, TIMEOUT ] )
  
  C<select> is a static method, that is you call it with the package name
  like C<new>. C<READ>, C<WRITE> and C<EXCEPTION> are either C<undef> or
  C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
  for the core select call.
  
  The result will be an array of 3 elements, each a reference to an array
  which will hold the handles that are ready for reading, writing and have
  exceptions respectively. Upon error an empty list is returned.
  
  =back
  
  =head1 EXAMPLE
  
  Here is a short example which shows how C<IO::Select> could be used
  to write a server which communicates with several sockets while also
  listening for more connections on a listen socket
  
      use IO::Select;
      use IO::Socket;
  
      $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
      $sel = new IO::Select( $lsn );
  
      while(@ready = $sel->can_read) {
          foreach $fh (@ready) {
              if($fh == $lsn) {
                  # Create a new socket
                  $new = $lsn->accept;
                  $sel->add($new);
              }
              else {
                  # Process socket
  
                  # Maybe we have finished with the socket
                  $sel->remove($fh);
                  $fh->close;
              }
          }
      }
  
  =head1 AUTHOR
  
  Graham Barr. Currently maintained by the Perl Porters.  Please report all
  bugs to <perl5-porters@perl.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-8 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.
  
  =cut
  
DARWIN-2LEVEL_IO_SELECT

$fatpacked{"darwin-2level/IO/Socket.pm"} = <<'DARWIN-2LEVEL_IO_SOCKET';
  # IO::Socket.pm
  #
  # Copyright (c) 1997-8 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 IO::Socket;
  
  require 5.006;
  
  use IO::Handle;
  use Socket 1.3;
  use Carp;
  use strict;
  our(@ISA, $VERSION, @EXPORT_OK);
  use Exporter;
  use Errno;
  
  # legacy
  
  require IO::Socket::INET;
  require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
  
  @ISA = qw(IO::Handle);
  
  $VERSION = "1.31";
  
  @EXPORT_OK = qw(sockatmark);
  
  sub import {
      my $pkg = shift;
      if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
  	Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
      } else {
  	my $callpkg = caller;
  	Exporter::export 'Socket', $callpkg, @_;
      }
  }
  
  sub new {
      my($class,%arg) = @_;
      my $sock = $class->SUPER::new();
  
      $sock->autoflush(1);
  
      ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
  
      return scalar(%arg) ? $sock->configure(\%arg)
  			: $sock;
  }
  
  my @domain2pkg;
  
  sub register_domain {
      my($p,$d) = @_;
      $domain2pkg[$d] = $p;
  }
  
  sub configure {
      my($sock,$arg) = @_;
      my $domain = delete $arg->{Domain};
  
      croak 'IO::Socket: Cannot configure a generic socket'
  	unless defined $domain;
  
      croak "IO::Socket: Unsupported socket domain"
  	unless defined $domain2pkg[$domain];
  
      croak "IO::Socket: Cannot configure socket in domain '$domain'"
  	unless ref($sock) eq "IO::Socket";
  
      bless($sock, $domain2pkg[$domain]);
      $sock->configure($arg);
  }
  
  sub socket {
      @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
      my($sock,$domain,$type,$protocol) = @_;
  
      socket($sock,$domain,$type,$protocol) or
      	return undef;
  
      ${*$sock}{'io_socket_domain'} = $domain;
      ${*$sock}{'io_socket_type'}   = $type;
      ${*$sock}{'io_socket_proto'}  = $protocol;
  
      $sock;
  }
  
  sub socketpair {
      @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
      my($class,$domain,$type,$protocol) = @_;
      my $sock1 = $class->new();
      my $sock2 = $class->new();
  
      socketpair($sock1,$sock2,$domain,$type,$protocol) or
      	return ();
  
      ${*$sock1}{'io_socket_type'}  = ${*$sock2}{'io_socket_type'}  = $type;
      ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
  
      ($sock1,$sock2);
  }
  
  sub connect {
      @_ == 2 or croak 'usage: $sock->connect(NAME)';
      my $sock = shift;
      my $addr = shift;
      my $timeout = ${*$sock}{'io_socket_timeout'};
      my $err;
      my $blocking;
  
      $blocking = $sock->blocking(0) if $timeout;
      if (!connect($sock, $addr)) {
  	if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
  	    require IO::Select;
  
  	    my $sel = new IO::Select $sock;
  
  	    undef $!;
  	    if (!$sel->can_write($timeout)) {
  		$err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
  		$@ = "connect: timeout";
  	    }
  	    elsif (!connect($sock,$addr) &&
                  not ($!{EISCONN} || ($! == 10022 && $^O eq 'MSWin32'))
              ) {
  		# Some systems refuse to re-connect() to
  		# an already open socket and set errno to EISCONN.
  		# Windows sets errno to WSAEINVAL (10022)
  		$err = $!;
  		$@ = "connect: $!";
  	    }
  	}
          elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK}))  {
  	    $err = $!;
  	    $@ = "connect: $!";
  	}
      }
  
      $sock->blocking(1) if $blocking;
  
      $! = $err if $err;
  
      $err ? undef : $sock;
  }
  
  # Enable/disable blocking IO on sockets.
  # Without args return the current status of blocking,
  # with args change the mode as appropriate, returning the
  # old setting, or in case of error during the mode change
  # undef.
  
  sub blocking {
      my $sock = shift;
  
      return $sock->SUPER::blocking(@_)
          if $^O ne 'MSWin32';
  
      # Windows handles blocking differently
      #
      # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
      # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp
      #
      # 0x8004667e is FIONBIO
      #
      # which is used to set blocking behaviour.
  
      # NOTE: 
      # This is a little confusing, the perl keyword for this is
      # 'blocking' but the OS level behaviour is 'non-blocking', probably
      # because sockets are blocking by default.
      # Therefore internally we have to reverse the semantics.
  
      my $orig= !${*$sock}{io_sock_nonblocking};
          
      return $orig unless @_;
  
      my $block = shift;
      
      if ( !$block != !$orig ) {
          ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1;
          ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking}))
              or return undef;
      }
      
      return $orig;        
  }
  
  
  sub close {
      @_ == 1 or croak 'usage: $sock->close()';
      my $sock = shift;
      ${*$sock}{'io_socket_peername'} = undef;
      $sock->SUPER::close();
  }
  
  sub bind {
      @_ == 2 or croak 'usage: $sock->bind(NAME)';
      my $sock = shift;
      my $addr = shift;
  
      return bind($sock, $addr) ? $sock
  			      : undef;
  }
  
  sub listen {
      @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
      my($sock,$queue) = @_;
      $queue = 5
  	unless $queue && $queue > 0;
  
      return listen($sock, $queue) ? $sock
  				 : undef;
  }
  
  sub accept {
      @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
      my $sock = shift;
      my $pkg = shift || $sock;
      my $timeout = ${*$sock}{'io_socket_timeout'};
      my $new = $pkg->new(Timeout => $timeout);
      my $peer = undef;
  
      if(defined $timeout) {
  	require IO::Select;
  
  	my $sel = new IO::Select $sock;
  
  	unless ($sel->can_read($timeout)) {
  	    $@ = 'accept: timeout';
  	    $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
  	    return;
  	}
      }
  
      $peer = accept($new,$sock)
  	or return;
  
      return wantarray ? ($new, $peer)
      	      	     : $new;
  }
  
  sub sockname {
      @_ == 1 or croak 'usage: $sock->sockname()';
      getsockname($_[0]);
  }
  
  sub peername {
      @_ == 1 or croak 'usage: $sock->peername()';
      my($sock) = @_;
      ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
  }
  
  sub connected {
      @_ == 1 or croak 'usage: $sock->connected()';
      my($sock) = @_;
      getpeername($sock);
  }
  
  sub send {
      @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
      my $sock  = $_[0];
      my $flags = $_[2] || 0;
      my $peer  = $_[3] || $sock->peername;
  
      croak 'send: Cannot determine peer address'
  	 unless(defined $peer);
  
      my $r = defined(getpeername($sock))
  	? send($sock, $_[1], $flags)
  	: send($sock, $_[1], $flags, $peer);
  
      # remember who we send to, if it was successful
      ${*$sock}{'io_socket_peername'} = $peer
  	if(@_ == 4 && defined $r);
  
      $r;
  }
  
  sub recv {
      @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
      my $sock  = $_[0];
      my $len   = $_[2];
      my $flags = $_[3] || 0;
  
      # remember who we recv'd from
      ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
  }
  
  sub shutdown {
      @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
      my($sock, $how) = @_;
      ${*$sock}{'io_socket_peername'} = undef;
      shutdown($sock, $how);
  }
  
  sub setsockopt {
      @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)';
      setsockopt($_[0],$_[1],$_[2],$_[3]);
  }
  
  my $intsize = length(pack("i",0));
  
  sub getsockopt {
      @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
      my $r = getsockopt($_[0],$_[1],$_[2]);
      # Just a guess
      $r = unpack("i", $r)
  	if(defined $r && length($r) == $intsize);
      $r;
  }
  
  sub sockopt {
      my $sock = shift;
      @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
  	    : $sock->setsockopt(SOL_SOCKET,@_);
  }
  
  sub atmark {
      @_ == 1 or croak 'usage: $sock->atmark()';
      my($sock) = @_;
      sockatmark($sock);
  }
  
  sub timeout {
      @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
      my($sock,$val) = @_;
      my $r = ${*$sock}{'io_socket_timeout'};
  
      ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
  	if(@_ == 2);
  
      $r;
  }
  
  sub sockdomain {
      @_ == 1 or croak 'usage: $sock->sockdomain()';
      my $sock = shift;
      ${*$sock}{'io_socket_domain'};
  }
  
  sub socktype {
      @_ == 1 or croak 'usage: $sock->socktype()';
      my $sock = shift;
      ${*$sock}{'io_socket_type'}
  }
  
  sub protocol {
      @_ == 1 or croak 'usage: $sock->protocol()';
      my($sock) = @_;
      ${*$sock}{'io_socket_proto'};
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  IO::Socket - Object interface to socket communications
  
  =head1 SYNOPSIS
  
      use IO::Socket;
  
  =head1 DESCRIPTION
  
  C<IO::Socket> provides an object interface to creating and using sockets. It
  is built upon the L<IO::Handle> interface and inherits all the methods defined
  by L<IO::Handle>.
  
  C<IO::Socket> only defines methods for those operations which are common to all
  types of socket. Operations which are specified to a socket in a particular 
  domain have methods defined in sub classes of C<IO::Socket>
  
  C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new ( [ARGS] )
  
  Creates an C<IO::Socket>, which is a reference to a
  newly created symbol (see the C<Symbol> package). C<new>
  optionally takes arguments, these arguments are in key-value pairs.
  C<new> only looks for one key C<Domain> which tells new which domain
  the socket will be in. All other arguments will be passed to the
  configuration method of the package for that domain, See below.
  
   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  
  As of VERSION 1.18 all IO::Socket objects have autoflush turned on
  by default. This was not the case with earlier releases.
  
   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  
  =back
  
  =head1 METHODS
  
  See L<perlfunc> for complete descriptions of each of the following
  supported C<IO::Socket> methods, which are just front ends for the
  corresponding built-in functions:
  
      socket
      socketpair
      bind
      listen
      accept
      send
      recv
      peername (getpeername)
      sockname (getsockname)
      shutdown
  
  Some methods take slightly different arguments to those defined in L<perlfunc>
  in attempt to make the interface more flexible. These are
  
  =over 4
  
  =item accept([PKG])
  
  perform the system call C<accept> on the socket and return a new
  object. The new object will be created in the same class as the listen
  socket, unless C<PKG> is specified. This object can be used to
  communicate with the client that was trying to connect.
  
  In a scalar context the new socket is returned, or undef upon
  failure. In a list context a two-element array is returned containing
  the new socket and the peer address; the list will be empty upon
  failure.
  
  The timeout in the [PKG] can be specified as zero to effect a "poll",
  but you shouldn't do that because a new IO::Select object will be
  created behind the scenes just to do the single poll.  This is
  horrendously inefficient.  Use rather true select() with a zero
  timeout on the handle, or non-blocking IO.
  
  =item socketpair(DOMAIN, TYPE, PROTOCOL)
  
  Call C<socketpair> and return a list of two sockets created, or an
  empty list on failure.
  
  =back
  
  Additional methods that are provided are:
  
  =over 4
  
  =item atmark
  
  True if the socket is currently positioned at the urgent data mark,
  false otherwise.
  
      use IO::Socket;
  
      my $sock = IO::Socket::INET->new('some_server');
      $sock->read($data, 1024) until $sock->atmark;
  
  Note: this is a reasonably new addition to the family of socket
  functions, so all systems may not support this yet.  If it is
  unsupported by the system, an attempt to use this method will
  abort the program.
  
  The atmark() functionality is also exportable as sockatmark() function:
  
  	use IO::Socket 'sockatmark';
  
  This allows for a more traditional use of sockatmark() as a procedural
  socket function.  If your system does not support sockatmark(), the
  C<use> declaration will fail at compile time.
  
  =item connected
  
  If the socket is in a connected state the peer address is returned.
  If the socket is not in a connected state then undef will be returned.
  
  =item protocol
  
  Returns the numerical number for the protocol being used on the socket, if
  known. If the protocol is unknown, as with an AF_UNIX socket, zero
  is returned.
  
  =item sockdomain
  
  Returns the numerical number for the socket domain type. For example, for
  an AF_INET socket the value of &AF_INET will be returned.
  
  =item sockopt(OPT [, VAL])
  
  Unified method to both set and get options in the SOL_SOCKET level. If called
  with one argument then getsockopt is called, otherwise setsockopt is called.
  
  =item socktype
  
  Returns the numerical number for the socket type. For example, for
  a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
  
  =item timeout([VAL])
  
  Set or get the timeout value associated with this socket. If called without
  any arguments then the current setting is returned. If called with an argument
  the current setting is changed and the previous value returned.
  
  =back
  
  =head1 SEE ALSO
  
  L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
  
  =head1 AUTHOR
  
  Graham Barr.  atmark() by Lincoln Stein.  Currently maintained by the
  Perl Porters.  Please report all bugs to <perl5-porters@perl.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-8 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.
  
  The atmark() implementation: Copyright 2001, Lincoln Stein <lstein@cshl.org>.
  This module is distributed under the same terms as Perl itself.
  Feel free to use, modify and redistribute it as long as you retain
  the correct attribution.
  
  =cut
DARWIN-2LEVEL_IO_SOCKET

$fatpacked{"darwin-2level/IO/Socket/INET.pm"} = <<'DARWIN-2LEVEL_IO_SOCKET_INET';
  # IO::Socket::INET.pm
  #
  # Copyright (c) 1997-8 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 IO::Socket::INET;
  
  use strict;
  our(@ISA, $VERSION);
  use IO::Socket;
  use Socket;
  use Carp;
  use Exporter;
  use Errno;
  
  @ISA = qw(IO::Socket);
  $VERSION = "1.31";
  
  my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
  
  IO::Socket::INET->register_domain( AF_INET );
  
  my %socket_type = ( tcp  => SOCK_STREAM,
  		    udp  => SOCK_DGRAM,
  		    icmp => SOCK_RAW
  		  );
  my %proto_number;
  $proto_number{tcp}  = Socket::IPPROTO_TCP()  if defined &Socket::IPPROTO_TCP;
  $proto_number{udp}  = Socket::IPPROTO_UDP()  if defined &Socket::IPPROTO_UDP;
  $proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
  my %proto_name = reverse %proto_number;
  
  sub new {
      my $class = shift;
      unshift(@_, "PeerAddr") if @_ == 1;
      return $class->SUPER::new(@_);
  }
  
  sub _cache_proto {
      my @proto = @_;
      for (map lc($_), $proto[0], split(' ', $proto[1])) {
  	$proto_number{$_} = $proto[2];
      }
      $proto_name{$proto[2]} = $proto[0];
  }
  
  sub _get_proto_number {
      my $name = lc(shift);
      return undef unless defined $name;
      return $proto_number{$name} if exists $proto_number{$name};
  
      my @proto = getprotobyname($name);
      return undef unless @proto;
      _cache_proto(@proto);
  
      return $proto[2];
  }
  
  sub _get_proto_name {
      my $num = shift;
      return undef unless defined $num;
      return $proto_name{$num} if exists $proto_name{$num};
  
      my @proto = getprotobynumber($num);
      return undef unless @proto;
      _cache_proto(@proto);
  
      return $proto[0];
  }
  
  sub _sock_info {
    my($addr,$port,$proto) = @_;
    my $origport = $port;
    my @serv = ();
  
    $port = $1
  	if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
  
    if(defined $proto  && $proto =~ /\D/) {
      my $num = _get_proto_number($proto);
      unless (defined $num) {
        $@ = "Bad protocol '$proto'";
        return;
      }
      $proto = $num;
    }
  
    if(defined $port) {
      my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
      my $pnum = ($port =~ m,^(\d+)$,)[0];
  
      @serv = getservbyname($port, _get_proto_name($proto) || "")
  	if ($port =~ m,\D,);
  
      $port = $serv[2] || $defport || $pnum;
      unless (defined $port) {
  	$@ = "Bad service '$origport'";
  	return;
      }
  
      $proto = _get_proto_number($serv[3]) if @serv && !$proto;
    }
  
   return ($addr || undef,
  	 $port || undef,
  	 $proto || undef
  	);
  }
  
  sub _error {
      my $sock = shift;
      my $err = shift;
      {
        local($!);
        my $title = ref($sock).": ";
        $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
        $sock->close()
  	if(defined fileno($sock));
      }
      $! = $err;
      return undef;
  }
  
  sub _get_addr {
      my($sock,$addr_str, $multi) = @_;
      my @addr;
      if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
  	(undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
      } else {
  	my $h = inet_aton($addr_str);
  	push(@addr, $h) if defined $h;
      }
      @addr;
  }
  
  sub configure {
      my($sock,$arg) = @_;
      my($lport,$rport,$laddr,$raddr,$proto,$type);
  
  
      $arg->{LocalAddr} = $arg->{LocalHost}
  	if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
  
      ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
  					$arg->{LocalPort},
  					$arg->{Proto})
  			or return _error($sock, $!, $@);
  
      $laddr = defined $laddr ? inet_aton($laddr)
  			    : INADDR_ANY;
  
      return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
  	unless(defined $laddr);
  
      $arg->{PeerAddr} = $arg->{PeerHost}
  	if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
  
      unless(exists $arg->{Listen}) {
  	($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
  					    $arg->{PeerPort},
  					    $proto)
  			or return _error($sock, $!, $@);
      }
  
      $proto ||= _get_proto_number('tcp');
  
      $type = $arg->{Type} || $socket_type{lc _get_proto_name($proto)};
  
      my @raddr = ();
  
      if(defined $raddr) {
  	@raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
  	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
  	    unless @raddr;
      }
  
      while(1) {
  
  	$sock->socket(AF_INET, $type, $proto) or
  	    return _error($sock, $!, "$!");
  
          if (defined $arg->{Blocking}) {
  	    defined $sock->blocking($arg->{Blocking})
  		or return _error($sock, $!, "$!");
  	}
  
  	if ($arg->{Reuse} || $arg->{ReuseAddr}) {
  	    $sock->sockopt(SO_REUSEADDR,1) or
  		    return _error($sock, $!, "$!");
  	}
  
  	if ($arg->{ReusePort}) {
  	    $sock->sockopt(SO_REUSEPORT,1) or
  		    return _error($sock, $!, "$!");
  	}
  
  	if ($arg->{Broadcast}) {
  		$sock->sockopt(SO_BROADCAST,1) or
  		    return _error($sock, $!, "$!");
  	}
  
  	if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
  	    $sock->bind($lport || 0, $laddr) or
  		    return _error($sock, $!, "$!");
  	}
  
  	if(exists $arg->{Listen}) {
  	    $sock->listen($arg->{Listen} || 5) or
  		return _error($sock, $!, "$!");
  	    last;
  	}
  
   	# don't try to connect unless we're given a PeerAddr
   	last unless exists($arg->{PeerAddr});
   
          $raddr = shift @raddr;
  
  	return _error($sock, $EINVAL, 'Cannot determine remote port')
  		unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
  
  	last
  	    unless($type == SOCK_STREAM || defined $raddr);
  
  	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
  	    unless defined $raddr;
  
  #        my $timeout = ${*$sock}{'io_socket_timeout'};
  #        my $before = time() if $timeout;
  
  	undef $@;
          if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
  #            ${*$sock}{'io_socket_timeout'} = $timeout;
              return $sock;
          }
  
  	return _error($sock, $!, $@ || "Timeout")
  	    unless @raddr;
  
  #	if ($timeout) {
  #	    my $new_timeout = $timeout - (time() - $before);
  #	    return _error($sock,
  #                         (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
  #                         "Timeout") if $new_timeout <= 0;
  #	    ${*$sock}{'io_socket_timeout'} = $new_timeout;
  #        }
  
      }
  
      $sock;
  }
  
  sub connect {
      @_ == 2 || @_ == 3 or
         croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
      my $sock = shift;
      return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
  }
  
  sub bind {
      @_ == 2 || @_ == 3 or
         croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
      my $sock = shift;
      return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_))
  }
  
  sub sockaddr {
      @_ == 1 or croak 'usage: $sock->sockaddr()';
      my($sock) = @_;
      my $name = $sock->sockname;
      $name ? (sockaddr_in($name))[1] : undef;
  }
  
  sub sockport {
      @_ == 1 or croak 'usage: $sock->sockport()';
      my($sock) = @_;
      my $name = $sock->sockname;
      $name ? (sockaddr_in($name))[0] : undef;
  }
  
  sub sockhost {
      @_ == 1 or croak 'usage: $sock->sockhost()';
      my($sock) = @_;
      my $addr = $sock->sockaddr;
      $addr ? inet_ntoa($addr) : undef;
  }
  
  sub peeraddr {
      @_ == 1 or croak 'usage: $sock->peeraddr()';
      my($sock) = @_;
      my $name = $sock->peername;
      $name ? (sockaddr_in($name))[1] : undef;
  }
  
  sub peerport {
      @_ == 1 or croak 'usage: $sock->peerport()';
      my($sock) = @_;
      my $name = $sock->peername;
      $name ? (sockaddr_in($name))[0] : undef;
  }
  
  sub peerhost {
      @_ == 1 or croak 'usage: $sock->peerhost()';
      my($sock) = @_;
      my $addr = $sock->peeraddr;
      $addr ? inet_ntoa($addr) : undef;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  IO::Socket::INET - Object interface for AF_INET domain sockets
  
  =head1 SYNOPSIS
  
      use IO::Socket::INET;
  
  =head1 DESCRIPTION
  
  C<IO::Socket::INET> provides an object interface to creating and using sockets
  in the AF_INET domain. It is built upon the L<IO::Socket> interface and
  inherits all the methods defined by L<IO::Socket>.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new ( [ARGS] )
  
  Creates an C<IO::Socket::INET> object, which is a reference to a
  newly created symbol (see the C<Symbol> package). C<new>
  optionally takes arguments, these arguments are in key-value pairs.
  
  In addition to the key-value pairs accepted by L<IO::Socket>,
  C<IO::Socket::INET> provides.
  
  
      PeerAddr	Remote host address          <hostname>[:<port>]
      PeerHost	Synonym for PeerAddr
      PeerPort	Remote port or service       <service>[(<no>)] | <no>
      LocalAddr	Local host bind	address      hostname[:port]
      LocalHost	Synonym for LocalAddr
      LocalPort	Local host bind	port         <service>[(<no>)] | <no>
      Proto	Protocol name (or number)    "tcp" | "udp" | ...
      Type	Socket type                  SOCK_STREAM | SOCK_DGRAM | ...
      Listen	Queue size for listen
      ReuseAddr	Set SO_REUSEADDR before binding
      Reuse	Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr)
      ReusePort	Set SO_REUSEPORT before binding
      Broadcast	Set SO_BROADCAST before binding
      Timeout	Timeout	value for various operations
      MultiHomed  Try all addresses for multi-homed hosts
      Blocking    Determine if connection will be blocking mode
  
  If C<Listen> is defined then a listen socket is created, else if the
  socket type, which is derived from the protocol, is SOCK_STREAM then
  connect() is called.
  
  Although it is not illegal, the use of C<MultiHomed> on a socket
  which is in non-blocking mode is of little use. This is because the
  first connect will never fail with a timeout as the connect call
  will not block.
  
  The C<PeerAddr> can be a hostname or the IP-address on the
  "xx.xx.xx.xx" form.  The C<PeerPort> can be a number or a symbolic
  service name.  The service name might be followed by a number in
  parenthesis which is used if the service is not known by the system.
  The C<PeerPort> specification can also be embedded in the C<PeerAddr>
  by preceding it with a ":".
  
  If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
  then the constructor will try to derive C<Proto> from the service
  name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
  parameter will be deduced from C<Proto> if not specified.
  
  If the constructor is only passed a single argument, it is assumed to
  be a C<PeerAddr> specification.
  
  If C<Blocking> is set to 0, the connection will be in nonblocking mode.
  If not specified it defaults to 1 (blocking mode).
  
  Examples:
  
     $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
                                   PeerPort => 'http(80)',
                                   Proto    => 'tcp');
  
     $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
  
     $sock = IO::Socket::INET->new(Listen    => 5,
                                   LocalAddr => 'localhost',
                                   LocalPort => 9000,
                                   Proto     => 'tcp');
  
     $sock = IO::Socket::INET->new('127.0.0.1:25');
  
     $sock = IO::Socket::INET->new(PeerPort  => 9999,
                                   PeerAddr  => inet_ntoa(INADDR_BROADCAST),
                                   Proto     => udp,    
                                   LocalAddr => 'localhost',
                                   Broadcast => 1 ) 
                               or die "Can't bind : $@\n";
  
   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  
  As of VERSION 1.18 all IO::Socket objects have autoflush turned on
  by default. This was not the case with earlier releases.
  
   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  
  =back
  
  =head2 METHODS
  
  =over 4
  
  =item sockaddr ()
  
  Return the address part of the sockaddr structure for the socket
  
  =item sockport ()
  
  Return the port number that the socket is using on the local host
  
  =item sockhost ()
  
  Return the address part of the sockaddr structure for the socket in a
  text form xx.xx.xx.xx
  
  =item peeraddr ()
  
  Return the address part of the sockaddr structure for the socket on
  the peer host
  
  =item peerport ()
  
  Return the port number for the socket on the peer host.
  
  =item peerhost ()
  
  Return the address part of the sockaddr structure for the socket on the
  peer host in a text form xx.xx.xx.xx
  
  =back
  
  =head1 SEE ALSO
  
  L<Socket>, L<IO::Socket>
  
  =head1 AUTHOR
  
  Graham Barr. Currently maintained by the Perl Porters.  Please report all
  bugs to <perl5-porters@perl.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1996-8 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.
  
  =cut
DARWIN-2LEVEL_IO_SOCKET_INET

$fatpacked{"darwin-2level/IO/Socket/UNIX.pm"} = <<'DARWIN-2LEVEL_IO_SOCKET_UNIX';
  # IO::Socket::UNIX.pm
  #
  # Copyright (c) 1997-8 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 IO::Socket::UNIX;
  
  use strict;
  our(@ISA, $VERSION);
  use IO::Socket;
  use Carp;
  
  @ISA = qw(IO::Socket);
  $VERSION = "1.23";
  $VERSION = eval $VERSION;
  
  IO::Socket::UNIX->register_domain( AF_UNIX );
  
  sub new {
      my $class = shift;
      unshift(@_, "Peer") if @_ == 1;
      return $class->SUPER::new(@_);
  }
  
  sub configure {
      my($sock,$arg) = @_;
      my($bport,$cport);
  
      my $type = $arg->{Type} || SOCK_STREAM;
  
      $sock->socket(AF_UNIX, $type, 0) or
  	return undef;
  
      if(exists $arg->{Local}) {
  	my $addr = sockaddr_un($arg->{Local});
  	$sock->bind($addr) or
  	    return undef;
      }
      if(exists $arg->{Listen} && $type != SOCK_DGRAM) {
  	$sock->listen($arg->{Listen} || 5) or
  	    return undef;
      }
      elsif(exists $arg->{Peer}) {
  	my $addr = sockaddr_un($arg->{Peer});
  	$sock->connect($addr) or
  	    return undef;
      }
  
      $sock;
  }
  
  sub hostpath {
      @_ == 1 or croak 'usage: $sock->hostpath()';
      my $n = $_[0]->sockname || return undef;
      (sockaddr_un($n))[0];
  }
  
  sub peerpath {
      @_ == 1 or croak 'usage: $sock->peerpath()';
      my $n = $_[0]->peername || return undef;
      (sockaddr_un($n))[0];
  }
  
  1; # Keep require happy
  
  __END__
  
  =head1 NAME
  
  IO::Socket::UNIX - Object interface for AF_UNIX domain sockets
  
  =head1 SYNOPSIS
  
      use IO::Socket::UNIX;
  
  =head1 DESCRIPTION
  
  C<IO::Socket::UNIX> provides an object interface to creating and using sockets
  in the AF_UNIX domain. It is built upon the L<IO::Socket> interface and
  inherits all the methods defined by L<IO::Socket>.
  
  =head1 CONSTRUCTOR
  
  =over 4
  
  =item new ( [ARGS] )
  
  Creates an C<IO::Socket::UNIX> object, which is a reference to a
  newly created symbol (see the C<Symbol> package). C<new>
  optionally takes arguments, these arguments are in key-value pairs.
  
  In addition to the key-value pairs accepted by L<IO::Socket>,
  C<IO::Socket::UNIX> provides.
  
      Type    	Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
      Local   	Path to local fifo
      Peer    	Path to peer fifo
      Listen  	Create a listen socket
  
  If the constructor is only passed a single argument, it is assumed to
  be a C<Peer> specification.
  
  
   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  
  As of VERSION 1.18 all IO::Socket objects have autoflush turned on
  by default. This was not the case with earlier releases.
  
   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  
  =back
  
  =head1 METHODS
  
  =over 4
  
  =item hostpath()
  
  Returns the pathname to the fifo at the local end
  
  =item peerpath()
  
  Returns the pathanme to the fifo at the peer end
  
  =back
  
  =head1 SEE ALSO
  
  L<Socket>, L<IO::Socket>
  
  =head1 AUTHOR
  
  Graham Barr. Currently maintained by the Perl Porters.  Please report all
  bugs to <perl5-porters@perl.org>.
  
  =head1 COPYRIGHT
  
  Copyright (c) 1996-8 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.
  
  =cut
DARWIN-2LEVEL_IO_SOCKET_UNIX

$fatpacked{"darwin-2level/List/Util.pm"} = <<'DARWIN-2LEVEL_LIST_UTIL';
  # List::Util.pm
  #
  # Copyright (c) 1997-2009 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.
  #
  # This module is normally only loaded if the XS module is not available
  
  package List::Util;
  
  use strict;
  require Exporter;
  
  our @ISA        = qw(Exporter);
  our @EXPORT_OK  = qw(first min max minstr maxstr reduce sum sum0 shuffle);
  our $VERSION    = "1.27";
  our $XS_VERSION = $VERSION;
  $VERSION    = eval $VERSION;
  
  require XSLoader;
  XSLoader::load('List::Util', $XS_VERSION);
  
  sub sum0
  {
     return 0 unless @_;
     goto &sum;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  List::Util - A selection of general-utility list subroutines
  
  =head1 SYNOPSIS
  
      use List::Util qw(first max maxstr min minstr reduce shuffle sum);
  
  =head1 DESCRIPTION
  
  C<List::Util> contains a selection of subroutines that people have
  expressed would be nice to have in the perl core, but the usage would
  not really be high enough to warrant the use of a keyword, and the size
  so small such that being individual extensions would be wasteful.
  
  By default C<List::Util> does not export any subroutines. The
  subroutines defined are
  
  =over 4
  
  =item first BLOCK LIST
  
  Similar to C<grep> in that it evaluates BLOCK setting C<$_> to each element
  of LIST in turn. C<first> returns the first element where the result from
  BLOCK is a true value. If BLOCK never returns true or LIST was empty then
  C<undef> is returned.
  
      $foo = first { defined($_) } @list    # first defined value in @list
      $foo = first { $_ > $value } @list    # first value in @list which
                                            # is greater than $value
  
  This function could be implemented using C<reduce> like this
  
      $foo = reduce { defined($a) ? $a : wanted($b) ? $b : undef } undef, @list
  
  for example wanted() could be defined() which would return the first
  defined value in @list
  
  =item max LIST
  
  Returns the entry in the list with the highest numerical value. If the
  list is empty then C<undef> is returned.
  
      $foo = max 1..10                # 10
      $foo = max 3,9,12               # 12
      $foo = max @bar, @baz           # whatever
  
  This function could be implemented using C<reduce> like this
  
      $foo = reduce { $a > $b ? $a : $b } 1..10
  
  =item maxstr LIST
  
  Similar to C<max>, but treats all the entries in the list as strings
  and returns the highest string as defined by the C<gt> operator.
  If the list is empty then C<undef> is returned.
  
      $foo = maxstr 'A'..'Z'          # 'Z'
      $foo = maxstr "hello","world"   # "world"
      $foo = maxstr @bar, @baz        # whatever
  
  This function could be implemented using C<reduce> like this
  
      $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'
  
  =item min LIST
  
  Similar to C<max> but returns the entry in the list with the lowest
  numerical value. If the list is empty then C<undef> is returned.
  
      $foo = min 1..10                # 1
      $foo = min 3,9,12               # 3
      $foo = min @bar, @baz           # whatever
  
  This function could be implemented using C<reduce> like this
  
      $foo = reduce { $a < $b ? $a : $b } 1..10
  
  =item minstr LIST
  
  Similar to C<min>, but treats all the entries in the list as strings
  and returns the lowest string as defined by the C<lt> operator.
  If the list is empty then C<undef> is returned.
  
      $foo = minstr 'A'..'Z'          # 'A'
      $foo = minstr "hello","world"   # "hello"
      $foo = minstr @bar, @baz        # whatever
  
  This function could be implemented using C<reduce> like this
  
      $foo = reduce { $a lt $b ? $a : $b } 'A'..'Z'
  
  =item reduce BLOCK LIST
  
  Reduces LIST by calling BLOCK, in a scalar context, multiple times,
  setting C<$a> and C<$b> each time. The first call will be with C<$a>
  and C<$b> set to the first two elements of the list, subsequent
  calls will be done by setting C<$a> to the result of the previous
  call and C<$b> to the next element in the list.
  
  Returns the result of the last call to BLOCK. If LIST is empty then
  C<undef> is returned. If LIST only contains one element then that
  element is returned and BLOCK is not executed.
  
      $foo = reduce { $a < $b ? $a : $b } 1..10       # min
      $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
      $foo = reduce { $a + $b } 1 .. 10               # sum
      $foo = reduce { $a . $b } @bar                  # concat
  
  If your algorithm requires that C<reduce> produce an identity value, then
  make sure that you always pass that identity value as the first argument to prevent
  C<undef> being returned
  
    $foo = reduce { $a + $b } 0, @values;             # sum with 0 identity value
  
  =item shuffle LIST
  
  Returns the elements of LIST in a random order
  
      @cards = shuffle 0..51      # 0..51 in a random order
  
  =item sum LIST
  
  Returns the sum of all the elements in LIST. If LIST is empty then
  C<undef> is returned.
  
      $foo = sum 1..10                # 55
      $foo = sum 3,9,12               # 24
      $foo = sum @bar, @baz           # whatever
  
  This function could be implemented using C<reduce> like this
  
      $foo = reduce { $a + $b } 1..10
  
  If your algorithm requires that C<sum> produce an identity of 0, then
  make sure that you always pass C<0> as the first argument to prevent
  C<undef> being returned
  
    $foo = sum 0, @values;
  
  =item sum0 LIST
  
  Similar to C<sum>, except this returns 0 when given an empty list, rather
  than C<undef>.
  
  =back
  
  =head1 KNOWN BUGS
  
  With perl versions prior to 5.005 there are some cases where reduce
  will return an incorrect result. This will show up as test 7 of
  reduce.t failing.
  
  =head1 SUGGESTED ADDITIONS
  
  The following are additions that have been requested, but I have been reluctant
  to add due to them being very simple to implement in perl
  
    # One argument is true
  
    sub any { $_ && return 1 for @_; 0 }
  
    # All arguments are true
  
    sub all { $_ || return 0 for @_; 1 }
  
    # All arguments are false
  
    sub none { $_ && return 0 for @_; 1 }
  
    # One argument is false
  
    sub notall { $_ || return 1 for @_; 0 }
  
    # How many elements are true
  
    sub true { scalar grep { $_ } @_ }
  
    # How many elements are false
  
    sub false { scalar grep { !$_ } @_ }
  
  =head1 SEE ALSO
  
  L<Scalar::Util>, L<List::MoreUtils>
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-2007 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.
  
  =cut
DARWIN-2LEVEL_LIST_UTIL

$fatpacked{"darwin-2level/List/Util/XS.pm"} = <<'DARWIN-2LEVEL_LIST_UTIL_XS';
  package List::Util::XS;
  use strict;
  use List::Util;
  
  our $VERSION = "1.27";       # FIXUP
  $VERSION = eval $VERSION;    # FIXUP
  
  1;
  __END__
  
  =head1 NAME
  
  List::Util::XS - Indicate if List::Util was compiled with a C compiler
  
  =head1 SYNOPSIS
  
      use List::Util::XS 1.20;
  
  =head1 DESCRIPTION
  
  C<List::Util::XS> can be used as a dependency to ensure List::Util was
  installed using a C compiler and that the XS version is installed.
  
  During installation C<$List::Util::XS::VERSION> will be set to
  C<undef> if the XS was not compiled.
  
  Starting with release 1.23_03, Scalar-List-Util is B<always> using
  the XS implementation, but for backwards compatibility, we still
  ship the C<List::Util::XS> module which just loads C<List::Util>.
  
  =head1 SEE ALSO
  
  L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2008 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.
  
  =cut
DARWIN-2LEVEL_LIST_UTIL_XS

$fatpacked{"darwin-2level/Scalar/Util.pm"} = <<'DARWIN-2LEVEL_SCALAR_UTIL';
  # Scalar::Util.pm
  #
  # Copyright (c) 1997-2007 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 Scalar::Util;
  
  use strict;
  require Exporter;
  require List::Util; # List::Util loads the XS
  
  our @ISA       = qw(Exporter);
  our @EXPORT_OK = qw(
    blessed
    dualvar
    isdual
    isvstring
    isweak
    looks_like_number
    openhandle
    readonly
    refaddr
    reftype
    set_prototype
    tainted
    weaken
  );
  our $VERSION    = "1.27";
  $VERSION   = eval $VERSION;
  
  our @EXPORT_FAIL;
  
  unless (defined &weaken) {
    push @EXPORT_FAIL, qw(weaken);
  }
  unless (defined &isweak) {
    push @EXPORT_FAIL, qw(isweak isvstring);
  }
  unless (defined &isvstring) {
    push @EXPORT_FAIL, qw(isvstring);
  }
  
  sub export_fail {
    if (grep { /^(?:weaken|isweak)$/ } @_ ) {
      require Carp;
      Carp::croak("Weak references are not implemented in the version of perl");
    }
  
    if (grep { /^isvstring$/ } @_ ) {
      require Carp;
      Carp::croak("Vstrings are not implemented in the version of perl");
    }
  
    @_;
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  Scalar::Util - A selection of general-utility scalar subroutines
  
  =head1 SYNOPSIS
  
      use Scalar::Util qw(blessed dualvar isdual readonly refaddr reftype
                          tainted weaken isweak isvstring looks_like_number
                          set_prototype);
                          # and other useful utils appearing below
  
  =head1 DESCRIPTION
  
  C<Scalar::Util> contains a selection of subroutines that people have
  expressed would be nice to have in the perl core, but the usage would
  not really be high enough to warrant the use of a keyword, and the size
  so small such that being individual extensions would be wasteful.
  
  By default C<Scalar::Util> does not export any subroutines. The
  subroutines defined are
  
  =over 4
  
  =item blessed EXPR
  
  If EXPR evaluates to a blessed reference the name of the package
  that it is blessed into is returned. Otherwise C<undef> is returned.
  
     $scalar = "foo";
     $class  = blessed $scalar;           # undef
  
     $ref    = [];
     $class  = blessed $ref;              # undef
  
     $obj    = bless [], "Foo";
     $class  = blessed $obj;              # "Foo"
  
  =item dualvar NUM, STRING
  
  Returns a scalar that has the value NUM in a numeric context and the
  value STRING in a string context.
  
      $foo = dualvar 10, "Hello";
      $num = $foo + 2;                    # 12
      $str = $foo . " world";             # Hello world
  
  =item isdual EXPR
  
  If EXPR is a scalar that is a dualvar, the result is true.
  
      $foo = dualvar 86, "Nix";
      $dual = isdual($foo);               # true
  
  Note that a scalar can be made to have both string and numeric content
  through numeric operations:
  
      $foo = "10";
      $dual = isdual($foo);               # false
      $bar = $foo + 0;
      $dual = isdual($foo);               # true
  
  Note that although C<$!> appears to be dual-valued variable, it is
  actually implemented using a tied scalar:
  
      $! = 1;
      print("$!\n");                      # "Operation not permitted"
      $dual = isdual($!);                 # false
  
  You can capture its numeric and string content using:
  
      $err = dualvar $!, $!;
      $dual = isdual($err);               # true
  
  =item isvstring EXPR
  
  If EXPR is a scalar which was coded as a vstring the result is true.
  
      $vs   = v49.46.48;
      $fmt  = isvstring($vs) ? "%vd" : "%s"; #true
      printf($fmt,$vs);
  
  =item looks_like_number EXPR
  
  Returns true if perl thinks EXPR is a number. See
  L<perlapi/looks_like_number>.
  
  =item openhandle FH
  
  Returns FH if FH may be used as a filehandle and is open, or FH is a tied
  handle. Otherwise C<undef> is returned.
  
      $fh = openhandle(*STDIN);           # \*STDIN
      $fh = openhandle(\*STDIN);          # \*STDIN
      $fh = openhandle(*NOTOPEN);         # undef
      $fh = openhandle("scalar");         # undef
  
  =item readonly SCALAR
  
  Returns true if SCALAR is readonly.
  
      sub foo { readonly($_[0]) }
  
      $readonly = foo($bar);              # false
      $readonly = foo(0);                 # true
  
  =item refaddr EXPR
  
  If EXPR evaluates to a reference the internal memory address of
  the referenced value is returned. Otherwise C<undef> is returned.
  
      $addr = refaddr "string";           # undef
      $addr = refaddr \$var;              # eg 12345678
      $addr = refaddr [];                 # eg 23456784
  
      $obj  = bless {}, "Foo";
      $addr = refaddr $obj;               # eg 88123488
  
  =item reftype EXPR
  
  If EXPR evaluates to a reference the type of the variable referenced
  is returned. Otherwise C<undef> is returned.
  
      $type = reftype "string";           # undef
      $type = reftype \$var;              # SCALAR
      $type = reftype [];                 # ARRAY
  
      $obj  = bless {}, "Foo";
      $type = reftype $obj;               # HASH
  
  =item set_prototype CODEREF, PROTOTYPE
  
  Sets the prototype of the given function, or deletes it if PROTOTYPE is
  undef. Returns the CODEREF.
  
      set_prototype \&foo, '$$';
  
  =item tainted EXPR
  
  Return true if the result of EXPR is tainted
  
      $taint = tainted("constant");       # false
      $taint = tainted($ENV{PWD});        # true if running under -T
  
  =item weaken REF
  
  REF will be turned into a weak reference. This means that it will not
  hold a reference count on the object it references. Also when the reference
  count on that object reaches zero, REF will be set to undef.
  
  This is useful for keeping copies of references , but you don't want to
  prevent the object being DESTROY-ed at its usual time.
  
      {
        my $var;
        $ref = \$var;
        weaken($ref);                     # Make $ref a weak reference
      }
      # $ref is now undef
  
  Note that if you take a copy of a scalar with a weakened reference,
  the copy will be a strong reference.
  
      my $var;
      my $foo = \$var;
      weaken($foo);                       # Make $foo a weak reference
      my $bar = $foo;                     # $bar is now a strong reference
  
  This may be less obvious in other situations, such as C<grep()>, for instance
  when grepping through a list of weakened references to objects that may have
  been destroyed already:
  
      @object = grep { defined } @object;
  
  This will indeed remove all references to destroyed objects, but the remaining
  references to objects will be strong, causing the remaining objects to never
  be destroyed because there is now always a strong reference to them in the
  @object array.
  
  =item isweak EXPR
  
  If EXPR is a scalar which is a weak reference the result is true.
  
      $ref  = \$foo;
      $weak = isweak($ref);               # false
      weaken($ref);
      $weak = isweak($ref);               # true
  
  B<NOTE>: Copying a weak reference creates a normal, strong, reference.
  
      $copy = $ref;
      $weak = isweak($copy);              # false
  
  =back
  
  =head1 DIAGNOSTICS
  
  Module use may give one of the following errors during import.
  
  =over
  
  =item Weak references are not implemented in the version of perl
  
  The version of perl that you are using does not implement weak references, to use
  C<isweak> or C<weaken> you will need to use a newer release of perl.
  
  =item Vstrings are not implemented in the version of perl
  
  The version of perl that you are using does not implement Vstrings, to use
  C<isvstring> you will need to use a newer release of perl.
  
  =item C<NAME> is only available with the XS version of Scalar::Util
  
  C<Scalar::Util> contains both perl and C implementations of many of its functions
  so that those without access to a C compiler may still use it. However some of the functions
  are only available when a C compiler was available to compile the XS version of the extension.
  
  At present that list is: weaken, isweak, dualvar, isvstring, set_prototype
  
  =back
  
  =head1 KNOWN BUGS
  
  There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will
  show up as tests 8 and 9 of dualvar.t failing
  
  =head1 SEE ALSO
  
  L<List::Util>
  
  =head1 COPYRIGHT
  
  Copyright (c) 1997-2007 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.
  
  Except weaken and isweak which are
  
  Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
  This program is free software; you can redistribute it and/or modify it
  under the same terms as perl itself.
  
  =cut
DARWIN-2LEVEL_SCALAR_UTIL

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

$fatpacked{"version/Requirements.pm"} = <<'VERSION_REQUIREMENTS';
  use strict;
  use warnings;
  package Version::Requirements;
  BEGIN {
    $Version::Requirements::VERSION = '0.101020';
  }
  # ABSTRACT: a set of version requirements for a CPAN dist
  
  
  use Carp ();
  use Scalar::Util ();
  use version 0.77 (); # the ->parse method
  
  
  sub new {
    my ($class) = @_;
    return bless {} => $class;
  }
  
  sub _version_object {
    my ($self, $version) = @_;
  
    $version = (! defined $version)                ? version->parse(0)
             : (! Scalar::Util::blessed($version)) ? version->parse($version)
             :                                       $version;
  
    return $version;
  }
  
  
  BEGIN {
    for my $type (qw(minimum maximum exclusion exact_version)) {
      my $method = "with_$type";
      my $to_add = $type eq 'exact_version' ? $type : "add_$type";
  
      my $code = sub {
        my ($self, $name, $version) = @_;
  
        $version = $self->_version_object( $version );
  
        $self->__modify_entry_for($name, $method, $version);
  
        return $self;
      };
      
      no strict 'refs';
      *$to_add = $code;
    }
  }
  
  
  sub add_requirements {
    my ($self, $req) = @_;
  
    for my $module ($req->required_modules) {
      my $modifiers = $req->__entry_for($module)->as_modifiers;
      for my $modifier (@$modifiers) {
        my ($method, @args) = @$modifier;
        $self->$method($module => @args);
      };
    }
  
    return $self;
  }
  
  
  sub accepts_module {
    my ($self, $module, $version) = @_;
  
    $version = $self->_version_object( $version );
  
    return 1 unless my $range = $self->__entry_for($module);
    return $range->_accepts($version);
  }
  
  
  sub clear_requirement {
    my ($self, $module) = @_;
  
    return $self unless $self->__entry_for($module);
  
    Carp::confess("can't clear requirements on finalized requirements")
      if $self->is_finalized;
  
    delete $self->{requirements}{ $module };
  
    return $self;
  }
  
  
  sub required_modules { keys %{ $_[0]{requirements} } }
  
  
  sub clone {
    my ($self) = @_;
    my $new = (ref $self)->new;
  
    return $new->add_requirements($self);
  }
  
  sub __entry_for     { $_[0]{requirements}{ $_[1] } }
  
  sub __modify_entry_for {
    my ($self, $name, $method, $version) = @_;
  
    my $fin = $self->is_finalized;
    my $old = $self->__entry_for($name);
  
    Carp::confess("can't add new requirements to finalized requirements")
      if $fin and not $old;
  
    my $new = ($old || 'Version::Requirements::_Range::Range')
            ->$method($version);
  
    Carp::confess("can't modify finalized requirements")
      if $fin and $old->as_string ne $new->as_string;
  
    $self->{requirements}{ $name } = $new;
  }
  
  
  sub is_simple {
    my ($self) = @_;
    for my $module ($self->required_modules) {
      # XXX: This is a complete hack, but also entirely correct.
      return if $self->__entry_for($module)->as_string =~ /\s/;
    }
  
    return 1;
  }
  
  
  sub is_finalized { $_[0]{finalized} }
  
  
  sub finalize { $_[0]{finalized} = 1 }
  
  
  sub as_string_hash {
    my ($self) = @_;
  
    my %hash = map {; $_ => $self->{requirements}{$_}->as_string }
               $self->required_modules;
  
    return \%hash;
  }
  
  
  my %methods_for_op = (
    '==' => [ qw(exact_version) ],
    '!=' => [ qw(add_exclusion) ],
    '>=' => [ qw(add_minimum)   ],
    '<=' => [ qw(add_maximum)   ],
    '>'  => [ qw(add_minimum add_exclusion) ],
    '<'  => [ qw(add_maximum add_exclusion) ],
  );
  
  sub from_string_hash {
    my ($class, $hash) = @_;
  
    my $self = $class->new;
  
    for my $module (keys %$hash) {
      my @parts = split qr{\s*,\s*}, $hash->{ $module };
      for my $part (@parts) {
        my ($op, $ver) = split /\s+/, $part, 2;
  
        if (! defined $ver) {
          $self->add_minimum($module => $op);
        } else {
          Carp::confess("illegal requirement string: $hash->{ $module }")
            unless my $methods = $methods_for_op{ $op };
  
          $self->$_($module => $ver) for @$methods;
        }
      }
    }
  
    return $self;
  }
  
  ##############################################################
  
  {
    package
      Version::Requirements::_Range::Exact;
  BEGIN {
    $Version::Requirements::_Range::Exact::VERSION = '0.101020';
  }
    sub _new     { bless { version => $_[1] } => $_[0] }
  
    sub _accepts { return $_[0]{version} == $_[1] }
  
    sub as_string { return "== $_[0]{version}" }
  
    sub as_modifiers { return [ [ exact_version => $_[0]{version} ] ] }
  
    sub _clone {
      (ref $_[0])->_new( version->new( $_[0]{version} ) )
    }
  
    sub with_exact_version {
      my ($self, $version) = @_;
  
      return $self->_clone if $self->_accepts($version);
  
      Carp::confess("illegal requirements: unequal exact version specified");
    }
  
    sub with_minimum {
      my ($self, $minimum) = @_;
      return $self->_clone if $self->{version} >= $minimum;
      Carp::confess("illegal requirements: minimum above exact specification");
    }
  
    sub with_maximum {
      my ($self, $maximum) = @_;
      return $self->_clone if $self->{version} <= $maximum;
      Carp::confess("illegal requirements: maximum below exact specification");
    }
  
    sub with_exclusion {
      my ($self, $exclusion) = @_;
      return $self->_clone unless $exclusion == $self->{version};
      Carp::confess("illegal requirements: excluded exact specification");
    }
  }
  
  ##############################################################
  
  {
    package
      Version::Requirements::_Range::Range;
  BEGIN {
    $Version::Requirements::_Range::Range::VERSION = '0.101020';
  }
  
    sub _self { ref($_[0]) ? $_[0] : (bless { } => $_[0]) }
  
    sub _clone {
      return (bless { } => $_[0]) unless ref $_[0];
  
      my ($s) = @_;
      my %guts = (
        (exists $s->{minimum} ? (minimum => version->new($s->{minimum})) : ()),
        (exists $s->{maximum} ? (maximum => version->new($s->{maximum})) : ()),
  
        (exists $s->{exclusions}
          ? (exclusions => [ map { version->new($_) } @{ $s->{exclusions} } ])
          : ()),
      );
  
      bless \%guts => ref($s);
    }
  
    sub as_modifiers {
      my ($self) = @_;
      my @mods;
      push @mods, [ add_minimum => $self->{minimum} ] if exists $self->{minimum};
      push @mods, [ add_maximum => $self->{maximum} ] if exists $self->{maximum};
      push @mods, map {; [ add_exclusion => $_ ] } @{$self->{exclusions} || []};
      return \@mods;
    }
  
    sub as_string {
      my ($self) = @_;
  
      return 0 if ! keys %$self;
  
      return "$self->{minimum}" if (keys %$self) == 1 and exists $self->{minimum};
  
      my @exclusions = @{ $self->{exclusions} || [] };
  
      my @parts;
  
      for my $pair (
        [ qw( >= > minimum ) ],
        [ qw( <= < maximum ) ],
      ) {
        my ($op, $e_op, $k) = @$pair;
        if (exists $self->{$k}) {
          my @new_exclusions = grep { $_ != $self->{ $k } } @exclusions;
          if (@new_exclusions == @exclusions) {
            push @parts, "$op $self->{ $k }";
          } else {
            push @parts, "$e_op $self->{ $k }";
            @exclusions = @new_exclusions;
          }
        }
      }
  
      push @parts, map {; "!= $_" } @exclusions;
  
      return join q{, }, @parts;
    }
  
    sub with_exact_version {
      my ($self, $version) = @_;
      $self = $self->_clone;
  
      Carp::confess("illegal requirements: exact specification outside of range")
        unless $self->_accepts($version);
  
      return Version::Requirements::_Range::Exact->_new($version);
    }
  
    sub _simplify {
      my ($self) = @_;
  
      if (defined $self->{minimum} and defined $self->{maximum}) {
        if ($self->{minimum} == $self->{maximum}) {
          Carp::confess("illegal requirements: excluded all values")
            if grep { $_ == $self->{minimum} } @{ $self->{exclusions} || [] };
  
          return Version::Requirements::_Range::Exact->_new($self->{minimum})
        }
  
        Carp::confess("illegal requirements: minimum exceeds maximum")
          if $self->{minimum} > $self->{maximum};
      }
  
      # eliminate irrelevant exclusions
      if ($self->{exclusions}) {
        my %seen;
        @{ $self->{exclusions} } = grep {
          (! defined $self->{minimum} or $_ >= $self->{minimum})
          and
          (! defined $self->{maximum} or $_ <= $self->{maximum})
          and
          ! $seen{$_}++
        } @{ $self->{exclusions} };
      }
  
      return $self;
    }
  
    sub with_minimum {
      my ($self, $minimum) = @_;
      $self = $self->_clone;
  
      if (defined (my $old_min = $self->{minimum})) {
        $self->{minimum} = (sort { $b cmp $a } ($minimum, $old_min))[0];
      } else {
        $self->{minimum} = $minimum;
      }
  
      return $self->_simplify;
    }
  
    sub with_maximum {
      my ($self, $maximum) = @_;
      $self = $self->_clone;
  
      if (defined (my $old_max = $self->{maximum})) {
        $self->{maximum} = (sort { $a cmp $b } ($maximum, $old_max))[0];
      } else {
        $self->{maximum} = $maximum;
      }
  
      return $self->_simplify;
    }
  
    sub with_exclusion {
      my ($self, $exclusion) = @_;
      $self = $self->_clone;
  
      push @{ $self->{exclusions} ||= [] }, $exclusion;
  
      return $self->_simplify;
    }
  
    sub _accepts {
      my ($self, $version) = @_;
  
      return if defined $self->{minimum} and $version < $self->{minimum};
      return if defined $self->{maximum} and $version > $self->{maximum};
      return if defined $self->{exclusions}
            and grep { $version == $_ } @{ $self->{exclusions} };
  
      return 1;
    }
  }
  
  1;
  
  __END__
  =pod
  
  =head1 NAME
  
  Version::Requirements - a set of version requirements for a CPAN dist
  
  =head1 VERSION
  
  version 0.101020
  
  =head1 SYNOPSIS
  
    use Version::Requirements;
  
    my $build_requires = Version::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 Version::Requirements object models a set of version constraints like those
  specified in the F<META.yml> or F<META.json> files in CPAN distributions.  It
  can be built up by adding more and more constraints, and it will reduce them to
  the simplest representation.
  
  Logically impossible constraints will be identified immediately by thrown
  exceptions.
  
  =head1 METHODS
  
  =head2 new
  
    my $req = Version::Requirements->new;
  
  This returns a new Version::Requirements object.  It ignores any arguments
  given.
  
  =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 Version::Requirements object
  to the requirements object on which it was called.  If there are any conflicts,
  an exception is thrown.
  
  This method returns the requirements object.
  
  =head2 accepts_module
  
    my $bool = $req->accepts_modules($module => $version);
  
  Given an module and version, this method returns true if the version
  specification for the module accepts the provided version.  In other words,
  given:
  
    Module => '>= 1.00, < 2.00'
  
  We will accept 1.00 and 1.75 but not 0.50 or 2.00.
  
  For modules that do not appear in the requirements, this method will return
  true.
  
  =head2 clear_requirement
  
    $req->clear_requirement( $module );
  
  This removes the requirement for a given module from the object.
  
  This method returns the requirements object.
  
  =head2 required_modules
  
  This method returns a list of all the modules for which requirements have been
  specified.
  
  =head2 clone
  
    $req->clone;
  
  This method returns a clone of the invocant.  The clone and the original object
  can then be changed independent of one another.
  
  =head2 is_simple
  
  This method returns true if and only if all requirements are inclusive minimums
  -- that is, if their string expression is just the version number.
  
  =head2 is_finalized
  
  This method returns true if the requirements have been finalized by having the
  C<finalize> method called on them.
  
  =head2 finalize
  
  This method marks the requirements finalized.  Subsequent attempts to change
  the requirements will be fatal, I<if> they would result in a change.  If they
  would not alter the requirements, they have no effect.
  
  If a finalized set of requirements is cloned, the cloned requirements are not
  also finalized.
  
  =head2 as_string_hash
  
  This returns a reference to a hash describing the requirements using the
  strings in the F<META.yml> specification.
  
  For example after the following program:
  
    my $req = Version::Requirements->new;
  
    $req->add_minimum('Version::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:
  
    {
      'Version::Requirements' => '0.102',
      'Library::Foo' => '>= 1.208, <= 2.206',
      'Module::Bar'  => '>= v1.2.3, != v1.2.8',
      'Xyzzy'        => '== 6.01',
    }
  
  =head2 from_string_hash
  
    my $req = Version::Requirements->from_string_hash( \%hash );
  
  This is an alternate constructor for a Version::Requirements object.  It takes
  a hash of module names and version requirement strings and returns a new
  Version::Requirements object.
  
  =head1 AUTHOR
  
    Ricardo Signes <rjbs@cpan.org>
  
  =head1 COPYRIGHT AND LICENSE
  
  This software is copyright (c) 2010 by 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
  
VERSION_REQUIREMENTS

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

s/^  //mg for values %fatpacked;

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

} # END OF FATPACK CODE
#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib/";
use Perl::Build;
use Getopt::Long;
use Pod::Usage;
use File::Spec;

my $test = undef;
my $patches;
my (@D, @A, @U);
Getopt::Long::Configure(
    'pass_through',
    'no_ignore_case',
    'bundling',
);
GetOptions(
    'test' => \$test,
    'D=s@' => \@D,
    'A=s@' => \@A,
    'U=s@' => \@U,
    'patches=s' => \$patches,
);
for (@D, @A, @U) {
    s/^=//;
}

shift @ARGV if @ARGV >= 1 && $ARGV[0] eq '--';

my $stuff   = shift @ARGV or pod2usage();
my $dest    = shift @ARGV or pod2usage();
   $dest    = File::Spec->rel2abs($dest);

my @configure_options = @ARGV ? @ARGV : ('-de');
push @configure_options, map { "-D$_" } @D;
push @configure_options, map { "-A$_" } @A;
push @configure_options, map { "-U$_" } @U;

$ENV{PERL5_PATCHPERL_PLUGIN} = $patches if defined $patches;

if ($stuff =~ /\.(gz|bz2)$/) {
    Perl::Build->install_from_tarball(
        $stuff => (
            dst_path          => $dest,
            configure_options => \@configure_options,
            test              => $test,
        )
    );
} else {
    my $version = $stuff;
    Perl::Build->install_from_cpan(
        $version => (
            dst_path          => $dest,
            configure_options => \@configure_options,
            test              => $test,
        )
    );
}

__END__

=head1 NAME

perl-build - perl binary builder

=head1 SYNOPSIS 

    # perl-build command is FatPacker ready
    % curl https://raw.github.com/tokuhirom/Perl-Build/master/perl-build | perl - 5.16.2 /opt/perl-5.16/

    # Or, just install from CPAN
    % cpanm Perl::Build

    # And run it.
    % perl-build 5.16.2 /usr/local/perl-5.16.2
    % perl-build path/to/perl-5.16.2.tar.gz /usr/local/perl-5.16.2

=head1 DESCRIPTION

This script fetch/build/install perl5 from CPAN or tar ball.

=head1 OPTIONS

=over 4

=item -D, -A, -U

-Dxxx, -Axxx, -Uxxx options are pass through to ./Configure script.

=item --test

This option enables C<< make test >> after building.

(Default: disabled)

=item --patches=Asan

You can set I<PERL5_PATCHPERL_PLUGIN> environment variable by this option.

=back

=head1 FAQ

=over 4

=item How can I apply security fixes like CVE-2013-1667?

RURBAN provides L<Devel::PatchPerl::Plugin::Asan>. Install it and run C<< perl-build --patches=Asan 5.16.1 /opt/perl/5.16/ >>.

=back

=head1 SEE ALSO

L<perlbrew>, L<plenv>

