#!/usr/bin/env perl # # This is a pre-compiled source code for the cpanm (cpanminus) program. # For more details about how to install cpanm, go to the following URL: # # https://github.com/miyagawa/cpanminus # # Quickstart: Run the following command and it will install itself for # you. You might want to run it as a root with sudo if you want to install # to places like /usr/local/bin. # # % curl -L https://cpanmin.us | perl - App::cpanminus # # If you don't have curl but wget, replace `curl -L` with `wget -O -`. # DO NOT EDIT -- this is an auto generated file # This chunk of stuff was generated by App::FatPacker. To find the original # file's code, look for the end of this BEGIN block or the string 'FATPACK' BEGIN { my %fatpacked; $fatpacked{"Algorithm/C3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_C3'; package Algorithm::C3;use strict;use warnings;use Carp 'confess';our$VERSION='0.10';sub merge {my ($root,$parent_fetcher,$cache)=@_;$cache ||= {};my@STACK;my$pfetcher_is_coderef=ref($parent_fetcher)eq 'CODE';unless ($pfetcher_is_coderef or $root->can($parent_fetcher)){confess "Could not find method $parent_fetcher in $root"}my$current_root=$root;my$current_parents=[$root->$parent_fetcher ];my$recurse_mergeout=[];my$i=0;my%seen=($root=>1);my ($new_root,$mergeout,%tails);while(1){if($i < @$current_parents){$new_root=$current_parents->[$i++];if($seen{$new_root}){my@isastack;my$reached;for(my$i=0;$i < $#STACK;$i += 4){if($reached || ($reached=($STACK[$i]eq $new_root))){push(@isastack,$STACK[$i])}}my$isastack=join(q{ -> },@isastack,$current_root,$new_root);die "Infinite loop detected in parents of '$root': $isastack"}$seen{$new_root}=1;unless ($pfetcher_is_coderef or $new_root->can($parent_fetcher)){confess "Could not find method $parent_fetcher in $new_root"}push(@STACK,$current_root,$current_parents,$recurse_mergeout,$i);$current_root=$new_root;$current_parents=$cache->{pfetch}->{$current_root}||= [$current_root->$parent_fetcher ];$recurse_mergeout=[];$i=0;next}$seen{$current_root}=0;$mergeout=$cache->{merge}->{$current_root}||= do {my@seqs=map {[@$_]}@$recurse_mergeout;push(@seqs,[@$current_parents])if @$current_parents;for my$seq (@seqs){$tails{$seq->[$_]}++ for (1..$#$seq)}my@res=($current_root);while (1){my$cand;my$winner;for (@seqs){next if!@$_;if(!$winner){$cand=$_->[0];next if$tails{$cand};push@res=>$winner=$cand;shift @$_;$tails{$_->[0]}-- if @$_}elsif($_->[0]eq $winner){shift @$_;$tails{$_->[0]}-- if @$_}}last if!$cand;die q{Inconsistent hierarchy found while merging '} .$current_root .qq{':\n\t} .qq{current merge results [\n\t\t} .(join ",\n\t\t"=>@res).qq{\n\t]\n\t} .qq{merging failed on '$cand'\n} if!$winner}\@res};return @$mergeout if!@STACK;$i=pop(@STACK);$recurse_mergeout=pop(@STACK);$current_parents=pop(@STACK);$current_root=pop(@STACK);push(@$recurse_mergeout,$mergeout)}}1; ALGORITHM_C3 $fatpacked{"App/cpanminus.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS'; package App::cpanminus;our$VERSION="1.7907";1; APP_CPANMINUS $fatpacked{"App/cpanminus/script.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_SCRIPT'; package App::cpanminus::script;use strict;use base qw(Menlo::CLI::Compat);sub doit {my$self=shift;return$self->run}1; APP_CPANMINUS_SCRIPT $fatpacked{"CPAN/Common/Index.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX'; use 5.008001;use strict;use warnings;package CPAN::Common::Index;our$VERSION='0.010';use Carp ();use Class::Tiny;sub index_age {time}sub refresh_index {1}sub attributes {{}}sub validate_attributes {1}1; CPAN_COMMON_INDEX $fatpacked{"CPAN/Common/Index/LocalPackage.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_LOCALPACKAGE'; use 5.008001;use strict;use warnings;package CPAN::Common::Index::LocalPackage;our$VERSION='0.010';use parent 'CPAN::Common::Index::Mirror';use Class::Tiny qw/source/;use Carp;use File::Basename ();use File::Copy ();use File::Spec;use File::stat ();sub BUILD {my$self=shift;my$file=$self->source;if (!defined$file){Carp::croak("'source' parameter must be provided")}elsif (!-f $file){Carp::croak("index file '$file' does not exist")}return}sub cached_package {my ($self)=@_;my$package=File::Spec->catfile($self->cache,File::Basename::basename($self->source));$package =~ s/\.gz$//;$self->refresh_index unless -r $package;return$package}sub refresh_index {my ($self)=@_;my$source=$self->source;my$basename=File::Basename::basename($source);if ($source =~ /\.gz$/){Carp::croak "can't load gz source files without IO::Uncompress::Gunzip\n" unless$CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP;(my$uncompressed=$basename)=~ s/\.gz$//;$uncompressed=File::Spec->catfile($self->cache,$uncompressed);if (!-f $uncompressed or File::stat::stat($source)->mtime > File::stat::stat($uncompressed)->mtime){no warnings 'once';IO::Uncompress::Gunzip::gunzip(map {"$_"}$source,$uncompressed)or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"}}else {my$dest=File::Spec->catfile($self->cache,$basename);File::Copy::copy($source,$dest)if!-e $dest || File::stat::stat($source)->mtime > File::stat::stat($dest)->mtime}return 1}sub search_authors {return};1; CPAN_COMMON_INDEX_LOCALPACKAGE $fatpacked{"CPAN/Common/Index/MetaDB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_METADB'; use 5.008001;use strict;use warnings;package CPAN::Common::Index::MetaDB;our$VERSION='0.010';use parent 'CPAN::Common::Index';use Class::Tiny qw/uri/;use Carp;use CPAN::Meta::YAML;use HTTP::Tiny;sub BUILD {my$self=shift;my$uri=$self->uri;$uri="http://cpanmetadb.plackperl.org/v1.0/" unless defined$uri;$uri =~ s{/?$}{/};$self->uri($uri);return}sub search_packages {my ($self,$args)=@_;Carp::croak("Argument to search_packages must be hash reference")unless ref$args eq 'HASH';return unless keys %$args==1 && exists$args->{package}&& ref$args->{package}eq '';my$mod=$args->{package};my$res=HTTP::Tiny->new->get($self->uri ."package/$mod");return unless$res->{success};if (my$yaml=CPAN::Meta::YAML->read_string($res->{content})){my$meta=$yaml->[0];if ($meta && $meta->{distfile}){my$file=$meta->{distfile};$file =~ s{^./../}{};return {package=>$mod,version=>$meta->{version},uri=>"cpan:///distfile/$file",}}}return}sub index_age {return time};sub search_authors {return};1; CPAN_COMMON_INDEX_METADB $fatpacked{"CPAN/Common/Index/Mirror.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_MIRROR'; use 5.008001;use strict;use warnings;package CPAN::Common::Index::Mirror;our$VERSION='0.010';use parent 'CPAN::Common::Index';use Class::Tiny qw/cache mirror/;use Carp;use CPAN::DistnameInfo;use File::Basename ();use File::Fetch;use File::Temp 0.19;use Search::Dict 1.07;use Tie::Handle::SkipHeader;use URI;our$HAS_IO_UNCOMPRESS_GUNZIP=eval {require IO::Uncompress::Gunzip};sub BUILD {my$self=shift;my$cache=$self->cache;$cache=File::Temp->newdir unless defined$cache;if (!-d $cache){Carp::croak("Cache directory '$cache' does not exist")}$self->cache($cache);my$mirror=$self->mirror;$mirror="http://www.cpan.org/" unless defined$mirror;$mirror =~ s{/?$}{/};$self->mirror($mirror);return}my%INDICES=(mailrc=>'authors/01mailrc.txt.gz',packages=>'modules/02packages.details.txt.gz',);my%TEST_GENERATORS=(regexp_nocase=>sub {my$arg=shift;my$re=ref$arg eq 'Regexp' ? $arg : qr/\A\Q$arg\E\z/i;return sub {$_[0]=~ $re}},regexp=>sub {my$arg=shift;my$re=ref$arg eq 'Regexp' ? $arg : qr/\A\Q$arg\E\z/;return sub {$_[0]=~ $re}},version=>sub {my$arg=shift;my$v=version->parse($arg);return sub {eval {version->parse($_[0])==$v}}},);my%QUERY_TYPES=(package=>'regexp',version=>'version',dist=>'regexp',id=>'regexp_nocase',fullname=>'regexp_nocase',email=>'regexp_nocase',);sub cached_package {my ($self)=@_;my$package=File::Spec->catfile($self->cache,File::Basename::basename($INDICES{packages}));$package =~ s/\.gz$//;$self->refresh_index unless -r $package;return$package}sub cached_mailrc {my ($self)=@_;my$mailrc=File::Spec->catfile($self->cache,File::Basename::basename($INDICES{mailrc}));$mailrc =~ s/\.gz$//;$self->refresh_index unless -r $mailrc;return$mailrc}sub refresh_index {my ($self)=@_;for my$file (values%INDICES){my$remote=URI->new_abs($file,$self->mirror);$remote =~ s/\.gz$// unless$HAS_IO_UNCOMPRESS_GUNZIP;my$ff=File::Fetch->new(uri=>$remote);my$where=$ff->fetch(to=>$self->cache)or Carp::croak($ff->error);if ($HAS_IO_UNCOMPRESS_GUNZIP){(my$uncompressed=$where)=~ s/\.gz$//;no warnings 'once';IO::Uncompress::Gunzip::gunzip($where,$uncompressed)or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"}}return 1}sub index_age {my ($self)=@_;my$package=$self->cached_package;return (-r $package ? (stat($package))[9]: 0)}sub search_packages {my ($self,$args)=@_;Carp::croak("Argument to search_packages must be hash reference")unless ref$args eq 'HASH';my$index_path=$self->cached_package;die "Can't read $index_path" unless -r $index_path;my$fh=IO::Handle->new;tie *$fh,'Tie::Handle::SkipHeader',"<",$index_path or die "Can't tie $index_path: $!";my$rules;while (my ($k,$v)=each %$args){$rules->{$k}=_rulify($k,$v)}my@found;if ($args->{package}and ref$args->{package}eq ''){my$pos=look$fh,$args->{package},{xfrm=>\&_xform_package,fold=>1 };return if$pos==-1;LINE: while (my$line=<$fh>){last unless$line =~ /\A\Q$args->{package}\E\s+/i;push@found,_match_package_line($line,$rules)}}else {LINE: while (my$line=<$fh>){push@found,_match_package_line($line,$rules)}}return wantarray ? @found : $found[0]}sub search_authors {my ($self,$args)=@_;Carp::croak("Argument to search_authors must be hash reference")unless ref$args eq 'HASH';my$index_path=$self->cached_mailrc;die "Can't read $index_path" unless -r $index_path;open my$fh,$index_path or die "Can't open $index_path: $!";my$rules;while (my ($k,$v)=each %$args){$rules->{$k}=_rulify($k,$v)}my@found;if ($args->{id}and ref$args->{id}eq ''){my$pos=look$fh,$args->{id},{xfrm=>\&_xform_mailrc,fold=>1 };return if$pos==-1;my$line=<$fh>;push@found,_match_mailrc_line($line,$rules)}else {LINE: while (my$line=<$fh>){push@found,_match_mailrc_line($line,$rules)}}return wantarray ? @found : $found[0]}sub _rulify {my ($key,$arg)=@_;return$arg if ref($arg)eq 'CODE';return$TEST_GENERATORS{$QUERY_TYPES{$key}}->($arg)}sub _xform_package {my@fields=split " ",$_[0],2;return$fields[0]}sub _xform_mailrc {my@fields=split " ",$_[0],3;return$fields[1]}sub _match_package_line {my ($line,$rules)=@_;return unless defined$line;my ($mod,$version,$dist,$comment)=split " ",$line,4;if ($rules->{package}){return unless$rules->{package}->($mod)}if ($rules->{version}){return unless$rules->{version}->($version)}if ($rules->{dist}){return unless$rules->{dist}->($dist)}$dist =~ s{\A./../}{};return {package=>$mod,version=>$version,uri=>"cpan:///distfile/$dist",}}sub _match_mailrc_line {my ($line,$rules)=@_;return unless defined$line;my ($id,$address)=$line =~ m{\Aalias\s+(\S+)\s+"(.*)"};my ($fullname,$email)=$address =~ m{([^<]+)<([^>]+)>};$fullname =~ s/\s*$//;if ($rules->{id}){return unless$rules->{id}->($id)}if ($rules->{fullname}){return unless$rules->{fullname}->($fullname)}if ($rules->{email}){return unless$rules->{email}->($email)}return {id=>$id,fullname=>$fullname,email=>$email,}}1; CPAN_COMMON_INDEX_MIRROR $fatpacked{"CPAN/Common/Index/Mux/Ordered.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_COMMON_INDEX_MUX_ORDERED'; use 5.008001;use strict;use warnings;package CPAN::Common::Index::Mux::Ordered;our$VERSION='0.010';use parent 'CPAN::Common::Index';use Class::Tiny qw/resolvers/;use Module::Load ();sub BUILD {my$self=shift;my$resolvers=$self->resolvers;$resolvers=[]unless defined$resolvers;if (ref$resolvers ne 'ARRAY'){Carp::croak("The 'resolvers' argument must be an array reference")}for my$r (@$resolvers){if (!eval {$r->isa("CPAN::Common::Index")}){Carp::croak("Resolver '$r' is not a CPAN::Common::Index object")}}$self->resolvers($resolvers);return}sub assemble {my ($class,@backends)=@_;my@resolvers;while (@backends){my ($subclass,$config)=splice@backends,0,2;my$full_class="CPAN::Common::Index::${subclass}";eval {Module::Load::load($full_class);1}or Carp::croak($@);my$object=$full_class->new($config);push@resolvers,$object}return$class->new({resolvers=>\@resolvers })}sub validate_attributes {my ($self)=@_;my$resolvers=$self->resolvers;return 1}sub search_packages {my ($self,$args)=@_;Carp::croak("Argument to search_packages must be hash reference")unless ref$args eq 'HASH';my@found;if ($args->{name}and ref$args->{name}eq ''){for my$source (@{$self->resolvers}){if (my@result=$source->search_packages($args)){push@found,@result;last}}}else {my%seen;for my$source (@{$self->resolvers}){my@result=$source->search_packages($args);push@found,grep {!$seen{$_->{package}}++}@result}}return wantarray ? @found : $found[0]}sub search_authors {my ($self,$args)=@_;Carp::croak("Argument to search_authors must be hash reference")unless ref$args eq 'HASH';my@found;if ($args->{name}and ref$args->{name}eq ''){for my$source (@{$self->resolvers}){if (my@result=$source->search_authors($args)){push@found,@result;last}}}else {my%seen;for my$source (@{$self->resolvers}){my@result=$source->search_authors($args);push@found,grep {!$seen{$_->{package}}++}@result}}return wantarray ? @found : $found[0]}1; CPAN_COMMON_INDEX_MUX_ORDERED $fatpacked{"CPAN/DistnameInfo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_DISTNAMEINFO'; package CPAN::DistnameInfo;$VERSION="0.12";use strict;sub distname_info {my$file=shift or return;my ($dist,$version)=$file =~ /^ ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))* (?: [A-Za-z](?=[^A-Za-z]|$) | \d(?=-) )(? 6 and $1 & 1)or ($2 and $2 >= 50))or $3}elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/){$dev=1}}else {$version=undef}($dist,$version,$dev)}sub new {my$class=shift;my$distfile=shift;$distfile =~ s,//+,/,g;my%info=(pathname=>$distfile);($info{filename}=$distfile)=~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,, and $info{cpanid}=$6;if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i){$info{distvname}=$1;$info{extension}=$2}@info{qw(dist version beta)}=distname_info($info{distvname});$info{maturity}=delete$info{beta}? 'developer' : 'released';return bless \%info,$class}sub dist {shift->{dist}}sub version {shift->{version}}sub maturity {shift->{maturity}}sub filename {shift->{filename}}sub cpanid {shift->{cpanid}}sub distvname {shift->{distvname}}sub extension {shift->{extension}}sub pathname {shift->{pathname}}sub properties {%{$_[0]}}1; CPAN_DISTNAMEINFO $fatpacked{"CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META'; use 5.006;use strict;use warnings;package CPAN::Meta;our$VERSION='2.150010';use Carp qw(carp croak);use CPAN::Meta::Feature;use CPAN::Meta::Prereqs;use CPAN::Meta::Converter;use CPAN::Meta::Validator;use Parse::CPAN::Meta 1.4414 ();BEGIN {*_dclone=\&CPAN::Meta::Converter::_dclone}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}){my$cmc=CPAN::Meta::Converter->new($struct);$self=$cmc->convert(version=>2);return bless$self,$class}else {my$cmv=CPAN::Meta::Validator->new($struct);unless ($cmv->is_valid){die "Invalid metadata structure. Errors: " .join(", ",$cmv->errors)."\n"}}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 load_string {my ($class,$string,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};my$self;eval {my$struct=Parse::CPAN::Meta->load_string($string);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}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();local$struct->{x_serialization_backend}=sprintf '%s version %s',$backend,$backend->VERSION;$data=$backend->new->pretty->canonical->encode($struct)}else {$backend=Parse::CPAN::Meta->yaml_backend();local$struct->{x_serialization_backend}=sprintf '%s version %s',$backend,$backend->VERSION;$data=eval {no strict 'refs';&{"$backend\::Dump"}($struct)};if ($@){croak$backend->can('errstr')? $backend->errstr : $@}}return$data}sub TO_JSON {return {%{$_[0]}}}1; CPAN_META $fatpacked{"CPAN/Meta/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CHECK'; package CPAN::Meta::Check;$CPAN::Meta::Check::VERSION='0.014';use strict;use warnings;use base 'Exporter';our@EXPORT=qw//;our@EXPORT_OK=qw/check_requirements requirements_for verify_dependencies/;our%EXPORT_TAGS=(all=>[@EXPORT,@EXPORT_OK ]);use CPAN::Meta::Prereqs '2.132830';use CPAN::Meta::Requirements 2.121;use Module::Metadata 1.000023;sub _check_dep {my ($reqs,$module,$dirs)=@_;$module eq 'perl' and return ($reqs->accepts_module($module,$])? (): sprintf "Your Perl (%s) is not in the range '%s'",$],$reqs->requirements_for_module($module));my$metadata=Module::Metadata->new_from_module($module,inc=>$dirs);return "Module '$module' is not installed" if not defined$metadata;my$version=eval {$metadata->version};return sprintf 'Installed version (%s) of %s is not in range \'%s\'',(defined$version ? $version : 'undef'),$module,$reqs->requirements_for_module($module)if not $reqs->accepts_module($module,$version || 0);return}sub _check_conflict {my ($reqs,$module,$dirs)=@_;my$metadata=Module::Metadata->new_from_module($module,inc=>$dirs);return if not defined$metadata;my$version=eval {$metadata->version};return sprintf 'Installed version (%s) of %s is in range \'%s\'',(defined$version ? $version : 'undef'),$module,$reqs->requirements_for_module($module)if$reqs->accepts_module($module,$version);return}sub requirements_for {my ($meta,$phases,$type)=@_;my$prereqs=ref($meta)eq 'CPAN::Meta' ? $meta->effective_prereqs : $meta;return$prereqs->merged_requirements(ref($phases)? $phases : [$phases ],[$type ])}sub check_requirements {my ($reqs,$type,$dirs)=@_;return +{map {$_=>$type ne 'conflicts' ? scalar _check_dep($reqs,$_,$dirs): scalar _check_conflict($reqs,$_,$dirs)}$reqs->required_modules }}sub verify_dependencies {my ($meta,$phases,$type,$dirs)=@_;my$reqs=requirements_for($meta,$phases,$type);my$issues=check_requirements($reqs,$type,$dirs);return grep {defined}values %{$issues}}1; CPAN_META_CHECK $fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER'; use 5.006;use strict;use warnings;package CPAN::Meta::Converter;our$VERSION='2.150010';use CPAN::Meta::Validator;use CPAN::Meta::Requirements;use Parse::CPAN::Meta 1.4400 ();BEGIN {eval "use version ()";if (my$err=$@){eval "use ExtUtils::MakeMaker::version" or die$err}}*_is_qv=version->can('is_qv')? sub {$_[0]->is_qv}: sub {exists $_[0]->{qv}};our$DCLONE_MAXDEPTH=1024;our$_CLONE_DEPTH;sub _dclone {my ($ref)=@_;return$ref unless my$reftype=ref$ref;local$_CLONE_DEPTH=defined$_CLONE_DEPTH ? $_CLONE_DEPTH - 1 : $DCLONE_MAXDEPTH;die "Depth Limit $DCLONE_MAXDEPTH Exceeded" if$_CLONE_DEPTH==0;return [map {_dclone($_)}@{$ref}]if 'ARRAY' eq $reftype;return {map {$_=>_dclone($ref->{$_})}keys %{$ref}}if 'HASH' eq $reftype;if ('SCALAR' eq $reftype){my$new=_dclone(${$ref});return \$new}if (eval {$ref->can('TO_JSON')}){my$data=$ref->TO_JSON;return ref$data ? _dclone($data): $data}return "$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];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 || "");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;return$key}sub _ucfirst_custom {my$key=shift;$key=ucfirst$key unless$key =~ /[A-Z]/;return$key}sub _no_prefix_ucfirst_custom {my$key=shift;$key =~ s/^x_//;return _ucfirst_custom($key)}sub _change_meta_spec {my ($element,undef,undef,$version)=@_;return {version=>$version,url=>$known_specs{$version},}}my@open_source=('perl','gpl','apache','artistic','artistic_2','lgpl','bsd','gpl','mit','mozilla','open_source',);my%is_open_source=map {;$_=>1}@open_source;my@valid_licenses_1=(@open_source,'unrestricted','restrictive','unknown',);my%license_map_1=((map {$_=>$_}@valid_licenses_1),artistic2=>'artistic_2',);sub _license_1 {my ($element)=@_;return 'unknown' unless defined$element;if ($license_map_1{lc$element}){return$license_map_1{lc$element}}else {return 'unknown'}}my@valid_licenses_2=qw(agpl_3 apache_1_1 apache_2_0 artistic_1 artistic_2 bsd freebsd gfdl_1_2 gfdl_1_3 gpl_1 gpl_2 gpl_3 lgpl_2_1 lgpl_3_0 mit mozilla_1_0 mozilla_1_1 openssl perl_5 qpl_1_0 ssleay sun zlib open_source restricted unrestricted unknown);my%license_map_2=((map {$_=>$_}@valid_licenses_2),apache=>'apache_2_0',artistic=>'artistic_1',artistic2=>'artistic_2',gpl=>'open_source',lgpl=>'open_source',mozilla=>'open_source',perl=>'perl_5',restrictive=>'restricted',);sub _license_2 {my ($element)=@_;return ['unknown' ]unless defined$element;$element=[$element ]unless ref$element eq 'ARRAY';my@new_list;for my$lic (@$element){next unless defined$lic;if (my$new=$license_map_2{lc$lic}){push@new_list,$new}}return@new_list ? \@new_list : ['unknown' ]}my%license_downgrade_map=qw(agpl_3 open_source apache_1_1 apache apache_2_0 apache artistic_1 artistic artistic_2 artistic_2 bsd bsd freebsd open_source gfdl_1_2 open_source gfdl_1_3 open_source gpl_1 gpl gpl_2 gpl gpl_3 gpl lgpl_2_1 lgpl lgpl_3_0 lgpl mit mit mozilla_1_0 mozilla mozilla_1_1 mozilla openssl open_source perl_5 perl qpl_1_0 open_source ssleay open_source sun open_source zlib open_source open_source open_source restricted restrictive unrestricted unrestricted unknown unknown);sub _downgrade_license {my ($element)=@_;if (!defined$element){return "unknown"}elsif(ref$element eq 'ARRAY'){if (@$element > 1){if (grep {!$is_open_source{$license_downgrade_map{lc $_}|| 'unknown' }}@$element){return 'unknown'}else {return 'open_source'}}elsif (@$element==1){return$license_downgrade_map{lc$element->[0]}|| "unknown"}}elsif (!ref$element){return$license_downgrade_map{lc$element}|| "unknown"}return "unknown"}my$no_index_spec_1_2={'file'=>\&_listify,'dir'=>\&_listify,'package'=>\&_listify,'namespace'=>\&_listify,};my$no_index_spec_1_3={'file'=>\&_listify,'directory'=>\&_listify,'package'=>\&_listify,'namespace'=>\&_listify,};my$no_index_spec_2={'file'=>\&_listify,'directory'=>\&_listify,'package'=>\&_listify,'namespace'=>\&_listify,':custom'=>\&_prefix_custom,};sub _no_index_1_2 {my (undef,undef,$meta)=@_;my$no_index=$meta->{no_index}|| $meta->{private};return unless$no_index;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 ]}}if (exists$no_index->{files}){$no_index->{file}=delete$no_index->{files}}if (exists$no_index->{modules}){$no_index->{module}=delete$no_index->{modules}}return _convert($no_index,$no_index_spec_1_2)}sub _no_index_directory {my ($element,$key,$meta,$version)=@_;return unless$element;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}}if (exists$element->{files}){$element->{file}=delete$element->{files}}if (exists$element->{modules}){$element->{module}=delete$element->{modules}}my$spec=$version==2 ? $no_index_spec_2 : $no_index_spec_1_3;return _convert($element,$spec)}sub _is_module_name {my$mod=shift;return unless defined$mod && length$mod;return$mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$}}sub _clean_version {my ($element)=@_;return 0 if!defined$element;$element =~ s{^\s*}{};$element =~ s{\s*$}{};$element =~ s{^\.}{0.};return 0 if!length$element;return 0 if ($element eq 'undef' || $element eq '');my$v=eval {version->new($element)};if (defined$v){return _is_qv($v)? $v->normal : $element}else {return 0}}sub _bad_version_hook {my ($v)=@_;$v =~ s{^\s*}{};$v =~ s{\s*$}{};$v =~ s{[a-z]+$}{};my$vobj=eval {version->new($v)};return defined($vobj)? $vobj : version->new(0)}sub _version_map {my ($element)=@_;return unless defined$element;if (ref$element eq 'HASH'){my$new_map=CPAN::Meta::Requirements->new({bad_version_hook=>\&_bad_version_hook });while (my ($k,$v)=each %$element){next unless _is_module_name($k);if (!defined($v)||!length($v)|| $v eq 'undef' || $v eq ''){$v=0}if (_is_module_name($v)&&!version::is_lax($v)){$new_map->add_minimum($k=>0);$new_map->add_minimum($v=>0)}$new_map->add_string_requirement($k=>$v)}return$new_map->as_string_hash}elsif (ref$element eq 'ARRAY'){my$hashref={map {$_=>0}@$element };return _version_map($hashref)}elsif (ref$element eq '' && length$element){return {$element=>0 }}return}sub _prereqs_from_1 {my (undef,undef,$meta)=@_;my$prereqs={};for my$phase (qw/build configure/){my$key="${phase}_requires";$prereqs->{$phase}{requires}=_version_map($meta->{$key})if$meta->{$key}}for my$rel (qw/requires recommends conflicts/){$prereqs->{runtime}{$rel}=_version_map($meta->{$rel})if$meta->{$rel}}return$prereqs}my$prereqs_spec={configure=>\&_prereqs_rel,build=>\&_prereqs_rel,test=>\&_prereqs_rel,runtime=>\&_prereqs_rel,develop=>\&_prereqs_rel,':custom'=>\&_prefix_custom,};my$relation_spec={requires=>\&_version_map,recommends=>\&_version_map,suggests=>\&_version_map,conflicts=>\&_version_map,':custom'=>\&_prefix_custom,};sub _cleanup_prereqs {my ($prereqs,$key,$meta,$to_version)=@_;return unless$prereqs && ref$prereqs eq 'HASH';return _convert($prereqs,$prereqs_spec,$to_version)}sub _prereqs_rel {my ($relation,$key,$meta,$to_version)=@_;return unless$relation && ref$relation eq 'HASH';return _convert($relation,$relation_spec,$to_version)}BEGIN {my@old_prereqs=qw(requires configure_requires recommends conflicts);for (@old_prereqs){my$sub="_get_$_";my ($phase,$type)=split qr/_/,$_;if (!defined$type){$type=$phase;$phase='runtime'}no strict 'refs';*{$sub}=sub {_extract_prereqs($_[2]->{prereqs},$phase,$type)}}}sub _get_build_requires {my ($data,$key,$meta)=@_;my$test_h=_extract_prereqs($_[2]->{prereqs},qw(test requires))|| {};my$build_h=_extract_prereqs($_[2]->{prereqs},qw(build requires))|| {};my$test_req=CPAN::Meta::Requirements->from_string_hash($test_h);my$build_req=CPAN::Meta::Requirements->from_string_hash($build_h);$test_req->add_requirements($build_req)->as_string_hash}sub _extract_prereqs {my ($prereqs,$phase,$type)=@_;return unless ref$prereqs eq 'HASH';return scalar _version_map($prereqs->{$phase}{$type})}sub _downgrade_optional_features {my (undef,undef,$meta)=@_;return unless exists$meta->{optional_features};my$origin=$meta->{optional_features};my$features={};for my$name (keys %$origin){$features->{$name}={description=>$origin->{$name}{description},requires=>_extract_prereqs($origin->{$name}{prereqs},'runtime','requires'),configure_requires=>_extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'),build_requires=>_extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'),recommends=>_extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'),conflicts=>_extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'),};for my$k (keys %{$features->{$name}}){delete$features->{$name}{$k}unless defined$features->{$name}{$k}}}return$features}sub _upgrade_optional_features {my (undef,undef,$meta)=@_;return unless exists$meta->{optional_features};my$origin=$meta->{optional_features};my$features={};for my$name (keys %$origin){$features->{$name}={description=>$origin->{$name}{description},prereqs=>_prereqs_from_1(undef,undef,$origin->{$name}),};delete$features->{$name}{prereqs}{configure}}return$features}my$optional_features_2_spec={description=>\&_keep,prereqs=>\&_cleanup_prereqs,':custom'=>\&_prefix_custom,};sub _feature_2 {my ($element,$key,$meta,$to_version)=@_;return unless$element && ref$element eq 'HASH';_convert($element,$optional_features_2_spec,$to_version)}sub _cleanup_optional_features_2 {my ($element,$key,$meta,$to_version)=@_;return unless$element && ref$element eq 'HASH';my$new_data={};for my$k (keys %$element){$new_data->{$k}=_feature_2($element->{$k},$k,$meta,$to_version)}return unless keys %$new_data;return$new_data}sub _optional_features_1_4 {my ($element)=@_;return unless$element;$element=_optional_features_as_map($element);for my$name (keys %$element){for my$drop (qw/requires_packages requires_os excluded_os/){delete$element->{$name}{$drop}}}return$element}sub _optional_features_as_map {my ($element)=@_;return unless$element;if (ref$element eq 'ARRAY'){my%map;for my$feature (@$element){my (@parts)=%$feature;$map{$parts[0]}=$parts[1]}$element=\%map}return$element}sub _is_urlish {defined $_[0]&& $_[0]=~ m{\A[-+.a-z0-9]+:.+}i}sub _url_or_drop {my ($element)=@_;return$element if _is_urlish($element);return}sub _url_list {my ($element)=@_;return unless$element;$element=_listify($element);$element=[grep {_is_urlish($_)}@$element ];return unless @$element;return$element}sub _author_list {my ($element)=@_;return ['unknown' ]unless$element;$element=_listify($element);$element=[map {defined $_ && length $_ ? $_ : 'unknown'}@$element ];return ['unknown' ]unless @$element;return$element}my$resource2_upgrade={license=>sub {return _is_urlish($_[0])? _listify($_[0]): undef},homepage=>\&_url_or_drop,bugtracker=>sub {my ($item)=@_;return unless$item;if ($item =~ m{^mailto:(.*)$}){return {mailto=>$1 }}elsif(_is_urlish($item)){return {web=>$item }}else {return}},repository=>sub {return _is_urlish($_[0])? {url=>$_[0]}: undef},':custom'=>\&_prefix_custom,};sub _upgrade_resources_2 {my (undef,undef,$meta,$version)=@_;return unless exists$meta->{resources};return _convert($meta->{resources},$resource2_upgrade)}my$bugtracker2_spec={web=>\&_url_or_drop,mailto=>\&_keep,':custom'=>\&_prefix_custom,};sub _repo_type {my ($element,$key,$meta,$to_version)=@_;return$element if defined$element;return unless exists$meta->{url};my$repo_url=$meta->{url};for my$type (qw/git svn/){return$type if$repo_url =~ m{\A$type}}return}my$repository2_spec={web=>\&_url_or_drop,url=>\&_url_or_drop,type=>\&_repo_type,':custom'=>\&_prefix_custom,};my$resources2_cleanup={license=>\&_url_list,homepage=>\&_url_or_drop,bugtracker=>sub {ref $_[0]? _convert($_[0],$bugtracker2_spec): undef},repository=>sub {my$data=shift;ref$data ? _convert($data,$repository2_spec): undef},':custom'=>\&_prefix_custom,};sub _cleanup_resources_2 {my ($resources,$key,$meta,$to_version)=@_;return unless$resources && ref$resources eq 'HASH';return _convert($resources,$resources2_cleanup,$to_version)}my$resource1_spec={license=>\&_url_or_drop,homepage=>\&_url_or_drop,bugtracker=>\&_url_or_drop,repository=>\&_url_or_drop,':custom'=>\&_keep,};sub _resources_1_3 {my (undef,undef,$meta,$version)=@_;return unless exists$meta->{resources};return _convert($meta->{resources},$resource1_spec)}*_resources_1_4=*_resources_1_3;sub _resources_1_2 {my (undef,undef,$meta)=@_;my$resources=$meta->{resources}|| {};if ($meta->{license_url}&&!$resources->{license}){$resources->{license}=$meta->{license_url}if _is_urlish($meta->{license_url})}return unless keys %$resources;return _convert($resources,$resource1_spec)}my$resource_downgrade_spec={license=>sub {return ref $_[0]? $_[0]->[0]: $_[0]},homepage=>\&_url_or_drop,bugtracker=>sub {return $_[0]->{web}},repository=>sub {return $_[0]->{url}|| $_[0]->{web}},':custom'=>\&_no_prefix_ucfirst_custom,};sub _downgrade_resources {my (undef,undef,$meta,$version)=@_;return unless exists$meta->{resources};return _convert($meta->{resources},$resource_downgrade_spec)}sub _release_status {my ($element,undef,$meta)=@_;return$element if$element && $element =~ m{\A(?:stable|testing|unstable)\z};return _release_status_from_version(undef,undef,$meta)}sub _release_status_from_version {my (undef,undef,$meta)=@_;my$version=$meta->{version}|| '';return ($version =~ /_/)? 'testing' : 'stable'}my$provides_spec={file=>\&_keep,version=>\&_keep,};my$provides_spec_2={file=>\&_keep,version=>\&_keep,':custom'=>\&_prefix_custom,};sub _provides {my ($element,$key,$meta,$to_version)=@_;return unless defined$element && ref$element eq 'HASH';my$spec=$to_version==2 ? $provides_spec_2 : $provides_spec;my$new_data={};for my$k (keys %$element){$new_data->{$k}=_convert($element->{$k},$spec,$to_version);$new_data->{$k}{version}=_clean_version($element->{$k}{version})if exists$element->{$k}{version}}return$new_data}sub _convert {my ($data,$spec,$to_version,$is_fragment)=@_;my$new_data={};for my$key (keys %$spec){next if$key eq ':custom' || $key eq ':drop';next unless my$fcn=$spec->{$key};if ($is_fragment && $key eq 'generated_by'){$fcn=\&_keep}die "spec for '$key' is not a coderef" unless ref$fcn && ref$fcn eq 'CODE';my$new_value=$fcn->($data->{$key},$key,$data,$to_version);$new_data->{$key}=$new_value if defined$new_value}my$drop_list=$spec->{':drop'};my$customizer=$spec->{':custom'}|| \&_keep;for my$key (keys %$data){next if$drop_list && grep {$key eq $_}@$drop_list;next if exists$spec->{$key};$new_data->{$customizer->($key)}=$data->{$key}}return$new_data}my%up_convert=('2-from-1.4'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_2,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'release_status'=>\&_release_status,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_upgrade_optional_features,'provides'=>\&_provides,'resources'=>\&_upgrade_resources_2,'description'=>\&_keep,'prereqs'=>\&_prereqs_from_1,':drop'=>[qw(build_requires configure_requires conflicts distribution_type license_url private recommends requires) ],':custom'=>\&_prefix_custom,},'1.4-from-1.3'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'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,'configure_requires'=>\&_keep,':drop'=>[qw(license_url private)],':custom'=>\&_keep },'1.3-from-1.2'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'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'=>[qw(license_url private)],':custom'=>\&_keep },'1.2-from-1.1'=>{'version'=>\&_keep,'license'=>\&_license_1,'name'=>\&_keep,'generated_by'=>\&_generated_by,'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'meta-spec'=>\&_change_meta_spec,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'recommends'=>\&_version_map,'requires'=>\&_version_map,'keywords'=>\&_keep,'no_index'=>\&_no_index_1_2,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'resources'=>\&_resources_1_2,':drop'=>[qw(license_url private)],':custom'=>\&_keep },'1.1-from-1.0'=>{'version'=>\&_keep,'name'=>\&_keep,'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,'license_url'=>\&_url_or_drop,'private'=>\&_keep,':custom'=>\&_keep },);my%down_convert=('1.4-from-2'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_downgrade_license,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'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'=>[qw(description prereqs release_status)],':custom'=>\&_keep },'1.3-from-1.4'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'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'=>[qw(configure_requires)],':custom'=>\&_keep,},'1.2-from-1.3'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'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,':custom'=>\&_keep,},'1.1-from-1.2'=>{'version'=>\&_keep,'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'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'=>[qw(abstract author provides no_index keywords resources)],':custom'=>\&_keep,},'1.0-from-1.1'=>{'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'version'=>\&_keep,'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,':custom'=>\&_keep,},);my%cleanup=('2'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_2,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'release_status'=>\&_release_status,'keywords'=>\&_keep,'no_index'=>\&_no_index_directory,'optional_features'=>\&_cleanup_optional_features_2,'provides'=>\&_provides,'resources'=>\&_cleanup_resources_2,'description'=>\&_keep,'prereqs'=>\&_cleanup_prereqs,':drop'=>[qw(build_requires configure_requires conflicts distribution_type license_url private recommends requires) ],':custom'=>\&_prefix_custom,},'1.4'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'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,'configure_requires'=>\&_keep,':custom'=>\&_keep },'1.3'=>{'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'generated_by'=>\&_generated_by,'license'=>\&_license_1,'meta-spec'=>\&_change_meta_spec,'name'=>\&_keep,'version'=>\&_keep,'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,':custom'=>\&_keep },'1.2'=>{'version'=>\&_keep,'license'=>\&_license_1,'name'=>\&_keep,'generated_by'=>\&_generated_by,'abstract'=>\&_keep_or_unknown,'author'=>\&_author_list,'meta-spec'=>\&_change_meta_spec,'build_requires'=>\&_version_map,'conflicts'=>\&_version_map,'distribution_type'=>\&_keep,'dynamic_config'=>\&_keep_or_one,'recommends'=>\&_version_map,'requires'=>\&_version_map,'keywords'=>\&_keep,'no_index'=>\&_no_index_1_2,'optional_features'=>\&_optional_features_as_map,'provides'=>\&_provides,'resources'=>\&_resources_1_2,':custom'=>\&_keep },'1.1'=>{'version'=>\&_keep,'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'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,'license_url'=>\&_url_or_drop,'private'=>\&_keep,':custom'=>\&_keep },'1.0'=>{'name'=>\&_keep,'meta-spec'=>\&_change_meta_spec,'version'=>\&_keep,'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,':custom'=>\&_keep,},);my%fragments_generate=('2'=>{'abstract'=>'abstract','author'=>'author','generated_by'=>'generated_by','license'=>'license','name'=>'name','version'=>'version','dynamic_config'=>'dynamic_config','release_status'=>'release_status','keywords'=>'keywords','no_index'=>'no_index','optional_features'=>'optional_features','provides'=>'provides','resources'=>'resources','description'=>'description','prereqs'=>'prereqs',},'1.4'=>{'abstract'=>'abstract','author'=>'author','generated_by'=>'generated_by','license'=>'license','name'=>'name','version'=>'version','build_requires'=>'prereqs','conflicts'=>'prereqs','distribution_type'=>'distribution_type','dynamic_config'=>'dynamic_config','keywords'=>'keywords','no_index'=>'no_index','optional_features'=>'optional_features','provides'=>'provides','recommends'=>'prereqs','requires'=>'prereqs','resources'=>'resources','configure_requires'=>'prereqs',},);$fragments_generate{$_}=$fragments_generate{'1.4'}for qw/1.3 1.2 1.1 1.0/;sub new {my ($class,$data,%args)=@_;my$self={'data'=>$data,'spec'=>_extract_spec_version($data,$args{default_version}),};return bless$self,$class}sub _extract_spec_version {my ($data,$default)=@_;my$spec=$data->{'meta-spec'};return($default || "1.0")unless defined$spec && ref$spec eq 'HASH';my$v=$spec->{version};if (defined$v && $v =~ /^\d+(?:\.\d+)?$/){return$v if defined$v && grep {$v eq $_}keys%known_specs;return$v+0 if defined$v && grep {$v==$_}keys%known_specs}return "2" if exists$data->{prereqs};return "1.4" if exists$data->{configure_requires};return($default || "1.2")}sub convert {my ($self,%args)=@_;my$args={%args };my$new_version=$args->{version}|| $HIGHEST;my$is_fragment=$args->{is_fragment};my ($old_version)=$self->{spec};my$converted=_dclone($self->{data});if ($old_version==$new_version){$converted=_convert($converted,$cleanup{$old_version},$old_version,$is_fragment);unless ($args->{is_fragment}){my$cmv=CPAN::Meta::Validator->new($converted);unless ($cmv->is_valid){my$errs=join("\n",$cmv->errors);die "Failed to clean-up $old_version metadata. Errors:\n$errs\n"}}return$converted}elsif ($old_version > $new_version){my@vers=sort {$b <=> $a}keys%known_specs;for my$i (0 .. $#vers-1){next if$vers[$i]> $old_version;last if$vers[$i+1]< $new_version;my$spec_string="$vers[$i+1]-from-$vers[$i]";$converted=_convert($converted,$down_convert{$spec_string},$vers[$i+1],$is_fragment);unless ($args->{is_fragment}){my$cmv=CPAN::Meta::Validator->new($converted);unless ($cmv->is_valid){my$errs=join("\n",$cmv->errors);die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n"}}}return$converted}else {my@vers=sort {$a <=> $b}keys%known_specs;for my$i (0 .. $#vers-1){next if$vers[$i]< $old_version;last if$vers[$i+1]> $new_version;my$spec_string="$vers[$i+1]-from-$vers[$i]";$converted=_convert($converted,$up_convert{$spec_string},$vers[$i+1],$is_fragment);unless ($args->{is_fragment}){my$cmv=CPAN::Meta::Validator->new($converted);unless ($cmv->is_valid){my$errs=join("\n",$cmv->errors);die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n"}}}return$converted}}sub upgrade_fragment {my ($self)=@_;my ($old_version)=$self->{spec};my%expected=map {;$_=>1}grep {defined}map {$fragments_generate{$old_version}{$_}}keys %{$self->{data}};my$converted=$self->convert(version=>$HIGHEST,is_fragment=>1);for my$key (keys %$converted){next if$key =~ /^x_/i || $key eq 'meta-spec';delete$converted->{$key}unless$expected{$key}}return$converted}1; CPAN_META_CONVERTER $fatpacked{"CPAN/Meta/Feature.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_FEATURE'; use 5.006;use strict;use warnings;package CPAN::Meta::Feature;our$VERSION='2.150010';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; CPAN_META_FEATURE $fatpacked{"CPAN/Meta/History.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_HISTORY'; use 5.006;use strict;use warnings;package CPAN::Meta::History;our$VERSION='2.150010';1; CPAN_META_HISTORY $fatpacked{"CPAN/Meta/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_MERGE'; use strict;use warnings;package CPAN::Meta::Merge;our$VERSION='2.150010';use Carp qw/croak/;use Scalar::Util qw/blessed/;use CPAN::Meta::Converter 2.141170;sub _is_identical {my ($left,$right)=@_;return (not defined$left and not defined$right)|| (defined$left and defined$right and $left eq $right)}sub _identical {my ($left,$right,$path)=@_;croak sprintf "Can't merge attribute %s: '%s' does not equal '%s'",join('.',@{$path}),$left,$right unless _is_identical($left,$right);return$left}sub _merge {my ($current,$next,$mergers,$path)=@_;for my$key (keys %{$next}){if (not exists$current->{$key}){$current->{$key}=$next->{$key}}elsif (my$merger=$mergers->{$key}){$current->{$key}=$merger->($current->{$key},$next->{$key},[@{$path},$key ])}elsif ($merger=$mergers->{':default'}){$current->{$key}=$merger->($current->{$key},$next->{$key},[@{$path},$key ])}else {croak sprintf "Can't merge unknown attribute '%s'",join '.',@{$path},$key}}return$current}sub _uniq {my%seen=();return grep {not $seen{$_}++}@_}sub _set_addition {my ($left,$right)=@_;return [+_uniq(@{$left},@{$right})]}sub _uniq_map {my ($left,$right,$path)=@_;for my$key (keys %{$right}){if (not exists$left->{$key}){$left->{$key}=$right->{$key}}elsif (_is_identical($left->{$key},$right->{$key})){1}elsif (ref$left->{$key}eq 'HASH' and ref$right->{$key}eq 'HASH'){$left->{$key}=_uniq_map($left->{$key},$right->{$key},[@{$path},$key ])}else {croak 'Duplication of element ' .join '.',@{$path},$key}}return$left}sub _improvise {my ($left,$right,$path)=@_;my ($name)=reverse @{$path};if ($name =~ /^x_/){if (ref($left)eq 'ARRAY'){return _set_addition($left,$right,$path)}elsif (ref($left)eq 'HASH'){return _uniq_map($left,$right,$path)}else {return _identical($left,$right,$path)}}croak sprintf "Can't merge '%s'",join '.',@{$path}}sub _optional_features {my ($left,$right,$path)=@_;for my$key (keys %{$right}){if (not exists$left->{$key}){$left->{$key}=$right->{$key}}else {for my$subkey (keys %{$right->{$key}}){next if$subkey eq 'prereqs';if (not exists$left->{$key}{$subkey}){$left->{$key}{$subkey}=$right->{$key}{$subkey}}else {Carp::croak "Cannot merge two optional_features named '$key' with different '$subkey' values" if do {no warnings 'uninitialized';$left->{$key}{$subkey}ne $right->{$key}{$subkey}}}}require CPAN::Meta::Prereqs;$left->{$key}{prereqs}=CPAN::Meta::Prereqs->new($left->{$key}{prereqs})->with_merged_prereqs(CPAN::Meta::Prereqs->new($right->{$key}{prereqs}))->as_string_hash}}return$left}my%default=(abstract=>\&_identical,author=>\&_set_addition,dynamic_config=>sub {my ($left,$right)=@_;return$left || $right},generated_by=>sub {my ($left,$right)=@_;return join ', ',_uniq(split(/, /,$left),split(/, /,$right))},license=>\&_set_addition,'meta-spec'=>{version=>\&_identical,url=>\&_identical },name=>\&_identical,release_status=>\&_identical,version=>\&_identical,description=>\&_identical,keywords=>\&_set_addition,no_index=>{map {($_=>\&_set_addition)}qw/file directory package namespace/ },optional_features=>\&_optional_features,prereqs=>sub {require CPAN::Meta::Prereqs;my ($left,$right)=map {CPAN::Meta::Prereqs->new($_)}@_[0,1];return$left->with_merged_prereqs($right)->as_string_hash},provides=>\&_uniq_map,resources=>{license=>\&_set_addition,homepage=>\&_identical,bugtracker=>\&_uniq_map,repository=>\&_uniq_map,':default'=>\&_improvise,},':default'=>\&_improvise,);sub new {my ($class,%arguments)=@_;croak 'default version required' if not exists$arguments{default_version};my%mapping=%default;my%extra=%{$arguments{extra_mappings}|| {}};for my$key (keys%extra){if (ref($mapping{$key})eq 'HASH'){$mapping{$key}={%{$mapping{$key}},%{$extra{$key}}}}else {$mapping{$key}=$extra{$key}}}return bless {default_version=>$arguments{default_version},mapping=>_coerce_mapping(\%mapping,[]),},$class}my%coderef_for=(set_addition=>\&_set_addition,uniq_map=>\&_uniq_map,identical=>\&_identical,improvise=>\&_improvise,improvize=>\&_improvise,);sub _coerce_mapping {my ($orig,$map_path)=@_;my%ret;for my$key (keys %{$orig}){my$value=$orig->{$key};if (ref($orig->{$key})eq 'CODE'){$ret{$key}=$value}elsif (ref($value)eq 'HASH'){my$mapping=_coerce_mapping($value,[@{$map_path},$key ]);$ret{$key}=sub {my ($left,$right,$path)=@_;return _merge($left,$right,$mapping,[@{$path}])}}elsif ($coderef_for{$value}){$ret{$key}=$coderef_for{$value}}else {croak "Don't know what to do with " .join '.',@{$map_path},$key}}return \%ret}sub merge {my ($self,@items)=@_;my$current={};for my$next (@items){if (blessed($next)&& $next->isa('CPAN::Meta')){$next=$next->as_struct}elsif (ref($next)eq 'HASH'){my$cmc=CPAN::Meta::Converter->new($next,default_version=>$self->{default_version});$next=$cmc->upgrade_fragment}else {croak "Don't know how to merge '$next'"}$current=_merge($current,$next,$self->{mapping},[])}return$current}1; CPAN_META_MERGE $fatpacked{"CPAN/Meta/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_PREREQS'; use 5.006;use strict;use warnings;package CPAN::Meta::Prereqs;our$VERSION='2.150010';use Carp qw(confess);use Scalar::Util qw(blessed);use CPAN::Meta::Requirements 2.121;sub __legal_phases {qw(configure build test runtime develop)}sub __legal_types {qw(requires recommends suggests conflicts)}sub new {my ($class,$prereq_spec)=@_;$prereq_spec ||= {};my%is_legal_phase=map {;$_=>1}$class->__legal_phases;my%is_legal_type=map {;$_=>1}$class->__legal_types;my%guts;PHASE: for my$phase (keys %$prereq_spec){next PHASE unless$phase =~ /\Ax_/i or $is_legal_phase{$phase};my$phase_spec=$prereq_spec->{$phase };next PHASE unless keys %$phase_spec;TYPE: for my$type (keys %$phase_spec){next TYPE unless$type =~ /\Ax_/i or $is_legal_type{$type};my$spec=$phase_spec->{$type };next TYPE unless keys %$spec;$guts{prereqs}{$phase}{$type}=CPAN::Meta::Requirements->from_string_hash($spec)}}return bless \%guts=>$class}sub requirements_for {my ($self,$phase,$type)=@_;confess "requirements_for called without phase" unless defined$phase;confess "requirements_for called without type" unless defined$type;unless ($phase =~ /\Ax_/i or grep {$phase eq $_}$self->__legal_phases){confess "requested requirements for unknown phase: $phase"}unless ($type =~ /\Ax_/i or grep {$type eq $_}$self->__legal_types){confess "requested requirements for unknown type: $type"}my$req=($self->{prereqs}{$phase}{$type}||= CPAN::Meta::Requirements->new);$req->finalize if$self->is_finalized;return$req}sub phases {my ($self)=@_;my%is_legal_phase=map {;$_=>1}$self->__legal_phases;grep {/\Ax_/i or $is_legal_phase{$_}}keys %{$self->{prereqs}}}sub types_in {my ($self,$phase)=@_;return unless$phase =~ /\Ax_/i or grep {$phase eq $_}$self->__legal_phases;my%is_legal_type=map {;$_=>1}$self->__legal_types;grep {/\Ax_/i or $is_legal_type{$_}}keys %{$self->{prereqs}{$phase}}}sub with_merged_prereqs {my ($self,$other)=@_;my@other=blessed($other)? $other : @$other;my@prereq_objs=($self,@other);my%new_arg;for my$phase (__uniq(map {$_->phases}@prereq_objs)){for my$type (__uniq(map {$_->types_in($phase)}@prereq_objs)){my$req=CPAN::Meta::Requirements->new;for my$prereq (@prereq_objs){my$this_req=$prereq->requirements_for($phase,$type);next unless$this_req->required_modules;$req->add_requirements($this_req)}next unless$req->required_modules;$new_arg{$phase }{$type }=$req->as_string_hash}}return (ref$self)->new(\%new_arg)}sub merged_requirements {my ($self,$phases,$types)=@_;$phases=[qw/runtime build test/]unless defined$phases;$types=[qw/requires recommends/]unless defined$types;confess "merged_requirements phases argument must be an arrayref" unless ref$phases eq 'ARRAY';confess "merged_requirements types argument must be an arrayref" unless ref$types eq 'ARRAY';my$req=CPAN::Meta::Requirements->new;for my$phase (@$phases){unless ($phase =~ /\Ax_/i or grep {$phase eq $_}$self->__legal_phases){confess "requested requirements for unknown phase: $phase"}for my$type (@$types){unless ($type =~ /\Ax_/i or grep {$type eq $_}$self->__legal_types){confess "requested requirements for unknown type: $type"}$req->add_requirements($self->requirements_for($phase,$type))}}$req->finalize if$self->is_finalized;return$req}sub as_string_hash {my ($self)=@_;my%hash;for my$phase ($self->phases){for my$type ($self->types_in($phase)){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)}sub __uniq {my (%s,$u);grep {defined($_)?!$s{$_}++ :!$u++}@_}1; CPAN_META_PREREQS $fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS'; use 5.006;use strict;use warnings;package CPAN::Meta::Requirements;our$VERSION='2.140';use Carp ();BEGIN {eval "use version ()";if (my$err=$@){eval "use ExtUtils::MakeMaker::version" or die$err}}*_is_qv=version->can('is_qv')? sub {$_[0]->is_qv}: sub {exists $_[0]->{qv}};my$V0=version->new(0);my@valid_options=qw(bad_version_hook);sub new {my ($class,$options)=@_;$options ||= {};Carp::croak "Argument to $class\->new() must be a hash reference" unless ref$options eq 'HASH';my%self=map {;$_=>$options->{$_}}@valid_options;return bless \%self=>$class}sub _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 _isa_version {UNIVERSAL::isa($_[0],'UNIVERSAL')&& $_[0]->isa('version')}sub _version_object {my ($self,$module,$version)=@_;my ($vobj,$err);if (not defined$version or (!ref($version)&& $version eq '0')){return$V0}elsif (ref($version)eq 'version' || (ref($version)&& _isa_version($version))){$vobj=$version}else {if ($INC{'version/vpp.pm'}|| $INC{'ExtUtils/MakeMaker/version/vpp.pm'}){my$magic=_find_magic_vstring($version);$version=$magic if length$magic}if ($] < 5.008001 && $version !~ /\A[0-9]/ && substr($version,0,1)ne 'v' && length($version)< 3){$version .= "\0" x (3 - length($version))}eval {local$SIG{__WARN__}=sub {die "Invalid version: $_[0]"};die "Invalid version: $version" if$version eq 'version';$vobj=version->new($version)};if (my$err=$@){my$hook=$self->{bad_version_hook};$vobj=eval {$hook->($version,$module)}if ref$hook eq 'CODE';unless (eval {$vobj->isa("version")}){$err =~ s{ at .* line \d+.*$}{};die "Can't convert '$version': $err"}}}if ($vobj =~ m{\A\.}){$vobj=version->new("0$vobj")}if (_is_qv($vobj)){$vobj=version->new($vobj->normal)}return$vobj}BEGIN {for my$type (qw(maximum exclusion exact_version)){my$method="with_$type";my$to_add=$type eq 'exact_version' ? $type : "add_$type";my$code=sub {my ($self,$name,$version)=@_;$version=$self->_version_object($name,$version);$self->__modify_entry_for($name,$method,$version);return$self};no strict 'refs';*$to_add=$code}}sub add_minimum {my ($self,$name,$version)=@_;if (not defined$version or "$version" eq '0'){return$self if$self->__entry_for($name);Carp::confess("can't add new requirements to finalized requirements")if$self->is_finalized;$self->{requirements}{$name }=CPAN::Meta::Requirements::_Range::Range->with_minimum($V0,$name)}else {$version=$self->_version_object($name,$version);$self->__modify_entry_for($name,'with_minimum',$version)}return$self}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($module,$version);return 1 unless my$range=$self->__entry_for($module);return$range->_accepts($version)}sub clear_requirement {my ($self,$module)=@_;return$self unless$self->__entry_for($module);Carp::confess("can't clear requirements on finalized requirements")if$self->is_finalized;delete$self->{requirements}{$module };return$self}sub requirements_for_module {my ($self,$module)=@_;my$entry=$self->__entry_for($module);return unless$entry;return$entry->as_string}sub structured_requirements_for_module {my ($self,$module)=@_;my$entry=$self->__entry_for($module);return unless$entry;return$entry->as_struct}sub required_modules {keys %{$_[0]{requirements}}}sub clone {my ($self)=@_;my$new=(ref$self)->new;return$new->add_requirements($self)}sub __entry_for {$_[0]{requirements}{$_[1]}}sub __modify_entry_for {my ($self,$name,$method,$version)=@_;my$fin=$self->is_finalized;my$old=$self->__entry_for($name);Carp::confess("can't add new requirements to finalized requirements")if$fin and not $old;my$new=($old || 'CPAN::Meta::Requirements::_Range::Range')->$method($version,$name);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){return if$self->__entry_for($module)->as_string =~ /\s/}return 1}sub is_finalized {$_[0]{finalized}}sub finalize {$_[0]{finalized}=1}sub as_string_hash {my ($self)=@_;my%hash=map {;$_=>$self->{requirements}{$_}->as_string}$self->required_modules;return \%hash}my%methods_for_op=('=='=>[qw(exact_version) ],'!='=>[qw(add_exclusion) ],'>='=>[qw(add_minimum) ],'<='=>[qw(add_maximum) ],'>'=>[qw(add_minimum add_exclusion) ],'<'=>[qw(add_maximum add_exclusion) ],);sub add_string_requirement {my ($self,$module,$req)=@_;unless (defined$req && length$req){$req=0;$self->_blank_carp($module)}my$magic=_find_magic_vstring($req);if (length$magic){$self->add_minimum($module=>$magic);return}my@parts=split qr{\s*,\s*},$req;for my$part (@parts){my ($op,$ver)=$part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z};if (!defined$op){$self->add_minimum($module=>$part)}else {Carp::confess("illegal requirement string: $req")unless my$methods=$methods_for_op{$op };$self->$_($module=>$ver)for @$methods}}}sub _blank_carp {my ($self,$module)=@_;Carp::carp("Undefined requirement for $module treated as '0'")}sub from_string_hash {my ($class,$hash,$options)=@_;my$self=$class->new($options);for my$module (keys %$hash){my$req=$hash->{$module};unless (defined$req && length$req){$req=0;$class->_blank_carp($module)}$self->add_string_requirement($module,$req)}return$self}{package CPAN::Meta::Requirements::_Range::Exact;sub _new {bless {version=>$_[1]}=>$_[0]}sub _accepts {return $_[0]{version}==$_[1]}sub as_string {return "== $_[0]{version}"}sub as_struct {return [['==',"$_[0]{version}" ]]}sub as_modifiers {return [[exact_version=>$_[0]{version}]]}sub _reject_requirements {my ($self,$module,$error)=@_;Carp::confess("illegal requirements for $module: $error")}sub _clone {(ref $_[0])->_new(version->new($_[0]{version}))}sub with_exact_version {my ($self,$version,$module)=@_;$module='module' unless defined$module;return$self->_clone if$self->_accepts($version);$self->_reject_requirements($module,"can't be exactly $version when exact requirement is already $self->{version}",)}sub with_minimum {my ($self,$minimum,$module)=@_;$module='module' unless defined$module;return$self->_clone if$self->{version}>= $minimum;$self->_reject_requirements($module,"minimum $minimum exceeds exact specification $self->{version}",)}sub with_maximum {my ($self,$maximum,$module)=@_;$module='module' unless defined$module;return$self->_clone if$self->{version}<= $maximum;$self->_reject_requirements($module,"maximum $maximum below exact specification $self->{version}",)}sub with_exclusion {my ($self,$exclusion,$module)=@_;$module='module' unless defined$module;return$self->_clone unless$exclusion==$self->{version};$self->_reject_requirements($module,"tried to exclude $exclusion, which is already exactly specified",)}}{package CPAN::Meta::Requirements::_Range::Range;sub _self {ref($_[0])? $_[0]: (bless {}=>$_[0])}sub _clone {return (bless {}=>$_[0])unless ref $_[0];my ($s)=@_;my%guts=((exists$s->{minimum}? (minimum=>version->new($s->{minimum})): ()),(exists$s->{maximum}? (maximum=>version->new($s->{maximum})): ()),(exists$s->{exclusions}? (exclusions=>[map {version->new($_)}@{$s->{exclusions}}]): ()),);bless \%guts=>ref($s)}sub as_modifiers {my ($self)=@_;my@mods;push@mods,[add_minimum=>$self->{minimum}]if exists$self->{minimum};push@mods,[add_maximum=>$self->{maximum}]if exists$self->{maximum};push@mods,map {;[add_exclusion=>$_ ]}@{$self->{exclusions}|| []};return \@mods}sub as_struct {my ($self)=@_;return 0 if!keys %$self;my@exclusions=@{$self->{exclusions}|| []};my@parts;for my$tuple ([qw(>= > minimum) ],[qw(<= < maximum) ],){my ($op,$e_op,$k)=@$tuple;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 \@parts}sub as_string {my ($self)=@_;my@parts=@{$self->as_struct};return$parts[0][1]if@parts==1 and $parts[0][0]eq '>=';return join q{, },map {;join q{ },@$_}@parts}sub _reject_requirements {my ($self,$module,$error)=@_;Carp::confess("illegal requirements for $module: $error")}sub with_exact_version {my ($self,$version,$module)=@_;$module='module' unless defined$module;$self=$self->_clone;unless ($self->_accepts($version)){$self->_reject_requirements($module,"exact specification $version outside of range " .$self->as_string)}return CPAN::Meta::Requirements::_Range::Exact->_new($version)}sub _simplify {my ($self,$module)=@_;if (defined$self->{minimum}and defined$self->{maximum}){if ($self->{minimum}==$self->{maximum}){if (grep {$_==$self->{minimum}}@{$self->{exclusions}|| []}){$self->_reject_requirements($module,"minimum and maximum are both $self->{minimum}, which is excluded",)}return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum})}if ($self->{minimum}> $self->{maximum}){$self->_reject_requirements($module,"minimum $self->{minimum} exceeds maximum $self->{maximum}",)}}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,$module)=@_;$module='module' unless defined$module;$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($module)}sub with_maximum {my ($self,$maximum,$module)=@_;$module='module' unless defined$module;$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($module)}sub with_exclusion {my ($self,$exclusion,$module)=@_;$module='module' unless defined$module;$self=$self->_clone;push @{$self->{exclusions}||= []},$exclusion;return$self->_simplify($module)}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; CPAN_META_REQUIREMENTS $fatpacked{"CPAN/Meta/Spec.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_SPEC'; use 5.006;use strict;use warnings;package CPAN::Meta::Spec;our$VERSION='2.150010';1; CPAN_META_SPEC $fatpacked{"CPAN/Meta/Validator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_VALIDATOR'; use 5.006;use strict;use warnings;package CPAN::Meta::Validator;our$VERSION='2.150010';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'=>{'abstract'=>{mandatory=>1,value=>\&string },'author'=>{mandatory=>1,list=>{value=>\&string }},'dynamic_config'=>{mandatory=>1,value=>\&boolean },'generated_by'=>{mandatory=>1,value=>\&string },'license'=>{mandatory=>1,list=>{value=>\&license }},'meta-spec'=>{mandatory=>1,'map'=>{version=>{mandatory=>1,value=>\&version},url=>{value=>\&url },':key'=>{name=>\&custom_2,value=>\&anything },}},'name'=>{mandatory=>1,value=>\&string },'release_status'=>{mandatory=>1,value=>\&release_status },'version'=>{mandatory=>1,value=>\&version },'description'=>{value=>\&string },'keywords'=>{list=>{value=>\&string }},'no_index'=>$no_index_2,'optional_features'=>{'map'=>{':key'=>{name=>\&string,'map'=>{description=>{value=>\&string },prereqs=>$prereq_map,':key'=>{name=>\&custom_2,value=>\&anything },}}}},'prereqs'=>$prereq_map,'provides'=>{'map'=>{':key'=>{name=>\&module,'map'=>{file=>{mandatory=>1,value=>\&file },version=>{value=>\&version },':key'=>{name=>\&custom_2,value=>\&anything },}}}},'resources'=>{'map'=>{license=>{list=>{value=>\&url }},homepage=>{value=>\&url },bugtracker=>{'map'=>{web=>{value=>\&url },mailto=>{value=>\&string},':key'=>{name=>\&custom_2,value=>\&anything },}},repository=>{'map'=>{web=>{value=>\&url },url=>{value=>\&url },type=>{value=>\&string },':key'=>{name=>\&custom_2,value=>\&anything },}},':key'=>{value=>\&string,name=>\&custom_2 },}},':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 },}},':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 },}},':key'=>{name=>\&string,value=>\&anything },},'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 },}},':key'=>{name=>\&string,value=>\&anything },},'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,':key'=>{name=>\&string,value=>\&anything },},'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,':key'=>{name=>\&string,value=>\&anything },},);sub new {my ($class,$data)=@_;my$self={'data'=>$data,'spec'=>eval {$data->{'meta-spec'}{'version'}}|| "1.0",'errors'=>undef,};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', or 'value'";sub check_map {my ($self,$spec,$data)=@_;if(ref($spec)ne 'HASH'){$self->_error("Unknown META specification, cannot validate.");return}if(ref($data)ne 'HASH'){$self->_error("Expected a map structure from string or file.");return}for my$key (keys %$spec){next unless($spec->{$key}->{mandatory});next if(defined$data->{$key});push @{$self->{stack}},$key;$self->_error("Missing mandatory field, '$key'");pop @{$self->{stack}}}for my$key (keys %$data){push @{$self->{stack}},$key;if($spec->{$key}){if($spec->{$key}{value}){$spec->{$key}{value}->($self,$key,$data->{$key})}elsif($spec->{$key}{'map'}){$self->check_map($spec->{$key}{'map'},$data->{$key})}elsif($spec->{$key}{'list'}){$self->check_list($spec->{$key}{'list'},$data->{$key})}else {$self->_error("$spec_error for '$key'")}}elsif ($spec->{':key'}){$spec->{':key'}{name}->($self,$key,$key);if($spec->{':key'}{value}){$spec->{':key'}{value}->($self,$key,$data->{$key})}elsif($spec->{':key'}{'map'}){$self->check_map($spec->{':key'}{'map'},$data->{$key})}elsif($spec->{':key'}{'list'}){$self->check_list($spec->{':key'}{'list'},$data->{$key})}else {$self->_error("$spec_error for ':key'")}}else {$self->_error("Unknown key, '$key', found in map structure")}pop @{$self->{stack}}}}sub check_list {my ($self,$spec,$data)=@_;if(ref($data)ne 'ARRAY'){$self->_error("Expected a list structure");return}if(defined$spec->{mandatory}){if(!defined$data->[0]){$self->_error("Missing entries from mandatory list")}}for my$value (@$data){push @{$self->{stack}},$value || "";if(defined$spec->{value}){$spec->{value}->($self,'list',$value)}elsif(defined$spec->{'map'}){$self->check_map($spec->{'map'},$value)}elsif(defined$spec->{'list'}){$self->check_list($spec->{'list'},$value)}elsif ($spec->{':key'}){$self->check_map($spec,$value)}else {$self->_error("$spec_error associated with '$self->{stack}[-2]'")}pop @{$self->{stack}}}}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}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='' 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=''}$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)$/)}else {$value=''}$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=''}$self->_error("License '$value' is invalid");return 0}sub custom_1 {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/)}else {$key=''}$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)}else {$key=''}$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)}else {$key=''}$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=''}$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=''}$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=''}$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; CPAN_META_VALIDATOR $fatpacked{"CPAN/Meta/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_YAML'; use 5.008001;use strict;use warnings;package CPAN::Meta::YAML;$CPAN::Meta::YAML::VERSION='0.018';;use Exporter;our@ISA=qw{Exporter};our@EXPORT=qw{Load Dump};our@EXPORT_OK=qw{LoadFile DumpFile freeze thaw};sub Dump {return CPAN::Meta::YAML->new(@_)->_dump_string}sub Load {my$self=CPAN::Meta::YAML->_load_string(@_);if (wantarray){return @$self}else {return$self->[-1]}}BEGIN {*freeze=\&Dump;*thaw=\&Load}sub DumpFile {my$file=shift;return CPAN::Meta::YAML->new(@_)->_dump_file($file)}sub LoadFile {my$file=shift;my$self=CPAN::Meta::YAML->_load_file($file);if (wantarray){return @$self}else {return$self->[-1]}}sub new {my$class=shift;bless [@_ ],$class}sub read_string {my$self=shift;$self->_load_string(@_)}sub write_string {my$self=shift;$self->_dump_string(@_)}sub read {my$self=shift;$self->_load_file(@_)}sub write {my$self=shift;$self->_dump_file(@_)}my@UNPRINTABLE=qw(0 x01 x02 x03 x04 x05 x06 a b t n v f r x0E x0F x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x1A e x1C x1D x1E x1F);my%UNESCAPES=(0=>"\x00",z=>"\x00",N=>"\x85",a=>"\x07",b=>"\x08",t=>"\x09",n=>"\x0a",v=>"\x0b",f=>"\x0c",r=>"\x0d",e=>"\x1b",'\\'=>'\\',);my%QUOTE=map {$_=>1}qw{null true false};my$re_capture_double_quoted=qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;my$re_capture_single_quoted=qr/\'([^\']*(?:\'\'[^\']*)*)\'/;my$re_capture_unquoted_key=qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/;my$re_trailing_comment=qr/(?:\s+\#.*)?/;my$re_key_value_separator=qr/\s*:(?:\s+(?:\#.*)?|$)/;sub _load_file {my$class=ref $_[0]? ref shift : shift;my$file=shift or $class->_error('You did not specify a file name');$class->_error("File '$file' does not exist")unless -e $file;$class->_error("'$file' is a directory, not a file")unless -f _;$class->_error("Insufficient permissions to read '$file'")unless -r _;open(my$fh,"<:unix:encoding(UTF-8)",$file);unless ($fh){$class->_error("Failed to open file '$file': $!")}if (_can_flock()){flock($fh,Fcntl::LOCK_SH())or warn "Couldn't lock '$file' for reading: $!"}my$contents=eval {use warnings FATAL=>'utf8';local $/;<$fh>};if (my$err=$@){$class->_error("Error reading from file '$file': $err")}unless (close$fh){$class->_error("Failed to close file '$file': $!")}$class->_load_string($contents)}sub _load_string {my$class=ref $_[0]? ref shift : shift;my$self=bless [],$class;my$string=$_[0];eval {unless (defined$string){die \"Did not provide a string to load"}if (utf8::is_utf8($string)&&!utf8::valid($string)){die \<<'...'}utf8::upgrade($string);$string =~ s/^\x{FEFF}//;return$self unless length$string;my@lines=grep {!/^\s*(?:\#.*)?\z/}split /(?:\015{1,2}\012|\015|\012)/,$string;@lines and $lines[0]=~ /^\%YAML[: ][\d\.]+.*\z/ and shift@lines;my$in_document=0;while (@lines){if ($lines[0]=~ /^---\s*(?:(.+)\s*)?\z/){shift@lines;if (defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/){push @$self,$self->_load_scalar("$1",[undef ],\@lines);next}$in_document=1}if (!@lines or $lines[0]=~ /^(?:---|\.\.\.)/){push @$self,undef;while (@lines and $lines[0]!~ /^---/){shift@lines}$in_document=0}elsif (!$in_document && @$self){die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'"}elsif ($lines[0]=~ /^\s*\-(?:\s|$|-+$)/){my$document=[];push @$self,$document;$self->_load_array($document,[0 ],\@lines)}elsif ($lines[0]=~ /^(\s*)\S/){my$document={};push @$self,$document;$self->_load_hash($document,[length($1)],\@lines)}else {die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'"}}};my$err=$@;if (ref$err eq 'SCALAR'){$self->_error(${$err})}elsif ($err){$self->_error($err)}return$self}sub _unquote_single {my ($self,$string)=@_;return '' unless length$string;$string =~ s/\'\'/\'/g;return$string}sub _unquote_double {my ($self,$string)=@_;return '' unless length$string;$string =~ s/\\"/"/g;$string =~ s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))} Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set). Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"? ... {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;return$string}sub _load_scalar {my ($self,$string,$indent,$lines)=@_;$string =~ s/\s*\z//;return undef if$string eq '~';if ($string =~ /^$re_capture_single_quoted$re_trailing_comment\z/){return$self->_unquote_single($1)}if ($string =~ /^$re_capture_double_quoted$re_trailing_comment\z/){return$self->_unquote_double($1)}if ($string =~ /^[\'\"!&]/){die \"CPAN::Meta::YAML does not support a feature in line '$string'"}return {}if$string =~ /^{}(?:\s+\#.*)?\z/;return []if$string =~ /^\[\](?:\s+\#.*)?\z/;if ($string !~ /^[>|]/){die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'" if$string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or $string =~ /:(?:\s|$)/;$string =~ s/\s+#.*\z//;return$string}die \"CPAN::Meta::YAML failed to find multi-line scalar content" unless @$lines;$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]'"}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}sub _load_array {my ($self,$array,$indent,$lines)=@_;while (@$lines){if ($lines->[0]=~ /^(?:---|\.\.\.)/){while (@$lines and $lines->[0]!~ /^---/){shift @$lines}return 1}$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+|$)/){my$indent2=length("$1");$lines->[0]=~ s/-/ /;push @$array,{};$self->_load_hash($array->[-1],[@$indent,$indent2 ],$lines)}elsif ($lines->[0]=~ /^\s*\-\s*\z/){shift @$lines;unless (@$lines){push @$array,undef;return 1}if ($lines->[0]=~ /^(\s*)\-/){my$indent2=length("$1");if ($indent->[-1]==$indent2){push @$array,undef}else {push @$array,[];$self->_load_array($array->[-1],[@$indent,$indent2 ],$lines)}}elsif ($lines->[0]=~ /^(\s*)\S/){push @$array,{};$self->_load_hash($array->[-1],[@$indent,length("$1")],$lines)}else {die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"}}elsif ($lines->[0]=~ /^\s*\-(\s*)(.+?)\s*\z/){shift @$lines;push @$array,$self->_load_scalar("$2",[@$indent,undef ],$lines)}elsif (defined$indent->[-2]and $indent->[-1]==$indent->[-2]){return 1}else {die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"}}return 1}sub _load_hash {my ($self,$hash,$indent,$lines)=@_;while (@$lines){if ($lines->[0]=~ /^(?:---|\.\.\.)/){while (@$lines and $lines->[0]!~ /^---/){shift @$lines}return 1}$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]'"}my$key;if ($lines->[0]=~ s/^\s*$re_capture_single_quoted$re_key_value_separator//){$key=$self->_unquote_single($1)}elsif ($lines->[0]=~ s/^\s*$re_capture_double_quoted$re_key_value_separator//){$key=$self->_unquote_double($1)}elsif ($lines->[0]=~ s/^\s*$re_capture_unquoted_key$re_key_value_separator//){$key=$1;$key =~ s/\s+$//}elsif ($lines->[0]=~ /^\s*\?/){die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'"}else {die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"}if (exists$hash->{$key}){warn "CPAN::Meta::YAML found a duplicate key '$key' in line '$lines->[0]'"}if (length$lines->[0]){$hash->{$key}=$self->_load_scalar(shift(@$lines),[@$indent,undef ],$lines)}else {shift @$lines;unless (@$lines){$hash->{$key}=undef;return 1}if ($lines->[0]=~ /^(\s*)-/){$hash->{$key}=[];$self->_load_array($hash->{$key},[@$indent,length($1)],$lines)}elsif ($lines->[0]=~ /^(\s*)./){my$indent2=length("$1");if ($indent->[-1]>= $indent2){$hash->{$key}=undef}else {$hash->{$key}={};$self->_load_hash($hash->{$key},[@$indent,length($1)],$lines)}}}}return 1}sub _dump_file {my$self=shift;require Fcntl;my$file=shift or $self->_error('You did not specify a file name');my$fh;if (_can_flock()){my$flags=Fcntl::O_WRONLY()|Fcntl::O_CREAT();sysopen($fh,$file,$flags);unless ($fh){$self->_error("Failed to open file '$file' for writing: $!")}binmode($fh,":raw:encoding(UTF-8)");flock($fh,Fcntl::LOCK_EX())or warn "Couldn't lock '$file' for reading: $!";truncate$fh,0;seek$fh,0,0}else {open$fh,">:unix:encoding(UTF-8)",$file}print {$fh}$self->_dump_string;unless (close$fh){$self->_error("Failed to close file '$file': $!")}return 1}sub _dump_string {my$self=shift;return '' unless ref$self && @$self;my$indent=0;my@lines=();eval {for my$cursor (@$self){push@lines,'---';if (!defined$cursor){}elsif (!ref$cursor){$lines[-1].= ' ' .$self->_dump_scalar($cursor)}elsif (ref$cursor eq 'ARRAY'){unless (@$cursor){$lines[-1].= ' []';next}push@lines,$self->_dump_array($cursor,$indent,{})}elsif (ref$cursor eq 'HASH'){unless (%$cursor){$lines[-1].= ' {}';next}push@lines,$self->_dump_hash($cursor,$indent,{})}else {die \("Cannot serialize " .ref($cursor))}}};if (ref $@ eq 'SCALAR'){$self->_error(${$@})}elsif ($@){$self->_error($@)}join '',map {"$_\n"}@lines}sub _has_internal_string_value {my$value=shift;my$b_obj=B::svref_2object(\$value);return$b_obj->FLAGS & B::SVf_POK()}sub _dump_scalar {my$string=$_[1];my$is_key=$_[2];my$has_string_flag=_has_internal_string_value($string);return '~' unless defined$string;return "''" unless length$string;if (Scalar::Util::looks_like_number($string)){if ($is_key || $has_string_flag){return qq['$string']}else {return$string}}if ($string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/){$string =~ s/\\/\\\\/g;$string =~ s/"/\\"/g;$string =~ s/\n/\\n/g;$string =~ s/[\x85]/\\N/g;$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;$string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;return qq|"$string"|}if ($string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or $QUOTE{$string}){return "'$string'"}return$string}sub _dump_array {my ($self,$array,$indent,$seen)=@_;if ($seen->{refaddr($array)}++){die \"CPAN::Meta::YAML does not support circular references"}my@lines=();for my$el (@$array){my$line=(' ' x $indent).'-';my$type=ref$el;if (!$type){$line .= ' ' .$self->_dump_scalar($el);push@lines,$line}elsif ($type eq 'ARRAY'){if (@$el){push@lines,$line;push@lines,$self->_dump_array($el,$indent + 1,$seen)}else {$line .= ' []';push@lines,$line}}elsif ($type eq 'HASH'){if (keys %$el){push@lines,$line;push@lines,$self->_dump_hash($el,$indent + 1,$seen)}else {$line .= ' {}';push@lines,$line}}else {die \"CPAN::Meta::YAML does not support $type references"}}@lines}sub _dump_hash {my ($self,$hash,$indent,$seen)=@_;if ($seen->{refaddr($hash)}++){die \"CPAN::Meta::YAML does not support circular references"}my@lines=();for my$name (sort keys %$hash){my$el=$hash->{$name};my$line=(' ' x $indent).$self->_dump_scalar($name,1).":";my$type=ref$el;if (!$type){$line .= ' ' .$self->_dump_scalar($el);push@lines,$line}elsif ($type eq 'ARRAY'){if (@$el){push@lines,$line;push@lines,$self->_dump_array($el,$indent + 1,$seen)}else {$line .= ' []';push@lines,$line}}elsif ($type eq 'HASH'){if (keys %$el){push@lines,$line;push@lines,$self->_dump_hash($el,$indent + 1,$seen)}else {$line .= ' {}';push@lines,$line}}else {die \"CPAN::Meta::YAML does not support $type references"}}@lines}our$errstr='';sub _error {require Carp;$errstr=$_[1];$errstr =~ s/ at \S+ line \d+.*//;Carp::croak($errstr)}my$errstr_warned;sub errstr {require Carp;Carp::carp("CPAN::Meta::YAML->errstr and \$CPAN::Meta::YAML::errstr is deprecated")unless$errstr_warned++;$errstr}use B;my$HAS_FLOCK;sub _can_flock {if (defined$HAS_FLOCK){return$HAS_FLOCK}else {require Config;my$c=\%Config::Config;$HAS_FLOCK=grep {$c->{$_}}qw/d_flock d_fcntl_can_lock d_lockf/;require Fcntl if$HAS_FLOCK;return$HAS_FLOCK}}use Scalar::Util ();BEGIN {local $@;if (eval {Scalar::Util->VERSION(1.18)}){*refaddr=*Scalar::Util::refaddr}else {eval <<'END_PERL'}}delete$CPAN::Meta::YAML::{refaddr};1; # Scalar::Util failed to load or too old sub refaddr { my $pkg = ref($_[0]) or return undef; if ( !! UNIVERSAL::can($_[0], 'can') ) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { no warnings 'portable'; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL CPAN_META_YAML $fatpacked{"Capture/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CAPTURE_TINY'; use 5.006;use strict;use warnings;package Capture::Tiny;our$VERSION='0.48';use Carp ();use Exporter ();use IO::Handle ();use File::Spec ();use File::Temp qw/tempfile tmpnam/;use Scalar::Util qw/reftype blessed/;BEGIN {local $@;eval {require PerlIO;PerlIO->can('get_layers')}or *PerlIO::get_layers=sub {return ()}}my%api=(capture=>[1,1,0,0],capture_stdout=>[1,0,0,0],capture_stderr=>[0,1,0,0],capture_merged=>[1,1,1,0],tee=>[1,1,0,1],tee_stdout=>[1,0,0,1],tee_stderr=>[0,1,0,1],tee_merged=>[1,1,1,1],);for my$sub (keys%api){my$args=join q{, },@{$api{$sub}};eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"}our@ISA=qw/Exporter/;our@EXPORT_OK=keys%api;our%EXPORT_TAGS=('all'=>\@EXPORT_OK);my$IS_WIN32=$^O eq 'MSWin32';our$TIMEOUT=30;my@cmd=($^X,'-C0','-e',<<'HERE');sub _relayer {my ($fh,$apply_layers)=@_;binmode($fh,":raw");while (1 < (my$layers=()=PerlIO::get_layers($fh,output=>1))){binmode($fh,":pop")}my@to_apply=@$apply_layers;shift@to_apply;binmode($fh,":" .join(":",@to_apply))}sub _name {my$glob=shift;no strict 'refs';return *{$glob}{NAME}}sub _open {open $_[0],$_[1]or Carp::confess "Error from open(" .join(q{, },@_)."): $!"}sub _close {close $_[0]or Carp::confess "Error from close(" .join(q{, },@_)."): $!"}my%dup;my%proxy_count;sub _proxy_std {my%proxies;if (!defined fileno STDIN){$proxy_count{stdin}++;if (defined$dup{stdin}){_open \*STDIN,"<&=" .fileno($dup{stdin})}else {_open \*STDIN,"<" .File::Spec->devnull;_open$dup{stdin}=IO::Handle->new,"<&=STDIN"}$proxies{stdin}=\*STDIN;binmode(STDIN,':utf8')if $] >= 5.008}if (!defined fileno STDOUT){$proxy_count{stdout}++;if (defined$dup{stdout}){_open \*STDOUT,">&=" .fileno($dup{stdout})}else {_open \*STDOUT,">" .File::Spec->devnull;_open$dup{stdout}=IO::Handle->new,">&=STDOUT"}$proxies{stdout}=\*STDOUT;binmode(STDOUT,':utf8')if $] >= 5.008}if (!defined fileno STDERR){$proxy_count{stderr}++;if (defined$dup{stderr}){_open \*STDERR,">&=" .fileno($dup{stderr})}else {_open \*STDERR,">" .File::Spec->devnull;_open$dup{stderr}=IO::Handle->new,">&=STDERR"}$proxies{stderr}=\*STDERR;binmode(STDERR,':utf8')if $] >= 5.008}return%proxies}sub _unproxy {my (%proxies)=@_;for my$p (keys%proxies){$proxy_count{$p}--;if (!$proxy_count{$p}){_close$proxies{$p};_close$dup{$p}unless $] < 5.008;delete$dup{$p}}}}sub _copy_std {my%handles;for my$h (qw/stdout stderr stdin/){next if$h eq 'stdin' &&!$IS_WIN32;my$redir=$h eq 'stdin' ? "<&" : ">&";_open$handles{$h}=IO::Handle->new(),$redir .uc($h)}return \%handles}sub _open_std {my ($handles)=@_;_open \*STDIN,"<&" .fileno$handles->{stdin}if defined$handles->{stdin};_open \*STDOUT,">&" .fileno$handles->{stdout}if defined$handles->{stdout};_open \*STDERR,">&" .fileno$handles->{stderr}if defined$handles->{stderr}}sub _start_tee {my ($which,$stash)=@_;$stash->{$_}{$which}=IO::Handle->new for qw/tee reader/;pipe$stash->{reader}{$which},$stash->{tee}{$which};select((select($stash->{tee}{$which}),$|=1)[0]);$stash->{new}{$which}=$stash->{tee}{$which};$stash->{child}{$which}={stdin=>$stash->{reader}{$which},stdout=>$stash->{old}{$which},stderr=>$stash->{capture}{$which},};$stash->{flag_files}{$which}=scalar(tmpnam()).$$;if ($IS_WIN32){my$old_eval_err=$@;undef $@;eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";my$os_fhandle=GetOsFHandle($stash->{tee}{$which});my$result=SetHandleInformation($os_fhandle,HANDLE_FLAG_INHERIT(),0);_open_std($stash->{child}{$which});$stash->{pid}{$which}=system(1,@cmd,$stash->{flag_files}{$which});$@=$old_eval_err}else {_fork_exec($which,$stash)}}sub _fork_exec {my ($which,$stash)=@_;my$pid=fork;if (not defined$pid){Carp::confess "Couldn't fork(): $!"}elsif ($pid==0){untie*STDIN;untie*STDOUT;untie*STDERR;_close$stash->{tee}{$which};_open_std($stash->{child}{$which});exec@cmd,$stash->{flag_files}{$which}}$stash->{pid}{$which}=$pid}my$have_usleep=eval "use Time::HiRes 'usleep'; 1";sub _files_exist {return 1 if @_==grep {-f}@_;Time::HiRes::usleep(1000)if$have_usleep;return 0}sub _wait_for_tees {my ($stash)=@_;my$start=time;my@files=values %{$stash->{flag_files}};my$timeout=defined$ENV{PERL_CAPTURE_TINY_TIMEOUT}? $ENV{PERL_CAPTURE_TINY_TIMEOUT}: $TIMEOUT;1 until _files_exist(@files)|| ($timeout && (time - $start > $timeout));Carp::confess "Timed out waiting for subprocesses to start" if!_files_exist(@files);unlink $_ for@files}sub _kill_tees {my ($stash)=@_;if ($IS_WIN32){close($_)for values %{$stash->{tee}};my$start=time;1 until wait==-1 || (time - $start > 30)}else {_close $_ for values %{$stash->{tee}};waitpid $_,0 for values %{$stash->{pid}}}}sub _slurp {my ($name,$stash)=@_;my ($fh,$pos)=map {$stash->{$_}{$name}}qw/capture pos/;seek($fh,$pos,0)or die "Couldn't seek on capture handle for $name\n";my$text=do {local $/;scalar readline$fh};return defined($text)? $text : ""}sub _capture_tee {my ($do_stdout,$do_stderr,$do_merge,$do_tee,$code,@opts)=@_;my%do=($do_stdout ? (stdout=>1): (),$do_stderr ? (stderr=>1): ());Carp::confess("Custom capture options must be given as key/value pairs\n")unless@opts % 2==0;my$stash={capture=>{@opts }};for (keys %{$stash->{capture}}){my$fh=$stash->{capture}{$_};Carp::confess "Custom handle for $_ must be seekable\n" unless ref($fh)eq 'GLOB' || (blessed($fh)&& $fh->isa("IO::Seekable"))}local*CT_ORIG_STDIN=*STDIN ;local*CT_ORIG_STDOUT=*STDOUT;local*CT_ORIG_STDERR=*STDERR;my%layers=(stdin=>[PerlIO::get_layers(\*STDIN)],stdout=>[PerlIO::get_layers(\*STDOUT,output=>1)],stderr=>[PerlIO::get_layers(\*STDERR,output=>1)],);$layers{stdout}=[PerlIO::get_layers(tied*STDOUT)]if tied(*STDOUT)&& (reftype tied*STDOUT eq 'GLOB');$layers{stderr}=[PerlIO::get_layers(tied*STDERR)]if tied(*STDERR)&& (reftype tied*STDERR eq 'GLOB');my%localize;$localize{stdin}++,local(*STDIN)if grep {$_ eq 'scalar'}@{$layers{stdin}};$localize{stdout}++,local(*STDOUT)if$do_stdout && grep {$_ eq 'scalar'}@{$layers{stdout}};$localize{stderr}++,local(*STDERR)if ($do_stderr || $do_merge)&& grep {$_ eq 'scalar'}@{$layers{stderr}};$localize{stdin}++,local(*STDIN),_open(\*STDIN,"<&=0")if tied*STDIN && $] >= 5.008;$localize{stdout}++,local(*STDOUT),_open(\*STDOUT,">&=1")if$do_stdout && tied*STDOUT && $] >= 5.008;$localize{stderr}++,local(*STDERR),_open(\*STDERR,">&=2")if ($do_stderr || $do_merge)&& tied*STDERR && $] >= 5.008;my%proxy_std=_proxy_std();$layers{stdout}=[PerlIO::get_layers(\*STDOUT,output=>1)]if$proxy_std{stdout};$layers{stderr}=[PerlIO::get_layers(\*STDERR,output=>1)]if$proxy_std{stderr};$stash->{old}=_copy_std();$stash->{new}={%{$stash->{old}}};for (keys%do){$stash->{new}{$_}=($stash->{capture}{$_}||= File::Temp->new);seek($stash->{capture}{$_},0,2)or die "Could not seek on capture handle for $_\n";$stash->{pos}{$_}=tell$stash->{capture}{$_};_start_tee($_=>$stash)if$do_tee}_wait_for_tees($stash)if$do_tee;$stash->{new}{stderr}=$stash->{new}{stdout}if$do_merge;_open_std($stash->{new});my ($exit_code,$inner_error,$outer_error,$orig_pid,@result);{$orig_pid=$$;local*STDIN=*CT_ORIG_STDIN if$localize{stdin};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;my$old_eval_err=$@;undef $@;eval {@result=$code->();$inner_error=$@};$exit_code=$?;$outer_error=$@;STDOUT->flush if$do_stdout;STDERR->flush if$do_stderr;$@=$old_eval_err}_open_std($stash->{old});_close($_)for values %{$stash->{old}};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;_unproxy(%proxy_std);_kill_tees($stash)if$do_tee;my%got;if ($orig_pid==$$ and (defined wantarray or ($do_tee && keys%localize))){for (keys%do){_relayer($stash->{capture}{$_},$layers{$_});$got{$_}=_slurp($_,$stash)}print CT_ORIG_STDOUT$got{stdout}if$do_stdout && $do_tee && $localize{stdout};print CT_ORIG_STDERR$got{stderr}if$do_stderr && $do_tee && $localize{stderr}}$?=$exit_code;$@=$inner_error if$inner_error;die$outer_error if$outer_error;return unless defined wantarray;my@return;push@return,$got{stdout}if$do_stdout;push@return,$got{stderr}if$do_stderr &&!$do_merge;push@return,@result;return wantarray ? @return : $return[0]}1; use Fcntl; $SIG{HUP}=sub{exit}; if ( my $fn=shift ) { sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!; print {$fh} $$; close $fh; } my $buf; while (sysread(STDIN, $buf, 2048)) { syswrite(STDOUT, $buf); syswrite(STDERR, $buf); } HERE CAPTURE_TINY $fatpacked{"Class/C3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_C3'; package Class::C3;use strict;use warnings;our$VERSION='0.34';our$C3_IN_CORE;our$C3_XS;BEGIN {if($] > 5.009_004){$C3_IN_CORE=1;require mro}elsif($C3_XS or not defined$C3_XS){my$error=do {local $@;eval {require Class::C3::XS};$@};if ($error){die$error if$error !~ /\blocate\b/;if ($C3_XS){require Carp;Carp::croak("XS explicitly requested but Class::C3::XS is not available")}require Algorithm::C3;require Class::C3::next}else {$C3_XS=1}}}our%MRO;sub _dump_MRO_table {%MRO}our$TURN_OFF_C3=0;our$_initialized=0;sub import {my$class=caller();return if$class eq 'main';return if$TURN_OFF_C3;mro::set_mro($class,'c3')if$C3_IN_CORE;$MRO{$class}=undef unless exists$MRO{$class}}{no warnings 'redefine';sub initialize {%next::METHOD_CACHE=();return unless keys%MRO;if($C3_IN_CORE){mro::set_mro($_,'c3')for keys%MRO}else {if($_initialized){uninitialize();$MRO{$_}=undef foreach keys%MRO}_calculate_method_dispatch_tables();_apply_method_dispatch_tables();$_initialized=1}}sub uninitialize {%next::METHOD_CACHE=();return unless keys%MRO;if($C3_IN_CORE){mro::set_mro($_,'dfs')for keys%MRO}else {_remove_method_dispatch_tables();$_initialized=0}}sub reinitialize {goto&initialize}}sub _calculate_method_dispatch_tables {return if$C3_IN_CORE;my%merge_cache;for my$class (keys%MRO){_calculate_method_dispatch_table($class,\%merge_cache)}}sub _calculate_method_dispatch_table {return if$C3_IN_CORE;my ($class,$merge_cache)=@_;no strict 'refs';my@MRO=calculateMRO($class,$merge_cache);$MRO{$class}={MRO=>\@MRO };my$has_overload_fallback;my%methods;for my$local (@MRO[1 .. $#MRO]){$has_overload_fallback=${"${local}::()"}if!defined$has_overload_fallback && defined ${"${local}::()"};for my$method (grep {defined &{"${local}::$_"}}keys %{"${local}::"}){next unless!defined *{"${class}::$method"}{CODE};$methods{$method}={orig=>"${local}::$method",code=>\&{"${local}::$method"}}unless exists$methods{$method}}}$MRO{$class}->{methods}=\%methods;$MRO{$class}->{has_overload_fallback}=$has_overload_fallback}sub _apply_method_dispatch_tables {return if$C3_IN_CORE;for my$class (keys%MRO){_apply_method_dispatch_table($class)}}sub _apply_method_dispatch_table {return if$C3_IN_CORE;my$class=shift;no strict 'refs';${"${class}::()"}=$MRO{$class}->{has_overload_fallback}if!defined &{"${class}::()"}&& defined$MRO{$class}->{has_overload_fallback};for my$method (keys %{$MRO{$class}->{methods}}){if ($method =~ /^\(/){my$orig=$MRO{$class}->{methods}->{$method}->{orig};${"${class}::$method"}=$$orig if defined $$orig}*{"${class}::$method"}=$MRO{$class}->{methods}->{$method}->{code}}}sub _remove_method_dispatch_tables {return if$C3_IN_CORE;for my$class (keys%MRO){_remove_method_dispatch_table($class)}}sub _remove_method_dispatch_table {return if$C3_IN_CORE;my$class=shift;no strict 'refs';delete ${"${class}::"}{"()"}if$MRO{$class}->{has_overload_fallback};for my$method (keys %{$MRO{$class}->{methods}}){delete ${"${class}::"}{$method}if defined *{"${class}::${method}"}{CODE}&& (*{"${class}::${method}"}{CODE}eq $MRO{$class}->{methods}->{$method}->{code})}}sub calculateMRO {my ($class,$merge_cache)=@_;return Algorithm::C3::merge($class,sub {no strict 'refs';@{$_[0].'::ISA'}},$merge_cache)}sub _core_calculateMRO {@{mro::get_linear_isa($_[0],'c3')}}if($C3_IN_CORE){no warnings 'redefine';*Class::C3::calculateMRO=\&_core_calculateMRO}elsif($C3_XS){no warnings 'redefine';*Class::C3::calculateMRO=\&Class::C3::XS::calculateMRO;*Class::C3::_calculate_method_dispatch_table =\&Class::C3::XS::_calculate_method_dispatch_table}1; CLASS_C3 $fatpacked{"Class/C3/next.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_C3_NEXT'; package next;use strict;use warnings;no warnings 'redefine';use Scalar::Util 'blessed';our$VERSION='0.34';our%METHOD_CACHE;sub method {my$self=$_[0];my$class=blessed($self)|| $self;my$indirect=caller()=~ /^(?:next|maybe::next)$/;my$level=$indirect ? 2 : 1;my ($method_caller,$label,@label);while ($method_caller=(caller($level++))[3]){@label=(split '::',$method_caller);$label=pop@label;last unless $label eq '(eval)' || $label eq '__ANON__'}my$method;my$caller=join '::'=>@label;$method=$METHOD_CACHE{"$class|$caller|$label"}||= do {my@MRO=Class::C3::calculateMRO($class);my$current;while ($current=shift@MRO){last if$caller eq $current}no strict 'refs';my$found;for my$class (@MRO){next if (defined$Class::C3::MRO{$class}&& defined$Class::C3::MRO{$class}{methods}{$label});last if (defined ($found=*{$class .'::' .$label}{CODE}))}$found};return$method if$indirect;die "No next::method '$label' found for $self" if!$method;goto &{$method}}sub can {method($_[0])}package maybe::next;use strict;use warnings;no warnings 'redefine';our$VERSION='0.34';sub method {(next::method($_[0])|| return)->(@_)}1; CLASS_C3_NEXT $fatpacked{"Class/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_TINY'; use 5.006;use strict;no strict 'refs';use warnings;package Class::Tiny;our$VERSION='1.006';use Carp ();require($] >= 5.010 ? "mro.pm" : "MRO/Compat.pm");my%CLASS_ATTRIBUTES;sub import {my$class=shift;my$pkg=caller;$class->prepare_class($pkg);$class->create_attributes($pkg,@_)if @_}sub prepare_class {my ($class,$pkg)=@_;@{"${pkg}::ISA"}="Class::Tiny::Object" unless @{"${pkg}::ISA"}}sub create_attributes {my ($class,$pkg,@spec)=@_;my%defaults=map {ref $_ eq 'HASH' ? %$_ : ($_=>undef)}@spec;my@attr=grep {defined and!ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'"}keys%defaults;$CLASS_ATTRIBUTES{$pkg}{$_}=$defaults{$_}for@attr;$class->_gen_accessor($pkg,$_)for grep {!*{"$pkg\::$_"}{CODE}}@attr;Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub _gen_accessor {my ($class,$pkg,$name)=@_;my$outer_default=$CLASS_ATTRIBUTES{$pkg}{$name};my$sub=$class->__gen_sub_body($name,defined($outer_default),ref($outer_default));eval "package $pkg; my \$default=\$outer_default; $sub";Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub __gen_sub_body {my ($self,$name,$has_default,$default_type)=@_;if ($has_default && $default_type eq 'CODE'){return << "HERE"}elsif ($has_default){return << "HERE"}else {return << "HERE"}}sub get_all_attributes_for {my ($class,$pkg)=@_;my%attr=map {$_=>undef}map {keys %{$CLASS_ATTRIBUTES{$_}|| {}}}@{mro::get_linear_isa($pkg)};return keys%attr}sub get_all_attribute_defaults_for {my ($class,$pkg)=@_;my$defaults={};for my$p (reverse @{mro::get_linear_isa($pkg)}){while (my ($k,$v)=each %{$CLASS_ATTRIBUTES{$p}|| {}}){$defaults->{$k}=$v}}return$defaults}package Class::Tiny::Object;our$VERSION='1.006';my (%HAS_BUILDARGS,%BUILD_CACHE,%DEMOLISH_CACHE,%ATTR_CACHE);my$_PRECACHE=sub {no warnings 'once';my ($class)=@_;my$linear_isa=@{"$class\::ISA"}==1 && ${"$class\::ISA"}[0]eq "Class::Tiny::Object" ? [$class]: mro::get_linear_isa($class);$DEMOLISH_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::DEMOLISH"}@$linear_isa ];$BUILD_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::BUILD"}reverse @$linear_isa ];$HAS_BUILDARGS{$class}=$class->can("BUILDARGS");return$ATTR_CACHE{$class}={map {$_=>1}Class::Tiny->get_all_attributes_for($class)}};sub new {my$class=shift;my$valid_attrs=$ATTR_CACHE{$class}|| $_PRECACHE->($class);my$args;if ($HAS_BUILDARGS{$class}){$args=$class->BUILDARGS(@_)}else {if (@_==1 && ref $_[0]){my%copy=eval {%{$_[0]}};Carp::croak("Argument to $class->new() could not be dereferenced as a hash")if $@;$args=\%copy}elsif (@_ % 2==0){$args={@_}}else {Carp::croak("$class->new() got an odd number of elements")}}my$self=bless {map {$_=>$args->{$_}}grep {exists$valid_attrs->{$_}}keys %$args },$class;$self->BUILDALL($args)if!delete$args->{__no_BUILD__}&& @{$BUILD_CACHE{$class}};return$self}sub BUILDALL {$_->(@_)for @{$BUILD_CACHE{ref $_[0]}}}require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};sub DESTROY {my$self=shift;my$class=ref$self;my$in_global_destruction=defined ${^GLOBAL_PHASE} ? ${^GLOBAL_PHASE} eq 'DESTRUCT' : Devel::GlobalDestruction::in_global_destruction();for my$demolisher (@{$DEMOLISH_CACHE{$class}}){my$e=do {local ($?,$@);eval {$demolisher->($self,$in_global_destruction)};$@};no warnings 'misc';die$e if$e}}1; sub $name { return ( ( \@_ == 1 && exists \$_[0]{$name} ) ? ( \$_[0]{$name} ) : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default->( \$_[0] ) ) ); } HERE sub $name { return ( ( \@_ == 1 && exists \$_[0]{$name} ) ? ( \$_[0]{$name} ) : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default ) ); } HERE sub $name { return \@_ == 1 ? \$_[0]{$name} : ( \$_[0]{$name} = \$_[1] ); } HERE CLASS_TINY $fatpacked{"Devel/GlobalDestruction.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_GLOBALDESTRUCTION'; package Devel::GlobalDestruction;use strict;use warnings;our$VERSION='0.14';use Sub::Exporter::Progressive -setup=>{exports=>[qw(in_global_destruction) ],groups=>{default=>[-all ]},};if (defined ${^GLOBAL_PHASE}){eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1' or die $@}elsif (eval {require Devel::GlobalDestruction::XS;no warnings 'once';*in_global_destruction=\&Devel::GlobalDestruction::XS::in_global_destruction;1}){}else {require B;eval 'sub in_global_destruction () { ${B::main_cv()} == 0 }; 1' or die $@}1; DEVEL_GLOBALDESTRUCTION $fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER'; package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||= 0;our$VERSION='5.72';our (%Cache);sub as_heavy {require Exporter::Heavy;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}my$exports=\@{"$pkg\::EXPORT"};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;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__};*{"$callpkg\::$_"}=\&{"$pkg\::$_"}foreach @_}sub export_fail {my$self=shift;@_}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; EXPORTER $fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY'; package Exporter::Heavy;use strict;no strict 'refs';require Exporter;our$VERSION=$Exporter::VERSION;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 {my$oldwarn=$SIG{__WARN__};local$SIG{__WARN__}=sub {local$SIG{__WARN__}=$oldwarn;my$text=shift;if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//){require Carp;local$Carp::CarpLevel=1;Carp::carp($text)}else {warn$text}};local$SIG{__DIE__}=sub {require Carp;local$Carp::CarpLevel=1;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);unshift@imports,':DEFAULT' if$imports[0]=~ m/^!/;for$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;@names=grep(/$patn/,@allexports)}else {@names=($spec)}warn "Import ".($remove ? "del":"add").": @names " if$Exporter::Verbose;if ($remove){for$sym (@names){delete$imports{$sym}}}else {@imports{@names}=(1)x @names}}@imports=keys%imports}my@carp;for$sym (@imports){if (!$export_cache->{$sym}){if ($sym =~ m/^\d/){$pkg->VERSION($sym);if (@imports==1){@imports=@$exports;last}if (@imports==2 and!$imports[1]){@imports=();last}}elsif ($sym !~ s/^&// ||!$export_cache->{$sym}){unless ($cache_is_current){%$export_cache=();_rebuild_cache ($pkg,$exports,$export_cache);$cache_is_current=1}if (!$export_cache->{$sym}){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){my@expanded=map {/^\w/ ? ($_,'&'.$_): $_}@$fail;warn "${pkg}::EXPORT_FAIL cached: @expanded" if$Exporter::Verbose;@{$fail_cache}{@expanded}=(1)x @expanded}my@failed;for$sym (@imports){push(@failed,$sym)if$fail_cache->{$sym}}if (@failed){@failed=$pkg->export_fail(@failed);for$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;for$sym (@imports){(*{"${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;my$callpkg=caller($level);$pkg->export($callpkg,@_)}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){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/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_CONFIG'; package ExtUtils::Config;$ExtUtils::Config::VERSION='0.008';use strict;use warnings;use Config;use Data::Dumper ();sub new {my ($pack,$args)=@_;return bless {values=>($args ? {%$args }: {}),},$pack}sub get {my ($self,$key)=@_;return exists$self->{values}{$key}? $self->{values}{$key}: $Config{$key}}sub exists {my ($self,$key)=@_;return exists$self->{values}{$key}|| exists$Config{$key}}sub values_set {my$self=shift;return {%{$self->{values}}}}sub all_config {my$self=shift;return {%Config,%{$self->{values}}}}sub serialize {my$self=shift;return$self->{serialized}||= Data::Dumper->new([$self->values_set])->Terse(1)->Sortkeys(1)->Dump}1; EXTUTILS_CONFIG $fatpacked{"ExtUtils/Helpers.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS'; package ExtUtils::Helpers;$ExtUtils::Helpers::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';use Config;use File::Basename qw/basename/;use File::Spec::Functions qw/splitpath canonpath abs2rel splitdir/;use Text::ParseWords 3.24 ();our@EXPORT_OK=qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;BEGIN {my%impl_for=(MSWin32=>'Windows',VMS=>'VMS');my$package='ExtUtils::Helpers::' .($impl_for{$^O}|| 'Unix');my$impl=$impl_for{$^O}|| 'Unix';require "ExtUtils/Helpers/$impl.pm";"ExtUtils::Helpers::$impl"->import()}sub split_like_shell {my ($string)=@_;return if not defined$string;$string =~ s/^\s+|\s+$//g;return if not length$string;return Text::ParseWords::shellwords($string)}sub man1_pagename {my$filename=shift;return basename($filename).".$Config{man1ext}"}my%separator=(MSWin32=>'.',VMS=>'__',os2=>'.',cygwin=>'.',);my$separator=$separator{$^O}|| '::';sub man3_pagename {my ($filename,$base)=@_;$base ||= 'lib';my ($vols,$dirs,$file)=splitpath(canonpath(abs2rel($filename,$base)));$file=basename($file,qw/.pm .pod/);my@dirs=grep {length}splitdir($dirs);return join$separator,@dirs,"$file.$Config{man3ext}"}1; EXTUTILS_HELPERS $fatpacked{"ExtUtils/Helpers/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_UNIX'; package ExtUtils::Helpers::Unix;$ExtUtils::Helpers::Unix::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Carp qw/croak/;use Config;my$layer=$] >= 5.008001 ? ":raw" : "";sub make_executable {my$filename=shift;my$current_mode=(stat$filename)[2]+ 0;if (-T $filename){open my$fh,"<$layer",$filename;my@lines=<$fh>;if (@lines and $lines[0]=~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms){open my$out,">$layer","$filename.new" or croak "Couldn't open $filename.new: $!";print$out @lines;close$out;rename$filename,"$filename.bak" or croak "Couldn't rename $filename to $filename.bak";rename "$filename.new",$filename or croak "Couldn't rename $filename.new to $filename";unlink "$filename.bak"}}chmod$current_mode | oct(111),$filename;return}sub detildefy {my$value=shift;for ($value){s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex}return$value}1; EXTUTILS_HELPERS_UNIX $fatpacked{"ExtUtils/Helpers/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_VMS'; package ExtUtils::Helpers::VMS;$ExtUtils::Helpers::VMS::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use File::Copy qw/copy/;sub make_executable {my$filename=shift;my$batchname="$filename.com";copy($filename,$batchname);ExtUtils::Helpers::Unix::make_executable($batchname);return}sub detildefy {my$arg=shift;return$arg if ($arg =~ /^~~/);return$arg if ($arg =~ /^~ /);if ($arg =~ /^~/){my$spec=$arg;$spec =~ s/^~//;$spec =~ s#^/##;my$home=VMS::Filespec::unixify($ENV{HOME});$home .= '/' unless$home =~ m#/$#;if ($spec eq ''){$home =~ s#/$##;return$home}my ($hvol,$hdir,$hfile)=File::Spec::Unix->splitpath($home);if ($hdir eq ''){$hdir=$hfile}my ($vol,$dir,$file)=File::Spec::Unix->splitpath($spec);my@hdirs=File::Spec::Unix->splitdir($hdir);my@dirs=File::Spec::Unix->splitdir($dir);unless ($arg =~ m#^~/#){shift@dirs}my$newdirs=File::Spec::Unix->catdir(@hdirs,@dirs);$arg=File::Spec::Unix->catpath($hvol,$newdirs,$file)}return$arg} EXTUTILS_HELPERS_VMS $fatpacked{"ExtUtils/Helpers/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_WINDOWS'; package ExtUtils::Helpers::Windows;$ExtUtils::Helpers::Windows::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Config;use Carp qw/carp croak/;use ExtUtils::PL2Bat 'pl2bat';sub make_executable {my$script=shift;if (-T $script && $script !~ / \. (?:bat|cmd) $ /x){pl2bat(in=>$script,update=>1)}return}sub detildefy {my$value=shift;$value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if$ENV{USERPROFILE};return$value}1; EXTUTILS_HELPERS_WINDOWS $fatpacked{"ExtUtils/InstallPaths.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLPATHS'; package ExtUtils::InstallPaths;$ExtUtils::InstallPaths::VERSION='0.011';use 5.006;use strict;use warnings;use File::Spec ();use Carp ();use ExtUtils::Config 0.002;my%complex_accessors=map {$_=>1}qw/prefix_relpaths install_sets/;my%hash_accessors=map {$_=>1}qw/install_path install_base_relpaths original_prefix/;my%defaults=(installdirs=>'site',install_base=>undef,prefix=>undef,verbose=>0,blib=>'blib',create_packlist=>1,dist_name=>undef,module_name=>undef,destdir=>undef,install_path=>sub {{}},install_sets=>\&_default_install_sets,original_prefix=>\&_default_original_prefix,install_base_relpaths=>\&_default_base_relpaths,prefix_relpaths=>\&_default_prefix_relpaths,);sub _merge_shallow {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);$filter->($_)for grep$filter,values %$override;return {%$defaults,%$override }}}sub _merge_deep {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);my$pair_for=sub {my$key=shift;my%override=%{$override->{$key}|| {}};$filter && $filter->($_)for values%override;return$key=>{%{$defaults->{$key}},%override }};return {map {$pair_for->($_)}keys %$defaults }}}my%allowed_installdir=map {$_=>1}qw/core site vendor/;my$must_be_relative=sub {Carp::croak('Value must be a relative path')if File::Spec->file_name_is_absolute($_[0])};my%deep_filter=map {$_=>$must_be_relative}qw/install_base_relpaths prefix_relpaths/;my%filter=(installdirs=>sub {my$value=shift;$value='core',Carp::carp('Perhaps you meant installdirs to be "core" rather than "perl"?')if$value eq 'perl';Carp::croak('installdirs must be one of "core", "site", or "vendor"')if not $allowed_installdir{$value};return$value},(map {$_=>_merge_shallow($_,$deep_filter{$_})}qw/original_prefix install_base_relpaths/),(map {$_=>_merge_deep($_,$deep_filter{$_})}qw/install_sets prefix_relpaths/),);sub new {my ($class,%args)=@_;my$config=$args{config}|| ExtUtils::Config->new;my%self=(config=>$config,map {$_=>exists$args{$_}? $filter{$_}? $filter{$_}->($args{$_},$config): $args{$_}: ref$defaults{$_}? $defaults{$_}->($config): $defaults{$_}}keys%defaults,);$self{module_name}||= do {my$module_name=$self{dist_name};$module_name =~ s/-/::/g;$module_name}if defined$self{dist_name};return bless \%self,$class}for my$attribute (keys%defaults){no strict qw/refs/;*{$attribute}=$hash_accessors{$attribute}? sub {my ($self,$key)=@_;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$key}}: $complex_accessors{$attribute}? sub {my ($self,$installdirs,$key)=@_;Carp::confess("$attribute needs installdir")if not defined$installdirs;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$installdirs}{$key}}: sub {my$self=shift;return$self->{$attribute}}}my$script=$] > 5.008000 ? 'script' : 'bin';my@install_sets_keys=qw/lib arch bin script bindoc libdoc binhtml libhtml/;my@install_sets_tail=('bin',$script,qw/man1dir man3dir html1dir html3dir/);my%install_sets_values=(core=>[qw/privlib archlib/,@install_sets_tail ],site=>[map {"site$_"}qw/lib arch/,@install_sets_tail ],vendor=>[map {"vendor$_"}qw/lib arch/,@install_sets_tail ],);sub _default_install_sets {my$c=shift;my%ret;for my$installdir (qw/core site vendor/){@{$ret{$installdir}}{@install_sets_keys}=map {$c->get("install$_")}@{$install_sets_values{$installdir}}}return \%ret}sub _default_base_relpaths {my$config=shift;return {lib=>['lib','perl5'],arch=>['lib','perl5',$config->get('archname')],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],}}my%common_prefix_relpaths=(bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],);sub _default_prefix_relpaths {my$c=shift;my@libstyle=$c->get('installstyle')? File::Spec->splitdir($c->get('installstyle')): qw(lib perl5);my$arch=$c->get('archname');my$version=$c->get('version');return {core=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},vendor=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},site=>{lib=>[@libstyle,'site_perl'],arch=>[@libstyle,'site_perl',$version,$arch],%common_prefix_relpaths,},}}sub _default_original_prefix {my$c=shift;my%ret=(core=>$c->get('installprefixexp'),site=>$c->get('siteprefixexp'),vendor=>$c->get('usevendorprefix')? $c->get('vendorprefixexp'): '',);return \%ret}sub _log_verbose {my$self=shift;print @_ if$self->verbose;return}sub is_default_installable {my$self=shift;my$type=shift;my$installable=$self->install_destination($type)&& ($self->install_path($type)|| $self->install_sets($self->installdirs,$type));return$installable ? 1 : 0}sub _prefixify_default {my$self=shift;my$type=shift;my$rprefix=shift;my$default=$self->prefix_relpaths($self->installdirs,$type);if(!$default){$self->_log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n");return$rprefix}else {return File::Spec->catdir(@{$default})}}sub _prefixify_novms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;$rprefix .= '/' if$sprefix =~ m{/$};$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n")if defined$path && length$path;if (not defined$path or length$path==0){$self->_log_verbose(" no path to prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}elsif(!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif($path !~ s{^\Q$sprefix\E\b}{}s){$self->_log_verbose(" cannot prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}$self->_log_verbose(" now $path in $rprefix\n");return$path}sub _catprefix_vms {my ($self,$rprefix,$default)=@_;my ($rvol,$rdirs)=File::Spec->splitpath($rprefix);if ($rvol){return File::Spec->catpath($rvol,File::Spec->catdir($rdirs,$default),'')}else {return File::Spec->catdir($rdirs,$default)}}sub _prefixify_vms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;return '' unless defined$path;$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n");require VMS::Filespec;$rprefix=VMS::Filespec::vmspath($rprefix)if$rprefix;$sprefix=VMS::Filespec::vmspath($sprefix)if$sprefix;$self->_log_verbose(" rprefix translated to $rprefix\n sprefix translated to $sprefix\n");if (length($path)==0){$self->_log_verbose(" no path to prefixify.\n")}elsif (!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif ($sprefix eq $rprefix){$self->_log_verbose(" no new prefix.\n")}else {my ($path_vol,$path_dirs)=File::Spec->splitpath($path);my$vms_prefix=$self->config->get('vms_prefix');if ($path_vol eq $vms_prefix.':'){$self->_log_verbose(" $vms_prefix: seen\n");$path_dirs =~ s{^\[}{\[.} unless$path_dirs =~ m{^\[\.};$path=$self->_catprefix_vms($rprefix,$path_dirs)}else {$self->_log_verbose(" cannot prefixify.\n");return File::Spec->catdir($self->prefix_relpaths($self->installdirs,$type))}}$self->_log_verbose(" now $path\n");return$path}BEGIN {*_prefixify=$^O eq 'VMS' ? \&_prefixify_vms : \&_prefixify_novms}sub prefix_relative {my ($self,$installdirs,$type)=@_;my$relpath=$self->install_sets($installdirs,$type);return$self->_prefixify($relpath,$self->original_prefix($installdirs),$type)}sub install_destination {my ($self,$type)=@_;return$self->install_path($type)if$self->install_path($type);if ($self->install_base){my$relpath=$self->install_base_relpaths($type);return$relpath ? File::Spec->catdir($self->install_base,@{$relpath}): undef}if ($self->prefix){my$relpath=$self->prefix_relative($self->installdirs,$type);return$relpath ? File::Spec->catdir($self->prefix,$relpath): undef}return$self->install_sets($self->installdirs,$type)}sub install_types {my$self=shift;my%types=(%{$self->{install_path}},$self->install_base ? %{$self->{install_base_relpaths}}: $self->prefix ? %{$self->{prefix_relpaths}{$self->installdirs }}: %{$self->{install_sets}{$self->installdirs }});return sort keys%types}sub install_map {my ($self,$blib)=@_;$blib ||= $self->blib;my (%map,@skipping);for my$type ($self->install_types){my$localdir=File::Spec->catdir($blib,$type);next unless -e $localdir;if (my$dest=$self->install_destination($type)){$map{$localdir}=$dest}else {push@skipping,$type}}warn "WARNING: Can't figure out install path for types: @skipping\nFiles will not be installed.\n" if@skipping;if ($self->create_packlist and my$module_name=$self->module_name){my$archdir=$self->install_destination('arch');my@ext=split /::/,$module_name;$map{write}=File::Spec->catfile($archdir,'auto',@ext,'.packlist')}if (length(my$destdir=$self->destdir || '')){for (keys%map){my ($volume,$path,$file)=File::Spec->splitpath($map{$_},0);my@dirs=File::Spec->splitdir($path);$path=File::Spec->catdir($destdir,@dirs);if ($file ne ''){$map{$_}=File::Spec->catfile($path,$file)}else {$map{$_}=$path}}}$map{read}='';return \%map}1; EXTUTILS_INSTALLPATHS $fatpacked{"File/Fetch.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_FETCH'; package File::Fetch;use strict;use FileHandle;use File::Temp;use File::Copy;use File::Spec;use File::Spec::Unix;use File::Basename qw[dirname];use Cwd qw[cwd];use Carp qw[carp];use IPC::Cmd qw[can_run run QUOTE];use File::Path qw[mkpath];use File::Temp qw[tempdir];use Params::Check qw[check];use Module::Load::Conditional qw[can_load];use Locale::Maketext::Simple Style=>'gettext';use vars qw[$VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT $BLACKLIST $METHOD_FAIL $VERSION $METHODS $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4];$VERSION='0.56';$VERSION=eval$VERSION;$PREFER_BIN=0;$FROM_EMAIL='File-Fetch@example.com';$USER_AGENT="File::Fetch/$VERSION";$BLACKLIST=[qw|ftp|];push @$BLACKLIST,qw|lftp| if $^O eq 'dragonfly' || $^O eq 'hpux';$METHOD_FAIL={};$FTP_PASSIVE=1;$TIMEOUT=0;$DEBUG=0;$WARN=1;$FORCEIPV4=0;$METHODS={http=>[qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ],https=>[qw|lwp wget curl| ],ftp=>[qw|lwp netftp wget curl lftp fetch ncftp ftp| ],file=>[qw|lwp lftp file| ],rsync=>[qw|rsync| ],git=>[qw|git| ],};local$Params::Check::VERBOSE=1;local$Params::Check::VERBOSE=1;local$Module::Load::Conditional::VERBOSE=0;local$Module::Load::Conditional::VERBOSE=0;local$Module::Load::Conditional::FORCE_SAFE_INC=1;use constant ON_WIN=>($^O eq 'MSWin32');use constant ON_VMS=>($^O eq 'VMS');use constant ON_UNIX=>(!ON_WIN);use constant HAS_VOL=>(ON_WIN);use constant HAS_SHARE=>(ON_WIN);use constant HAS_FETCH=>($^O =~ m!^(freebsd|netbsd|dragonfly)$!);{my$Tmpl={scheme=>{default=>'http' },host=>{default=>'localhost' },path=>{default=>'/' },file=>{required=>1 },uri=>{required=>1 },userinfo=>{default=>'' },vol=>{default=>'' },share=>{default=>'' },file_default=>{default=>'file_default' },tempdir_root=>{required=>1 },_error_msg=>{no_override=>1 },_error_msg_long=>{no_override=>1 },};for my$method (keys %$Tmpl){no strict 'refs';*$method=sub {my$self=shift;$self->{$method}=$_[0]if @_;return$self->{$method}}}sub _create {my$class=shift;my%hash=@_;my$args=check($Tmpl,\%hash)or return;bless$args,$class;if(lc($args->scheme)ne 'file' and not $args->host){return$class->_error(loc("Hostname required when fetching from '%1'",$args->scheme))}for (qw[path]){unless($args->$_()){return$class->_error(loc("No '%1' specified",$_))}}return$args}}sub output_file {my$self=shift;my$file=$self->file;$file =~ s/\?.*$//g;$file ||= $self->file_default;return$file}sub new {my$class=shift;my%hash=@_;my ($uri,$file_default,$tempdir_root);my$tmpl={uri=>{required=>1,store=>\$uri },file_default=>{required=>0,store=>\$file_default },tempdir_root=>{required=>0,store=>\$tempdir_root },};check($tmpl,\%hash)or return;my$href=$class->_parse_uri($uri)or return;$href->{file_default}=$file_default if$file_default;$href->{tempdir_root}=File::Spec->rel2abs($tempdir_root)if$tempdir_root;$href->{tempdir_root}=File::Spec->rel2abs(Cwd::cwd)if not $href->{tempdir_root};my$ff=$class->_create(%$href)or return;return$ff}sub _parse_uri {my$self=shift;my$uri=shift or return;my$href={uri=>$uri };$uri =~ s|^(\w+)://||;$href->{scheme}=$1;if($href->{scheme}eq 'file'){my@parts=split '/',$uri;$href->{host}=$parts[0]|| '';my$index=1;if (HAS_SHARE and not length$parts[0]and not length$parts[1]){$href->{host}=$parts[2]|| '';$href->{share}=$parts[3]|| '';$index=4}elsif (HAS_VOL){$href->{vol}=$parts[1]|| '';$href->{vol}=~ s/\A([A-Z])\|\z/$1:/i if ON_WIN;$index=2}$href->{path}=join '/','',splice(@parts,$index,$#parts)}else {@{$href}{qw(userinfo host path) }=$uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)$|s}{my@parts=File::Spec::Unix->splitpath(delete$href->{path});$href->{path}=$parts[1];$href->{file}=$parts[2]}$href->{host}='' if ($href->{host}eq 'localhost')and ($href->{scheme}eq 'file');return$href}sub fetch {my$self=shift or return;my%hash=@_;my$target;my$tmpl={to=>{default=>cwd(),store=>\$target },};check($tmpl,\%hash)or return;my ($to,$fh);if(ref$target and UNIVERSAL::isa($target,'SCALAR')){$to=tempdir('FileFetch.XXXXXX',DIR=>$self->tempdir_root,CLEANUP=>1)}else {$to=$target;$to=VMS::Filespec::vmspath($to)if ON_VMS;unless(-d $to){eval {mkpath($to)};return$self->_error(loc("Could not create path '%1'",$to))if $@}}local$ENV{FTP_PASSIVE}=$FTP_PASSIVE;my$out_to=ON_WIN ? $to.'/'.$self->output_file : File::Spec->catfile($to,$self->output_file);for my$method (@{$METHODS->{$self->scheme}}){my$sub='_'.$method.'_fetch';unless(__PACKAGE__->can($sub)){$self->_error(loc("Cannot call method for '%1' -- WEIRD!",$method));next}next if grep {lc $_ eq $method}@$BLACKLIST;next if$METHOD_FAIL->{$method};local$IPC::Cmd::USE_IPC_RUN=0;if(my$file=$self->$sub(to=>$out_to)){unless(-e $file && -s _){$self->_error(loc("'%1' said it fetched '%2', "."but it was not created",$method,$file));$METHOD_FAIL->{$method}=1;next}else {if(ref$target and UNIVERSAL::isa($target,'SCALAR')){open my$fh,"<$file" or do {$self->_error(loc("Could not open '%1': %2",$file,$!));return};$$target=do {local $/;<$fh>}}my$abs=File::Spec->rel2abs($file);return$abs}}}return}sub _lwp_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$use_list={LWP=>'0.0','LWP::UserAgent'=>'0.0','HTTP::Request'=>'0.0','HTTP::Status'=>'0.0',URI=>'0.0',};if ($self->scheme eq 'https'){$use_list->{'LWP::Protocol::https'}='0'}unless(can_load(modules=>$use_list)){$METHOD_FAIL->{'lwp'}=1;return}my$uri=URI->new(File::Spec::Unix->catfile($self->path,$self->file));$uri->scheme($self->scheme);$uri->host($self->scheme eq 'file' ? '' : $self->host);if ($self->userinfo){$uri->userinfo($self->userinfo)}elsif ($self->scheme ne 'file'){$uri->userinfo("anonymous:$FROM_EMAIL")}my$ua=LWP::UserAgent->new();$ua->timeout($TIMEOUT)if$TIMEOUT;$ua->agent($USER_AGENT);$ua->from($FROM_EMAIL);$ua->env_proxy;my$res=$ua->mirror($uri,$to)or return;if ($res->code==304 or $res->code==200){return$to}else {return$self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]",$res->code,HTTP::Status::status_message($res->code),$res->status_line))}}sub _httptiny_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$use_list={'HTTP::Tiny'=>'0.008',};unless(can_load(modules=>$use_list)){$METHOD_FAIL->{'httptiny'}=1;return}my$uri=$self->uri;my$http=HTTP::Tiny->new(($TIMEOUT ? (timeout=>$TIMEOUT): ()));my$rc=$http->mirror($uri,$to);unless ($rc->{success}){return$self->_error(loc("Fetch failed! HTTP response: %1 [%2]",$rc->{status},$rc->{reason}))}return$to}sub _httplite_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$use_list={'HTTP::Lite'=>'2.2','MIME::Base64'=>'0',};unless(can_load(modules=>$use_list)){$METHOD_FAIL->{'httplite'}=1;return}my$uri=$self->uri;my$retries=0;RETRIES: while ($retries++ < 5){my$http=HTTP::Lite->new();$http->{timeout}=$TIMEOUT if$TIMEOUT;$http->http11_mode(1);if ($self->userinfo){my$encoded=MIME::Base64::encode($self->userinfo,'');$http->add_req_header("Authorization","Basic $encoded")}my$fh=FileHandle->new;unless ($fh->open($to,'>')){return$self->_error(loc("Could not open '%1' for writing: %2",$to,$!))}$fh->autoflush(1);binmode$fh;my$rc=$http->request($uri,sub {my ($self,$dref,$cbargs)=@_;local $\;print {$cbargs}$$dref},$fh);close$fh;if ($rc==301 || $rc==302){my$loc;HEADERS: for ($http->headers_array){/Location: (\S+)/ and $loc=$1,last HEADERS}if ($loc =~ m!^/!){$uri =~ s{^(\w+?://[^/]+)/.*$}{$1};$uri .= $loc}else {$uri=$loc}next RETRIES}elsif ($rc==200){return$to}else {return$self->_error(loc("Fetch failed! HTTP response: %1 [%2]",$rc,$http->status_message))}}return$self->_error("Fetch failed! Gave up after 5 tries")}sub _iosock_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$use_list={'IO::Socket::INET'=>'0.0','IO::Select'=>'0.0',};unless(can_load(modules=>$use_list)){$METHOD_FAIL->{'iosock'}=1;return}my$sock=IO::Socket::INET->new(PeerHost=>$self->host,($self->host =~ /:/ ? (): (PeerPort=>80)),);unless ($sock){return$self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!))}my$fh=FileHandle->new;unless ($fh->open($to,'>')){return$self->_error(loc("Could not open '%1' for writing: %2",$to,$!))}$fh->autoflush(1);binmode$fh;my$path=File::Spec::Unix->catfile($self->path,$self->file);my$req="GET $path HTTP/1.0\x0d\x0aHost: " .$self->host ."\x0d\x0a\x0d\x0a";$sock->send($req);my$select=IO::Select->new($sock);my$resp='';my$normal=0;while ($select->can_read($TIMEOUT || 60)){my$ret=$sock->sysread($resp,4096,length($resp));if (!defined$ret or $ret==0){$select->remove($sock);$normal++}}close$sock;unless ($normal){return$self->_error(loc("Socket timed out after '%1' seconds",($TIMEOUT || 60)))}$resp =~ s/^(\x0d?\x0a)+//;unless ($resp =~ m!^HTTP/(\d+)\.(\d+)!i){return$self->_error(loc("Did not get a HTTP response from '%1'",$self->host))}my ($code)=$resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i;unless ($code eq '200'){return$self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host))}{local $\;print$fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s)[0]}close$fh;return$to}sub _netftp_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$use_list={'Net::FTP'=>0 };unless(can_load(modules=>$use_list)){$METHOD_FAIL->{'netftp'}=1;return}my$ftp;my@options=($self->host);push(@options,Timeout=>$TIMEOUT)if$TIMEOUT;unless($ftp=Net::FTP->new(@options)){return$self->_error(loc("Ftp creation failed: %1",$@))}unless($ftp->login(anonymous=>$FROM_EMAIL)){return$self->_error(loc("Could not login to '%1'",$self->host))}$ftp->binary;my$remote=File::Spec::Unix->catfile($self->path,$self->file);my$target;unless($target=$ftp->get($remote,$to)){return$self->_error(loc("Could not fetch '%1' from '%2'",$remote,$self->host))}$ftp->quit;return$target}sub _wget_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$wget;unless($wget=can_run('wget')){$METHOD_FAIL->{'wget'}=1;return}my$cmd=[$wget,'--quiet' ];push(@$cmd,'--timeout=' .$TIMEOUT)if$TIMEOUT;push @$cmd,'--passive-ftp' if$FTP_PASSIVE;push @$cmd,'--output-document',$to,$self->uri;my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){1 while unlink$to;return$self->_error(loc("Command failed: %1",$captured || ''))}return$to}sub _lftp_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$lftp;unless($lftp=can_run('lftp')){$METHOD_FAIL->{'lftp'}=1;return}my$cmd=[$lftp,'-f' ];my$fh=File::Temp->new;my$str;$str .= "set net:timeout $TIMEOUT;\n" if$TIMEOUT;$str .= "set ftp:passive-mode 1;\n" if$FTP_PASSIVE;$str .= q[get '].$self->uri .q[' -o ].$to .$/;if($DEBUG){my$pp_str=join ' ',split $/,$str;print "# lftp command: $pp_str\n"}$fh->autoflush(1);print$fh $str;push @$cmd,$fh->filename;my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){1 while unlink$to;return$self->_error(loc("Command failed: %1",$captured || ''))}return$to}sub _ftp_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$ftp;unless($ftp=can_run('ftp')){$METHOD_FAIL->{'ftp'}=1;return}my$fh=FileHandle->new;local$SIG{CHLD}='IGNORE';unless ($fh->open("$ftp -n",'|-')){return$self->_error(loc("%1 creation failed: %2",$ftp,$!))}my@dialog=("lcd " .dirname($to),"open " .$self->host,"user anonymous $FROM_EMAIL","cd /","cd " .$self->path,"binary","get " .$self->file ." " .$self->output_file,"quit",);for (@dialog){$fh->print($_,"\n")}$fh->close or return;return$to}sub _lynx_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$lynx;unless ($lynx=can_run('lynx')){$METHOD_FAIL->{'lynx'}=1;return}unless(IPC::Cmd->can_capture_buffer){$METHOD_FAIL->{'lynx'}=1;return$self->_error(loc("Can not capture buffers. Can not use '%1' to fetch files",'lynx'))}if ($self->uri =~ /^https?:\/\//i){my$cmd=[$lynx,'-head','-source',"-auth=anonymous:$FROM_EMAIL",];push @$cmd,"-connect_timeout=$TIMEOUT" if$TIMEOUT;push @$cmd,$self->uri;my$head;unless(run(command=>$cmd,buffer=>\$head,verbose=>$DEBUG)){return$self->_error(loc("Command failed: %1",$head || ''))}unless($head =~ /^HTTP\/\d+\.\d+ 200\b/){return$self->_error(loc("Command failed: %1",$head || ''))}}my$local=FileHandle->new($to,'w')or return$self->_error(loc("Could not open '%1' for writing: %2",$to,$!));my$cmd=[$lynx,'-source',"-auth=anonymous:$FROM_EMAIL",];push @$cmd,"-connect_timeout=$TIMEOUT" if$TIMEOUT;push @$cmd,$self->uri;my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){return$self->_error(loc("Command failed: %1",$captured || ''))}$local->print($captured);$local->close or return;return$to}sub _ncftp_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;return if$FTP_PASSIVE;my$ncftp;unless($ncftp=can_run('ncftp')){$METHOD_FAIL->{'ncftp'}=1;return}my$cmd=[$ncftp,'-V','-p',$FROM_EMAIL,$self->host,dirname($to),$IPC::Cmd::USE_IPC_RUN ? File::Spec::Unix->catdir($self->path,$self->file): QUOTE.File::Spec::Unix->catdir($self->path,$self->file).QUOTE ];my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){return$self->_error(loc("Command failed: %1",$captured || ''))}return$to}sub _curl_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$curl;unless ($curl=can_run('curl')){$METHOD_FAIL->{'curl'}=1;return}my$cmd=[$curl,'-q' ];push(@$cmd,'-4')if $^O eq 'netbsd' && $FORCEIPV4;push(@$cmd,'--connect-timeout',$TIMEOUT)if$TIMEOUT;push(@$cmd,'--silent')unless$DEBUG;if ($self->scheme eq 'ftp'){push(@$cmd,'--user',"anonymous:$FROM_EMAIL")}push @$cmd,'--fail','--location','--output',$to,$self->uri;my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){return$self->_error(loc("Command failed: %1",$captured || ''))}return$to}sub _fetch_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$fetch;unless(HAS_FETCH and $fetch=can_run('fetch')){$METHOD_FAIL->{'fetch'}=1;return}my$cmd=[$fetch,'-q' ];push(@$cmd,'-T',$TIMEOUT)if$TIMEOUT;local$ENV{'FTP_PASSIVE_MODE'}=1 if$FTP_PASSIVE;push @$cmd,'-o',$to,$self->uri;my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){1 while unlink$to;return$self->_error(loc("Command failed: %1",$captured || ''))}return$to}sub _file_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$path=$self->path;my$vol=$self->vol;my$share=$self->share;my$remote;if (!$share and $self->host){return$self->_error(loc("Currently %1 cannot handle hosts in %2 urls",'File::Fetch','file://'))}if($vol){$path=File::Spec->catdir(split /\//,$path);$remote=File::Spec->catpath($vol,$path,$self->file)}elsif($share){$path =~ s|/+|\\|g;$remote="\\\\".$self->host."\\$share\\$path"}else {my$file_class=ON_VMS ? 'File::Spec::Unix' : 'File::Spec';$remote=$file_class->catfile($path,$self->file)}my$rv=eval {File::Copy::copy($remote,$to)};if(!$rv or $@){return$self->_error(loc("Could not copy '%1' to '%2': %3 %4",$remote,$to,$!,$@))}return$to}sub _rsync_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$rsync;unless ($rsync=can_run('rsync')){$METHOD_FAIL->{'rsync'}=1;return}my$cmd=[$rsync ];push(@$cmd,'--timeout=' .$TIMEOUT)if$TIMEOUT;push(@$cmd,'--quiet')unless$DEBUG;push @$cmd,$self->uri,$to;my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){return$self->_error(loc("Command %1 failed: %2","@$cmd" || '',$captured || ''))}return$to}sub _git_fetch {my$self=shift;my%hash=@_;my ($to);my$tmpl={to=>{required=>1,store=>\$to }};check($tmpl,\%hash)or return;my$git;unless ($git=can_run('git')){$METHOD_FAIL->{'git'}=1;return}my$cmd=[$git,'clone' ];push(@$cmd,'--quiet')unless$DEBUG;push @$cmd,$self->uri,$to;my$captured;unless(run(command=>$cmd,buffer=>\$captured,verbose=>$DEBUG)){return$self->_error(loc("Command %1 failed: %2","@$cmd" || '',$captured || ''))}return$to}sub _error {my$self=shift;my$error=shift;$self->_error_msg($error);$self->_error_msg_long(Carp::longmess($error));if($WARN){carp$DEBUG ? $self->_error_msg_long : $self->_error_msg}return}sub error {my$self=shift;return shift()? $self->_error_msg_long : $self->_error_msg}1; FILE_FETCH $fatpacked{"File/Path.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PATH'; package File::Path;use 5.005_04;use strict;use Cwd 'getcwd';use File::Basename ();use File::Spec ();BEGIN {if ($] < 5.006){eval 'use Symbol'}}use Exporter ();use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);$VERSION='2.15';$VERSION=eval$VERSION;@ISA=qw(Exporter);@EXPORT=qw(mkpath rmtree);@EXPORT_OK=qw(make_path remove_tree);BEGIN {for (qw(VMS MacOS MSWin32 os2)){no strict 'refs';*{"_IS_\U$_"}=$^O eq $_ ? sub () {1}: sub () {0}}*_FORCE_WRITABLE=(grep {$^O eq $_}qw(amigaos dos epoc MSWin32 MacOS os2))? sub () {1}: sub () {0};*_NEED_STAT_CHECK=!(_IS_MSWIN32())? sub () {1}: sub () {0}}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 __is_arg {my ($arg)=@_;return (ref$arg eq 'HASH')}sub make_path {push @_,{}unless @_ and __is_arg($_[-1]);goto&mkpath}sub mkpath {my$old_style=!(@_ and __is_arg($_[-1]));my$data;my$paths;if ($old_style){my ($verbose,$mode);($paths,$verbose,$mode)=@_;$paths=[$paths]unless UNIVERSAL::isa($paths,'ARRAY');$data->{verbose}=$verbose;$data->{mode}=defined$mode ? $mode : oct '777'}else {my%args_permitted=map {$_=>1}(qw|chmod error group mask mode owner uid user verbose|);my%not_on_win32_args=map {$_=>1}(qw|group owner uid user|);my@bad_args=();my@win32_implausible_args=();my$arg=pop @_;for my$k (sort keys %{$arg}){if (!$args_permitted{$k}){push@bad_args,$k}elsif ($not_on_win32_args{$k}and _IS_MSWIN32){push@win32_implausible_args,$k}else {$data->{$k}=$arg->{$k}}}_carp("Unrecognized option(s) passed to mkpath() or make_path(): @bad_args")if@bad_args;_carp("Option(s) implausible on Win32 passed to mkpath() or make_path(): @win32_implausible_args")if@win32_implausible_args;$data->{mode}=delete$data->{mask}if exists$data->{mask};$data->{mode}=oct '777' unless exists$data->{mode};${$data->{error}}=[]if exists$data->{error};unless (@win32_implausible_args){$data->{owner}=delete$data->{user}if exists$data->{user};$data->{owner}=delete$data->{uid}if exists$data->{uid};if (exists$data->{owner}and $data->{owner}=~ /\D/){my$uid=(getpwnam$data->{owner})[2];if (defined$uid){$data->{owner}=$uid}else {_error($data,"unable to map $data->{owner} to a uid, ownership not changed");delete$data->{owner}}}if (exists$data->{group}and $data->{group}=~ /\D/){my$gid=(getgrnam$data->{group})[2];if (defined$gid){$data->{group}=$gid}else {_error($data,"unable to map $data->{group} to a gid, group ownership not changed");delete$data->{group}}}if (exists$data->{owner}and not exists$data->{group}){$data->{group}=-1}if (exists$data->{group}and not exists$data->{owner}){$data->{owner}=-1}}$paths=[@_]}return _mkpath($data,$paths)}sub _mkpath {my$data=shift;my$paths=shift;my (@created);for my$path (@{$paths}){next unless defined($path)and length($path);$path .= '/' if _IS_OS2 and $path =~ /^\w:\z/s;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($data,[$parent]))}print "mkdir $path\n" if$data->{verbose};if (mkdir($path,$data->{mode})){push(@created,$path);if (exists$data->{owner}){if (!chown$data->{owner},$data->{group},$path){_error($data,"Cannot change ownership of $path to $data->{owner}:$data->{group}")}}if (exists$data->{chmod}){if (!chmod$data->{chmod},$path){_error($data,"Cannot change permissions of $path to $data->{chmod}")}}}else {my$save_bang=$!;my ($e,$e1)=($save_bang,$^E);$e .= "; $e1" if$e ne $e1;if (!-d $path){$!=$save_bang;if ($data->{error}){push @{${$data->{error}}},{$path=>$e }}else {_croak("mkdir $path: $e")}}}}return@created}sub remove_tree {push @_,{}unless @_ and __is_arg($_[-1]);goto&rmtree}sub _is_subdir {my ($dir,$test)=@_;my ($dv,$dd)=File::Spec->splitpath($dir,1);my ($tv,$td)=File::Spec->splitpath($test,1);return 0 if$dv ne $tv;my@d=File::Spec->splitdir($dd);my@t=File::Spec->splitdir($td);return 0 if@t < @d;return join('/',@d)eq join('/',splice@t,0,+@d)}sub rmtree {my$old_style=!(@_ and __is_arg($_[-1]));my ($arg,$data,$paths);if ($old_style){my ($verbose,$safe);($paths,$verbose,$safe)=@_;$data->{verbose}=$verbose;$data->{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 {my%args_permitted=map {$_=>1}(qw|error keep_root result safe verbose|);my@bad_args=();my$arg=pop @_;for my$k (sort keys %{$arg}){if (!$args_permitted{$k}){push@bad_args,$k}else {$data->{$k}=$arg->{$k}}}_carp("Unrecognized option(s) passed to remove_tree(): @bad_args")if@bad_args;${$data->{error}}=[]if exists$data->{error};${$data->{result}}=[]if exists$data->{result};$paths=[@_]}$data->{prefix}='';$data->{depth}=0;my@clean_path;$data->{cwd}=getcwd()or do {_error($data,"cannot fetch initial working directory");return 0};for ($data->{cwd}){/\A(.*)\Z/s;$_=$1}for my$p (@$paths){my$ortho_root=_IS_MSWIN32 ? _slash_lc($p): $p;my$ortho_cwd=_IS_MSWIN32 ? _slash_lc($data->{cwd}): $data->{cwd};my$ortho_root_length=length($ortho_root);$ortho_root_length-- if _IS_VMS;if ($ortho_root_length && _is_subdir($ortho_root,$ortho_cwd)){local $!=0;_error($data,"cannot remove path when cwd is $data->{cwd}",$p);next}if (_IS_MACOS){$p=":$p" unless$p =~ /:/;$p .= ":" unless$p =~ /:\z/}elsif (_IS_MSWIN32){$p =~ s{[/\\]\z}{}}else {$p =~ s{/\z}{}}push@clean_path,$p}@{$data}{qw(device inode)}=(lstat$data->{cwd})[0,1 ]or do {_error($data,"cannot stat initial working directory",$data->{cwd});return 0};return _rmtree($data,\@clean_path)}sub _rmtree {my$data=shift;my$paths=shift;my$count=0;my$curdir=File::Spec->curdir();my$updir=File::Spec->updir();my (@files,$root);ROOT_DIR: foreach my$root (@$paths){my$canon=$data->{prefix}? File::Spec->catfile($data->{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)){my$root_fh;if (open($root_fh,'<',$root)){my ($fh_dev,$fh_inode)=(stat$root_fh)[0,1];$perm &= oct '7777';my$nperm=$perm | oct '700';local $@;if (!($data->{safe}or $nperm==$perm or!-d _ or $fh_dev ne $ldev or $fh_inode ne $lino or eval {chmod($nperm,$root_fh)})){_error($data,"cannot make child directory read-write-exec",$canon);next ROOT_DIR}close$root_fh}if (!chdir($root)){_error($data,"cannot chdir to child",$canon);next ROOT_DIR}}my ($cur_dev,$cur_inode,$perm)=(stat$curdir)[0,1,2 ]or do {_error($data,"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 &= oct '7777';my$nperm=$perm | oct '700';if (!($data->{safe}or $nperm==$perm or chmod($nperm,$curdir))){_error($data,"cannot make directory read+writeable",$canon);$nperm=$perm}my$d;$d=gensym()if $] < 5.006;if (!opendir$d,$curdir){_error($data,"cannot opendir",$canon);@files=()}else {if (!defined ${^TAINT} or ${^TAINT}){@files=map {/\A(.*)\z/s;$1}readdir$d}else {@files=readdir$d}closedir$d}if (_IS_VMS){@files=map {$_ eq '.' ? '.;' : $_}reverse@files}@files=grep {$_ ne $updir and $_ ne $curdir}@files;if (@files){my$narg={%$data};@{$narg}{qw(device inode cwd prefix depth)}=($cur_dev,$cur_inode,$updir,$canon,$data->{depth}+ 1);$count += _rmtree($narg,\@files)}if ($nperm!=$perm and not chmod($perm,$curdir)){_error($data,"cannot reset chmod",$canon)}chdir($data->{cwd})or _croak("cannot chdir to $data->{cwd} from $canon: $!, aborting.");($cur_dev,$cur_inode)=(stat$curdir)[0,1 ]or _croak("cannot stat prior working directory $data->{cwd}: $!, aborting.");if (_NEED_STAT_CHECK){($data->{device}eq $cur_dev and $data->{inode}eq $cur_inode)or _croak("previous directory $data->{cwd} " ."changed before entering $canon, " ."expected dev=$ldev ino=$lino, " ."actual dev=$cur_dev ino=$cur_inode, aborting.")}if ($data->{depth}or!$data->{keep_root}){if ($data->{safe}&& (_IS_VMS ?!&VMS::Filespec::candelete($root):!-w $root)){print "skipped $root\n" if$data->{verbose};next ROOT_DIR}if (_FORCE_WRITABLE and!chmod$perm | oct '700',$root){_error($data,"cannot make directory writeable",$canon)}print "rmdir $root\n" if$data->{verbose};if (rmdir$root){push @{${$data->{result}}},$root if$data->{result};++$count}else {_error($data,"cannot remove directory",$canon);if (_FORCE_WRITABLE &&!chmod($perm,(_IS_VMS ? VMS::Filespec::fileify($root): $root))){_error($data,sprintf("cannot restore permissions to 0%o",$perm),$canon)}}}}else {$root=VMS::Filespec::vmsify("./$root")if _IS_VMS &&!File::Spec->file_name_is_absolute($root)&& ($root !~ m/(?]+/);if ($data->{safe}&& (_IS_VMS ?!&VMS::Filespec::candelete($root):!(-l $root || -w $root))){print "skipped $root\n" if$data->{verbose};next ROOT_DIR}my$nperm=$perm & oct '7777' | oct '600';if (_FORCE_WRITABLE and $nperm!=$perm and not chmod$nperm,$root){_error($data,"cannot make file writeable",$canon)}print "unlink $canon\n" if$data->{verbose};for (;;){if (unlink$root){push @{${$data->{result}}},$root if$data->{result}}else {_error($data,"cannot unlink file",$canon);_FORCE_WRITABLE and chmod($perm,$root)or _error($data,sprintf("cannot restore permissions to 0%o",$perm),$canon);last}++$count;last unless _IS_VMS && lstat$root}}}return$count}sub _slash_lc {my$path=shift;$path =~ tr{\\}{/};return lc($path)}1; FILE_PATH $fatpacked{"File/Temp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_TEMP'; package File::Temp;our$VERSION='0.2304';use 5.006;use strict;use Carp;use File::Spec 0.8;use Cwd ();use File::Path 2.06 qw/rmtree/;use Fcntl 1.03;use IO::Seekable;use Errno;use Scalar::Util 'refaddr';require VMS::Stdio if $^O eq 'VMS';eval {require Carp::Heavy};require Symbol if $] < 5.006;use parent 0.221 qw/IO::Handle IO::Seekable/;use overload '""'=>"STRINGIFY",'0+'=>"NUMIFY",fallback=>1;use vars qw(@EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);$DEBUG=0;$KEEP_ALL=0;use Exporter 5.57 'import';@EXPORT_OK=qw{tempfile tempdir tmpnam tmpfile mktemp mkstemp mkstemps mkdtemp unlink0 cleanup SEEK_SET SEEK_CUR SEEK_END};%EXPORT_TAGS=('POSIX'=>[qw/tmpnam tmpfile/],'mktemp'=>[qw/mktemp mkstemp mkstemps mkdtemp/],'seekable'=>[qw/SEEK_SET SEEK_CUR SEEK_END/],);Exporter::export_tags('POSIX','mktemp','seekable');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 _/);use constant MAX_TRIES=>1000;use constant MINX=>4;use constant TEMPXXX=>'X' x 10;use constant STANDARD=>0;use constant MEDIUM=>1;use constant HIGH=>2;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 {local$SIG{__DIE__}=sub {};local$SIG{__WARN__}=sub {};$bit=&$func();1}}$LOCKFLAG=eval {local$SIG{__DIE__}=sub {};local$SIG{__WARN__}=sub {};&Fcntl::O_EXLOCK()}}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 {local$SIG{__DIE__}=sub {};local$SIG{__WARN__}=sub {};$bit=&$func();1}}}my%FILES_CREATED_BY_OBJECT;sub _gettemp {croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);' unless scalar(@_)>= 1;my$tempErrStr;my%options=("open"=>0,"mkdir"=>0,"suffixlen"=>0,"unlink_on_close"=>0,"use_exlock"=>1,"ErrStr"=>\$tempErrStr,);my$template=shift;if (ref($template)){carp "File::Temp::_gettemp: template must not be a reference";return ()}if (scalar(@_)% 2!=0){carp "File::Temp::_gettemp: Must have even number of options";return ()}%options=(%options,@_)if @_;${$options{ErrStr}}=undef;if ($options{"open"}&& $options{"mkdir"}){${$options{ErrStr}}="doopen and domkdir can not both be true\n";return ()}my$start=length($template)- 1 - $options{"suffixlen"};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 ()}my$path=_replace_XX($template,$options{"suffixlen"});my ($volume,$directories,$file);my$parent;if ($options{"mkdir"}){($volume,$directories,$file)=File::Spec->splitpath($path,1);my@dirs=File::Spec->splitdir($directories);if ($#dirs==0){$parent=File::Spec->curdir}else {if ($^O eq 'VMS'){$parent=File::Spec->catdir($volume,@dirs[0..$#dirs-1]);$parent='sys$disk:[]' if$parent eq ''}else {$parent=File::Spec->catdir(@dirs[0..$#dirs-1]);$parent=File::Spec->catpath($volume,$parent,'')}}}else {($volume,$directories,$file)=File::Spec->splitpath($path);$parent=File::Spec->catpath($volume,$directories,'');$parent=File::Spec->curdir unless$directories ne ''}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 ()}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 ()}}for (my$i=0;$i < MAX_TRIES;$i++){if ($options{"open"}){my$fh;if ($] < 5.006){$fh=&Symbol::gensym}local $^F=2;my$open_success=undef;if ($^O eq 'VMS' and $options{"unlink_on_close"}&&!$KEEP_ALL){$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){chmod(0600,$path);return ($fh,$path)}else {unless ($!{EEXIST}){${$options{ErrStr}}="Could not create temp file $path: $!";return ()}}}elsif ($options{"mkdir"}){if (mkdir($path,0700)){chmod(0700,$path);return undef,$path}else {unless ($!{EEXIST}){${$options{ErrStr}}="Could not create directory $path: $!";return ()}}}else {return (undef,$path)unless -e $path}my$original=$path;my$counter=0;my$MAX_GUESS=50;do {$path=_replace_XX($template,$options{"suffixlen"});$counter++}until ($path ne $original || $counter > $MAX_GUESS);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 ()}}${$options{ErrStr}}="Have exceeded the maximum number of attempts (" .MAX_TRIES .") to open temp file/dir";return ()}sub _replace_XX {croak 'Usage: _replace_XX($template, $ignore)' unless scalar(@_)==2;my ($path,$ignore)=@_;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}sub _force_writable {my$file=shift;chmod 0600,$file}sub _is_safe {my$path=shift;my$err_ref=shift;my@info=stat($path);unless (scalar(@info)){$$err_ref="stat(path) returned no values";return 0};return 1 if $^O eq 'VMS';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}if (($info[2]& &Fcntl::S_IWGRP)|| ($info[2]& &Fcntl::S_IWOTH)){unless (-d $path){$$err_ref="Path ($path) is not a directory" if ref($err_ref);return 0}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}sub _is_verysafe {require POSIX;my$path=shift;print "_is_verysafe testing $path\n" if$DEBUG;return 1 if $^O eq 'VMS';my$err_ref=shift;local($@);my$chown_restricted;$chown_restricted=&POSIX::_PC_CHOWN_RESTRICTED()if eval {&POSIX::_PC_CHOWN_RESTRICTED();1};if (defined$chown_restricted){return _is_safe($path,$err_ref)if POSIX::sysconf($chown_restricted)}unless (File::Spec->file_name_is_absolute($path)){$path=File::Spec->rel2abs($path)}my ($volume,$directories,undef)=File::Spec->splitpath($path,1);my@dirs=File::Spec->splitdir($directories);for my$pos (0.. $#dirs){my$dir=File::Spec->catpath($volume,File::Spec->catdir(@dirs[0.. $#dirs - $pos]),'');print "TESTING DIR $dir\n" if$DEBUG;return 0 unless _is_safe($dir,$err_ref)}return 1}sub _can_unlink_opened_file {if (grep {$^O eq $_}qw/MSWin32 os2 VMS dos MacOS haiku/){return 0}else {return 1}}sub _can_do_level {my$level=shift;return 1 if$level==STANDARD;if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix'){return 0}else {return 1}}{my (%files_to_unlink,%dirs_to_unlink);END {local($.,$@,$!,$^E,$?);cleanup(at_exit=>1)}sub cleanup {my%h=@_;my$at_exit=delete$h{at_exit};$at_exit=0 if not defined$at_exit;{my@k=sort keys%h;die "unrecognized parameters: @k" if@k}if (!$KEEP_ALL){my@files=(exists$files_to_unlink{$$}? @{$files_to_unlink{$$}}: ());for my$file (@files){close($file->[0]);if (-f $file->[1]){_force_writable($file->[1]);unlink$file->[1]or warn "Error removing ".$file->[1]}}my@dirs=(exists$dirs_to_unlink{$$}? @{$dirs_to_unlink{$$}}: ());my ($cwd,$cwd_to_remove);for my$dir (@dirs){if (-d $dir){if ($at_exit){$cwd=Cwd::abs_path(File::Spec->curdir)if not defined$cwd;my$abs=Cwd::abs_path($dir);if ($abs eq $cwd){$cwd_to_remove=$dir;next}}eval {rmtree($dir,$DEBUG,0)};warn $@ if ($@ && $^W)}}if (defined$cwd_to_remove){chdir$cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!";my$updir=File::Spec->updir;chdir$updir or die "cannot chdir to $updir: $!";eval {rmtree($cwd_to_remove,$DEBUG,0)};warn $@ if ($@ && $^W)}@{$files_to_unlink{$$}}=()if exists$files_to_unlink{$$};@{$dirs_to_unlink{$$}}=()if exists$dirs_to_unlink{$$}}}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;$fname=Cwd::abs_path($fname);($fname)=$fname =~ /^(.*)$/;if ($isdir){if (-d $fname){$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){$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}}}}sub _parse_args {my$leading_template=(scalar(@_)% 2==1 ? shift(@_): '');my%args=@_;%args=map {uc($_),$args{$_}}keys%args;my@template=(exists$args{TEMPLATE}? $args{TEMPLATE}: $leading_template ? $leading_template : ());delete$args{TEMPLATE};return(\@template,\%args)}sub new {my$proto=shift;my$class=ref($proto)|| $proto;my ($maybe_template,$args)=_parse_args(@_);my$unlink=(exists$args->{UNLINK}? $args->{UNLINK}: 1);delete$args->{UNLINK};delete$args->{OPEN};my ($fh,$path)=tempfile(@$maybe_template,%$args);print "Tmp: $fh - $path\n" if$DEBUG;${*$fh}=$path;$FILES_CREATED_BY_OBJECT{$$}{$path}=1;%{*$fh}=%$args;bless$fh,$class;$fh->unlink_on_destroy($unlink);return$fh}sub newdir {my$self=shift;my ($maybe_template,$args)=_parse_args(@_);my$cleanup=(exists$args->{CLEANUP}? $args->{CLEANUP}: 1);delete$args->{CLEANUP};my$tempdir=tempdir(@$maybe_template,%$args);my$real_dir=Cwd::abs_path($tempdir);($real_dir)=$real_dir =~ /^(.*)$/;return bless {DIRNAME=>$tempdir,REALNAME=>$real_dir,CLEANUP=>$cleanup,LAUNCHPID=>$$,},"File::Temp::Dir"}sub filename {my$self=shift;return ${*$self}}sub STRINGIFY {my$self=shift;return$self->filename}sub NUMIFY {return refaddr($_[0])}sub unlink_on_destroy {my$self=shift;if (@_){${*$self}{UNLINK}=shift}return ${*$self}{UNLINK}}sub DESTROY {local($.,$@,$!,$^E,$?);my$self=shift;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;return unless$was_created_by_proc;_force_writable($file);unlink1($self,$file)or unlink($file)}}sub tempfile {if (@_ && $_[0]eq 'File::Temp'){croak "'tempfile' can't be called as a method"}my%options=("DIR"=>undef,"SUFFIX"=>'',"UNLINK"=>0,"OPEN"=>1,"TMPDIR"=>0,"EXLOCK"=>1,);my ($maybe_template,$args)=_parse_args(@_);my$template=@$maybe_template ? $maybe_template->[0]: undef;%options=(%options,%$args);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'){$options{"DIR"}=VMS::Filespec::vmspath($options{"DIR"})}if (defined$template){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)}}$template .= $options{"SUFFIX"};my$unlink_on_close=(wantarray ? 0 : 1);my ($fh,$path,$errstr);croak "Error in tempfile() using template $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},));_deferred_unlink($fh,$path,0)if$options{"UNLINK"};if (wantarray()){if ($options{'OPEN'}){return ($fh,$path)}else {return (undef,$path)}}else {unlink0($fh,$path)or croak "Error unlinking file $path using unlink0";return$fh}}sub tempdir {if (@_ && $_[0]eq 'File::Temp'){croak "'tempdir' can't be called as a method"}my%options=("CLEANUP"=>0,"DIR"=>'',"TMPDIR"=>0,);my ($maybe_template,$args)=_parse_args(@_);my$template=@$maybe_template ? $maybe_template->[0]: undef;%options=(%options,%$args);if (defined$template){if ($options{'TMPDIR'}|| $options{'DIR'}){$template=VMS::Filespec::vmspath($template)if $^O eq 'VMS';my ($volume,$directories,undef)=File::Spec->splitpath($template,1);$template=(File::Spec->splitdir($directories))[-1];if ($options{"DIR"}){$template=File::Spec->catdir($options{"DIR"},$template)}elsif ($options{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)}}my$tempdir;my$suffixlen=0;if ($^O eq 'VMS'){$template =~ m/([\.\]:>]+)$/;$suffixlen=length($1)}if (($^O eq 'MacOS')&& (substr($template,-1)eq ':')){++$suffixlen}my$errstr;croak "Error in tempdir() using $template: $errstr" unless ((undef,$tempdir)=_gettemp($template,"open"=>0,"mkdir"=>1,"suffixlen"=>$suffixlen,"ErrStr"=>\$errstr,));if ($options{'CLEANUP'}&& -d $tempdir){_deferred_unlink(undef,$tempdir,1)}return$tempdir}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}}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}}sub mkdtemp {croak "Usage: mkdtemp(template)" if scalar(@_)!=1;my$template=shift;my$suffixlen=0;if ($^O eq 'VMS'){$template =~ m/([\.\]:>]+)$/;$suffixlen=length($1)}if (($^O eq 'MacOS')&& (substr($template,-1)eq ':')){++$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}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}sub tmpnam {my$tmpdir=File::Spec->tmpdir;croak "Error temporary directory is not writable" if$tmpdir eq '';my$template=File::Spec->catfile($tmpdir,TEMPXXX);if (wantarray()){return mkstemp($template)}else {return mktemp($template)}}sub tmpfile {my ($fh,$file)=tmpnam();unlink0($fh,$file)or return undef;return$fh}sub tempnam {croak 'Usage tempnam($dir, $prefix)' unless scalar(@_)==2;my ($dir,$prefix)=@_;$prefix .= 'XXXXXXXX';my$template=File::Spec->catfile($dir,$prefix);return mktemp($template)}sub unlink0 {croak 'Usage: unlink0(filehandle, filename)' unless scalar(@_)==2;my ($fh,$path)=@_;cmpstat($fh,$path)or return 0;if (_can_unlink_opened_file()){return 1 if$KEEP_ALL;croak "unlink0: $path has become a directory!" if -d $path;unlink($path)or return 0;my@fh=stat$fh;print "Link count = $fh[3] \n" if$DEBUG;return 1 if$fh[3]==0 || $^O eq 'cygwin'}_deferred_unlink($fh,$path,0);return 1}sub cmpstat {croak 'Usage: cmpstat(filehandle, filename)' unless scalar(@_)==2;my ($fh,$path)=@_;warn "Comparing stat\n" if$DEBUG;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}my@path=stat$path;unless (@path){carp "unlink0: $path is gone already" if $^W;return}unless (-f $path){confess "panic: $path is no longer a file: SB=@fh"}my@okstat=(0..$#fh);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'){@okstat=(0,1)}elsif ($^O eq 'dos'){@okstat=(0,2..7,11..$#fh)}elsif ($^O eq 'mpeix'){@okstat=(0..4,8..10)}for (@okstat){print "Comparing: $_ : $fh[$_] and $path[$_]\n" if$DEBUG;unless ($fh[$_]eq $path[$_]){warn "Did not match $_ element of stat\n" if$DEBUG;return 0}}return 1}sub unlink1 {croak 'Usage: unlink1(filehandle, filename)' unless scalar(@_)==2;my ($fh,$path)=@_;cmpstat($fh,$path)or return 0;close($fh)or return 0;_force_writable($path);return 1 if$KEEP_ALL;return unlink($path)}{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 {if ($] < 5.006 && $level!=STANDARD){croak "Currently requires perl 5.006 or newer to do the safe checks"}$LEVEL=$level if _can_do_level($level)}}return$LEVEL}}{my$TopSystemUID=10;$TopSystemUID=197108 if $^O eq 'interix';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}}package File::Temp::Dir;use File::Path qw/rmtree/;use strict;use overload '""'=>"STRINGIFY",'0+'=>\&File::Temp::NUMIFY,fallback=>1;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->{REALNAME}){eval {rmtree($self->{REALNAME},$File::Temp::DEBUG,0)};warn $@ if ($@ && $^W)}}}1; FILE_TEMP $fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH'; package File::Which;use strict;use warnings;use Exporter ();use File::Spec ();our$VERSION='1.22';our@ISA='Exporter';our@EXPORT='which';our@EXPORT_OK='where';use constant IS_VMS=>($^O eq 'VMS');use constant IS_MAC=>($^O eq 'MacOS');use constant IS_DOS=>($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');use constant IS_CYG=>($^O eq 'cygwin' || $^O eq 'msys');my@PATHEXT=('');if (IS_DOS){if ($ENV{PATHEXT}){push@PATHEXT,split ';',$ENV{PATHEXT}}else {push@PATHEXT,qw{.com .exe .bat}}}elsif (IS_VMS){push@PATHEXT,qw{.exe .com}}elsif (IS_CYG){push@PATHEXT,qw{.exe .com}}sub which {my ($exec)=@_;return undef unless defined$exec;return undef if$exec eq '';my$all=wantarray;my@results=();if (IS_VMS){my$symbol=`SHOW SYMBOL $exec`;chomp($symbol);unless ($?){return$symbol unless$all;push@results,$symbol}}if (IS_MAC){my@aliases=split /\,/,$ENV{Aliases};for my$alias (@aliases){if (lc($alias)eq lc($exec)){chomp(my$file=`Alias $alias`);last unless$file;return$file unless$all;push@results,$file;last}}}return$exec if!IS_VMS and!IS_MAC and!IS_DOS and $exec =~ /\// and -f $exec and -x $exec;my@path=File::Spec->path;if (IS_DOS or IS_VMS or IS_MAC){unshift@path,File::Spec->curdir}for my$base (map {File::Spec->catfile($_,$exec)}@path){for my$ext (@PATHEXT){my$file=$base.$ext;next if -d $file;if (-x _ or (IS_MAC || ((IS_DOS or IS_CYG)and grep {$file =~ /$_\z/i}@PATHEXT[1..$#PATHEXT])and -e _)){return$file unless$all;push@results,$file}}}if ($all){return@results}else {return undef}}sub where {my@res=which($_[0]);return@res}1; FILE_WHICH $fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD'; use strict;use warnings;package File::pushd;our$VERSION='1.014';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {File::Spec->canonpath($_[0]->{_pushd})},fallback=>1;sub pushd {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::pushd in void context');return}my ($target_dir,$options)=@_;$options->{untaint_pattern}||= qr{^([-+@\w./]+)$};$target_dir="." unless defined$target_dir;croak "Can't locate directory $target_dir" unless -d $target_dir;my$tainted_orig=getcwd;my$orig;if ($tainted_orig =~ $options->{untaint_pattern}){$orig=$1}else {$orig=$tainted_orig}my$tainted_dest;eval {$tainted_dest=$target_dir ? abs_path($target_dir): $orig};croak "Can't locate absolute path for $target_dir: $@" if $@;my$dest;if ($tainted_dest =~ $options->{untaint_pattern}){$dest=$1}else {$dest=$tainted_dest}if ($dest ne $orig){chdir$dest or croak "Can't chdir to $dest\: $!"}my$self=bless {_pushd=>$dest,_original=>$orig },__PACKAGE__;return$self}sub tempd {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::tempd in void context');return}my ($options)=@_;my$dir;eval {$dir=pushd(File::Temp::tempdir(CLEANUP=>0),$options)};croak $@ if $@;$dir->{_tempd}=1;return$dir}sub preserve {my$self=shift;return 1 if!$self->{"_tempd"};if (@_==0){return$self->{_preserve}=1}else {return$self->{_preserve}=$_[0]? 1 : 0}}sub DESTROY {my ($self)=@_;my$orig=$self->{_original};chdir$orig if$orig;if ($self->{_tempd}&&!$self->{_preserve}){my$err=do {local $@;eval {rmtree($self->{_pushd})};$@};carp$err if$err}}1; FILE_PUSHD $fatpacked{"Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG'; use 5.004;use strict;use warnings;package Getopt::Long;use vars qw($VERSION);$VERSION=2.50;use vars qw($VERSION_STRING);$VERSION_STRING="2.50";use Exporter;use vars qw(@ISA @EXPORT @EXPORT_OK);@ISA=qw(Exporter);sub GetOptions(@);sub GetOptionsFromArray(@);sub GetOptionsFromString(@);sub Configure(@);sub HelpMessage(@);sub VersionMessage(@);BEGIN {@EXPORT=qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);@EXPORT_OK=qw(&HelpMessage &VersionMessage &Configure &GetOptionsFromArray &GetOptionsFromString)}use vars@EXPORT,@EXPORT_OK;use vars qw($error $debug $major_version $minor_version);use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough);use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);my$bundling_values;sub config(@);sub ConfigDefaults();sub ParseOptionSpec($$);sub OptCtl($);sub FindOption($$$$$);sub ValidValue ($$$$$);my$requested_version=0;sub ConfigDefaults() {if (defined$ENV{"POSIXLY_CORRECT"}){$genprefix="(--|-)";$autoabbrev=0;$bundling=0;$getopt_compat=0;$order=$REQUIRE_ORDER}else {$genprefix="(--|-|\\+)";$autoabbrev=1;$bundling=0;$getopt_compat=1;$order=$PERMUTE}$debug=0;$error=0;$ignorecase=1;$passthrough=0;$gnu_compat=0;$longprefix="(--)";$bundling_values=0}sub import {my$pkg=shift;my@syms=();my@config=();my$dest=\@syms;for (@_){if ($_ eq ':config'){$dest=\@config;next}push(@$dest,$_)}local$Exporter::ExportLevel=1;push(@syms,qw(&GetOptions))if@syms;$requested_version=0;$pkg->SUPER::import(@syms);Configure(@config)if@config}($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER)=(0..2);($major_version,$minor_version)=$VERSION =~ /^(\d+)\.(\d+)/;ConfigDefaults();package Getopt::Long::Parser;my$default_config=do {Getopt::Long::Configure ()};sub new {my$that=shift;my$class=ref($that)|| $that;my%atts=@_;my$self={caller_pkg=>(caller)[0]};bless ($self,$class);if (defined$atts{config}){my$save=Getopt::Long::Configure ($default_config,@{$atts{config}});$self->{settings}=Getopt::Long::Configure ($save);delete ($atts{config})}else {$self->{settings}=$default_config}if (%atts){die(__PACKAGE__.": unhandled attributes: ".join(" ",sort(keys(%atts)))."\n")}$self}sub configure {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings},@_);$self->{settings}=Getopt::Long::Configure ($save)}sub getoptions {my ($self)=shift;return$self->getoptionsfromarray(\@ARGV,@_)}sub getoptionsfromarray {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings});my$ret=0;$Getopt::Long::caller=$self->{caller_pkg};eval {local ($SIG{__DIE__})='DEFAULT';$ret=Getopt::Long::GetOptionsFromArray (@_)};Getopt::Long::Configure ($save);die ($@)if $@;return$ret}package Getopt::Long;use constant CTL_TYPE=>0;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;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_]*"."(\.[0-9_]+)?"."([eE][-+]?[0-9_]+)?";sub GetOptions(@) {unshift(@_,\@ARGV);goto&GetOptionsFromArray}sub GetOptionsFromString(@) {my ($string)=shift;require Text::ParseWords;my$args=[Text::ParseWords::shellwords($string)];$caller ||= (caller)[0];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)=@_;my$argend='--';my%opctl=();my$pkg=$caller || (caller)[0];my@ret=();my%linkage;my$userlinkage;my$opt;my$prefix=$genprefix;$error='';if ($debug){local ($^W)=0;print STDERR ("Getopt::Long $Getopt::Long::VERSION ","called from package \"$pkg\".","\n ","argv: ",defined($argv)? UNIVERSAL::isa($argv,'ARRAY')? "(@$argv)" : $argv : "","\n ","autoabbrev=$autoabbrev,"."bundling=$bundling,","bundling_values=$bundling_values,","getopt_compat=$getopt_compat,","gnu_compat=$gnu_compat,","order=$order,","\n ","ignorecase=$ignorecase,","requested_version=$requested_version,","passthrough=$passthrough,","genprefix=\"$genprefix\",","longprefix=\"$longprefix\".","\n")}$userlinkage=undef;if (@optionlist && ref($optionlist[0])and UNIVERSAL::isa($optionlist[0],'HASH')){$userlinkage=shift (@optionlist);print STDERR ("=> user linkage: $userlinkage\n")if$debug}if (@optionlist && $optionlist[0]=~ /^\W+$/ &&!($optionlist[0]eq '<>' && @optionlist > 0 && ref($optionlist[1]))){$prefix=shift (@optionlist);$prefix =~ s/(\W)/\\$1/g;$prefix="([" .$prefix ."])";print STDERR ("=> prefix=\"$prefix\"\n")if$debug}%opctl=();while (@optionlist){my$opt=shift (@optionlist);unless (defined($opt)){$error .= "Undefined argument in option spec\n";next}$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";shift (@optionlist)if@optionlist && ref($optionlist[0]);next}$linkage{'<>'}=shift (@optionlist);next}my ($name,$orig)=ParseOptionSpec ($opt,\%opctl);unless (defined$name){$error .= $orig;shift (@optionlist)if@optionlist && ref($optionlist[0]);next}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 {next}}}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"){}elsif ($rl eq "CODE"){}else {$error .= "Invalid option linkage for \"$opt\"\n"}}else {my$ov=$orig;$ov =~ s/\W/_/g;if ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;")}elsif ($opctl{$name}[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;")}else {print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;")}}if ($opctl{$name}[CTL_TYPE]eq 'I' && ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY || $opctl{$name}[CTL_DEST]==CTL_DEST_HASH)){$error .= "Invalid option linkage for \"$opt\"\n"}}$error .= "GetOptionsFromArray: 1st parameter is not an array reference\n" unless$argv && UNIVERSAL::isa($argv,'ARRAY');die ($error)if$error;$error=0;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}if ($debug){my ($arrow,$k,$v);$arrow="=> ";while (($k,$v)=each(%opctl)){print STDERR ($arrow,"\$opctl{$k} = $v ",OptCtl($v),"\n");$arrow=" "}}my$goon=1;while ($goon && @$argv > 0){$opt=shift (@$argv);print STDERR ("=> arg \"",$opt,"\"\n")if$debug;if (defined($opt)&& $opt eq $argend){push (@ret,$argend)if$passthrough;last}my$tryopt=$opt;my$found;my$key;my$arg;my$ctl;($found,$opt,$ctl,$arg,$key)=FindOption ($argv,$prefix,$argend,$opt,\%opctl);if ($found){next unless defined$opt;my$argcnt=0;while (defined$arg){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")}}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);if ($argcnt < $ctl->[CTL_AMIN]){if (@$argv){if (ValidValue($ctl,$argv->[0],1,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}warn("Value \"$$argv[0]\" invalid for option $opt\n");$error++}else {warn("Insufficient arguments for option $opt\n");$error++}}if (@$argv && ValidValue($ctl,$argv->[0],0,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}}}elsif ($order==$PERMUTE){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($tryopt)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("=> saving \"$tryopt\" ","(not an option, may permute)\n")if$debug;push (@ret,$tryopt)}next}else {unshift (@$argv,$tryopt);return ($error==0)}}if (@ret && $order==$PERMUTE){print STDERR ("=> restoring \"",join('" "',@ret),"\"\n")if$debug;unshift (@$argv,@ret)}return ($error==0)}sub OptCtl ($) {my ($v)=@_;my@v=map {defined($_)? ($_): ("")}@$v;"[".join(",","\"$v[CTL_TYPE]\"","\"$v[CTL_CNAME]\"","\"$v[CTL_DEFAULT]\"",("\$","\@","\%","\&")[$v[CTL_DEST]|| 0],$v[CTL_AMIN]|| '',$v[CTL_AMAX]|| '',)."]"}sub ParseOptionSpec ($$) {my ($opt,$opctl)=@_;if ($opt !~ m;^ ( # Option name (?: \w+[-\w]* ) # Alias names, or "?" (?: \| (?: \? | \w[-\w]* ) )* # Aliases (?: \| (?: [^-|!+=:][^|!+=:]* )? )* )? ( # Either modifiers ... [!+] | # ... or a value/dest/repeat specification [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )? | # ... or an optional-with-default spec : (?: -?\d+ | \+ ) [@%]? )? $;x){return (undef,"Error in option spec: \"$opt\"\n")}my ($names,$spec)=($1,$2);$spec='' unless defined$spec;my$orig;my@names;if (defined$names){@names=split (/\|/,$names);$orig=$names[0]}else {@names=('');$orig=''}my$entry;if ($spec eq '' || $spec eq '+' || $spec eq '!'){$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;$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;$mi=$mand eq '=' ? 1 : 0 unless defined$mi;$mand=$mi ? '=' : ':';$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;$entry=[$type,$orig,undef,$dest,$mi,$ma||-1]}my$dups='';for (@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){for (split(/\n+/,$dups)){warn($_."\n")}}($names[0],$orig)}sub FindOption ($$$$$) {my ($argv,$prefix,$argend,$opt,$opctl)=@_;print STDERR ("=> find \"$opt\"\n")if$debug;return (0)unless defined($opt);return (0)unless$opt =~ /^($prefix)(.*)$/s;return (0)if$opt eq "-" &&!defined$opctl->{''};$opt=substr($opt,length($1));my$starter=$1;print STDERR ("=> split \"$starter\"+\"$opt\"\n")if$debug;my$optarg;my$rest;if (($starter=~/^$longprefix$/ || ($getopt_compat && ($bundling==0 || $bundling==2)))&& (my$oppos=index($opt,'=',1))> 0){my$optorg=$opt;$opt=substr($optorg,0,$oppos);$optarg=substr($optorg,$oppos + 1);print STDERR ("=> option \"",$opt,"\", optarg = \"$optarg\"\n")if$debug}my$tryopt=$opt;if (($bundling || $bundling_values)&& $starter eq '-'){$tryopt=$ignorecase ? lc($opt): $opt;if ($bundling==2 && length($tryopt)> 1 && defined ($opctl->{$tryopt})){print STDERR ("=> $starter$tryopt overrides unbundling\n")if$debug}elsif ($bundling_values){$tryopt=$opt;$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;$optarg=$rest eq '' ? undef : $rest;$rest=undef}else {$tryopt=$opt;$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 ''}}elsif ($autoabbrev && $opt ne ""){my@names=sort(keys (%$opctl));$opt=lc ($opt)if$ignorecase;$tryopt=$opt;my$pat=quotemeta ($opt);my@hits=grep (/^$pat/,@names);print STDERR ("=> ",scalar(@hits)," hits (@hits) with \"$pat\" ","out of ",scalar(@names),"\n")if$debug;unless ((@hits <= 1)|| (grep ($_ eq $opt,@hits)==1)){my%hit;for (@hits){my$hit=$opctl->{$_}->[CTL_CNAME]if defined$opctl->{$_}->[CTL_CNAME];$hit="no" .$hit if$opctl->{$_}->[CTL_TYPE]eq '!';$hit{$hit}=1}if (keys(%hit)==2){if ($auto_version && exists($hit{version})){delete$hit{version}}elsif ($auto_help && exists($hit{help})){delete$hit{help}}}unless (keys(%hit)==1){return (0)if$passthrough;warn ("Option ",$opt," is ambiguous (",join(", ",@hits),")\n");$error++;return (1,undef)}@hits=keys(%hit)}if (@hits==1 && $hits[0]ne $opt){$tryopt=$hits[0];$tryopt=lc ($tryopt)if$ignorecase > (($bundling && length($tryopt)==1)? 1 : 0);print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")if$debug}}elsif ($ignorecase){$tryopt=lc ($opt)}my$ctl=$opctl->{$tryopt};unless (defined$ctl){return (0)if$passthrough;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)}$opt=$tryopt;print STDERR ("=> found ",OptCtl($ctl)," for \"",$opt,"\"\n")if$debug;my$type=$ctl->[CTL_TYPE];my$arg;if ($type eq '' || $type eq '!' || $type eq '+'){if (defined$optarg){return (0)if$passthrough;warn ("Option ",$opt," does not take an argument\n");$error++;undef$opt;undef$optarg if$bundling_values}elsif ($type eq '' || $type eq '+'){$arg=1}else {$opt =~ s/^no-?//i;$arg=0}unshift (@$argv,$starter.$rest)if defined$rest;return (1,$opt,$ctl,$arg)}my$mand=$ctl->[CTL_AMIN];if ($gnu_compat){my$optargtype=0;if (defined($optarg)){$optargtype=(length($optarg)==0)? 1 : 2}elsif (defined$rest || @$argv > 0){$optargtype=3}if(($optargtype==0)&&!$mand){my$val =defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0;return (1,$opt,$ctl,$val)}return (1,$opt,$ctl,$type eq 's' ? '' : 0)if$optargtype==1}if (defined$optarg ? ($optarg eq ''):!(defined$rest || @$argv > 0)){if ($mand){return (0)if$passthrough;warn ("Option ",$opt," requires an argument\n");$error++;return (1,undef)}if ($type eq 'I'){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)}$arg=(defined$rest ? $rest : (defined$optarg ? $optarg : shift (@$argv)));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++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}}my$key_valid=$ctl->[CTL_DEST]==CTL_DEST_HASH ? "[^=]+=" : "";if ($type eq 's'){return (1,$opt,$ctl,$arg,$key)if$mand;return (1,$opt,$ctl,$arg,$key)if$ctl->[CTL_DEST]==CTL_DEST_HASH;return (1,$opt,$ctl,$arg,$key)if defined$optarg || defined$rest;return (1,$opt,$ctl,$arg,$key)if$arg eq "-";if ($arg eq $argend || $arg =~ /^$prefix.+/){unshift (@$argv,$arg);$arg=''}}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){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++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}$arg=defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: 0}}}elsif ($type eq 'f'){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++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);$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'){return (1)if$mand;return (1)if$arg eq "-";return 0 if$arg eq $argend || $arg =~ /^$prefix.+/;return 1}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;return$arg =~ /^$o_valid$/si}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;return$arg =~ /^$o_valid$/}die("ValidValue: Cannot happen\n")}sub Configure (@) {my (@options)=@_;my$prevconfig=[$error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values ];if (ref($options[0])eq 'ARRAY'){($error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values)=@{shift(@options)}}my$opt;for$opt (@options){my$try=lc ($opt);my$action=1;if ($try =~ /^no_?(.*)$/s){$action=0;$try=$+}if (($try eq 'default' or $try eq 'defaults')&& $action){ConfigDefaults ()}elsif (($try eq 'posix_default' or $try eq 'posix_defaults')){local$ENV{POSIXLY_CORRECT};$ENV{POSIXLY_CORRECT}=1 if$action;ConfigDefaults ()}elsif ($try eq 'auto_abbrev' or $try eq 'autoabbrev'){$autoabbrev=$action}elsif ($try eq 'getopt_compat'){$getopt_compat=$action;$genprefix=$action ? "(--|-|\\+)" : "(--|-)"}elsif ($try eq 'gnu_getopt'){if ($action){$gnu_compat=1;$bundling=1;$getopt_compat=0;$genprefix="(--|-)";$order=$PERMUTE;$bundling_values=0}}elsif ($try eq 'gnu_compat'){$gnu_compat=$action;$bundling=0;$bundling_values=1}elsif ($try =~ /^(auto_?)?version$/){$auto_version=$action}elsif ($try =~ /^(auto_?)?help$/){$auto_help=$action}elsif ($try eq 'ignorecase' or $try eq 'ignore_case'){$ignorecase=$action}elsif ($try eq 'ignorecase_always' or $try eq 'ignore_case_always'){$ignorecase=$action ? 2 : 0}elsif ($try eq 'bundling'){$bundling=$action;$bundling_values=0 if$action}elsif ($try eq 'bundling_override'){$bundling=$action ? 2 : 0;$bundling_values=0 if$action}elsif ($try eq 'bundling_values'){$bundling_values=$action;$bundling=0 if$action}elsif ($try eq 'require_order'){$order=$action ? $REQUIRE_ORDER : $PERMUTE}elsif ($try eq 'permute'){$order=$action ? $PERMUTE : $REQUIRE_ORDER}elsif ($try eq 'pass_through' or $try eq 'passthrough'){$passthrough=$action}elsif ($try =~ /^prefix=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .quotemeta($genprefix).")";eval {'' =~ /$genprefix/};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^prefix_pattern=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .$genprefix .")" unless$genprefix =~ /^\(.*\)$/;eval {'' =~ m"$genprefix"};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^long_prefix_pattern=(.+)$/ && $action){$longprefix=$1;$longprefix="(" .$longprefix .")" unless$longprefix =~ /^\(.*\)$/;eval {'' =~ m"$longprefix"};die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n")if $@}elsif ($try eq 'debug'){$debug=$action}else {die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")}}$prevconfig}sub config (@) {Configure (@_)}sub VersionMessage(@) {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"}sub HelpMessage(@) {eval {require Pod::Usage;import Pod::Usage;1}|| die("Cannot provide help: cannot load Pod::Usage\n");pod2usage(setup_pa_args("help",@_))}sub setup_pa_args($@) {my$tag=shift;@_=()if @_==2 && $_[0]eq $tag;my$pa;if (@_ > 1){$pa={@_ }}else {$pa=shift || {}}if (UNIVERSAL::isa($pa,'HASH')){$pa->{-message}=$pa->{-msg};delete($pa->{-msg})}elsif ($pa =~ /^-?\d+$/){$pa={-exitval=>$pa }}else {$pa={-message=>$pa }}$pa->{-verbose}=0 unless exists($pa->{-verbose});$pa->{-exitval}=0 unless exists($pa->{-exitval});$pa}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 '""'=>\&name,fallback=>1;1; GETOPT_LONG $fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY'; package HTTP::Tiny;use strict;use warnings;our$VERSION='0.070';sub _croak {require Carp;Carp::croak(@_)}my@attributes;BEGIN {@attributes=qw(cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy SSL_options verify_SSL);my%persist_ok=map {;$_=>1}qw(cookie_jar default_headers max_redirect max_size);no strict 'refs';no warnings 'uninitialized';for my$accessor (@attributes){*{$accessor}=sub {@_ > 1 ? do {delete $_[0]->{handle}if!$persist_ok{$accessor}&& $_[1]ne $_[0]->{$accessor};$_[0]->{$accessor}=$_[1]}: $_[0]->{$accessor}}}}sub agent {my($self,$agent)=@_;if(@_ > 1){$self->{agent}=(defined$agent && $agent =~ / $/)? $agent .$self->_agent : $agent}return$self->{agent}}sub timeout {my ($self,$timeout)=@_;if (@_ > 1){$self->{timeout}=$timeout;if ($self->{handle}){$self->{handle}->timeout($timeout)}}return$self->{timeout}}sub new {my($class,%args)=@_;my$self={max_redirect=>5,timeout=>defined$args{timeout}? $args{timeout}: 60,keep_alive=>1,verify_SSL=>$args{verify_SSL}|| $args{verify_ssl}|| 0,no_proxy=>$ENV{no_proxy},};bless$self,$class;$class->_validate_cookie_jar($args{cookie_jar})if$args{cookie_jar};for my$key (@attributes){$self->{$key}=$args{$key}if exists$args{$key}}$self->agent(exists$args{agent}? $args{agent}: $class->_agent);$self->_set_proxies;return$self}sub _set_proxies {my ($self)=@_;if (!exists$self->{proxy}){$self->{proxy}=$ENV{all_proxy}|| $ENV{ALL_PROXY}}if (defined$self->{proxy}){$self->_split_proxy('generic proxy'=>$self->{proxy})}else {delete$self->{proxy}}if (!exists$self->{http_proxy}){local$ENV{HTTP_PROXY}if$ENV{REQUEST_METHOD};$self->{http_proxy}=$ENV{http_proxy}|| $ENV{HTTP_PROXY}|| $self->{proxy}}if (defined$self->{http_proxy}){$self->_split_proxy(http_proxy=>$self->{http_proxy});$self->{_has_proxy}{http}=1}else {delete$self->{http_proxy}}if (!exists$self->{https_proxy}){$self->{https_proxy}=$ENV{https_proxy}|| $ENV{HTTPS_PROXY}|| $self->{proxy}}if ($self->{https_proxy}){$self->_split_proxy(https_proxy=>$self->{https_proxy});$self->{_has_proxy}{https}=1}else {delete$self->{https_proxy}}unless (ref$self->{no_proxy}eq 'ARRAY'){$self->{no_proxy}=(defined$self->{no_proxy})? [split /\s*,\s*/,$self->{no_proxy}]: []}return}for my$sub_name (qw/get head put post delete/){my$req_method=uc$sub_name;no strict 'refs';eval <<"HERE"}sub post_form {my ($self,$url,$data,$args)=@_;(@_==3 || @_==4 && ref$args eq 'HASH')or _croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ ."\n");my$headers={};while (my ($key,$value)=each %{$args->{headers}|| {}}){$headers->{lc$key}=$value}delete$args->{headers};return$self->request('POST',$url,{%$args,content=>$self->www_form_urlencode($data),headers=>{%$headers,'content-type'=>'application/x-www-form-urlencoded' },})}sub mirror {my ($self,$url,$file,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or _croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ ."\n");if (exists$args->{headers}){my$headers={};while (my ($key,$value)=each %{$args->{headers}|| {}}){$headers->{lc$key}=$value}$args->{headers}=$headers}if (-e $file and my$mtime=(stat($file))[9]){$args->{headers}{'if-modified-since'}||= $self->_http_date($mtime)}my$tempfile=$file .int(rand(2**31));require Fcntl;sysopen my$fh,$tempfile,Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()or _croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);binmode$fh;$args->{data_callback}=sub {print {$fh}$_[0]};my$response=$self->request('GET',$url,$args);close$fh or _croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);if ($response->{success}){rename$tempfile,$file or _croak(qq/Error replacing $file with $tempfile: $!\n/);my$lm=$response->{headers}{'last-modified'};if ($lm and my$mtime=$self->_parse_http_date($lm)){utime$mtime,$mtime,$file}}$response->{success}||= $response->{status}eq '304';unlink$tempfile;return$response}my%idempotent=map {$_=>1}qw/GET HEAD PUT DELETE OPTIONS TRACE/;sub request {my ($self,$method,$url,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or _croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ ."\n");$args ||= {};my$response;for (0 .. 1){$response=eval {$self->_request($method,$url,$args)};last unless $@ && $idempotent{$method}&& $@ =~ m{^(?:Socket closed|Unexpected end)}}if (my$e=$@){if (ref$e eq 'HASH' && exists$e->{status}){$e->{redirects}=delete$args->{_redirects}if @{$args->{_redirects}|| []};return$e}$e="$e";$response={url=>$url,success=>q{},status=>599,reason=>'Internal Exception',content=>$e,headers=>{'content-type'=>'text/plain','content-length'=>length$e,},(@{$args->{_redirects}|| []}? (redirects=>delete$args->{_redirects}): ()),}}return$response}sub www_form_urlencode {my ($self,$data)=@_;(@_==2 && ref$data)or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ ."\n");(ref$data eq 'HASH' || ref$data eq 'ARRAY')or _croak("form data must be a hash or array reference\n");my@params=ref$data eq 'HASH' ? %$data : @$data;@params % 2==0 or _croak("form data reference must have an even number of terms\n");my@terms;while(@params){my ($key,$value)=splice(@params,0,2);if (ref$value eq 'ARRAY'){unshift@params,map {$key=>$_}@$value}else {push@terms,join("=",map {$self->_uri_escape($_)}$key,$value)}}return join("&",(ref$data eq 'ARRAY')? (@terms): (sort@terms))}sub can_ssl {my ($self)=@_;my($ok,$reason)=(1,'');local@INC=@INC;pop@INC if$INC[-1]eq '.';unless (eval {require IO::Socket::SSL;IO::Socket::SSL->VERSION(1.42)}){$ok=0;$reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/}unless (eval {require Net::SSLeay;Net::SSLeay->VERSION(1.49)}){$ok=0;$reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/}if (ref($self)&& ($self->{verify_SSL}|| $self->{SSL_options}{SSL_verify_mode})){my$handle=HTTP::Tiny::Handle->new(SSL_options=>$self->{SSL_options},verify_SSL=>$self->{verify_SSL},);unless (eval {$handle->_find_CA_file;1}){$ok=0;$reason .= "$@"}}wantarray ? ($ok,$reason): $ok}sub connected {my ($self)=@_;if ($self->{handle}&& $self->{handle}{fh}){my$socket=$self->{handle}{fh};if ($socket->connected){return wantarray ? ($socket->peerhost,$socket->peerport): join(':',$socket->peerhost,$socket->peerport)}}return}my%DefaultPort=(http=>80,https=>443,);sub _agent {my$class=ref($_[0])|| $_[0];(my$default_agent=$class)=~ s{::}{-}g;return$default_agent ."/" .$class->VERSION}sub _request {my ($self,$method,$url,$args)=@_;my ($scheme,$host,$port,$path_query,$auth)=$self->_split_url($url);my$request={method=>$method,scheme=>$scheme,host=>$host,port=>$port,host_port=>($port==$DefaultPort{$scheme}? $host : "$host:$port"),uri=>$path_query,headers=>{},};my$peer=$args->{peer}|| $host;my$handle=delete$self->{handle};if ($handle){unless ($handle->can_reuse($scheme,$host,$port,$peer)){$handle->close;undef$handle}}$handle ||= $self->_open_handle($request,$scheme,$host,$port,$peer);$self->_prepare_headers_and_cb($request,$args,$url,$auth);$handle->write_request($request);my$response;do {$response=$handle->read_response_header}until (substr($response->{status},0,1)ne '1');$self->_update_cookie_jar($url,$response)if$self->{cookie_jar};my@redir_args=$self->_maybe_redirect($request,$response,$args);my$known_message_length;if ($method eq 'HEAD' || $response->{status}=~ /^[23]04/){$known_message_length=1}else {my$cb_args=@redir_args ? +{}: $args;my$data_cb=$self->_prepare_data_cb($response,$cb_args);$known_message_length=$handle->read_body($data_cb,$response)}if ($self->{keep_alive}&& $known_message_length && $response->{protocol}eq 'HTTP/1.1' && ($response->{headers}{connection}|| '')ne 'close'){$self->{handle}=$handle}else {$handle->close}$response->{success}=substr($response->{status},0,1)eq '2';$response->{url}=$url;if (@redir_args){push @{$args->{_redirects}},$response;return$self->_request(@redir_args,$args)}$response->{redirects}=delete$args->{_redirects}if @{$args->{_redirects}};return$response}sub _open_handle {my ($self,$request,$scheme,$host,$port,$peer)=@_;my$handle=HTTP::Tiny::Handle->new(timeout=>$self->{timeout},SSL_options=>$self->{SSL_options},verify_SSL=>$self->{verify_SSL},local_address=>$self->{local_address},keep_alive=>$self->{keep_alive});if ($self->{_has_proxy}{$scheme}&&!grep {$host =~ /\Q$_\E$/}@{$self->{no_proxy}}){return$self->_proxy_connect($request,$handle)}else {return$handle->connect($scheme,$host,$port,$peer)}}sub _proxy_connect {my ($self,$request,$handle)=@_;my@proxy_vars;if ($request->{scheme}eq 'https'){_croak(qq{No https_proxy defined})unless$self->{https_proxy};@proxy_vars=$self->_split_proxy(https_proxy=>$self->{https_proxy});if ($proxy_vars[0]eq 'https'){_croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}})}}else {_croak(qq{No http_proxy defined})unless$self->{http_proxy};@proxy_vars=$self->_split_proxy(http_proxy=>$self->{http_proxy})}my ($p_scheme,$p_host,$p_port,$p_auth)=@proxy_vars;if (length$p_auth &&!defined$request->{headers}{'proxy-authorization'}){$self->_add_basic_auth_header($request,'proxy-authorization'=>$p_auth)}$handle->connect($p_scheme,$p_host,$p_port,$p_host);if ($request->{scheme}eq 'https'){$self->_create_proxy_tunnel($request,$handle)}else {$request->{uri}="$request->{scheme}://$request->{host_port}$request->{uri}"}return$handle}sub _split_proxy {my ($self,$type,$proxy)=@_;my ($scheme,$host,$port,$path_query,$auth)=eval {$self->_split_url($proxy)};unless(defined($scheme)&& length($scheme)&& length($host)&& length($port)&& $path_query eq '/'){_croak(qq{$type URL must be in format http[s]://[auth@]:/\n})}return ($scheme,$host,$port,$auth)}sub _create_proxy_tunnel {my ($self,$request,$handle)=@_;$handle->_assert_ssl;my$agent=exists($request->{headers}{'user-agent'})? $request->{headers}{'user-agent'}: $self->{agent};my$connect_request={method=>'CONNECT',uri=>"$request->{host}:$request->{port}",headers=>{host=>"$request->{host}:$request->{port}",'user-agent'=>$agent,}};if ($request->{headers}{'proxy-authorization'}){$connect_request->{headers}{'proxy-authorization'}=delete$request->{headers}{'proxy-authorization'}}$handle->write_request($connect_request);my$response;do {$response=$handle->read_response_header}until (substr($response->{status},0,1)ne '1');unless (substr($response->{status},0,1)eq '2'){die$response}$handle->start_ssl($request->{host});return}sub _prepare_headers_and_cb {my ($self,$request,$args,$url,$auth)=@_;for ($self->{default_headers},$args->{headers}){next unless defined;while (my ($k,$v)=each %$_){$request->{headers}{lc$k}=$v;$request->{header_case}{lc$k}=$k}}if (exists$request->{headers}{'host'}){die(qq/The 'Host' header must not be provided as header option\n/)}$request->{headers}{'host'}=$request->{host_port};$request->{headers}{'user-agent'}||= $self->{agent};$request->{headers}{'connection'}="close" unless$self->{keep_alive};if (defined$args->{content}){if (ref$args->{content}eq 'CODE'){$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'transfer-encoding'}='chunked' unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=$args->{content}}elsif (length$args->{content}){my$content=$args->{content};if ($] ge '5.008'){utf8::downgrade($content,1)or die(qq/Wide character in request message body\n/)}$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'content-length'}=length$content unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=sub {substr$content,0,length$content,''}}$request->{trailer_cb}=$args->{trailer_callback}if ref$args->{trailer_callback}eq 'CODE'}if ($self->{cookie_jar}){my$cookies=$self->cookie_jar->cookie_header($url);$request->{headers}{cookie}=$cookies if length$cookies}if (length$auth &&!defined$request->{headers}{authorization}){$self->_add_basic_auth_header($request,'authorization'=>$auth)}return}sub _add_basic_auth_header {my ($self,$request,$header,$auth)=@_;require MIME::Base64;$request->{headers}{$header}="Basic " .MIME::Base64::encode_base64($auth,"");return}sub _prepare_data_cb {my ($self,$response,$args)=@_;my$data_cb=$args->{data_callback};$response->{content}='';if (!$data_cb || $response->{status}!~ /^2/){if (defined$self->{max_size}){$data_cb=sub {$_[1]->{content}.= $_[0];die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)if length $_[1]->{content}> $self->{max_size}}}else {$data_cb=sub {$_[1]->{content}.= $_[0]}}}return$data_cb}sub _update_cookie_jar {my ($self,$url,$response)=@_;my$cookies=$response->{headers}->{'set-cookie'};return unless defined$cookies;my@cookies=ref$cookies ? @$cookies : $cookies;$self->cookie_jar->add($url,$_)for@cookies;return}sub _validate_cookie_jar {my ($class,$jar)=@_;for my$method (qw/add cookie_header/){_croak(qq/Cookie jar must provide the '$method' method\n/)unless ref($jar)&& ref($jar)->can($method)}return}sub _maybe_redirect {my ($self,$request,$response,$args)=@_;my$headers=$response->{headers};my ($status,$method)=($response->{status},$request->{method});$args->{_redirects}||= [];if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))and $headers->{location}and @{$args->{_redirects}}< $self->{max_redirect}){my$location=($headers->{location}=~ /^\//)? "$request->{scheme}://$request->{host_port}$headers->{location}" : $headers->{location};return (($status eq '303' ? 'GET' : $method),$location)}return}sub _split_url {my$url=pop;my ($scheme,$host,$path_query)=$url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> or die(qq/Cannot parse URL: '$url'\n/);$scheme=lc$scheme;$path_query="/$path_query" unless$path_query =~ m<\A/>;my$auth='';if ((my$i=index$host,'@')!=-1){$auth=substr$host,0,$i,'';substr$host,0,1,'';$auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg}my$port=$host =~ s/:(\d*)\z// && length $1 ? $1 : $scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef;return ($scheme,(length$host ? lc$host : "localhost"),$port,$path_query,$auth)}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}}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))if (length$str==do {use bytes;length$str});$str=pack("C*",unpack("C*",$str))}$str =~ s/($unsafe_char)/$escapes{$1}/ge;return$str}package HTTP::Tiny::Handle;use strict;use warnings;use Errno qw[EINTR EPIPE];use IO::Socket qw[SOCK_STREAM];use Socket qw[SOL_SOCKET SO_KEEPALIVE];my$SOCKET_CLASS=$ENV{PERL_HTTP_TINY_IPV4_ONLY}? 'IO::Socket::INET' : eval {require IO::Socket::IP;IO::Socket::IP->VERSION(0.25)}? 'IO::Socket::IP' : 'IO::Socket::INET';sub BUFSIZE () {32768}my$Printable=sub {local $_=shift;s/\r/\\r/g;s/\n/\\n/g;s/\t/\\t/g;s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;$_};my$Token=qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;my$Field_Content=qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;sub new {my ($class,%args)=@_;return bless {rbuf=>'',timeout=>60,max_line_size=>16384,max_header_lines=>64,verify_SSL=>0,SSL_options=>{},%args },$class}sub timeout {my ($self,$timeout)=@_;if (@_ > 1){$self->{timeout}=$timeout;if ($self->{fh}&& $self->{fh}->can('timeout')){$self->{fh}->timeout($timeout)}}return$self->{timeout}}sub connect {@_==5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ ."\n");my ($self,$scheme,$host,$port,$peer)=@_;if ($scheme eq 'https'){$self->_assert_ssl}elsif ($scheme ne 'http'){die(qq/Unsupported URL scheme '$scheme'\n/)}$self->{fh}=$SOCKET_CLASS->new(PeerHost=>$peer,PeerPort=>$port,$self->{local_address}? (LocalAddr=>$self->{local_address}): (),Proto=>'tcp',Type=>SOCK_STREAM,Timeout=>$self->{timeout},)or die(qq/Could not connect to '$host:$port': $@\n/);binmode($self->{fh})or die(qq/Could not binmode() socket: '$!'\n/);if ($self->{keep_alive}){unless (defined($self->{fh}->setsockopt(SOL_SOCKET,SO_KEEPALIVE,1))){CORE::close($self->{fh});die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/)}}$self->start_ssl($host)if$scheme eq 'https';$self->{scheme}=$scheme;$self->{host}=$host;$self->{peer}=$peer;$self->{port}=$port;$self->{pid}=$$;$self->{tid}=_get_tid();return$self}sub start_ssl {my ($self,$host)=@_;if (ref($self->{fh})eq 'IO::Socket::SSL'){unless ($self->{fh}->stop_SSL){my$ssl_err=IO::Socket::SSL->errstr;die(qq/Error halting prior SSL connection: $ssl_err/)}}my$ssl_args=$self->_ssl_args($host);IO::Socket::SSL->start_SSL($self->{fh},%$ssl_args,SSL_create_ctx_callback=>sub {my$ctx=shift;Net::SSLeay::CTX_set_mode($ctx,Net::SSLeay::MODE_AUTO_RETRY())},);unless (ref($self->{fh})eq 'IO::Socket::SSL'){my$ssl_err=IO::Socket::SSL->errstr;die(qq/SSL connection failed for $host: $ssl_err\n/)}}sub close {@_==1 || die(q/Usage: $handle->close()/ ."\n");my ($self)=@_;CORE::close($self->{fh})or die(qq/Could not close socket: '$!'\n/)}sub write {@_==2 || die(q/Usage: $handle->write(buf)/ ."\n");my ($self,$buf)=@_;if ($] ge '5.008'){utf8::downgrade($buf,1)or die(qq/Wide character in write()\n/)}my$len=length$buf;my$off=0;local$SIG{PIPE}='IGNORE';while (){$self->can_write or die(qq/Timed out while waiting for socket to become ready for writing\n/);my$r=syswrite($self->{fh},$buf,$len,$off);if (defined$r){$len -= $r;$off += $r;last unless$len > 0}elsif ($!==EPIPE){die(qq/Socket closed by remote server: $!\n/)}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not write to SSL socket: '$err'\n /)}else {die(qq/Could not write to socket: '$!'\n/)}}}return$off}sub read {@_==2 || @_==3 || die(q/Usage: $handle->read(len [, allow_partial])/ ."\n");my ($self,$len,$allow_partial)=@_;my$buf='';my$got=length$self->{rbuf};if ($got){my$take=($got < $len)? $got : $len;$buf=substr($self->{rbuf},0,$take,'');$len -= $take}while ($len > 0){$self->can_read or die(q/Timed out while waiting for socket to become ready for reading/ ."\n");my$r=sysread($self->{fh},$buf,$len,length$buf);if (defined$r){last unless$r;$len -= $r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}if ($len &&!$allow_partial){die(qq/Unexpected end of stream\n/)}return$buf}sub readline {@_==1 || die(q/Usage: $handle->readline()/ ."\n");my ($self)=@_;while (){if ($self->{rbuf}=~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x){return $1}if (length$self->{rbuf}>= $self->{max_line_size}){die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/)}$self->can_read or die(qq/Timed out while waiting for socket to become ready for reading\n/);my$r=sysread($self->{fh},$self->{rbuf},BUFSIZE,length$self->{rbuf});if (defined$r){last unless$r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}die(qq/Unexpected end of stream while looking for line\n/)}sub read_header_lines {@_==1 || @_==2 || die(q/Usage: $handle->read_header_lines([headers])/ ."\n");my ($self,$headers)=@_;$headers ||= {};my$lines=0;my$val;while (){my$line=$self->readline;if (++$lines >= $self->{max_header_lines}){die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/)}elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x){my ($field_name)=lc $1;if (exists$headers->{$field_name}){for ($headers->{$field_name}){$_=[$_]unless ref $_ eq "ARRAY";push @$_,$2;$val=\$_->[-1]}}else {$val=\($headers->{$field_name}=$2)}}elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x){$val or die(qq/Unexpected header continuation line\n/);next unless length $1;$$val .= ' ' if length $$val;$$val .= $1}elsif ($line =~ /\A \x0D?\x0A \z/x){last}else {die(q/Malformed header line: / .$Printable->($line)."\n")}}return$headers}sub write_request {@_==2 || die(q/Usage: $handle->write_request(request)/ ."\n");my($self,$request)=@_;$self->write_request_header(@{$request}{qw/method uri headers header_case/});$self->write_body($request)if$request->{cb};return}my@rfc_request_headers=qw(Accept Accept-Charset Accept-Encoding Accept-Language Authorization Cache-Control Connection Content-Length Expect From Host If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer Transfer-Encoding Upgrade User-Agent Via);my@other_request_headers=qw(Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin X-XSS-Protection);my%HeaderCase=map {lc($_)=>$_}@rfc_request_headers,@other_request_headers;sub write_header_lines {(@_ >= 2 && @_ <= 4 && ref $_[1]eq 'HASH')|| die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ ."\n");my($self,$headers,$header_case,$prefix_data)=@_;$header_case ||= {};my$buf=(defined$prefix_data ? $prefix_data : '');my%seen;for my$k (qw/host cache-control expect max-forwards pragma range te/){next unless exists$headers->{$k};$seen{$k}++;my$field_name=$HeaderCase{$k};my$v=$headers->{$k};for (ref$v eq 'ARRAY' ? @$v : $v){$_='' unless defined $_;$buf .= "$field_name: $_\x0D\x0A"}}while (my ($k,$v)=each %$headers){my$field_name=lc$k;next if$seen{$field_name};if (exists$HeaderCase{$field_name}){$field_name=$HeaderCase{$field_name}}else {if (exists$header_case->{$field_name}){$field_name=$header_case->{$field_name}}else {$field_name =~ s/\b(\w)/\u$1/g}$field_name =~ /\A $Token+ \z/xo or die(q/Invalid HTTP header field name: / .$Printable->($field_name)."\n");$HeaderCase{lc$field_name}=$field_name}for (ref$v eq 'ARRAY' ? @$v : $v){s/\x0D?\x0A\s+/ /g;die(qq/Invalid HTTP header field value ($field_name): / .$Printable->($_)."\n")unless $_ eq '' || /\A $Field_Content \z/xo;$_='' unless defined $_;$buf .= "$field_name: $_\x0D\x0A"}}$buf .= "\x0D\x0A";return$self->write($buf)}sub read_body {@_==3 || die(q/Usage: $handle->read_body(callback, response)/ ."\n");my ($self,$cb,$response)=@_;my$te=$response->{headers}{'transfer-encoding'}|| '';my$chunked=grep {/chunked/i}(ref$te eq 'ARRAY' ? @$te : $te);return$chunked ? $self->read_chunked_body($cb,$response): $self->read_content_body($cb,$response)}sub write_body {@_==2 || die(q/Usage: $handle->write_body(request)/ ."\n");my ($self,$request)=@_;if ($request->{headers}{'content-length'}){return$self->write_content_body($request)}else {return$self->write_chunked_body($request)}}sub read_content_body {@_==3 || @_==4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ ."\n");my ($self,$cb,$response,$content_length)=@_;$content_length ||= $response->{headers}{'content-length'};if (defined$content_length){my$len=$content_length;while ($len > 0){my$read=($len > BUFSIZE)? BUFSIZE : $len;$cb->($self->read($read,0),$response);$len -= $read}return length($self->{rbuf})==0}my$chunk;$cb->($chunk,$response)while length($chunk=$self->read(BUFSIZE,1));return}sub write_content_body {@_==2 || die(q/Usage: $handle->write_content_body(request)/ ."\n");my ($self,$request)=@_;my ($len,$content_length)=(0,$request->{headers}{'content-length'});while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_content()\n/)}$len += $self->write($data)}$len==$content_length or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);return$len}sub read_chunked_body {@_==3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ ."\n");my ($self,$cb,$response)=@_;while (){my$head=$self->readline;$head =~ /\A ([A-Fa-f0-9]+)/x or die(q/Malformed chunk head: / .$Printable->($head)."\n");my$len=hex($1)or last;$self->read_content_body($cb,$response,$len);$self->read(2)eq "\x0D\x0A" or die(qq/Malformed chunk: missing CRLF after chunk data\n/)}$self->read_header_lines($response->{headers});return 1}sub write_chunked_body {@_==2 || die(q/Usage: $handle->write_chunked_body(request)/ ."\n");my ($self,$request)=@_;my$len=0;while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_chunked_body()\n/)}$len += length$data;my$chunk=sprintf '%X',length$data;$chunk .= "\x0D\x0A";$chunk .= $data;$chunk .= "\x0D\x0A";$self->write($chunk)}$self->write("0\x0D\x0A");if (ref$request->{trailer_cb}eq 'CODE'){$self->write_header_lines($request->{trailer_cb}->())}else {$self->write("\x0D\x0A")}return$len}sub read_response_header {@_==1 || die(q/Usage: $handle->read_response_header()/ ."\n");my ($self)=@_;my$line=$self->readline;$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x or die(q/Malformed Status-Line: / .$Printable->($line)."\n");my ($protocol,$version,$status,$reason)=($1,$2,$3,$4);die (qq/Unsupported HTTP protocol: $protocol\n/)unless$version =~ /0*1\.0*[01]/;return {status=>$status,reason=>$reason,headers=>$self->read_header_lines,protocol=>$protocol,}}sub write_request_header {@_==5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ ."\n");my ($self,$method,$request_uri,$headers,$header_case)=@_;return$self->write_header_lines($headers,$header_case,"$method $request_uri HTTP/1.1\x0D\x0A")}sub _do_timeout {my ($self,$type,$timeout)=@_;$timeout=$self->{timeout}unless defined$timeout && $timeout >= 0;my$fd=fileno$self->{fh};defined$fd && $fd >= 0 or die(qq/select(2): 'Bad file descriptor'\n/);my$initial=time;my$pending=$timeout;my$nfound;vec(my$fdset='',$fd,1)=1;while (){$nfound=($type eq 'read')? select($fdset,undef,undef,$pending): select(undef,$fdset,undef,$pending);if ($nfound==-1){$!==EINTR or die(qq/select(2): '$!'\n/);redo if!$timeout || ($pending=$timeout - (time - $initial))> 0;$nfound=0}last}$!=0;return$nfound}sub can_read {@_==1 || @_==2 || die(q/Usage: $handle->can_read([timeout])/ ."\n");my$self=shift;if (ref($self->{fh})eq 'IO::Socket::SSL'){return 1 if$self->{fh}->pending}return$self->_do_timeout('read',@_)}sub can_write {@_==1 || @_==2 || die(q/Usage: $handle->can_write([timeout])/ ."\n");my$self=shift;return$self->_do_timeout('write',@_)}sub _assert_ssl {my($ok,$reason)=HTTP::Tiny->can_ssl();die$reason unless$ok}sub can_reuse {my ($self,$scheme,$host,$port,$peer)=@_;return 0 if $self->{pid}!=$$ || $self->{tid}!=_get_tid()|| length($self->{rbuf})|| $scheme ne $self->{scheme}|| $host ne $self->{host}|| $port ne $self->{port}|| $peer ne $self->{peer}|| eval {$self->can_read(0)}|| $@ ;return 1}sub _find_CA_file {my$self=shift();my$ca_file=defined($self->{SSL_options}->{SSL_ca_file})? $self->{SSL_options}->{SSL_ca_file}: $ENV{SSL_CERT_FILE};if (defined$ca_file){unless (-r $ca_file){die qq/SSL_ca_file '$ca_file' not found or not readable\n/}return$ca_file}local@INC=@INC;pop@INC if$INC[-1]eq '.';return Mozilla::CA::SSL_ca_file()if eval {require Mozilla::CA;1};for my$ca_bundle ("/etc/ssl/certs/ca-certificates.crt","/etc/pki/tls/certs/ca-bundle.crt","/etc/ssl/ca-bundle.pem","/etc/openssl/certs/ca-certificates.crt","/etc/ssl/cert.pem","/usr/local/share/certs/ca-root-nss.crt","/etc/pki/tls/cacert.pem","/etc/certs/ca-certificates.crt",){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 _get_tid {no warnings 'reserved';return threads->can("tid")? threads->tid : 0}sub _ssl_args {my ($self,$host)=@_;my%ssl_args;if (Net::SSLeay::OPENSSL_VERSION_NUMBER()>= 0x01000000){$ssl_args{SSL_hostname}=$host,}if ($self->{verify_SSL}){$ssl_args{SSL_verifycn_scheme}='http';$ssl_args{SSL_verifycn_name}=$host;$ssl_args{SSL_verify_mode}=0x01;$ssl_args{SSL_ca_file}=$self->_find_CA_file}else {$ssl_args{SSL_verifycn_scheme}='none';$ssl_args{SSL_verify_mode}=0x00}for my$k (keys %{$self->{SSL_options}}){$ssl_args{$k}=$self->{SSL_options}{$k}if$k =~ m/^SSL_/}return \%ssl_args}1; sub $sub_name { my (\$self, \$url, \$args) = \@_; \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH') or _croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n"); return \$self->request('$req_method', \$url, \$args || {}); } HERE HTTP_TINY $fatpacked{"HTTP/Tinyish.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH'; package HTTP::Tinyish;use strict;use warnings;use Carp ();our$VERSION='0.14';our$PreferredBackend;our@Backends=map "HTTP::Tinyish::$_",qw(LWP HTTPTiny Curl Wget);my%configured;sub new {my($class,%attr)=@_;bless \%attr,$class}for my$method (qw/get head put post delete mirror/){no strict 'refs';eval <<"HERE"}sub request {my$self=shift;$self->_backend_for($_[1])->request(@_)}sub _backend_for {my($self,$url)=@_;my($scheme)=$url =~ m!^(https?):!;Carp::croak "URL Scheme '$url' not supported." unless$scheme;for my$backend ($self->backends){$self->configure_backend($backend)or next;if ($backend->supports($scheme)){return$backend->new(%$self)}}Carp::croak "No backend configured for scheme $scheme"}sub backends {$PreferredBackend ? ($PreferredBackend): @Backends}sub configure_backend {my($self,$backend)=@_;unless (exists$configured{$backend}){$configured{$backend}=eval {require_module($backend);$backend->configure}}$configured{$backend}}sub require_module {local $_=shift;s!::!/!g;require "$_.pm"}1; sub $method { my \$self = shift; \$self->_backend_for(\$_[0])->$method(\@_); } HERE HTTP_TINYISH $fatpacked{"HTTP/Tinyish/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_BASE'; package HTTP::Tinyish::Base;use strict;use warnings;for my$sub_name (qw/get head put post delete/){my$req_method=uc$sub_name;eval <<"HERE"}sub parse_http_header {my($self,$header,$res)=@_;$header =~ s/.*^(HTTP\/\d(?:\.\d)?)/$1/ms;if ($header =~ /^(.*?\x0d?\x0a\x0d?\x0a)/){$header=$1}my@header=split /\x0d?\x0a/,$header;my$status_line=shift@header;my@out;for (@header){if(/^[ \t]+/){return -1 unless@out;$out[-1].= $_}else {push@out,$_}}my($proto,$status,$reason)=split / /,$status_line,3;return unless$proto and $proto =~ /^HTTP\/(\d+)(\.(\d+))?$/i;$res->{status}=$status;$res->{reason}=$reason;$res->{success}=$status =~ /^(?:2|304)/;$res->{protocol}=$proto;my$token=qr/[^][\x00-\x1f\x7f()<>@,;:\\"\/?={} \t]+/;my$k;for my$header (@out){if ($header =~ s/^($token): ?//){$k=lc $1}elsif ($header =~ /^\s+/){}else {return -1}if (exists$res->{headers}{$k}){$res->{headers}{$k}=[$res->{headers}{$k}]unless ref$res->{headers}{$k};push @{$res->{headers}{$k}},$header}else {$res->{headers}{$k}=$header}}}sub internal_error {my($self,$url,$message)=@_;return {content=>$message,headers=>{"content-length"=>length($message),"content-type"=>"text/plain" },reason=>"Internal Exception",status=>599,success=>"",url=>$url,}}1; 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 HTTP_TINYISH_BASE $fatpacked{"HTTP/Tinyish/Curl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_CURL'; package HTTP::Tinyish::Curl;use strict;use warnings;use parent qw(HTTP::Tinyish::Base);use IPC::Run3 qw(run3);use File::Which qw(which);use File::Temp ();my%supports;my$curl;sub _slurp {open my$fh,"<",shift or die $!;local $/;<$fh>}sub configure {my$class=shift;my%meta;$curl=which('curl');eval {run3([$curl,'--version'],\undef,\my$version,\my$error);if ($version =~ /^Protocols: (.*)/m){my%protocols=map {$_=>1}split /\s/,$1;$supports{http}=1 if$protocols{http};$supports{https}=1 if$protocols{https}}$meta{$curl}=$version};\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attr)=@_;bless \%attr,$class}sub request {my($self,$method,$url,$opts)=@_;$opts ||= {};my(undef,$temp)=File::Temp::tempfile(UNLINK=>1);my($output,$error);eval {run3 [$curl,'-X',$method,($method eq 'HEAD' ? ('--head'): ()),$self->build_options($url,$opts),'--dump-header',$temp,$url,],\undef,\$output,\$error};if ($@ or $?){return$self->internal_error($url,$@ || $error)}my$res={url=>$url,content=>$output };$self->parse_http_header(_slurp($temp),$res);$res}sub mirror {my($self,$url,$file,$opts)=@_;$opts ||= {};my(undef,$temp)=File::Temp::tempfile(UNLINK=>1);my($output,$error);eval {run3 [$curl,$self->build_options($url,$opts),'-z',$file,'-o',$file,'--dump-header',$temp,'--remote-time',$url,],\undef,\$output,\$error};if ($@ or $?){return$self->internal_error($url,$@ || $error)}my$res={url=>$url,content=>$output };$self->parse_http_header(_slurp($temp),$res);$res}sub build_options {my($self,$url,$opts)=@_;my@options=('--location','--silent','--max-time',($self->{timeout}|| 60),'--max-redirs',($self->{max_redirect}|| 5),'--user-agent',($self->{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),);my%headers;if ($self->{default_headers}){%headers=%{$self->{default_headers}}}if ($opts->{headers}){%headers=(%headers,%{$opts->{headers}})}$self->_translate_headers(\%headers,\@options);unless ($self->{verify_SSL}){push@options,'--insecure'}if ($opts->{content}){my$content;if (ref$opts->{content}eq 'CODE'){while (my$chunk=$opts->{content}->()){$content .= $chunk}}else {$content=$opts->{content}}push@options,'--data',$content}@options}sub _translate_headers {my($self,$headers,$options)=@_;for my$field (keys %$headers){my$value=$headers->{$field};if (ref$value eq 'ARRAY'){push @$options,map {('-H',"$field:$_")}@$value}else {push @$options,'-H',"$field:$value"}}}1; HTTP_TINYISH_CURL $fatpacked{"HTTP/Tinyish/HTTPTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_HTTPTINY'; package HTTP::Tinyish::HTTPTiny;use strict;use parent qw(HTTP::Tinyish::Base);use HTTP::Tiny;my%supports=(http=>1);sub configure {my%meta=("HTTP::Tiny"=>$HTTP::Tiny::VERSION);$supports{https}=HTTP::Tiny->can_ssl;\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attrs)=@_;bless {tiny=>HTTP::Tiny->new(%attrs),},$class}sub request {my$self=shift;$self->{tiny}->request(@_)}sub mirror {my$self=shift;$self->{tiny}->mirror(@_)}1; HTTP_TINYISH_HTTPTINY $fatpacked{"HTTP/Tinyish/LWP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_LWP'; package HTTP::Tinyish::LWP;use strict;use parent qw(HTTP::Tinyish::Base);use LWP 5.802;use LWP::UserAgent;my%supports=(http=>1);sub configure {my%meta=(LWP=>$LWP::VERSION,);if (eval {require LWP::Protocol::https;1}){$supports{https}=1;$meta{"LWP::Protocol::https"}=$LWP::Protocol::https::VERSION}\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attr)=@_;my$ua=LWP::UserAgent->new;bless {ua=>$class->translate_lwp($ua,%attr),},$class}sub _headers_to_hashref {my($self,$hdrs)=@_;my%headers;for my$field ($hdrs->header_field_names){$headers{lc$field}=$hdrs->header($field)}\%headers}sub request {my($self,$method,$url,$opts)=@_;$opts ||= {};my$req=HTTP::Request->new($method=>$url);if ($opts->{headers}){$req->header(%{$opts->{headers}})}if ($opts->{content}){$req->content($opts->{content})}my$res=$self->{ua}->request($req);if ($self->is_internal_response($res)){return$self->internal_error($url,$res->content)}return {url=>$url,content=>$res->decoded_content(charset=>'none'),success=>$res->is_success,status=>$res->code,reason=>$res->message,headers=>$self->_headers_to_hashref($res->headers),protocol=>$res->protocol,}}sub mirror {my($self,$url,$file)=@_;my$res=$self->{ua}->mirror($url,$file);if ($self->is_internal_response($res)){return$self->internal_error($url,$res->content)}return {url=>$url,content=>$res->decoded_content,success=>$res->is_success || $res->code==304,status=>$res->code,reason=>$res->message,headers=>$self->_headers_to_hashref($res->headers),protocol=>$res->protocol,}}sub translate_lwp {my($class,$agent,%attr)=@_;$agent->parse_head(0);$agent->env_proxy;$agent->timeout(delete$attr{timeout}|| 60);$agent->max_redirect(delete$attr{max_redirect}|| 5);$agent->agent(delete$attr{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION");unless ($attr{verify_SSL}){if ($agent->can("ssl_opts")){$agent->ssl_opts(verify_hostname=>0)}}if ($attr{default_headers}){$agent->default_headers(HTTP::Headers->new(%{$attr{default_headers}}))}$agent}sub is_internal_response {my($self,$res)=@_;$res->code==500 && ($res->header('Client-Warning')|| '')eq 'Internal response'}1; HTTP_TINYISH_LWP $fatpacked{"HTTP/Tinyish/Wget.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_WGET'; package HTTP::Tinyish::Wget;use strict;use warnings;use parent qw(HTTP::Tinyish::Base);use IPC::Run3 qw(run3);use File::Which qw(which);my%supports;my$wget;my$method_supported;sub _run_wget {run3([$wget,@_],\undef,\my$out,\my$err);wantarray ? ($out,$err): $out}sub configure {my$class=shift;my%meta;$wget=which('wget');eval {local$ENV{LC_ALL}='en_US';$meta{$wget}=_run_wget('--version');unless ($meta{$wget}=~ /GNU Wget 1\.(\d+)/ and $1 >= 12){die "Wget version is too old. $meta{$wget}"}my$config=$class->new(agent=>__PACKAGE__);my@options=grep {$_ ne '--quiet'}$config->build_options("GET");my(undef,$err)=_run_wget(@options,'https://');if ($err && $err =~ /HTTPS support not compiled/){$supports{http}=1}elsif ($err && $err =~ /Invalid host/){$supports{http}=$supports{https}=1}(undef,$err)=_run_wget('--method','GET','http://');if ($err && $err =~ /Invalid host/){$method_supported=$meta{method_supported}=1}};\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attr)=@_;bless \%attr,$class}sub request {my($self,$method,$url,$opts)=@_;$opts ||= {};my($stdout,$stderr);eval {run3 [$wget,$self->build_options($method,$url,$opts),$url,'-O','-',],\undef,\$stdout,\$stderr};if ($@ or $? && ($? >> 8)<= 5){return$self->internal_error($url,$@ || $stderr)}my$header='';$stderr =~ s{^ (\S.*)$}{ $header .= $1."\n" }gem;my$res={url=>$url,content=>$stdout };$self->parse_http_header($header,$res);$res}sub mirror {my($self,$url,$file,$opts)=@_;$opts ||= {};my($stdout,$stderr);eval {run3 [$wget,$self->build_options("GET",$url,$opts),$url,'-O',$file],\undef,\$stdout,\$stderr};if ($@ or $?){return$self->internal_error($url,$@ || $stderr)}$stderr =~ s/^ //gm;my$res={url=>$url,content=>$stdout };$self->parse_http_header($stderr,$res);$res}sub build_options {my($self,$method,$url,$opts)=@_;my@options=('--retry-connrefused','--server-response','--timeout',($self->{timeout}|| 60),'--tries',1,'--max-redirect',($self->{max_redirect}|| 5),'--user-agent',($self->{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),);if ($method_supported){push@options,"--method",$method}else {if ($method eq 'GET' or $method eq 'POST'){}elsif ($method eq 'HEAD'){push@options,'--spider'}else {die "This version of wget doesn't support specifying HTTP method '$method'"}}if ($self->{agent}){push@options,'--user-agent',$self->{agent}}my%headers;if ($self->{default_headers}){%headers=%{$self->{default_headers}}}if ($opts->{headers}){%headers=(%headers,%{$opts->{headers}})}$self->_translate_headers(\%headers,\@options);if ($supports{https}&&!$self->{verify_SSL}){push@options,'--no-check-certificate'}if ($opts->{content}){my$content;if (ref$opts->{content}eq 'CODE'){while (my$chunk=$opts->{content}->()){$content .= $chunk}}else {$content=$opts->{content}}if ($method_supported){push@options,'--body-data',$content}else {push@options,'--post-data',$content}}@options}sub _translate_headers {my($self,$headers,$options)=@_;for my$field (keys %$headers){my$value=$headers->{$field};if (ref$value eq 'ARRAY'){push @$options,'--header',"$field:" .join(",",@$value)}else {push @$options,'--header',"$field:$value"}}}1; HTTP_TINYISH_WGET $fatpacked{"IPC/Cmd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'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 $HAVE_MONOTONIC];$VERSION='1.00';$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;require Time::HiRes;Time::HiRes->import();require Win32 if IS_WIN32};$CAN_USE_RUN_FORKED=$@ ||!IS_VMS &&!IS_WIN32;eval {my$wait_start_time=Time::HiRes::clock_gettime(&Time::HiRes::CLOCK_MONOTONIC)};if ($@){$HAVE_MONOTONIC=0}else {$HAVE_MONOTONIC=1}@ISA=qw[Exporter];@EXPORT_OK=qw[can_run run run_forked QUOTE]}require Carp;use File::Spec;use Params::Check qw[check];use Text::ParseWords ();use Module::Load::Conditional qw[can_load];use Locale::Maketext::Simple Style=>'gettext';local$Module::Load::Conditional::FORCE_SAFE_INC=1;sub can_use_ipc_run {my$self=shift;my$verbose=shift || 0;return if IS_WIN98;return unless can_load(modules=>{'IPC::Run'=>'0.55' },verbose=>($WARN && $verbose),);return$IPC::Run::VERSION}sub can_use_ipc_open3 {my$self=shift;my$verbose=shift || 0;return if IS_VMS;return unless can_load(modules=>{map {$_=>'0.0'}qw|IPC::Open3 IO::Select Symbol| },verbose=>($WARN && $verbose),);return$IPC::Open3::VERSION}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}sub can_run {my$command=shift;if ($^O eq 'VMS'){require VMS::DCLsym;my$syms=VMS::DCLsym->new;return$command if scalar$syms->getsym(uc$command)}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 (File::Spec->path,(IS_WIN32 ? 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}{my@acc=qw[ok error _fds];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"}sub get_monotonic_time {if ($HAVE_MONOTONIC){return Time::HiRes::clock_gettime(&Time::HiRes::CLOCK_MONOTONIC)}else {return time()}}sub adjust_monotonic_start_time {my ($ref_vars,$now,$previous)=@_;return if$HAVE_MONOTONIC;return unless$previous;my$time_diff=$now - $previous;if ($time_diff > 5 || $time_diff < 0){for my$ref_var (@{$ref_vars}){if (defined($$ref_var)){$$ref_var=$$ref_var + $time_diff}}}}sub uninstall_signals {return unless defined($IPC::Cmd::{'__old_signals'});for my$sig_name (keys %{$IPC::Cmd::{'__old_signals'}}){$SIG{$sig_name}=$IPC::Cmd::{'__old_signals'}->{$sig_name}}}sub install_layered_signal {my ($s,$handler_code)=@_;my%available_signals=map {$_=>1}keys%SIG;Carp::confess("install_layered_signal got nonexistent signal name [$s]")unless defined($available_signals{$s});Carp::confess("install_layered_signal expects coderef")if!ref($handler_code)|| ref($handler_code)ne 'CODE';$IPC::Cmd::{'__old_signals'}={}unless defined($IPC::Cmd::{'__old_signals'});$IPC::Cmd::{'__old_signals'}->{$s}=$SIG{$s};my$previous_handler=$SIG{$s};my$sig_handler=sub {my ($called_sig_name,@sig_param)=@_;my$signal_name=$s;if ($called_sig_name eq $signal_name){$handler_code->($signal_name)}if (ref($previous_handler)){$previous_handler->($called_sig_name,@sig_param)}};$SIG{$s}=$sig_handler}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$do_wait=1;my$child_finished=0;my$wait_start_time=get_monotonic_time();my$now;my$previous_monotonic_value;while ($do_wait){$previous_monotonic_value=$now;$now=get_monotonic_time();adjust_monotonic_start_time([\$wait_start_time],$now,$previous_monotonic_value);if ($now > $wait_start_time + $opts->{'wait_time'}){$do_wait=0;next}my$waitpid=waitpid($pid,POSIX::WNOHANG);if ($waitpid eq -1){$child_finished=1;$do_wait=0;next}Time::HiRes::usleep(250000)}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);Time::HiRes::usleep(1);if ($opts->{'parent_info'}){my$ps=$opts->{'parent_info'};print$ps "spawned $pid\n"}if ($child_in && $child_out->opened && $opts->{'child_stdin'}){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);SIGNAL: foreach my$s (keys%SIG){next SIGNAL if$s eq '__WARN__' or $s eq '__DIE__';my$sig_handler;$sig_handler=sub {kill("$s",$pid);$SIG{$s}=$sig_handler};$SIG{$s}=$sig_handler}my$child_finished=0;my$real_exit;my$exit_value;while(!$child_finished){if (getppid()eq "1"){kill(-9,$$);POSIX::_exit 1}my$waitpid=waitpid($pid,POSIX::WNOHANG);if ($waitpid ne 0 && $waitpid ne -1){$real_exit=$?;$exit_value=$? >> 8}if ($waitpid eq -1){$child_finished=1}my$ready_fds=[];push @{$ready_fds},$select->can_read(1/100);READY_FDS: while (scalar(@{$ready_fds})){my$fd=shift @{$ready_fds};$ready_fds=[grep {$_ ne $fd}@{$ready_fds}];my$str=$child_output->{$fd->fileno};Carp::confess("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 {Carp::confess("error during sysread: " .$!)}push @{$ready_fds},$select->can_read(1/100)if$child_finished}Time::HiRes::usleep(1)}if ($opts->{'parent_info'}){my$ps=$opts->{'parent_info'};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,}}}sub run_forked {my$self=bless {},__PACKAGE__;if (!can_use_run_forked()){Carp::carp("run_forked is not available: $CAN_USE_RUN_FORKED");return}require POSIX;my ($cmd,$opts)=@_;if (ref($cmd)eq 'ARRAY'){$cmd=join(" ",@{$cmd})}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'});$opts->{'clean_up_children'}=1 unless defined($opts->{'clean_up_children'});my$child_stdout_socket;my$parent_stdout_socket;my$child_stderr_socket;my$parent_stderr_socket;my$child_info_socket;my$parent_info_socket;socketpair($child_stdout_socket,$parent_stdout_socket,&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)|| Carp::confess ("socketpair: $!");socketpair($child_stderr_socket,$parent_stderr_socket,&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)|| Carp::confess ("socketpair: $!");socketpair($child_info_socket,$parent_info_socket,&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)|| Carp::confess ("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=get_monotonic_time();my$pid;if ($pid=fork){close($parent_stdout_socket);close($parent_stderr_socket);close($parent_info_socket);my$flags;$flags=fcntl($child_stdout_socket,POSIX::F_GETFL,0)|| Carp::confess "can't fnctl F_GETFL: $!";$flags |= POSIX::O_NONBLOCK;fcntl($child_stdout_socket,POSIX::F_SETFL,$flags)|| Carp::confess "can't fnctl F_SETFL: $!";$flags=fcntl($child_stderr_socket,POSIX::F_GETFL,0)|| Carp::confess "can't fnctl F_GETFL: $!";$flags |= POSIX::O_NONBLOCK;fcntl($child_stderr_socket,POSIX::F_SETFL,$flags)|| Carp::confess "can't fnctl F_SETFL: $!";$flags=fcntl($child_info_socket,POSIX::F_GETFL,0)|| Carp::confess "can't fnctl F_GETFL: $!";$flags |= POSIX::O_NONBLOCK;fcntl($child_info_socket,POSIX::F_SETFL,$flags)|| Carp::confess "can't fnctl F_SETFL: $!";my$child_output={$child_stdout_socket->fileno=>{'scalar_buffer'=>"",'child_handle'=>$child_stdout_socket,'block_size'=>($child_stdout_socket->stat)[11]|| 1024,'protocol'=>'stdout',},$child_stderr_socket->fileno=>{'scalar_buffer'=>"",'child_handle'=>$child_stderr_socket,'block_size'=>($child_stderr_socket->stat)[11]|| 1024,'protocol'=>'stderr',},$child_info_socket->fileno=>{'scalar_buffer'=>"",'child_handle'=>$child_info_socket,'block_size'=>($child_info_socket->stat)[11]|| 1024,'protocol'=>'info',},};my$select=IO::Select->new();$select->add($child_stdout_socket,$child_stderr_socket,$child_info_socket);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$last_parent_check=0;my$got_sig_child=0;my$got_sig_quit=0;my$orig_sig_child=$SIG{'CHLD'};$SIG{'CHLD'}=sub {$got_sig_child=get_monotonic_time()};if ($opts->{'terminate_on_signal'}){install_layered_signal($opts->{'terminate_on_signal'},sub {$got_sig_quit=time()})}my$child_child_pid;my$now;my$previous_monotonic_value;while (!$child_finished){$previous_monotonic_value=$now;$now=get_monotonic_time();adjust_monotonic_start_time([\$start_time,\$last_parent_check,\$got_sig_child],$now,$previous_monotonic_value);if ($opts->{'terminate_on_parent_sudden_death'}){if ($now > $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}$last_parent_check=$now}}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}}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);if ($waitpid ne 0 && $waitpid ne -1){$child_exit_code=$? >> 8}if ($waitpid eq -1){$child_finished=1}my$ready_fds=[];push @{$ready_fds},$select->can_read(1/100);READY_FDS: while (scalar(@{$ready_fds})){my$fd=shift @{$ready_fds};$ready_fds=[grep {$_ ne $fd}@{$ready_fds}];my$str=$child_output->{$fd->fileno};Carp::confess("child stream not found: $fd")unless$str;my$data="";my$count=$fd->sysread($data,$str->{'block_size'});if ($count){if ($data =~ /(.+\n)([^\n]*)/so){$data=$str->{'scalar_buffer'}.$1;$str->{'scalar_buffer'}=$2 || ""}else {$str->{'scalar_buffer'}.= $data;$data=""}}elsif ($count eq 0){$select->remove($fd);$fd->close();if ($str->{'scalar_buffer'}){$data=$str->{'scalar_buffer'}."\n"}}else {Carp::confess("error during sysread on [$fd]: " .$!)}if ($str->{'protocol'}eq 'info'){if ($data =~ /^spawned ([0-9]+?)\n(.*?)/so){$child_child_pid=$1;$data=$2}if ($data =~ /^reaped ([0-9]+?)\n(.*?)/so){$child_child_pid=undef;$data=$2}if ($data =~ /^[\d]+ killed with ([0-9]+?)\n(.*?)/so){$child_killed_by_signal=$1;$data=$2}if ($data){Carp::confess("info protocol violation: [$data]")}}if ($str->{'protocol'}eq 'stdout'){if (!$opts->{'discard_output'}){$child_stdout .= $data;$child_merged .= $data}if ($opts->{'stdout_handler'}&& ref($opts->{'stdout_handler'})eq 'CODE'){$opts->{'stdout_handler'}->($data)}}if ($str->{'protocol'}eq 'stderr'){if (!$opts->{'discard_output'}){$child_stderr .= $data;$child_merged .= $data}if ($opts->{'stderr_handler'}&& ref($opts->{'stderr_handler'})eq 'CODE'){$opts->{'stderr_handler'}->($data)}}push @{$ready_fds},$select->can_read(1/100)if$child_finished}if ($opts->{'wait_loop_callback'}&& ref($opts->{'wait_loop_callback'})eq 'CODE'){$opts->{'wait_loop_callback'}->()}Time::HiRes::usleep(1)}if ($child_child_pid){kill_gently($child_child_pid)}if ($opts->{'clean_up_children'}){kill(-9,$pid)}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,'cmd'=>$cmd,};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'}&&!$opts->{'non_empty_stdout_ok'}){$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'})}uninstall_signals();return$o}else {Carp::confess("cannot fork: $!")unless defined($pid);POSIX::setsid()|| Carp::confess("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;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'){open STDOUT,'>&',$parent_stdout_socket || Carp::confess("Unable to reopen STDOUT: $!\n");open STDERR,'>&',$parent_stderr_socket || Carp::confess("Unable to reopen STDERR: $!\n");$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'}->()}$|=1;POSIX::_exit$child_exit_code}}sub run {my$self=bless {},__PACKAGE__;my%hash=@_;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;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;my(@buffer,@buff_err,@buff_out);my$_out_handler=sub {my$buf=shift;return unless defined$buf;print STDOUT$buf if$verbose;push@buffer,$buf;push@buff_out,$buf};my$_err_handler=sub {my$buf=shift;return unless defined$buf;print STDERR$buf if$verbose;push@buffer,$buf;push@buff_err,$buf};my$have_buffer=$self->can_capture_buffer ? 1 : 0;my$ok;local $?;local $@;local $!;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;if(!IS_WIN32 and $USE_IPC_RUN and $self->can_use_ipc_run(1)){$self->_debug("# Using IPC::Run. Have buffer: $have_buffer")if$DEBUG;$ok=$self->_ipc_run($cmd,$_out_handler,$_err_handler)}elsif ($USE_IPC_OPEN3 and $self->can_use_ipc_open3(1)){$self->_debug("# Using IPC::Open3. Have buffer: $have_buffer")if$DEBUG;my$method=IS_WIN32 ? '_open3_run_win32' : '_open3_run';$ok=$self->$method($cmd,$_out_handler,$_err_handler,$verbose)}else {$self->_debug("# Using system(). Have buffer: $have_buffer")if$DEBUG;$ok=$self->_system_run($cmd,$verbose)}alarm 0};$self->__reopen_fds(@{$self->_fds})if$self->_fds;my$err;unless($ok){if ($@ and ref $@ and $@->isa(ALARM_CLASS)){$err=$@->()}else {$err=$self->error}}$$buffer=join '',@buffer if@buffer;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;require Socket;my$pipe=sub {socketpair($_[0],$_[1],&Socket::AF_UNIX,&Socket::SOCK_STREAM,&Socket::PF_UNSPEC)or return undef;shutdown($_[0],1);shutdown($_[1],0);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);if (!$bytes_read){$in_sel->remove($fh)}else {$obj->("$buf")}}for my$fh (@$outs){}}waitpid($pid,0);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;use Symbol;my$kidout=Symbol::gensym();my$kiderror=Symbol::gensym();my@fds_to_dup=(IS_WIN32 &&!$verbose ? qw[STDIN STDOUT STDERR] : qw[STDIN]);$self->_fds(\@fds_to_dup);$self->__dup_fds(@fds_to_dup);$cmd=$self->__fix_cmd_whitespace_and_special_chars($cmd);my$pid=eval {IPC::Open3::open3('<&STDIN',(IS_WIN32 ? '>&STDOUT' : $kidout),(IS_WIN32 ? '>&STDERR' : $kiderror),(ref$cmd ? @$cmd : $cmd),)};if($@ and $@ =~ /^open3:/){$self->ok(0);$self->error($@);return};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');my$stdout_done=0;my$stderr_done=0;OUTER: while (my@ready=$selector->can_read){for my$h (@ready){my$buf;my$len=sysread($h,$buf,4096);if(not defined$len){warn(loc("Error reading from process: %1",$!));last OUTER}$_out_handler->("$buf")if$len && $h==$kidout;$_err_handler->("$buf")if$len && $h==$kiderror;$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;if($?){$self->error($self->_pp_child_error($cmd,$?));$self->ok(0);return}else {return$self->ok(1)}}{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);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 {[map {m/[ ]/ ? qq{'$_'} : $_}$parse_sub->($_)]}}split(/\s*$re\s*/,$cmd)}my$ok=eval {IPC::Run::run(@command,fileno(STDOUT).'>',$_out_handler,fileno(STDERR).'>',$_err_handler)};if($ok){return$self->ok($ok)}else {$self->ok(0);if($@ and not UNIVERSAL::isa($@,ALARM_CLASS)){$self->error($@)}elsif($@){die $@}else {$self->error($self->_pp_child_error($cmd,$?))}return}}}sub _system_run {my$self=shift;my$cmd=shift;my$verbose=shift || 0;$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);$self->ok(1);system(ref$cmd ? @$cmd : $cmd)==0 or do {$self->error($self->_pp_child_error($cmd,$?));$self->ok(0)};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;if(ref$cmd and grep {$sc_lookup{$_}}@$cmd){my$fixed;my@cmd=map {/ / ? do {$fixed++;QUOTE.$_.QUOTE}: $_}@$cmd;$self->_debug("# Quoted $fixed arguments containing whitespace")if$DEBUG && $fixed;$cmd=join ' ',@cmd}return$cmd}}sub _quote_args_vms {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;map {if (/^[^\/\"]/){$_ =~ s/\"/""/g;$_=q(").$_.q(")}}($got_arrayref ? @{$args[0]}: @args);$got_arrayref ? unshift(@{$args[0]},$cmd): unshift(@args,$cmd);return$got_arrayref ? $args[0]: join(' ',@args)}sub _split_like_shell_win32 {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 ' ')){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()],);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);open$glob,$redir .fileno($fh)or (Carp::carp(loc("Could not dup '$name': %1",$!)),return);if($redir eq '>&'){open($fh,'>' .File::Spec->devnull)or (Carp::carp(loc("Could not reopen '$name': %1",$!)),return)}}return 1}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);open($fh,$redir .fileno($glob))or (Carp::carp(loc("Could not restore '$name': %1",$!)),return);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){$str="Failed to execute '$pp_cmd': $!"}elsif ($ce & 127){$str=loc("'%1' died with signal %2, %3 coredump",$pp_cmd,($ce & 127),($ce & 128)? 'with' : 'without')}else {$str="'$pp_cmd' exited with value " .($ce >> 8)}$self->_debug("# Child error '$ce' translated to: $str")if$DEBUG;return$str}1; IPC_CMD $fatpacked{"IPC/Run3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3'; package IPC::Run3;BEGIN {require 5.006_000}use strict;our$VERSION='0.048';use Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(run3);our%EXPORT_TAGS=(all=>\@EXPORT);use constant debugging=>$ENV{IPCRUN3DEBUG}|| $ENV{IPCRUNDEBUG}|| 0;use constant profiling=>$ENV{IPCRUN3PROFILE}|| $ENV{IPCRUNPROFILE}|| 0;use constant is_win32=>0 <= index $^O,"Win32";BEGIN {if (is_win32){eval "use Win32 qw( GetOSName ); use Win32::ShellQuote qw(quote_native); 1" or die $@}}use Carp qw(croak);use File::Temp qw(tempfile);use POSIX qw(dup dup2);my%fh_cache;my$fh_cache_pid=$$;my$profiler;sub _profiler {$profiler}BEGIN {if (profiling){eval "use Time::HiRes qw( gettimeofday ); 1" or die $@;if ($ENV{IPCRUN3PROFILE}=~ /\A\d+\z/){require IPC::Run3::ProfPP;IPC::Run3::ProfPP->import;$profiler=IPC::Run3::ProfPP->new(Level=>$ENV{IPCRUN3PROFILE})}else {my ($dest,undef,$class)=reverse split /(=)/,$ENV{IPCRUN3PROFILE},2;$class="IPC::Run3::ProfLogger" unless defined$class && length$class;if (not eval "require $class"){my$e=$@;$class="IPC::Run3::$class";eval "require IPC::Run3::$class" or die$e}$profiler=$class->new(Destination=>$dest)}$profiler->app_call([$0,@ARGV ],scalar gettimeofday())}}END {$profiler->app_exit(scalar gettimeofday())if profiling}sub _binmode {my ($fh,$mode,$what)=@_;my$layer=!$mode ? (is_win32 ? ":crlf" : ":raw"): ($mode =~ /^:/ ? $mode : ":raw");warn "binmode $what, $layer\n" if debugging >= 2;binmode$fh,":raw" unless$layer eq ":raw";binmode$fh,$layer or croak "binmode $layer failed: $!"}sub _spool_data_to_child {my ($type,$source,$binmode_it)=@_;return undef unless defined$source;my$fh;if (!$type){open$fh,"<",$source or croak "$!: $source";_binmode($fh,$binmode_it,"STDIN");warn "run3(): feeding file '$source' to child STDIN\n" if debugging >= 2}elsif ($type eq "FH"){$fh=$source;warn "run3(): feeding filehandle '$source' to child STDIN\n" if debugging >= 2}else {$fh=$fh_cache{in}||= tempfile;truncate$fh,0;seek$fh,0,0;_binmode($fh,$binmode_it,"STDIN");my$seekit;if ($type eq "SCALAR"){return$fh unless defined $$source;warn "run3(): feeding SCALAR to child STDIN",debugging >= 3 ? (": '",$$source,"' (",length $$source," chars)"): (),"\n" if debugging >= 2;$seekit=length $$source;print$fh $$source or die "$! writing to temp file"}elsif ($type eq "ARRAY"){warn "run3(): feeding ARRAY to child STDIN",debugging >= 3 ? (": '",@$source,"'"): (),"\n" if debugging >= 2;print$fh @$source or die "$! writing to temp file";$seekit=grep length,@$source}elsif ($type eq "CODE"){warn "run3(): feeding output of CODE ref '$source' to child STDIN\n" if debugging >= 2;my$parms=[];while (1){my$data=$source->(@$parms);last unless defined$data;print$fh $data or die "$! writing to temp file";$seekit=length$data}}seek$fh,0,0 or croak "$! seeking on temp file for child's stdin" if$seekit}croak "run3() can't redirect $type to child stdin" unless defined$fh;return$fh}sub _fh_for_child_output {my ($what,$type,$dest,$options)=@_;my$fh;if ($type eq "SCALAR" && $dest==\undef){warn "run3(): redirecting child $what to oblivion\n" if debugging >= 2;$fh=$fh_cache{nul}||= do {open$fh,">",File::Spec->devnull;$fh}}elsif ($type eq "FH"){$fh=$dest;warn "run3(): redirecting $what to filehandle '$dest'\n" if debugging >= 3}elsif (!$type){warn "run3(): feeding child $what to file '$dest'\n" if debugging >= 2;open$fh,$options->{"append_$what"}? ">>" : ">",$dest or croak "$!: $dest"}else {warn "run3(): capturing child $what\n" if debugging >= 2;$fh=$fh_cache{$what}||= tempfile;seek$fh,0,0;truncate$fh,0}my$binmode_it=$options->{"binmode_$what"};_binmode($fh,$binmode_it,uc$what);return$fh}sub _read_child_output_fh {my ($what,$type,$dest,$fh,$options)=@_;return if$type eq "SCALAR" && $dest==\undef;seek$fh,0,0 or croak "$! seeking on temp file for child $what";if ($type eq "SCALAR"){warn "run3(): reading child $what to SCALAR\n" if debugging >= 3;my$count=read$fh,$$dest,10_000,$options->{"append_$what"}? length $$dest : 0;while (1){croak "$! reading child $what from temp file" unless defined$count;last unless$count;warn "run3(): read $count bytes from child $what",debugging >= 3 ? (": '",substr($$dest,-$count),"'"): (),"\n" if debugging >= 2;$count=read$fh,$$dest,10_000,length $$dest}}elsif ($type eq "ARRAY"){if ($options->{"append_$what"}){push @$dest,<$fh>}else {@$dest=<$fh>}if (debugging >= 2){my$count=0;$count += length for @$dest;warn "run3(): read ",scalar @$dest," records, $count bytes from child $what",debugging >= 3 ? (": '",@$dest,"'"): (),"\n"}}elsif ($type eq "CODE"){warn "run3(): capturing child $what to CODE ref\n" if debugging >= 3;local $_;while (<$fh>){warn "run3(): read ",length," bytes from child $what",debugging >= 3 ? (": '",$_,"'"): (),"\n" if debugging >= 2;$dest->($_)}}else {croak "run3() can't redirect child $what to a $type"}}sub _type {my ($redir)=@_;return "FH" if eval {local$SIG{'__DIE__'};$redir->isa("IO::Handle")};my$type=ref$redir;return$type eq "GLOB" ? "FH" : $type}sub _max_fd {my$fd=dup(0);POSIX::close$fd;return$fd}my$run_call_time;my$sys_call_time;my$sys_exit_time;sub run3 {$run_call_time=gettimeofday()if profiling;my$options=@_ && ref $_[-1]eq "HASH" ? pop : {};my ($cmd,$stdin,$stdout,$stderr)=@_;print STDERR "run3(): running ",join(" ",map "'$_'",ref$cmd ? @$cmd : $cmd),"\n" if debugging;if (ref$cmd){croak "run3(): empty command" unless @$cmd;croak "run3(): undefined command" unless defined$cmd->[0];croak "run3(): command name ('')" unless length$cmd->[0]}else {croak "run3(): missing command" unless @_;croak "run3(): undefined command" unless defined$cmd;croak "run3(): command ('')" unless length$cmd}for (qw/binmode_stdin binmode_stdout binmode_stderr/){if (my$mode=$options->{$_}){croak qq[option $_ must be a number or a proper layer string: "$mode"] unless$mode =~ /^(:|\d+$)/}}my$in_type=_type$stdin;my$out_type=_type$stdout;my$err_type=_type$stderr;if ($fh_cache_pid!=$$){close $_ foreach values%fh_cache;%fh_cache=();$fh_cache_pid=$$}my$in_fh=_spool_data_to_child$in_type,$stdin,$options->{binmode_stdin}if defined$stdin;my$out_fh=_fh_for_child_output "stdout",$out_type,$stdout,$options if defined$stdout;my$tie_err_to_out=defined$stderr && defined$stdout && $stderr eq $stdout;my$err_fh=$tie_err_to_out ? $out_fh : _fh_for_child_output "stderr",$err_type,$stderr,$options if defined$stderr;local*STDOUT_SAVE;local*STDERR_SAVE;my$saved_fd0=dup(0)if defined$in_fh;open STDOUT_SAVE,">&STDOUT" or croak "run3(): $! saving STDOUT" if defined$out_fh;open STDERR_SAVE,">&STDERR" or croak "run3(): $! saving STDERR" if defined$err_fh;my$errno;my$ok=eval {dup2(fileno$in_fh,0)or croak "run3(): $! redirecting STDIN" if defined$in_fh;open STDOUT,">&" .fileno$out_fh or croak "run3(): $! redirecting STDOUT" if defined$out_fh;open STDERR,">&" .fileno$err_fh or croak "run3(): $! redirecting STDERR" if defined$err_fh;$sys_call_time=gettimeofday()if profiling;my$r=ref$cmd ? system {$cmd->[0]}is_win32 ? quote_native(@$cmd): @$cmd : system$cmd;$errno=$!;$sys_exit_time=gettimeofday()if profiling;if (debugging){my$err_fh=defined$err_fh ? \*STDERR_SAVE : \*STDERR;if (defined$r && $r!=-1){print$err_fh "run3(): \$? is $?\n"}else {print$err_fh "run3(): \$? is $?, \$! is $errno\n"}}if (defined$r && ($r==-1 || (is_win32 && $r==0xFF00))&&!$options->{return_if_system_error}){croak($errno)}1};my$x=$@;my@errs;if (defined$saved_fd0){dup2($saved_fd0,0);POSIX::close($saved_fd0)}open STDOUT,">&STDOUT_SAVE" or push@errs,"run3(): $! restoring STDOUT" if defined$out_fh;open STDERR,">&STDERR_SAVE" or push@errs,"run3(): $! restoring STDERR" if defined$err_fh;croak join ", ",@errs if@errs;die$x unless$ok;_read_child_output_fh "stdout",$out_type,$stdout,$out_fh,$options if defined$out_fh && $out_type && $out_type ne "FH";_read_child_output_fh "stderr",$err_type,$stderr,$err_fh,$options if defined$err_fh && $err_type && $err_type ne "FH" &&!$tie_err_to_out;$profiler->run_exit($cmd,$run_call_time,$sys_call_time,$sys_exit_time,scalar gettimeofday())if profiling;$!=$errno;return 1}1; IPC_RUN3 $fatpacked{"IPC/Run3/ProfArrayBuffer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFARRAYBUFFER'; package IPC::Run3::ProfArrayBuffer;$VERSION=0.048;use strict;sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{Events}=[];return$self}for my$subname (qw(app_call app_exit run_exit)){no strict 'refs';*{$subname}=sub {push @{shift->{Events}},[$subname=>@_ ]}}sub get_events {my$self=shift;@{$self->{Events}}}1; IPC_RUN3_PROFARRAYBUFFER $fatpacked{"IPC/Run3/ProfLogReader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGREADER'; package IPC::Run3::ProfLogReader;$VERSION=0.048;use strict;sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{Source}="run3.out" unless defined$self->{Source}&& length$self->{Source};my$source=$self->{Source};if (ref$source eq "GLOB" || UNIVERSAL::isa($source,"IO::Handle")){$self->{FH}=$source}elsif ($source eq "-"){$self->{FH}=\*STDIN}else {open PROFILE,"<$self->{Source}" or die "$!: $self->{Source}\n";$self->{FH}=*PROFILE{IO}}return$self}sub set_handler {$_[0]->{Handler}=$_[1]}sub get_handler {$_[0]->{Handler}}sub read {my$self=shift;my$fh=$self->{FH};my@ln=split / /,<$fh>;return 0 unless@ln;return 1 unless$self->{Handler};chomp$ln[-1];return 1 if@ln==1 &&!length$ln[0]|| 0==index$ln[0],"#";if ($ln[0]eq "\\app_call"){shift@ln;my@times=split /,/,pop@ln;$self->{Handler}->app_call([map {s/\\\\/\\/g;s/\\_/ /g;$_}@ln ],@times)}elsif ($ln[0]eq "\\app_exit"){shift@ln;$self->{Handler}->app_exit(pop@ln,@ln)}else {my@times=split /,/,pop@ln;$self->{Handler}->run_exit([map {s/\\\\/\\/g;s/\\_/ /g;$_}@ln ],@times)}return 1}sub read_all {my$self=shift;1 while$self->read;return 1}1; IPC_RUN3_PROFLOGREADER $fatpacked{"IPC/Run3/ProfLogger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFLOGGER'; package IPC::Run3::ProfLogger;$VERSION=0.048;use strict;sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{Destination}="run3.out" unless defined$self->{Destination}&& length$self->{Destination};open PROFILE,">$self->{Destination}" or die "$!: $self->{Destination}\n";binmode PROFILE;$self->{FH}=*PROFILE{IO};$self->{times}=[];return$self}sub run_exit {my$self=shift;my$fh=$self->{FH};print($fh join(" ",(map {my$s=$_;$s =~ s/\\/\\\\/g;$s =~ s/ /_/g;$s}@{shift()}),join(",",@{$self->{times}},@_,),),"\n")}sub app_exit {my$self=shift;my$fh=$self->{FH};print$fh "\\app_exit ",shift,"\n"}sub app_call {my$self=shift;my$fh=$self->{FH};my$t=shift;print($fh join(" ","\\app_call",(map {my$s=$_;$s =~ s/\\\\/\\/g;$s =~ s/ /\\_/g;$s}@_),$t,),"\n")}1; IPC_RUN3_PROFLOGGER $fatpacked{"IPC/Run3/ProfPP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFPP'; package IPC::Run3::ProfPP;$VERSION=0.048;require IPC::Run3::ProfReporter;@ISA=qw(IPC::Run3::ProfReporter);use strict;use POSIX qw(floor);sub _emit {shift;warn @_}sub _t {sprintf "%10.6f secs",@_}sub _r {my ($num,$denom)=@_;return ()unless$denom;sprintf "%10.6f",$num / $denom}sub _pct {my ($num,$denom)=@_;return ()unless$denom;sprintf " (%3d%%)",floor(100 * $num / $denom + 0.5)}sub handle_app_call {my$self=shift;$self->_emit("IPC::Run3 parent: ",join(" ",@{$self->get_app_cmd}),"\n",);$self->{NeedNL}=1}sub handle_app_exit {my$self=shift;$self->_emit("\n")if$self->{NeedNL}&& $self->{NeedNL}!=1;$self->_emit("IPC::Run3 total elapsed: ",_t($self->get_app_cumulative_time),"\n");$self->_emit("IPC::Run3 calls to run3(): ",sprintf("%10d",$self->get_run_count),"\n");$self->_emit("IPC::Run3 total spent in run3(): ",_t($self->get_run_cumulative_time),_pct($self->get_run_cumulative_time,$self->get_app_cumulative_time),", ",_r($self->get_run_cumulative_time,$self->get_run_count)," per call","\n");my$exclusive=$self->get_app_cumulative_time - $self->get_run_cumulative_time;$self->_emit("IPC::Run3 total spent not in run3(): ",_t($exclusive),_pct($exclusive,$self->get_app_cumulative_time),"\n");$self->_emit("IPC::Run3 total spent in children: ",_t($self->get_sys_cumulative_time),_pct($self->get_sys_cumulative_time,$self->get_app_cumulative_time),", ",_r($self->get_sys_cumulative_time,$self->get_run_count)," per call","\n");my$overhead=$self->get_run_cumulative_time - $self->get_sys_cumulative_time;$self->_emit("IPC::Run3 total overhead: ",_t($overhead),_pct($overhead,$self->get_sys_cumulative_time),", ",_r($overhead,$self->get_run_count)," per call","\n")}sub handle_run_exit {my$self=shift;my$overhead=$self->get_run_time - $self->get_sys_time;$self->_emit("\n")if$self->{NeedNL}&& $self->{NeedNL}!=2;$self->{NeedNL}=3;$self->_emit("IPC::Run3 child: ",join(" ",@{$self->get_run_cmd}),"\n");$self->_emit("IPC::Run3 run3() : ",_t($self->get_run_time),"\n","IPC::Run3 child : ",_t($self->get_sys_time),"\n","IPC::Run3 overhead: ",_t($overhead),_pct($overhead,$self->get_sys_time),"\n")}1; IPC_RUN3_PROFPP $fatpacked{"IPC/Run3/ProfReporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3_PROFREPORTER'; package IPC::Run3::ProfReporter;$VERSION=0.048;use strict;my$loaded_by;sub import {$loaded_by=shift}END {my@caller;for (my$i=0;;++$i ){my@c=caller$i;last unless@c;@caller=@c}if ($caller[0]eq "main" && $caller[1]eq "-e"){require IPC::Run3::ProfLogReader;require Getopt::Long;my ($app,$run);Getopt::Long::GetOptions("app"=>\$app,"run"=>\$run,);$app=1,$run=1 unless$app || $run;for (@ARGV ? @ARGV : ""){my$r=IPC::Run3::ProfLogReader->new(Source=>$_,Handler=>$loaded_by->new(Source=>$_,app_report=>$app,run_report=>$run,),);$r->read_all}}}sub new {my$class=ref $_[0]? ref shift : shift;my$self=bless {@_ },$class;$self->{app_report}=1,$self->{run_report}=1 unless$self->{app_report}|| $self->{run_report};return$self}sub handle_app_call {}sub handle_app_exit {}sub handle_run_exit {}sub app_call {my$self=shift;($self->{app_cmd},$self->{app_call_time})=@_;$self->handle_app_call if$self->{app_report}}sub app_exit {my$self=shift;$self->{app_exit_time}=shift;$self->handle_app_exit if$self->{app_report}}sub run_exit {my$self=shift;@{$self}{qw(run_cmd run_call_time sys_call_time sys_exit_time run_exit_time)}=@_;++$self->{run_count};$self->{run_cumulative_time}+= $self->get_run_time;$self->{sys_cumulative_time}+= $self->get_sys_time;$self->handle_run_exit if$self->{run_report}}sub get_run_count {shift->{run_count}}sub get_app_call_time {shift->{app_call_time}}sub get_app_exit_time {shift->{app_exit_time}}sub get_app_cmd {shift->{app_cmd}}sub get_app_time {my$self=shift;$self->get_app_exit_time - $self->get_app_call_time}sub get_app_cumulative_time {my$self=shift;$self->get_app_exit_time - $self->get_app_call_time}sub get_run_call_time {shift->{run_call_time}}sub get_run_exit_time {shift->{run_exit_time}}sub get_run_time {my$self=shift;$self->get_run_exit_time - $self->get_run_call_time}sub get_run_cumulative_time {shift->{run_cumulative_time}}sub get_sys_call_time {shift->{sys_call_time}}sub get_sys_exit_time {shift->{sys_exit_time}}sub get_sys_time {my$self=shift;$self->get_sys_exit_time - $self->get_sys_call_time}sub get_sys_cumulative_time {shift->{sys_cumulative_time}}sub get_run_cmd {shift->{run_cmd}}1; IPC_RUN3_PROFREPORTER $fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP'; package JSON::PP;use 5.005;use strict;use Exporter ();BEGIN {@JSON::PP::ISA=('Exporter')}use overload ();use JSON::PP::Boolean;use Carp ();$JSON::PP::VERSION='2.97001';@JSON::PP::EXPORT=qw(encode_json decode_json from_json to_json);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;use constant USE_B=>0;BEGIN {if (USE_B){require B}}BEGIN {my@xs_compati_bit_properties=qw(latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink allow_blessed convert_blessed relaxed allow_unknown);my@pp_bit_properties=qw(allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed);if (OLD_PERL){my$helper=$] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';eval qq| require $helper |;if ($@){Carp::croak $@}}for my$name (@xs_compati_bit_properties,@pp_bit_properties){my$property_id='P_' .uc($name);eval qq/ sub $name { my \$enable = defined \$_[1] ? \$_[1] : 1; if (\$enable) { \$_[0]->{PROPS}->[$property_id] = 1; } else { \$_[0]->{PROPS}->[$property_id] = 0; } \$_[0]; } sub get_$name { \$_[0]->{PROPS}->[$property_id] ? 1 : ''; } /}}my$JSON;sub encode_json ($) {($JSON ||= __PACKAGE__->new->utf8)->encode(@_)}sub decode_json {($JSON ||= __PACKAGE__->new->utf8)->decode(@_)}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.")}sub new {my$class=shift;my$self={max_depth=>512,max_size=>0,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)}sub pretty {my ($self,$v)=@_;my$enable=defined$v ? $v : 1;if ($enable){$self->indent(1)->space_before(1)->space_after(1)}else {$self->indent(0)->space_before(0)->space_after(0)}$self}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 {if (defined $_[1]and ref $_[1]eq 'CODE'){$_[0]->{cb_object}=$_[1]}else {delete $_[0]->{cb_object}}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub filter_json_single_key_object {if (@_==1 or @_ > 3){Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)")}if (defined $_[2]and ref $_[2]eq 'CODE'){$_[0]->{cb_sk_object}->{$_[1]}=$_[2]}else {delete $_[0]->{cb_sk_object}->{$_[1]};delete $_[0]->{cb_sk_object}unless %{$_[0]->{cb_sk_object}|| {}}}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub indent_length {if (!defined $_[1]or $_[1]> 15 or $_[1]< 0){Carp::carp "The acceptable range of indent_length() is 0 to 15."}else {$_[0]->{indent_length}=$_[1]}$_[0]}sub get_indent_length {$_[0]->{indent_length}}sub sort_by {$_[0]->{sort_by}=defined $_[1]? $_[1]: 1;$_[0]}sub allow_bigint {Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead.");$_[0]->allow_bignum}{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$props=$self->{PROPS};($ascii,$latin1,$utf8,$indent,$canonical,$space_before,$space_after,$allow_blessed,$convert_blessed,$escape_slash,$bignum,$as_nonblessed)=@{$props}[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!$props->[P_ALLOW_NONREF ]);my$str=$self->object_to_json($obj);$str .= "\n" if ($indent);unless ($ascii or $latin1 or $utf8){utf8::upgrade($str)}if ($props->[P_SHRINK ]){utf8::downgrade($str,1)}return$str}sub object_to_json {my ($self,$obj)=@_;my$type=ref($obj);if($type eq 'HASH'){return$self->hash_to_json($obj)}elsif($type eq 'ARRAY'){return$self->array_to_json($obj)}elsif ($type){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));if ($allow_blessed){return$self->blessed_to_json($obj)if ($as_nonblessed);return 'null'}encode_error(sprintf("encountered object '%s', but neither allow_blessed " ."nor convert_blessed settings are enabled",$obj))}else {return$self->value_to_json($obj)}}else{return$self->value_to_json($obj)}}sub hash_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');my$del=($space_before ? ' ' : '').':' .($space_after ? ' ' : '');for my$k (_sort($obj)){if (OLD_PERL){utf8::decode($k)}push@res,$self->string_to_json($k).$del .(ref$obj->{$k}? $self->object_to_json($obj->{$k}): $self->value_to_json($obj->{$k}))}--$depth;$self->_down_indent()if ($indent);return '{}' unless@res;return '{' .$pre .join(",$pre",@res).$post .'}'}sub array_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');for my$v (@$obj){push@res,ref($v)? $self->object_to_json($v): $self->value_to_json($v)}--$depth;$self->_down_indent()if ($indent);return '[]' unless@res;return '[' .$pre .join(",$pre",@res).$post .']'}sub _looks_like_number {my$value=shift;if (USE_B){my$b_obj=B::svref_2object(\$value);my$flags=$b_obj->FLAGS;return 1 if$flags & (B::SVp_IOK()| B::SVp_NOK())and!($flags & B::SVp_POK());return}else {no warnings 'numeric';return if utf8::is_utf8($value);return unless length((my$dummy="")& $value);return unless 0 + $value eq $value;return 1 if$value * 0==0;return -1}}sub value_to_json {my ($self,$value)=@_;return 'null' if(!defined$value);my$type=ref($value);if (!$type){if (_looks_like_number($value)){return$value}return$self->string_to_json($value)}elsif(blessed($value)and $value->isa('JSON::PP::Boolean')){return $$value==1 ? 'true' : 'false'}else {if ((overload::StrVal($value)=~ /=(\w+)/)[0]){return$self->value_to_json("$value")}if ($type eq 'SCALAR' and defined $$value){return $$value eq '1' ? 'true' : $$value eq '0' ? 'false' : $self->{PROPS}->[P_ALLOW_UNKNOWN ]? 'null' : encode_error("cannot encode reference to scalar")}if ($self->{PROPS}->[P_ALLOW_UNKNOWN ]){return 'null'}else {if ($type eq 'SCALAR' or $type eq 'REF'){encode_error("cannot encode reference to scalar")}else {encode_error("encountered $value, but JSON can only represent references to arrays or hashes")}}}}my%esc=("\n"=>'\n',"\r"=>'\r',"\t"=>'\t',"\f"=>'\f',"\b"=>'\b',"\""=>'\"',"\\"=>'\\\\',"\'"=>'\\\'',);sub string_to_json {my ($self,$arg)=@_;$arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;$arg =~ s/\//\\\//g if ($escape_slash);$arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;if ($ascii){$arg=JSON_PP_encode_ascii($arg)}if ($latin1){$arg=JSON_PP_encode_latin1($arg)}if ($utf8){utf8::encode($arg)}return '"' .$arg .'"'}sub blessed_to_json {my$reftype=reftype($_[1])|| '';if ($reftype eq 'HASH'){return $_[0]->hash_to_json($_[1])}elsif ($reftype eq 'ARRAY'){return $_[0]->array_to_json($_[1])}else {return 'null'}}sub encode_error {my$error=shift;Carp::croak "$error"}sub _sort {defined$keysort ? (sort$keysort (keys %{$_[0]})): keys %{$_[0]}}sub _up_indent {my$self=shift;my$space=' ' x $indent_length;my ($pre,$post)=('','');$post="\n" .$space x $indent_count;$indent_count++;$pre="\n" .$space x $indent_count;return ($pre,$post)}sub _down_indent {$indent_count--}sub PP_encode_box {{depth=>$depth,indent_count=>$indent_count,}}}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 {my$uni=$_[0]- 0x10000;return ($uni / 0x400 + 0xD800,$uni % 0x400 + 0xDC00)}sub _is_bignum {$_[0]->isa('Math::BigInt')or $_[0]->isa('Math::BigFloat')}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}}}{my%escapes=(b=>"\x8",t=>"\x9",n=>"\xA",f=>"\xC",r=>"\xD",'\\'=>'\\','"'=>'"','/'=>'/',);my$text;my$at;my$ch;my$len;my$depth;my$encoding;my$is_valid_utf8;my$utf8_len;my$utf8;my$max_depth;my$max_size;my$relaxed;my$cb_object;my$cb_sk_object;my$F_HOOK;my$allow_bignum;my$singlequote;my$loose;my$allow_barekey;sub _detect_utf_encoding {my$text=shift;my@octets=unpack('C4',$text);return 'unknown' unless defined$octets[3];return ($octets[0]and $octets[1])? 'UTF-8' : (!$octets[0]and $octets[1])? 'UTF-16BE' : (!$octets[0]and!$octets[1])? 'UTF-32BE' : ($octets[2])? 'UTF-16LE' : (!$octets[2])? 'UTF-32LE' : 'unknown'}sub PP_decode_json {my ($self,$want_offset);($self,$text,$want_offset)=@_;($at,$ch,$depth)=(0,'',0);if (!defined$text or ref$text){decode_error("malformed JSON string, neither array, object, number, string or atom")}my$props=$self->{PROPS};($utf8,$relaxed,$loose,$allow_bignum,$allow_barekey,$singlequote)=@{$props}[P_UTF8,P_RELAXED,P_LOOSE .. P_ALLOW_SINGLEQUOTE];if ($utf8){$encoding=_detect_utf_encoding($text);if ($encoding ne 'UTF-8' and $encoding ne 'unknown'){require Encode;Encode::from_to($text,$encoding,'utf-8')}else {utf8::downgrade($text,1)or Carp::croak("Wide character in subroutine entry")}}else {utf8::upgrade($text);utf8::encode($text)}$len=length$text;($max_depth,$max_size,$cb_object,$cb_sk_object,$F_HOOK)=@{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/};if ($max_size > 1){use bytes;my$bytes=length$text;decode_error(sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s" ,$bytes,$max_size),1)if ($bytes > $max_size)}white();decode_error("malformed JSON string, neither array, object, number, string or atom")unless defined$ch;my$result=value();if (!$props->[P_ALLOW_NONREF ]and!ref$result){decode_error('JSON text must be an object or array (but found number, string, true, false or null,' .' use allow_nonref to allow this)',1)}Carp::croak('something wrong.')if$len < $at;my$consumed=defined$ch ? $at - 1 : $at;white();return ($result,$consumed)if$want_offset;decode_error("garbage after JSON object")if defined$ch;$result}sub next_chr {return$ch=undef if($at >= $len);$ch=substr($text,$at++,1)}sub value {white();return if(!defined$ch);return object()if($ch eq '{');return array()if($ch eq '[');return string()if($ch eq '"' or ($singlequote and $ch eq "'"));return number()if($ch =~ /[0-9]/ or $ch eq '-');return word()}sub string {my$utf16;my$is_utf8;($is_valid_utf8,$utf8_len)=('',0);my$s='';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'){my$u='';for(1..4){$ch=next_chr();last OUTER if($ch !~ /[0-9a-fA-F]/);$u .= $ch}if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/){$utf16=$u}elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/){unless (defined$utf16){decode_error("missing high surrogate character in surrogate pair")}$is_utf8=1;$s .= JSON_PP_decode_surrogates($utf16,$u)|| next;$utf16=undef}else {if (defined$utf16){decode_error("surrogate pair expected")}if ((my$hex=hex($u))> 127){$is_utf8=1;$s .= JSON_PP_decode_unicode($u)|| next}else {$s .= chr$hex}}}else{unless ($loose){$at -= 2;decode_error('illegal backslash escape sequence in string')}$s .= $ch}}else{if (ord$ch > 127){unless($ch=is_valid_utf8($ch)){$at -= 1;decode_error("malformed UTF-8 character in JSON string")}else {$at += $utf8_len - 1}$is_utf8=1}if (!$loose){if ($ch =~ /[\x00-\x1f\x22\x5c]/){$at--;decode_error('invalid character encountered while parsing JSON string')}}$s .= $ch}}}decode_error("unexpected end of string while parsing JSON string")}sub white {while(defined$ch){if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){next_chr()}elsif($relaxed and $ch eq '/'){next_chr();if(defined$ch and $ch eq '/'){1 while(defined(next_chr())and $ch ne "\n" and $ch ne "\r")}elsif(defined$ch and $ch eq '*'){next_chr();while(1){if(defined$ch){if($ch eq '*'){if(defined(next_chr())and $ch eq '/'){next_chr();last}}else{next_chr()}}else{decode_error("Unterminated comment")}}next}else{$at--;decode_error("malformed JSON string, neither array, object, number, string or atom")}}else{if ($relaxed and $ch eq '#'){pos($text)=$at;$text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;$at=pos($text);next_chr;next}last}}}sub array {my$a=$_[0]|| [];decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')if (++$depth > $max_depth);next_chr();white();if(defined$ch and $ch eq ']'){--$depth;next_chr();return$a}else {while(defined($ch)){push @$a,value();white();if (!defined$ch){last}if($ch eq ']'){--$depth;next_chr();return$a}if($ch ne ','){last}next_chr();white();if ($relaxed and $ch eq ']'){--$depth;next_chr();return$a}}}$at-- if defined$ch and $ch ne '';decode_error(", or ] expected while parsing array")}sub object {my$o=$_[0]|| {};my$k;decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')if (++$depth > $max_depth);next_chr();white();if(defined$ch and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}else {while (defined$ch){$k=($allow_barekey and $ch ne '"' and $ch ne "'")? bareKey(): string();white();if(!defined$ch or $ch ne ':'){$at--;decode_error("':' expected")}next_chr();$o->{$k}=value();white();last if (!defined$ch);if($ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}if($ch ne ','){last}next_chr();white();if ($relaxed and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}}}$at-- if defined$ch and $ch ne '';decode_error(", or } expected while parsing object/hash")}sub bareKey {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--;decode_error("'null' expected")if ($word =~ /^n/);decode_error("'true' expected")if ($word =~ /^t/);decode_error("'false' expected")if ($word =~ /^f/);decode_error("malformed JSON string, neither array, object, number, string or atom")}sub number {my$n='';my$v;my$is_dec;my$is_exp;if($ch eq '-'){$n='-';next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after initial minus)")}}if($ch eq '0'){my$peek=substr($text,$at,1);if($peek =~ /^[0-9a-dfA-DF]/){decode_error("malformed number (leading zero must not be followed by another digit)")}$n .= $ch;next_chr}while(defined$ch and $ch =~ /\d/){$n .= $ch;next_chr}if(defined$ch and $ch eq '.'){$n .= '.';$is_dec=1;next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after decimal point)")}else {$n .= $ch}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}if(defined$ch and ($ch eq 'e' or $ch eq 'E')){$n .= $ch;$is_exp=1;next_chr;if(defined($ch)and ($ch eq '+' or $ch eq '-')){$n .= $ch;next_chr;if (!defined$ch or $ch =~ /\D/){decode_error("malformed number (no digits after exp sign)")}$n .= $ch}elsif(defined($ch)and $ch =~ /\d/){$n .= $ch}else {decode_error("malformed number (no digits after exp sign)")}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}$v .= $n;if ($is_dec or $is_exp){if ($allow_bignum){require Math::BigFloat;return Math::BigFloat->new($v)}}else {if (length$v > $max_intsize){if ($allow_bignum){require Math::BigInt;return Math::BigInt->new($v)}else {return "$v"}}}return$is_dec ? $v/1.0 : 0+$v}sub is_valid_utf8 {$utf8_len=$_[0]=~ /[\x00-\x7F]/ ? 1 : $_[0]=~ /[\xC2-\xDF]/ ? 2 : $_[0]=~ /[\xE0-\xEF]/ ? 3 : $_[0]=~ /[\xF0-\xF4]/ ? 4 : 0 ;return unless$utf8_len;my$is_valid_utf8=substr($text,$at - 1,$utf8_len);return ($is_valid_utf8 =~ /^(?: [\x00-\x7F] |[\xC2-\xDF][\x80-\xBF] |[\xE0][\xA0-\xBF][\x80-\xBF] |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] |[\xED][\x80-\x9F][\x80-\xBF] |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] )$/x)? $is_valid_utf8 : ''}sub decode_error {my$error=shift;my$no_rep=shift;my$str=defined$text ? substr($text,$at): '';my$mess='';my$type='U*';if (OLD_PERL){my$type=$] < 5.006 ? 'C*' : utf8::is_utf8($str)? 'U*' : 'C*' }for my$c (unpack($type,$str)){$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,}}}sub _decode_surrogates {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}BEGIN {unless (defined&utf8::is_utf8){require Encode;*utf8::is_utf8=*Encode::is_utf8}if (!OLD_PERL){*JSON::PP::JSON_PP_encode_ascii=\&_encode_ascii;*JSON::PP::JSON_PP_encode_latin1=\&_encode_latin1;*JSON::PP::JSON_PP_decode_surrogates=\&_decode_surrogates;*JSON::PP::JSON_PP_decode_unicode=\&_decode_unicode;if ($] < 5.008003){package JSON::PP;require subs;subs->import('join');eval q| sub join { return '' if (@_ < 2); my $j = shift; my $str = shift; for (@_) { $str .= $j . $_; } return $str; } |}}sub JSON::PP::incr_parse {local$Carp::CarpLevel=1;($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_parse(@_)}sub JSON::PP::incr_skip {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_skip}sub JSON::PP::incr_reset {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_reset}eval q{ sub JSON::PP::incr_text : lvalue { $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new; if ( $_[0]->{_incr_parser}->{incr_pos} ) { Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); } $_[0]->{_incr_parser}->{incr_text}; } } if ($] >= 5.006)}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{eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';*JSON::PP::blessed=sub {local($@,$SIG{__DIE__},$SIG{__WARN__});ref($_[0])? eval {$_[0]->a_sub_not_likely_to_be_here}: undef};require B;my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP);*JSON::PP::reftype=sub {my$r=shift;return undef unless length(ref($r));my$t=ref(B::svref_2object($r));return exists$tmap{$t}? $tmap{$t}: length(ref($$r))? 'REF' : 'SCALAR'};*JSON::PP::refaddr=sub {return undef unless length(ref($_[0]));my$addr;if(defined(my$pkg=blessed($_[0]))){$addr .= bless $_[0],'Scalar::Util::Fake';bless $_[0],$pkg}else {$addr .= $_[0]}$addr =~ /0x(\w+)/;local $^W;hex($1)}}}$JSON::PP::true=do {bless \(my$dummy=1),"JSON::PP::Boolean"};$JSON::PP::false=do {bless \(my$dummy=0),"JSON::PP::Boolean"};sub is_bool {blessed $_[0]and $_[0]->isa("JSON::PP::Boolean")}sub true {$JSON::PP::true}sub false {$JSON::PP::false}sub null {undef}package JSON::PP::IncrParser;use strict;use constant INCR_M_WS=>0;use constant INCR_M_STR=>1;use constant INCR_M_BS=>2;use constant INCR_M_JSON=>3;use constant INCR_M_C0=>4;use constant INCR_M_C1=>5;$JSON::PP::IncrParser::VERSION='1.01';sub new {my ($class)=@_;bless {incr_nest=>0,incr_text=>undef,incr_pos=>0,incr_mode=>0,},$class}sub incr_parse {my ($self,$coder,$text)=@_;$self->{incr_text}='' unless (defined$self->{incr_text});if (defined$text){if (utf8::is_utf8($text)and!utf8::is_utf8($self->{incr_text})){utf8::upgrade($self->{incr_text});utf8::decode($self->{incr_text})}$self->{incr_text}.= $text}if (defined wantarray){my$max_size=$coder->get_max_size;my$p=$self->{incr_pos};my@ret;{do {unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){$self->_incr_parse($coder);if ($max_size and $self->{incr_pos}> $max_size){Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size")}unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){if ($self->{incr_mode}==INCR_M_WS and $self->{incr_pos}){$self->{incr_pos}=0;$self->{incr_text}=''}last}}my ($obj,$offset)=$coder->PP_decode_json($self->{incr_text},0x00000001);push@ret,$obj;use bytes;$self->{incr_text}=substr($self->{incr_text},$offset || 0);$self->{incr_pos}=0;$self->{incr_nest}=0;$self->{incr_mode}=0;last unless wantarray}while (wantarray)}if (wantarray){return@ret}else {return$ret[0]? $ret[0]: undef}}}sub _incr_parse {my ($self,$coder)=@_;my$text=$self->{incr_text};my$len=length$text;my$p=$self->{incr_pos};INCR_PARSE: while ($len > $p){my$s=substr($text,$p,1);last INCR_PARSE unless defined$s;my$mode=$self->{incr_mode};if ($mode==INCR_M_WS){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if (ord($s)> 0x20){if ($s eq '#'){$self->{incr_mode}=INCR_M_C0;redo INCR_PARSE}else {$self->{incr_mode}=INCR_M_JSON;redo INCR_PARSE}}$p++}}elsif ($mode==INCR_M_BS){$p++;$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($mode==INCR_M_C0 or $mode==INCR_M_C1){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq "\n"){$self->{incr_mode}=$self->{incr_mode}==INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;last}$p++}next}elsif ($mode==INCR_M_STR){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq '"'){$p++;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($s eq '\\'){$p++;if (!defined substr($text,$p,1)){$self->{incr_mode}=INCR_M_BS;last INCR_PARSE}}$p++}}elsif ($mode==INCR_M_JSON){while ($len > $p){$s=substr($text,$p++,1);if ($s eq "\x00"){$p--;last INCR_PARSE}elsif ($s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20"){if (!$self->{incr_nest}){$p--;last INCR_PARSE}next}elsif ($s eq '"'){$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($s eq '[' or $s eq '{'){if (++$self->{incr_nest}> $coder->get_max_depth){Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')}next}elsif ($s eq ']' or $s eq '}'){if (--$self->{incr_nest}<= 0){last INCR_PARSE}}elsif ($s eq '#'){$self->{incr_mode}=INCR_M_C1;redo INCR_PARSE}}}}$self->{incr_pos}=$p;$self->{incr_parsing}=$p ? 1 : 0}sub incr_text {if ($_[0]->{incr_pos}){Carp::croak("incr_text cannot be called when the incremental parser already started parsing")}$_[0]->{incr_text}}sub incr_skip {my$self=shift;$self->{incr_text}=substr($self->{incr_text},$self->{incr_pos});$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}sub incr_reset {my$self=shift;$self->{incr_text}=undef;$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}1; JSON_PP $fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN'; package JSON::PP::Boolean;use strict;use overload ("0+"=>sub {${$_[0]}},"++"=>sub {$_[0]=${$_[0]}+ 1},"--"=>sub {$_[0]=${$_[0]}- 1},fallback=>1,);$JSON::PP::Boolean::VERSION='2.97001';1; JSON_PP_BOOLEAN $fatpacked{"Locale/Maketext/Simple.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCALE_MAKETEXT_SIMPLE'; package Locale::Maketext::Simple;$Locale::Maketext::Simple::VERSION='0.21';use strict;use 5.005;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;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) ? ($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;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;$path="auto/$calldir/";for my$inc (@INC){return "$inc/$path" if -d "$inc/$path"}return}1; LOCALE_MAKETEXT_SIMPLE $fatpacked{"MRO/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MRO_COMPAT'; package MRO::Compat;use strict;use warnings;require 5.006_000;our$VERSION='0.13';BEGIN {if($] < 5.009_005){$mro::VERSION =$VERSION;$INC{'mro.pm'}=__FILE__;*mro::import=\&__import;*mro::get_linear_isa=\&__get_linear_isa;*mro::set_mro=\&__set_mro;*mro::get_mro=\&__get_mro;*mro::get_isarev=\&__get_isarev;*mro::is_universal=\&__is_universal;*mro::method_changed_in=\&__method_changed_in;*mro::invalidate_all_method_caches =\&__invalidate_all_method_caches;require Class::C3;if($Class::C3::XS::VERSION && $Class::C3::XS::VERSION > 0.03){*mro::get_pkg_gen=\&__get_pkg_gen_c3xs}else {*mro::get_pkg_gen=\&__get_pkg_gen_pp}}else {require mro;no warnings 'redefine';*Class::C3::initialize=sub {1};*Class::C3::reinitialize=sub {1};*Class::C3::uninitialize=sub {1}}}sub __get_linear_isa_dfs {no strict 'refs';my$classname=shift;my@lin=($classname);my%stored;for my$parent (@{"$classname\::ISA"}){my$plin=__get_linear_isa_dfs($parent);for (@$plin){next if exists$stored{$_};push(@lin,$_);$stored{$_}=1}}return \@lin}sub __get_linear_isa {my ($classname,$type)=@_;die "mro::get_mro requires a classname" if!defined$classname;$type ||= __get_mro($classname);if($type eq 'dfs'){return __get_linear_isa_dfs($classname)}elsif($type eq 'c3'){return [Class::C3::calculateMRO($classname)]}die "type argument must be 'dfs' or 'c3'"}sub __import {if($_[1]){goto&Class::C3::import if $_[1]eq 'c3';__set_mro(scalar(caller),$_[1])}}sub __set_mro {my ($classname,$type)=@_;if(!defined$classname ||!$type){die q{Usage: mro::set_mro($classname, $type)}}if($type eq 'c3'){eval "package $classname; use Class::C3";die $@ if $@}elsif($type eq 'dfs'){if(defined$Class::C3::MRO{$classname}){Class::C3::_remove_method_dispatch_table($classname)}delete$Class::C3::MRO{$classname}}else {die qq{Invalid mro type "$type"}}return}sub __get_mro {my$classname=shift;die "mro::get_mro requires a classname" if!defined$classname;return 'c3' if exists$Class::C3::MRO{$classname};return 'dfs'}sub __get_all_pkgs_with_isas {no strict 'refs';no warnings 'recursion';my@retval;my$search=shift;my$pfx;my$isa;if(defined$search){$isa=\@{"$search\::ISA"};$pfx="$search\::"}else {$search='main';$isa=\@main::ISA;$pfx=''}push(@retval,$search)if scalar(@$isa);for my$cand (keys %{"$search\::"}){if($cand =~ s/::$//){next if$cand eq $search;push(@retval,@{__get_all_pkgs_with_isas($pfx .$cand)})}}return \@retval}sub __get_isarev_recurse {no strict 'refs';my ($class,$all_isas,$level)=@_;die "Recursive inheritance detected" if$level > 100;my%retval;for my$cand (@$all_isas){my$found_me;for (@{"$cand\::ISA"}){if($_ eq $class){$found_me=1;last}}if($found_me){$retval{$cand}=1;map {$retval{$_}=1}@{__get_isarev_recurse($cand,$all_isas,$level+1)}}}return [keys%retval]}sub __get_isarev {my$classname=shift;die "mro::get_isarev requires a classname" if!defined$classname;__get_isarev_recurse($classname,__get_all_pkgs_with_isas(),0)}sub __is_universal {my$classname=shift;die "mro::is_universal requires a classname" if!defined$classname;my$lin=__get_linear_isa('UNIVERSAL');for (@$lin){return 1 if$classname eq $_}return 0}sub __invalidate_all_method_caches {@f845a9c1ac41be33::ISA=@f845a9c1ac41be33::ISA;return}sub __method_changed_in {my$classname=shift;die "mro::method_changed_in requires a classname" if!defined$classname;__invalidate_all_method_caches()}{my$__pkg_gen=2;sub __get_pkg_gen_pp {my$classname=shift;die "mro::get_pkg_gen requires a classname" if!defined$classname;return$__pkg_gen++}}sub __get_pkg_gen_c3xs {my$classname=shift;die "mro::get_pkg_gen requires a classname" if!defined$classname;return Class::C3::XS::_plsubgen()}1; MRO_COMPAT $fatpacked{"Menlo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO'; package Menlo;our$VERSION="1.9019";1; MENLO $fatpacked{"Menlo/Builder/Static.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_BUILDER_STATIC'; package Menlo::Builder::Static;use strict;use warnings;use CPAN::Meta;use ExtUtils::Config 0.003;use ExtUtils::Helpers 0.020 qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;use ExtUtils::Install qw/pm_to_blib install/;use ExtUtils::InstallPaths 0.002;use File::Basename qw/dirname/;use File::Find ();use File::Path qw/mkpath/;use File::Spec::Functions qw/catfile catdir rel2abs abs2rel splitdir curdir/;use Getopt::Long 2.36 qw/GetOptionsFromArray/;sub new {my($class,%args)=@_;bless {meta=>$args{meta},},$class}sub meta {my$self=shift;$self->{meta}}sub manify {my ($input_file,$output_file,$section,$opts)=@_;return if -e $output_file && -M $input_file <= -M $output_file;my$dirname=dirname($output_file);mkpath($dirname,$opts->{verbose})if not -d $dirname;require Pod::Man;Pod::Man->new(section=>$section)->parse_from_file($input_file,$output_file);print "Manifying $output_file\n" if$opts->{verbose}&& $opts->{verbose}> 0;return}sub find {my ($pattern,$dir)=@_;my@ret;File::Find::find(sub {push@ret,$File::Find::name if /$pattern/ && -f},$dir)if -d $dir;return@ret}my%actions=(build=>sub {my%opt=@_;my%modules=map {$_=>catfile('blib',$_)}find(qr/\.p(?:m|od)$/,'lib');my%scripts=map {$_=>catfile('blib',$_)}find(qr//,'script');my%shared=map {$_=>catfile(qw/blib lib auto share dist/,$opt{meta}->name,abs2rel($_,'share'))}find(qr//,'share');pm_to_blib({%modules,%scripts,%shared},catdir(qw/blib lib auto/));make_executable($_)for values%scripts;mkpath(catdir(qw/blib arch/),$opt{verbose});if ($opt{install_paths}->install_destination('bindoc')&& $opt{install_paths}->is_default_installable('bindoc')){manify($_,catfile('blib','bindoc',man1_pagename($_)),$opt{config}->get('man1ext'),\%opt)for keys%scripts}if ($opt{install_paths}->install_destination('libdoc')&& $opt{install_paths}->is_default_installable('libdoc')){manify($_,catfile('blib','libdoc',man3_pagename($_)),$opt{config}->get('man3ext'),\%opt)for keys%modules}1},test=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';require TAP::Harness::Env;my%test_args=((verbosity=>$opt{verbose})x!!exists$opt{verbose},(jobs=>$opt{jobs})x!!exists$opt{jobs},(color=>1)x!!-t STDOUT,lib=>[map {rel2abs(catdir(qw/blib/,$_))}qw/arch lib/ ],);my$tester=TAP::Harness::Env->create(\%test_args);$tester->runtests(sort +find(qr/\.t$/,'t'))->has_errors and return;1},install=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';install($opt{install_paths}->install_map,@opt{qw/verbose dry_run uninst/});1},);sub build {my$self=shift;my$action=@_ && $_[0]=~ /\A\w+\z/ ? shift @_ : 'build';die "No such action '$action'\n" if not $actions{$action};my%opt;GetOptionsFromArray([@$_],\%opt,qw/install_base=s install_path=s% installdirs=s destdir=s prefix=s config=s% uninst:1 verbose:1 dry_run:1 pureperl-only:1 create_packlist=i jobs=i/)for ($self->{env},$self->{configure_args},\@_);$_=detildefy($_)for grep {defined}@opt{qw/install_base destdir prefix/},values %{$opt{install_path}};@opt{'config','meta' }=(ExtUtils::Config->new($opt{config}),$self->meta);$actions{$action}->(%opt,install_paths=>ExtUtils::InstallPaths->new(%opt,dist_name=>$opt{meta}->name))}sub configure {my$self=shift;$self->{env}=defined$ENV{PERL_MB_OPT}? [split_like_shell($ENV{PERL_MB_OPT})]: [];$self->{configure_args}=[@_];$self->meta->save(@$_)for ['MYMETA.json'],['MYMETA.yml'=>{version=>1.4 }]}1; MENLO_BUILDER_STATIC $fatpacked{"Menlo/CLI/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_CLI_COMPAT'; package Menlo::CLI::Compat;use strict;use Config;use Cwd ();use Menlo;use Menlo::Dependency;use Menlo::Util qw(WIN32);use File::Basename ();use File::Find ();use File::Path ();use File::Spec ();use File::Copy ();use File::Temp ();use File::Which qw(which);use Getopt::Long ();use Symbol ();use version ();use constant BAD_TAR=>($^O eq 'solaris' || $^O eq 'hpux');use constant CAN_SYMLINK=>eval {symlink("","");1};our$VERSION='1.9020';if ($INC{"App/FatPacker/Trace.pm"}){require version::vpp}sub qs($) {Menlo::Util::shell_quote($_[0])}sub determine_home {my$class=shift;my$homedir=$ENV{HOME}|| eval {require File::HomeDir;File::HomeDir->my_home}|| join('',@ENV{qw(HOMEDRIVE HOMEPATH)});if (WIN32){require Win32;$homedir=Win32::GetShortPathName($homedir)}return "$homedir/.cpanm"}sub new {my$class=shift;my$self=bless {name=>"Menlo",home=>$class->determine_home,cmd=>'install',seen=>{},notest=>undef,test_only=>undef,installdeps=>undef,force=>undef,sudo=>undef,make=>undef,verbose=>undef,quiet=>undef,interactive=>undef,log=>undef,mirrors=>[],mirror_only=>undef,mirror_index=>undef,cpanmetadb=>"http://cpanmetadb.plackperl.org/v1.0/",perl=>$^X,argv=>[],local_lib=>undef,self_contained=>undef,exclude_vendor=>undef,prompt_timeout=>0,prompt=>undef,configure_timeout=>60,build_timeout=>3600,test_timeout=>1800,try_lwp=>1,try_wget=>1,try_curl=>1,uninstall_shadows=>($] < 5.012),skip_installed=>1,skip_satisfied=>0,static_install=>1,auto_cleanup=>7,pod2man=>1,installed_dists=>0,install_types=>['requires'],with_develop=>0,with_configure=>0,showdeps=>0,scandeps=>0,scandeps_tree=>[],format=>'tree',save_dists=>undef,skip_configure=>0,verify=>0,report_perl_version=>!$class->maybe_ci,build_args=>{},features=>{},pure_perl=>0,cpanfile_path=>'cpanfile',@_,},$class;$self}sub env {my($self,$key)=@_;$ENV{"PERL_CPANM_" .$key}}sub maybe_ci {my$class=shift;grep$ENV{$_},qw(TRAVIS CI AUTOMATED_TESTING AUTHOR_TESTING)}sub install_type_handlers {my$self=shift;my@handlers;for my$type (qw(recommends suggests)){push@handlers,"with-$type"=>sub {my%uniq;$self->{install_types}=[grep!$uniq{$_}++,@{$self->{install_types}},$type ]};push@handlers,"without-$type"=>sub {$self->{install_types}=[grep $_ ne $type,@{$self->{install_types}}]}}@handlers}sub build_args_handlers {my$self=shift;my@handlers;for my$phase (qw(configure build test install)){push@handlers,"$phase-args=s"=>\($self->{build_args}{$phase})}@handlers}sub parse_options {my$self=shift;local@ARGV=@{$self->{argv}};push@ARGV,grep length,split /\s+/,$self->env('OPT');push@ARGV,@_;Getopt::Long::Configure("bundling");Getopt::Long::GetOptions('f|force'=>sub {$self->{skip_installed}=0;$self->{force}=1},'n|notest!'=>\$self->{notest},'test-only'=>sub {$self->{notest}=0;$self->{skip_installed}=0;$self->{test_only}=1},'S|sudo!'=>\$self->{sudo},'v|verbose'=>\$self->{verbose},'verify!'=>\$self->{verify},'q|quiet!'=>\$self->{quiet},'h|help'=>sub {$self->{action}='show_help'},'V|version'=>sub {$self->{action}='show_version'},'perl=s'=>sub {$self->diag("--perl is deprecated since it's known to be fragile in figuring out dependencies. Run `$_[1] -S cpanm` instead.\n",1);$self->{perl}=$_[1]},'l|local-lib=s'=>sub {$self->{local_lib}=$self->maybe_abs($_[1])},'L|local-lib-contained=s'=>sub {$self->{local_lib}=$self->maybe_abs($_[1]);$self->{self_contained}=1;$self->{pod2man}=undef},'self-contained!'=>\$self->{self_contained},'exclude-vendor!'=>\$self->{exclude_vendor},'mirror=s@'=>$self->{mirrors},'mirror-only!'=>\$self->{mirror_only},'mirror-index=s'=>sub {$self->{mirror_index}=$self->maybe_abs($_[1])},'M|from=s'=>sub {$self->{mirrors}=[$_[1]];$self->{mirror_only}=1},'cpanmetadb=s'=>\$self->{cpanmetadb},'cascade-search!'=>\$self->{cascade_search},'prompt!'=>\$self->{prompt},'installdeps'=>\$self->{installdeps},'skip-installed!'=>\$self->{skip_installed},'skip-satisfied!'=>\$self->{skip_satisfied},'reinstall'=>sub {$self->{skip_installed}=0},'interactive!'=>\$self->{interactive},'i|install'=>sub {$self->{cmd}='install'},'info'=>sub {$self->{cmd}='info'},'look'=>sub {$self->{cmd}='look';$self->{skip_installed}=0},'U|uninstall'=>sub {$self->{cmd}='uninstall'},'self-upgrade'=>sub {$self->{action}='self_upgrade'},'uninst-shadows!'=>\$self->{uninstall_shadows},'lwp!'=>\$self->{try_lwp},'wget!'=>\$self->{try_wget},'curl!'=>\$self->{try_curl},'auto-cleanup=s'=>\$self->{auto_cleanup},'man-pages!'=>\$self->{pod2man},'scandeps'=>\$self->{scandeps},'showdeps'=>sub {$self->{showdeps}=1;$self->{skip_installed}=0},'format=s'=>\$self->{format},'save-dists=s'=>sub {$self->{save_dists}=$self->maybe_abs($_[1])},'skip-configure!'=>\$self->{skip_configure},'static-install!'=>\$self->{static_install},'dev!'=>\$self->{dev_release},'metacpan!'=>\$self->{metacpan},'report-perl-version!'=>\$self->{report_perl_version},'configure-timeout=i'=>\$self->{configure_timeout},'build-timeout=i'=>\$self->{build_timeout},'test-timeout=i'=>\$self->{test_timeout},'with-develop'=>\$self->{with_develop},'without-develop'=>sub {$self->{with_develop}=0},'with-configure'=>\$self->{with_configure},'without-configure'=>sub {$self->{with_configure}=0},'with-feature=s'=>sub {$self->{features}{$_[1]}=1},'without-feature=s'=>sub {$self->{features}{$_[1]}=0},'with-all-features'=>sub {$self->{features}{__all}=1},'pp|pureperl!'=>\$self->{pure_perl},"cpanfile=s"=>\$self->{cpanfile_path},$self->install_type_handlers,$self->build_args_handlers,);if (!@ARGV && $0 ne '-' &&!-t STDIN){push@ARGV,$self->load_argv_from_fh(\*STDIN);$self->{load_from_stdin}=1}$self->{argv}=\@ARGV}sub check_upgrade {my$self=shift;my$install_base=$ENV{PERL_LOCAL_LIB_ROOT}? $self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}): $Config{installsitebin};if ($0 eq '-'){return}elsif ($0 !~ /^$install_base/){if ($0 =~ m!perlbrew/bin!){die <{_checked}++;$self->bootstrap_local_lib}sub setup_verify {my$self=shift;my$has_modules=eval {require Module::Signature;require Digest::SHA;1};$self->{cpansign}=which('cpansign');unless ($has_modules && $self->{cpansign}){warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";$self->{verify}=0}}sub parse_module_args {my($self,$module)=@_;$module =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;if ($module =~ /\~[v\d\._,\!<>= ]+$/){return split '~',$module,2}else {return$module,undef}}sub run {my$self=shift;my$code;eval {$code=($self->_doit==0)};if (my$e=$@){warn$e;$code=1}$self->{status}=$code}sub status {$_[0]->{status}}sub _doit {my$self=shift;$self->setup_home;$self->init_tools;$self->setup_verify if$self->{verify};if (my$action=$self->{action}){$self->$action()and return 1}return$self->show_help(1)unless @{$self->{argv}}or $self->{load_from_stdin};$self->configure_mirrors;my$cwd=Cwd::cwd;my@fail;for my$module (@{$self->{argv}}){if ($module =~ s/\.pm$//i){my ($volume,$dirs,$file)=File::Spec->splitpath($module);$module=join '::',grep {$_}File::Spec->splitdir($dirs),$file}($module,my$version)=$self->parse_module_args($module);$self->chdir($cwd);if ($self->{cmd}eq 'uninstall'){$self->uninstall_module($module)or push@fail,$module}else {$self->install_module($module,0,$version)or push@fail,$module}}if ($self->{base}&& $self->{auto_cleanup}){$self->cleanup_workdirs}if ($self->{installed_dists}){my$dists=$self->{installed_dists}> 1 ? "distributions" : "distribution";$self->diag("$self->{installed_dists} $dists installed\n",1)}if ($self->{scandeps}){$self->dump_scandeps()}$self->chdir($cwd);return!@fail}sub setup_home {my$self=shift;$self->{home}=$self->env('HOME')if$self->env('HOME');unless (_writable($self->{home})){die "Can't write to cpanm home '$self->{home}': You should fix it with chown/chmod first.\n"}$self->{base}="$self->{home}/work/" .time .".$$";File::Path::mkpath([$self->{base}],0,0777);$self->{log}=File::Spec->catfile($self->{base},"build.log");my$final_log="$self->{home}/build.log";{open my$out,">$self->{log}" or die "$self->{log}: $!"}if (CAN_SYMLINK){my$build_link="$self->{home}/latest-build";unlink$build_link;symlink$self->{base},$build_link;unlink$final_log;symlink$self->{log},$final_log}else {my$log=$self->{log};my$home=$self->{home};$self->{at_exit}=sub {my$self=shift;my$temp_log="$home/build.log." .time .".$$";File::Copy::copy($log,$temp_log)&& unlink($final_log);rename($temp_log,$final_log)}}$self->chat("cpanm ($self->{name}) $Menlo::VERSION on perl $] built for $Config{archname}\n" ."Work directory is $self->{base}\n")}sub search_mirror_index_local {my ($self,$local,$module,$version)=@_;require CPAN::Common::Index::LocalPackage;my$index=CPAN::Common::Index::LocalPackage->new({source=>$local });$self->search_common($index,{package=>$module },$version)}sub search_mirror_index {my ($self,$mirror,$module,$version)=@_;require Menlo::Index::Mirror;my$index=Menlo::Index::Mirror->new({mirror=>$mirror,cache=>$self->source_for($mirror),fetcher=>sub {$self->mirror(@_)},});$self->search_common($index,{package=>$module },$version)}sub search_common {my($self,$index,$search_args,$want_version)=@_;$index->refresh_index;my$found=$index->search_packages($search_args);$found=$self->cpan_module_common($found)if$found;return$found unless$self->{cascade_search};if ($found){if ($self->satisfy_version($found->{module},$found->{module_version},$want_version)){return$found}else {$self->chat("Found $found->{module} $found->{module_version} which doesn't satisfy $want_version.\n")}}return}sub with_version_range {my($self,$version)=@_;defined($version)&& $version =~ /(?:<|!=|==)/}sub numify_ver {my($self,$ver)=@_;eval version->new($ver)->numify}sub search_metacpan {my($self,$module,$version,$dev_release)=@_;require Menlo::Index::MetaCPAN;$self->chat("Searching $module ($version) on metacpan ...\n");my$index=Menlo::Index::MetaCPAN->new({include_dev=>$self->{dev_release}});my$pkg=$self->search_common($index,{package=>$module,version_range=>$version },$version);return$pkg if$pkg;$self->diag_fail("Finding $module ($version) on metacpan failed.");return}sub search_database {my($self,$module,$version)=@_;my$found;if ($self->{dev_release}or $self->{metacpan}){$found=$self->search_metacpan($module,$version,$self->{dev_release})and return$found;$found=$self->search_cpanmetadb($module,$version,$self->{dev_release})and return$found}else {$found=$self->search_cpanmetadb($module,$version)and return$found;$found=$self->search_metacpan($module,$version)and return$found}}sub search_cpanmetadb {my($self,$module,$version,$dev_release)=@_;require Menlo::Index::MetaDB;$self->chat("Searching $module ($version) on cpanmetadb ...\n");my$args={package=>$module };if ($self->with_version_range($version)){$args->{version_range}=$version}my$index=Menlo::Index::MetaDB->new({uri=>$self->{cpanmetadb}});my$pkg=$self->search_common($index,$args,$version);return$pkg if$pkg;$self->diag_fail("Finding $module on cpanmetadb failed.");return}sub search_module {my($self,$module,$version)=@_;if ($self->{mirror_index}){$self->mask_output(chat=>"Searching $module on mirror index $self->{mirror_index} ...\n");my$pkg=$self->search_mirror_index_local($self->{mirror_index},$module,$version);return$pkg if$pkg;unless ($self->{cascade_search}){$self->mask_output(diag_fail=>"Finding $module ($version) on mirror index $self->{mirror_index} failed.");return}}unless ($self->{mirror_only}){my$found=$self->search_database($module,$version);return$found if$found}MIRROR: for my$mirror (@{$self->{mirrors}}){$self->mask_output(chat=>"Searching $module on mirror $mirror ...\n");my$pkg=$self->search_mirror_index($mirror,$module,$version);return$pkg if$pkg;$self->mask_output(diag_fail=>"Finding $module ($version) on mirror $mirror failed.")}return}sub source_for {my($self,$mirror)=@_;$mirror =~ s/[^\w\.\-]+/%/g;my$dir="$self->{home}/sources/$mirror";File::Path::mkpath([$dir ],0,0777);return$dir}sub load_argv_from_fh {my($self,$fh)=@_;my@argv;while(defined(my$line=<$fh>)){chomp$line;$line =~ s/#.+$//;$line =~ s/^\s+//;$line =~ s/\s+$//;push@argv,split ' ',$line if$line}return@argv}sub show_version {my$self=shift;print "cpanm ($self->{name}) version $VERSION ($0)\n";print "perl version $] ($^X)\n\n";print " \%Config:\n";for my$key (qw(archname installsitelib installsitebin installman1dir installman3dir sitearchexp sitelibexp vendorarch vendorlibexp archlibexp privlibexp)){print " $key=$Config{$key}\n" if$Config{$key}}print " \%ENV:\n";for my$key (grep /^PERL/,sort keys%ENV){print " $key=$ENV{$key}\n"}print " \@INC:\n";for my$inc (@INC){print " $inc\n" unless ref($inc)eq 'CODE'}return 1}sub show_help {my$self=shift;if ($_[0]){print <splitdir($dir);while (@dir){$dir=File::Spec->catdir(@dir);if (-e $dir){return -w _}pop@dir}return}sub maybe_abs {my($self,$lib)=@_;if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)){return$lib}else {return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(),$lib))}}sub local_lib_target {my($self,$root)=@_;(grep {$_ ne ''}split /\Q$Config{path_sep}/,$root)[0]}sub bootstrap_local_lib {my$self=shift;if ($self->{local_lib}){return$self->setup_local_lib($self->{local_lib})}if ($ENV{PERL_LOCAL_LIB_ROOT}&& $ENV{PERL_MM_OPT}){return$self->setup_local_lib($self->local_lib_target($ENV{PERL_LOCAL_LIB_ROOT}),1)}return if$self->{sudo}or (_writable($Config{installsitelib})and _writable($Config{installsitebin}));if ($ENV{PERL_MM_OPT}and ($ENV{MODULEBUILDRC}or $ENV{PERL_MB_OPT})){return}$self->setup_local_lib;$self->diag(<module=>$_}@$config_deps;my$reqs=CPAN::Meta::Requirements->from_string_hash({'Module::Build'=>'0.38','ExtUtils::MakeMaker'=>'6.58','ExtUtils::Install'=>'1.46',});if ($deps{"ExtUtils::MakeMaker"}){$deps{"ExtUtils::MakeMaker"}->merge_with($reqs)}elsif ($deps{"Module::Build"}){$deps{"Module::Build"}->merge_with($reqs);$deps{"ExtUtils::Install"}||= Menlo::Dependency->new("ExtUtils::Install",0,'configure');$deps{"ExtUtils::Install"}->merge_with($reqs)}@$config_deps=values%deps}sub _core_only_inc {my($self,$base)=@_;require local::lib;(local::lib->resolve_path(local::lib->install_base_arch_path($base)),local::lib->resolve_path(local::lib->install_base_perl_path($base)),(!$self->{exclude_vendor}? grep {$_}@Config{qw(vendorarch vendorlibexp)}: ()),@Config{qw(archlibexp privlibexp)},)}sub _setup_local_lib_env {my($self,$base)=@_;$self->diag(<setup_env_hash_for($base,0)}sub setup_local_lib {my($self,$base,$no_env)=@_;$base=undef if$base eq '_';require local::lib;{local $0='cpanm';$base ||= "~/perl5";$base=local::lib->resolve_path($base);if ($self->{self_contained}){my@inc=$self->_core_only_inc($base);$self->{search_inc}=[@inc ]}else {$self->{search_inc}=[local::lib->install_base_arch_path($base),local::lib->install_base_perl_path($base),@INC,]}$self->_setup_local_lib_env($base)unless$no_env;$self->{local_lib}=$base}}sub prompt_bool {my($self,$mess,$def)=@_;my$val=$self->prompt($mess,$def);return lc$val eq 'y'}sub prompt {my($self,$mess,$def)=@_;my$isa_tty=-t STDIN && (-t STDOUT ||!(-f STDOUT || -c STDOUT));my$dispdef=defined$def ? "[$def] " : " ";$def=defined$def ? $def : "";if (!$self->{prompt}|| (!$isa_tty && eof STDIN)){return$def}local $|=1;local $\;my$ans;eval {local$SIG{ALRM}=sub {undef$ans;die "alarm\n"};print STDOUT "$mess $dispdef";alarm$self->{prompt_timeout}if$self->{prompt_timeout};$ans=;alarm 0};if (defined$ans){chomp$ans}else {print STDOUT "\n"}return (!defined$ans || $ans eq '')? $def : $ans}sub diag_ok {my($self,$msg)=@_;chomp$msg;$msg ||= "OK";if ($self->{in_progress}){$self->_diag("$msg\n");$self->{in_progress}=0}$self->log("-> $msg\n")}sub diag_fail {my($self,$msg,$always)=@_;chomp$msg;if ($self->{in_progress}){$self->_diag("FAIL\n");$self->{in_progress}=0}if ($msg){$self->_diag("! $msg\n",$always,1);$self->log("-> FAIL $msg\n")}}sub diag_progress {my($self,$msg)=@_;chomp$msg;$self->{in_progress}=1;$self->_diag("$msg ... ");$self->log("$msg\n")}sub _diag {my($self,$msg,$always,$error)=@_;my$fh=$error ? *STDERR : *STDOUT;print {$fh}$msg if$always or $self->{verbose}or!$self->{quiet}}sub diag {my($self,$msg,$always)=@_;$self->_diag($msg,$always);$self->log($msg)}sub chat {my$self=shift;print STDERR @_ if$self->{verbose};$self->log(@_)}sub mask_output {my$self=shift;my$method=shift;$self->$method($self->mask_uri_passwords(@_))}sub log {my$self=shift;open my$out,">>$self->{log}";print$out @_}sub run_command {my($self,$cmd)=@_;if (ref$cmd eq 'CODE'){if ($self->{verbose}){return$cmd->()}else {require Capture::Tiny;open my$logfh,">>",$self->{log};my$ret;Capture::Tiny::capture(sub {$ret=$cmd->()},stdout=>$logfh,stderr=>$logfh);return$ret}}if (WIN32){$cmd=Menlo::Util::shell_quote(@$cmd)if ref$cmd eq 'ARRAY';unless ($self->{verbose}){$cmd .= " >> " .Menlo::Util::shell_quote($self->{log})." 2>&1"}!system$cmd}else {my$pid=fork;if ($pid){waitpid$pid,0;return!$?}else {$self->run_exec($cmd)}}}sub run_exec {my($self,$cmd)=@_;if (ref$cmd eq 'ARRAY'){unless ($self->{verbose}){open my$logfh,">>",$self->{log};open STDERR,'>&',$logfh;open STDOUT,'>&',$logfh;close$logfh}exec @$cmd}else {unless ($self->{verbose}){$cmd .= " >> " .Menlo::Util::shell_quote($self->{log})." 2>&1"}exec$cmd}}sub run_timeout {my($self,$cmd,$timeout)=@_;return$self->run_command($cmd)if ref($cmd)eq 'CODE' || WIN32 || $self->{verbose}||!$timeout;my$pid=fork;if ($pid){eval {local$SIG{ALRM}=sub {die "alarm\n"};alarm$timeout;waitpid$pid,0;alarm 0};if ($@ && $@ eq "alarm\n"){$self->diag_fail("Timed out (> ${timeout}s). Use --verbose to retry.");local$SIG{TERM}='IGNORE';kill TERM=>0;waitpid$pid,0;return}return!$?}elsif ($pid==0){$self->run_exec($cmd)}else {$self->chat("! fork failed: falling back to system()\n");$self->run_command($cmd)}}sub append_args {my($self,$cmd,$phase)=@_;return$cmd if ref$cmd ne 'ARRAY';if (my$args=$self->{build_args}{$phase}){$cmd=join ' ',Menlo::Util::shell_quote(@$cmd),$args}$cmd}sub _use_unsafe_inc {my($self,$dist)=@_;if (exists$ENV{PERL_USE_UNSAFE_INC}){return$ENV{PERL_USE_UNSAFE_INC}}if (exists$dist->{meta}{x_use_unsafe_inc}){$self->chat("Distribution opts in x_use_unsafe_inc: $dist->{meta}{x_use_unsafe_inc}\n");return$dist->{meta}{x_use_unsafe_inc}}return 1}sub configure {my($self,$cmd,$dist,$depth)=@_;local$ENV{PERL5_CPAN_IS_RUNNING}=local$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$;local$ENV{PERL5_CPANM_IS_RUNNING}=$$;my$use_default=!$self->{interactive};local$ENV{PERL_MM_USE_DEFAULT}=$use_default;local$ENV{PERL_MM_OPT}=$ENV{PERL_MM_OPT};local$ENV{PERL_MB_OPT}=$ENV{PERL_MB_OPT};unless ($self->{pod2man}){$ENV{PERL_MM_OPT}.= " INSTALLMAN1DIR=none INSTALLMAN3DIR=none";$ENV{PERL_MB_OPT}.= " --config installman1dir= --config installsiteman1dir= --config installman3dir= --config installsiteman3dir="}if ($self->{pure_perl}){$ENV{PERL_MM_OPT}.= " PUREPERL_ONLY=1";$ENV{PERL_MB_OPT}.= " --pureperl-only"}local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);$cmd=$self->append_args($cmd,'configure')if$depth==0;local$self->{verbose}=$self->{verbose}|| $self->{interactive};$self->run_timeout($cmd,$self->{configure_timeout})}sub build {my($self,$cmd,$distname,$dist,$depth)=@_;local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);$cmd=$self->append_args($cmd,'build')if$depth==0;return 1 if$self->run_timeout($cmd,$self->{build_timeout});while (1){my$ans=lc$self->prompt("Building $distname failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?","s");return if$ans eq 's';return$self->build($cmd,$distname,$dist,$depth)if$ans eq 'r';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}sub test {my($self,$cmd,$distname,$dist,$depth)=@_;return 1 if$self->{notest};local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{NONINTERACTIVE_TESTING}=!$self->{interactive};local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);$cmd=$self->append_args($cmd,'test')if$depth==0;return 1 if$self->run_timeout($cmd,$self->{test_timeout});if ($self->{force}){$self->diag_fail("Testing $distname failed but installing it anyway.");return 1}else {$self->diag_fail;while (1){my$ans=lc$self->prompt("Testing $distname failed.\nYou can s)kip, r)etry, f)orce install, e)xamine build log, or l)ook ?","s");return if$ans eq 's';return$self->test($cmd,$distname,$dist,$depth)if$ans eq 'r';return 1 if$ans eq 'f';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}}sub install {my($self,$cmd,$uninst_opts,$dist,$depth)=@_;if ($depth==0 && $self->{test_only}){return 1}return$self->run_command($cmd)if ref$cmd eq 'CODE';local$ENV{PERL_USE_UNSAFE_INC}=$self->_use_unsafe_inc($dist);if ($self->{sudo}){unshift @$cmd,"sudo"}if ($self->{uninstall_shadows}&&!$ENV{PERL_MM_OPT}){push @$cmd,@$uninst_opts}$cmd=$self->append_args($cmd,'install')if$depth==0;$self->run_command($cmd)}sub look {my$self=shift;my$shell=$ENV{SHELL};$shell ||= $ENV{COMSPEC}if WIN32;if ($shell){my$cwd=Cwd::cwd;$self->diag("Entering $cwd with $shell\n");system$shell}else {$self->diag_fail("You don't seem to have a SHELL :/")}}sub show_build_log {my$self=shift;my@pagers=($ENV{PAGER},(WIN32 ? (): ('less')),'more');my$pager;while (@pagers){$pager=shift@pagers;next unless$pager;$pager=which($pager);next unless$pager;last}if ($pager){if (WIN32){system "@{[ qs $pager ]} < @{[ qs $self->{log}]}"}else {system$pager,$self->{log}}}else {$self->diag_fail("You don't seem to have a PAGER :/")}}sub chdir {my$self=shift;Cwd::chdir(File::Spec->canonpath($_[0]))or die "$_[0]: $!"}sub configure_mirrors {my$self=shift;unless (@{$self->{mirrors}}){$self->{mirrors}=['http://www.cpan.org' ]}for (@{$self->{mirrors}}){s!^/!file:///!;s!/$!!}}sub self_upgrade {my$self=shift;$self->check_upgrade;$self->{argv}=['Menlo' ];return}sub install_module {my($self,$module,$depth,$version,$dep)=@_;$self->check_libs;if ($self->{seen}{$module}++){$self->chat("Already tried $module. Skipping.\n");return 1}if ($self->{skip_satisfied}){my($ok,$local)=$self->check_module($module,$version || 0);if ($ok){$self->diag("You have $module ($local)\n",1);return 1}}my$dist=$self->resolve_name($module,$version,$dep);unless ($dist){my$what=$module .($version ? " ($version)" : "");$self->diag_fail("Couldn't find module or a distribution $what",1);return}if ($dist->{distvname}&& $self->{seen}{$dist->{distvname}}++){$self->chat("Already tried $dist->{distvname}. Skipping.\n");return 1}if ($self->{cmd}eq 'info'){print$self->format_dist($dist),"\n";return 1}$dist->{depth}=$depth;if ($dist->{module}){unless ($self->satisfy_version($dist->{module},$dist->{module_version},$version)){$self->diag("Found $dist->{module} $dist->{module_version} which doesn't satisfy $version.\n",1);return}my$cmp=$version ? "==" : "";my$requirement=$dist->{module_version}? "$cmp$dist->{module_version}" : 0;my($ok,$local)=$self->check_module($dist->{module},$requirement);if ($self->{skip_installed}&& $ok){$self->diag("$dist->{module} is up to date. ($local)\n",1);return 1}}if ($dist->{dist}eq 'perl'){$self->diag("skipping $dist->{pathname}\n");return 1}$self->diag("--> Working on $module\n");$dist->{dir}||= $self->fetch_module($dist);unless ($dist->{dir}){$self->diag_fail("Failed to fetch distribution $dist->{distvname}",1);return}$self->chat("Entering $dist->{dir}\n");$self->chdir($self->{base});$self->chdir($dist->{dir});if ($self->{cmd}eq 'look'){$self->look;return 1}return$self->build_stuff($module,$dist,$depth)}sub uninstall_search_path {my$self=shift;$self->{local_lib}? (local::lib->install_base_arch_path($self->{local_lib}),local::lib->install_base_perl_path($self->{local_lib})): @Config{qw(installsitearch installsitelib)}}sub uninstall_module {my ($self,$module)=@_;$self->check_libs;my@inc=$self->uninstall_search_path;my($metadata,$packlist)=$self->packlists_containing($module,\@inc);unless ($packlist){$self->diag_fail(<uninstall_target($metadata,$packlist);$self->ask_permission($module,\@uninst_files)or return;$self->uninstall_files(@uninst_files,$packlist);$self->diag("Successfully uninstalled $module\n",1);return 1}sub packlists_containing {my($self,$module,$inc)=@_;require Module::Metadata;my$metadata=Module::Metadata->new_from_module($module,inc=>$inc)or return;my$packlist;my$wanted=sub {return unless $_ eq '.packlist' && -f $_;for my$file ($self->unpack_packlist($File::Find::name)){$packlist ||= $File::Find::name if$file eq $metadata->filename}};{require File::pushd;my$pushd=File::pushd::pushd();my@search=grep -d $_,map File::Spec->catdir($_,'auto'),@$inc;File::Find::find($wanted,@search)}return$metadata,$packlist}sub uninstall_target {my($self,$metadata,$packlist)=@_;if ($self->has_shadow_install($metadata)or $self->{local_lib}){grep$self->should_unlink($_),$self->unpack_packlist($packlist)}else {$self->unpack_packlist($packlist)}}sub has_shadow_install {my($self,$metadata)=@_;my@shadow=grep defined,map Module::Metadata->new_from_module($metadata->name,inc=>[$_]),@INC;@shadow >= 2}sub should_unlink {my($self,$file)=@_;if ($self->{local_lib}){$file =~ /^\Q$self->{local_lib}\E/}else {!(grep$file =~ /^\Q$_\E/,@Config{qw(installbin installscript installman1dir installman3dir)})}}sub ask_permission {my ($self,$module,$files)=@_;$self->diag("$module contains the following files:\n\n");for my$file (@$files){$self->diag(" $file\n")}$self->diag("\n");return 'force uninstall' if$self->{force};local$self->{prompt}=1;return$self->prompt_bool("Are you sure you want to uninstall $module?",'y')}sub unpack_packlist {my ($self,$packlist)=@_;open my$fh,'<',$packlist or die "$packlist: $!";map {chomp;$_}<$fh>}sub uninstall_files {my ($self,@files)=@_;$self->diag("\n");for my$file (@files){$self->diag("Unlink: $file\n");unlink$file or $self->diag_fail("$!: $file")}$self->diag("\n");return 1}sub format_dist {my($self,$dist)=@_;return "$dist->{cpanid}/$dist->{filename}"}sub trim {local $_=shift;tr/\n/ /d;s/^\s*|\s*$//g;$_}sub fetch_module {my($self,$dist)=@_;$self->chdir($self->{base});for my$uri (@{$dist->{uris}}){$self->mask_output(diag_progress=>"Fetching $uri");my$filename=$dist->{filename}|| $uri;my$name=File::Basename::basename($filename);my$cancelled;my$fetch=sub {my$file;eval {local$SIG{INT}=sub {$cancelled=1;die "SIGINT\n"};$self->mirror($uri,$name);$file=$name if -e $name};$self->diag("ERROR: " .trim("$@")."\n",1)if $@ && $@ ne "SIGINT\n";return$file};my($try,$file);while ($try++ < 3){$file=$fetch->();last if$cancelled or $file;$self->mask_output(diag_fail=>"Download $uri failed. Retrying ... ")}if ($cancelled){$self->diag_fail("Download cancelled.");return}unless ($file){$self->mask_output(diag_fail=>"Failed to download $uri");next}$self->diag_ok;$dist->{local_path}=File::Spec->rel2abs($name);my$dir=$self->unpack($file,$uri,$dist);next unless$dir;if (my$save=$self->{save_dists}){my$path=$dist->{pathname}? "$save/authors/id/$dist->{pathname}" : "$save/vendor/$file";$self->chat("Copying $name to $path\n");File::Path::mkpath([File::Basename::dirname($path)],0,0777);File::Copy::copy($file,$path)or warn $!}return$dist,$dir}}sub unpack {my($self,$file,$uri,$dist)=@_;if ($self->{verify}){$self->verify_archive($file,$uri,$dist)or return}$self->chat("Unpacking $file\n");my$dir=$file =~ /\.zip/i ? $self->unzip($file): $self->untar($file);unless ($dir){$self->diag_fail("Failed to unpack $file: no directory")}return$dir}sub verify_checksums_signature {my($self,$chk_file)=@_;require Module::Signature;$self->chat("Verifying the signature of CHECKSUMS\n");my$rv=eval {local$SIG{__WARN__}=sub {};my$v=Module::Signature::_verify($chk_file);$v==Module::Signature::SIGNATURE_OK()};if ($rv){$self->chat("Verified OK!\n")}else {$self->diag_fail("Verifying CHECKSUMS signature failed: $rv\n");return}return 1}sub verify_archive {my($self,$file,$uri,$dist)=@_;unless ($dist->{cpanid}){$self->chat("Archive '$file' does not seem to be from PAUSE. Skip verification.\n");return 1}(my$mirror=$uri)=~ s!/authors/id.*$!!;(my$chksum_uri=$uri)=~ s!/[^/]*$!/CHECKSUMS!;my$chk_file=$self->source_for($mirror)."/$dist->{cpanid}.CHECKSUMS";$self->mask_output(diag_progress=>"Fetching $chksum_uri");$self->mirror($chksum_uri,$chk_file);unless (-e $chk_file){$self->diag_fail("Fetching $chksum_uri failed.\n");return}$self->diag_ok;$self->verify_checksums_signature($chk_file)or return;$self->verify_checksum($file,$chk_file)}sub verify_checksum {my($self,$file,$chk_file)=@_;$self->chat("Verifying the SHA1 for $file\n");open my$fh,"<$chk_file" or die "$chk_file: $!";my$data=join '',<$fh>;$data =~ s/\015?\012/\n/g;require Safe;my$chksum=Safe->new->reval($data);if (!ref$chksum or ref$chksum ne 'HASH'){$self->diag_fail("! Checksum file downloaded from $chk_file is broken.\n");return}if (my$sha=$chksum->{$file}{sha256}){my$hex=$self->sha_for(256,$file);if ($hex eq $sha){$self->chat("Checksum for $file: Verified!\n")}else {$self->diag_fail("Checksum mismatch for $file\n");return}}else {$self->chat("Checksum for $file not found in CHECKSUMS.\n");return}}sub sha_for {my($self,$alg,$file)=@_;require Digest::SHA;open my$fh,"<",$file or die "$file: $!";my$dg=Digest::SHA->new($alg);my($data);while (read($fh,$data,4096)){$dg->add($data)}return$dg->hexdigest}sub verify_signature {my($self,$dist)=@_;$self->diag_progress("Verifying the SIGNATURE file");my$out=`@{[ qs $self->{cpansign} ]} -v --skip 2>&1`;$self->log($out);if ($out =~ /Signature verified OK/){$self->diag_ok("Verified OK");return 1}else {$self->diag_fail("SIGNATURE verification for $dist->{filename} failed\n");return}}sub resolve_name {my($self,$module,$version,$dep)=@_;if ($dep && $dep->url){if ($dep->url =~ m!authors/id/(.*)!){return$self->cpan_dist($1,$dep->url)}else {return {uris=>[$dep->url ]}}}if ($dep && $dep->dist){return$self->cpan_dist($dep->dist,undef,$dep->mirror)}if ($module =~ /(?:^git:|\.git(?:@.+)?$)/){return$self->git_uri($module)}if ($module =~ /^(ftp|https?|file):/){if ($module =~ m!authors/id/(.*)!){return$self->cpan_dist($1,$module)}else {return {uris=>[$module ]}}}if ($module =~ m!^[\./]! && -d $module){return {source=>'local',dir=>Cwd::abs_path($module),}}if (-f $module){return {source=>'local',uris=>["file://" .Cwd::abs_path($module)],}}if ($module =~ s!^cpan:///distfile/!!){return$self->cpan_dist($module)}if ($module =~ m!^(?:[A-Z]/[A-Z]{2}/)?([A-Z]{2}[\-A-Z0-9]*/.*)$!){return$self->cpan_dist($1)}return$self->search_module($module,$version)}sub cpan_module_common {my($self,$match)=@_;(my$distfile=$match->{uri})=~ s!^cpan:///distfile/!!;my$mirrors=$self->{mirrors};if ($match->{download_uri}){(my$mirror=$match->{download_uri})=~ s!/authors/id/.*$!!;$mirrors=[$mirror]}local$self->{mirrors}=$mirrors;return$self->cpan_module($match->{package},$distfile,$match->{version})}sub cpan_module {my($self,$module,$dist_file,$version)=@_;my$dist=$self->cpan_dist($dist_file);$dist->{module}=$module;$dist->{module_version}=$version if$version && $version ne 'undef';return$dist}sub cpan_dist {my($self,$dist,$url,$mirror)=@_;$mirror =~ s!/$!! if$mirror;$dist =~ s!^([A-Z]{2})!substr($1,0,1)."/".substr($1,0,2)."/".$1!e;require CPAN::DistnameInfo;my$d=CPAN::DistnameInfo->new($dist);if ($url){$url=[$url ]unless ref$url eq 'ARRAY'}else {my$id=$d->cpanid;my$fn=substr($id,0,1)."/" .substr($id,0,2)."/" .$id ."/" .$d->filename;my@mirrors=$mirror ? ($mirror): @{$self->{mirrors}};my@urls=map "$_/authors/id/$fn",@mirrors;$url=\@urls,}return {$d->properties,source=>'cpan',uris=>$url,}}sub git_uri {my ($self,$uri)=@_;($uri,my$commitish)=split /(?<=\.git)@/i,$uri,2;my$dir=File::Temp::tempdir(CLEANUP=>1);$self->mask_output(diag_progress=>"Cloning $uri");$self->run_command(['git','clone',$uri,$dir ]);unless (-e "$dir/.git"){$self->diag_fail("Failed cloning git repository $uri",1);return}if ($commitish){require File::pushd;my$dir=File::pushd::pushd($dir);unless ($self->run_command(['git','checkout',$commitish ])){$self->diag_fail("Failed to checkout '$commitish' in git repository $uri\n");return}}$self->diag_ok;return {source=>'local',dir=>$dir,}}sub core_version_for {my($self,$module)=@_;require Module::CoreList;unless (exists$Module::CoreList::version{$]+0}){die sprintf("Module::CoreList %s (loaded from %s) doesn't seem to have entries for perl $]. " ."You're strongly recommended to upgrade Module::CoreList from CPAN.\n",$Module::CoreList::VERSION,$INC{"Module/CoreList.pm"})}unless (exists$Module::CoreList::version{$]+0}{$module}){return -1}return$Module::CoreList::version{$]+0}{$module}}sub search_inc {my$self=shift;$self->{search_inc}||= do {if (defined$::Bin){[grep!/^\Q$::Bin\E\/..\/(?:fat)?lib$/,@INC]}else {[@INC]}}}sub check_module {my($self,$mod,$want_ver)=@_;require Module::Metadata;my$meta=Module::Metadata->new_from_module($mod,inc=>$self->search_inc)or return 0,undef;my$version=$meta->version;if ($self->{self_contained}&& $self->loaded_from_perl_lib($meta)){$version=$self->core_version_for($mod);return 0,undef if$version && $version==-1}$self->{local_versions}{$mod}=$version;if ($self->is_deprecated($meta)){return 0,$version}elsif ($self->satisfy_version($mod,$version,$want_ver)){return 1,($version || 'undef')}else {return 0,$version}}sub satisfy_version {my($self,$mod,$version,$want_ver)=@_;$want_ver='0' unless defined($want_ver)&& length($want_ver);require CPAN::Meta::Requirements;my$requirements=CPAN::Meta::Requirements->new;$requirements->add_string_requirement($mod,$want_ver);$requirements->accepts_module($mod,$version)}sub unsatisfy_how {my($self,$ver,$want_ver)=@_;if ($want_ver =~ /^[v0-9\.\_]+$/){return "$ver < $want_ver"}else {return "$ver doesn't satisfy $want_ver"}}sub is_deprecated {my($self,$meta)=@_;my$deprecated=eval {require Module::CoreList;Module::CoreList::is_deprecated($meta->{module})};return$deprecated && $self->loaded_from_perl_lib($meta)}sub loaded_from_perl_lib {my($self,$meta)=@_;require Config;my@dirs=qw(archlibexp privlibexp);if ($self->{self_contained}&&!$self->{exclude_vendor}&& $Config{vendorarch}){unshift@dirs,qw(vendorarch vendorlibexp)}for my$dir (@dirs){my$confdir=$Config{$dir};if ($confdir eq substr($meta->filename,0,length($confdir))){return 1}}return}sub should_install {my($self,$mod,$ver)=@_;$self->chat("Checking if you have $mod $ver ... ");my($ok,$local)=$self->check_module($mod,$ver);if ($ok){$self->chat("Yes ($local)\n")}elsif ($local){$self->chat("No (" .$self->unsatisfy_how($local,$ver).")\n")}else {$self->chat("No\n")}return$mod unless$ok;return}sub check_perl_version {my($self,$version)=@_;require CPAN::Meta::Requirements;my$req=CPAN::Meta::Requirements->from_string_hash({perl=>$version });$req->accepts_module(perl=>$])}sub install_deps {my($self,$dir,$depth,@deps)=@_;my(@install,%seen,@fail);for my$dep (@deps){next if$seen{$dep->module};if ($dep->module eq 'perl'){if ($dep->is_requirement &&!$self->check_perl_version($dep->version)){$self->diag("Needs perl @{[$dep->version]}, you have $]\n");push@fail,'perl'}}elsif ($self->should_install($dep->module,$dep->version)){push@install,$dep;$seen{$dep->module}=1}}if (@install){$self->diag("==> Found dependencies: " .join(", ",map $_->module,@install)."\n")}for my$dep (@install){$self->install_module($dep->module,$depth + 1,$dep->version,$dep)}$self->chdir($self->{base});$self->chdir($dir)if$dir;if ($self->{scandeps}){return 1}my@not_ok=$self->unsatisfied_deps(@deps);if (@not_ok){return 0,\@not_ok}else {return 1}}sub unsatisfied_deps {my($self,@deps)=@_;require CPAN::Meta::Check;require CPAN::Meta::Requirements;my$reqs=CPAN::Meta::Requirements->new;for my$dep (grep $_->is_requirement,@deps){$reqs->add_string_requirement($dep->module=>$dep->requires_version || '0')}my$ret=CPAN::Meta::Check::check_requirements($reqs,'requires',$self->{search_inc});grep defined,values %$ret}sub install_deps_bailout {my($self,$target,$dir,$depth,@deps)=@_;my($ok,$fail)=$self->install_deps($dir,$depth,@deps);if (!$ok){$self->diag_fail("Installing the dependencies failed: " .join(", ",@$fail),1);unless ($self->prompt_bool("Do you want to continue building $target anyway?","n")){$self->diag_fail("Bailing out the installation for $target.",1);return}}return 1}sub build_stuff {my($self,$stuff,$dist,$depth)=@_;if ($self->{verify}&& -e 'SIGNATURE'){$self->verify_signature($dist)or return}require CPAN::Meta;my($meta_file)=grep -f,qw(META.json META.yml);if ($meta_file){$self->chat("Checking configure dependencies from $meta_file\n");$dist->{cpanmeta}=eval {CPAN::Meta->load_file($meta_file)}}elsif ($dist->{dist}&& $dist->{version}){$self->chat("META.yml/json not found. Creating skeleton for it.\n");$dist->{cpanmeta}=CPAN::Meta->new({name=>$dist->{dist},version=>$dist->{version}})}$dist->{meta}=$dist->{cpanmeta}? $dist->{cpanmeta}->as_struct : {};if ($self->opts_in_static_install($dist->{cpanmeta})){$dist->{static_install}=1}my@config_deps;if ($dist->{cpanmeta}){push@config_deps,Menlo::Dependency->from_prereqs($dist->{cpanmeta}->effective_prereqs,['configure'],$self->{install_types},)}if (-e 'Build.PL' &&!@config_deps){push@config_deps,Menlo::Dependency->from_versions({'Module::Build'=>'0.38' },'configure',)}$self->merge_with_cpanfile($dist,\@config_deps);$self->upgrade_toolchain(\@config_deps);my$target=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $dist->{dir};unless ($self->skip_configure($dist,$depth)){$self->install_deps_bailout($target,$dist->{dir},$depth,@config_deps)or return}$self->diag_progress("Configuring $target");my$configure_state=$self->configure_this($dist,$depth);$self->diag_ok($configure_state->{configured_ok}? "OK" : "N/A");if ($dist->{cpanmeta}&& $dist->{source}eq 'cpan'){$dist->{provides}=$dist->{cpanmeta}{provides}|| $self->extract_packages($dist->{cpanmeta},".")}my$deps_only=$self->deps_only($depth);$dist->{want_phases}=$self->{notest}&&!$self->deps_only($depth)? [qw(build runtime)]: [qw(build test runtime)];push @{$dist->{want_phases}},'develop' if$self->{with_develop}&& $depth==0;push @{$dist->{want_phases}},'configure' if$self->{with_configure}&& $depth==0;my@deps=$self->find_prereqs($dist);my$module_name=$self->find_module_name($configure_state)|| $dist->{meta}{name};$module_name =~ s/-/::/g;if ($self->{showdeps}){for my$dep (@config_deps,@deps){print$dep->module,($dep->version ? ("~".$dep->version): ""),"\n"}return 1}my$distname=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;my$walkup;if ($self->{scandeps}){$walkup=$self->scandeps_append_child($dist)}$self->install_deps_bailout($distname,$dist->{dir},$depth,@deps)or return;if ($self->{scandeps}){unless ($configure_state->{configured_ok}){my$diag=<{scandeps_tree}};$diag .= "!\n" .join("",map "! * $_->[0]{module}\n",@tree[0..$#tree-1])if@tree}$self->diag("!\n$diag!\n",1)}$walkup->();return 1}if ($self->{installdeps}&& $depth==0){if ($configure_state->{configured_ok}){$self->diag("<== Installed dependencies for $stuff. Finishing.\n");return 1}else {$self->diag("! Configuring $distname failed. See $self->{log} for details.\n",1);return}}my$installed;if ($configure_state->{static_install}){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build(sub {$configure_state->{static_install}->build},$distname,$dist,$depth)&& $self->test(sub {$configure_state->{static_install}->build("test")},$distname,$dist,$depth)&& $self->install(sub {$configure_state->{static_install}->build("install")},[],$dist,$depth)&& $installed++}elsif ($configure_state->{use_module_build}&& -e 'Build' && -f _){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{perl},"./Build" ],$distname,$dist,$depth)&& $self->test([$self->{perl},"./Build","test" ],$distname,$dist,$depth)&& $self->install([$self->{perl},"./Build","install" ],["--uninst",1 ],$dist,$depth)&& $installed++}elsif ($self->{make}&& -e 'Makefile'){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{make}],$distname,$dist,$depth)&& $self->test([$self->{make},"test" ],$distname,$dist,$depth)&& $self->install([$self->{make},"install" ],["UNINST=1" ],$dist,$depth)&& $installed++}else {my$why;my$configure_failed=$configure_state->{configured}&&!$configure_state->{configured_ok};if ($configure_failed){$why="Configure failed for $distname."}elsif ($self->{make}){$why="The distribution doesn't have a proper Makefile.PL/Build.PL"}else {$why="Can't configure the distribution. You probably need to have 'make'."}$self->diag_fail("$why See $self->{log} for details.",1);return}if ($installed && $self->{test_only}){$self->diag_ok;$self->diag("Successfully tested $distname\n",1)}elsif ($installed){my$local=$self->{local_versions}{$dist->{module}|| ''};my$version=$dist->{module_version}|| $dist->{meta}{version}|| $dist->{version};my$reinstall=$local && ($local eq $version);my$action=$local &&!$reinstall ? $self->numify_ver($version)< $self->numify_ver($local)? "downgraded" : "upgraded" : undef;my$how=$reinstall ? "reinstalled $distname" : $local ? "installed $distname ($action from $local)" : "installed $distname" ;my$msg="Successfully $how";$self->diag_ok;$self->diag("$msg\n",1);$self->{installed_dists}++;$self->save_meta($stuff,$dist,$module_name,\@config_deps,\@deps);return 1}else {my$what=$self->{test_only}? "Testing" : "Installing";$self->diag_fail("$what $stuff failed. See $self->{log} for details. Retry with --force to force install it.",1);return}}sub opts_in_static_install {my($self,$meta)=@_;return if!$self->{static_install};return if$self->{sudo}or $self->{uninstall_shadows};return$meta->{x_static_install}&& $meta->{x_static_install}==1}sub skip_configure {my($self,$dist,$depth)=@_;return 1 if$self->{skip_configure};return 1 if$dist->{static_install};return 1 if$self->no_dynamic_config($dist->{meta})&& $self->deps_only($depth);return}sub no_dynamic_config {my($self,$meta)=@_;exists$meta->{dynamic_config}&& $meta->{dynamic_config}==0}sub deps_only {my($self,$depth)=@_;($self->{installdeps}&& $depth==0)or $self->{showdeps}or $self->{scandeps}}sub perl_requirements {my($self,@requires)=@_;my@perl;for my$requires (grep defined,@requires){if (exists$requires->{perl}){push@perl,Menlo::Dependency->new(perl=>$requires->{perl})}}return@perl}sub configure_this {my($self,$dist,$depth)=@_;my$deps_only=$self->deps_only($depth);if (-e $self->{cpanfile_path}&& $deps_only){require Module::CPANfile;$dist->{cpanfile}=eval {Module::CPANfile->load($self->{cpanfile_path})};$self->diag_fail($@,1)if $@;$self->{cpanfile_global}||= $dist->{cpanfile};return {configured=>1,configured_ok=>!!$dist->{cpanfile},use_module_build=>0,}}if ($self->{skip_configure}){my$eumm=-e 'Makefile';my$mb=-e 'Build' && -f _;return {configured=>1,configured_ok=>$eumm || $mb,use_module_build=>$mb,}}if ($deps_only && $self->no_dynamic_config($dist->{meta})){return {configured=>1,configured_ok=>exists$dist->{meta}{prereqs},use_module_build=>0,}}my$state={};my$try_static=sub {if ($dist->{static_install}){$self->chat("Distribution opts in x_static_install: $dist->{meta}{x_static_install}\n");$self->static_install_configure($state,$dist,$depth)}};my$try_eumm=sub {if (-e 'Makefile.PL'){$self->chat("Running Makefile.PL\n");if ($self->configure([$self->{perl},"Makefile.PL" ],$dist,$depth)){$state->{configured_ok}=-e 'Makefile'}$state->{configured}++}};my$try_mb=sub {if (-e 'Build.PL'){$self->chat("Running Build.PL\n");if ($self->configure([$self->{perl},"Build.PL" ],$dist,$depth)){$state->{configured_ok}=-e 'Build' && -f _}$state->{use_module_build}++;$state->{configured}++}};for my$try ($try_static,$try_mb,$try_eumm){$try->();last if$state->{configured_ok}}unless ($state->{configured_ok}){while (1){my$ans=lc$self->prompt("Configuring $dist->{dist} failed.\nYou can s)kip, r)etry, e)xamine build log, or l)ook ?","s");last if$ans eq 's';return$self->configure_this($dist,$depth)if$ans eq 'r';$self->show_build_log if$ans eq 'e';$self->look if$ans eq 'l'}}return$state}sub static_install_configure {my($self,$state,$dist,$depth)=@_;my$args=$depth==0 ? $self->{build_args}{configure}: [];require Menlo::Builder::Static;my$builder=Menlo::Builder::Static->new(meta=>$dist->{cpanmeta});$self->configure(sub {$builder->configure($args || [])},$dist,$depth);$state->{configured_ok}=1;$state->{static_install}=$builder;$state->{configured}++}sub find_module_name {my($self,$state)=@_;return unless$state->{configured_ok};if ($state->{use_module_build}&& -e "_build/build_params"){my$params=do {open my$in,"_build/build_params";eval(join "",<$in>)};return eval {$params->[2]{module_name}}|| undef}elsif (-e "Makefile"){open my$mf,"Makefile";while (<$mf>){if (/^\#\s+NAME\s+=>\s+(.*)/){return eval($1)}}}return}sub list_files {my$self=shift;if (-e 'MANIFEST'){require ExtUtils::Manifest;my$manifest=eval {ExtUtils::Manifest::manifind()}|| {};return sort {lc$a cmp lc$b}keys %$manifest}else {require File::Find;my@files;my$finder=sub {my$name=$File::Find::name;$name =~ s!\.[/\\]!!;push@files,$name};File::Find::find($finder,".");return sort {lc$a cmp lc$b}@files}}sub extract_packages {my($self,$meta,$dir)=@_;my$try=sub {my$file=shift;return 0 if$file =~ m!^(?:x?t|inc|local|perl5|fatlib|_build)/!;return 1 unless$meta->{no_index};return 0 if grep {$file =~ m!^$_/!}@{$meta->{no_index}{directory}|| []};return 0 if grep {$file eq $_}@{$meta->{no_index}{file}|| []};return 1};require Parse::PMFile;my@files=grep {/\.pm(?:\.PL)?$/ && $try->($_)}$self->list_files;my$provides={};for my$file (@files){my$parser=Parse::PMFile->new($meta,{UNSAFE=>1,ALLOW_DEV_VERSION=>1 });my$packages=$parser->parse($file);while (my($package,$meta)=each %$packages){$provides->{$package}||= {file=>$meta->{infile},($meta->{version}eq 'undef')? (): (version=>$meta->{version}),}}}return$provides}sub save_meta {my($self,$module,$dist,$module_name,$config_deps,$build_deps)=@_;return unless$dist->{distvname}&& $dist->{source}eq 'cpan';my$base=($ENV{PERL_MM_OPT}|| '')=~ /INSTALL_BASE=/ ? ($self->install_base($ENV{PERL_MM_OPT})."/lib/perl5"): $Config{sitelibexp};my$provides=$dist->{provides};File::Path::mkpath("blib/meta",0,0777);my$local={name=>$module_name,target=>$module,version=>exists$provides->{$module_name}? ($provides->{$module_name}{version}|| $dist->{version}): $dist->{version},dist=>$dist->{distvname},pathname=>$dist->{pathname},provides=>$provides,};require JSON::PP;open my$fh,">","blib/meta/install.json" or die $!;print$fh JSON::PP::encode_json($local);File::Copy::copy("MYMETA.json","blib/meta/MYMETA.json");my@cmd=(($self->{sudo}? 'sudo' : ()),$^X,'-MExtUtils::Install=install','-e',qq[install({ 'blib/meta' => '$base/$Config{archname}/.meta/$dist->{distvname}' })],);$self->run_command(\@cmd)}sub install_base {my($self,$mm_opt)=@_;$mm_opt =~ /INSTALL_BASE=(\S+)/ and return $1;die "Your PERL_MM_OPT doesn't contain INSTALL_BASE"}sub configure_features {my($self,$dist,@features)=@_;map $_->identifier,grep {$self->effective_feature($dist,$_)}@features}sub effective_feature {my($self,$dist,$feature)=@_;if ($dist->{depth}==0){my$value=$self->{features}{$feature->identifier};return$value if defined$value;return 1 if$self->{features}{__all}}if ($self->{interactive}){require CPAN::Meta::Requirements;$self->diag("[@{[ $feature->description ]}]\n",1);my$req=CPAN::Meta::Requirements->new;for my$phase (@{$dist->{want_phases}}){for my$type (@{$self->{install_types}}){$req->add_requirements($feature->prereqs->requirements_for($phase,$type))}}my$reqs=$req->as_string_hash;my@missing;for my$module (keys %$reqs){if ($self->should_install($module,$req->{$module})){push@missing,$module}}if (@missing){my$howmany=@missing;$self->diag("==> Found missing dependencies: " .join(", ",@missing)."\n",1);local$self->{prompt}=1;return$self->prompt_bool("Install the $howmany optional module(s)?","y")}}return}sub find_prereqs {my($self,$dist)=@_;my@deps=$self->extract_meta_prereqs($dist);if ($dist->{module}=~ /^Bundle::/i){push@deps,$self->bundle_deps($dist)}$self->merge_with_cpanfile($dist,\@deps);return@deps}sub merge_with_cpanfile {my($self,$dist,$deps)=@_;if ($self->{cpanfile_requirements}&&!$dist->{cpanfile}){for my$dep (@$deps){$dep->merge_with($self->{cpanfile_requirements})}}if ($self->{cpanfile_global}){for my$dep (@$deps){my$opts=$self->{cpanfile_global}->options_for_module($dep->module)or next;$dep->dist($opts->{dist})if$opts->{dist};$dep->mirror($opts->{mirror})if$opts->{mirror};$dep->url($opts->{url})if$opts->{url}}}}sub extract_meta_prereqs {my($self,$dist)=@_;if ($dist->{cpanfile}){my@features=$self->configure_features($dist,$dist->{cpanfile}->features);my$prereqs=$dist->{cpanfile}->prereqs_with(@features);$self->{cpanfile_requirements}=$prereqs->merged_requirements($dist->{want_phases},['requires']);return Menlo::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}require CPAN::Meta;my@meta=qw(MYMETA.json MYMETA.yml);if ($self->no_dynamic_config($dist->{meta})){push@meta,qw(META.json META.yml)}my@deps;my($meta_file)=grep -f,@meta;if ($meta_file){$self->chat("Checking dependencies from $meta_file ...\n");my$mymeta=eval {CPAN::Meta->load_file($meta_file,{lazy_validation=>1 })};if ($mymeta){$dist->{meta}{name}=$mymeta->name;$dist->{meta}{version}=$mymeta->version;return$self->extract_prereqs($mymeta,$dist)}}$self->diag_fail("No MYMETA file is found after configure. Your toolchain is too old?");return}sub bundle_deps {my($self,$dist)=@_;my$match;if ($dist->{module}){$match=sub {my$meta=Module::Metadata->new_from_file($_[0]);$meta && ($meta->name eq $dist->{module})}}else {$match=sub {1}}my@files;File::Find::find({wanted=>sub {push@files,File::Spec->rel2abs($_)if /\.pm$/i && $match->($_)},no_chdir=>1,},'.');my@deps;for my$file (@files){open my$pod,"<",$file or next;my$in_contents;while (<$pod>){if (/^=head\d\s+CONTENTS/){$in_contents=1}elsif (/^=/){$in_contents=0}elsif ($in_contents){/^(\S+)\s*(\S+)?/ and push@deps,Menlo::Dependency->new($1,$self->maybe_version($2))}}}return@deps}sub maybe_version {my($self,$string)=@_;return$string && $string =~ /^\.?\d/ ? $string : undef}sub extract_prereqs {my($self,$meta,$dist)=@_;my@features=$self->configure_features($dist,$meta->features);my$prereqs=$meta->effective_prereqs(\@features)->clone;$self->adjust_prereqs($dist,$prereqs);return Menlo::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}sub adjust_prereqs {my($self,$dist,$prereqs)=@_;if (-e "inc/Module/Install.pm"){for my$phase (qw(build test runtime)){my$reqs=$prereqs->requirements_for($phase,'requires');if ($reqs->requirements_for_module('ExtUtils::MakeMaker')){$reqs->clear_requirement('ExtUtils::MakeMaker');$reqs->add_minimum('ExtUtils::MakeMaker'=>0)}}}if ($dist->{static_install}){my$reqs=$prereqs->requirements_for('test'=>'requires');$reqs->add_minimum('TAP::Harness::Env'=>0)}}sub cleanup_workdirs {my$self=shift;my$expire=time - 24 * 60 * 60 * $self->{auto_cleanup};my@targets;opendir my$dh,"$self->{home}/work";while (my$e=readdir$dh){next if$e !~ /^(\d+)\.\d+$/;my$time=$1;if ($time < $expire){push@targets,"$self->{home}/work/$e"}}if (@targets){if (@targets >= 64){$self->diag("Expiring " .scalar(@targets)." work directories. This might take a while...\n")}else {$self->chat("Expiring " .scalar(@targets)." work directories.\n")}File::Path::rmtree(\@targets,0,0)}}sub scandeps_append_child {my($self,$dist)=@_;my$new_node=[$dist,[]];my$curr_node=$self->{scandeps_current}|| [undef,$self->{scandeps_tree}];push @{$curr_node->[1]},$new_node;$self->{scandeps_current}=$new_node;return sub {$self->{scandeps_current}=$curr_node}}sub dump_scandeps {my$self=shift;if ($self->{format}eq 'tree'){$self->walk_down(sub {my($dist,$depth)=@_;if ($depth==0){print "$dist->{distvname}\n"}else {print " " x ($depth - 1);print "\\_ $dist->{distvname}\n"}},1)}elsif ($self->{format}=~ /^dists?$/){$self->walk_down(sub {my($dist,$depth)=@_;print$self->format_dist($dist),"\n"},0)}elsif ($self->{format}eq 'json'){require JSON::PP;print JSON::PP::encode_json($self->{scandeps_tree})}elsif ($self->{format}eq 'yaml'){require CPAN::Meta::YAML;print CPAN::Meta::YAML::Dump($self->{scandeps_tree})}else {$self->diag("Unknown format: $self->{format}\n")}}sub walk_down {my($self,$cb,$pre)=@_;$self->_do_walk_down($self->{scandeps_tree},$cb,0,$pre)}sub _do_walk_down {my($self,$children,$cb,$depth,$pre)=@_;for my$node (@$children){$cb->($node->[0],$depth)if$pre;$self->_do_walk_down($node->[1],$cb,$depth + 1,$pre);$cb->($node->[0],$depth)unless$pre}}sub DESTROY {my$self=shift;$self->{at_exit}->($self)if$self->{at_exit}}sub mirror {my($self,$uri,$local)=@_;if ($uri =~ /^file:/){$self->file_mirror($uri,$local)}else {$self->{http}->mirror($uri,$local)}}sub untar {$_[0]->{_backends}{untar}->(@_)};sub unzip {$_[0]->{_backends}{unzip}->(@_)};sub uri_to_file {my($self,$uri)=@_;if ($uri =~ s!file:/+!!){$uri="/$uri" unless$uri =~ m![a-zA-Z]:!}return$uri}sub file_get {my($self,$uri)=@_;my$file=$self->uri_to_file($uri);open my$fh,"<$file" or return;join '',<$fh>}sub file_mirror {my($self,$uri,$path)=@_;my$file=$self->uri_to_file($uri);my$source_mtime=(stat$file)[9];return 1 if -e $path && (stat$path)[9]>= $source_mtime;File::Copy::copy($file,$path);utime$source_mtime,$source_mtime,$path}sub configure_http {my$self=shift;require HTTP::Tinyish;my@try=qw(HTTPTiny);unshift@try,'Wget' if$self->{try_wget};unshift@try,'Curl' if$self->{try_curl};unshift@try,'LWP' if$self->{try_lwp};my@protocol=('http');push@protocol,'https' if grep /^https:/,@{$self->{mirrors}};my$backend;for my$try (map "HTTP::Tinyish::$_",@try){if (my$meta=HTTP::Tinyish->configure_backend($try)){if ((grep$try->supports($_),@protocol)==@protocol){for my$tool (sort keys %$meta){(my$desc=$meta->{$tool})=~ s/^(.*?)\n.*/$1/s;$self->chat("You have $tool: $desc\n")}$backend=$try;last}}}$backend->new(agent=>"Menlo/$Menlo::VERSION",verify_SSL=>1)}sub init_tools {my$self=shift;return if$self->{initialized}++;if ($self->{make}=which($Config{make})){$self->chat("You have make $self->{make}\n")}$self->{http}=$self->configure_http;my$tar=which('tar');my$tar_ver;my$maybe_bad_tar=sub {WIN32 || BAD_TAR || (($tar_ver=`@{[ qs $tar ]} --version 2>/dev/null`)=~ /GNU.*1\.13/i)};if ($tar &&!$maybe_bad_tar->()){chomp$tar_ver;$self->chat("You have $tar: $tar_ver\n");$self->{_backends}{untar}=sub {my($self,$tarfile)=@_;my$xf=($self->{verbose}? 'v' : '')."xf";my$ar=$tarfile =~ /bz2$/ ? 'j' : 'z';my($root,@others)=`@{[ qs $tar ]} ${ar}tf @{[ qs $tarfile ]}` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}$self->run_command([$tar,$ar.$xf,$tarfile ]);return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif ($tar and my$gzip=which('gzip')and my$bzip2=which('bzip2')){$self->chat("You have $tar, $gzip and $bzip2\n");$self->{_backends}{untar}=sub {my($self,$tarfile)=@_;my$x="x" .($self->{verbose}? 'v' : '')."f -";my$ar=$tarfile =~ /bz2$/ ? $bzip2 : $gzip;my($root,@others)=`@{[ qs $ar ]} -dc @{[ qs $tarfile ]} | @{[ qs $tar ]} tf -` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "@{[ qs $ar ]} -dc @{[ qs $tarfile ]} | @{[ qs $tar ]} $x";return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif (eval {require Archive::Tar}){$self->chat("Falling back to Archive::Tar $Archive::Tar::VERSION\n");$self->{_backends}{untar}=sub {my$self=shift;my$t=Archive::Tar->new($_[0]);my($root,@others)=$t->list_files;FILE: {$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}$t->extract;return -d $root ? $root : undef}}else {$self->{_backends}{untar}=sub {die "Failed to extract $_[1] - You need to have tar or Archive::Tar installed.\n"}}if (my$unzip=which('unzip')){$self->chat("You have $unzip\n");$self->{_backends}{unzip}=sub {my($self,$zipfile)=@_;my@opt=$self->{verbose}? (): ('-q');my(undef,$root,@others)=`@{[ qs $unzip ]} -t @{[ qs $zipfile ]}` or return undef;FILE: {chomp$root;if ($root !~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1}){$root=shift(@others);redo FILE if$root}}$self->run_command([$unzip,@opt,$zipfile ]);return$root if -d $root;$self->diag_fail("Bad archive: '$root' $zipfile");return undef}}else {$self->{_backends}{unzip}=sub {eval {require Archive::Zip}or die "Failed to extract $_[1] - You need to have unzip or Archive::Zip installed.\n";my($self,$file)=@_;my$zip=Archive::Zip->new();my$status;$status=$zip->read($file);$self->diag_fail("Read of file '$file' failed")if$status!=Archive::Zip::AZ_OK();my@members=$zip->members();for my$member (@members){my$af=$member->fileName();next if ($af =~ m!^(/|\.\./)!);$status=$member->extractToFileNamed($af);$self->diag_fail("Extracting of file 'af' from zipfile '$file' failed")if$status!=Archive::Zip::AZ_OK()}my ($root)=$zip->membersMatching(qr<^[^/]+/$>);$root &&= $root->fileName;return -d $root ? $root : undef}}}sub mask_uri_passwords {my($self,@strings)=@_;s{ (https?://) ([^:/]+) : [^@/]+ @ }{$1$2:********@}gx for@strings;return@strings}1; It appears your cpanm executable was installed via `perlbrew install-cpanm`. cpanm --self-upgrade won't upgrade the version of cpanm you're running. Run the following command to get it upgraded. perlbrew install-cpanm DIE You are running cpanm from the path where your current perl won't install executables to. Because of that, cpanm --self-upgrade won't upgrade the version of cpanm you're running. cpanm path : $0 Install path : $Config{installsitebin} It means you either installed cpanm globally with system perl, or use distro packages such as rpm or apt-get, and you have to use them again to upgrade cpanm. DIE Usage: cpanm [options] Module [...] Try `cpanm --help` or `man cpanm` for more options. USAGE Usage: cpanm [options] Module [...] Options: -v,--verbose Turns on chatty output -q,--quiet Turns off the most output --interactive Turns on interactive configure (required for Task:: modules) -f,--force force install -n,--notest Do not run unit tests --test-only Run tests only, do not install -S,--sudo sudo to run install commands --installdeps Only install dependencies --showdeps Only display direct dependencies --reinstall Reinstall the distribution even if you already have the latest version installed --mirror Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/) --mirror-only Use the mirror's index file instead of the CPAN Meta DB -M,--from Use only this mirror base URL and its index file --prompt Prompt when configure/build/test fails -l,--local-lib Specify the install base to install modules -L,--local-lib-contained Specify the install base to install all non-core modules --self-contained Install all non-core modules, even if they're already installed. --auto-cleanup Number of days that cpanm's work directories expire in. Defaults to 7 Commands: --self-upgrade upgrades itself --info Displays distribution info on CPAN --look Opens the distribution with your SHELL -U,--uninstall Uninstalls the modules (EXPERIMENTAL) -V,--version Displays software version Examples: cpanm Test::More # install Test::More cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file cpanm --interactive Task::Kensho # Configure interactively cpanm . # install from local directory cpanm --installdeps . # install all the deps for the current directory cpanm -L extlib Plack # install Plack and all non-core deps into extlib cpanm --mirror http://cpan.cpantesters.org/ DBI # use the fast-syncing mirror cpanm -M https://cpan.metacpan.org App::perlbrew # use only this secure mirror and its index You can also specify the default options in PERL_CPANM_OPT environment variable in the shell rc: export PERL_CPANM_OPT="--prompt --reinstall -l ~/perl --mirror http://cpan.cpantesters.org" Type `man cpanm` or `perldoc cpanm` for the more detailed explanation of the options. HELP ! ! Can't write to $Config{installsitelib} and $Config{installsitebin}: Installing modules to $ENV{HOME}/perl5 ! To turn off this warning, you have to do one of the following: ! - run me as a root or with --sudo option (to install to $Config{installsitelib} and $Config{installsitebin}) ! - Configure local::lib in your existing shell to set PERL_MM_OPT etc. ! - Install local::lib by running the following commands ! ! cpanm --local-lib=~/perl5 local::lib && eval \$(perl -I ~/perl5/lib/perl5/ -Mlocal::lib) ! DIAG WARNING: Your lib directory name ($base) contains a space in it. It's known to cause issues with perl builder tools such as local::lib and MakeMaker. You're recommended to rename your directory. WARN $module is not found in the following directories and can't be uninstalled. @{[ join(" \n", map " $_", @inc) ]} DIAG ! Configuring $distname failed. See $self->{log} for details. ! You might have to install the following modules first to get --scandeps working correctly. DIAG MENLO_CLI_COMPAT $fatpacked{"Menlo/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_DEPENDENCY'; package Menlo::Dependency;use strict;use CPAN::Meta::Requirements;use Class::Tiny qw(module version type original_version dist mirror url);sub BUILDARGS {my($class,$module,$version,$type)=@_;return {module=>$module,version=>$version,type=>$type || 'requires',}}sub from_prereqs {my($class,$prereqs,$phases,$types)=@_;my@deps;for my$type (@$types){push@deps,$class->from_versions($prereqs->merged_requirements($phases,[$type])->as_string_hash,$type,)}return@deps}sub from_versions {my($class,$versions,$type)=@_;my@deps;while (my($module,$version)=each %$versions){push@deps,$class->new($module,$version,$type)}@deps}sub merge_with {my($self,$requirements)=@_;$self->original_version($self->version);eval {$requirements->add_string_requirement($self->module,$self->version)};if ($@ =~ /illegal requirements/){warn sprintf("Can't merge requirements for %s: '%s' and '%s'",$self->module,$self->version,$requirements->requirements_for_module($self->module))}$self->version($requirements->requirements_for_module($self->module))}sub requires_version {my$self=shift;if (defined$self->original_version){return$self->original_version}$self->version}sub is_requirement {$_[0]->type eq 'requires'}1; MENLO_DEPENDENCY $fatpacked{"Menlo/Index/MetaCPAN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_METACPAN'; use 5.008001;use strict;use warnings;package Menlo::Index::MetaCPAN;use parent 'CPAN::Common::Index';use Class::Tiny qw/uri include_dev/;use Carp;use HTTP::Tinyish;use JSON::PP ();use Time::Local ();sub BUILD {my$self=shift;my$uri=$self->uri;$uri="https://fastapi.metacpan.org/v1/download_url/" unless defined$uri;$uri =~ s{/?$}{/};$self->uri($uri);return}sub search_packages {my ($self,$args)=@_;Carp::croak("Argument to search_packages must be hash reference")unless ref$args eq 'HASH';my$range;if ($args->{version}){$range="== $args->{version}"}elsif ($args->{version_range}){$range=$args->{version_range}}my%query=(($self->include_dev ? (dev=>1): ()),($range ? (version=>$range): ()),);my$query=join "&",map {"$_=" .$self->_uri_escape($query{$_})}sort keys%query;my$uri=$self->uri .$args->{package}.($query ? "?$query" : "");my$res=HTTP::Tinyish->new->get($uri);return unless$res->{success};my$dist_meta=eval {JSON::PP::decode_json($res->{content})};if ($dist_meta && $dist_meta->{download_url}){(my$distfile=$dist_meta->{download_url})=~ s!.+/authors/id/\w/\w\w/!!;return {package=>$args->{package},version=>$dist_meta->{version},uri=>"cpan:///distfile/$distfile",download_uri=>$self->_download_uri("http://cpan.metacpan.org",$distfile),}}return}sub _parse_date {my($self,$date)=@_;my@date=$date =~ /^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)$/;Time::Local::timegm($date[5],$date[4],$date[3],$date[2],$date[1]- 1,$date[0]- 1900)}sub _uri_escape {my($self,$string)=@_;$string =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;$string}sub _download_uri {my($self,$base,$distfile)=@_;join "/",$base,"authors/id",substr($distfile,0,1),substr($distfile,0,2),$distfile}sub index_age {return time}sub search_authors {return}1; MENLO_INDEX_METACPAN $fatpacked{"Menlo/Index/MetaDB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_METADB'; use 5.008001;use strict;use warnings;package Menlo::Index::MetaDB;our$VERSION="1.9019";use parent 'CPAN::Common::Index';use Class::Tiny qw/uri/;use Carp;use CPAN::Meta::YAML;use CPAN::Meta::Requirements;use HTTP::Tiny;sub BUILD {my$self=shift;my$uri=$self->uri;$uri="http://cpanmetadb.plackperl.org/v1.0/" unless defined$uri;$uri =~ s{/?$}{/};$self->uri($uri);return}sub search_packages {my ($self,$args)=@_;Carp::croak("Argument to search_packages must be hash reference")unless ref$args eq 'HASH';return unless exists$args->{package}&& ref$args->{package}eq '';my$mod=$args->{package};if ($args->{version}|| $args->{version_range}){my$res=HTTP::Tiny->new->get($self->uri ."history/$mod");return unless$res->{success};my$range=defined$args->{version}? "== $args->{version}" : $args->{version_range};my$reqs=CPAN::Meta::Requirements->from_string_hash({$mod=>$range });my@found;for my$line (split /\r?\n/,$res->{content}){if ($line =~ /^$mod\s+(\S+)\s+(\S+)$/){push@found,{version=>$1,version_o=>version::->parse($1),distfile=>$2,}}}return unless@found;$found[-1]->{latest}=1;my$match;for my$try (sort {$b->{version_o}<=> $a->{version_o}}@found){if ($reqs->accepts_module($mod=>$try->{version_o})){$match=$try,last}}if ($match){my$file=$match->{distfile};$file =~ s{^./../}{};return {package=>$mod,version=>$match->{version},uri=>"cpan:///distfile/$file",($match->{latest}? (): (download_uri=>"http://backpan.perl.org/authors/id/$match->{distfile}")),}}}else {my$res=HTTP::Tiny->new->get($self->uri ."package/$mod");return unless$res->{success};if (my$yaml=CPAN::Meta::YAML->read_string($res->{content})){my$meta=$yaml->[0];if ($meta && $meta->{distfile}){my$file=$meta->{distfile};$file =~ s{^./../}{};return {package=>$mod,version=>$meta->{version},uri=>"cpan:///distfile/$file",}}}}return}sub index_age {return time};sub search_authors {return};1; MENLO_INDEX_METADB $fatpacked{"Menlo/Index/Mirror.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_INDEX_MIRROR'; package Menlo::Index::Mirror;use strict;use parent qw(CPAN::Common::Index::Mirror);use Class::Tiny qw(fetcher);use File::Basename ();use File::Spec ();use URI ();our$HAS_IO_UNCOMPRESS_GUNZIP=eval {require IO::Uncompress::Gunzip};my%INDICES=(packages=>'modules/02packages.details.txt.gz',);sub refresh_index {my$self=shift;for my$file (values%INDICES){my$remote=URI->new_abs($file,$self->mirror);$remote =~ s/\.gz$// unless$HAS_IO_UNCOMPRESS_GUNZIP;my$local=File::Spec->catfile($self->cache,File::Basename::basename($file));$self->fetcher->($remote,$local)or Carp::croak("Cannot fetch $remote to $local");if ($HAS_IO_UNCOMPRESS_GUNZIP){(my$uncompressed=$local)=~ s/\.gz$//;IO::Uncompress::Gunzip::gunzip($local,$uncompressed)or Carp::croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"}}}1; MENLO_INDEX_MIRROR $fatpacked{"Menlo/Legacy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_LEGACY'; package Menlo::Legacy;use strict;our$VERSION='1.9020';1; MENLO_LEGACY $fatpacked{"Menlo/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MENLO_UTIL'; package Menlo::Util;use strict;use Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(WIN32);use constant WIN32=>$^O eq 'MSWin32';if (WIN32){require Win32::ShellQuote;*shell_quote=\&Win32::ShellQuote::quote_native}else {require String::ShellQuote;*shell_quote=\&String::ShellQuote::shell_quote_best_effort}1; MENLO_UTIL $fatpacked{"Module/CPANfile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE'; package Module::CPANfile;use strict;use warnings;use Cwd;use Carp ();use Module::CPANfile::Environment;use Module::CPANfile::Requirement;our$VERSION='1.1004';BEGIN {if (${^TAINT}){*untaint=sub {my$str=shift;($str)=$str =~ /^(.+)$/s;$str}}else {*untaint=sub {$_[0]}}}sub new {my($class,$file)=@_;bless {},$class}sub load {my($proto,$file)=@_;my$self=ref$proto ? $proto : $proto->new;$self->parse($file || _default_cpanfile());$self}sub save {my($self,$path)=@_;open my$out,">",$path or die "$path: $!";print {$out}$self->to_string}sub parse {my($self,$file)=@_;my$code=do {open my$fh,"<",$file or die "$file: $!";join '',<$fh>};$code=untaint$code;my$env=Module::CPANfile::Environment->new($file);$env->parse($code)or die $@;$self->{_mirrors}=$env->mirrors;$self->{_prereqs}=$env->prereqs}sub from_prereqs {my($proto,$prereqs)=@_;my$self=$proto->new;$self->{_prereqs}=Module::CPANfile::Prereqs->from_cpan_meta($prereqs);$self}sub mirrors {my$self=shift;$self->{_mirrors}|| []}sub features {my$self=shift;map$self->feature($_),$self->{_prereqs}->identifiers}sub feature {my($self,$identifier)=@_;$self->{_prereqs}->feature($identifier)}sub prereq {shift->prereqs}sub prereqs {my$self=shift;$self->{_prereqs}->as_cpan_meta}sub merged_requirements {my$self=shift;$self->{_prereqs}->merged_requirements}sub effective_prereqs {my($self,$features)=@_;$self->prereqs_with(@{$features || []})}sub prereqs_with {my($self,@feature_identifiers)=@_;my@others=map {$self->feature($_)->prereqs}@feature_identifiers;$self->prereqs->with_merged_prereqs(\@others)}sub prereq_specs {my$self=shift;$self->prereqs->as_string_hash}sub prereq_for_module {my($self,$module)=@_;$self->{_prereqs}->find($module)}sub options_for_module {my($self,$module)=@_;my$prereq=$self->prereq_for_module($module)or return;$prereq->requirement->options}sub merge_meta {my($self,$file,$version)=@_;require CPAN::Meta;$version ||= $file =~ /\.yml$/ ? '1.4' : '2';my$prereq=$self->prereqs;my$meta=CPAN::Meta->load_file($file);my$prereqs_hash=$prereq->with_merged_prereqs($meta->effective_prereqs)->as_string_hash;my$struct={%{$meta->as_struct},prereqs=>$prereqs_hash };CPAN::Meta->new($struct)->save($file,{version=>$version })}sub _d($) {require Data::Dumper;chomp(my$value=Data::Dumper->new([$_[0]])->Terse(1)->Dump);$value}sub _default_cpanfile {my$file=Cwd::abs_path('cpanfile');untaint$file}sub to_string {my($self,$include_empty)=@_;my$mirrors=$self->mirrors;my$prereqs=$self->prereq_specs;my$code='';$code .= $self->_dump_mirrors($mirrors);$code .= $self->_dump_prereqs($prereqs,$include_empty);for my$feature ($self->features){$code .= "feature @{[ _d $feature->{identifier} ]}, @{[ _d $feature->{description} ]} => sub {\n";$code .= $self->_dump_prereqs($feature->{prereqs}->as_string_hash,$include_empty,4);$code .= "};\n\n"}$code =~ s/\n+$/\n/s;$code}sub _dump_mirrors {my($self,$mirrors)=@_;my$code="";for my$url (@$mirrors){$code .= "mirror @{[ _d $url ]};\n"}$code =~ s/\n+$/\n/s;$code}sub _dump_prereqs {my($self,$prereqs,$include_empty,$base_indent)=@_;my$code='';for my$phase (qw(runtime configure build test develop)){my$indent=$phase eq 'runtime' ? '' : ' ';$indent .= (' ' x ($base_indent || 0));my($phase_code,$requirements);$phase_code .= "on $phase => sub {\n" unless$phase eq 'runtime';for my$type (qw(requires recommends suggests conflicts)){for my$mod (sort keys %{$prereqs->{$phase}{$type}}){my$ver=$prereqs->{$phase}{$type}{$mod};$phase_code .= $ver eq '0' ? "${indent}$type @{[ _d $mod ]}" : "${indent}$type @{[ _d $mod ]}, @{[ _d $ver ]}";my$options=$self->options_for_module($mod)|| {};if (%$options){my@opts;for my$key (keys %$options){my$k=$key =~ /^[a-zA-Z0-9_]+$/ ? $key : _d$key;push@opts,"$k => @{[ _d $options->{$k} ]}"}$phase_code .= ",\n" .join(",\n",map " $indent$_",@opts)}$phase_code .= ";\n";$requirements++}}$phase_code .= "\n" unless$requirements;$phase_code .= "};\n" unless$phase eq 'runtime';$code .= $phase_code ."\n" if$requirements or $include_empty}$code =~ s/\n+$/\n/s;$code}1; MODULE_CPANFILE $fatpacked{"Module/CPANfile/Environment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_ENVIRONMENT'; package Module::CPANfile::Environment;use strict;use warnings;use Module::CPANfile::Prereqs;use Carp ();my@bindings=qw(on requires recommends suggests conflicts feature osname mirror configure_requires build_requires test_requires author_requires);my$file_id=1;sub new {my($class,$file)=@_;bless {file=>$file,phase=>'runtime',feature=>undef,features=>{},prereqs=>Module::CPANfile::Prereqs->new,mirrors=>[],},$class}sub bind {my$self=shift;my$pkg=caller;for my$binding (@bindings){no strict 'refs';*{"$pkg\::$binding"}=sub {$self->$binding(@_)}}}sub parse {my($self,$code)=@_;my$err;{local $@;$file_id++;$self->_evaluate(<{file} failed: $err"};return 1}sub _evaluate {my$_environment=$_[0];eval $_[1]}sub prereqs {$_[0]->{prereqs}}sub mirrors {$_[0]->{mirrors}}sub on {my($self,$phase,$code)=@_;local$self->{phase}=$phase;$code->()}sub feature {my($self,$identifier,$description,$code)=@_;if (@_==3 && ref($description)eq 'CODE'){$code=$description;$description=$identifier}unless (ref$description eq '' && ref$code eq 'CODE'){Carp::croak("Usage: feature 'identifier', 'Description' => sub { ... }")}local$self->{feature}=$identifier;$self->prereqs->add_feature($identifier,$description);$code->()}sub osname {die "TODO"}sub mirror {my($self,$url)=@_;push @{$self->{mirrors}},$url}sub requirement_for {my($self,$module,@args)=@_;my$requirement=0;$requirement=shift@args if@args % 2;return Module::CPANfile::Requirement->new(name=>$module,version=>$requirement,@args,)}sub requires {my$self=shift;$self->add_prereq(requires=>@_)}sub recommends {my$self=shift;$self->add_prereq(recommends=>@_)}sub suggests {my$self=shift;$self->add_prereq(suggests=>@_)}sub conflicts {my$self=shift;$self->add_prereq(conflicts=>@_)}sub add_prereq {my($self,$type,$module,@args)=@_;$self->prereqs->add(feature=>$self->{feature},phase=>$self->{phase},type=>$type,module=>$module,requirement=>$self->requirement_for($module,@args),)}sub configure_requires {my($self,@args)=@_;$self->on(configure=>sub {$self->requires(@args)})}sub build_requires {my($self,@args)=@_;$self->on(build=>sub {$self->requires(@args)})}sub test_requires {my($self,@args)=@_;$self->on(test=>sub {$self->requires(@args)})}sub author_requires {my($self,@args)=@_;$self->on(develop=>sub {$self->requires(@args)})}1; package Module::CPANfile::Sandbox$file_id; no warnings; BEGIN { \$_environment->bind } # line 1 "$self->{file}" $code; EVAL MODULE_CPANFILE_ENVIRONMENT $fatpacked{"Module/CPANfile/Prereq.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_PREREQ'; package Module::CPANfile::Prereq;use strict;sub new {my($class,%options)=@_;bless \%options,$class}sub feature {$_[0]->{feature}}sub phase {$_[0]->{phase}}sub type {$_[0]->{type}}sub module {$_[0]->{module}}sub requirement {$_[0]->{requirement}}1; MODULE_CPANFILE_PREREQ $fatpacked{"Module/CPANfile/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_PREREQS'; package Module::CPANfile::Prereqs;use strict;use Carp ();use CPAN::Meta::Feature;use Module::CPANfile::Prereq;sub from_cpan_meta {my($class,$prereqs)=@_;my$self=$class->new;for my$phase (keys %$prereqs){for my$type (keys %{$prereqs->{$phase}}){while (my($module,$requirement)=each %{$prereqs->{$phase}{$type}}){$self->add(phase=>$phase,type=>$type,module=>$module,requirement=>Module::CPANfile::Requirement->new(name=>$module,version=>$requirement),)}}}$self}sub new {my$class=shift;bless {prereqs=>{},features=>{},},$class}sub add_feature {my($self,$identifier,$description)=@_;$self->{features}{$identifier}={description=>$description }}sub add {my($self,%args)=@_;my$feature=$args{feature}|| '';push @{$self->{prereqs}{$feature}},Module::CPANfile::Prereq->new(%args)}sub as_cpan_meta {my$self=shift;$self->{cpanmeta}||= $self->build_cpan_meta}sub build_cpan_meta {my($self,$feature)=@_;CPAN::Meta::Prereqs->new($self->specs($feature))}sub specs {my($self,$feature)=@_;$feature='' unless defined$feature;my$prereqs=$self->{prereqs}{$feature}|| [];my$specs={};for my$prereq (@$prereqs){$specs->{$prereq->phase}{$prereq->type}{$prereq->module}=$prereq->requirement->version}return$specs}sub merged_requirements {my$self=shift;my$reqs=CPAN::Meta::Requirements->new;for my$prereq (@{$self->{prereqs}}){$reqs->add_string_requirement($prereq->module,$prereq->requirement->version)}$reqs}sub find {my($self,$module)=@_;for my$feature ('',keys %{$self->{features}}){for my$prereq (@{$self->{prereqs}{$feature}}){return$prereq if$prereq->module eq $module}}return}sub identifiers {my$self=shift;keys %{$self->{features}}}sub feature {my($self,$identifier)=@_;my$data=$self->{features}{$identifier}or Carp::croak("Unknown feature '$identifier'");my$prereqs=$self->build_cpan_meta($identifier);CPAN::Meta::Feature->new($identifier,{description=>$data->{description},prereqs=>$prereqs->as_string_hash,})}1; MODULE_CPANFILE_PREREQS $fatpacked{"Module/CPANfile/Requirement.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_REQUIREMENT'; package Module::CPANfile::Requirement;use strict;sub new {my ($class,%args)=@_;$args{version}||= 0;bless +{name=>delete$args{name},version=>delete$args{version},options=>\%args,},$class}sub name {$_[0]->{name}}sub version {$_[0]->{version}}sub options {$_[0]->{options}}sub has_options {keys %{$_[0]->{options}}> 0}1; MODULE_CPANFILE_REQUIREMENT $fatpacked{"Module/Load.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_LOAD'; package Module::Load;$VERSION='0.32';use strict;use warnings;use File::Spec ();sub import {my$who=_who();my$h;shift;{no strict 'refs';@_ or (*{"${who}::load"}=\&load,*{"${who}::autoload"}=\&autoload,return);map {$h->{$_}=()if defined $_}@_;(exists$h->{none}or exists$h->{''})and shift,last;((exists$h->{autoload}and shift,1)or (exists$h->{all}and shift))and *{"${who}::autoload"}=\&autoload;((exists$h->{load}and shift,1)or exists$h->{all})and *{"${who}::load"}=\&load;((exists$h->{load_remote}and shift,1)or exists$h->{all})and *{"${who}::load_remote"}=\&load_remote;((exists$h->{autoload_remote}and shift,1)or exists$h->{all})and *{"${who}::autoload_remote"}=\&autoload_remote}}sub load(*;@){goto&_load}sub autoload(*;@){unshift @_,'autoimport';goto&_load}sub load_remote($$;@){my ($dst,$src,@exp)=@_;eval "package $dst;Module::Load::load('$src', qw/@exp/);";$@ && die "$@"}sub autoload_remote($$;@){my ($dst,$src,@exp)=@_;eval "package $dst;Module::Load::autoload('$src', qw/@exp/);";$@ && die "$@"}sub _load{my$autoimport=$_[0]eq 'autoimport' and shift;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}}{no strict 'refs';my$import;((@_ or $autoimport)and ($import=$mod->can('import'))and (unshift(@_,$mod),goto &$import,return))}}sub _to_file{local $_=shift;my$pm=shift || '';my@parts=split /::|'/,$_,-1;shift@parts if@parts &&!$parts[0];my$file=$^O eq 'MSWin32' ? join "/",@parts : File::Spec->catfile(@parts);$file .= '.pm' if$pm;$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}1; MODULE_LOAD $fatpacked{"Module/Load/Conditional.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_LOAD_CONDITIONAL'; package Module::Load::Conditional;use strict;use Module::Load qw/load autoload_remote/;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';use constant ON_WIN32=>$^O eq 'MSWin32' ? 1 : 0;use constant QUOTE=>do {ON_WIN32 ? q["] : q[']};BEGIN {use vars qw[$VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED $FIND_VERSION $ERROR $CHECK_INC_HASH $FORCE_SAFE_INC];use Exporter;@ISA=qw[Exporter];$VERSION='0.68';$VERBOSE=0;$DEPRECATED=0;$FIND_VERSION=1;$CHECK_INC_HASH=0;$FORCE_SAFE_INC=0;@EXPORT_OK=qw[check_install can_load requires]}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';my$href={file=>undef,version=>undef,uptodate=>undef,};my$filename;if($CHECK_INC_HASH){$filename=$href->{'file'}=$INC{$file_inc }if defined$INC{$file_inc };if(defined$filename && $FIND_VERSION){no strict 'refs';$href->{version}=${"$args->{module}"."::VERSION"}}}unless($filename){local@INC=@INC[0..$#INC-1]if$FORCE_SAFE_INC && $INC[-1]eq '.';DIR: for my$dir (@INC){my$fh;if (ref$dir){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}}$href->{dir}=$dir;$href->{file}=ON_VMS ? VMS::Filespec::unixify($filename): $filename;last DIR unless$FIND_VERSION;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}}}return unless defined$href->{file};if($FIND_VERSION and not defined$href->{version}){{local $^W;warn loc(q[Could not check version on '%1'],$args->{module})if$args->{verbose}and $args->{version}> 0}$href->{uptodate}=1}else {local $^W;eval {$href->{uptodate}=version->new($args->{version})<= version->new($href->{version})? 1 : 0}}if ($DEPRECATED and "$]" >= 5.011){local@INC=@INC[0..$#INC-1]if$FORCE_SAFE_INC && $INC[-1]eq '.';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}and $Config::Config{privlibexp}ne $Config::Config{sitelibexp}}return$href}sub can_load {my%hash=@_;my$tmpl={modules=>{default=>{},strict_type=>1 },verbose=>{default=>$VERBOSE },nocache=>{default=>0 },autoload=>{default=>0 },};my$args;unless($args=check($tmpl,\%hash,$VERBOSE)){$ERROR=loc(q[Problem validating arguments!]);warn$ERROR if$VERBOSE;return}$CACHE ||= {};my$error;BLOCK: {my$href=$args->{modules};my@load;for my$mod (keys %$href){next if$CACHE->{$mod}->{usable}&&!$args->{nocache};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}){local@INC=@INC[0..$#INC-1]if$FORCE_SAFE_INC && $INC[-1]eq '.';if ($args->{autoload}){my$who=(caller())[0];eval {autoload_remote$who,$mod}}else {eval {load$mod}}if($@){$error=$@;$CACHE->{$mod}->{usable}=0;last BLOCK}else {$CACHE->{$mod}->{usable}=1}}else {$error=loc(q[Module '%1' is not uptodate!],$mod);$CACHE->{$mod}->{usable}=0;last BLOCK}}}if(defined$error){$ERROR=$error;Carp::carp(loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error))if$args->{verbose};return}else {return 1}}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}local@INC=@INC[0..$#INC-1]if$FORCE_SAFE_INC && $INC[-1]eq '.';my$lib=join " ",map {qq["-I$_"]}@INC;my$oneliner='print(join(qq[\n],map{qq[BONG=$_]}keys(%INC)),qq[\n])';my$cmd=join '',qq["$^X" $lib -M$who -e],QUOTE,$oneliner,QUOTE;return sort grep {!/^$who$/}map {chomp;s|/|::|g;$_}grep {s|\.pm$||i}map {s!^BONG\=!!;$_}grep {m!^BONG\=!}`$cmd`}1; MODULE_LOAD_CONDITIONAL $fatpacked{"Module/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_METADATA'; package Module::Metadata;sub __clean_eval {eval $_[0]}use strict;use warnings;our$VERSION='1.000033';use Carp qw/croak/;use File::Spec;BEGIN {eval {require Fcntl;Fcntl->import('SEEK_SET');1}or *SEEK_SET=sub {0}}use version 0.87;BEGIN {if ($INC{'Log/Contextual.pm'}){require "Log/Contextual/WarnLogger.pm";Log::Contextual->import('log_info','-default_logger'=>Log::Contextual::WarnLogger->new({env_prefix=>'MODULE_METADATA',}),)}else {*log_info=sub (&) {warn $_[0]->()}}}use File::Find qw(find);my$V_NUM_REGEXP=qr{v?[0-9._]+};my$PKG_FIRST_WORD_REGEXP=qr{ # the FIRST word in a package name [a-zA-Z_] # the first word CANNOT start with a digit (?: [\w']? # can contain letters, digits, _, or ticks \w # But, NO multi-ticks or trailing ticks )* }x;my$PKG_ADDL_WORD_REGEXP=qr{ # the 2nd+ word in a package name \w # the 2nd+ word CAN start with digits (?: [\w']? # and can contain letters or ticks \w # But, NO multi-ticks or trailing ticks )* }x;my$PKG_NAME_REGEXP=qr{ # match a package name (?: :: )? # a pkg name can start with arisdottle $PKG_FIRST_WORD_REGEXP # a package word (?: (?: :: )+ ### arisdottle (allow one or many times) $PKG_ADDL_WORD_REGEXP ### a package word )* # ^ zero, one or many times (?: :: # allow trailing arisdottle )? }x;my$PKG_REGEXP=qr{ # match a package declaration ^[\s\{;]* # intro chars on a line package # the word 'package' \s+ # whitespace ($PKG_NAME_REGEXP) # a package name \s* # optional whitespace ($V_NUM_REGEXP)? # optional version number \s* # optional whitesapce [;\{] # semicolon line terminator or block start (since 5.16) }x;my$VARNAME_REGEXP=qr{ # match fully-qualified VERSION name ([\$*]) # sigil - $ or * ( ( # optional leading package name (?:::|\')? # possibly starting like just :: (a la $::VERSION) (?:\w+(?:::|\'))* # Foo::Bar:: ... )? VERSION )\b }x;my$VERS_REGEXP=qr{ # match a VERSION definition (?: \(\s*$VARNAME_REGEXP\s*\) # with parens | $VARNAME_REGEXP # without parens ) \s* =[^=~>] # = but not ==, nor =~, nor => }x;sub new_from_file {my$class=shift;my$filename=File::Spec->rel2abs(shift);return undef unless defined($filename)&& -f $filename;return$class->_init(undef,$filename,@_)}sub new_from_handle {my$class=shift;my$handle=shift;my$filename=shift;return undef unless defined($handle)&& defined($filename);$filename=File::Spec->rel2abs($filename);return$class->_init(undef,$filename,@_,handle=>$handle)}sub new_from_module {my$class=shift;my$module=shift;my%props=@_;$props{inc}||= \@INC;my$filename=$class->find_module_by_name($module,$props{inc});return undef unless defined($filename)&& -f $filename;return$class->_init($module,$filename,%props)}{my$compare_versions=sub {my ($v1,$op,$v2)=@_;$v1=version->new($v1)unless UNIVERSAL::isa($v1,'version');my$eval_str="\$v1 $op \$v2";my$result=eval$eval_str;log_info {"error comparing versions: '$eval_str' $@"}if $@;return$result};my$normalize_version=sub {my ($version)=@_;if ($version =~ /[=<>!,]/){}elsif (ref$version eq 'version'){$version=$version->is_qv ? $version->normal : $version->stringify}elsif ($version =~ /^[^v][^.]*\.[^.]+\./){$version="v$version"}else {}return$version};my$resolve_module_versions=sub {my$packages=shift;my($file,$version);my$err='';for my$p (@$packages){if (defined($p->{version})){if (defined($version)){if ($compare_versions->($version,'!=',$p->{version})){$err .= " $p->{file} ($p->{version})\n"}else {}}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})}if (length$args{prefix}){$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)}my(%prime,%alt);for 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);for my$package ($pm_info->packages_inside){next if$package eq 'main';next if$package eq 'DB';next if grep /^_/,split(/::/,$package);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,})}}}for my$package (keys(%alt)){my$result=$resolve_module_versions->($alt{$package});if (exists($prime{$package})){if ($result->{err}){log_info {"Found conflicting versions for package '$package'\n" ." $prime{$package}{file} ($prime{$package}{version})\n" .$result->{err}}}elsif (defined($result->{version})){if (exists($prime{$package}{version})&& defined($prime{$package}{version})){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 {$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}}}else {}}else {if ($result->{err}){log_info {"Found conflicting versions for package '$package'\n" .$result->{err}}}$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}if defined($result->{version})}}for (grep defined $_->{version},values%prime){$_->{version}=$normalize_version->($_->{version})}return \%prime}}sub _init {my$class=shift;my$module=shift;my$filename=shift;my%props=@_;my$handle=delete$props{handle};my(%valid_props,@valid_props);@valid_props=qw(collect_pod inc);@valid_props{@valid_props}=delete(@props{@valid_props});warn "Unknown properties: @{[keys %props]}\n" if scalar(%props);my%data=(module=>$module,filename=>$filename,version=>undef,packages=>[],versions=>{},pod=>{},pod_headings=>[],collect_pod=>0,%valid_props,);my$self=bless(\%data,$class);if (not $handle){my$filename=$self->{filename};open$handle,'<',$filename or croak("Can't open '$filename': $!");$self->_handle_bom($handle,$filename)}$self->_parse_fh($handle);@{$self->{packages}}=__uniq(@{$self->{packages}});unless($self->{module}and length($self->{module})){if ($self->{filename}=~ /\.pm$/){my ($v,$d,$f)=File::Spec->splitpath($self->{filename});$f =~ s/\..+$//;my@candidates=grep /(^|::)$f$/,@{$self->{packages}};$self->{module}=shift(@candidates)}else {if ((grep /main/,@{$self->{packages}})or (grep /main/,keys %{$self->{versions}})){$self->{module}='main'}else {$self->{module}=$self->{packages}[0]|| ''}}}$self->{version}=$self->{versions}{$self->{module}}if defined($self->{module});return$self}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));for my$dir (@$dirs){my$testfile=File::Spec->catfile($dir,$file);return [File::Spec->rel2abs($testfile),$dir ]if -e $testfile and!-d _;$testfile .= '.pm';return [File::Spec->rel2abs($testfile),$dir ]if -e $testfile}return}sub find_module_by_name {my$found=shift()->_do_find_module(@_)or return;return$found->[0]}sub find_module_dir_by_name {my$found=shift()->_do_find_module(@_)or return;return$found->[1]}sub _parse_version_expression {my$self=shift;my$line=shift;my($sigil,$variable_name,$package);if ($line =~ /$VERS_REGEXP/o){($sigil,$variable_name,$package)=$2 ? ($1,$2,$3): ($4,$5,$6);if ($package){$package=($package eq '::')? 'main' : $package;$package =~ s/::$//}}return ($sigil,$variable_name,$package)}sub _handle_bom {my ($self,$fh,$filename)=@_;my$pos=tell$fh;return unless defined$pos;my$buf=' ' x 2;my$count=read$fh,$buf,length$buf;return unless defined$count and $count >= 2;my$encoding;if ($buf eq "\x{FE}\x{FF}"){$encoding='UTF-16BE'}elsif ($buf eq "\x{FF}\x{FE}"){$encoding='UTF-16LE'}elsif ($buf eq "\x{EF}\x{BB}"){$buf=' ';$count=read$fh,$buf,length$buf;if (defined$count and $count >= 1 and $buf eq "\x{BF}"){$encoding='UTF-8'}}if (defined$encoding){if ("$]" >= 5.008){binmode($fh,":encoding($encoding)")}}else {seek$fh,$pos,SEEK_SET or croak(sprintf "Can't reset position to the top of '$filename'")}return$encoding}sub _parse_fh {my ($self,$fh)=@_;my($in_pod,$seen_end,$need_vers)=(0,0,0);my(@packages,%vers,%pod,@pod);my$package='main';my$pod_sect='';my$pod_data='';my$in_end=0;while (defined(my$line=<$fh>)){my$line_num=$.;chomp($line);my$is_cut;if ($line =~ /^=([a-zA-Z].*)/){my$cmd=$1;$is_cut=$cmd =~ /^cut(?:[^a-zA-Z]|$)/;$in_pod=!$is_cut}if ($in_pod){if ($line =~ /^=head[1-4]\s+(.+)\s*$/){push(@pod,$1);if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data;$pod_data=''}$pod_sect=$1}elsif ($self->{collect_pod}){$pod_data .= "$line\n"}next}elsif ($is_cut){if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data;$pod_data=''}$pod_sect='';next}next if$in_end;next if$line =~ /^\s*#/;if ($line eq '__END__'){$in_end++;next}last if$line eq '__DATA__';my($version_sigil,$version_fullname,$version_package)=index($line,'VERSION')>= 1 ? $self->_parse_version_expression($line): ();if ($line =~ /$PKG_REGEXP/o){$package=$1;my$version=$2;push(@packages,$package)unless grep($package eq $_,@packages);$need_vers=defined$version ? 0 : 1;if (not exists$vers{$package}and defined$version){my$dwim_version=eval {_dwim_version($version)};croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n" unless defined$dwim_version;$vers{$package}=$dwim_version}}elsif ($version_fullname && $version_package){$need_vers=0 if$version_package eq $package;unless (defined$vers{$version_package}&& length$vers{$version_package}){$vers{$version_package}=$self->_evaluate_version_line($version_sigil,$version_fullname,$line)}}elsif ($package eq 'main' && $version_fullname &&!exists($vers{main})){$need_vers=0;my$v=$self->_evaluate_version_line($version_sigil,$version_fullname,$line);$vers{$package}=$v;push(@packages,'main')}elsif ($package eq 'main' &&!exists($vers{main})&& $line =~ /\w/){$need_vers=1;$vers{main}='';push(@packages,'main')}elsif ($version_fullname && $need_vers){$need_vers=0;my$v=$self->_evaluate_version_line($version_sigil,$version_fullname,$line);unless (defined$vers{$package}&& length$vers{$package}){$vers{$package}=$v}}}if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data}$self->{versions}=\%vers;$self->{packages}=\@packages;$self->{pod}=\%pod;$self->{pod_headings}=\@pod}sub __uniq (@) {my (%seen,$key);grep {not $seen{$key=$_ }++}@_}{my$pn=0;sub _evaluate_version_line {my$self=shift;my($sigil,$variable_name,$line)=@_;$pn++;my$eval=qq{ my \$dummy = q# Hide from _packages_inside() #; package Module::Metadata::_version::p${pn}; use version; sub { local $sigil$variable_name; $line; return \$$variable_name if defined \$$variable_name; return \$Module::Metadata::_version::p${pn}::$variable_name; }; };$eval=$1 if$eval =~ m{^(.+)}s;local $^W;my$vsub=__clean_eval($eval);if ($@ =~ /Can't locate/ && -d 'lib'){local@INC=('lib',@INC);$vsub=__clean_eval($eval)}warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;(ref($vsub)eq 'CODE')or croak "failed to build version sub for $self->{filename}";my$result=eval {$vsub->()};croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@;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;return$version}}{my@version_prep=(sub {return shift},sub {my$v=shift;$v =~ s{([0-9])[a-z-].*$}{$1}i;return$v},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},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 $@;last if defined$version}croak$error unless defined$version;return$version}}sub name {$_[0]->{module}}sub filename {$_[0]->{filename}}sub packages_inside {@{$_[0]->{packages}}}sub pod_inside {@{$_[0]->{pod_headings}}}sub contains_pod {0+@{$_[0]->{pod_headings}}}sub version {my$self=shift;my$mod=shift || $self->{module};my$vers;if (defined($mod)&& length($mod)&& exists($self->{versions}{$mod})){return$self->{versions}{$mod}}else {return undef}}sub pod {my$self=shift;my$sect=shift;if (defined($sect)&& length($sect)&& exists($self->{pod}{$sect})){return$self->{pod}{$sect}}else {return undef}}sub is_indexable {my ($self,$package)=@_;my@indexable_packages=grep {$_ ne 'main'}$self->packages_inside;return!!grep {$_ eq $package}@indexable_packages if$package;return!!@indexable_packages}1; MODULE_METADATA $fatpacked{"Params/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'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.38';$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|;sub check {my ($utmpl,$href,$verbose)=@_;_clear_error();if (!$utmpl or!$href){_store_error(loc('check() expects two arguments'));return unless$WARNINGS_FATAL;croak(__PACKAGE__->last_error)}$verbose ||= $VERBOSE || 0;my$args;if($PRESERVE_CASE and!$STRIP_LEADING_DASHES){$args=$href}else {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;my@want_store;my$fail;for my$key (keys %$utmpl){my$tmpl=$utmpl->{$key};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);$fail++;next}$defs{$key}=$tmpl->{'default'}if exists$tmpl->{'default'};if($SANITY_CHECK_TEMPLATE){map {_store_error(loc(q|Template type '%1' not supported [at key '%2']|,$_,$key),1,0)}grep {not $known_keys{$_}}keys %$tmpl;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'}}return if$fail;my$wrong;my$warned;for my$key (keys %$args){my$arg=$args->{$key};unless($utmpl->{$key}){if($ALLOW_UNKNOWN){$defs{$key}=$arg}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}my%tmpl=%{$utmpl->{$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}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}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}if(exists$tmpl{'allow'}and not do {local$_ERROR_STRING;allow($arg,$tmpl{'allow'})}){_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}$defs{$key}=$arg}croak(__PACKAGE__->last_error)if ($wrong || $warned)&& $WARNINGS_FATAL;return if$wrong;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}sub allow {if(ref $_[1]eq 'Regexp'){local $^W;return if $_[0]!~ /$_[1]/}elsif (ref $_[1]eq 'CODE'){return unless $_[1]->($_[0])}elsif (ref $_[1]eq 'ARRAY'){for (@{$_[1]}){return 1 if allow($_[0],$_)}return}else {return unless _safe_eq($_[0],$_[1])}return 1}sub _safe_eq {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'}{$_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; PARAMS_CHECK $fatpacked{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META'; use 5.008001;use strict;use warnings;package Parse::CPAN::Meta;our$VERSION='2.150010';use Exporter;use Carp 'croak';our@ISA=qw/Exporter/;our@EXPORT_OK=qw/Load LoadFile/;sub load_file {my ($class,$filename)=@_;my$meta=_slurp($filename);if ($filename =~ /\.ya?ml$/){return$class->load_yaml_string($meta)}elsif ($filename =~ /\.json$/){return$class->load_json_string($meta)}else {$class->load_string($meta)}}sub load_string {my ($class,$string)=@_;if ($string =~ /^---/){return$class->load_yaml_string($string)}elsif ($string =~ /^\s*\{/){return$class->load_json_string($string)}else {return$class->load_yaml_string($string)}}sub load_yaml_string {my ($class,$string)=@_;my$backend=$class->yaml_backend();my$data=eval {no strict 'refs';&{"$backend\::Load"}($string)};croak $@ if $@;return$data || {}}sub load_json_string {my ($class,$string)=@_;require Encode;my$encoded=Encode::encode('UTF-8',$string,Encode::PERLQQ());my$data=eval {$class->json_decoder()->can('decode_json')->($encoded)};croak $@ if $@;return$data || {}}sub yaml_backend {if ($ENV{PERL_CORE}or not defined$ENV{PERL_YAML_BACKEND}){_can_load('CPAN::Meta::YAML',0.011)or croak "CPAN::Meta::YAML 0.011 is not available\n";return "CPAN::Meta::YAML"}else {my$backend=$ENV{PERL_YAML_BACKEND};_can_load($backend)or croak "Could not load PERL_YAML_BACKEND '$backend'\n";$backend->can("Load")or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";return$backend}}sub json_decoder {if ($ENV{PERL_CORE}){_can_load('JSON::PP'=>2.27300)or croak "JSON::PP 2.27300 is not available\n";return 'JSON::PP'}if (my$decoder=$ENV{CPAN_META_JSON_DECODER}){_can_load($decoder)or croak "Could not load CPAN_META_JSON_DECODER '$decoder'\n";$decoder->can('decode_json')or croak "No decode_json sub provided by CPAN_META_JSON_DECODER '$decoder'\n";return$decoder}return $_[0]->json_backend}sub json_backend {if ($ENV{PERL_CORE}){_can_load('JSON::PP'=>2.27300)or croak "JSON::PP 2.27300 is not available\n";return 'JSON::PP'}if (my$backend=$ENV{CPAN_META_JSON_BACKEND}){_can_load($backend)or croak "Could not load CPAN_META_JSON_BACKEND '$backend'\n";$backend->can('new')or croak "No constructor provided by CPAN_META_JSON_BACKEND '$backend'\n";return$backend}if (!$ENV{PERL_JSON_BACKEND}or $ENV{PERL_JSON_BACKEND}eq 'JSON::PP'){_can_load('JSON::PP'=>2.27300)or croak "JSON::PP 2.27300 is not available\n";return 'JSON::PP'}else {_can_load('JSON'=>2.5)or croak "JSON 2.5 is required for " ."\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";return "JSON"}}sub _slurp {require Encode;open my$fh,"<:raw","$_[0]" or die "can't open $_[0] for reading: $!";my$content=do {local $/;<$fh>};$content=Encode::decode('UTF-8',$content,Encode::PERLQQ());return$content}sub _can_load {my ($module,$version)=@_;(my$file=$module)=~ s{::}{/}g;$file .= ".pm";return 1 if$INC{$file};return 0 if exists$INC{$file};eval {require$file;1}or return 0;if (defined$version){eval {$module->VERSION($version);1}or return 0}return 1}sub LoadFile ($) {return Load(_slurp(shift))}sub Load ($) {require CPAN::Meta::YAML;my$object=eval {CPAN::Meta::YAML::Load(shift)};croak $@ if $@;return$object}1; PARSE_CPAN_META $fatpacked{"Parse/PMFile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_PMFILE'; package Parse::PMFile;sub __clean_eval {eval $_[0]}use strict;use warnings;use Safe;use JSON::PP ();use Dumpvalue;use version ();use File::Spec ();our$VERSION='0.41';our$VERBOSE=0;our$ALLOW_DEV_VERSION=0;our$FORK=0;our$UNSAFE=$] < 5.010000 ? 1 : 0;sub new {my ($class,$meta,$opts)=@_;bless {%{$opts || {}},META_CONTENT=>$meta},$class}sub parse {my ($self,$pmfile)=@_;$pmfile =~ s|\\|/|g;my($filemtime)=(stat$pmfile)[9];$self->{MTIME}=$filemtime;$self->{PMFILE}=$pmfile;unless ($self->_version_from_meta_ok){my$version;unless (eval {$version=$self->_parse_version;1}){$self->_verbose(1,"error with version in $pmfile: $@");return}$self->{VERSION}=$version;if ($self->{VERSION}=~ /^\{.*\}$/){}elsif ($self->{VERSION}=~ /[_\s]/ &&!$self->{ALLOW_DEV_VERSION}&&!$ALLOW_DEV_VERSION){return}}my($ppp)=$self->_packages_per_pmfile;my@keys_ppp=$self->_filter_ppps(sort keys %$ppp);$self->_verbose(1,"Will check keys_ppp[@keys_ppp]\n");my ($package,%errors);my%checked_in;DBPACK: foreach$package (@keys_ppp){if ($package !~ /^\w[\w\:\']*\w?\z/ || $package !~ /\w\z/ || $package =~ /:/ && $package !~ /::/ || $package =~ /\w:\w/ || $package =~ /:::/){$self->_verbose(1,"Package[$package] did not pass the ultimate sanity check");delete$ppp->{$package};next}if ($self->{USERID}&& $self->{PERMISSIONS}&&!$self->_perm_check($package)){delete$ppp->{$package};next}{my (undef,$module)=split m{/lib/},$self->{PMFILE},2;if ($module){$module =~ s{\.pm\z}{};$module =~ s{/}{::}g;if (lc$module eq lc$package && $module ne $package){$errors{$package}={indexing_warning=>"Capitalization of package ($package) does not match filename!",infile=>$self->{PMFILE},}}}}my$pp=$ppp->{$package};if ($pp->{version}&& $pp->{version}=~ /^\{.*\}$/){my$err=JSON::PP::decode_json($pp->{version});if ($err->{x_normalize}){$errors{$package}={normalize=>$err->{version},infile=>$pp->{infile},};$pp->{version}="undef"}elsif ($err->{openerr}){$pp->{version}="undef";$self->_verbose(1,qq{Parse::PMFile was not able to read the file. It issued the following error: C< $err->{r} >},);$errors{$package}={open=>$err->{r},infile=>$pp->{infile},}}else {$pp->{version}="undef";$self->_verbose(1,qq{Parse::PMFile was not able to parse the following line in that file: C< $err->{line} > Note: the indexer is running in a Safe compartement and cannot provide the full functionality of perl in the VERSION line. It is trying hard, but sometime it fails. As a workaround, please consider writing a META.yml that contains a 'provides' attribute or contact the CPAN admins to investigate (yet another) workaround against "Safe" limitations.)},);$errors{$package}={parse_version=>$err->{line},infile=>$err->{file},}}}for ($package,$pp->{version},){if (!defined || /^\s*$/ || /\s/){delete$ppp->{$package};next}}unless ($self->_version_ok($pp)){$errors{$package}={long_version=>qq{Version string exceeds maximum allowed length of 16b: "$pp->{version}"},infile=>$pp->{infile},};next}$checked_in{$package}=$ppp->{$package}}return (wantarray && %errors)? (\%checked_in,\%errors): \%checked_in}sub _version_ok {my ($self,$pp)=@_;return if length($pp->{version}|| 0)> 16;return 1}sub _perm_check {my ($self,$package)=@_;my$userid=$self->{USERID};my$module=$self->{PERMISSIONS}->module_permissions($package);return 1 if!$module;return 1 if defined$module->m && $module->m eq $userid;return 1 if defined$module->f && $module->f eq $userid;return 1 if defined$module->c && grep {$_ eq $userid}@{$module->c};return}sub _parse_version {my$self=shift;use strict;my$pmfile=$self->{PMFILE};my$tmpfile=File::Spec->catfile(File::Spec->tmpdir,"ParsePMFile$$" .rand(1000));my$pmcp=$pmfile;for ($pmcp){s/([^\\](\\\\)*)@/$1\\@/g}my($v);{package main;my$pid;if ($self->{FORK}|| $FORK){$pid=fork();die "Can't fork: $!" unless defined$pid}if ($pid){waitpid($pid,0);if (open my$fh,'<',$tmpfile){$v=<$fh>}}else {my($comp)=Safe->new;my$eval=qq{ local(\$^W) = 0; Parse::PMFile::_parse_version_safely("$pmcp"); };$comp->permit("entereval");$comp->share("*Parse::PMFile::_parse_version_safely");$comp->share("*version::new");$comp->share("*version::numify");$comp->share_from('main',['*version::','*charstar::','*Exporter::','*DynaLoader::']);$comp->share_from('version',['&qv']);$comp->permit(":base_math");$comp->deny(qw/enteriter iter unstack goto/);version->import('qv')if$self->{UNSAFE}|| $UNSAFE;{no strict;$v=($self->{UNSAFE}|| $UNSAFE)? eval$eval : $comp->reval($eval)}if ($@){my$err=$@;if (ref$err){if ($err->{line}=~ /([\$*])([\w\:\']*)\bVERSION\b.*?\=(.*)/){local($^W)=0;my ($sigil,$vstr)=($1,$3);$self->_restore_overloaded_stuff(1)if$err->{line}=~ /use\s+version\b|version\->|qv\(/;$v=($self->{UNSAFE}|| $UNSAFE)? eval$vstr : $comp->reval($vstr);$v=$$v if$sigil eq '*' && ref$v}if ($@ or!$v){$self->_verbose(1,sprintf("reval failed: err[%s] for eval[%s]",JSON::PP::encode_json($err),$eval,));$v=JSON::PP::encode_json($err)}}else {$v=JSON::PP::encode_json({openerr=>$err })}}if (defined$v){no warnings;$v=$v->numify if ref($v)=~ /^version(::vpp)?$/}else {$v=""}if ($self->{FORK}|| $FORK){open my$fh,'>:utf8',$tmpfile;print$fh $v;exit 0}else {utf8::encode($v);$v=undef if defined$v &&!length$v;$comp->erase;$self->_restore_overloaded_stuff}}}unlink$tmpfile if ($self->{FORK}|| $FORK)&& -e $tmpfile;return$self->_normalize_version($v)}sub _restore_overloaded_stuff {my ($self,$used_version_in_safe)=@_;return if$self->{UNSAFE}|| $UNSAFE;no strict 'refs';no warnings 'redefine';my$restored;if ($INC{'version/vxs.pm'}){*{'version::(""'}=\&version::vxs::stringify;*{'version::(0+'}=\&version::vxs::numify;*{'version::(cmp'}=\&version::vxs::VCMP;*{'version::(<=>'}=\&version::vxs::VCMP;*{'version::(bool'}=\&version::vxs::boolean;$restored=1}if ($INC{'version/vpp.pm'}){{package charstar;overload->import}if (!$used_version_in_safe){package version::vpp;overload->import}unless ($restored){*{'version::(""'}=\&version::vpp::stringify;*{'version::(0+'}=\&version::vpp::numify;*{'version::(cmp'}=\&version::vpp::vcmp;*{'version::(<=>'}=\&version::vpp::vcmp;*{'version::(bool'}=\&version::vpp::vbool}*{'version::vpp::(""'}=\&version::vpp::stringify;*{'version::vpp::(0+'}=\&version::vpp::numify;*{'version::vpp::(cmp'}=\&version::vpp::vcmp;*{'version::vpp::(<=>'}=\&version::vpp::vcmp;*{'version::vpp::(bool'}=\&version::vpp::vbool;*{'charstar::(""'}=\&charstar::thischar;*{'charstar::(0+'}=\&charstar::thischar;*{'charstar::(++'}=\&charstar::increment;*{'charstar::(--'}=\&charstar::decrement;*{'charstar::(+'}=\&charstar::plus;*{'charstar::(-'}=\&charstar::minus;*{'charstar::(*'}=\&charstar::multiply;*{'charstar::(cmp'}=\&charstar::cmp;*{'charstar::(<=>'}=\&charstar::spaceship;*{'charstar::(bool'}=\&charstar::thischar;*{'charstar::(='}=\&charstar::clone;$restored=1}if (!$restored){*{'version::(""'}=\&version::stringify;*{'version::(0+'}=\&version::numify;*{'version::(cmp'}=\&version::vcmp;*{'version::(<=>'}=\&version::vcmp;*{'version::(bool'}=\&version::boolean}}sub _packages_per_pmfile {my$self=shift;my$ppp={};my$pmfile=$self->{PMFILE};my$filemtime=$self->{MTIME};my$version=$self->{VERSION};open my$fh,"<","$pmfile" or return$ppp;local $/="\n";my$inpod=0;PLINE: while (<$fh>){chomp;my($pline)=$_;$inpod=$pline =~ /^=(?!cut)/ ? 1 : $pline =~ /^=cut/ ? 0 : $inpod;next if$inpod;next if substr($pline,0,4)eq "=cut";$pline =~ s/\#.*//;next if$pline =~ /^\s*$/;if ($pline =~ /^__(?:END|DATA)__\b/ and $pmfile !~ /\.PL$/){last PLINE}my$pkg;my$strict_version;if ($pline =~ m{ # (.*) # takes too much time if $pline is long #(? 128;$ppp->{$pkg}{parsed}++;$ppp->{$pkg}{infile}=$pmfile;if ($self->_simile($pmfile,$pkg)){$ppp->{$pkg}{simile}=$pmfile;if ($self->_version_from_meta_ok){my$provides=$self->{META_CONTENT}{provides};if (exists$provides->{$pkg}){if (defined$provides->{$pkg}{version}){my$v=$provides->{$pkg}{version};if ($v =~ /[_\s]/ &&!$self->{ALLOW_DEV_VERSION}&&!$ALLOW_DEV_VERSION){next PLINE}unless (eval {$version=$self->_normalize_version($v);1}){$self->_verbose(1,"error with version in $pmfile: $@");next}$ppp->{$pkg}{version}=$version}else {$ppp->{$pkg}{version}="undef"}}}else {if (defined$strict_version){$ppp->{$pkg}{version}=$strict_version }else {$ppp->{$pkg}{version}=defined$version ? $version : ""}no warnings;if ($version eq 'undef'){$ppp->{$pkg}{version}=$version unless defined$ppp->{$pkg}{version}}else {$ppp->{$pkg}{version}=$version if$version > $ppp->{$pkg}{version}|| $version gt $ppp->{$pkg}{version}}}}else {$ppp->{$pkg}{version}=$version unless defined$ppp->{$pkg}{version}&& length($ppp->{$pkg}{version})}$ppp->{$pkg}{filemtime}=$filemtime}else {}}close$fh;$ppp}{no strict;sub _parse_version_safely {my($parsefile)=@_;my$result;local*FH;local $/="\n";open(FH,$parsefile)or die "Could not open '$parsefile': $!";my$inpod=0;while (){$inpod=/^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;next if$inpod || /^\s*#/;last if /^__(?:END|DATA)__\b/;chop;if (my ($ver)=/package \s+ \S+ \s+ (\S+) \s* [;{]/x){return$ver if version::is_lax($ver)}next unless /(?<=])\=(?![=>])/;my$current_parsed_line=$_;my$eval=qq{ package # ExtUtils::MakeMaker::_version; local $1$2; \$$2=undef; do { $_ }; \$$2 };local $^W=0;local$SIG{__WARN__}=sub {};$result=__clean_eval($eval);if ($@ or!defined$result){die +{eval=>$eval,line=>$current_parsed_line,file=>$parsefile,err=>$@,}}last}close FH;$result="undef" unless defined$result;if ((ref$result)=~ /^version(?:::vpp)?\b/){no warnings;$result=$result->numify}return$result}}sub _filter_ppps {my($self,@ppps)=@_;my@res;MANI: for my$ppp (@ppps){if ($self->{META_CONTENT}){my$no_index=$self->{META_CONTENT}{no_index}|| $self->{META_CONTENT}{private};if (ref($no_index)eq 'HASH'){my%map=(package=>qr{\z},namespace=>qr{::},);for my$k (qw(package namespace)){next unless my$v=$no_index->{$k};my$rest=$map{$k};if (ref$v eq "ARRAY"){for my$ve (@$v){$ve =~ s|::$||;if ($ppp =~ /^$ve$rest/){$self->_verbose(1,"Skipping ppp[$ppp] due to ve[$ve]");next MANI}else {$self->_verbose(1,"NOT skipping ppp[$ppp] due to ve[$ve]")}}}else {$v =~ s|::$||;if ($ppp =~ /^$v$rest/){$self->_verbose(1,"Skipping ppp[$ppp] due to v[$v]");next MANI}else {$self->_verbose(1,"NOT skipping ppp[$ppp] due to v[$v]")}}}}else {$self->_verbose(1,"No keyword 'no_index' or 'private' in META_CONTENT")}}else {}push@res,$ppp}$self->_verbose(1,"Result of filter_ppps: res[@res]");@res}sub _simile {my($self,$file,$package)=@_;$file =~ s|.*/||;$file =~ s|\.pm(?:\.PL)?||;my$ret=$package =~ m/\b\Q$file\E$/;$ret ||= 0;unless ($ret){$ret=1 if lc$file eq 'version'}$self->_verbose(1,"Result of simile(): file[$file] package[$package] ret[$ret]\n");$ret}sub _normalize_version {my($self,$v)=@_;$v="undef" unless defined$v;my$dv=Dumpvalue->new;my$sdv=$dv->stringify($v,1);$self->_verbose(1,"Result of normalize_version: sdv[$sdv]\n");return$v if$v eq "undef";return$v if$v =~ /^\{.*\}$/;$v =~ s/^\s+//;$v =~ s/\s+\z//;if ($v =~ /_/){return$v }if (!version::is_lax($v)){return JSON::PP::encode_json({x_normalize=>'version::is_lax failed',version=>$v })}my$vv=eval {no warnings;version->new($v)->numify};if ($@){return JSON::PP::encode_json({x_normalize=>$@,version=>$v })}if ($vv eq $v){}else {my$forced=$self->_force_numeric($v);if ($forced eq $vv){}elsif ($forced =~ /^v(.+)/){no warnings;$vv=version->new($1)->numify}else {if ($forced==$vv){$vv=$forced}}}return$vv}sub _force_numeric {my($self,$v)=@_;$v=$self->_readable($v);if ($v =~ /^(\+?)(\d*)(\.(\d*))?/ && (defined $2 && length $2 || defined $4 && length $4)){my$two=defined $2 ? $2 : "";my$three=defined $3 ? $3 : "";$v="$two$three"}$v}sub _version_from_meta_ok {my($self)=@_;return$self->{VERSION_FROM_META_OK}if exists$self->{VERSION_FROM_META_OK};my$c=$self->{META_CONTENT};return($self->{VERSION_FROM_META_OK}=0)unless$c->{provides};my ($mb_v)=(defined$c->{generated_by}? $c->{generated_by}: '')=~ /Module::Build version ([\d\.]+)/;return($self->{VERSION_FROM_META_OK}=1)unless$mb_v;return($self->{VERSION_FROM_META_OK}=1)if$mb_v eq '0.250.0';if ($mb_v >= 0.19 && $mb_v < 0.26 &&!keys %{$c->{provides}}){return($self->{VERSION_FROM_META_OK}=0)}return($self->{VERSION_FROM_META_OK}=1)}sub _verbose {my($self,$level,@what)=@_;warn@what if$level <= ((ref$self && $self->{VERBOSE})|| $VERBOSE)}sub _vcmp {my($self,$l,$r)=@_;local($^W)=0;$self->_verbose(9,"l[$l] r[$r]");return 0 if$l eq $r;for ($l,$r){s/_//g}$self->_verbose(9,"l[$l] r[$r]");for ($l,$r){next unless tr/.// > 1 || /^v/;s/^v?/v/;1 while s/\.0+(\d)/.$1/}$self->_verbose(9,"l[$l] r[$r]");if ($l=~/^v/ <=> $r=~/^v/){for ($l,$r){next if /^v/;$_=$self->_float2vv($_)}}$self->_verbose(9,"l[$l] r[$r]");my$lvstring="v0";my$rvstring="v0";if ($] >= 5.006 && $l =~ /^v/ && $r =~ /^v/){$lvstring=$self->_vstring($l);$rvstring=$self->_vstring($r);$self->_verbose(9,sprintf "lv[%vd] rv[%vd]",$lvstring,$rvstring)}return (($l ne "undef")<=> ($r ne "undef")|| $lvstring cmp $rvstring || $l <=> $r || $l cmp $r)}sub _vgt {my($self,$l,$r)=@_;$self->_vcmp($l,$r)> 0}sub _vlt {my($self,$l,$r)=@_;$self->_vcmp($l,$r)< 0}sub _vge {my($self,$l,$r)=@_;$self->_vcmp($l,$r)>= 0}sub _vle {my($self,$l,$r)=@_;$self->_vcmp($l,$r)<= 0}sub _vstring {my($self,$n)=@_;$n =~ s/^v// or die "Parse::PMFile::_vstring() called with invalid arg [$n]";pack "U*",split /\./,$n}sub _float2vv {my($self,$n)=@_;my($rev)=int($n);$rev ||= 0;my($mantissa)=$n =~ /\.(\d{1,12})/;$mantissa ||= 0;$mantissa .= "0" while length($mantissa)%3;my$ret="v" .$rev;while ($mantissa){$mantissa =~ s/(\d{1,3})// or die "Panic: length>0 but not a digit? mantissa[$mantissa]";$ret .= ".".int($1)}$ret =~ s/(\.0)+/.0/;$ret}sub _readable {my($self,$n)=@_;$n =~ /^([\w\-\+\.]+)/;return $1 if defined $1 && length($1)>0;if ($] < 5.006){$self->_verbose(9,"Suspicious version string seen [$n]\n");return$n}my$better=sprintf "v%vd",$n;$self->_verbose(9,"n[$n] better[$better]");return$better}1; PARSE_PMFILE $fatpacked{"Search/Dict.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SEARCH_DICT'; package Search::Dict;require 5.000;require Exporter;my$fc_available;BEGIN {$fc_available='5.015008';if ($] ge $fc_available){require feature;'feature'->import('fc')}}use strict;our$VERSION='1.07';our@ISA=qw(Exporter);our@EXPORT=qw(look);sub look {my($fh,$key,$dict,$fold)=@_;my ($comp,$xfrm);if (@_==3 && ref$dict eq 'HASH'){my$params=$dict;$dict=0;$dict=$params->{dict}if exists$params->{dict};$fold=$params->{fold}if exists$params->{fold};$comp=$params->{comp}if exists$params->{comp};$xfrm=$params->{xfrm}if exists$params->{xfrm}}$comp=sub {$_[0]cmp $_[1]}unless defined$comp;local($_);my$fno=fileno$fh;my@stat;if (defined$fno && $fno >= 0 &&!tied *{$fh}){@stat=eval {stat($fh)}}my($size,$blksize)=@stat[7,11];$size=do {seek($fh,0,2);my$s=tell($fh);seek($fh,0,0);$s}unless defined$size;$blksize ||= 8192;$key =~ s/[^\w\s]//g if$dict;if ($fold){$key=$] ge $fc_available ? fc($key): lc($key)}my($min,$max)=(0,int($size / $blksize));my$mid;while ($max - $min > 1){$mid=int(($max + $min)/ 2);seek($fh,$mid * $blksize,0)or return -1;<$fh> if$mid;$_=<$fh>;$_=$xfrm->($_)if defined$xfrm;chomp;s/[^\w\s]//g if$dict;if ($fold){$_=$] ge $fc_available ? fc($_): lc($_)}if (defined($_)&& $comp->($_,$key)< 0){$min=$mid}else {$max=$mid}}$min *= $blksize;seek($fh,$min,0)or return -1;<$fh> if$min;for (;;){$min=tell($fh);defined($_=<$fh>)or last;$_=$xfrm->($_)if defined$xfrm;chomp;s/[^\w\s]//g if$dict;if ($fold){$_=$] ge $fc_available ? fc($_): lc($_)}last if$comp->($_,$key)>= 0}seek($fh,$min,0);$min}1; SEARCH_DICT $fatpacked{"String/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_SHELLQUOTE'; package String::ShellQuote;use strict;use vars qw($VERSION @ISA @EXPORT);require Exporter;$VERSION='1.04';@ISA=qw(Exporter);@EXPORT=qw(shell_quote shell_quote_best_effort shell_comment_quote);sub croak {require Carp;goto&Carp::croak}sub _shell_quote_backend {my@in=@_;my@err=();if (0){require RS::Handy;print RS::Handy::data_dump(\@in)}return \@err,'' unless@in;my$ret='';my$saw_non_equal=0;for (@in){if (!defined $_ or $_ eq ''){$_="''";next}if (s/\x00//g){push@err,"No way to quote string containing null (\\000) bytes"}my$escape=0;if (/=/){if (!$saw_non_equal){$escape=1}}else {$saw_non_equal=1}if (m|[^\w!%+,\-./:=@^]|){$escape=1}if ($escape || (!$saw_non_equal && /=/)){s/'/'\\''/g;s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;$_="'$_'";s/^''//;s/''$//}}continue {$ret .= "$_ "}chop$ret;return \@err,$ret}sub shell_quote {my ($rerr,$s)=_shell_quote_backend @_;if (@$rerr){my%seen;@$rerr=grep {!$seen{$_}++}@$rerr;my$s=join '',map {"shell_quote(): $_\n"}@$rerr;chomp$s;croak$s}return$s}sub shell_quote_best_effort {my ($rerr,$s)=_shell_quote_backend @_;return$s}sub shell_comment_quote {return '' unless @_;unless (@_==1){croak "Too many arguments to shell_comment_quote " ."(got " .@_ ." expected 1)"}local $_=shift;s/\n/\n#/g;return $_}1; STRING_SHELLQUOTE $fatpacked{"Sub/Exporter/Progressive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_EXPORTER_PROGRESSIVE'; package Sub::Exporter::Progressive;$Sub::Exporter::Progressive::VERSION='0.001013';use strict;use warnings;sub _croak {require Carp;&Carp::croak}sub import {my ($self,@args)=@_;my$inner_target=caller;my$export_data=sub_export_options($inner_target,@args);my$full_exporter;no strict 'refs';no warnings 'once';@{"${inner_target}::EXPORT_OK"}=@{$export_data->{exports}};@{"${inner_target}::EXPORT"}=@{$export_data->{defaults}};%{"${inner_target}::EXPORT_TAGS"}=%{$export_data->{tags}};*{"${inner_target}::import"}=sub {use strict;my ($self,@args)=@_;if (grep {length ref $_ or $_ !~ / \A [:-]? \w+ \z /xm}@args){_croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed' unless eval {require Sub::Exporter};$full_exporter ||= Sub::Exporter::build_exporter($export_data->{original});goto$full_exporter}elsif (defined((my ($num)=grep {m/^\d/}@args)[0])){_croak "cannot export symbols with a leading digit: '$num'"}else {require Exporter;s/ \A - /:/xm for@args;@_=($self,@args);goto \&Exporter::import}};return}my$too_complicated=<<'DEATH';sub sub_export_options {my ($inner_target,$setup,$options)=@_;my@exports;my@defaults;my%tags;if (($setup||'')eq '-setup'){my%options=%$options;OPTIONS: for my$opt (keys%options){if ($opt eq 'exports'){_croak$too_complicated if ref$options{exports}ne 'ARRAY';@exports=@{$options{exports}};_croak$too_complicated if grep {length ref $_}@exports}elsif ($opt eq 'groups'){%tags=%{$options{groups}};for my$tagset (values%tags){_croak$too_complicated if grep {length ref $_ or $_ =~ / \A - (?! all \b ) /x}@{$tagset}}@defaults=@{$tags{default}|| []}}else {_croak$too_complicated}}@{$_}=map {/ \A [:-] all \z /x ? @exports : $_}@{$_}for \@defaults,values%tags;$tags{all}||= [@exports ];my%exports=map {$_=>1}@exports;my@errors=grep {not $exports{$_}}@defaults;_croak join(', ',@errors)." is not exported by the $inner_target module\n" if@errors}return {exports=>\@exports,defaults=>\@defaults,original=>$options,tags=>\%tags,}}1; You are using Sub::Exporter::Progressive, but the features your program uses from Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well just use vanilla Sub::Exporter DEATH SUB_EXPORTER_PROGRESSIVE $fatpacked{"Text/ParseWords.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_PARSEWORDS'; package Text::ParseWords;use strict;require 5.006;our$VERSION="3.30";use Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(shellwords quotewords nested_quotewords parse_line);our@EXPORT_OK=qw(old_shellwords);our$PERL_SINGLE_QUOTE;sub shellwords {my (@lines)=@_;my@allwords;for my$line (@lines){$line =~ s/^\s+//;my@words=parse_line('\s+',0,$line);pop@words if (@words and!defined$words[-1]);return()unless (@words ||!length($line));push(@allwords,@words)}return(@allwords)}sub quotewords {my($delim,$keep,@lines)=@_;my($line,@words,@allwords);for$line (@lines){@words=parse_line($delim,$keep,$line);return()unless (@words ||!length($line));push(@allwords,@words)}return(@allwords)}sub nested_quotewords {my($delim,$keep,@lines)=@_;my($i,@allwords);for ($i=0;$i < @lines;$i++){@{$allwords[$i]}=parse_line($delim,$keep,$lines[$i]);return()unless (@{$allwords[$i]}||!length($lines[$i]))}return(@allwords)}sub parse_line {my($delimiter,$keep,$line)=@_;my($word,@pieces);no warnings 'uninitialized';while (length($line)){$line =~ s/^ (?: # double quoted string (") # $quote ((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted | # --OR-- # singe quoted string (') # $quote ((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted | # --OR-- # unquoted string ( # $unquoted (?:\\.|[^\\"'])*? ) # followed by ( # $delim \Z(?!\n) # EOL | # --OR-- (?-x:$delimiter) # delimiter | # --OR-- (?!^)(?=["']) # a quote ) )//xs or return;my ($quote,$quoted,$unquoted,$delim)=(($1 ? ($1,$2): ($3,$4)),$5,$6);return()unless(defined($quote)|| length($unquoted)|| length($delim));if ($keep){$quoted="$quote$quoted$quote"}else {$unquoted =~ s/\\(.)/$1/sg;if (defined$quote){$quoted =~ s/\\(.)/$1/sg if ($quote eq '"');$quoted =~ s/\\([\\'])/$1/g if ($PERL_SINGLE_QUOTE && $quote eq "'")}}$word .= substr($line,0,0);$word .= defined$quote ? $quoted : $unquoted;if (length($delim)){push(@pieces,$word);push(@pieces,$delim)if ($keep eq 'delimiters');undef$word}if (!length($line)){push(@pieces,$word)}}return(@pieces)}sub old_shellwords {no warnings 'uninitialized';local*_=\join('',@_)if @_;my (@words,$snippet);s/\A\s+//;while ($_ ne ''){my$field=substr($_,0,0);for (;;){if (s/\A"(([^"\\]|\\.)*)"//s){($snippet=$1)=~ s#\\(.)#$1#sg}elsif (/\A"/){require Carp;Carp::carp("Unmatched double quote: $_");return()}elsif (s/\A'(([^'\\]|\\.)*)'//s){($snippet=$1)=~ s#\\(.)#$1#sg}elsif (/\A'/){require Carp;Carp::carp("Unmatched single quote: $_");return()}elsif (s/\A\\(.?)//s){$snippet=$1}elsif (s/\A([^\s\\'"]+)//){$snippet=$1}else {s/\A\s+//;last}$field .= $snippet}push(@words,$field)}return@words}1; TEXT_PARSEWORDS $fatpacked{"Tie/Handle/Offset.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIE_HANDLE_OFFSET'; use strict;BEGIN{if (not $] < 5.006){require warnings;warnings->import}}package Tie::Handle::Offset;our$VERSION='0.004';use Tie::Handle;our@ISA=qw/Tie::Handle/;sub offset {my$self=shift;if (@_){return ${*$self}{offset}=shift}else {return ${*$self}{offset}}}sub TIEHANDLE {my$class=shift;my$params;$params=pop if ref $_[-1]eq 'HASH';my$self=\do {no warnings 'once';local*HANDLE};bless$self,$class;$self->OPEN(@_)if (@_);if ($params->{offset}){seek($self,$self->offset($params->{offset}),0)}return$self}sub TELL {my$cur=tell($_[0])- $_[0]->offset;return$cur > 0 ? $cur : 0}sub SEEK {my ($self,$pos,$whence)=@_;my$rc;if ($whence==0 || $whence==1){$rc=seek($self,$pos + $self->offset,$whence)}elsif (_size($self)+ $pos < $self->offset){$rc=''}else {$rc=seek($self,$pos,$whence)}return$rc}sub OPEN {$_[0]->offset(0);$_[0]->CLOSE if defined($_[0]->FILENO);@_==2 ? open($_[0],$_[1]): open($_[0],$_[1],$_[2])}sub _size {my ($self)=@_;my$cur=tell($self);seek($self,0,2);my$size=tell($self);seek($self,$cur,0);return$size}sub EOF {eof($_[0])}sub FILENO {fileno($_[0])}sub CLOSE {close($_[0])}sub BINMODE {binmode($_[0])}sub READ {read($_[0],$_[1],$_[2])}sub READLINE {my$fh=$_[0];<$fh>}sub GETC {getc($_[0])}sub WRITE {my$fh=$_[0];print$fh substr($_[1],0,$_[2])}1; TIE_HANDLE_OFFSET $fatpacked{"Tie/Handle/SkipHeader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIE_HANDLE_SKIPHEADER'; use strict;BEGIN{if (not $] < 5.006){require warnings;warnings->import}}package Tie::Handle::SkipHeader;our$VERSION='0.004';use Tie::Handle::Offset;our@ISA=qw/Tie::Handle::Offset/;sub TIEHANDLE {my$class=shift;pop if ref $_[-1]eq 'HASH';return$class->SUPER::TIEHANDLE(@_)}sub OPEN {my$self=shift;my$rc=$self->SUPER::OPEN(@_);while (my$line=<$self>){last if$line =~ /\A\s*\Z/}$self->offset(tell($self));return$rc}1; TIE_HANDLE_SKIPHEADER $fatpacked{"URI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI'; package URI;use strict;use warnings;our$VERSION='1.74';our ($ABS_REMOTE_LEADING_DOTS,$ABS_ALLOW_RELATIVE_SCHEME,$DEFAULT_QUERY_FORM_DELIMITER);my%implements;our$reserved=q(;/?:@&=+$,[]);our$mark=q(-_.!~*'());our$unreserved="A-Za-z0-9\Q$mark\E";our$uric=quotemeta($reserved).$unreserved ."%";our$scheme_re='[a-zA-Z][a-zA-Z0-9.+\-]*';use Carp ();use URI::Escape ();use overload ('""'=>sub {${$_[0]}},'=='=>sub {_obj_eq(@_)},'!='=>sub {!_obj_eq(@_)},fallback=>1,);sub _obj_eq {return overload::StrVal($_[0])eq overload::StrVal($_[1])}sub new {my($class,$uri,$scheme)=@_;$uri=defined ($uri)? "$uri" : "";$uri =~ s/^<(?:URL:)?(.*)>$/$1/;$uri =~ s/^"(.*)"$/$1/;$uri =~ s/^\s+//;$uri =~ s/\s+$//;my$impclass;if ($uri =~ m/^($scheme_re):/so){$scheme=$1}else {if (($impclass=ref($scheme))){$scheme=$scheme->scheme}elsif ($scheme && $scheme =~ m/^($scheme_re)(?::|$)/o){$scheme=$1}}$impclass ||= implementor($scheme)|| do {require URI::_foreign;$impclass='URI::_foreign'};return$impclass->_init($uri,$scheme)}sub new_abs {my($class,$uri,$base)=@_;$uri=$class->new($uri,$base);$uri->abs($base)}sub _init {my$class=shift;my($str,$scheme)=@_;$str=$class->_uric_escape($str);$str="$scheme:$str" unless$str =~ /^$scheme_re:/o || $class->_no_scheme_ok;my$self=bless \$str,$class;$self}sub _uric_escape {my($class,$str)=@_;$str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;utf8::downgrade($str);return$str}my%require_attempted;sub implementor {my($scheme,$impclass)=@_;if (!$scheme || $scheme !~ /\A$scheme_re\z/o){require URI::_generic;return "URI::_generic"}$scheme=lc($scheme);if ($impclass){my$old=$implements{$scheme};$impclass->_init_implementor($scheme);$implements{$scheme}=$impclass;return$old}my$ic=$implements{$scheme};return$ic if$ic;$ic="URI::$scheme";$ic =~ s/\+/_P/g;$ic =~ s/\./_O/g;$ic =~ s/\-/_/g;no strict 'refs';unless (@{"${ic}::ISA"}){if (not exists$require_attempted{$ic}){my$_old_error=$@;eval "require $ic";die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;$@=$_old_error}return undef unless @{"${ic}::ISA"}}$ic->_init_implementor($scheme);$implements{$scheme}=$ic;$ic}sub _init_implementor {my($class,$scheme)=@_}sub clone {my$self=shift;my$other=$$self;bless \$other,ref$self}sub TO_JSON {${$_[0]}}sub _no_scheme_ok {0}sub _scheme {my$self=shift;unless (@_){return undef unless $$self =~ /^($scheme_re):/o;return $1}my$old;my$new=shift;if (defined($new)&& length($new)){Carp::croak("Bad scheme '$new'")unless$new =~ /^$scheme_re$/o;$old=$1 if $$self =~ s/^($scheme_re)://o;my$newself=URI->new("$new:$$self");$$self=$$newself;bless$self,ref($newself)}else {if ($self->_no_scheme_ok){$old=$1 if $$self =~ s/^($scheme_re)://o;Carp::carp("Oops, opaque part now look like scheme")if $^W && $$self =~ m/^$scheme_re:/o}else {$old=$1 if $$self =~ m/^($scheme_re):/o}}return$old}sub scheme {my$scheme=shift->_scheme(@_);return undef unless defined$scheme;lc($scheme)}sub has_recognized_scheme {my$self=shift;return ref($self)!~ /^URI::_(?:foreign|generic)\z/}sub opaque {my$self=shift;unless (@_){$$self =~ /^(?:$scheme_re:)?([^\#]*)/o or die;return $1}$$self =~ /^($scheme_re:)? # optional scheme ([^\#]*) # opaque (\#.*)? # optional fragment $/sx or die;my$old_scheme=$1;my$old_opaque=$2;my$old_frag=$3;my$new_opaque=shift;$new_opaque="" unless defined$new_opaque;$new_opaque =~ s/([^$uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_opaque);$$self=defined($old_scheme)? $old_scheme : "";$$self .= $new_opaque;$$self .= $old_frag if defined$old_frag;$old_opaque}sub path {goto&opaque}sub fragment {my$self=shift;unless (@_){return undef unless $$self =~ /\#(.*)/s;return $1}my$old;$old=$1 if $$self =~ s/\#(.*)//s;my$new_frag=shift;if (defined$new_frag){$new_frag =~ s/([^$uric])/ URI::Escape::escape_char($1) /ego;utf8::downgrade($new_frag);$$self .= "#$new_frag"}$old}sub as_string {my$self=shift;$$self}sub as_iri {my$self=shift;my$str=$$self;if ($str =~ s/%([89a-fA-F][0-9a-fA-F])/chr(hex($1))/eg){require Encode;my$enc=Encode::find_encoding("UTF-8");my$u="";while (length$str){$u .= $enc->decode($str,Encode::FB_QUIET());if (length$str){$u .= URI::Escape::escape_char(substr($str,0,1,""))}}$str=$u}return$str}sub canonical {my$self=shift;my$scheme=$self->_scheme || "";my$uc_scheme=$scheme =~ /[A-Z]/;my$esc=$$self =~ /%[a-fA-F0-9]{2}/;return$self unless$uc_scheme || $esc;my$other=$self->clone;if ($uc_scheme){$other->_scheme(lc$scheme)}if ($esc){$$other =~ s{%([0-9a-fA-F]{2})} { my $a = chr(hex($1)); $a =~ /^[$unreserved]\z/o ? $a : "%\U$1" }ge}return$other}sub eq {my($self,$other)=@_;$self=URI->new($self,$other)unless ref$self;$other=URI->new($other,$self)unless ref$other;ref($self)eq ref($other)&& $self->canonical->as_string eq $other->canonical->as_string}sub abs {$_[0]}sub rel {$_[0]}sub secure {0}sub STORABLE_freeze {my($self,$cloning)=@_;return $$self}sub STORABLE_thaw {my($self,$cloning,$str)=@_;$$self=$str}1; URI $fatpacked{"URI/Escape.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_ESCAPE'; package URI::Escape;use strict;use warnings;use Exporter 5.57 'import';our%escapes;our@EXPORT=qw(uri_escape uri_unescape uri_escape_utf8);our@EXPORT_OK=qw(%escapes);our$VERSION="3.31";use Carp ();for (0..255){$escapes{chr($_)}=sprintf("%%%02X",$_)}my%subst;my%Unsafe=(RFC2732=>qr/[^A-Za-z0-9\-_.!~*'()]/,RFC3986=>qr/[^A-Za-z0-9\-\._~]/,);sub uri_escape {my($text,$patn)=@_;return undef unless defined$text;if (defined$patn){unless (exists$subst{$patn}){(my$tmp=$patn)=~ s,/,\\/,g;eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";Carp::croak("uri_escape: $@")if $@}&{$subst{$patn}}($text)}else {$text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge}$text}sub _fail_hi {my$chr=shift;Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead",ord($chr))}sub uri_escape_utf8 {my$text=shift;return undef unless defined$text;utf8::encode($text);return uri_escape($text,@_)}sub uri_unescape {my$str=shift;if (@_ && wantarray){my@str=($str,@_);for (@str){s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg}return@str}$str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined$str;$str}sub escape_char {my$dummy=substr($_[0],0,0);if (utf8::is_utf8($_[0])){my$s=shift;utf8::encode($s);unshift(@_,$s)}return join '',@URI::Escape::escapes{split //,$_[0]}}1; URI_ESCAPE $fatpacked{"URI/Heuristic.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HEURISTIC'; package URI::Heuristic;use strict;use warnings;use Exporter 5.57 'import';our@EXPORT_OK=qw(uf_uri uf_uristr uf_url uf_urlstr);our$VERSION="4.20";our ($MY_COUNTRY,$DEBUG);sub MY_COUNTRY() {for ($MY_COUNTRY){return $_ if defined;$_=$ENV{COUNTRY};return $_ if defined;my@srcs=($ENV{LC_ALL},$ENV{LANG});if (my$httplang=$ENV{HTTP_ACCEPT_LANGUAGE}){for$httplang (split(/\s*,\s*/,$httplang)){if ($httplang =~ /^\s*([a-zA-Z]+)[_-]([a-zA-Z]{2})\s*$/){unshift(@srcs,"${1}_${2}");last}}}for (@srcs){next unless defined;return lc($1)if /^[a-zA-Z]+_([a-zA-Z]{2})(?:[.@]|$)/}require Net::Domain;my$fqdn=Net::Domain::hostfqdn();$_=lc($1)if$fqdn =~ /\.([a-zA-Z]{2})$/;return $_ if defined;return ($_=0)}}our%LOCAL_GUESSING=('us'=>[qw(www.ACME.gov www.ACME.mil)],'gb'=>[qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],'au'=>[qw(www.ACME.com.au www.ACME.org.au www.ACME.edu.au)],'il'=>[qw(www.ACME.co.il www.ACME.org.il www.ACME.net.il)],);$LOCAL_GUESSING{uk}=$LOCAL_GUESSING{gb};sub uf_uristr ($) {local($_)=@_;print STDERR "uf_uristr: resolving $_\n" if$DEBUG;return unless defined;s/^\s+//;s/\s+$//;if (/^(www|web|home)[a-z0-9-]*(?:\.|$)/i){$_="http://$_"}elsif (/^(ftp|gopher|news|wais|https|http)[a-z0-9-]*(?:\.|$)/i){$_=lc($1)."://$_"}elsif ($^O ne "MacOS" && (m,^/, || m,^\.\.?/, || m,^[a-zA-Z]:[/\\],)){$_="file:$_"}elsif ($^O eq "MacOS" && m/:/){unless (m/^(ftp|gopher|news|wais|http|https|mailto):/){require URI::file;my$a=URI::file->new($_)->as_string;$_=($a =~ m/^file:/)? $a : "file:$a"}}elsif (/^\w+([\.\-]\w+)*\@(\w+\.)+\w{2,3}$/){$_="mailto:$_"}elsif (!/^[a-zA-Z][a-zA-Z0-9.+\-]*:/){if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/){my$host=$1;my$scheme="http";if (/^:(\d+)\b/){if ($1 =~ /^[56789]?443$/){$scheme="https"}elsif ($1 eq "21"){$scheme="ftp"}}if ($host !~ /\./ && $host ne "localhost"){my@guess;if (exists$ENV{URL_GUESS_PATTERN}){@guess=map {s/\bACME\b/$host/;$_}split(' ',$ENV{URL_GUESS_PATTERN})}else {if (MY_COUNTRY()){my$special=$LOCAL_GUESSING{MY_COUNTRY()};if ($special){my@special=@$special;push(@guess,map {s/\bACME\b/$host/;$_}@special)}else {push(@guess,"www.$host." .MY_COUNTRY())}}push(@guess,map "www.$host.$_","com","org","net","edu","int")}my$guess;for$guess (@guess){print STDERR "uf_uristr: gethostbyname('$guess.')..." if$DEBUG;if (gethostbyname("$guess.")){print STDERR "yes\n" if$DEBUG;$host=$guess;last}print STDERR "no\n" if$DEBUG}}$_="$scheme://$host$_"}else {}}print STDERR "uf_uristr: ==> $_\n" if$DEBUG;$_}sub uf_uri ($) {require URI;URI->new(uf_uristr($_[0]))}*uf_urlstr=\*uf_uristr;sub uf_url ($) {require URI::URL;URI::URL->new(uf_uristr($_[0]))}1; URI_HEURISTIC $fatpacked{"URI/IRI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_IRI'; package URI::IRI;use strict;use warnings;use URI ();use overload '""'=>sub {shift->as_string};our$VERSION='1.74';sub new {my($class,$uri,$scheme)=@_;utf8::upgrade($uri);return bless {uri=>URI->new($uri,$scheme),},$class}sub clone {my$self=shift;return bless {uri=>$self->{uri}->clone,},ref($self)}sub as_string {my$self=shift;return$self->{uri}->as_iri}our$AUTOLOAD;sub AUTOLOAD {my$method=substr($AUTOLOAD,rindex($AUTOLOAD,'::')+2);no strict 'refs';*$method=sub {shift->{uri}->$method(@_)};goto &$method}sub DESTROY {}1; URI_IRI $fatpacked{"URI/QueryParam.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_QUERYPARAM'; package URI::QueryParam;use strict;use warnings;our$VERSION='1.74';sub URI::_query::query_param {my$self=shift;my@old=$self->query_form;if (@_==0){my (%seen,$i);return grep!($i++ % 2 || $seen{$_}++),@old}my$key=shift;my@i=grep $_ % 2==0 && $old[$_]eq $key,0 .. $#old;if (@_){my@new=@old;my@new_i=@i;my@vals=map {ref($_)eq 'ARRAY' ? @$_ : $_}@_;while (@new_i > @vals){splice@new,pop@new_i,2}if (@vals > @new_i){my$i=@new_i ? $new_i[-1]+ 2 : @new;my@splice=splice@vals,@new_i,@vals - @new_i;splice@new,$i,0,map {$key=>$_}@splice}if (@vals){@new[map $_ + 1,@new_i ]=@vals}$self->query_form(\@new)}return wantarray ? @old[map $_+1,@i]: @i ? $old[$i[0]+1]: undef}sub URI::_query::query_param_append {my$self=shift;my$key=shift;my@vals=map {ref $_ eq 'ARRAY' ? @$_ : $_}@_;$self->query_form($self->query_form,$key=>\@vals);return}sub URI::_query::query_param_delete {my$self=shift;my$key=shift;my@old=$self->query_form;my@vals;for (my$i=@old - 2;$i >= 0;$i -= 2){next if$old[$i]ne $key;push(@vals,(splice(@old,$i,2))[1])}$self->query_form(\@old)if@vals;return wantarray ? reverse@vals : $vals[-1]}sub URI::_query::query_form_hash {my$self=shift;my@old=$self->query_form;if (@_){$self->query_form(@_==1 ? %{shift(@_)}: @_)}my%hash;while (my($k,$v)=splice(@old,0,2)){if (exists$hash{$k}){for ($hash{$k}){$_=[$_]unless ref($_)eq "ARRAY";push(@$_,$v)}}else {$hash{$k}=$v}}return \%hash}1; URI_QUERYPARAM $fatpacked{"URI/Split.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SPLIT'; package URI::Split;use strict;use warnings;our$VERSION='1.74';use Exporter 5.57 'import';our@EXPORT_OK=qw(uri_split uri_join);use URI::Escape ();sub uri_split {return $_[0]=~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,}sub uri_join {my($scheme,$auth,$path,$query,$frag)=@_;my$uri=defined($scheme)? "$scheme:" : "";$path="" unless defined$path;if (defined$auth){$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;$uri .= "//$auth";$path="/$path" if length($path)&& $path !~ m,^/,}elsif ($path =~ m,^//,){$uri .= "//"}unless (length$uri){$path =~ s,(:), URI::Escape::escape_char($1),e while$path =~ m,^[^:/?\#]+:,}$path =~ s,([?\#]), URI::Escape::escape_char($1),eg;$uri .= $path;if (defined$query){$query =~ s,(\#), URI::Escape::escape_char($1),eg;$uri .= "?$query"}$uri .= "#$frag" if defined$frag;$uri}1; URI_SPLIT $fatpacked{"URI/URL.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URL'; package URI::URL;use strict;use warnings;use parent 'URI::WithBase';our$VERSION="5.04";use Exporter 5.57 'import';our@EXPORT=qw(url);sub url ($;$) {URI::URL->new(@_)}use URI::Escape qw(uri_unescape);sub new {my$class=shift;my$self=$class->SUPER::new(@_);$self->[0]=$self->[0]->canonical;$self}sub newlocal {my$class=shift;require URI::file;bless [URI::file->new_abs(shift)],$class}{package URI::_foreign;sub _init {my$class=shift;die "Unknown URI::URL scheme $_[1]:" if$URI::URL::STRICT;$class->SUPER::_init(@_)}}sub strict {my$old=$URI::URL::STRICT;$URI::URL::STRICT=shift if @_;$old}sub print_on {my$self=shift;require Data::Dumper;print STDERR Data::Dumper::Dumper($self)}sub _try {my$self=shift;my$method=shift;scalar(eval {$self->$method(@_)})}sub crack {my$self=shift;(scalar($self->scheme),$self->_try("user"),$self->_try("password"),$self->_try("host"),$self->_try("port"),$self->_try("path"),$self->_try("params"),$self->_try("query"),scalar($self->fragment),)}sub full_path {my$self=shift;my$path=$self->path_query;$path="/" unless length$path;$path}sub netloc {shift->authority(@_)}sub epath {my$path=shift->SUPER::path(@_);$path =~ s/;.*//;$path}sub eparams {my$self=shift;my@p=$self->path_segments;return undef unless ref($p[-1]);@p=@{$p[-1]};shift@p;join(";",@p)}sub params {shift->eparams(@_)}sub path {my$self=shift;my$old=$self->epath(@_);return unless defined wantarray;return '/' if!defined($old)||!length($old);Carp::croak("Path components contain '/' (you must call epath)")if$old =~ /%2[fF]/ and!@_;$old="/$old" if$old !~ m|^/| && defined$self->netloc;return uri_unescape($old)}sub path_components {shift->path_segments(@_)}sub query {my$self=shift;my$old=$self->equery(@_);if (defined(wantarray)&& defined($old)){if ($old =~ /%(?:26|2[bB]|3[dD])/){my$mess;for ($old){$mess="Query contains both '+' and '%2B'" if /\+/ && /%2[bB]/;$mess="Form query contains escaped '=' or '&'" if /=/ && /%(?:3[dD]|26)/}if ($mess){Carp::croak("$mess (you must call equery)")}}return uri_unescape($old)}undef}sub abs {my$self=shift;my$base=shift;my$allow_scheme=shift;$allow_scheme=$URI::URL::ABS_ALLOW_RELATIVE_SCHEME unless defined$allow_scheme;local$URI::ABS_ALLOW_RELATIVE_SCHEME=$allow_scheme;local$URI::ABS_REMOTE_LEADING_DOTS=$URI::URL::ABS_REMOTE_LEADING_DOTS;$self->SUPER::abs($base)}sub frag {shift->fragment(@_)}sub keywords {shift->query_keywords(@_)}sub local_path {shift->file}sub unix_path {shift->file("unix")}sub dos_path {shift->file("dos")}sub mac_path {shift->file("mac")}sub vms_path {shift->file("vms")}sub address {shift->to(@_)}sub encoded822addr {shift->to(@_)}sub URI::mailto::authority {shift->to(@_)}sub groupart {shift->_group(@_)}sub article {shift->message(@_)}1; URI_URL $fatpacked{"URI/WithBase.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_WITHBASE'; package URI::WithBase;use strict;use warnings;use URI;use Scalar::Util 'blessed';our$VERSION="2.20";use overload '""'=>"as_string",fallback=>1;sub as_string;sub new {my($class,$uri,$base)=@_;my$ibase=$base;if ($base && blessed($base)&& $base->isa(__PACKAGE__)){$base=$base->abs;$ibase=$base->[0]}bless [URI->new($uri,$ibase),$base],$class}sub new_abs {my$class=shift;my$self=$class->new(@_);$self->abs}sub _init {my$class=shift;my($str,$scheme)=@_;bless [URI->new($str,$scheme),undef],$class}sub eq {my($self,$other)=@_;$other=$other->[0]if blessed($other)and $other->isa(__PACKAGE__);$self->[0]->eq($other)}our$AUTOLOAD;sub AUTOLOAD {my$self=shift;my$method=substr($AUTOLOAD,rindex($AUTOLOAD,'::')+2);return if$method eq "DESTROY";$self->[0]->$method(@_)}sub can {my$self=shift;$self->SUPER::can(@_)|| (ref($self)? $self->[0]->can(@_): undef)}sub base {my$self=shift;my$base=$self->[1];if (@_){my$new_base=shift;$new_base=$new_base->abs if ref($new_base)&& $new_base->isa(__PACKAGE__);$self->[1]=$new_base}return unless defined wantarray;if (defined($base)&&!ref($base)){$base=ref($self)->new($base);$self->[1]=$base unless @_}$base}sub clone {my$self=shift;my$base=$self->[1];$base=$base->clone if ref($base);bless [$self->[0]->clone,$base],ref($self)}sub abs {my$self=shift;my$base=shift || $self->base || return$self->clone;$base=$base->as_string if ref($base);bless [$self->[0]->abs($base,@_),$base],ref($self)}sub rel {my$self=shift;my$base=shift || $self->base || return$self->clone;$base=$base->as_string if ref($base);bless [$self->[0]->rel($base,@_),$base],ref($self)}1; URI_WITHBASE $fatpacked{"URI/_foreign.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__FOREIGN'; package URI::_foreign;use strict;use warnings;use parent 'URI::_generic';our$VERSION='1.74';1; URI__FOREIGN $fatpacked{"URI/_generic.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__GENERIC'; package URI::_generic;use strict;use warnings;use parent qw(URI URI::_query);use URI::Escape qw(uri_unescape);use Carp ();our$VERSION='1.74';my$ACHAR=$URI::uric;$ACHAR =~ s,\\[/?],,g;my$PCHAR=$URI::uric;$PCHAR =~ s,\\[?],,g;sub _no_scheme_ok {1}sub authority {my$self=shift;$$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;if (@_){my$auth=shift;$$self=$1;my$rest=$3;if (defined$auth){$auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($auth);$$self .= "//$auth"}_check_path($rest,$$self);$$self .= $rest}$2}sub path {my$self=shift;$$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;if (@_){$$self=$1;my$rest=$3;my$new_path=shift;$new_path="" unless defined$new_path;$new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_path);_check_path($new_path,$$self);$$self .= $new_path .$rest}$2}sub path_query {my$self=shift;$$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;if (@_){$$self=$1;my$rest=$3;my$new_path=shift;$new_path="" unless defined$new_path;$new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($new_path);_check_path($new_path,$$self);$$self .= $new_path .$rest}$2}sub _check_path {my($path,$pre)=@_;my$prefix;if ($pre =~ m,/,){$prefix="/" if length($path)&& $path !~ m,^[/?\#],}else {if ($path =~ m,^//,){Carp::carp("Path starting with double slash is confusing")if $^W}elsif (!length($pre)&& $path =~ m,^[^:/?\#]+:,){Carp::carp("Path might look like scheme, './' prepended")if $^W;$prefix="./"}}substr($_[0],0,0)=$prefix if defined$prefix}sub path_segments {my$self=shift;my$path=$self->path;if (@_){my@arg=@_;for (@arg){if (ref($_)){my@seg=@$_;$seg[0]=~ s/%/%25/g;for (@seg){s/;/%3B/g}$_=join(";",@seg)}else {s/%/%25/g;s/;/%3B/g}s,/,%2F,g}$self->path(join("/",@arg))}return$path unless wantarray;map {/;/ ? $self->_split_segment($_): uri_unescape($_)}split('/',$path,-1)}sub _split_segment {my$self=shift;require URI::_segment;URI::_segment->new(@_)}sub abs {my$self=shift;my$base=shift || Carp::croak("Missing base argument");if (my$scheme=$self->scheme){return$self unless$URI::ABS_ALLOW_RELATIVE_SCHEME;$base=URI->new($base)unless ref$base;return$self unless$scheme eq $base->scheme}$base=URI->new($base)unless ref$base;my$abs=$self->clone;$abs->scheme($base->scheme);return$abs if $$self =~ m,^(?:$URI::scheme_re:)?//,o;$abs->authority($base->authority);my$path=$self->path;return$abs if$path =~ m,^/,;if (!length($path)){my$abs=$base->clone;my$query=$self->query;$abs->query($query)if defined$query;my$fragment=$self->fragment;$abs->fragment($fragment)if defined$fragment;return$abs}my$p=$base->path;$p =~ s,[^/]+$,,;$p .= $path;my@p=split('/',$p,-1);shift(@p)if@p &&!length($p[0]);my$i=1;while ($i < @p){if ($p[$i-1]eq "."){splice(@p,$i-1,1);$i-- if$i > 1}elsif ($p[$i]eq ".." && $p[$i-1]ne ".."){splice(@p,$i-1,2);if ($i > 1){$i--;push(@p,"")if$i==@p}}else {$i++}}$p[-1]="" if@p && $p[-1]eq ".";if ($URI::ABS_REMOTE_LEADING_DOTS){shift@p while@p && $p[0]=~ /^\.\.?$/}$abs->path("/" .join("/",@p));$abs}sub rel {my$self=shift;my$base=shift || Carp::croak("Missing base argument");my$rel=$self->clone;$base=URI->new($base)unless ref$base;my$scheme=$rel->scheme;my$auth=$rel->canonical->authority;my$path=$rel->path;if (!defined($scheme)&&!defined($auth)){return$rel}my$bscheme=$base->scheme;my$bauth=$base->canonical->authority;my$bpath=$base->path;for ($bscheme,$bauth,$auth){$_='' unless defined}unless ($scheme eq $bscheme && $auth eq $bauth){return$rel}for ($path,$bpath){$_="/$_" unless m,^/,}$rel->scheme(undef);$rel->authority(undef);my$li=1;while (1){my$i=index($path,'/',$li);last if$i < 0 || $i!=index($bpath,'/',$li)|| substr($path,$li,$i-$li)ne substr($bpath,$li,$i-$li);$li=$i+1}substr($path,0,$li)='';substr($bpath,0,$li)='';if ($path eq $bpath && defined($rel->fragment)&& !defined($rel->query)){$rel->path("")}else {$path=('../' x $bpath =~ tr|/|/|).$path;$path="./" if$path eq "";$rel->path($path)}$rel}1; URI__GENERIC $fatpacked{"URI/_idna.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__IDNA'; package URI::_idna;use strict;use warnings;use URI::_punycode qw(encode_punycode decode_punycode);use Carp qw(croak);our$VERSION='1.74';BEGIN {*URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS="$]" < 5.008_003 ? sub () {1}: sub () {0}}my$ASCII=qr/^[\x00-\x7F]*\z/;sub encode {my$idomain=shift;my@labels=split(/\./,$idomain,-1);my@last_empty;push(@last_empty,pop@labels)if@labels > 1 && $labels[-1]eq "";for (@labels){$_=ToASCII($_)}return eval 'join(".", @labels, @last_empty)' if URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS;return join(".",@labels,@last_empty)}sub decode {my$domain=shift;return join(".",map ToUnicode($_),split(/\./,$domain,-1))}sub nameprep {my$label=shift;$label=lc($label);return$label}sub check_size {my$label=shift;croak "Label empty" if$label eq "";croak "Label too long" if length($label)> 63;return$label}sub ToASCII {my$label=shift;return check_size($label)if$label =~ $ASCII;$label=nameprep($label);return check_size($label)if$label =~ $ASCII;if ($label =~ /^xn--/){croak "Label starts with ACE prefix"}$label=encode_punycode($label);$label="xn--$label";return check_size($label)}sub ToUnicode {my$label=shift;$label=nameprep($label)unless$label =~ $ASCII;return$label unless$label =~ /^xn--/;my$result=decode_punycode(substr($label,4));my$label2=ToASCII($result);if (lc($label)ne $label2){croak "IDNA does not round-trip: '\L$label\E' vs '$label2'"}return$result}1; URI__IDNA $fatpacked{"URI/_ldap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__LDAP'; package URI::_ldap;use strict;use warnings;our$VERSION='1.74';use URI::Escape qw(uri_unescape);sub _ldap_elem {my$self=shift;my$elem=shift;my$query=$self->query;my@bits=(split(/\?/,defined($query)? $query : ""),("")x4);my$old=$bits[$elem];if (@_){my$new=shift;$new =~ s/\?/%3F/g;$bits[$elem]=$new;$query=join("?",@bits);$query =~ s/\?+$//;$query=undef unless length($query);$self->query($query)}$old}sub dn {my$old=shift->path(@_);$old =~ s:^/::;uri_unescape($old)}sub attributes {my$self=shift;my$old=_ldap_elem($self,0,@_ ? join(",",map {my$tmp=$_;$tmp =~ s/,/%2C/g;$tmp}@_): ());return$old unless wantarray;map {uri_unescape($_)}split(/,/,$old)}sub _scope {my$self=shift;my$old=_ldap_elem($self,1,@_);return undef unless defined wantarray && defined$old;uri_unescape($old)}sub scope {my$old=&_scope;$old="base" unless length$old;$old}sub _filter {my$self=shift;my$old=_ldap_elem($self,2,@_);return undef unless defined wantarray && defined$old;uri_unescape($old)}sub filter {my$old=&_filter;$old="(objectClass=*)" unless length$old;$old}sub extensions {my$self=shift;my@ext;while (@_){my$key=shift;my$value=shift;push(@ext,join("=",map {$_="" unless defined;s/,/%2C/g;$_}$key,$value))}@ext=join(",",@ext)if@ext;my$old=_ldap_elem($self,3,@ext);return$old unless wantarray;map {uri_unescape($_)}map {/^([^=]+)=(.*)$/}split(/,/,$old)}sub canonical {my$self=shift;my$other=$self->_nonldap_canonical;$other=$other->clone if$other==$self;$other->dn(_normalize_dn($other->dn));$other->attributes(map lc,$other->attributes);my$old_scope=$other->scope;my$new_scope=lc($old_scope);$new_scope="" if$new_scope eq "base";$other->scope($new_scope)if$new_scope ne $old_scope;my$old_filter=$other->filter;$other->filter("")if lc($old_filter)eq "(objectclass=*)" || lc($old_filter)eq "objectclass=*";my@ext=$other->extensions;for (my$i=0;$i < @ext;$i += 2){my$etype=$ext[$i]=lc($ext[$i]);if ($etype =~ /^!?bindname$/){$ext[$i+1]=_normalize_dn($ext[$i+1])}}$other->extensions(@ext)if@ext;$other}sub _normalize_dn {my$dn=shift;return$dn;my@dn=split(/([+,])/,$dn);for (@dn){s/^([a-zA-Z]+=)/lc($1)/e}join("",@dn)}1; URI__LDAP $fatpacked{"URI/_login.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__LOGIN'; package URI::_login;use strict;use warnings;use parent qw(URI::_server URI::_userpass);our$VERSION='1.74';1; URI__LOGIN $fatpacked{"URI/_punycode.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__PUNYCODE'; package URI::_punycode;use strict;use warnings;our$VERSION='1.74';use Exporter 'import';our@EXPORT=qw(encode_punycode decode_punycode);use integer;our$DEBUG=0;use constant BASE=>36;use constant TMIN=>1;use constant TMAX=>26;use constant SKEW=>38;use constant DAMP=>700;use constant INITIAL_BIAS=>72;use constant INITIAL_N=>128;my$Delimiter=chr 0x2D;my$BasicRE=qr/[\x00-\x7f]/;sub _croak {require Carp;Carp::croak(@_)}sub digit_value {my$code=shift;return ord($code)- ord("A")if$code =~ /[A-Z]/;return ord($code)- ord("a")if$code =~ /[a-z]/;return ord($code)- ord("0")+ 26 if$code =~ /[0-9]/;return}sub code_point {my$digit=shift;return$digit + ord('a')if 0 <= $digit && $digit <= 25;return$digit + ord('0')- 26 if 26 <= $digit && $digit <= 36;die 'NOT COME HERE'}sub adapt {my($delta,$numpoints,$firsttime)=@_;$delta=$firsttime ? $delta / DAMP : $delta / 2;$delta += $delta / $numpoints;my$k=0;while ($delta > ((BASE - TMIN)* TMAX)/ 2){$delta /= BASE - TMIN;$k += BASE}return$k + (((BASE - TMIN + 1)* $delta)/ ($delta + SKEW))}sub decode_punycode {my$code=shift;my$n=INITIAL_N;my$i=0;my$bias=INITIAL_BIAS;my@output;if ($code =~ s/(.*)$Delimiter//o){push@output,map ord,split //,$1;return _croak('non-basic code point')unless $1 =~ /^$BasicRE*$/o}while ($code){my$oldi=$i;my$w=1;LOOP: for (my$k=BASE;1;$k += BASE){my$cp=substr($code,0,1,'');my$digit=digit_value($cp);defined$digit or return _croak("invalid punycode input");$i += $digit * $w;my$t=($k <= $bias)? TMIN : ($k >= $bias + TMAX)? TMAX : $k - $bias;last LOOP if$digit < $t;$w *= (BASE - $t)}$bias=adapt($i - $oldi,@output + 1,$oldi==0);warn "bias becomes $bias" if$DEBUG;$n += $i / (@output + 1);$i=$i % (@output + 1);splice(@output,$i,0,$n);warn join " ",map sprintf('%04x',$_),@output if$DEBUG;$i++}return join '',map chr,@output}sub encode_punycode {my$input=shift;my@input=split //,$input;my$n=INITIAL_N;my$delta=0;my$bias=INITIAL_BIAS;my@output;my@basic=grep /$BasicRE/,@input;my$h=my$b=@basic;push@output,@basic;push@output,$Delimiter if$b && $h < @input;warn "basic codepoints: (@output)" if$DEBUG;while ($h < @input){my$m=min(grep {$_ >= $n}map ord,@input);warn sprintf "next code point to insert is %04x",$m if$DEBUG;$delta += ($m - $n)* ($h + 1);$n=$m;for my$i (@input){my$c=ord($i);$delta++ if$c < $n;if ($c==$n){my$q=$delta;LOOP: for (my$k=BASE;1;$k += BASE){my$t=($k <= $bias)? TMIN : ($k >= $bias + TMAX)? TMAX : $k - $bias;last LOOP if$q < $t;my$cp=code_point($t + (($q - $t)% (BASE - $t)));push@output,chr($cp);$q=($q - $t)/ (BASE - $t)}push@output,chr(code_point($q));$bias=adapt($delta,$h + 1,$h==$b);warn "bias becomes $bias" if$DEBUG;$delta=0;$h++}}$delta++;$n++}return join '',@output}sub min {my$min=shift;for (@_){$min=$_ if $_ <= $min}return$min}1; URI__PUNYCODE $fatpacked{"URI/_query.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__QUERY'; package URI::_query;use strict;use warnings;use URI ();use URI::Escape qw(uri_unescape);our$VERSION='1.74';sub query {my$self=shift;$$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die;if (@_){my$q=shift;$$self=$1;if (defined$q){$q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;utf8::downgrade($q);$$self .= "?$q"}$$self .= $3}$2}sub query_form {my$self=shift;my$old=$self->query;if (@_){my$delim;my$r=$_[0];if (ref($r)eq "ARRAY"){$delim=$_[1];@_=@$r}elsif (ref($r)eq "HASH"){$delim=$_[1];@_=map {$_=>$r->{$_}}sort keys %$r}$delim=pop if @_ % 2;my@query;while (my($key,$vals)=splice(@_,0,2)){$key='' unless defined$key;$key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;$key =~ s/ /+/g;$vals=[ref($vals)eq "ARRAY" ? @$vals : $vals];for my$val (@$vals){$val='' unless defined$val;$val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;$val =~ s/ /+/g;push(@query,"$key=$val")}}if (@query){unless ($delim){$delim=$1 if$old && $old =~ /([&;])/;$delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&"}$self->query(join($delim,@query))}else {$self->query(undef)}}return if!defined($old)||!length($old)||!defined(wantarray);return unless$old =~ /=/;map {s/\+/ /g;uri_unescape($_)}map {/=/ ? split(/=/,$_,2): ($_=>'')}split(/[&;]/,$old)}sub query_keywords {my$self=shift;my$old=$self->query;if (@_){my@copy=@_;@copy=@{$copy[0]}if@copy==1 && ref($copy[0])eq "ARRAY";for (@copy){s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg}$self->query(@copy ? join('+',@copy): undef)}return if!defined($old)||!defined(wantarray);return if$old =~ /=/;map {uri_unescape($_)}split(/\+/,$old,-1)}sub equery {goto&query}1; URI__QUERY $fatpacked{"URI/_segment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__SEGMENT'; package URI::_segment;use strict;use warnings;use URI::Escape qw(uri_unescape);use overload '""'=>sub {$_[0]->[0]},fallback=>1;our$VERSION='1.74';sub new {my$class=shift;my@segment=split(';',shift,-1);$segment[0]=uri_unescape($segment[0]);bless \@segment,$class}1; URI__SEGMENT $fatpacked{"URI/_server.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__SERVER'; package URI::_server;use strict;use warnings;use parent 'URI::_generic';use URI::Escape qw(uri_unescape);our$VERSION='1.74';sub _uric_escape {my($class,$str)=@_;if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os){my($scheme,$host,$rest)=($1,$2,$3);my$ui=$host =~ s/(.*@)// ? $1 : "";my$port=$host =~ s/(:\d+)\z// ? $1 : "";if (_host_escape($host)){$str="$scheme//$ui$host$port$rest"}}return$class->SUPER::_uric_escape($str)}sub _host_escape {return unless $_[0]=~ /[^$URI::uric]/;eval {require URI::_idna;$_[0]=URI::_idna::encode($_[0])};return 0 if $@;return 1}sub as_iri {my$self=shift;my$str=$self->SUPER::as_iri;if ($str =~ /\bxn--/){if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os){my($scheme,$host,$rest)=($1,$2,$3);my$ui=$host =~ s/(.*@)// ? $1 : "";my$port=$host =~ s/(:\d+)\z// ? $1 : "";require URI::_idna;$host=URI::_idna::decode($host);$str="$scheme//$ui$host$port$rest"}}return$str}sub userinfo {my$self=shift;my$old=$self->authority;if (@_){my$new=$old;$new="" unless defined$new;$new =~ s/.*@//;my$ui=shift;if (defined$ui){$ui =~ s/@/%40/g;$new="$ui\@$new"}$self->authority($new)}return undef if!defined($old)|| $old !~ /(.*)@/;return $1}sub host {my$self=shift;my$old=$self->authority;if (@_){my$tmp=$old;$tmp="" unless defined$tmp;my$ui=($tmp =~ /(.*@)/)? $1 : "";my$port=($tmp =~ /(:\d+)$/)? $1 : "";my$new=shift;$new="" unless defined$new;if (length$new){$new =~ s/[@]/%40/g;if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/){$new =~ s/(:\d*)\z// || die "Assert";$port=$1}$new="[$new]" if$new =~ /:/ && $new !~ /^\[/;_host_escape($new)}$self->authority("$ui$new$port")}return undef unless defined$old;$old =~ s/.*@//;$old =~ s/:\d+$//;$old =~ s{^\[(.*)\]$}{$1};return uri_unescape($old)}sub ihost {my$self=shift;my$old=$self->host(@_);if ($old =~ /(^|\.)xn--/){require URI::_idna;$old=URI::_idna::decode($old)}return$old}sub _port {my$self=shift;my$old=$self->authority;if (@_){my$new=$old;$new =~ s/:\d*$//;my$port=shift;$new .= ":$port" if defined$port;$self->authority($new)}return $1 if defined($old)&& $old =~ /:(\d*)$/;return}sub port {my$self=shift;my$port=$self->_port(@_);$port=$self->default_port if!defined($port)|| $port eq "";$port}sub host_port {my$self=shift;my$old=$self->authority;$self->host(shift)if @_;return undef unless defined$old;$old =~ s/.*@//;$old =~ s/:$//;$old .= ":" .$self->port unless$old =~ /:\d+$/;$old}sub default_port {undef}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$host=$other->host || "";my$port=$other->_port;my$uc_host=$host =~ /[A-Z]/;my$def_port=defined($port)&& ($port eq "" || $port==$self->default_port);if ($uc_host || $def_port){$other=$other->clone if$other==$self;$other->host(lc$host)if$uc_host;$other->port(undef)if$def_port}$other}1; URI__SERVER $fatpacked{"URI/_userpass.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI__USERPASS'; package URI::_userpass;use strict;use warnings;use URI::Escape qw(uri_unescape);our$VERSION='1.74';sub user {my$self=shift;my$info=$self->userinfo;if (@_){my$new=shift;my$pass=defined($info)? $info : "";$pass =~ s/^[^:]*//;if (!defined($new)&&!length($pass)){$self->userinfo(undef)}else {$new="" unless defined($new);$new =~ s/%/%25/g;$new =~ s/:/%3A/g;$self->userinfo("$new$pass")}}return undef unless defined$info;$info =~ s/:.*//;uri_unescape($info)}sub password {my$self=shift;my$info=$self->userinfo;if (@_){my$new=shift;my$user=defined($info)? $info : "";$user =~ s/:.*//;if (!defined($new)&&!length($user)){$self->userinfo(undef)}else {$new="" unless defined($new);$new =~ s/%/%25/g;$self->userinfo("$user:$new")}}return undef unless defined$info;return undef unless$info =~ s/^[^:]*://;uri_unescape($info)}1; URI__USERPASS $fatpacked{"URI/data.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_DATA'; package URI::data;use strict;use warnings;use parent 'URI';our$VERSION='1.74';use MIME::Base64 qw(encode_base64 decode_base64);use URI::Escape qw(uri_unescape);sub media_type {my$self=shift;my$opaque=$self->opaque;$opaque =~ /^([^,]*),?/ or die;my$old=$1;my$base64;$base64=$1 if$old =~ s/(;base64)$//i;if (@_){my$new=shift;$new="" unless defined$new;$new =~ s/%/%25/g;$new =~ s/,/%2C/g;$base64="" unless defined$base64;$opaque =~ s/^[^,]*,?/$new$base64,/;$self->opaque($opaque)}return uri_unescape($old)if$old;"text/plain;charset=US-ASCII"}sub data {my$self=shift;my($enc,$data)=split(",",$self->opaque,2);unless (defined$data){$data="";$enc="" unless defined$enc}my$base64=($enc =~ /;base64$/i);if (@_){$enc =~ s/;base64$//i if$base64;my$new=shift;$new="" unless defined$new;my$uric_count=_uric_count($new);my$urienc_len=$uric_count + (length($new)- $uric_count)* 3;my$base64_len=int((length($new)+2)/ 3)* 4;$base64_len += 7;if ($base64_len < $urienc_len || $_[0]){$enc .= ";base64";$new=encode_base64($new,"")}else {$new =~ s/%/%25/g}$self->opaque("$enc,$new")}return unless defined wantarray;$data=uri_unescape($data);return$base64 ? decode_base64($data): $data}my$ENC=$URI::uric;$ENC =~ s/%//;eval <"OS2",mac=>"Mac",MacOS=>"Mac",MSWin32=>"Win32",win32=>"Win32",msdos=>"FAT",dos=>"FAT",qnx=>"QNX",);sub os_class {my($OS)=shift || $^O;my$class="URI::file::" .($OS_CLASS{$OS}|| "Unix");no strict 'refs';unless (%{"$class\::"}){eval "require $class";die $@ if $@}$class}sub host {uri_unescape(shift->authority(@_))}sub new {my($class,$path,$os)=@_;os_class($os)->new($path)}sub new_abs {my$class=shift;my$file=$class->new(@_);return$file->abs($class->cwd)unless $$file =~ /^file:/;$file}sub cwd {my$class=shift;require Cwd;my$cwd=Cwd::cwd();$cwd=VMS::Filespec::unixpath($cwd)if $^O eq 'VMS';$cwd=$class->new($cwd);$cwd .= "/" unless substr($cwd,-1,1)eq "/";$cwd}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$scheme=$other->scheme;my$auth=$other->authority;return$other if!defined($scheme)&&!defined($auth);if (!defined($auth)|| $auth eq "" || lc($auth)eq "localhost" || (defined($DEFAULT_AUTHORITY)&& lc($auth)eq lc($DEFAULT_AUTHORITY))){if ((defined($auth)|| defined($DEFAULT_AUTHORITY))&& (!defined($auth)||!defined($DEFAULT_AUTHORITY)|| $auth ne $DEFAULT_AUTHORITY)){$other=$other->clone if$self==$other;$other->authority($DEFAULT_AUTHORITY)}}$other}sub file {my($self,$os)=@_;os_class($os)->file($self)}sub dir {my($self,$os)=@_;os_class($os)->dir($self)}1; URI_FILE $fatpacked{"URI/file/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_BASE'; package URI::file::Base;use strict;use warnings;use URI::Escape qw();our$VERSION='1.74';sub new {my$class=shift;my$path=shift;$path="" unless defined$path;my($auth,$escaped_auth,$escaped_path);($auth,$escaped_auth)=$class->_file_extract_authority($path);($path,$escaped_path)=$class->_file_extract_path($path);if (defined$auth){$auth =~ s,%,%25,g unless$escaped_auth;$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;$auth="//$auth";if (defined$path){$path="/$path" unless substr($path,0,1)eq "/"}else {$path=""}}else {return undef unless defined$path;$auth=""}$path =~ s,([%;?]), URI::Escape::escape_char($1),eg unless$escaped_path;$path =~ s/\#/%23/g;my$uri=$auth .$path;$uri="file:$uri" if substr($uri,0,1)eq "/";URI->new($uri,"file")}sub _file_extract_authority {my($class,$path)=@_;return undef unless$class->_file_is_absolute($path);return$URI::file::DEFAULT_AUTHORITY}sub _file_extract_path {return undef}sub _file_is_absolute {return 0}sub _file_is_localhost {shift;my$host=lc(shift);return 1 if$host eq "localhost";eval {require Net::Domain;lc(Net::Domain::hostfqdn()|| '')eq $host || lc(Net::Domain::hostname()|| '')eq $host}}sub file {undef}sub dir {my$self=shift;$self->file(@_)}1; URI_FILE_BASE $fatpacked{"URI/file/FAT.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_FAT'; package URI::file::FAT;use strict;use warnings;use parent 'URI::file::Win32';our$VERSION='1.74';sub fix_path {shift;for (@_){my@p=map uc,split(/\./,$_,-1);return if@p > 2;@p=("")unless@p;$_=substr($p[0],0,8);if (@p > 1){my$ext=substr($p[1],0,3);$_ .= ".$ext" if length$ext}}1}1; URI_FILE_FAT $fatpacked{"URI/file/Mac.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_MAC'; package URI::file::Mac;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='1.74';sub _file_extract_path {my$class=shift;my$path=shift;my@pre;if ($path =~ s/^(:+)//){if (length($1)==1){@pre=(".")unless length($path)}else {@pre=("..")x (length($1)- 1)}}else {$pre[0]=""}my$isdir=($path =~ s/:$//);$path =~ s,([%/;]), URI::Escape::escape_char($1),eg;my@path=split(/:/,$path,-1);for (@path){if ($_ eq "." || $_ eq ".."){$_="%2E" x length($_)}$_=".." unless length($_)}push (@path,"")if$isdir;(join("/",@pre,@path),1)}sub file {my$class=shift;my$uri=shift;my@path;my$auth=$uri->authority;if (defined$auth){if (lc($auth)ne "localhost" && $auth ne ""){my$u_auth=uri_unescape($auth);if (!$class->_file_is_localhost($u_auth)){@path=("",$auth)}}}my@ps=split("/",$uri->path,-1);shift@ps if@path;push(@path,@ps);my$pre="";if (!@path){return}elsif ($path[0]eq ""){shift(@path);if (@path==1){return if$path[0]eq "";push(@path,"")}@ps=@path;@path=();my$part;for (@ps){next if $_ eq ".";$part=$_ eq ".." ? "" : $_;push(@path,$part)}if ($ps[-1]eq ".."){push(@path,"")}}else {$pre=":";@ps=@path;@path=();my$part;for (@ps){next if $_ eq ".";$part=$_ eq ".." ? "" : $_;push(@path,$part)}if ($ps[-1]eq ".."){push(@path,"")}}return unless$pre || @path;for (@path){s/;.*//;$_=uri_unescape($_);return if /\0/;return if /:/}$pre .join(":",@path)}sub dir {my$class=shift;my$path=$class->file(@_);return unless defined$path;$path .= ":" unless$path =~ /:$/;$path}1; URI_FILE_MAC $fatpacked{"URI/file/OS2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_OS2'; package URI::file::OS2;use strict;use warnings;use parent 'URI::file::Win32';our$VERSION='1.74';sub _file_extract_authority {my$class=shift;return $1 if $_[0]=~ s,^\\\\([^\\]+),,;return $1 if $_[0]=~ s,^//([^/]+),,;if ($_[0]=~ m#^[a-zA-Z]{1,2}:#){return ""}return}sub file {my$p=&URI::file::Win32::file;return unless defined$p;$p =~ s,\\,/,g;$p}1; URI_FILE_OS2 $fatpacked{"URI/file/QNX.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_QNX'; package URI::file::QNX;use strict;use warnings;use parent 'URI::file::Unix';our$VERSION='1.74';sub _file_extract_path {my($class,$path)=@_;$path =~ s,(.)//+,$1/,g;$path =~ s,(/\.)+/,/,g;$path="./$path" if$path =~ m,^[^:/]+:,,;$path}1; URI_FILE_QNX $fatpacked{"URI/file/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_UNIX'; package URI::file::Unix;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='1.74';sub _file_extract_path {my($class,$path)=@_;$path =~ s,//+,/,g;$path =~ s,(/\.)+/,/,g;$path="./$path" if$path =~ m,^[^:/]+:,,;return$path}sub _file_is_absolute {my($class,$path)=@_;return$path =~ m,^/,}sub file {my$class=shift;my$uri=shift;my@path;my$auth=$uri->authority;if (defined($auth)){if (lc($auth)ne "localhost" && $auth ne ""){$auth=uri_unescape($auth);unless ($class->_file_is_localhost($auth)){push(@path,"","",$auth)}}}my@ps=$uri->path_segments;shift@ps if@path;push(@path,@ps);for (@path){return undef if /\0/;return undef if /\//}return join("/",@path)}1; URI_FILE_UNIX $fatpacked{"URI/file/Win32.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FILE_WIN32'; package URI::file::Win32;use strict;use warnings;use parent 'URI::file::Base';use URI::Escape qw(uri_unescape);our$VERSION='1.74';sub _file_extract_authority {my$class=shift;return$class->SUPER::_file_extract_authority($_[0])if defined$URI::file::DEFAULT_AUTHORITY;return $1 if $_[0]=~ s,^\\\\([^\\]+),,;return $1 if $_[0]=~ s,^//([^/]+),,;if ($_[0]=~ s,^([a-zA-Z]:),,){my$auth=$1;$auth .= "relative" if $_[0]!~ m,^[\\/],;return$auth}return undef}sub _file_extract_path {my($class,$path)=@_;$path =~ s,\\,/,g;$path =~ s,(/\.)+/,/,g;if (defined$URI::file::DEFAULT_AUTHORITY){$path =~ s,^([a-zA-Z]:),/$1,}return$path}sub _file_is_absolute {my($class,$path)=@_;return$path =~ m,^[a-zA-Z]:, || $path =~ m,^[/\\],}sub file {my$class=shift;my$uri=shift;my$auth=$uri->authority;my$rel;if (defined$auth){$auth=uri_unescape($auth);if ($auth =~ /^([a-zA-Z])[:|](relative)?/){$auth=uc($1).":";$rel++ if $2}elsif (lc($auth)eq "localhost"){$auth=""}elsif (length$auth){$auth="\\\\" .$auth}}else {$auth=""}my@path=$uri->path_segments;for (@path){return undef if /\0/;return undef if /\//}return undef unless$class->fix_path(@path);my$path=join("\\",@path);$path =~ s/^\\// if$rel;$path=$auth .$path;$path =~ s,^\\([a-zA-Z])[:|],\u$1:,;return$path}sub fix_path {1}1; URI_FILE_WIN32 $fatpacked{"URI/ftp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_FTP'; package URI::ftp;use strict;use warnings;our$VERSION='1.74';use parent qw(URI::_server URI::_userpass);sub default_port {21}sub path {shift->path_query(@_)}sub _user {shift->SUPER::user(@_)}sub _password {shift->SUPER::password(@_)}sub user {my$self=shift;my$user=$self->_user(@_);$user="anonymous" unless defined$user;$user}sub password {my$self=shift;my$pass=$self->_password(@_);unless (defined$pass){my$user=$self->user;if ($user eq 'anonymous' || $user eq 'ftp'){$pass='anonymous@'}}$pass}1; URI_FTP $fatpacked{"URI/gopher.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_GOPHER'; package URI::gopher;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_server';use URI::Escape qw(uri_unescape);sub default_port {70}sub _gopher_type {my$self=shift;my$path=$self->path_query;$path =~ s,^/,,;my$gtype=$1 if$path =~ s/^(.)//s;if (@_){my$new_type=shift;if (defined($new_type)){Carp::croak("Bad gopher type '$new_type'")unless length($new_type)==1;substr($path,0,0)=$new_type;$self->path_query($path)}else {Carp::croak("Can't delete gopher type when selector is present")if length($path);$self->path_query(undef)}}return$gtype}sub gopher_type {my$self=shift;my$gtype=$self->_gopher_type(@_);$gtype="1" unless defined$gtype;$gtype}sub gtype {goto&gopher_type}sub selector {shift->_gfield(0,@_)}sub search {shift->_gfield(1,@_)}sub string {shift->_gfield(2,@_)}sub _gfield {my$self=shift;my$fno=shift;my$path=$self->path_query;$path =~ s/\?/\t/;$path=uri_unescape($path);$path =~ s,^/,,;my$gtype=$1 if$path =~ s,^(.),,s;my@path=split(/\t/,$path,3);if (@_){my$new=shift;$path[$fno]=$new;pop(@path)while@path &&!defined($path[-1]);for (@path){$_="" unless defined}$path=$gtype;$path="1" unless defined$path;$path .= join("\t",@path);$self->path_query($path)}$path[$fno]}1; URI_GOPHER $fatpacked{"URI/http.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HTTP'; package URI::http;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_server';sub default_port {80}sub canonical {my$self=shift;my$other=$self->SUPER::canonical;my$slash_path=defined($other->authority)&& !length($other->path)&&!defined($other->query);if ($slash_path){$other=$other->clone if$other==$self;$other->path("/")}$other}1; URI_HTTP $fatpacked{"URI/https.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_HTTPS'; package URI::https;use strict;use warnings;our$VERSION='1.74';use parent 'URI::http';sub default_port {443}sub secure {1}1; URI_HTTPS $fatpacked{"URI/ldap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAP'; package URI::ldap;use strict;use warnings;our$VERSION='1.74';use parent qw(URI::_ldap URI::_server);sub default_port {389}sub _nonldap_canonical {my$self=shift;$self->URI::_server::canonical(@_)}1; URI_LDAP $fatpacked{"URI/ldapi.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAPI'; package URI::ldapi;use strict;use warnings;our$VERSION='1.74';use parent qw(URI::_ldap URI::_generic);require URI::Escape;sub un_path {my$self=shift;my$old=URI::Escape::uri_unescape($self->authority);if (@_){my$p=shift;$p =~ s/:/%3A/g;$p =~ s/\@/%40/g;$self->authority($p)}return$old}sub _nonldap_canonical {my$self=shift;$self->URI::_generic::canonical(@_)}1; URI_LDAPI $fatpacked{"URI/ldaps.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_LDAPS'; package URI::ldaps;use strict;use warnings;our$VERSION='1.74';use parent 'URI::ldap';sub default_port {636}sub secure {1}1; URI_LDAPS $fatpacked{"URI/mailto.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_MAILTO'; package URI::mailto;use strict;use warnings;our$VERSION='1.74';use parent qw(URI URI::_query);sub to {my$self=shift;my@old=$self->headers;if (@_){my@new=@old;for (my$i=0;$i < @new;$i += 2){if (lc($new[$i]|| '')eq "to"){splice(@new,$i,2);redo}}my$to=shift;$to="" unless defined$to;unshift(@new,"to"=>$to);$self->headers(@new)}return unless defined wantarray;my@to;while (@old){my$h=shift@old;my$v=shift@old;push(@to,$v)if lc($h)eq "to"}join(",",@to)}sub headers {my$self=shift;my$opaque="to=" .$self->opaque;$opaque =~ s/\?/&/;if (@_){my@new=@_;my@to;for (my$i=0;$i < @new;$i += 2){if (lc($new[$i]|| '')eq "to"){push(@to,(splice(@new,$i,2))[1]);redo}}my$new=join(",",@to);$new =~ s/%/%25/g;$new =~ s/\?/%3F/g;$self->opaque($new);$self->query_form(@new)if@new}return unless defined wantarray;URI->new("mailto:?$opaque")->query_form}1; URI_MAILTO $fatpacked{"URI/mms.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_MMS'; package URI::mms;use strict;use warnings;our$VERSION='1.74';use parent 'URI::http';sub default_port {1755}1; URI_MMS $fatpacked{"URI/news.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_NEWS'; package URI::news;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_server';use URI::Escape qw(uri_unescape);use Carp ();sub default_port {119}sub _group {my$self=shift;my$old=$self->path;if (@_){my($group,$from,$to)=@_;if ($group =~ /\@/){$group =~ s/^<(.*)>$/$1/}$group =~ s,%,%25,g;$group =~ s,/,%2F,g;my$path=$group;if (defined$from){$path .= "/$from";$path .= "-$to" if defined$to}$self->path($path)}$old =~ s,^/,,;if ($old !~ /\@/ && $old =~ s,/(.*),, && wantarray){my$extra=$1;return (uri_unescape($old),split(/-/,$extra))}uri_unescape($old)}sub group {my$self=shift;if (@_){Carp::croak("Group name can't contain '\@'")if $_[0]=~ /\@/}my@old=$self->_group(@_);return if$old[0]=~ /\@/;wantarray ? @old : $old[0]}sub message {my$self=shift;if (@_){Carp::croak("Message must contain '\@'")unless $_[0]=~ /\@/}my$old=$self->_group(@_);return undef unless$old =~ /\@/;return$old}1; URI_NEWS $fatpacked{"URI/nntp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_NNTP'; package URI::nntp;use strict;use warnings;our$VERSION='1.74';use parent 'URI::news';1; URI_NNTP $fatpacked{"URI/pop.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_POP'; package URI::pop;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_server';use URI::Escape qw(uri_unescape);sub default_port {110}sub user {my$self=shift;my$old=$self->userinfo;if (@_){my$new_info=$old;$new_info="" unless defined$new_info;$new_info =~ s/^[^;]*//;my$new=shift;if (!defined($new)&&!length($new_info)){$self->userinfo(undef)}else {$new="" unless defined$new;$new =~ s/%/%25/g;$new =~ s/;/%3B/g;$self->userinfo("$new$new_info")}}return undef unless defined$old;$old =~ s/;.*//;return uri_unescape($old)}sub auth {my$self=shift;my$old=$self->userinfo;if (@_){my$new=$old;$new="" unless defined$new;$new =~ s/(^[^;]*)//;my$user=$1;$new =~ s/;auth=[^;]*//i;my$auth=shift;if (defined$auth){$auth =~ s/%/%25/g;$auth =~ s/;/%3B/g;$new=";AUTH=$auth$new"}$self->userinfo("$user$new")}return undef unless defined$old;$old =~ s/^[^;]*//;return uri_unescape($1)if$old =~ /;auth=(.*)/i;return}1; URI_POP $fatpacked{"URI/rlogin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RLOGIN'; package URI::rlogin;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_login';sub default_port {513}1; URI_RLOGIN $fatpacked{"URI/rsync.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RSYNC'; package URI::rsync;use strict;use warnings;our$VERSION='1.74';use parent qw(URI::_server URI::_userpass);sub default_port {873}1; URI_RSYNC $fatpacked{"URI/rtsp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RTSP'; package URI::rtsp;use strict;use warnings;our$VERSION='1.74';use parent 'URI::http';sub default_port {554}1; URI_RTSP $fatpacked{"URI/rtspu.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_RTSPU'; package URI::rtspu;use strict;use warnings;our$VERSION='1.74';use parent 'URI::rtsp';sub default_port {554}1; URI_RTSPU $fatpacked{"URI/sftp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SFTP'; package URI::sftp;use strict;use warnings;use parent 'URI::ssh';our$VERSION='1.74';1; URI_SFTP $fatpacked{"URI/sip.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SIP'; package URI::sip;use strict;use warnings;use parent qw(URI::_server URI::_userpass);use URI::Escape qw(uri_unescape);our$VERSION='1.74';sub default_port {5060}sub authority {my$self=shift;$$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;my$old=$2;if (@_){my$auth=shift;$$self=defined($1)? $1 : "";my$rest=$3;if (defined$auth){$auth =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;$$self .= "$auth"}$$self .= $rest}$old}sub params_form {my$self=shift;$$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;my$paramstr=$3;if (@_){my@args=@_;$$self=$1 .$2;my$rest=$4;my@new;for (my$i=0;$i < @args;$i += 2){push(@new,"$args[$i]=$args[$i+1]")}$paramstr=join(";",@new);$$self .= ";" .$paramstr .$rest}$paramstr =~ s/^;//o;return split(/[;=]/,$paramstr)}sub params {my$self=shift;$$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;my$paramstr=$3;if (@_){my$new=shift;$$self=$1 .$2;my$rest=$4;$$self .= $paramstr .$rest}$paramstr =~ s/^;//o;return$paramstr}sub path {}sub path_query {}sub path_segments {}sub abs {shift}sub rel {shift}sub query_keywords {}1; URI_SIP $fatpacked{"URI/sips.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SIPS'; package URI::sips;use strict;use warnings;our$VERSION='1.74';use parent 'URI::sip';sub default_port {5061}sub secure {1}1; URI_SIPS $fatpacked{"URI/snews.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SNEWS'; package URI::snews;use strict;use warnings;our$VERSION='1.74';use parent 'URI::news';sub default_port {563}sub secure {1}1; URI_SNEWS $fatpacked{"URI/ssh.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_SSH'; package URI::ssh;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_login';sub default_port {22}sub secure {1}1; URI_SSH $fatpacked{"URI/telnet.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_TELNET'; package URI::telnet;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_login';sub default_port {23}1; URI_TELNET $fatpacked{"URI/tn3270.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_TN3270'; package URI::tn3270;use strict;use warnings;our$VERSION='1.74';use parent 'URI::_login';sub default_port {23}1; URI_TN3270 $fatpacked{"URI/urn.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN'; package URI::urn;use strict;use warnings;our$VERSION='1.74';use parent 'URI';use Carp qw(carp);my%implementor;my%require_attempted;sub _init {my$class=shift;my$self=$class->SUPER::_init(@_);my$nid=$self->nid;my$impclass=$implementor{$nid};return$impclass->_urn_init($self,$nid)if$impclass;$impclass="URI::urn";if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/){my$id=$nid;$id =~ s/-/_/g;$id="_$id" if$id =~ /^\d/;$impclass="URI::urn::$id";no strict 'refs';unless (@{"${impclass}::ISA"}){if (not exists$require_attempted{$impclass}){my$_old_error=$@;eval "require $impclass";die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;$@=$_old_error}$impclass="URI::urn" unless @{"${impclass}::ISA"}}}else {carp("Illegal namespace identifier '$nid' for URN '$self'")if $^W}$implementor{$nid}=$impclass;return$impclass->_urn_init($self,$nid)}sub _urn_init {my($class,$self,$nid)=@_;bless$self,$class}sub _nid {my$self=shift;my$opaque=$self->opaque;if (@_){my$v=$opaque;my$new=shift;$v =~ s/[^:]*/$new/;$self->opaque($v)}$opaque =~ s/:.*//s;return$opaque}sub nid {my$self=shift;my$nid=$self->_nid(@_);$nid=lc($nid)if defined($nid);return$nid}sub nss {my$self=shift;my$opaque=$self->opaque;if (@_){my$v=$opaque;my$new=shift;if (defined$new){$v =~ s/(:|\z).*/:$new/}else {$v =~ s/:.*//s}$self->opaque($v)}return undef unless$opaque =~ s/^[^:]*://;return$opaque}sub canonical {my$self=shift;my$nid=$self->_nid;my$new=$self->SUPER::canonical;return$new if$nid !~ /[A-Z]/ || $nid =~ /%/;$new=$new->clone if$new==$self;$new->nid(lc($nid));return$new}1; URI_URN $fatpacked{"URI/urn/isbn.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN_ISBN'; package URI::urn::isbn;use strict;use warnings;our$VERSION='1.74';use parent 'URI::urn';use Carp qw(carp);BEGIN {require Business::ISBN;local $^W=0;warn "Using Business::ISBN version " .Business::ISBN->VERSION ." which is deprecated.\nUpgrade to Business::ISBN version 2\n" if Business::ISBN->VERSION < 2}sub _isbn {my$nss=shift;$nss=$nss->nss if ref($nss);my$isbn=Business::ISBN->new($nss);$isbn=undef if$isbn &&!$isbn->is_valid;return$isbn}sub _nss_isbn {my$self=shift;my$nss=$self->nss(@_);my$isbn=_isbn($nss);$isbn=$isbn->as_string if$isbn;return($nss,$isbn)}sub isbn {my$self=shift;my$isbn;(undef,$isbn)=$self->_nss_isbn(@_);return$isbn}sub isbn_publisher_code {my$isbn=shift->_isbn || return undef;return$isbn->publisher_code}BEGIN {my$group_method=do {local $^W=0;Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code'};sub isbn_group_code {my$isbn=shift->_isbn || return undef;return$isbn->$group_method}}sub isbn_country_code {my$name=(caller(0))[3];$name =~ s/.*:://;carp "$name is DEPRECATED. Use isbn_group_code instead";no strict 'refs';&isbn_group_code}BEGIN {my$isbn13_method=do {local $^W=0;Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean'};sub isbn13 {my$isbn=shift->_isbn || return undef;my$thingy=$isbn->$isbn13_method;return eval {$thingy->can('as_string')}? $thingy->as_string([]): $thingy}}sub isbn_as_ean {my$name=(caller(0))[3];$name =~ s/.*:://;carp "$name is DEPRECATED. Use isbn13 instead";no strict 'refs';&isbn13}sub canonical {my$self=shift;my($nss,$isbn)=$self->_nss_isbn;my$new=$self->SUPER::canonical;return$new unless$nss && $isbn && $nss ne $isbn;$new=$new->clone if$new==$self;$new->nss($isbn);return$new}1; URI_URN_ISBN $fatpacked{"URI/urn/oid.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'URI_URN_OID'; package URI::urn::oid;use strict;use warnings;our$VERSION='1.74';use parent 'URI::urn';sub oid {my$self=shift;my$old=$self->nss;if (@_){$self->nss(join(".",@_))}return split(/\./,$old)if wantarray;return$old}1; URI_URN_OID $fatpacked{"Win32/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'WIN32_SHELLQUOTE'; package Win32::ShellQuote;use strict;use warnings FATAL=>'all';use base 'Exporter';use Carp;our$VERSION='0.003001';$VERSION=eval$VERSION;our@EXPORT_OK=qw(quote_native quote_cmd quote_system_list quote_system_string quote_system quote_system_cmd quote_literal cmd_escape unquote_native cmd_unescape);our%EXPORT_TAGS=(all=>[@EXPORT_OK]);sub quote_native {return join q{ },quote_system_list(@_)}sub quote_cmd {return cmd_escape(quote_native(@_))}sub quote_system_list {return map {quote_literal($_,1)}@_}sub quote_system_string {my$args=quote_native(@_);if (_has_shell_metachars($args)){$args=cmd_escape($args)}return$args}sub quote_system {if (@_ > 1){return quote_system_list(@_)}else {return quote_system_string(@_)}}sub quote_system_cmd {my$args=quote_native(@_);if (!_has_shell_metachars($args)){return '%PATH:~0,0%' .cmd_escape($args)}return cmd_escape($args)}sub cmd_escape {my$string=shift;if ($string =~ /[\r\n\0]/){croak "can't quote newlines to pass through cmd.exe"}$string =~ s/([()%!^"<>&|])/^$1/g;return$string}sub quote_literal {my ($text,$force)=@_;if (!$force && $text ne '' && $text !~ /[ \t\n\x0b"]/){}else {$text =~ s{(\\*)(?="|\z)}{$1$1}g;$text =~ s{"}{\\"}g;$text=qq{"$text"}}return$text}sub _has_shell_metachars {my$string=shift;return 1 if$string =~ /%/;$string =~ s/(['"]).*?(\1|\z)//sg;return$string =~ /[<>|]/}sub unquote_native {local ($_)=@_;my@argv;my$length=length or return@argv;m/\G\s*/gc;ARGS: until (pos==$length){my$quote_mode;my$arg='';CHARS: until (pos==$length){if (m/\G((?:\\\\)+)(?=\\?(")?)/gc){if (defined $2){$arg .= '\\' x (length($1)/ 2)}else {$arg .= $1}}elsif (m/\G\\"/gc){$arg .= '"'}elsif (m/\G"/gc){if ($quote_mode && m/\G"/gc){$arg .= '"'}$quote_mode=!$quote_mode}elsif (!$quote_mode && m/\G\s+/gc){last}elsif (m/\G(.)/sgc){$arg .= $1}}push@argv,$arg}return@argv}sub cmd_unescape {my ($string)=@_;no warnings 'uninitialized';$string =~ s/\^(.?)|([^^"]+)|("[^"]*(?:"|\z))/$1$2$3/gs;return$string}1; WIN32_SHELLQUOTE $fatpacked{"lib/core/only.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIB_CORE_ONLY'; package lib::core::only;use strict;use warnings FATAL=>'all';use Config;sub import {@INC=@Config{qw(privlibexp archlibexp)};return}1; LIB_CORE_ONLY $fatpacked{"local/lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCAL_LIB'; package local::lib;use 5.006;BEGIN {if ($ENV{RELEASE_TESTING}){require strict;strict->import;require warnings;warnings->import}}use Config ();our$VERSION='2.000024';$VERSION=eval$VERSION;BEGIN {*_WIN32=($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'symbian')? sub(){1}: sub(){0};*_USE_FSPEC=($^O eq 'MacOS' || $^O eq 'VMS' || $INC{'File/Spec.pm'})? sub(){1}: sub(){0}}my$_archname=$Config::Config{archname};my$_version=$Config::Config{version};my@_inc_version_list=reverse split / /,$Config::Config{inc_version_list};my$_path_sep=$Config::Config{path_sep};our$_DIR_JOIN=_WIN32 ? '\\' : '/';our$_DIR_SPLIT=(_WIN32 || $^O eq 'cygwin')? qr{[\\/]} : qr{/};our$_ROOT=_WIN32 ? do {my$UNC=qr{[\\/]{2}[^\\/]+[\\/][^\\/]+};qr{^(?:$UNC|[A-Za-z]:|)$_DIR_SPLIT}}: qr{^/};our$_PERL;sub _perl {if (!$_PERL){($_PERL,my$exe)=$^X =~ /((?:.*$_DIR_SPLIT)?(.+))/;$_PERL='perl' if$exe !~ /perl/;if (_is_abs($_PERL)){}elsif (-x $Config::Config{perlpath}){$_PERL=$Config::Config{perlpath}}elsif ($_PERL =~ $_DIR_SPLIT && -x $_PERL){$_PERL=_rel2abs($_PERL)}else {($_PERL)=map {/(.*)/}grep {-x $_}map {($_,_WIN32 ? ("$_.exe"): ())}map {join($_DIR_JOIN,$_,$_PERL)}split /\Q$_path_sep\E/,$ENV{PATH}}}$_PERL}sub _cwd {if (my$cwd =defined&Cwd::sys_cwd ? \&Cwd::sys_cwd : defined&Cwd::cwd ? \&Cwd::cwd : undef){no warnings 'redefine';*_cwd=$cwd;goto &$cwd}my$drive=shift;return Win32::Cwd()if _WIN32 && defined&Win32::Cwd &&!$drive;local@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};my$cmd=$drive ? "eval { Cwd::getdcwd(q($drive)) }" : 'getcwd';my$perl=_perl;my$cwd=`"$perl" -MCwd -le "print $cmd"`;chomp$cwd;if (!length$cwd && $drive){$cwd=$drive}$cwd =~ s/$_DIR_SPLIT?$/$_DIR_JOIN/;$cwd}sub _catdir {if (_USE_FSPEC){require File::Spec;File::Spec->catdir(@_)}else {my$dir=join($_DIR_JOIN,@_);$dir =~ s{($_DIR_SPLIT)(?:\.?$_DIR_SPLIT)+}{$1}g;$dir}}sub _is_abs {if (_USE_FSPEC){require File::Spec;File::Spec->file_name_is_absolute($_[0])}else {$_[0]=~ $_ROOT}}sub _rel2abs {my ($dir,$base)=@_;return$dir if _is_abs($dir);$base=_WIN32 && $dir =~ s/^([A-Za-z]:)// ? _cwd("$1"): $base ? _rel2abs($base): _cwd;return _catdir($base,$dir)}our$_DEVNULL;sub _devnull {return$_DEVNULL ||= _USE_FSPEC ? (require File::Spec,File::Spec->devnull): _WIN32 ? 'nul' : $^O eq 'os2' ? '/dev/nul' : '/dev/null'}sub import {my ($class,@args)=@_;if ($0 eq '-'){push@args,@ARGV;require Cwd}my@steps;my%opts;my%attr;my$shelltype;while (@args){my$arg=shift@args;if ($arg =~ /\xE2\x88\x92/){die <<'DEATH'}elsif ($arg eq '--self-contained'){die <<'DEATH'}elsif($arg =~ /^--deactivate(?:=(.*))?$/){my$path=defined $1 ? $1 : shift@args;push@steps,['deactivate',$path]}elsif ($arg eq '--deactivate-all'){push@steps,['deactivate_all']}elsif ($arg =~ /^--shelltype(?:=(.*))?$/){$shelltype=defined $1 ? $1 : shift@args}elsif ($arg eq '--no-create'){$opts{no_create}=1}elsif ($arg eq '--quiet'){$attr{quiet}=1}elsif ($arg =~ /^--/){die "Unknown import argument: $arg"}else {push@steps,['activate',$arg,\%opts]}}if (!@steps){push@steps,['activate',undef,\%opts]}my$self=$class->new(%attr);for (@steps){my ($method,@args)=@$_;$self=$self->$method(@args)}if ($0 eq '-'){print$self->environment_vars_string($shelltype);exit 0}else {$self->setup_local_lib}}sub new {my$class=shift;bless {@_},$class}sub clone {my$self=shift;bless {%$self,@_},ref$self}sub inc {$_[0]->{inc}||= \@INC}sub libs {$_[0]->{libs}||= [\'PERL5LIB' ]}sub bins {$_[0]->{bins}||= [\'PATH' ]}sub roots {$_[0]->{roots}||= [\'PERL_LOCAL_LIB_ROOT' ]}sub extra {$_[0]->{extra}||= {}}sub quiet {$_[0]->{quiet}}sub _as_list {my$list=shift;grep length,map {!(ref $_ && ref $_ eq 'SCALAR')? $_ : (defined$ENV{$$_}? split(/\Q$_path_sep/,$ENV{$$_}): ())}ref$list ? @$list : $list}sub _remove_from {my ($list,@remove)=@_;return @$list if!@remove;my%remove=map {$_=>1}@remove;grep!$remove{$_},_as_list($list)}my@_lib_subdirs=([$_version,$_archname],[$_version],[$_archname],(map [$_],@_inc_version_list),[],);sub install_base_bin_path {my ($class,$path)=@_;return _catdir($path,'bin')}sub install_base_perl_path {my ($class,$path)=@_;return _catdir($path,'lib','perl5')}sub install_base_arch_path {my ($class,$path)=@_;_catdir($class->install_base_perl_path($path),$_archname)}sub lib_paths_for {my ($class,$path)=@_;my$base=$class->install_base_perl_path($path);return map {_catdir($base,@$_)}@_lib_subdirs}sub _mm_escape_path {my$path=shift;$path =~ s/\\/\\\\/g;if ($path =~ s/ /\\ /g){$path=qq{"$path"}}return$path}sub _mb_escape_path {my$path=shift;$path =~ s/\\/\\\\/g;return qq{"$path"}}sub installer_options_for {my ($class,$path)=@_;return (PERL_MM_OPT=>defined$path ? "INSTALL_BASE="._mm_escape_path($path): undef,PERL_MB_OPT=>defined$path ? "--install_base "._mb_escape_path($path): undef,)}sub active_paths {my ($self)=@_;$self=ref$self ? $self : $self->new;return grep {my$active_ll=$self->install_base_perl_path($_);grep {$_ eq $active_ll}@{$self->inc}}_as_list($self->roots)}sub deactivate {my ($self,$path)=@_;$self=$self->new unless ref$self;$path=$self->resolve_path($path);$path=$self->normalize_path($path);my@active_lls=$self->active_paths;if (!grep {$_ eq $path}@active_lls){warn "Tried to deactivate inactive local::lib '$path'\n";return$self}my%args=(bins=>[_remove_from($self->bins,$self->install_base_bin_path($path))],libs=>[_remove_from($self->libs,$self->install_base_perl_path($path))],inc=>[_remove_from($self->inc,$self->lib_paths_for($path))],roots=>[_remove_from($self->roots,$path)],);$args{extra}={$self->installer_options_for($args{roots}[0])};$self->clone(%args)}sub deactivate_all {my ($self)=@_;$self=$self->new unless ref$self;my@active_lls=$self->active_paths;my%args;if (@active_lls){%args=(bins=>[_remove_from($self->bins,map$self->install_base_bin_path($_),@active_lls)],libs=>[_remove_from($self->libs,map$self->install_base_perl_path($_),@active_lls)],inc=>[_remove_from($self->inc,map$self->lib_paths_for($_),@active_lls)],roots=>[_remove_from($self->roots,@active_lls)],)}$args{extra}={$self->installer_options_for(undef)};$self->clone(%args)}sub activate {my ($self,$path,$opts)=@_;$opts ||= {};$self=$self->new unless ref$self;$path=$self->resolve_path($path);$self->ensure_dir_structure_for($path,{quiet=>$self->quiet })unless$opts->{no_create};$path=$self->normalize_path($path);my@active_lls=$self->active_paths;if (grep {$_ eq $path}@active_lls[1 .. $#active_lls]){$self=$self->deactivate($path)}my%args;if ($opts->{always}||!@active_lls || $active_lls[0]ne $path){%args=(bins=>[$self->install_base_bin_path($path),@{$self->bins}],libs=>[$self->install_base_perl_path($path),@{$self->libs}],inc=>[$self->lib_paths_for($path),@{$self->inc}],roots=>[$path,@{$self->roots}],)}$args{extra}={$self->installer_options_for($path)};$self->clone(%args)}sub normalize_path {my ($self,$path)=@_;$path=(Win32::GetShortPathName($path)|| $path)if $^O eq 'MSWin32';return$path}sub build_environment_vars_for {my$self=$_[0]->new->activate($_[1],{always=>1 });$self->build_environment_vars}sub build_activate_environment_vars_for {my$self=$_[0]->new->activate($_[1],{always=>1 });$self->build_environment_vars}sub build_deactivate_environment_vars_for {my$self=$_[0]->new->deactivate($_[1]);$self->build_environment_vars}sub build_deact_all_environment_vars_for {my$self=$_[0]->new->deactivate_all;$self->build_environment_vars}sub build_environment_vars {my$self=shift;(PATH=>join($_path_sep,_as_list($self->bins)),PERL5LIB=>join($_path_sep,_as_list($self->libs)),PERL_LOCAL_LIB_ROOT=>join($_path_sep,_as_list($self->roots)),%{$self->extra},)}sub setup_local_lib_for {my$self=$_[0]->new->activate($_[1]);$self->setup_local_lib}sub setup_local_lib {my$self=shift;require Carp::Heavy if$INC{'Carp.pm'};$self->setup_env_hash;@INC=@{$self->inc}}sub setup_env_hash_for {my$self=$_[0]->new->activate($_[1]);$self->setup_env_hash}sub setup_env_hash {my$self=shift;my%env=$self->build_environment_vars;for my$key (keys%env){if (defined$env{$key}){$ENV{$key}=$env{$key}}else {delete$ENV{$key}}}}sub print_environment_vars_for {print $_[0]->environment_vars_string_for(@_[1..$#_])}sub environment_vars_string_for {my$self=$_[0]->new->activate($_[1],{always=>1});$self->environment_vars_string}sub environment_vars_string {my ($self,$shelltype)=@_;$shelltype ||= $self->guess_shelltype;my$extra=$self->extra;my@envs=(PATH=>$self->bins,PERL5LIB=>$self->libs,PERL_LOCAL_LIB_ROOT=>$self->roots,map {$_=>$extra->{$_}}sort keys %$extra,);$self->_build_env_string($shelltype,\@envs)}sub _build_env_string {my ($self,$shelltype,$envs)=@_;my@envs=@$envs;my$build_method="build_${shelltype}_env_declaration";my$out='';while (@envs){my ($name,$value)=(shift(@envs),shift(@envs));if (ref$value && @$value==1 && ref$value->[0]&& ref$value->[0]eq 'SCALAR' && ${$value->[0]}eq $name){next}$out .= $self->$build_method($name,$value)}my$wrap_method="wrap_${shelltype}_output";if ($self->can($wrap_method)){return$self->$wrap_method($out)}return$out}sub build_bourne_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'${%s:-}',qr/["\\\$!`]/,'\\%s');if (!defined$value){return qq{unset $name;\n}}$value =~ s/(^|\G|$_path_sep)\$\{$name:-\}$_path_sep/$1\${$name}\${$name:+$_path_sep}/g;$value =~ s/$_path_sep\$\{$name:-\}$/\${$name:+$_path_sep\${$name}}/;qq{${name}="$value"; export ${name};\n}}sub build_csh_env_declaration {my ($class,$name,$args)=@_;my ($value,@vars)=$class->_interpolate($args,'${%s}',qr/["\$]/,'"\\%s"');if (!defined$value){return qq{unsetenv $name;\n}}my$out='';for my$var (@vars){$out .= qq{if ! \$?$name setenv $name '';\n}}my$value_without=$value;if ($value_without =~ s/(?:^|$_path_sep)\$\{$name\}(?:$_path_sep|$)//g){$out .= qq{if "\${$name}" != '' setenv $name "$value";\n};$out .= qq{if "\${$name}" == '' }}$out .= qq{setenv $name "$value_without";\n};return$out}sub build_cmd_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'%%%s%%',qr(%),'%s');if (!$value){return qq{\@set $name=\n}}my$out='';my$value_without=$value;if ($value_without =~ s/(?:^|$_path_sep)%$name%(?:$_path_sep|$)//g){$out .= qq{\@if not "%$name%"=="" set "$name=$value"\n};$out .= qq{\@if "%$name%"=="" }}$out .= qq{\@set "$name=$value_without"\n};return$out}sub build_powershell_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'$env:%s',qr/["\$]/,'`%s');if (!$value){return qq{Remove-Item -ErrorAction 0 Env:\\$name;\n}}my$maybe_path_sep=qq{\$(if("\$env:$name"-eq""){""}else{"$_path_sep"})};$value =~ s/(^|\G|$_path_sep)\$env:$name$_path_sep/$1\$env:$name"+$maybe_path_sep+"/g;$value =~ s/$_path_sep\$env:$name$/"+$maybe_path_sep+\$env:$name+"/;qq{\$env:$name = \$("$value");\n}}sub wrap_powershell_output {my ($class,$out)=@_;return$out || " \n"}sub build_fish_env_declaration {my ($class,$name,$args)=@_;my$value=$class->_interpolate($args,'$%s',qr/[\\"'$ ]/,'\\%s');if (!defined$value){return qq{set -e $name;\n}}if ($name =~ /^(?:CD|MAN)?PATH$/){$value =~ s/$_path_sep/ /g;my$silent=$name =~ /^(?:CD)?PATH$/ ? " ^"._devnull : '';return qq{set -x $name $value$silent;\n}}my$out='';my$value_without=$value;if ($value_without =~ s/(?:^|$_path_sep)\$$name(?:$_path_sep|$)//g){$out .= qq{set -q $name; and set -x $name $value;\n};$out .= qq{set -q $name; or }}$out .= qq{set -x $name $value_without;\n};$out}sub _interpolate {my ($class,$args,$var_pat,$escape,$escape_pat)=@_;return unless defined$args;my@args=ref$args ? @$args : $args;return unless@args;my@vars=map {$$_}grep {ref $_ eq 'SCALAR'}@args;my$string=join$_path_sep,map {ref $_ eq 'SCALAR' ? sprintf($var_pat,$$_): do {s/($escape)/sprintf($escape_pat, $1)/ge;$_}}@args;return wantarray ? ($string,\@vars): $string}sub pipeline;sub pipeline {my@methods=@_;my$last=pop(@methods);if (@methods){\sub {my ($obj,@args)=@_;$obj->${pipeline@methods}($obj->$last(@args))}}else {\sub {shift->$last(@_)}}}sub resolve_path {my ($class,$path)=@_;$path=$class->${pipeline qw(resolve_relative_path resolve_home_path resolve_empty_path)}($path);$path}sub resolve_empty_path {my ($class,$path)=@_;if (defined$path){$path}else {'~/perl5'}}sub resolve_home_path {my ($class,$path)=@_;$path =~ /^~([^\/]*)/ or return$path;my$user=$1;my$homedir=do {if (!length($user)&& defined$ENV{HOME}){$ENV{HOME}}else {require File::Glob;File::Glob::bsd_glob("~$user",File::Glob::GLOB_TILDE())}};unless (defined$homedir){require Carp;require Carp::Heavy;Carp::croak("Couldn't resolve homedir for " .(defined$user ? $user : 'current user'))}$path =~ s/^~[^\/]*/$homedir/;$path}sub resolve_relative_path {my ($class,$path)=@_;_rel2abs($path)}sub ensure_dir_structure_for {my ($class,$path,$opts)=@_;$opts ||= {};my@dirs;for my$dir ($class->lib_paths_for($path),$class->install_base_bin_path($path),){my$d=$dir;while (!-d $d){push@dirs,$d;require File::Basename;$d=File::Basename::dirname($d)}}warn "Attempting to create directory ${path}\n" if!$opts->{quiet}&& @dirs;my%seen;for my$dir (reverse@dirs){next if$seen{$dir}++;mkdir$dir or -d $dir or die "Unable to create $dir: $!"}return}sub guess_shelltype {my$shellbin =defined$ENV{SHELL}&& length$ENV{SHELL}? ($ENV{SHELL}=~ /([\w.]+)$/)[-1]: ($^O eq 'MSWin32' && exists$ENV{'!EXITCODE'})? 'bash' : ($^O eq 'MSWin32' && $ENV{PROMPT}&& $ENV{COMSPEC})? ($ENV{COMSPEC}=~ /([\w.]+)$/)[-1]: ($^O eq 'MSWin32' &&!$ENV{PROMPT})? 'powershell.exe' : 'sh';for ($shellbin){return /csh$/ ? 'csh' : /fish$/ ? 'fish' : /command(?:\.com)?$/i ? 'cmd' : /cmd(?:\.exe)?$/i ? 'cmd' : /4nt(?:\.exe)?$/i ? 'cmd' : /powershell(?:\.exe)?$/i ? 'powershell' : 'bourne'}}1; WHOA THERE! It looks like you've got some fancy dashes in your commandline! These are *not* the traditional -- dashes that software recognizes. You probably got these by copy-pasting from the perldoc for this module as rendered by a UTF8-capable formatter. This most typically happens on an OS X terminal, but can happen elsewhere too. Please try again after replacing the dashes with normal minus signs. DEATH FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise). DEATH LOCAL_LIB $fatpacked{"parent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARENT'; package parent;use strict;use vars qw($VERSION);$VERSION='0.236';sub import {my$class=shift;my$inheritor=caller(0);if (@_ and $_[0]eq '-norequire'){shift @_}else {for (my@filename=@_){s{::|'}{/}g;require "$_.pm"}}{no strict 'refs';push @{"$inheritor\::ISA"},@_}};1; PARENT $fatpacked{"version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION'; package version;use 5.006002;use strict;use warnings::register;if ($] >= 5.015){warnings::register_categories(qw/version/)}our$VERSION=0.9924;our$CLASS='version';our (@ISA,$STRICT,$LAX);{local$SIG{'__DIE__'};if (1){eval "use version::vpp $VERSION";die "$@" if ($@);push@ISA,"version::vpp";local $^W;*version::qv=\&version::vpp::qv;*version::declare=\&version::vpp::declare;*version::_VERSION=\&version::vpp::_VERSION;*version::vcmp=\&version::vpp::vcmp;*version::new=\&version::vpp::new;*version::numify=\&version::vpp::numify;*version::normal=\&version::vpp::normal;if ($] >= 5.009000){no strict 'refs';*version::stringify=\&version::vpp::stringify;*{'version::(""'}=\&version::vpp::stringify;*{'version::(<=>'}=\&version::vpp::vcmp;*{'version::(cmp'}=\&version::vpp::vcmp;*version::parse=\&version::vpp::parse}}else {push@ISA,"version::vxs";local $^W;*version::declare=\&version::vxs::declare;*version::qv=\&version::vxs::qv;*version::_VERSION=\&version::vxs::_VERSION;*version::vcmp=\&version::vxs::VCMP;*version::new=\&version::vxs::new;*version::numify=\&version::vxs::numify;*version::normal=\&version::vxs::normal;if ($] >= 5.009000){no strict 'refs';*version::stringify=\&version::vxs::stringify;*{'version::(""'}=\&version::vxs::stringify;*{'version::(<=>'}=\&version::vxs::VCMP;*{'version::(cmp'}=\&version::vxs::VCMP;*version::parse=\&version::vxs::parse}}}require version::regex;*version::is_lax=\&version::regex::is_lax;*version::is_strict=\&version::regex::is_strict;*LAX=\$version::regex::LAX;*LAX_DECIMAL_VERSION=\$version::regex::LAX_DECIMAL_VERSION;*LAX_DOTTED_DECIMAL_VERSION=\$version::regex::LAX_DOTTED_DECIMAL_VERSION;*STRICT=\$version::regex::STRICT;*STRICT_DECIMAL_VERSION=\$version::regex::STRICT_DECIMAL_VERSION;*STRICT_DOTTED_DECIMAL_VERSION=\$version::regex::STRICT_DOTTED_DECIMAL_VERSION;sub import {no strict 'refs';my ($class)=shift;unless ($class eq $CLASS){local $^W;*{$class.'::declare'}=\&{$CLASS.'::declare'};*{$class.'::qv'}=\&{$CLASS.'::qv'}}my%args;if (@_){map {$args{$_}=1}@_}else {%args=(qv=>1,'UNIVERSAL::VERSION'=>1,)}my$callpkg=caller();if (exists($args{declare})){*{$callpkg.'::declare'}=sub {return$class->declare(shift)}unless defined(&{$callpkg.'::declare'})}if (exists($args{qv})){*{$callpkg.'::qv'}=sub {return$class->qv(shift)}unless defined(&{$callpkg.'::qv'})}if (exists($args{'UNIVERSAL::VERSION'})){local $^W;*UNIVERSAL::VERSION =\&{$CLASS.'::_VERSION'}}if (exists($args{'VERSION'})){*{$callpkg.'::VERSION'}=\&{$CLASS.'::_VERSION'}}if (exists($args{'is_strict'})){*{$callpkg.'::is_strict'}=\&{$CLASS.'::is_strict'}unless defined(&{$callpkg.'::is_strict'})}if (exists($args{'is_lax'})){*{$callpkg.'::is_lax'}=\&{$CLASS.'::is_lax'}unless defined(&{$callpkg.'::is_lax'})}}1; VERSION $fatpacked{"version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_REGEX'; package version::regex;use strict;our$VERSION=0.9924;my$FRACTION_PART=qr/\.[0-9]+/;my$STRICT_INTEGER_PART=qr/0|[1-9][0-9]*/;my$LAX_INTEGER_PART=qr/[0-9]+/;my$STRICT_DOTTED_DECIMAL_PART=qr/\.[0-9]{1,3}/;my$LAX_DOTTED_DECIMAL_PART=qr/\.[0-9]+/;my$LAX_ALPHA_PART=qr/_[0-9]+/;our$STRICT_DECIMAL_VERSION=qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;our$STRICT_DOTTED_DECIMAL_VERSION=qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;our$STRICT=qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;our$LAX_DECIMAL_VERSION=qr/ $LAX_INTEGER_PART (?: $FRACTION_PART | \. )? $LAX_ALPHA_PART? | $FRACTION_PART $LAX_ALPHA_PART? /x;our$LAX_DOTTED_DECIMAL_VERSION=qr/ v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )? | $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART? /x;our$LAX=qr/ undef | $LAX_DOTTED_DECIMAL_VERSION | $LAX_DECIMAL_VERSION /x;sub is_strict {defined $_[0]&& $_[0]=~ qr/ \A $STRICT \z /x}sub is_lax {defined $_[0]&& $_[0]=~ qr/ \A $LAX \z /x}1; VERSION_REGEX $fatpacked{"version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_VPP'; package charstar;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)){$right=$left->new($right)}return$left->{current}<=> $right->{current}}sub cmp {my ($left,$right,$swapped)=@_;unless (ref($right)){if (length($right)==1){return$left->thischar cmp $right}$right=$left->new($right)}return$left->currstr cmp $right->currstr}sub bool {my ($self)=@_;my$char=$self->thischar;return ($char ne '')}sub clone {my ($left,$right,$swapped)=@_;$right={string=>[@{$left->{string}}],current=>$left->{current},};return bless$right,ref($left)}sub currstr {my ($self,$s)=@_;my$curr=$self->{current};my$last=$#{$self->{string}};if (defined($s)&& $s->{current}< $last){$last=$s->{current}}my$string=join('',@{$self->{string}}[$curr..$last]);return$string}package version::vpp;use 5.006002;use strict;use warnings::register;use Config;our$VERSION=0.9924;our$CLASS='version::vpp';our ($LAX,$STRICT,$WARN_CATEGORY);if ($] > 5.015){warnings::register_categories(qw/version/);$WARN_CATEGORY='version'}else {$WARN_CATEGORY='numeric'}require version::regex;*version::vpp::is_strict=\&version::regex::is_strict;*version::vpp::is_lax=\&version::regex::is_lax;*LAX=\$version::regex::LAX;*STRICT=\$version::regex::STRICT;use overload ('""'=>\&stringify,'0+'=>\&numify,'cmp'=>\&vcmp,'<=>'=>\&vcmp,'bool'=>\&vbool,'+'=>\&vnoop,'-'=>\&vnoop,'*'=>\&vnoop,'/'=>\&vnoop,'+='=>\&vnoop,'-='=>\&vnoop,'*='=>\&vnoop,'/='=>\&vnoop,'abs'=>\&vnoop,);sub import {no strict 'refs';my ($class)=shift;unless ($class eq $CLASS){local $^W;*{$class.'::declare'}=\&{$CLASS.'::declare'};*{$class.'::qv'}=\&{$CLASS.'::qv'}}my%args;if (@_){map {$args{$_}=1}@_}else {%args=(qv=>1,'UNIVERSAL::VERSION'=>1,)}my$callpkg=caller();if (exists($args{declare})){*{$callpkg.'::declare'}=sub {return$class->declare(shift)}unless defined(&{$callpkg.'::declare'})}if (exists($args{qv})){*{$callpkg.'::qv'}=sub {return$class->qv(shift)}unless defined(&{$callpkg.'::qv'})}if (exists($args{'UNIVERSAL::VERSION'})){no warnings qw/redefine/;*UNIVERSAL::VERSION =\&{$CLASS.'::_VERSION'}}if (exists($args{'VERSION'})){*{$callpkg.'::VERSION'}=\&{$CLASS.'::_VERSION'}}if (exists($args{'is_strict'})){*{$callpkg.'::is_strict'}=\&{$CLASS.'::is_strict'}unless defined(&{$callpkg.'::is_strict'})}if (exists($args{'is_lax'})){*{$callpkg.'::is_lax'}=\&{$CLASS.'::is_lax'}unless defined(&{$callpkg.'::is_lax'})}}my$VERSION_MAX=0x7FFFFFFF;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'){$d++;if (isDIGIT($d)){$qv=TRUE}else {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)){return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)")}while (isDIGIT($d)){$d++}if ($d eq '.'){$saw_decimal++;$d++}else {if ($strict){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)){$i++;while (isDIGIT($d)){$d++;$j++;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){return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)")}}}else {my$j=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)")}}if ($d eq '-'){return BADVERSION($s,$errstr,"Invalid version format (negative version number)")}while (isDIGIT($d)){$d++}if ($d eq '.'){$saw_decimal++;$d++}elsif (!$d || $d eq ';' || isSPACE($d)|| $d eq '}'){if ($d==$s){return BADVERSION($s,$errstr,"Invalid version format (version required)")}goto version_prescan_finish}elsif ($d==$s){return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)")}elsif ($d eq '_'){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){return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)")}if ($d &&!isDIGIT($d)&& ($strict ||!($d eq ';' || isSPACE($d)|| $d eq '}'))){return BADVERSION($s,$errstr,"Invalid version format (fractional part required)")}while (isDIGIT($d)){$d++;$j++;if ($d eq '.' && isDIGIT($d-1)){if ($alpha){return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)")}if ($strict){return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')")}$d=$s;$qv=TRUE;goto dotted_decimal_version}if ($d eq '_'){if ($strict){return BADVERSION($s,$errstr,"Invalid version format (no underscores)")}if ($alpha){return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)")}if (!isDIGIT($d+1)){return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)")}$width=$j;$d++;$alpha=TRUE}}}version_prescan_finish: while (isSPACE($d)){$d++}if ($d &&!isDIGIT($d)&& (!($d eq ';' || $d eq '}'))){return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)")}if ($saw_decimal > 1 && ($d-1)eq '.'){return BADVERSION($s,$errstr,"Invalid version format (trailing decimal)")}if (defined$sqv){$$sqv=$qv}if (defined$swidth){$$swidth=$width}if (defined$ssaw_decimal){$$ssaw_decimal=$saw_decimal}if (defined$salpha){$$salpha=$alpha}return$d}sub scan_version {my ($s,$rv,$qv)=@_;my$start;my$pos;my$last;my$errstr;my$saw_decimal=0;my$width=3;my$alpha=FALSE;my$vinf=FALSE;my@av;$s=new charstar$s;while (isSPACE($s)){$s++}$last=prescan_version($s,FALSE,\$errstr,\$qv,\$saw_decimal,\$width,\$alpha);if ($errstr){if ($s ne 'undef'){require Carp;Carp::croak($errstr)}}$start=$s;if ($s eq 'v'){$s++}$pos=$s;if ($qv){$$rv->{qv}=$qv}if ($alpha){$$rv->{alpha}=$alpha}if (!$qv && $width < 3){$$rv->{width}=$width}while (isDIGIT($pos)|| $pos eq '_'){$pos++}if (!isALPHA($pos)){my$rev;for (;;){$rev=0;{my$end=$pos;my$mult=1;my$orev;if (!$qv && $s > $start && $saw_decimal==1){$mult *= 100;while ($s < $end){next if$s eq '_';$orev=$rev;$rev += $s * $mult;$mult /= 10;if ((abs($orev)> abs($rev))|| (abs($rev)> $VERSION_MAX)){warn("Integer overflow in version %d",$VERSION_MAX);$s=$end - 1;$rev=$VERSION_MAX;$vinf=1}$s++;if ($s eq '_'){$s++}}}else {while (--$end >= $s){next if$end eq '_';$orev=$rev;$rev += $end * $mult;$mult *= 10;if ((abs($orev)> abs($rev))|| (abs($rev)> $VERSION_MAX)){warn("Integer overflow in version");$end=$s - 1;$rev=$VERSION_MAX;$vinf=1}}}}push@av,$rev;if ($vinf){$s=$last;last}elsif ($pos eq '.'){$s=++$pos}elsif ($pos eq '_' && isDIGIT($pos+1)){$s=++$pos}elsif ($pos eq ',' && isDIGIT($pos+1)){$s=++$pos}elsif (isDIGIT($pos)){$s=$pos}else {$s=$pos;last}if ($qv){while (isDIGIT($pos)|| $pos eq '_'){$pos++}}else {my$digits=0;while ((isDIGIT($pos)|| $pos eq '_')&& $digits < 3){if ($pos ne '_'){$digits++}$pos++}}}}if ($qv){my$len=$#av;$len=2 - $len;while ($len-- > 0){push@av,0}}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'){$$rv->{original}='v' .$$rv->{original}}}else {$$rv->{original}='0';push(@av,0)}$$rv->{version}=\@av;if ($s eq 'undef'){$s += 5}return$s}sub new {my$class=shift;unless (defined$class or $#_ > 1){require Carp;Carp::croak('Usage: version::new(class, version)')}my$self=bless ({},ref ($class)|| $class);my$qv=FALSE;if ($#_==1){$qv=TRUE}my$value=pop;if (ref($value)&& eval('$value->isa("version")')){$self->{version}=[@{$value->{version}}];$self->{qv}=1 if$value->{qv};$self->{alpha}=1 if$value->{alpha};$self->{original}=''.$value->{original};return$self}if (not defined$value or $value =~ /^undef$/){push @{$self->{version}},0;$self->{original}="0";return ($self)}if (ref($value)=~ m/ARRAY|HASH/){require Carp;Carp::croak("Invalid version format (non-numeric data)")}$value=_un_vstring($value);if ($Config{d_setlocale}){use POSIX qw/locale_h/;use if$Config{d_setlocale},'locale';my$currlocale=setlocale(LC_ALL);if (localeconv()->{decimal_point}eq ','){$value =~ tr/,/./}}if ($value =~ /\d+.?\d*e[-+]?\d+/){$value=sprintf("%.9f",$value);$value =~ s/(0+)$//}my$s=scan_version($value,\$self,$qv);if ($s){warn(sprintf "Version string '%s' contains invalid data; " ."ignoring: '%s'",$value,$s)}return ($self)}*parse=\&new;sub numify {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}my$alpha=$self->{alpha}|| "";my$len=$#{$self->{version}};my$digit=$self->{version}[0];my$string=sprintf("%d.",$digit);if ($alpha and warnings::enabled()){warnings::warn($WARN_CATEGORY,'alpha->numify() is lossy')}for (my$i=1 ;$i <= $len ;$i++ ){$digit=$self->{version}[$i];$string .= sprintf("%03d",$digit)}if ($len==0){$string .= sprintf("000")}return$string}sub normal {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}my$len=$#{$self->{version}};my$digit=$self->{version}[0];my$string=sprintf("v%d",$digit);for (my$i=1 ;$i <= $len ;$i++ ){$digit=$self->{version}[$i];$string .= sprintf(".%d",$digit)}if ($len <= 2){for ($len=2 - $len;$len!=0;$len-- ){$string .= sprintf(".%0d",0)}}return$string}sub stringify {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}return exists$self->{original}? $self->{original}: exists$self->{qv}? $self->normal : $self->numify}sub vcmp {my ($left,$right,$swap)=@_;my$class=ref($left);unless (UNIVERSAL::isa($right,$class)){$right=$class->new($right)}if ($swap){($left,$right)=($right,$left)}unless (_verify($left)){require Carp;Carp::croak("Invalid version object")}unless (_verify($right)){require Carp;Carp::croak("Invalid version format")}my$l=$#{$left->{version}};my$r=$#{$right->{version}};my$m=$l < $r ? $l : $r;my$lalpha=$left->is_alpha;my$ralpha=$right->is_alpha;my$retval=0;my$i=0;while ($i <= $m && $retval==0){$retval=$left->{version}[$i]<=> $right->{version}[$i];$i++}if ($retval==0 && $l!=$r){if ($l < $r){while ($i <= $r && $retval==0){if ($right->{version}[$i]!=0){$retval=-1}$i++}}else {while ($i <= $l && $retval==0){if ($left->{version}[$i]!=0){$retval=+1}$i++}}}return$retval}sub vbool {my ($self)=@_;return vcmp($self,$self->new("0"),1)}sub vnoop {require Carp;Carp::croak("operation not supported with version object")}sub is_alpha {my ($self)=@_;return (exists$self->{alpha})}sub qv {my$value=shift;my$class=$CLASS;if (@_){$class=ref($value)|| $value;$value=shift}$value=_un_vstring($value);$value='v'.$value unless$value =~ /(^v|\d+\.\d+\.\d)/;my$obj=$CLASS->new($value);return bless$obj,$class}*declare=\&qv;sub is_qv {my ($self)=@_;return (exists$self->{qv})}sub _verify {my ($self)=@_;if (ref($self)&& eval {exists$self->{version}}&& ref($self->{version})eq 'ARRAY'){return 1}else {return 0}}sub _is_non_alphanumeric {my$s=shift;$s=new charstar$s;while ($s){return 0 if isSPACE($s);return 1 unless (isALPHA($s)|| isDIGIT($s)|| $s =~ /[.-]/);$s++}return 0}sub _un_vstring {my$value=shift;if (length($value)>= 1 && $value !~ /[,._]/ && _is_non_alphanumeric($value)){my$tvalue;if ($] >= 5.008_001){$tvalue=_find_magic_vstring($value);$value=$tvalue if length$tvalue}elsif ($] >= 5.006_000){$tvalue=sprintf("v%vd",$value);if ($tvalue =~ /^v\d+(\.\d+)*$/){$value=$tvalue}}}return$value}sub _find_magic_vstring {my$value=shift;my$tvalue='';require B;my$sv=B::svref_2object(\$value);my$magic=ref($sv)eq 'B::PVMG' ? $sv->MAGIC : undef;while ($magic){if ($magic->TYPE eq 'V'){$tvalue=$magic->PTR;$tvalue =~ s/^v?(.+)$/v$1/;last}else {$magic=$magic->MOREMAGIC}}$tvalue =~ tr/_//d;return$tvalue}sub _VERSION {my ($obj,$req)=@_;my$class=ref($obj)|| $obj;no strict 'refs';if (exists$INC{"$class.pm"}and not %{"$class\::"}and $] >= 5.008){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; VERSION_VPP s/^ //mg for values %fatpacked; my $class = 'FatPacked::'.(0+\%fatpacked); no strict 'refs'; *{"${class}::files"} = sub { keys %{$_[0]} }; if ($] < 5.008) { *{"${class}::INC"} = sub { if (my $fat = $_[0]{$_[1]}) { my $pos = 0; my $last = length $fat; return (sub { return 0 if $pos == $last; my $next = (1 + index $fat, "\n", $pos) || $last; $_ .= substr $fat, $pos, $next - $pos; $pos = $next; return 1; }); } }; } else { *{"${class}::INC"} = sub { if (my $fat = $_[0]{$_[1]}) { open my $fh, '<', \$fat or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; return $fh; } return; }; } unshift @INC, bless \%fatpacked, $class; } # END OF FATPACK CODE use strict; use App::cpanminus::script; unless (caller) { my $app = App::cpanminus::script->new(name => "App::cpanminus"); $app->parse_options(@ARGV); exit $app->doit; } __END__ =head1 NAME cpanm - get, unpack build and install modules from CPAN =head1 SYNOPSIS cpanm Test::More # install Test::More cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file cpanm --interactive Task::Kensho # Configure interactively cpanm . # install from local directory cpanm --installdeps . # install all the deps for the current directory cpanm -L extlib Plack # install Plack and all non-core deps into extlib cpanm --mirror http://cpan.cpantesters.org/ DBI # use the fast-syncing mirror cpanm --from https://cpan.metacpan.org/ Plack # use only the HTTPS mirror =head1 COMMANDS =over 4 =item (arguments) Command line arguments can be either a module name, distribution file, local file path, HTTP URL or git repository URL. Following commands will all work as you expect. cpanm Plack cpanm Plack/Request.pm cpanm MIYAGAWA/Plack-1.0000.tar.gz cpanm /path/to/Plack-1.0000.tar.gz cpanm http://cpan.metacpan.org/authors/id/M/MI/MIYAGAWA/Plack-0.9990.tar.gz cpanm git://github.com/plack/Plack.git Additionally, you can use the notation using C<~> and C<@> to specify version for a given module. C<~> specifies the version requirement in the L format, while C<@> pins the exact version, and is a shortcut for C<~"== VERSION">. cpanm Plack~1.0000 # 1.0000 or later cpanm Plack~">= 1.0000, < 2.0000" # latest of 1.xxxx cpanm Plack@0.9990 # specific version. same as Plack~"== 0.9990" The version query including specific version or range will be sent to L to search for previous releases. The query will search for BackPAN archives by default, unless you specify C<--dev> option, in which case, archived versions will be filtered out. For a git repository, you can specify a branch, tag, or commit SHA to build. The default is C cpanm git://github.com/plack/Plack.git@1.0000 # tag cpanm git://github.com/plack/Plack.git@devel # branch =item -i, --install Installs the modules. This is a default behavior and this is just a compatibility option to make it work like L or L. =item --self-upgrade Upgrades itself. It's just an alias for: cpanm App::cpanminus =item --info Displays the distribution information in C format in the standard out. =item --installdeps Installs the dependencies of the target distribution but won't build itself. Handy if you want to try the application from a version controlled repository such as git. cpanm --installdeps . =item --look Download and unpack the distribution and then open the directory with your shell. Handy to poke around the source code or do manual testing. =item -h, --help Displays the help message. =item -V, --version Displays the version number. =back =head1 OPTIONS You can specify the default options in C environment variable. =over 4 =item -f, --force Force install modules even when testing failed. =item -n, --notest Skip the testing of modules. Use this only when you just want to save time for installing hundreds of distributions to the same perl and architecture you've already tested to make sure it builds fine. Defaults to false, and you can say C<--no-notest> to override when it is set in the default options in C. =item --test-only Run the tests only, and do not install the specified module or distributions. Handy if you want to verify the new (or even old) releases pass its unit tests without installing the module. Note that if you specify this option with a module or distribution that has dependencies, these dependencies will be installed if you don't currently have them. =item -S, --sudo Switch to the root user with C when installing modules. Use this if you want to install modules to the system perl include path. Defaults to false, and you can say C<--no-sudo> to override when it is set in the default options in C. =item -v, --verbose Makes the output verbose. It also enables the interactive configuration. (See --interactive) =item -q, --quiet Makes the output even more quiet than the default. It only shows the successful/failed dependencies to the output. =item -l, --local-lib Sets the L compatible path to install modules to. You don't need to set this if you already configure the shell environment variables using L, but this can be used to override that as well. =item -L, --local-lib-contained Same with C<--local-lib> but with L<--self-contained> set. All non-core dependencies will be installed even if they're already installed. For instance, cpanm -L extlib Plack would install Plack and all of its non-core dependencies into the directory C, which can be loaded from your application with: use local::lib '/path/to/extlib'; Note that this option does B reliably work with perl installations supplied by operating system vendors that strips standard modules from perl, such as RHEL, Fedora and CentOS, B you also install packages supplying all the modules that have been stripped. For these systems you will probably want to install the C meta-package which does just that. =item --self-contained When examining the dependencies, assume no non-core modules are installed on the system. Handy if you want to bundle application dependencies in one directory so you can distribute to other machines. =item --exclude-vendor Don't include modules installed under the 'vendor' paths when searching for core modules when the C<--self-contained> flag is in effect. This restores the behaviour from before version 1.7023 =item --mirror Specifies the base URL for the CPAN mirror to use, such as C (you can omit the trailing slash). You can specify multiple mirror URLs by repeating the command line option. You can use a local directory that has a CPAN mirror structure (created by tools such as L or L) by using a special URL scheme C. If the given URL begins with `/` (without any scheme), it is considered as a file scheme as well. cpanm --mirror file:///path/to/mirror cpanm --mirror ~/minicpan # Because shell expands ~ to /home/user Defaults to C. =item --mirror-only Download the mirror's 02packages.details.txt.gz index file instead of querying the CPAN Meta DB. This will also effectively opt out sending your local perl versions to backend database servers such as CPAN Meta DB and MetaCPAN. Select this option if you are using a local mirror of CPAN, such as minicpan when you're offline, or your own CPAN index (a.k.a darkpan). =item --from, -M cpanm -M https://cpan.metacpan.org/ cpanm --from https://cpan.metacpan.org/ Use the given mirror URL and its index as the I source to search and download modules from. It works similar to C<--mirror> and C<--mirror-only> combined, with a small difference: unlike C<--mirror> which I the URL to the list of mirrors, C<--from> (or C<-M> for short) uses the specified URL as its I source to download index and modules from. This makes the option always override the default mirror, which might have been set via global options such as the one set by C environment variable. B It might be useful if you name these options with your shell aliases, like: alias minicpanm='cpanm --from ~/minicpan' alias darkpan='cpanm --from http://mycompany.example.com/DPAN' =item --mirror-index B: Specifies the file path to C<02packages.details.txt> for module search index. =item --cpanmetadb B: Specifies an alternate URI for CPAN MetaDB index lookups. =item --metacpan Prefers MetaCPAN API over CPAN MetaDB. =item --cpanfile B: Specified an alternate path for cpanfile to search for, when C<--installdeps> command is in use. Defaults to C. =item --prompt Prompts when a test fails so that you can skip, force install, retry or look in the shell to see what's going wrong. It also prompts when one of the dependency failed if you want to proceed the installation. Defaults to false, and you can say C<--no-prompt> to override if it's set in the default options in C. =item --dev B: search for a newer developer release as well. Defaults to false. =item --reinstall cpanm, when given a module name in the command line (i.e. C), checks the locally installed version first and skips if it is already installed. This option makes it skip the check, so: cpanm --reinstall Plack would reinstall L even if your locally installed version is latest, or even newer (which would happen if you install a developer release from version control repositories). Defaults to false. =item --interactive Makes the configuration (such as C and C) interactive, so you can answer questions in the distribution that requires custom configuration or Task:: distributions. Defaults to false, and you can say C<--no-interactive> to override when it's set in the default options in C. =item --pp, --pureperl Prefer Pure perl build of modules by setting C for MakeMaker and C<--pureperl-only> for Build.PL based distributions. Note that not all of the CPAN modules support this convention yet. =item --with-recommends, --with-suggests B: Installs dependencies declared as C and C respectively, per META spec. When these dependencies fail to install, cpanm continues the installation, since they're just recommendation/suggestion. Enabling this could potentially make a circular dependency for a few modules on CPAN, when C adds a module that C back the module in return. There's also C<--without-recommend> and C<--without-suggests> to override the default decision made earlier in C. Defaults to false for both. =item --with-develop B: Installs develop phase dependencies in META files or C when used with C<--installdeps>. Defaults to false. =item --with-configure B: Installs configure phase dependencies in C when used with C<--installdeps>. Defaults to false. =item --with-feature, --without-feature, --with-all-features B: Specifies the feature to enable, if a module supports optional features per META spec 2.0. cpanm --with-feature=opt_csv Spreadsheet::Read the features can also be interactively chosen when C<--interactive> option is enabled. C<--with-all-features> enables all the optional features, and C<--without-feature> can select a feature to disable. =item --configure-timeout, --build-timeout, --test-timeout Specify the timeout length (in seconds) to wait for the configure, build and test process. Current default values are: 60 for configure, 3600 for build and 1800 for test. =item --configure-args, --build-args, --test-args, --install-args B: Pass arguments for configure/build/test/install commands respectively, for a given module to install. cpanm DBD::mysql --configure-args="--cflags=... --libs=..." The argument is only enabled for the module passed as a command line argument, not dependencies. =item --scandeps B: Scans the depencencies of given modules and output the tree in a text format. (See C<--format> below for more options) Because this command doesn't actually install any distributions, it will be useful that by typing: cpanm --scandeps Catalyst::Runtime you can make sure what modules will be installed. This command takes into account which modules you already have installed in your system. If you want to see what modules will be installed against a vanilla perl installation, you might want to combine it with C<-L> option. =item --format B: Determines what format to display the scanned dependency tree. Available options are C, C, C and C. =over 8 =item tree Displays the tree in a plain text format. This is the default value. =item json, yaml Outputs the tree in a JSON or YAML format. L and L modules need to be installed respectively. The output tree is represented as a recursive tuple of: [ distribution, dependencies ] and the container is an array containing the root elements. Note that there may be multiple root nodes, since you can give multiple modules to the C<--scandeps> command. =item dists C is a special output format, where it prints the distribution filename in the I after the dependency resolution, like: GAAS/MIME-Base64-3.13.tar.gz GAAS/URI-1.58.tar.gz PETDANCE/HTML-Tagset-3.20.tar.gz GAAS/HTML-Parser-3.68.tar.gz GAAS/libwww-perl-5.837.tar.gz which means you can install these distributions in this order without extra dependencies. When combined with C<-L> option, it will be useful to replay installations on other machines. =back =item --save-dists Specifies the optional directory path to copy downloaded tarballs in the CPAN mirror compatible directory structure i.e. I If the distro tarball did not come from CPAN, for example from a local file or from GitHub, then it will be saved under I. =item --uninst-shadows Uninstalls the shadow files of the distribution that you're installing. This eliminates the confusion if you're trying to install core (dual-life) modules from CPAN against perl 5.10 or older, or modules that used to be XS-based but switched to pure perl at some version. If you run cpanm as root and use C or equivalent to specify custom installation path, you SHOULD disable this option so you won't accidentally uninstall dual-life modules from the core include path. Defaults to true if your perl version is smaller than 5.12, and you can disable that with C<--no-uninst-shadows>. B: Since version 1.3000 this flag is turned off by default for perl newer than 5.12, since with 5.12 @INC contains site_perl directory I the perl core library path, and uninstalling shadows is not necessary anymore and does more harm by deleting files from the core library path. =item --uninstall, -U Uninstalls a module from the library path. It finds a packlist for given modules, and removes all the files included in the same distribution. If you enable local::lib, it only removes files from the local::lib directory. If you try to uninstall a module in C directory (i.e. core module), an error will be thrown. A dialog will be prompted to confirm the files to be deleted. If you pass C<-f> option as well, the dialog will be skipped and uninstallation will be forced. =item --cascade-search B: Specifies whether to cascade search when you specify multiple mirrors and a mirror doesn't have a module or has a lower version of the module than requested. Defaults to false. =item --skip-installed Specifies whether a module given in the command line is skipped if its latest version is already installed. Defaults to true. B: The C environment variable have to be correctly set for this to work with modules installed using L, unless you always use the C<-l> option. =item --skip-satisfied B: Specifies whether a module (and version) given in the command line is skipped if it's already installed. If you run: cpanm --skip-satisfied CGI DBI~1.2 cpanm won't install them if you already have CGI (for whatever versions) or have DBI with version higher than 1.2. It is similar to C<--skip-installed> but while C<--skip-installed> checks if the I version of CPAN is installed, C<--skip-satisfied> checks if a requested version (or not, which means any version) is installed. Defaults to false. =item --verify Verify the integrity of distribution files retrieved from PAUSE using CHECKSUMS and SIGNATURES (if found). Defaults to false. =item --report-perl-version Whether it reports the locally installed perl version to the various web server as part of User-Agent. Defaults to true unless CI related environment variables such as C, C or C is enabled. You can disable it by using C<--no-report-perl-version>. =item --auto-cleanup Specifies the number of days in which cpanm's work directories expire. Defaults to 7, which means old work directories will be cleaned up in one week. You can set the value to C<0> to make cpan never cleanup those directories. =item --man-pages Generates man pages for executables (man1) and libraries (man3). Defaults to true (man pages generated) unless C<-L|--local-lib-contained> option is supplied in which case it's set to false. You can disable it with C<--no-man-pages>. =item --lwp Uses L module to download stuff over HTTP. Defaults to true, and you can say C<--no-lwp> to disable using LWP, when you want to upgrade LWP from CPAN on some broken perl systems. =item --wget Uses GNU Wget (if available) to download stuff. Defaults to true, and you can say C<--no-wget> to disable using Wget (versions of Wget older than 1.9 don't support the C<--retry-connrefused> option used by cpanm). =item --curl Uses cURL (if available) to download stuff. Defaults to true, and you can say C<--no-curl> to disable using cURL. Normally with C<--lwp>, C<--wget> and C<--curl> options set to true (which is the default) cpanm tries L, Wget, cURL and L (in that order) and uses the first one available. =back =head1 ENVIRONMENT VARIABLES =over 4 =item PERL_CPANM_HOME The directory cpanm should use to store downloads and build and test modules. Defaults to the C<.cpanm> directory in your user's home directory. =item PERL_CPANM_OPT If set, adds a set of default options to every cpanm command. These options come first, and so are overridden by command-line options. =back =head1 SEE ALSO L =head1 COPYRIGHT Copyright 2010- Tatsuhiko Miyagawa. =head1 AUTHOR Tatsuhiko Miyagawa =cut