#!/usr/bin/env perl use 5.8.1; # The following distributions are embedded into this script: # # [ # { # "copyright" : "Infinity Interactive, Inc.", # "license" : "the same as Perl 5", # "name" : "Algorithm-C3", # "url" : "https://metacpan.org/dist/Algorithm-C3" # }, # { # "copyright" : "Shoichi Kaji", # "license" : "the same as Perl 5", # "name" : "CPAN-02Packages-Search", # "url" : "https://metacpan.org/dist/CPAN-02Packages-Search" # }, # { # "copyright" : "Graham Barr", # "license" : "the same as Perl 5", # "name" : "CPAN-DistnameInfo", # "url" : "https://metacpan.org/dist/CPAN-DistnameInfo" # }, # { # "copyright" : "David Golden, Ricardo Signes, Adam Kennedy and Contributors", # "license" : "the same as Perl 5", # "name" : "CPAN-Meta", # "url" : "https://metacpan.org/dist/CPAN-Meta" # }, # { # "copyright" : "David Golden and Ricardo Signes", # "license" : "the same as Perl 5", # "name" : "CPAN-Meta-Requirements", # "url" : "https://metacpan.org/dist/CPAN-Meta-Requirements" # }, # { # "copyright" : "Adam Kennedy", # "license" : "the same as Perl 5", # "name" : "CPAN-Meta-YAML", # "url" : "https://metacpan.org/dist/CPAN-Meta-YAML" # }, # { # "copyright" : "David Golden", # "license" : "Apache 2.0", # "name" : "Capture-Tiny", # "url" : "https://metacpan.org/dist/Capture-Tiny" # }, # { # "copyright" : "Infinity Interactive, Inc.", # "license" : "the same as Perl 5", # "name" : "Class-C3", # "url" : "https://metacpan.org/dist/Class-C3" # }, # { # "copyright" : "David Golden", # "license" : "Apache 2.0", # "name" : "Class-Tiny", # "url" : "https://metacpan.org/dist/Class-Tiny" # }, # { # "copyright" : "Shoichi Kaji", # "license" : "the same as Perl 5", # "name" : "Command-Runner", # "url" : "https://metacpan.org/dist/Command-Runner" # }, # { # "copyright" : "Yuval Kogman", # "license" : "the same as Perl 5", # "name" : "Devel-GlobalDestruction", # "url" : "https://metacpan.org/dist/Devel-GlobalDestruction" # }, # { # "copyright" : "Unknown", # "license" : "the same as Perl 5", # "name" : "Exporter", # "url" : "https://metacpan.org/dist/Exporter" # }, # { # "copyright" : "Ken Williams, Leon Timmermans", # "license" : "the same as Perl 5", # "name" : "ExtUtils-Config", # "url" : "https://metacpan.org/dist/ExtUtils-Config" # }, # { # "copyright" : "Ken Williams, Leon Timmermans", # "license" : "the same as Perl 5", # "name" : "ExtUtils-Helpers", # "url" : "https://metacpan.org/dist/ExtUtils-Helpers" # }, # { # "copyright" : "Yves Orton, Michael Schwern, Alan Burlison, Randy W. Sims and others", # "license" : "the same as Perl 5", # "name" : "ExtUtils-Install", # "url" : "https://metacpan.org/dist/ExtUtils-Install" # }, # { # "copyright" : "Ken Williams, Leon Timmermans.", # "license" : "the same as Perl 5", # "name" : "ExtUtils-InstallPaths", # "url" : "https://metacpan.org/dist/ExtUtils-InstallPaths" # }, # { # "copyright" : "Leon Timmermans.", # "license" : "the same as Perl 5", # "name" : "ExtUtils-PL2Bat", # "url" : "https://metacpan.org/dist/ExtUtils-PL2Bat" # }, # { # "copyright" : "Daniel Muey", # "license" : "the same as Perl 5", # "name" : "File-Copy-Recursive", # "url" : "https://metacpan.org/dist/File-Copy-Recursive" # }, # { # "copyright" : "Charles Bailey, Tim Bunce, David Landgren, James Keenan, and Richard Elberger", # "license" : "the same as Perl 5", # "name" : "File-Path", # "url" : "https://metacpan.org/dist/File-Path" # }, # { # "copyright" : "Tim Jenness and the UK Particle Physics and Astronomy Research Council", # "license" : "the same as Perl 5", # "name" : "File-Temp", # "url" : "https://metacpan.org/dist/File-Temp" # }, # { # "copyright" : "Per Einar Ellefsen", # "license" : "the same as Perl 5", # "name" : "File-Which", # "url" : "https://metacpan.org/dist/File-Which" # }, # { # "copyright" : "David A Golden", # "license" : "the same as Perl 5", # "name" : "File-pushd", # "url" : "https://metacpan.org/dist/File-pushd" # }, # { # "copyright" : "Johan Vromans", # "license" : "the terms of the Perl Artistic License or the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version", # "name" : "Getopt-Long", # "url" : "https://metacpan.org/dist/Getopt-Long" # }, # { # "copyright" : "Christian Hansen", # "license" : "the same as Perl 5", # "name" : "HTTP-Tiny", # "url" : "https://metacpan.org/dist/HTTP-Tiny" # }, # { # "copyright" : "Tatsuhiko Miyagawa", # "license" : "the same as Perl 5", # "name" : "HTTP-Tinyish", # "url" : "https://metacpan.org/dist/HTTP-Tinyish" # }, # { # "copyright" : "R. Barrie Slaymaker, Jr.", # "license" : "the BSD, Artistic, or GPL licenses, any version", # "name" : "IPC-Run3", # "url" : "https://metacpan.org/dist/IPC-Run3" # }, # { # "copyright" : "Makamaka Hannyaharamitu", # "license" : "the same as Perl 5", # "name" : "JSON-PP", # "url" : "https://metacpan.org/dist/JSON-PP" # }, # { # "copyright" : "Brandon L. Black", # "license" : "the same as Perl 5", # "name" : "MRO-Compat", # "url" : "https://metacpan.org/dist/MRO-Compat" # }, # { # "copyright" : "Tatsuhiko Miyagawa", # "license" : "the same as Perl 5", # "name" : "Menlo", # "url" : "https://metacpan.org/dist/Menlo" # }, # { # "copyright" : "Tatsuhiko Miyagawa", # "license" : "the same as Perl 5", # "name" : "Menlo-Legacy", # "url" : "https://metacpan.org/dist/Menlo-Legacy" # }, # { # "copyright" : "Tatsuhiko Miyagawa", # "license" : "the same as Perl 5", # "name" : "Module-CPANfile", # "url" : "https://metacpan.org/dist/Module-CPANfile" # }, # { # "copyright" : "Jos Boumans", # "license" : "the same as Perl 5", # "name" : "Module-Load", # "url" : "https://metacpan.org/dist/Module-Load" # }, # { # "copyright" : "Ken Williams, Matt Trout and David Golden", # "license" : "the same as Perl 5", # "name" : "Module-Metadata", # "url" : "https://metacpan.org/dist/Module-Metadata" # }, # { # "copyright" : "Shoichi Kaji", # "license" : "the same as Perl 5", # "name" : "Module-cpmfile", # "url" : "https://metacpan.org/dist/Module-cpmfile" # }, # { # "copyright" : "Shoichi Kaji", # "license" : "the same as Perl 5", # "name" : "Parallel-Pipes", # "url" : "https://metacpan.org/dist/Parallel-Pipes" # }, # { # "copyright" : "Andreas Koenig, Kenichi Ishigaki", # "license" : "the same as Perl 5", # "name" : "Parse-PMFile", # "url" : "https://metacpan.org/dist/Parse-PMFile" # }, # { # "copyright" : "Shoichi Kaji", # "license" : "the same as Perl 5", # "name" : "Proc-ForkSafe", # "url" : "https://metacpan.org/dist/Proc-ForkSafe" # }, # { # "copyright" : "The Perl 5 Porters", # "license" : "the same as Perl 5", # "name" : "Search-Dict", # "url" : "https://metacpan.org/dist/Search-Dict" # }, # { # "copyright" : "Roderick Schertler", # "license" : "the same as Perl 5", # "name" : "String-ShellQuote", # "url" : "https://metacpan.org/dist/String-ShellQuote" # }, # { # "copyright" : "Arthur Axel \"fREW\" Schmidt", # "license" : "the same as Perl 5", # "name" : "Sub-Exporter-Progressive", # "url" : "https://metacpan.org/dist/Sub-Exporter-Progressive" # }, # { # "copyright" : "Alexandr Ciornii", # "license" : "the same as Perl 5", # "name" : "Text-ParseWords", # "url" : "https://metacpan.org/dist/Text-ParseWords" # }, # { # "copyright" : "David Golden", # "license" : "Apache 2.0", # "name" : "Tie-Handle-Offset", # "url" : "https://metacpan.org/dist/Tie-Handle-Offset" # }, # { # "copyright" : "Tina Müller", # "license" : "the same as Perl 5", # "name" : "YAML-PP", # "url" : "https://metacpan.org/dist/YAML-PP" # }, # { # "copyright" : "Graham Knop, CONTRIBUTORS", # "license" : "the same as Perl 5", # "name" : "Win32-ShellQuote", # "url" : "https://metacpan.org/dist/Win32-ShellQuote" # }, # { # "copyright" : "Matt S Trout, CONTRIBUTORS", # "license" : "the same as Perl 5", # "name" : "local-lib", # "url" : "https://metacpan.org/dist/local-lib" # }, # { # "copyright" : "John Peacock", # "license" : "the same as Perl 5", # "name" : "version", # "url" : "https://metacpan.org/dist/version" # } # ] # 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.11';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/cpm.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM'; package App::cpm;use strict;use warnings;our$VERSION='0.997017';our ($GIT_DESCRIBE,$GIT_URL);1; APP_CPM $fatpacked{"App/cpm/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_CLI'; package App::cpm::CLI;use 5.008001;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::Distribution;use App::cpm::Logger::File;use App::cpm::Logger;use App::cpm::Master;use App::cpm::Requirement;use App::cpm::Resolver::Cascade;use App::cpm::Resolver::MetaCPAN;use App::cpm::Resolver::MetaDB;use App::cpm::Util qw(WIN32 determine_home maybe_abs);use App::cpm::Worker;use App::cpm::version;use App::cpm;use CPAN::Meta;use Command::Runner;use Config;use Cwd ();use File::Copy ();use File::Path ();use File::Spec;use Getopt::Long qw(:config no_auto_abbrev no_ignore_case bundling);use List::Util ();use Module::CPANfile;use Module::cpmfile;use Parallel::Pipes::App;use Pod::Text ();use local::lib ();sub new {my ($class,%option)=@_;my$prebuilt=exists$ENV{PERL_CPM_PREBUILT}&&!$ENV{PERL_CPM_PREBUILT}? 0 : 1;bless {argv=>undef,home=>determine_home,cwd=>Cwd::cwd(),workers=>WIN32 ? 1 : 5,snapshot=>"cpanfile.snapshot",dependency_file=>undef,local_lib=>"local",cpanmetadb=>"https://cpanmetadb.plackperl.org/v1.0/",_default_mirror=>'https://cpan.metacpan.org/',retry=>1,configure_timeout=>60,build_timeout=>3600,test_timeout=>1800,with_requires=>1,with_recommends=>0,with_suggests=>0,with_configure=>0,with_build=>1,with_test=>1,with_runtime=>1,with_develop=>0,feature=>[],notest=>1,prebuilt=>$] >= 5.012 && $prebuilt,pureperl_only=>0,static_install=>1,default_resolvers=>1,%option },$class}sub parse_options {my$self=shift;local@ARGV=@_;my ($mirror,@resolver,@feature);my$with_option=sub {my$n=shift;("with-$n",\$self->{"with_$n"},"without-$n",sub {$self->{"with_$n"}=0})};my@type=qw(requires recommends suggests);my@phase=qw(configure build test runtime develop);GetOptions "L|local-lib-contained=s"=>\($self->{local_lib}),"color!"=>\($self->{color}),"g|global"=>\($self->{global}),"mirror=s"=>\$mirror,"v|verbose"=>\($self->{verbose}),"w|workers=i"=>\($self->{workers}),"target-perl=s"=>\my$target_perl,"test!"=>sub {$self->{notest}=$_[1]? 0 : 1},"cpanfile=s"=>sub {$self->{dependency_file}={type=>"cpanfile",path=>$_[1]}},"cpmfile=s"=>sub {$self->{dependency_file}={type=>"cpmfile",path=>$_[1]}},"metafile=s"=>sub {$self->{dependency_file}={type=>"metafile",path=>$_[1]}},"snapshot=s"=>\($self->{snapshot}),"sudo"=>\($self->{sudo}),"r|resolver=s@"=>\@resolver,"default-resolvers!"=>\($self->{default_resolvers}),"mirror-only"=>\($self->{mirror_only}),"dev"=>\($self->{dev}),"man-pages"=>\($self->{man_pages}),"home=s"=>\($self->{home}),"retry!"=>\($self->{retry}),"exclude-vendor!"=>\($self->{exclude_vendor}),"configure-timeout=i"=>\($self->{configure_timeout}),"build-timeout=i"=>\($self->{build_timeout}),"test-timeout=i"=>\($self->{test_timeout}),"show-progress!"=>\($self->{show_progress}),"prebuilt!"=>\($self->{prebuilt}),"reinstall"=>\($self->{reinstall}),"pp|pureperl|pureperl-only"=>\($self->{pureperl_only}),"static-install!"=>\($self->{static_install}),"with-all"=>sub {map {$self->{"with_$_"}=1}@type,@phase},(map$with_option->($_),@type),(map$with_option->($_),@phase),"feature=s@"=>\@feature,"show-build-log-on-failure"=>\($self->{show_build_log_on_failure}),or return 0;$self->{local_lib}=maybe_abs($self->{local_lib},$self->{cwd})unless$self->{global};$self->{home}=maybe_abs($self->{home},$self->{cwd});$self->{resolver}=\@resolver;$self->{feature}=\@feature if@feature;$self->{mirror}=$self->normalize_mirror($mirror)if$mirror;$self->{color}=1 if!defined$self->{color}&& -t STDOUT;$self->{show_progress}=1 if!WIN32 &&!defined$self->{show_progress}&& -t STDOUT;if ($target_perl){die "--target-perl option conflicts with --global option\n" if$self->{global};die "--target-perl option can be used only if perl version >= 5.18.0\n" if $] < 5.018;$target_perl="v$target_perl" if$target_perl =~ /^5\.[1-9]\d*$/;$target_perl=sprintf '%0.6f',App::cpm::version->parse($target_perl)->numify;$target_perl='5.008' if$target_perl eq '5.008000';$self->{target_perl}=$target_perl}if (WIN32 and $self->{workers}!=1){die "The number of workers must be 1 under WIN32 environment.\n"}if ($self->{sudo}){!system "sudo",$^X,"-e1" or exit 1}if ($self->{pureperl_only}or $self->{sudo}or!$self->{notest}or $self->{man_pages}or $] < 5.012){$self->{prebuilt}=0}$App::cpm::Logger::COLOR=1 if$self->{color};$App::cpm::Logger::VERBOSE=1 if$self->{verbose};$App::cpm::Logger::SHOW_PROGRESS=1 if$self->{show_progress};if (@ARGV){if ($ARGV[0]eq "-"){my$argv=$self->read_argv_from_stdin;return -1 if @$argv==0;$self->{argv}=$argv}else {$self->{argv}=\@ARGV}}elsif (!$self->{dependency_file}){$self->{dependency_file}=$self->locate_dependency_file}return 1}sub read_argv_from_stdin {my$self=shift;my@argv;while (my$line=){next if$line !~ /\S/;next if$line =~ /^\s*#/;$line =~ s/^\s*//;$line =~ s/\s*$//;push@argv,split /\s+/,$line}return \@argv}sub _core_inc {my$self=shift;[(!$self->{exclude_vendor}? grep {$_}@Config{qw(vendorarch vendorlibexp)}: ()),@Config{qw(archlibexp privlibexp)},]}sub _search_inc {my$self=shift;return \@INC if$self->{global};my$base=$self->{local_lib};my@local_lib=(local::lib->resolve_path(local::lib->install_base_arch_path($base)),local::lib->resolve_path(local::lib->install_base_perl_path($base)),);if ($self->{target_perl}){return [@local_lib]}else {return [@local_lib,@{$self->_core_inc}]}}sub normalize_mirror {my ($self,$mirror)=@_;$mirror =~ s{/*$}{/};return$mirror if$mirror =~ m{^https?://};$mirror =~ s{^file://}{};die "$mirror: No such directory.\n" unless -d $mirror;"file://" .maybe_abs($mirror,$self->{cwd})}sub run {my ($self,@argv)=@_;my$cmd=shift@argv or die "Need subcommand, try `cpm --help`\n";$cmd="help" if$cmd =~ /^(-h|--help)$/;$cmd="version" if$cmd =~ /^(-V|--version)$/;if (my$sub=$self->can("cmd_$cmd")){return$self->$sub(@argv)if$cmd eq "exec";my$ok=$self->parse_options(@argv);return 1 if!$ok;return 0 if$ok==-1;return$self->$sub}else {my$message=$cmd =~ /^-/ ? "Missing subcommand" : "Unknown subcommand '$cmd'";die "$message, try `cpm --help`\n"}}sub cmd_help {open my$fh,">",\my$out;Pod::Text->new->parse_from_file($0,$fh);$out =~ s/^[ ]{6}/ /mg;print$out;return 0}sub cmd_version {print "cpm $App::cpm::VERSION ($0)\n";if ($App::cpm::GIT_DESCRIBE){print "This is a self-contained version, $App::cpm::GIT_DESCRIBE ($App::cpm::GIT_URL)\n"}printf "perl version v%vd ($^X)\n\n",$^V;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 0}sub cmd_install {my$self=shift;die "Need arguments or cpm.yml/cpanfile/Build.PL/Makefile.PL\n" if!$self->{argv}&&!$self->{dependency_file};local%ENV=%ENV;File::Path::mkpath($self->{home})unless -d $self->{home};my$logger=App::cpm::Logger::File->new("$self->{home}/build.log.@{[time]}");$logger->symlink_to("$self->{home}/build.log");$logger->log("Running cpm $App::cpm::VERSION ($0) on perl $Config{version} built for $Config{archname} ($^X)");$logger->log("This is a self-contained version, $App::cpm::GIT_DESCRIBE ($App::cpm::GIT_URL)")if$App::cpm::GIT_DESCRIBE;$logger->log("Command line arguments are: @ARGV");my$master=App::cpm::Master->new(logger=>$logger,core_inc=>$self->_core_inc,search_inc=>$self->_search_inc,global=>$self->{global},show_progress=>$self->{show_progress},(exists$self->{target_perl}? (target_perl=>$self->{target_perl}): ()),);my ($packages,$dists,$resolver)=$self->initial_task($master);return 0 unless$packages;my$worker=App::cpm::Worker->new(verbose=>$self->{verbose},home=>$self->{home},logger=>$logger,notest=>$self->{notest},sudo=>$self->{sudo},resolver=>$self->generate_resolver($resolver),man_pages=>$self->{man_pages},retry=>$self->{retry},prebuilt=>$self->{prebuilt},pureperl_only=>$self->{pureperl_only},static_install=>$self->{static_install},configure_timeout=>$self->{configure_timeout},build_timeout=>$self->{build_timeout},test_timeout=>$self->{test_timeout},($self->{global}? (): (local_lib=>$self->{local_lib})),);{last if $] >= 5.018;my$requirement=App::cpm::Requirement->new('ExtUtils::MakeMaker'=>'6.64','ExtUtils::ParseXS'=>'3.16');for my$name ('ExtUtils::MakeMaker','ExtUtils::ParseXS'){if (my ($i)=grep {$packages->[$_]{package}eq $name}0..$#{$packages}){$requirement->add($name,$packages->[$i]{version_range})or die sprintf "We have to install newer $name first: $@\n";splice @$packages,$i,1}}my ($is_satisfied,@need_resolve)=$master->is_satisfied($requirement->as_array);last if$is_satisfied;$master->add_task(type=>"resolve",%$_)for@need_resolve;$self->install($master,$worker,1);if (my$fail=$master->fail){local$App::cpm::Logger::VERBOSE=0;for my$type (qw(install resolve)){App::cpm::Logger->log(result=>"FAIL",type=>$type,message=>$_)for @{$fail->{$type}}}print STDERR "\r" if$self->{show_progress};warn sprintf "%d distribution%s installed.\n",$master->installed_distributions,$master->installed_distributions > 1 ? "s" : "";if ($self->{show_build_log_on_failure}){File::Copy::copy($logger->file,\*STDERR)}else {warn "See $self->{home}/build.log for details.\n";warn "You may want to execute cpm with --show-build-log-on-failure,\n";warn "so that the build.log is automatically dumped on failure.\n"}return 1}}$master->add_task(type=>"resolve",%$_)for @$packages;$master->add_distribution($_)for @$dists;$self->install($master,$worker,$self->{workers});my$fail=$master->fail;if ($fail){local$App::cpm::Logger::VERBOSE=0;for my$type (qw(install resolve)){App::cpm::Logger->log(result=>"FAIL",type=>$type,message=>$_)for @{$fail->{$type}}}}print STDERR "\r" if$self->{show_progress};warn sprintf "%d distribution%s installed.\n",$master->installed_distributions,$master->installed_distributions > 1 ? "s" : "";$self->cleanup;if ($fail){if ($self->{show_build_log_on_failure}){File::Copy::copy($logger->file,\*STDERR)}else {warn "See $self->{home}/build.log for details.\n";warn "You may want to execute cpm with --show-build-log-on-failure,\n";warn "so that the build.log is automatically dumped on failure.\n"}return 1}else {return 0}}sub install {my ($self,$master,$worker,$num)=@_;if ($num > 1 && $^O eq "darwin" &&!exists$ENV{OBJC_DISABLE_INITIALIZE_FORK_SAFETY}&&!$self->{_darwin_fixed}){require Socket;Socket::inet_aton("call-inet_aton-before_fork");$self->{_darwin_fixed}=1}my@task=$master->get_task;Parallel::Pipes::App->run(num=>$num,before_work=>sub {my$task=shift;$task->in_charge(1)},work=>sub {my$task=shift;return$worker->work($task)},after_work=>sub {my$result=shift;$master->register_result($result);@task=$master->get_task},tasks=>\@task,)}sub cleanup {my$self=shift;my$week=time - 7*24*60*60;my@entry=glob "$self->{home}/build.log.*";if (opendir my$dh,"$self->{home}/work"){push@entry,map File::Spec->catdir("$self->{home}/work",$_),grep!/^\.{1,2}$/,readdir$dh}for my$entry (@entry){my$mtime=(stat$entry)[9];if ($mtime < $week){if (-d $entry){File::Path::rmtree($entry)}else {unlink$entry}}}}sub initial_task {my ($self,$master)=@_;if (!$self->{argv}){my ($requirement,$reinstall,$resolver)=$self->load_dependency_file;my ($is_satisfied,@need_resolve)=$master->is_satisfied($requirement);if (!@$reinstall and $is_satisfied){warn "All requirements are satisfied.\n";return}elsif (!defined$is_satisfied){my ($req)=grep {$_->{package}eq "perl"}@$requirement;die sprintf "%s requires perl %s, but you have only %s\n",$self->{dependency_file}{path},$req->{version_range},$self->{target_perl}|| $]}my@package=(@need_resolve,@$reinstall);return (\@package,[],$resolver)}$self->{mirror}||= $self->{_default_mirror};my (@package,@dist);for (@{$self->{argv}}){my$arg=$_;my ($package,$dist);if (-d $arg || -f $arg || $arg =~ s{^file://}{}){$arg=maybe_abs($arg,$self->{cwd});$dist=App::cpm::Distribution->new(source=>"local",uri=>"file://$arg",provides=>[])}elsif ($arg =~ /(?:^git:|\.git(?:@.+)?$)/){my%ref=$arg =~ s/(?<=\.git)@(.+)$// ? (ref=>$1): ();$dist=App::cpm::Distribution->new(source=>"git",uri=>$arg,provides=>[],%ref)}elsif ($arg =~ m{^(https?|file)://}){my ($source,$distfile)=($1 eq "file" ? "local" : "http",undef);if (my$d=App::cpm::DistNotation->new_from_uri($arg)){($source,$distfile)=("cpan",$d->distfile)}$dist=App::cpm::Distribution->new(source=>$source,uri=>$arg,$distfile ? (distfile=>$distfile): (),provides=>[],)}elsif (my$d=App::cpm::DistNotation->new_from_dist($arg)){$dist=App::cpm::Distribution->new(source=>"cpan",uri=>$d->cpan_uri($self->{mirror}),distfile=>$d->distfile,provides=>[],)}else {my ($name,$version_range,$dev);$arg =~ s/^([A-Za-z0-9_:]+)@([v\d\._]+)$/$1~== $2/;if ($arg =~ /\~[v\d\._,\!<>= ]+$/){($name,$version_range)=split '~',$arg,2}else {$arg =~ s/[~@]dev$// and $dev++;$name=$arg}$package= +{package=>$name,version_range=>$version_range || 0,dev=>$dev,reinstall=>$self->{reinstall},}}push@package,$package if$package;push@dist,$dist if$dist}return (\@package,\@dist,undef)}sub locate_dependency_file {my$self=shift;if (-f "cpm.yml"){return {type=>"cpmfile",path=>"cpm.yml" }}if (-f "cpanfile"){return {type=>"cpanfile",path=>"cpanfile" }}if (-f 'META.json'){my$meta=CPAN::Meta->load_file('META.json');if (!$meta->dynamic_config){return {type=>'metafile',path=>'META.json' }}}if (-f 'Build.PL' || -f 'Makefile.PL'){my$build_file= -f 'Build.PL' ? 'Build.PL' : 'Makefile.PL';warn "Executing $build_file to generate MYMETA.json and to determine requirements...\n";local%ENV=(PERL5_CPAN_IS_RUNNING=>1,PERL5_CPANPLUS_IS_RUNNING=>1,PERL5_CPANM_IS_RUNNING=>1,PERL_MM_USE_DEFAULT=>1,%ENV,);if (!$self->{global}){local$SIG{__WARN__}=sub {};local::lib->setup_env_hash_for($self->{local_lib},0)}my$runner=Command::Runner->new(command=>[$^X,$build_file ],timeout=>60,redirect=>1,);my$res=$runner->run;if ($res->{timeout}){die "Error: timed out (>60s).\n$res->{stdout}"}if ($res->{result}!=0){die "Error: failed to execute $build_file.\n$res->{stdout}"}if (!-f 'MYMETA.json'){die "Error: No MYMETA.json after executing $build_file\n"}return {type=>'metafile',path=>'MYMETA.json' }}return}sub load_dependency_file {my$self=shift;my$cpmfile=do {my ($type,$path)=@{$self->{dependency_file}}{qw(type path)};warn "Loading requirements from $path...\n";if ($type eq "cpmfile"){Module::cpmfile->load($path)}elsif ($type eq "cpanfile"){Module::cpmfile->from_cpanfile(Module::CPANfile->load($path))}elsif ($type eq "metafile"){Module::cpmfile->from_cpanmeta(CPAN::Meta->load_file($path))}else {die}};if (!$self->{mirror}){my$mirrors=$cpmfile->{_mirrors}|| [];if (@$mirrors){$self->{mirror}=$self->normalize_mirror($mirrors->[0])}else {$self->{mirror}=$self->{_default_mirror}}}my@phase=grep$self->{"with_$_"},qw(configure build test runtime develop);my@type=grep$self->{"with_$_"},qw(requires recommends suggests);my$reqs=$cpmfile->effective_requirements($self->{feature},\@phase,\@type);my (@package,@reinstall);for my$package (sort keys %$reqs){my$options=$reqs->{$package};my$req={package=>$package,version_range=>$options->{version},dev=>$options->{dev},reinstall=>$options->{git}? 1 : 0,};if ($options->{git}){push@reinstall,$req}else {push@package,$req}}require App::cpm::Resolver::Custom;my$resolver=App::cpm::Resolver::Custom->new(requirements=>$reqs,mirror=>$self->{mirror},from=>$self->{dependency_file}{type},);return (\@package,\@reinstall,$resolver->effective ? $resolver : undef)}sub generate_resolver {my ($self,$initial)=@_;my$cascade=App::cpm::Resolver::Cascade->new;$cascade->add($initial)if$initial;if (@{$self->{resolver}}){for my$r (@{$self->{resolver}}){my ($klass,@argv)=split /,/,$r;my$resolver=$self->_generate_resolver($klass,@argv);$cascade->add($resolver)}}return$cascade if!$self->{default_resolvers};if ($self->{mirror_only}){require App::cpm::Resolver::02Packages;my$resolver=App::cpm::Resolver::02Packages->new(mirror=>$self->{mirror},cache=>"$self->{home}/sources",);$cascade->add($resolver);return$cascade}if (!$self->{argv}and -f $self->{snapshot}){if (!eval {require App::cpm::Resolver::Snapshot}){die "To load $self->{snapshot}, you need to install Carton::Snapshot.\n"}warn "Loading distributions from $self->{snapshot}...\n";my$resolver=App::cpm::Resolver::Snapshot->new(path=>$self->{snapshot},mirror=>$self->{mirror},);$cascade->add($resolver)}my$resolver=App::cpm::Resolver::MetaCPAN->new($self->{dev}? (dev=>1): (only_dev=>1));$cascade->add($resolver);$resolver=App::cpm::Resolver::MetaDB->new(uri=>$self->{cpanmetadb},mirror=>$self->{mirror},);$cascade->add($resolver);if (!$self->{dev}){$resolver=App::cpm::Resolver::MetaCPAN->new;$cascade->add($resolver)}$cascade}sub _generate_resolver {my ($self,$klass,@argv)=@_;if ($klass =~ /^metadb$/i){my ($uri,$mirror);if (@argv > 1){($uri,$mirror)=@argv}elsif (@argv==1){$mirror=$argv[0]}else {$mirror=$self->{mirror}}return App::cpm::Resolver::MetaDB->new($uri ? (uri=>$uri): (),mirror=>$self->normalize_mirror($mirror),)}elsif ($klass =~ /^metacpan$/i){return App::cpm::Resolver::MetaCPAN->new(dev=>$self->{dev})}elsif ($klass =~ /^02packages?$/i){require App::cpm::Resolver::02Packages;my ($path,$mirror);if (@argv > 1){($path,$mirror)=@argv}elsif (@argv==1){$mirror=$argv[0]}else {$mirror=$self->{mirror}}return App::cpm::Resolver::02Packages->new($path ? (path=>$path): (),cache=>"$self->{home}/sources",mirror=>$self->normalize_mirror($mirror),)}elsif ($klass =~ /^snapshot$/i){require App::cpm::Resolver::Snapshot;return App::cpm::Resolver::Snapshot->new(path=>$self->{snapshot},mirror=>@argv ? $self->normalize_mirror($argv[0]): $self->{mirror},)}my$full_klass=$klass =~ s/^\+// ? $klass : "App::cpm::Resolver::$klass";(my$file=$full_klass)=~ s{::}{/}g;require "$file.pm";return$full_klass->new(@argv)}1; APP_CPM_CLI $fatpacked{"App/cpm/CircularDependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_CIRCULARDEPENDENCY'; package App::cpm::CircularDependency;use strict;use warnings;{package App::cpm::CircularDependency::OrderedSet;sub new {my$class=shift;bless {index=>0,hash=>+{}},$class}sub add {my ($self,$name)=@_;$self->{hash}{$name}=$self->{index}++}sub exists {my ($self,$name)=@_;exists$self->{hash}{$name}}sub values {my$self=shift;sort {$self->{hash}{$a}<=> $self->{hash}{$b}}keys %{$self->{hash}}}sub clone {my$self=shift;my$new=(ref$self)->new;$new->add($_)for$self->values;$new}}sub _uniq {my%u;grep!$u{$_}++,@_}sub new {my$class=shift;bless {_tmp=>{}},$class}sub add {my ($self,$distfile,$provides,$requirements)=@_;$self->{_tmp}{$distfile}= +{provides=>[map $_->{package},@$provides ],requirements=>[map $_->{package},@$requirements ],}}sub finalize {my$self=shift;for my$distfile (sort keys %{$self->{_tmp}}){$self->{$distfile}=[_uniq map$self->_find($_),@{$self->{_tmp}{$distfile}{requirements}}]}delete$self->{_tmp};return}sub _find {my ($self,$package)=@_;for my$distfile (sort keys %{$self->{_tmp}}){if (grep {$_ eq $package}@{$self->{_tmp}{$distfile}{provides}}){return$distfile}}return}sub detect {my$self=shift;my%result;for my$distfile (sort keys %$self){my$seen=App::cpm::CircularDependency::OrderedSet->new;$seen->add($distfile);if (my$detected=$self->_detect($distfile,$seen)){$result{$distfile}=$detected}}return \%result}sub _detect {my ($self,$distfile,$seen)=@_;for my$req (@{$self->{$distfile}}){if ($seen->exists($req)){return [$seen->values,$req]}my$clone=$seen->clone;$clone->add($req);if (my$detected=$self->_detect($req,$clone)){return$detected}}return}1; APP_CPM_CIRCULARDEPENDENCY $fatpacked{"App/cpm/DistNotation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_DISTNOTATION'; package App::cpm::DistNotation;use strict;use warnings;my$A1=q{[A-Z]};my$A2=q{[A-Z]{2}};my$AUTHOR=qr{[A-Z]{2}[\-A-Z0-9]*};our$CPAN_URI=qr{^(.*)/authors/id/($A1/$A2/$AUTHOR/.*)$}o;our$DISTFILE=qr{^(?:$A1/$A2/)?($AUTHOR)/(.*)$}o;sub new {my$class=shift;bless {mirror=>'',distfile=>'',},$class}sub new_from_dist {my$self=shift->new;my$dist=shift;if ($dist =~ $DISTFILE){my$author=$1;my$rest=$2;$self->{distfile}=sprintf "%s/%s/%s/%s",substr($author,0,1),substr($author,0,2),$author,$rest;return$self}return}sub new_from_uri {my$self=shift->new;my$uri=shift;if ($uri =~ $CPAN_URI){$self->{mirror}=$1;$self->{distfile}=$2;return$self}return}sub cpan_uri {my$self=shift;my$mirror=shift || $self->{mirror};$mirror =~ s{/+$}{};sprintf "%s/authors/id/%s",$mirror,$self->{distfile}}sub distfile {shift->{distfile}}1; APP_CPM_DISTNOTATION $fatpacked{"App/cpm/Distribution.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_DISTRIBUTION'; package App::cpm::Distribution;use strict;use warnings;use App::cpm::Logger;use App::cpm::Requirement;use App::cpm::version;use CPAN::DistnameInfo;use constant STATE_REGISTERED=>0b000001;use constant STATE_DEPS_REGISTERED=>0b000010;use constant STATE_RESOLVED=>0b000100;use constant STATE_FETCHED=>0b001000;use constant STATE_CONFIGURED=>0b010000;use constant STATE_INSTALLED=>0b100000;sub new {my ($class,%option)=@_;my$uri=delete$option{uri};my$distfile=delete$option{distfile};my$source=delete$option{source}|| "cpan";my$provides=delete$option{provides}|| [];bless {%option,provides=>$provides,uri=>$uri,distfile=>$distfile,source=>$source,_state=>STATE_RESOLVED,requirements=>{},},$class}sub requirements {my ($self,$phase,$req)=@_;if (ref$phase){my$req=App::cpm::Requirement->new;for my$p (@$phase){if (my$r=$self->{requirements}{$p}){$req->merge($r)}}return$req}$self->{requirements}{$phase}=$req if$req;$self->{requirements}{$phase}|| App::cpm::Requirement->new}for my$attr (qw(source directory distdata meta uri provides ref static_builder prebuilt)){no strict 'refs';*$attr=sub {my$self=shift;$self->{$attr}=shift if @_;$self->{$attr}}}sub distfile {my$self=shift;$self->{distfile}=shift if @_;$self->{distfile}|| $self->{uri}}sub distvname {my$self=shift;$self->{distvname}||= do {CPAN::DistnameInfo->new($self->{distfile})->distvname || $self->distfile}}sub overwrite_provide {my ($self,$provide)=@_;my$overwrote;for my$exist (@{$self->{provides}}){if ($exist->{package}eq $provide->{package}){$exist=$provide;$overwrote++}}if (!$overwrote){push @{$self->{provides}},$provide}return 1}sub registered {my$self=shift;if (@_ && $_[0]){$self->{_state}|= STATE_REGISTERED}$self->{_state}& STATE_REGISTERED}sub deps_registered {my$self=shift;if (@_ && $_[0]){$self->{_state}|= STATE_DEPS_REGISTERED}$self->{_state}& STATE_DEPS_REGISTERED}sub resolved {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_RESOLVED}$self->{_state}& STATE_RESOLVED}sub fetched {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_FETCHED}$self->{_state}& STATE_FETCHED}sub configured {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_CONFIGURED}$self->{_state}& STATE_CONFIGURED}sub installed {my$self=shift;if (@_ && $_[0]){$self->{_state}=STATE_INSTALLED}$self->{_state}& STATE_INSTALLED}sub providing {my ($self,$package,$version_range)=@_;for my$provide (@{$self->provides}){if ($provide->{package}eq $package){if (!$version_range or App::cpm::version->parse($provide->{version})->satisfy($version_range)){return 1}else {my$message=sprintf "%s provides %s (%s), but needs %s\n",$self->distfile,$package,$provide->{version}|| 0,$version_range;App::cpm::Logger->log(result=>"WARN",message=>$message);last}}}return}sub equals {my ($self,$that)=@_;$self->distfile && $that->distfile and $self->distfile eq $that->distfile}1; APP_CPM_DISTRIBUTION $fatpacked{"App/cpm/HTTP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_HTTP'; package App::cpm::HTTP;use strict;use warnings;use App::cpm;use HTTP::Tinyish;sub create {my ($class,%args)=@_;my$wantarray=wantarray;my@try=$args{prefer}? @{$args{prefer}}: qw(HTTPTiny LWP Curl Wget);my ($backend,$tool,$desc);for my$try (map "HTTP::Tinyish::$_",@try){my$meta=HTTP::Tinyish->configure_backend($try)or next;$try->supports("https")or next;($tool)=sort keys %$meta;($desc=$meta->{$tool})=~ s/^(.*?)\n.*/$1/s;$backend=$try,last}die "Couldn't find HTTP Clients that support https" unless$backend;my$http=$backend->new(agent=>"App::cpm/$App::cpm::VERSION",timeout=>60,verify_SSL=>1,%args,);my$keep_alive=exists$args{keep_alive}? $args{keep_alive}: 1;if ($keep_alive and $backend =~ /LWP$/){$http->{ua}->conn_cache({total_capacity=>1 })}$wantarray ? ($http,"$tool $desc"): $http}1; APP_CPM_HTTP $fatpacked{"App/cpm/Installer/Unpacker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_INSTALLER_UNPACKER'; package App::cpm::Installer::Unpacker;use strict;use warnings;use File::Basename ();use File::Temp ();use File::Which ();use IPC::Run3 ();sub run3 {my ($cmd,$outfile)=@_;my$out;IPC::Run3::run3$cmd,\undef,($outfile ? $outfile : \$out),\my$err;return ($?,$out,$err)}sub new {my ($class,%argv)=@_;my$self=bless \%argv,$class;$self->_init_untar;$self->_init_unzip;$self}sub unpack {my ($self,$file)=@_;my$method=$file =~ /\.zip$/ ? $self->{method}{unzip}: $self->{method}{untar};$self->$method($file)}sub describe {my$self=shift;my%describe=(map {($_,$self->{$_})}grep$self->{$_},qw(gzip bzip2 Archive::Tar unzip Archive::Zip),);if ($self->{tar}){$describe{tar}=sprintf "%s (%s%s)",$self->{tar},$self->{tar_kind},$self->{tar_bad}? ", will be used together with gzip/bzip2" : "",}\%describe}sub _init_untar {my$self=shift;my$tar=$self->{tar}=File::Which::which('gtar')|| File::Which::which("tar");if ($tar){my ($exit,$out,$err)=run3 [$tar,'--version'];if ($out =~ /bsdtar/){$self->{tar_kind}='bsd'}elsif ($out =~ /GNU/){$self->{tar_kind}='gnu'}elsif ($^O eq 'openbsd'){$self->{tar_kind}='openbsd'}else {$self->{tar_kind}='unknown'}$self->{tar_bad}=1 if$out =~ /GNU.*1\.13/i || $^O eq 'MSWin32' || $^O eq 'solaris' || $^O eq 'hpux'}if ($tar and!$self->{tar_bad}){$self->{method}{untar}=*_untar;return if!$self->{_init_all}}my$gzip=$self->{gzip}=File::Which::which("gzip");my$bzip2=$self->{bzip2}=File::Which::which("bzip2");if ($tar && $gzip && $bzip2){$self->{method}{untar}=*_untar_bad;return if!$self->{_init_all}}if (eval {require Archive::Tar}){$self->{"Archive::Tar"}=Archive::Tar->VERSION;$self->{method}{untar}=*_untar_module;return if!$self->{_init_all}}return if$self->{_init_all};$self->{method}{untar}=sub {die "There is no backend for untar"}}sub _init_unzip {my$self=shift;my$unzip=$self->{unzip}=File::Which::which("unzip");if ($unzip){$self->{method}{unzip}=*_unzip;return if!$self->{_init_all}}if (eval {require Archive::Zip}){$self->{"Archive::Zip"}=Archive::Zip->VERSION;$self->{method}{unzip}=*_unzip_module;return if!$self->{_init_all}}return if$self->{_init_all};$self->{method}{unzip}=sub {die "There is no backend for unzip"}}sub _untar {my ($self,$file)=@_;my$wantarray=wantarray;my ($exit,$out,$err);{my$ar=$file =~ /\.bz2$/ ? 'j' : 'z';($exit,$out,$err)=run3 [$self->{tar},"${ar}tf",$file];last if$exit!=0;my$root=$self->_find_tarroot(split /\r?\n/,$out);my@no_same_owner=$self->{tar_kind}eq 'openbsd' ? (): ('-o');($exit,$out,$err)=run3 [$self->{tar},"${ar}xf",$file,@no_same_owner];return$root if$exit==0 and -d $root}return if!$wantarray;return (undef,$err || $out)}sub _untar_bad {my ($self,$file)=@_;my$wantarray=wantarray;my ($exit,$out,$err);{my$ar=$file =~ /\.bz2$/ ? $self->{bzip2}: $self->{gzip};my$temp=File::Temp->new(SUFFIX=>'.tar',EXLOCK=>0);($exit,$out,$err)=run3 [$ar,"-dc",$file],$temp->filename;last if$exit!=0;my@opt=$^O eq 'MSWin32' && $self->{tar_kind}ne "bsd" ? ('--force-local'): ();($exit,$out,$err)=run3 [$self->{tar},@opt,"-tf",$temp->filename];last if$exit!=0 ||!$out;my$root=$self->_find_tarroot(split /\r?\n/,$out);($exit,$out,$err)=run3 [$self->{tar},@opt,"-xf",$temp->filename,"-o"];return$root if$exit==0 and -d $root}return if!$wantarray;return (undef,$err || $out)}sub _untar_module {my ($self,$file)=@_;my$wantarray=wantarray;no warnings 'once';local$Archive::Tar::WARN=0;my$t=Archive::Tar->new;{my$ok=$t->read($file);last if!$ok;my$root=$self->_find_tarroot($t->list_files);my@file=$t->extract;return$root if@file and -d $root}return if!$wantarray;return (undef,$t->error)}sub _find_tarroot {my ($self,$root,@others)=@_;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length$root){$root=shift@others;redo FILE if$root}}$root}sub _unzip {my ($self,$file)=@_;my$wantarray=wantarray;my ($exit,$out,$err);{($exit,$out,$err)=run3 [$self->{unzip},'-t',$file];last if$exit!=0;my$root=$self->_find_ziproot(split /\r?\n/,$out);($exit,$out,$err)=run3 [$self->{unzip},'-q',$file];return$root if$exit==0 and -d $root}return if!$wantarray;return (undef,$err || $out)}sub _unzip_module {my ($self,$file)=@_;my$wantarray=wantarray;no warnings 'once';my$err='';local$Archive::Zip::ErrorHandler=sub {$err .= "@_"};my$zip=Archive::Zip->new;UNZIP: {my$status=$zip->read($file);last UNZIP if$status!=Archive::Zip::AZ_OK();for my$member ($zip->members){my$af=$member->fileName;next if$af =~ m!^(/|\.\./)!;my$status=$member->extractToFileNamed($af);last UNZIP if$status!=Archive::Zip::AZ_OK()}my ($root)=$zip->membersMatching(qr{^[^/]+/$});last UNZIP if!$root;$root=$root->fileName;$root =~ s{/$}{};return$root if -d $root}return if!$wantarray;return (undef,$err)}sub _find_ziproot {my ($self,undef,$root,@others)=@_;FILE: {chomp$root;if ($root !~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1}){$root=shift@others;redo FILE if$root}}$root}1; APP_CPM_INSTALLER_UNPACKER $fatpacked{"App/cpm/Logger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_LOGGER'; package App::cpm::Logger;use strict;use warnings;use App::cpm::Util 'WIN32';use List::Util 'max';our$COLOR;our$VERBOSE;our$SHOW_PROGRESS;my%color=(resolve=>33,fetch=>34,configure=>35,install=>36,FAIL=>31,DONE=>32,WARN=>33,);our$HAS_WIN32_COLOR;sub new {my$class=shift;bless {@_},$class}sub log {my ($self,%option)=@_;my$type=$option{type}|| "";my$message=$option{message};chomp$message;my$optional=$option{optional}? " ($option{optional})" : "";my$result=$option{result};my$is_color=ref$self ? $self->{color}: $COLOR;my$verbose=ref$self ? $self->{verbose}: $VERBOSE;my$show_progress=ref$self ? $self->{show_progress}: $SHOW_PROGRESS;if ($is_color and WIN32){if (!defined$HAS_WIN32_COLOR){$HAS_WIN32_COLOR=eval {require Win32::Console::ANSI;1}? 1 : 0}$is_color=0 unless$HAS_WIN32_COLOR}if ($is_color){$type="\e[$color{$type}m$type\e[m" if$type && $color{$type};$result="\e[$color{$result}m$result\e[m" if$result && $color{$result};$optional="\e[1;37m$optional\e[m" if$optional}my$r=$show_progress ? "\r" : "";if ($verbose){$type=$is_color && $type ? sprintf("%-17s",$type): sprintf("%-9s",$type || "");warn$r .sprintf "%d %s %s %s%s\n",$option{pid}|| $$,$result,$type,$message,$optional}else {warn$r .join(" ",$result,$type ? $type : (),$message .$optional)."\n"}}1; APP_CPM_LOGGER $fatpacked{"App/cpm/Logger/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_LOGGER_FILE'; package App::cpm::Logger::File;use strict;use warnings;use App::cpm::Util 'WIN32';use File::Temp ();use POSIX ();sub new {my ($class,$file)=@_;my$fh;if (WIN32){require IO::File;$file ||= File::Temp::tmpnam()}elsif ($file){open$fh,">>:unix",$file or die "$file: $!"}else {($fh,$file)=File::Temp::tempfile(UNLINK=>1)}bless {context=>'',fh=>$fh,file=>$file,pid=>'',},$class}sub symlink_to {my ($self,$dest)=@_;unlink$dest;if (!eval {symlink$self->file,$dest}){$self->{file}=$dest}}sub file {shift->{file}}sub prefix {my$self=shift;my$pid=$self->{pid}|| $$;$self->{context}? "$pid,$self->{context}" : $pid}sub log {my ($self,@line)=@_;my$now=POSIX::strftime('%Y-%m-%dT%H:%M:%S',localtime);my$prefix=$self->prefix;local$self->{fh}=IO::File->new($self->{file},'a')if WIN32;for my$line (@line){chomp$line;print {$self->{fh}}"$now,$prefix| $_\n" for split /\n/,$line}}sub log_with_fh {my ($self,$fh)=@_;my$prefix=$self->prefix;local$self->{fh}=IO::File->new($self->{file},'a')if WIN32;while (my$line=<$fh>){chomp$line;print {$self->{fh}}"@{[POSIX::strftime('%Y-%m-%dT%H:%M:%S', localtime)]},$prefix| $line\n"}}1; APP_CPM_LOGGER_FILE $fatpacked{"App/cpm/Master.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_MASTER'; package App::cpm::Master;use strict;use warnings;use App::cpm::CircularDependency;use App::cpm::Distribution;use App::cpm::Logger;use App::cpm::Task;use App::cpm::version;use CPAN::DistnameInfo;use IO::Handle;use Module::Metadata;sub new {my ($class,%option)=@_;my$self=bless {%option,installed_distributions=>0,tasks=>+{},distributions=>+{},_fail_resolve=>+{},_fail_install=>+{},_is_installed=>+{},},$class;if ($self->{target_perl}){require Module::CoreList;if (!exists$Module::CoreList::version{$self->{target_perl}}){die "Module::CoreList does not have target perl $self->{target_perl} entry, abort.\n"}if (!exists$Module::CoreList::version{$]}){die "Module::CoreList does not have our perl $] entry, abort.\n"}}if (!$self->{global}){if (eval {require Module::CoreList}){if (!exists$Module::CoreList::version{$]}){die "Module::CoreList does not have our perl $] entry, abort.\n"}$self->{_has_corelist}=1}else {my$msg="You don't have Module::CoreList. " ."The local-lib may result in incomplete self-contained directory.";App::cpm::Logger->log(result=>"WARN",message=>$msg)}}$self}sub fail {my$self=shift;my@fail_resolve=sort keys %{$self->{_fail_resolve}};my@fail_install=sort keys %{$self->{_fail_install}};my@not_installed=grep {!$self->{_fail_install}{$_->distfile}&&!$_->installed}$self->distributions;return if!@fail_resolve &&!@fail_install &&!@not_installed;my$detector=App::cpm::CircularDependency->new;for my$dist (@not_installed){my$req=$dist->requirements([qw(configure build test runtime)])->as_array;$detector->add($dist->distfile,$dist->provides,$req)}$detector->finalize;my$detected=$detector->detect;for my$distfile (sort keys %$detected){my$distvname=$self->distribution($distfile)->distvname;my@circular=@{$detected->{$distfile}};my$msg=join " -> ",map {$self->distribution($_)->distvname}@circular;local$self->{logger}{context}=$distvname;$self->{logger}->log("Detected circular dependencies $msg");$self->{logger}->log("Failed to install distribution")}for my$dist (sort {$a->distvname cmp $b->distvname}grep {!$detected->{$_->distfile}}@not_installed){local$self->{logger}{context}=$dist->distvname;$self->{logger}->log("Failed to install distribution, " ."because of installing some dependencies failed")}my@fail_install_name=map {CPAN::DistnameInfo->new($_)->distvname || $_}@fail_install;my@not_installed_name=map {$_->distvname}@not_installed;if (@fail_resolve || @fail_install_name){$self->{logger}->log("--");$self->{logger}->log("Installation failed. " ."The direct cause of the failure comes from the following packages/distributions; " ."you may want to grep this log file by them:");$self->{logger}->log(" * $_")for@fail_resolve,sort@fail_install_name}{resolve=>\@fail_resolve,install=>[sort@fail_install_name,@not_installed_name]}}sub tasks {values %{shift->{tasks}}}sub add_task {my ($self,%task)=@_;my$new=App::cpm::Task->new(%task);if (grep {$_->equals($new)}$self->tasks){return 0}else {$self->{tasks}{$new->uid}=$new;return 1}}sub get_task {my$self=shift;if (my@task=grep {!$_->in_charge}$self->tasks){return@task}$self->_calculate_tasks;return unless$self->tasks;if (my@task=grep {!$_->in_charge}$self->tasks){return@task}return}sub register_result {my ($self,$result)=@_;my ($task)=grep {$_->uid eq $result->{uid}}$self->tasks;die "Missing task that has uid=$result->{uid}" unless$task;%{$task}=%{$result};my$logged=$self->info($task);my$method="_register_@{[$task->{type}]}_result";$self->$method($task);$self->remove_task($task);$self->_show_progress if$logged && $self->{show_progress};return 1}sub info {my ($self,$task)=@_;my$type=$task->type;return if!$App::cpm::Logger::VERBOSE && $type ne "install";my$name=$task->distvname;my ($message,$optional);if ($type eq "resolve"){$message=$task->{package};$message .= " -> $name" .($task->{ref}? "\@$task->{ref}" : "")if$task->{ok};$optional="from $task->{from}" if$task->{ok}and $task->{from}}else {$message=$name;$optional="using cache" if$type eq "fetch" and $task->{using_cache};$optional="using prebuilt" if$task->{prebuilt}}my$elapsed=defined$task->{elapsed}? sprintf "(%.3fsec) ",$task->{elapsed}: "";App::cpm::Logger->log(pid=>$task->{pid},type=>$type,result=>$task->{ok}? "DONE" : "FAIL",message=>"$elapsed$message",optional=>$optional,);return 1}sub _show_progress {my$self=shift;my$all=keys %{$self->{distributions}};my$num=$self->installed_distributions;print STDERR "--- $num/$all ---";STDERR->flush}sub remove_task {my ($self,$task)=@_;delete$self->{tasks}{$task->uid}}sub distributions {values %{shift->{distributions}}}sub distribution {my ($self,$distfile)=@_;$self->{distributions}{$distfile}}sub _calculate_tasks {my$self=shift;my@distributions=grep {!$self->{_fail_install}{$_->distfile}}$self->distributions;if (my@dists=grep {$_->resolved &&!$_->registered}@distributions){for my$dist (@dists){$dist->registered(1);$self->add_task(type=>"fetch",distfile=>$dist->{distfile},source=>$dist->source,uri=>$dist->uri,ref=>$dist->ref,)}}if (my@dists=grep {$_->fetched &&!$_->registered}@distributions){for my$dist (@dists){local$self->{logger}->{context}=$dist->distvname;my$dist_requirements=$dist->requirements('configure')->as_array;my ($is_satisfied,@need_resolve)=$self->is_satisfied($dist_requirements);if ($is_satisfied){$dist->registered(1);$self->add_task(type=>"configure",meta=>$dist->meta,directory=>$dist->directory,distfile=>$dist->{distfile},source=>$dist->source,uri=>$dist->uri,distvname=>$dist->distvname,)}elsif (@need_resolve and!$dist->deps_registered){$dist->deps_registered(1);my$msg=sprintf "Found configure dependencies: %s",join(", ",map {sprintf "%s (%s)",$_->{package},$_->{version_range}|| 0}@need_resolve);$self->{logger}->log($msg);my$ok=$self->_register_resolve_task(@need_resolve);$self->{_fail_install}{$dist->distfile}++ unless$ok}elsif (!defined$is_satisfied){my ($req)=grep {$_->{package}eq "perl"}@$dist_requirements;my$msg=sprintf "%s requires perl %s, but you have only %s",$dist->distvname,$req->{version_range},$self->{target_perl}|| $];$self->{logger}->log($msg);App::cpm::Logger->log(result=>"FAIL",message=>$msg);$self->{_fail_install}{$dist->distfile}++}}}if (my@dists=grep {$_->configured &&!$_->registered}@distributions){for my$dist (@dists){local$self->{logger}->{context}=$dist->distvname;my@phase=qw(build test runtime);push@phase,'configure' if$dist->prebuilt;my$dist_requirements=$dist->requirements(\@phase)->as_array;my ($is_satisfied,@need_resolve)=$self->is_satisfied($dist_requirements);if ($is_satisfied){$dist->registered(1);$self->add_task(type=>"install",meta=>$dist->meta,distdata=>$dist->distdata,directory=>$dist->directory,distfile=>$dist->{distfile},uri=>$dist->uri,static_builder=>$dist->static_builder,prebuilt=>$dist->prebuilt,)}elsif (@need_resolve and!$dist->deps_registered){$dist->deps_registered(1);my$msg=sprintf "Found dependencies: %s",join(", ",map {sprintf "%s (%s)",$_->{package},$_->{version_range}|| 0}@need_resolve);$self->{logger}->log($msg);my$ok=$self->_register_resolve_task(@need_resolve);$self->{_fail_install}{$dist->distfile}++ unless$ok}elsif (!defined$is_satisfied){my ($req)=grep {$_->{package}eq "perl"}@$dist_requirements;my$msg=sprintf "%s requires perl %s, but you have only %s",$dist->distvname,$req->{version_range},$self->{target_perl}|| $];$self->{logger}->log($msg);App::cpm::Logger->log(result=>"FAIL",message=>$msg);$self->{_fail_install}{$dist->distfile}++}}}}sub _register_resolve_task {my ($self,@package)=@_;my$ok=1;for my$package (@package){if ($self->{_fail_resolve}{$package->{package}}|| $self->{_fail_install}{$package->{package}}){$ok=0;next}$self->add_task(type=>"resolve",package=>$package->{package},version_range=>$package->{version_range},)}return$ok}sub is_satisfied_perl_version {my ($self,$version_range)=@_;App::cpm::version->parse($self->{target_perl}|| $])->satisfy($version_range)}sub is_installed {my ($self,$package,$version_range)=@_;my$wantarray=wantarray;if (exists$self->{_is_installed}{$package}){if ($self->{_is_installed}{$package}->satisfy($version_range)){return$wantarray ? (1,$self->{_is_installed}{$package}): 1}}my$info=Module::Metadata->new_from_module($package,inc=>$self->{search_inc});return unless$info;if (!$self->{global}and $self->{_has_corelist}and $self->_in_core_inc($info->filename)){return if!exists$Module::CoreList::version{$]}{$info->name}}my$current_version=$self->{_is_installed}{$package}=App::cpm::version->parse($info->version);my$ok=$current_version->satisfy($version_range);$wantarray ? ($ok,$current_version): $ok}sub _in_core_inc {my ($self,$file)=@_;!!grep {$file =~ /^\Q$_/}@{$self->{core_inc}}}sub is_core {my ($self,$package,$version_range)=@_;my$target_perl=$self->{target_perl};if (exists$Module::CoreList::version{$target_perl}{$package}){if (!exists$Module::CoreList::version{$]}{$package}){if (!$self->{_removed_core}{$package}++){my$t=App::cpm::version->parse($target_perl)->normal;my$v=App::cpm::version->parse($])->normal;App::cpm::Logger->log(result=>"WARN",message=>"$package used to be core in $t, but not in $v, so will be installed",)}return}return 1 unless$version_range;my$core_version=$Module::CoreList::version{$target_perl}{$package};return App::cpm::version->parse($core_version)->satisfy($version_range)}return}sub is_satisfied {my ($self,$requirements)=@_;my$is_satisfied=1;my@need_resolve;my@distributions=$self->distributions;for my$req (@$requirements){my ($package,$version_range)=@{$req}{qw(package version_range)};if ($package eq "perl"){$is_satisfied=undef if!$self->is_satisfied_perl_version($version_range);next}next if$self->{target_perl}and $self->is_core($package,$version_range);next if$self->is_installed($package,$version_range);my ($resolved)=grep {$_->providing($package,$version_range)}@distributions;next if$resolved && $resolved->installed;$is_satisfied=0 if defined$is_satisfied;if (!$resolved){push@need_resolve,$req}}return ($is_satisfied,@need_resolve)}sub add_distribution {my ($self,$distribution)=@_;my$distfile=$distribution->distfile;if (my$already=$self->{distributions}{$distfile}){$already->overwrite_provide($_)for @{$distribution->provides};return 0}else {$self->{distributions}{$distfile}=$distribution;return 1}}sub _register_resolve_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_resolve}{$task->{package}}++;return}local$self->{logger}{context}=$task->{package};if ($task->{distfile}and $task->{distfile}=~ m{/perl-5[^/]+$}){my$message="$task->{package} is a core module.";$self->{logger}->log($message);App::cpm::Logger->log(result=>"DONE",type=>"install",message=>$message,);return}if (!$task->{reinstall}){my$want=$task->{version_range}|| $task->{version};my ($ok,$local)=$self->is_installed($task->{package},$want);if ($ok){my$message=$task->{package}.(App::cpm::version->parse($task->{version})!=$local ? ", you already have $local" : " is up to date. ($local)");$self->{logger}->log($message);App::cpm::Logger->log(result=>"DONE",type=>"install",message=>$message,);return}}my$provides=$task->{provides};if (!$provides or @$provides==0){my$version=App::cpm::version->parse($task->{version})|| 0;$provides=[{package=>$task->{package},version=>$version}]}my$distribution=App::cpm::Distribution->new(source=>$task->{source},uri=>$task->{uri},provides=>$provides,distfile=>$task->{distfile},ref=>$task->{ref},);$self->add_distribution($distribution)}sub _register_fetch_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_install}{$task->distfile}++;return}my$distribution=$self->distribution($task->distfile);$distribution->directory($task->{directory});$distribution->meta($task->{meta});$distribution->provides($task->{provides});if ($task->{prebuilt}){$distribution->configured(1);$distribution->requirements($_=>$task->{requirements}{$_})for keys %{$task->{requirements}};$distribution->prebuilt(1);local$self->{logger}{context}=$distribution->distvname;my$msg=join ", ",map {sprintf "%s (%s)",$_->{package},$_->{version}|| 0}@{$distribution->provides};$self->{logger}->log("Distribution provides: $msg")}else {$distribution->fetched(1);$distribution->requirements($_=>$task->{requirements}{$_})for keys %{$task->{requirements}}}return 1}sub _register_configure_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_install}{$task->distfile}++;return}my$distribution=$self->distribution($task->distfile);$distribution->configured(1);$distribution->requirements($_=>$task->{requirements}{$_})for keys %{$task->{requirements}};$distribution->static_builder($task->{static_builder});$distribution->distdata($task->{distdata});my$p=$task->{distdata}{provides};my@provide=map +{package=>$_,version=>$p->{$_}{version}},sort keys %$p;$distribution->provides(\@provide);local$self->{logger}{context}=$distribution->distvname;my$msg=join ", ",map {sprintf "%s (%s)",$_->{package},$_->{version}|| 0}@{$distribution->provides};$self->{logger}->log("Distribution provides: $msg");return 1}sub _register_install_result {my ($self,$task)=@_;if (!$task->is_success){$self->{_fail_install}{$task->distfile}++;return}my$distribution=$self->distribution($task->distfile);$distribution->installed(1);$self->{installed_distributions}++;return 1}sub installed_distributions {shift->{installed_distributions}}1; APP_CPM_MASTER $fatpacked{"App/cpm/Requirement.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_REQUIREMENT'; package App::cpm::Requirement;use strict;use warnings;use App::cpm::version;sub new {my$class=shift;my$self=bless {requirement=>[]},$class;$self->add(@_)if @_;$self}sub empty {my$self=shift;@{$self->{requirement}}==0}sub has {my ($self,$package)=@_;my ($found)=grep {$_->{package}eq $package}@{$self->{requirement}};$found}sub add {my$self=shift;my%package=(@_,@_ % 2 ? (0): ());for my$package (sort keys%package){my$version_range=$package{$package};if (my ($found)=grep {$_->{package}eq $package}@{$self->{requirement}}){my$merged=eval {App::cpm::version::range_merge($found->{version_range},$version_range)};if (my$err=$@){if ($err =~ /illegal requirements/){$@="Couldn't merge version range '$version_range' with '$found->{version_range}' for package '$package'";warn $@;return}else {die$err}}$found->{version_range}=$merged}else {push @{$self->{requirement}},{package=>$package,version_range=>$version_range }}}return 1}sub merge {my ($self,$other)=@_;$self->add(map {($_->{package},$_->{version_range})}@{$other->as_array})}sub delete :method {my ($self,@package)=@_;for my$i (reverse 0 .. $#{$self->{requirement}}){my$current=$self->{requirement}[$i]{package};if (grep {$current eq $_}@package){splice @{$self->{requirement}},$i,1}}}sub as_array {my$self=shift;$self->{requirement}}1; APP_CPM_REQUIREMENT $fatpacked{"App/cpm/Resolver.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER'; package App::cpm::Resolver;use strict;use warnings;1; APP_CPM_RESOLVER $fatpacked{"App/cpm/Resolver/02Packages.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_02PACKAGES'; package App::cpm::Resolver::02Packages;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::HTTP;use App::cpm::version;use CPAN::02Packages::Search;use Cwd ();use File::Basename ();use File::Copy ();use File::Path ();use File::Spec;use File::Which ();use IPC::Run3 ();use Proc::ForkSafe;sub new {my ($class,%option)=@_;my$cache_dir_base=$option{cache}or die "cache option is required\n";my$mirror=$option{mirror}or die "mirror option is required\n";$mirror =~ s{/*$}{/};my$path=$option{path}|| "${mirror}modules/02packages.details.txt.gz";my$cache_dir=$class->_cache_dir($mirror,$cache_dir_base);my$local_path=$class->_fetch($path=>$cache_dir);my$index=Proc::ForkSafe->wrap(sub {CPAN::02Packages::Search->new(file=>$local_path)});bless {mirror=>$mirror,local_path=>$local_path,index=>$index },$class}sub _cache_dir {my ($class,$mirror,$base)=@_;if ($mirror !~ m{^https?://}){$mirror =~ s{^file://}{};$mirror=Cwd::abs_path($mirror);$mirror =~ s{^/}{}}$mirror =~ s{/$}{};$mirror =~ s/[^\w\.\-]+/%/g;my$dir="$base/$mirror";File::Path::mkpath([$dir],0,0777);return$dir}sub _fetch {my ($class,$path,$cache_dir)=@_;my$dest=File::Spec->catfile($cache_dir,File::Basename::basename($path));if ($path =~ m{^https?://}){my$res=App::cpm::HTTP->create->mirror($path=>$dest);die "$res->{status} $res->{reason}, $path\n" if!$res->{success}}else {$path =~ s{^file://}{};die "$path: No such file.\n" if!-f $path;if (!-f $dest or (stat$dest)[9]<= (stat$path)[9]){File::Copy::copy($path,$dest)or die "Copy $path $dest: $!\n";my$mtime=(stat$path)[9];utime$mtime,$mtime,$dest}}return$dest if$dest !~ /\.gz$/;my$plain=$dest;$plain =~ s/\.gz$//;if (!-f $plain or (stat$plain)[9]<= (stat$dest)[9]){my$gzip=File::Which::which('gzip');die "Need gzip command to decompress $dest\n" if!$gzip;my@cmd=($gzip,"-dc",$dest);IPC::Run3::run3 \@cmd,undef,$plain,\my$err;if ($?!=0){chomp$err;$err ||= "exit status $?";die "@cmd: $err\n"}}return$plain}sub resolve {my ($self,$task)=@_;my$res=$self->{index}->call(search=>$task->{package});if (!$res){return {error=>"not found, @{[$self->{local_path}]}" }}if (my$version_range=$task->{version_range}){my$version=$res->{version}|| 0;if (!App::cpm::version->parse($version)->satisfy($version_range)){return {error=>"found version $version, but it does not satisfy $version_range, @{[$self->{local_path}]}" }}}my$dist=App::cpm::DistNotation->new_from_dist($res->{path});return +{source=>"cpan",distfile=>$dist->distfile,uri=>$dist->cpan_uri($self->{mirror}),version=>$res->{version}|| 0,package=>$task->{package},}}1; APP_CPM_RESOLVER_02PACKAGES $fatpacked{"App/cpm/Resolver/Cascade.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_CASCADE'; package App::cpm::Resolver::Cascade;use strict;use warnings;sub new {my$class=shift;bless {backends=>[]},$class}sub add {my ($self,$resolver)=@_;push @{$self->{backends}},$resolver;$self}sub resolve {my ($self,$task)=@_;my@error;for my$backend (@{$self->{backends}}){my$result=$backend->resolve($task);next unless$result;my$klass=ref$backend;$klass=$1 if$klass =~ /^App::cpm::Resolver::(.*)$/;if (my$error=$result->{error}){push@error,"$klass, $error"}else {$result->{from}=$klass;return$result}}push@error,"no resolver backends" if!@error;return {error=>join("\n",@error)}}1; APP_CPM_RESOLVER_CASCADE $fatpacked{"App/cpm/Resolver/Custom.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_CUSTOM'; package App::cpm::Resolver::Custom;use strict;use warnings;use App::cpm::DistNotation;sub new {my ($class,%argv)=@_;my$from=$argv{from};my$requirements=$argv{requirements};my$mirror=$argv{mirror}|| 'https://cpan.metacpan.org/';$mirror =~ s{/*$}{/};my$self=bless {from=>$from,mirror=>$mirror,requirements=>$requirements,},$class;$self->_load;$self}sub _load {my$self=shift;my%resolve;for my$package (sort keys %{$self->{requirements}}){my$options=$self->{requirements}{$package};my$uri;if ($uri=$options->{git}){$resolve{$package}={source=>'git',uri=>$uri,ref=>$options->{ref},provides=>[{package=>$package}],}}elsif ($uri=$options->{dist}){my$dist=App::cpm::DistNotation->new_from_dist($uri);die "Unsupported dist '$uri' found in $self->{from}\n" if!$dist;my$cpan_uri=$dist->cpan_uri($options->{mirror}|| $self->{mirror});$resolve{$package}={source=>'cpan',uri=>$cpan_uri,distfile=>$dist->distfile,provides=>[{package=>$package}],}}elsif ($uri=$options->{url}){die "Unsupported url '$uri' found in $self->{from}\n" if$uri !~ m{^(?:https?|file)://};my$dist=App::cpm::DistNotation->new_from_uri($uri);my$source=$dist ? 'cpan' : $uri =~ m{^file://} ? 'local' : 'http';$resolve{$package}={source=>$source,uri=>$dist ? $dist->cpan_uri : $uri,($dist ? (distfile=>$dist->distfile): ()),provides=>[{package=>$package}],}}}$self->{resolve}=\%resolve}sub effective {my$self=shift;%{$self->{resolve}}? 1 : 0}sub resolve {my ($self,$task)=@_;my$found=$self->{resolve}{$task->{package}};if (!$found){return {error=>"not found in $self->{from}" }}$found}1; APP_CPM_RESOLVER_CUSTOM $fatpacked{"App/cpm/Resolver/Fixed.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_FIXED'; package App::cpm::Resolver::Fixed;use strict;use warnings;use parent 'App::cpm::Resolver::MetaDB';sub new {my$class=shift;my%package;for my$argv (@_){my ($package,$fixed_version)=split /\@/,$argv;$package{$package}=$fixed_version}my$self=$class->SUPER::new;$self->{_packages}=\%package;$self}sub resolve {my ($self,$argv)=@_;my$fixed_version=$self->{_packages}{$argv->{package}};return {error=>"not found" }if!$fixed_version;my$version_range=$argv->{version_range};if ($version_range){$version_range .= ", == $fixed_version"}else {$version_range="== $fixed_version"}$self->SUPER::resolve({%$argv,version_range=>$version_range })}1; APP_CPM_RESOLVER_FIXED $fatpacked{"App/cpm/Resolver/MetaCPAN.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_METACPAN'; package App::cpm::Resolver::MetaCPAN;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::HTTP;use JSON::PP ();sub new {my ($class,%option)=@_;my$uri=$option{uri}|| "https://fastapi.metacpan.org/v1/download_url/";$uri =~ s{/*$}{/};my$http=App::cpm::HTTP->create;bless {%option,uri=>$uri,http=>$http },$class}sub _encode {my$str=shift;$str =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;$str}sub resolve {my ($self,$task)=@_;if ($self->{only_dev}and!$task->{dev}){return {error=>"skip, because MetaCPAN is configured to resolve dev releases only" }}my%query=((($self->{dev}|| $task->{dev})? (dev=>1): ()),($task->{version_range}? (version=>$task->{version_range}): ()),);my$query=join "&",map {"$_=" ._encode($query{$_})}sort keys%query;my$uri="$self->{uri}$task->{package}" .($query ? "?$query" : "");my$res;for (1..2){$res=$self->{http}->get($uri);last if$res->{success}or $res->{status}==404}if (!$res->{success}){my$error="$res->{status} $res->{reason}, $uri";$error .= ", $res->{content}" if$res->{status}==599;return {error=>$error }}my$hash=eval {JSON::PP::decode_json($res->{content})}or return;my$dist=App::cpm::DistNotation->new_from_uri($hash->{download_url});return {source=>"cpan",distfile=>$dist->distfile,package=>$task->{package},version=>$hash->{version}|| 0,uri=>$hash->{download_url},}}1; APP_CPM_RESOLVER_METACPAN $fatpacked{"App/cpm/Resolver/MetaDB.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_METADB'; package App::cpm::Resolver::MetaDB;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::HTTP;use App::cpm::version;use CPAN::Meta::YAML;sub new {my ($class,%option)=@_;my$uri=$option{uri}|| "https://cpanmetadb.plackperl.org/v1.0/";my$mirror=$option{mirror}|| "https://cpan.metacpan.org/";s{/*$}{/} for$uri,$mirror;my$http=App::cpm::HTTP->create;bless {%option,http=>$http,uri=>$uri,mirror=>$mirror,},$class}sub _get {my ($self,$uri)=@_;my$res;for (1..2){$res=$self->{http}->get($uri);last if$res->{success}or $res->{status}==404}$res}sub _uniq {my%x;grep {!$x{$_ || ""}++}@_}sub resolve {my ($self,$task)=@_;if (defined$task->{version_range}and $task->{version_range}=~ /(?:<|!=|==)/){my$uri="$self->{uri}history/$task->{package}";my$res=$self->_get($uri);if (!$res->{success}){my$error="$res->{status} $res->{reason}, $uri";$error .= ", $res->{content}" if$res->{status}==599;return {error=>$error }}my@found;for my$line (split /\r?\n/,$res->{content}){if ($line =~ /^$task->{package}\s+(\S+)\s+(\S+)$/){push@found,{version=>$1,version_o=>App::cpm::version->parse($1),distfile=>$2,}}}$found[-1]->{latest}=1;my$match;for my$try (sort {$b->{version_o}<=> $a->{version_o}}@found){if ($try->{version_o}->satisfy($task->{version_range})){$match=$try,last}}if ($match){my$dist=App::cpm::DistNotation->new_from_dist($match->{distfile});return {source=>"cpan",package=>$task->{package},version=>$match->{version},uri=>$dist->cpan_uri($self->{mirror}),distfile=>$dist->distfile,}}else {return {error=>"found versions @{[join ',', _uniq map $_->{version}, @found]}, but they do not satisfy $task->{version_range}, $uri" }}}else {my$uri="$self->{uri}package/$task->{package}";my$res=$self->_get($uri);if (!$res->{success}){my$error="$res->{status} $res->{reason}, $uri";$error .= ", $res->{content}" if$res->{status}==599;return {error=>$error }}my$yaml=CPAN::Meta::YAML->read_string($res->{content});my$meta=$yaml->[0];if (!App::cpm::version->parse($meta->{version})->satisfy($task->{version_range})){return {error=>"found version $meta->{version}, but it does not satisfy $task->{version_range}, $uri" }}my@provides=map {my$package=$_;my$version=$meta->{provides}{$_};$version=undef if$version eq "undef";+{package=>$package,version=>$version }}sort keys %{$meta->{provides}};my$dist=App::cpm::DistNotation->new_from_dist($meta->{distfile});return {source=>"cpan",distfile=>$dist->distfile,uri=>$dist->cpan_uri($self->{mirror}),version=>$meta->{version},provides=>\@provides,}}return}1; APP_CPM_RESOLVER_METADB $fatpacked{"App/cpm/Resolver/Snapshot.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_RESOLVER_SNAPSHOT'; package App::cpm::Resolver::Snapshot;use strict;use warnings;use App::cpm::DistNotation;use App::cpm::version;use Carton::Snapshot;sub new {my ($class,%option)=@_;my$snapshot=Carton::Snapshot->new(path=>$option{path}|| "cpanfile.snapshot");$snapshot->load;my$mirror=$option{mirror}|| "https://cpan.metacpan.org/";$mirror =~ s{/*$}{/};bless {%option,mirror=>$mirror,snapshot=>$snapshot },$class}sub snapshot {shift->{snapshot}}sub resolve {my ($self,$task)=@_;my$package=$task->{package};my$found=$self->snapshot->find($package);if (!$found){return {error=>"not found, @{[$self->snapshot->path]}" }}my$version=$found->version_for($package);if (my$version_range=$task->{version_range}){if (!App::cpm::version->parse($version)->satisfy($version_range)){return {error=>"found version $version, but it does not satisfy $version_range, @{[$self->snapshot->path]}" }}}my@provides=map {my$package=$_;my$version=$found->provides->{$_}{version};+{package=>$package,version=>$version }}sort keys %{$found->provides};my$dist=App::cpm::DistNotation->new_from_dist($found->distfile);return {source=>"cpan",distfile=>$dist->distfile,uri=>$dist->cpan_uri($self->{mirror}),version=>$version || 0,provides=>\@provides,}}1; APP_CPM_RESOLVER_SNAPSHOT $fatpacked{"App/cpm/Task.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_TASK'; package App::cpm::Task;use strict;use warnings;use CPAN::DistnameInfo;sub new {my ($class,%option)=@_;my$self=bless {%option},$class;$self->{uid}=$self->_uid;$self}sub uid {shift->{uid}}sub _uid {my$self=shift;my$type=$self->type;if (grep {$type eq $_}qw(fetch configure install)){"$type " .$self->distfile}elsif ($type eq "resolve"){"$type " .$self->{package}}else {die "unknown type: " .($type || "(undef)")}}sub distfile {my$self=shift;$self->{distfile}|| $self->{uri}}sub distvname {my$self=shift;return$self->{_distvname}if$self->{_distvname};if ($self->{distfile}){$self->{_distvname}||= CPAN::DistnameInfo->new($self->{distfile})->distvname}elsif ($self->{uri}){$self->{uri}}elsif ($self->{package}){$self->{package}}else {"UNKNOWN"}}sub distname {my$self=shift;$self->{_distname}||= CPAN::DistnameInfo->new($self->distfile)->dist || 'UNKNOWN'}sub cpanid {my$self=shift;$self->{_cpanid}||= CPAN::DistnameInfo->new($self->distfile)->cpanid || 'UNKNOWN'}sub type {my$self=shift;$self->{type}}sub in_charge {my$self=shift;@_ ? $self->{in_charge}=shift : $self->{in_charge}}sub is_success {my$self=shift;$self->{ok}}sub equals {my ($self,$that)=@_;$self->uid eq $that->uid}sub merge {my ($self,$that)=@_;for my$key (keys %$that){$self->{$key}=$that->{$key}}$self}1; APP_CPM_TASK $fatpacked{"App/cpm/Tutorial.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_TUTORIAL'; package App::cpm::Tutorial;use strict;use warnings;1; APP_CPM_TUTORIAL $fatpacked{"App/cpm/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_UTIL'; package App::cpm::Util;use strict;use warnings;use Config;use Cwd ();use Digest::MD5 ();use File::Spec;use Exporter 'import';our@EXPORT_OK=qw(perl_identity maybe_abs WIN32 determine_home);use constant WIN32=>$^O eq 'MSWin32';sub perl_identity {my$digest=Digest::MD5::md5_hex($Config{perlpath}.Config->myconfig);$digest=substr$digest,0,8;join '-',$Config{version},$Config{archname},$digest}sub maybe_abs {my$path=shift;if (File::Spec->file_name_is_absolute($path)){return$path}my$cwd=shift || Cwd::cwd();File::Spec->canonpath(File::Spec->catdir($cwd,$path))}sub determine_home {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)}File::Spec->catdir($homedir,".perl-cpm")}1; APP_CPM_UTIL $fatpacked{"App/cpm/Worker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER'; package App::cpm::Worker;use strict;use warnings;use App::cpm::Logger::File;use App::cpm::Util;use App::cpm::Worker::Installer;use App::cpm::Worker::Resolver;use Config;use File::Path ();use File::Spec;use Time::HiRes qw(gettimeofday tv_interval);sub new {my ($class,%option)=@_;my$home=$option{home};my$logger=$option{logger}|| App::cpm::Logger::File->new("$home/build.log.@{[time]}");my$prebuilt_base;if ($option{prebuilt}){$prebuilt_base=$class->prebuilt_base($home);File::Path::mkpath($prebuilt_base)if!-d $prebuilt_base;my$file="$prebuilt_base/version";if (!-f $file){open my$fh,">",$file or die "$file: $!";print {$fh}"$Config{perlpath}\n"}}%option=(%option,logger=>$logger,base=>"$home/work/" .time .".$$",cache=>"$home/cache",$prebuilt_base ? (prebuilt_base=>$prebuilt_base): (),);my$installer=App::cpm::Worker::Installer->new(%option);my$resolver=App::cpm::Worker::Resolver->new(%option,impl=>$option{resolver});bless {%option,installer=>$installer,resolver=>$resolver },$class}sub prebuilt_base {my ($class,$home)=@_;my$identity=App::cpm::Util::perl_identity;File::Spec->catdir($home,"builds",$identity)}sub work {my ($self,$task)=@_;my$type=$task->{type}|| "(undef)";my$result;my$start=$self->{verbose}? [gettimeofday]: undef;if (grep {$type eq $_}qw(fetch configure install)){$result=eval {$self->{installer}->work($task)};warn $@ if $@}elsif ($type eq "resolve"){$result=eval {$self->{resolver}->work($task)};warn $@ if $@}else {die "Unknown type: $type\n"}my$elapsed=$start ? tv_interval($start): undef;$result ||= {ok=>0 };$task->merge({%$result,pid=>$$,elapsed=>$elapsed});return$task}1; APP_CPM_WORKER $fatpacked{"App/cpm/Worker/Installer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_INSTALLER'; package App::cpm::Worker::Installer;use strict;use warnings;use App::cpm::Logger::File;use App::cpm::Requirement;use App::cpm::Worker::Installer::Menlo;use App::cpm::Worker::Installer::Prebuilt;use App::cpm::version;use CPAN::DistnameInfo;use CPAN::Meta;use Config;use ExtUtils::Install ();use ExtUtils::InstallPaths ();use File::Basename 'basename';use File::Copy ();use File::Copy::Recursive ();use File::Path qw(mkpath rmtree);use File::Spec;use File::Temp ();use File::pushd 'pushd';use JSON::PP ();use Time::HiRes ();use constant NEED_INJECT_TOOLCHAIN_REQUIREMENTS=>$] < 5.018;my$TRUSTED_MIRROR=sub {my$uri=shift;!!($uri =~ m{^https?://(?:www.cpan.org|backpan.perl.org|cpan.metacpan.org)})};sub work {my ($self,$task)=@_;my$type=$task->{type}|| "(undef)";local$self->{logger}{context}=$task->distvname;if ($type eq "fetch"){if (my$result=$self->fetch($task)){return +{ok=>1,directory=>$result->{directory},meta=>$result->{meta},requirements=>$result->{requirements},provides=>$result->{provides},using_cache=>$result->{using_cache},prebuilt=>$result->{prebuilt},}}else {$self->{logger}->log("Failed to fetch/configure distribution")}}elsif ($type eq "configure"){if (my$result=$self->configure($task)){return +{ok=>1,distdata=>$result->{distdata},requirements=>$result->{requirements},static_builder=>$result->{static_builder},}}else {$self->{logger}->log("Failed to configure distribution")}}elsif ($type eq "install"){my$ok=$self->install($task);my$message=$ok ? "Successfully installed distribution" : "Failed to install distribution";$self->{logger}->log($message);return {ok=>$ok,directory=>$task->{directory}}}else {die "Unknown type: $type\n"}return {ok=>0 }}sub new {my ($class,%option)=@_;$option{logger}||= App::cpm::Logger::File->new;$option{base}or die "base option is required\n";$option{cache}or die "cache option is required\n";mkpath $_ for grep!-d,$option{base},$option{cache};$option{logger}->log("Work directory is $option{base}");my$menlo=App::cpm::Worker::Installer::Menlo->new(static_install=>$option{static_install},base=>$option{base},logger=>$option{logger},quiet=>1,pod2man=>$option{man_pages},notest=>$option{notest},sudo=>$option{sudo},mirrors=>["https://cpan.metacpan.org/"],configure_timeout=>$option{configure_timeout},build_timeout=>$option{build_timeout},test_timeout=>$option{test_timeout},);if ($option{local_lib}){my$local_lib=$option{local_lib}=$menlo->maybe_abs($option{local_lib});$menlo->{self_contained}=1;$menlo->log("Setup local::lib $local_lib");$menlo->setup_local_lib($local_lib)}$menlo->log("--",`$^X -V`,"--");$option{prebuilt}=App::cpm::Worker::Installer::Prebuilt->new if$option{prebuilt};bless {%option,menlo=>$menlo },$class}sub menlo {shift->{menlo}}sub _fetch_git {my ($self,$uri,$ref)=@_;my$basename=File::Basename::basename($uri);$basename =~ s/\.git$//;$basename =~ s/[^a-zA-Z0-9_.-]/-/g;my$dir=File::Temp::tempdir("$basename-XXXXX",CLEANUP=>0,DIR=>$self->menlo->{base},);$self->menlo->mask_output(diag_progress=>"Cloning $uri");local$ENV{GIT_TERMINAL_PROMPT}=0 if!exists$ENV{GIT_TERMINAL_PROMPT};$self->menlo->run_command(['git','clone',$uri,$dir ]);unless (-e "$dir/.git"){$self->menlo->diag_fail("Failed cloning git repository $uri",0);return}my$guard=pushd$dir;if ($ref){unless ($self->menlo->run_command(['git','checkout',$ref ])){$self->menlo->diag_fail("Failed to checkout '$ref' in git repository $uri\n",0);return}}$self->menlo->diag_ok;chomp(my$rev=`git rev-parse --short HEAD`);($dir,$rev)}sub enable_prebuilt {my ($self,$uri)=@_;$self->{prebuilt}&&!$self->{prebuilt}->skip($uri)&& $TRUSTED_MIRROR->($uri)}sub fetch {my ($self,$task)=@_;my$guard=pushd;my$source=$task->{source};my$distfile=$task->{distfile};my$uri=$task->{uri};if ($self->enable_prebuilt($uri)){if (my$result=$self->find_prebuilt($uri)){$self->{logger}->log("Using prebuilt $result->{directory}");return$result}}my ($dir,$rev,$using_cache);if ($source eq "git"){($dir,$rev)=$self->_fetch_git($uri,$task->{ref})}elsif ($source eq "local"){$self->{logger}->log("Copying $uri");$uri =~ s{^file://}{};$uri=$self->menlo->maybe_abs($uri);my$basename=basename$uri;my$g=pushd$self->menlo->{base};if (-d $uri){my$dest=File::Temp::tempdir("$basename-XXXXX",CLEANUP=>0,DIR=>$self->menlo->{base},);File::Copy::Recursive::dircopy($uri,$dest);$dir=$dest}elsif (-f $uri){my$dest=$basename;File::Copy::copy($uri,$dest);$dir=$self->menlo->unpack($basename);$dir=File::Spec->catdir($self->menlo->{base},$dir)if$dir}}elsif ($source =~ /^(?:cpan|https?)$/){my$g=pushd$self->menlo->{base};FETCH: {my$basename=basename$uri;if ($uri =~ s{^file://}{}){$self->{logger}->log("Copying $uri");File::Copy::copy($uri,$basename)or last FETCH;$dir=$self->menlo->unpack($basename)}else {local$self->menlo->{save_dists};if ($distfile and $TRUSTED_MIRROR->($uri)){my$cache=File::Spec->catfile($self->{cache},"authors/id/$distfile");if (-f $cache){$self->{logger}->log("Using cache $cache");File::Copy::copy($cache,$basename);$dir=$self->menlo->unpack($basename);if ($dir){$using_cache++;last FETCH}unlink$cache}$self->menlo->{save_dists}=$self->{cache}}$dir=$self->menlo->fetch_module({uris=>[$uri],pathname=>$distfile})}}$dir=File::Spec->catdir($self->menlo->{base},$dir)if$dir}return unless$dir;chdir$dir or die;my$meta=$self->_load_metafile($distfile,'META.json','META.yml');if (!$meta){$self->{logger}->log("Distribution does not have META.json nor META.yml");return}my$p=$meta->{provides}|| $self->menlo->extract_packages($meta,".");my$provides=[map +{package=>$_,version=>$p->{$_}{version}},sort keys %$p ];my$req={configure=>App::cpm::Requirement->new };if ($self->menlo->opts_in_static_install($meta)){$self->{logger}->log("Distribution opts in x_static_install: $meta->{x_static_install}")}else {$req={configure=>$self->_extract_configure_requirements($meta,$distfile)}}return +{directory=>$dir,meta=>$meta,requirements=>$req,provides=>$provides,using_cache=>$using_cache,}}sub find_prebuilt {my ($self,$uri)=@_;my$info=CPAN::DistnameInfo->new($uri);my$dir=File::Spec->catdir($self->{prebuilt_base},$info->cpanid,$info->distvname);return unless -f File::Spec->catfile($dir,".prebuilt");my$guard=pushd$dir;my$meta=$self->_load_metafile($uri,'META.json','META.yml');my$mymeta=$self->_load_metafile($uri,'blib/meta/MYMETA.json');my$phase=$self->{notest}? [qw(build runtime)]: [qw(build test runtime)];my%req;if (!$self->menlo->opts_in_static_install($meta)){%req=(configure=>$self->_extract_configure_requirements($meta,$uri))}%req=(%req,%{$self->_extract_requirements($mymeta,$phase)});my$provides=do {open my$fh,"<",'blib/meta/install.json' or die;my$json=JSON::PP::decode_json(do {local $/;<$fh>});my$provides=$json->{provides};[map +{package=>$_,version=>$provides->{$_}{version}},sort keys %$provides ]};return +{directory=>$dir,meta=>$meta->as_struct,provides=>$provides,prebuilt=>1,requirements=>\%req,}}sub save_prebuilt {my ($self,$task)=@_;my$dir=File::Spec->catdir($self->{prebuilt_base},$task->cpanid,$task->distvname);if (-d $dir and!File::Path::rmtree($dir)){return}my$parent=File::Basename::dirname($dir);for (1..3){last if -d $parent;eval {File::Path::mkpath($parent)}}return unless -d $parent;$self->{logger}->log("Saving the build $task->{directory} in $dir");if (File::Copy::Recursive::dircopy($task->{directory},$dir)){open my$fh,">",File::Spec->catfile($dir,".prebuilt")or die $!}else {warn "dircopy $task->{directory} $dir: $!"}}sub _inject_toolchain_requirements {my ($self,$distfile,$requirement)=@_;$distfile ||= "";if (-f "Makefile.PL" and!$requirement->has('ExtUtils::MakeMaker')and!-f "Build.PL" and $distfile !~ m{/ExtUtils-MakeMaker-[0-9v]}){$requirement->add('ExtUtils::MakeMaker')}if ($requirement->has('Module::Build')){$requirement->add('ExtUtils::Install')}my%inject=('Module::Build'=>'0.38','ExtUtils::MakeMaker'=>'6.64','ExtUtils::Install'=>'1.46',);for my$package (sort keys%inject){$requirement->has($package)or next;$requirement->add($package,$inject{$package})}$requirement}sub _load_metafile {my ($self,$distfile,@file)=@_;my$meta;if (my ($file)=grep -f,@file){$meta=eval {CPAN::Meta->load_file($file)};$self->{logger}->log("Invalid $file: $@")if $@}if (!$meta and $distfile){my$d=CPAN::DistnameInfo->new($distfile);$meta=CPAN::Meta->new({name=>$d->dist,version=>$d->version})}$meta}sub _extract_configure_requirements {my ($self,$meta,$distfile)=@_;my$requirement=$self->_extract_requirements($meta,[qw(configure)])->{configure};if ($requirement->empty and -f "Build.PL" and ($distfile || "")!~ m{/Module-Build-[0-9v]}){$requirement->add("Module::Build"=>"0.38")}if (NEED_INJECT_TOOLCHAIN_REQUIREMENTS){$self->_inject_toolchain_requirements($distfile,$requirement)}return$requirement}sub _extract_requirements {my ($self,$meta,$phases)=@_;$phases=[$phases]unless ref$phases;my$hash=$meta->effective_prereqs->as_string_hash;my%req;for my$phase (@$phases){my$req=App::cpm::Requirement->new;my$from=($hash->{$phase}|| +{})->{requires}|| +{};for my$package (sort keys %$from){$req->add($package,$from->{$package})}$req{$phase}=$req}\%req}sub _retry {my ($self,$sub)=@_;return 1 if$sub->();return unless$self->{retry};Time::HiRes::sleep(0.1);$self->{logger}->log("! Retrying (you can turn off this behavior by --no-retry)");return$sub->()}sub configure {my ($self,$task)=@_;my ($dir,$distfile,$meta,$source)=@{$task}{qw(directory distfile meta source)};my$guard=pushd$dir;my$menlo=$self->menlo;my$menlo_dist={meta=>$meta,cpanmeta=>$meta };$self->{logger}->log("Configuring distribution");my ($static_builder,$configure_ok);{if ($menlo->opts_in_static_install($meta)){my$state={};$menlo->static_install_configure($state,$menlo_dist,1);$static_builder=$state->{static_install};++$configure_ok and last}if (-f 'Build.PL'){my@cmd=($menlo->{perl},'Build.PL');push@cmd,'--pureperl-only' if$self->{pureperl_only};$self->_retry(sub {$menlo->configure(\@cmd,$menlo_dist,1);-f 'Build'})and ++$configure_ok and last}if (-f 'Makefile.PL'){if (!$menlo->{make}){$self->{logger}->log("There is Makefile.PL, but you don't have 'make' command; you should install 'make' command first");last}my@cmd=($menlo->{perl},'Makefile.PL');push@cmd,'PUREPERL_ONLY=1' if$self->{pureperl_only};$self->_retry(sub {$menlo->configure(\@cmd,$menlo_dist,1);-f 'Makefile'})and ++$configure_ok and last}}return unless$configure_ok;my$distdata=$self->_build_distdata($source,$distfile,$meta);my$phase=$self->{notest}? [qw(build runtime)]: [qw(build test runtime)];my$mymeta=$self->_load_metafile($distfile,'MYMETA.json','MYMETA.yml');my$req=$self->_extract_requirements($mymeta,$phase);return +{distdata=>$distdata,requirements=>$req,static_builder=>$static_builder,}}sub _build_distdata {my ($self,$source,$distfile,$meta)=@_;my$menlo=$self->menlo;my$fake_state={configured_ok=>1,use_module_build=>-f "Build" };my$module_name=$menlo->find_module_name($fake_state)|| $meta->{name};$module_name =~ s/-/::/g;my$distvname=CPAN::DistnameInfo->new($distfile)->distvname;my$provides=$meta->{provides}|| $menlo->extract_packages($meta,".");+{distvname=>$distvname,pathname=>$distfile,provides=>$provides,version=>$meta->{version}|| 0,source=>$source,module_name=>$module_name,}}sub install {my ($self,$task)=@_;return$self->install_prebuilt($task)if$task->{prebuilt};my ($dir,$distdata,$static_builder,$distvname,$meta)=@{$task}{qw(directory distdata static_builder distvname meta)};my$guard=pushd$dir;my$menlo=$self->menlo;my$menlo_dist={meta=>$meta };$self->{logger}->log("Building " .($menlo->{notest}? "" : "and testing ")."distribution");my$installed;if ($static_builder){$menlo->build(sub {$static_builder->build},$distvname,$menlo_dist)&& $menlo->test(sub {$static_builder->build("test")},$distvname,$menlo_dist)&& $menlo->install(sub {$static_builder->build("install")},[],$distvname,$menlo_dist)&& $installed++}elsif (-f 'Build'){$self->_retry(sub {$menlo->build([$menlo->{perl},"./Build" ],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->test([$menlo->{perl},"./Build","test" ],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->install([$menlo->{perl},"./Build","install" ],[],$distvname,$menlo_dist)})&& $installed++}else {$self->_retry(sub {$menlo->build([$menlo->{make}],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->test([$menlo->{make},"test" ],$distvname,$menlo_dist)})&& $self->_retry(sub {$menlo->install([$menlo->{make},"install" ],[],$distvname,$menlo_dist)})&& $installed++}if ($installed && $distdata){$menlo->save_meta($distdata->{module_name},$distdata,$distdata->{module_name},);$self->save_prebuilt($task)if$self->enable_prebuilt($task->{uri})}return$installed}sub install_prebuilt {my ($self,$task)=@_;my$install_base=$self->{local_lib};if (!$install_base && ($ENV{PERL_MM_OPT}|| '')=~ /INSTALL_BASE=(\S+)/){$install_base=$1}$self->{logger}->log("Copying prebuilt $task->{directory}/blib");my$guard=pushd$task->{directory};my$paths=ExtUtils::InstallPaths->new(dist_name=>$task->distname,$install_base ? (install_base=>$install_base): (),);my$install_base_meta=$install_base ? "$install_base/lib/perl5" : $Config{sitelibexp};my$distvname=$task->distvname;open my$fh,">",\my$stdout;{local*STDOUT=$fh;ExtUtils::Install::install([from_to=>$paths->install_map,verbose=>0,dry_run=>0,uninstall_shadows=>0,skip=>undef,always_copy=>1,result=>\my%result,]);ExtUtils::Install::install({'blib/meta'=>"$install_base_meta/$Config{archname}/.meta/$distvname",})}$self->{logger}->log($stdout);return 1}1; APP_CPM_WORKER_INSTALLER $fatpacked{"App/cpm/Worker/Installer/Menlo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_INSTALLER_MENLO'; package App::cpm::Worker::Installer::Menlo;use strict;use warnings;use parent 'Menlo::CLI::Compat';use App::cpm::HTTP;use App::cpm::Installer::Unpacker;use App::cpm::Logger::File;use App::cpm::Util 'WIN32';use Command::Runner;use Config;use File::Which ();use Menlo::Builder::Static;sub new {my ($class,%option)=@_;$option{log}||= $option{logger}->file;my$self=$class->SUPER::new(%option);if ($self->{make}=File::Which::which($Config{make})){$self->{logger}->log("You have make $self->{make}")}{my ($http,$desc)=App::cpm::HTTP->create;$self->{http}=$http;$self->{logger}->log("You have $desc")}{$self->{unpacker}=App::cpm::Installer::Unpacker->new;my$desc=$self->{unpacker}->describe;for my$key (sort keys %$desc){$self->{logger}->log("You have $key $desc->{$key}")}}$self->{initialized}=1;$self}sub unpack {my ($self,$file)=@_;$self->{logger}->log("Unpacking $file");my ($dir,$err)=$self->{unpacker}->unpack($file);$self->{logger}->log($err)if!$dir && $err;$dir}sub mirror {my ($self,$uri,$local)=@_;if ($uri =~ /^file:/){return$self->file_mirror($uri,$local)}my$res=$self->{http}->mirror($uri,$local);$self->{logger}->log($res->{status}.($res->{reason}? " $res->{reason}" : ""));return 1 if$res->{success};unlink$local;$self->{logger}->log($res->{content})if$res->{status}==599;return}sub log {my$self=shift;$self->{logger}->log(@_)}sub run_command {my ($self,$cmd)=@_;$self->run_timeout($cmd,0)}sub run_timeout {my ($self,$cmd,$timeout)=@_;my$str=ref$cmd eq 'CODE' ? '' : ref$cmd eq 'ARRAY' ? "@$cmd" : $cmd;$self->{logger}->log("Executing $str")if$str;my$runner=Command::Runner->new(command=>$cmd,keep=>0,redirect=>1,timeout=>$timeout,stdout=>sub {$self->log(@_)},);my$res=$runner->run;if ($res->{timeout}){$self->diag_fail("Timed out (> ${timeout}s).");return}my$result=$res->{result};ref$cmd eq 'CODE' ? $result : $result==0}1; APP_CPM_WORKER_INSTALLER_MENLO $fatpacked{"App/cpm/Worker/Installer/Prebuilt.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_INSTALLER_PREBUILT'; package App::cpm::Worker::Installer::Prebuilt;use strict;use warnings;my@SKIP=(qr{/XML-SAX-v?[0-9\.]+\.tar\.gz$},);sub new {my$class=shift;bless {},$class}sub skip {my ($self,$uri)=@_;!!grep {$uri =~ $_}@SKIP}1; APP_CPM_WORKER_INSTALLER_PREBUILT $fatpacked{"App/cpm/Worker/Resolver.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_WORKER_RESOLVER'; package App::cpm::Worker::Resolver;use strict;use warnings;use App::cpm::Logger::File;sub new {my ($class,%option)=@_;my$logger=$option{logger}|| App::cpm::Logger::File->new;bless {impl=>$option{impl},logger=>$logger },$class}sub work {my ($self,$task)=@_;local$self->{logger}->{context}=$task->{package};my$result=$self->{impl}->resolve($task);if ($result and!$result->{error}){$result->{ok}=1;my$msg=sprintf "Resolved %s (%s) -> %s",$task->{package},$task->{version_range}|| 0,$result->{uri}.($result->{from}? " from $result->{from}" : "");$self->{logger}->log($msg);return$result}else {$self->{logger}->log($result->{error})if$result and $result->{error};$self->{logger}->log(sprintf "Failed to resolve %s",$task->{package});return {ok=>0 }}}1; APP_CPM_WORKER_RESOLVER $fatpacked{"App/cpm/version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPM_VERSION'; package App::cpm::version;use strict;use warnings;use CPAN::Meta::Requirements;use parent 'version';sub satisfy {my ($self,$version_range)=@_;return 1 unless$version_range;return$self >= (ref$self)->parse($version_range)if$version_range =~ /^v?[\d_.]+$/;my$requirements=CPAN::Meta::Requirements->new;$requirements->add_string_requirement('DummyModule',$version_range);$requirements->accepts_module('DummyModule',$self->numify)}sub numify {local$SIG{__WARN__}=sub {};shift->SUPER::numify(@_)}sub parse {local$SIG{__WARN__}=sub {};shift->SUPER::parse(@_)}sub range_merge {my ($range1,$range2)=@_;my$req=CPAN::Meta::Requirements->new;$req->add_string_requirement('DummyModule',$_)for$range1,$range2;$req->requirements_for_module('DummyModule')}1; APP_CPM_VERSION $fatpacked{"CPAN/02Packages/Search.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_02PACKAGES_SEARCH'; package CPAN::02Packages::Search;use strict;use warnings;use Search::Dict ();use Symbol ();use Tie::Handle::SkipHeader;our$VERSION='0.100';sub new {my ($class,%argv)=@_;my$fh=$argv{fh};if (!$fh){my$file=$argv{file};my$skip_header=exists$argv{skip_header}? $argv{skip_header}: 1;$fh=$class->_open($file,$skip_header)}bless {fh=>$fh },$class}sub _open {my ($class,$file,$skip_header)=@_;if ($skip_header){my$fh=Symbol::gensym;tie *$fh,'Tie::Handle::SkipHeader','<',$file or die "$!: $file\n";return$fh}open my$fh,"<",$file or die "$!: $file\n";$fh}sub search {my ($self,$package)=@_;my$fh=$self->{fh};seek$fh,0,0;my$pos=Search::Dict::look$fh,$package,{xfrm=>\&_xform_package,fold=>1 };return if$pos==-1 || eof$fh;while (my$line=<$fh>){last if$line !~ /\A\Q$package\E\s+/i;chomp$line;my ($_package,$version,$path)=split /\s+/,$line,4;if ($package eq $_package){$version=undef if$version eq 'undef';return {version=>$version,path=>$path }}}return}sub _xform_package {(split " ",$_[0],2)[0]}1; CPAN_02PACKAGES_SEARCH $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/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.35';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.35';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.35';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.008';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.008';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{"Command/Runner.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER'; package Command::Runner;use strict;use warnings;use Capture::Tiny ();use Command::Runner::Format ();use Command::Runner::LineBuffer;use Command::Runner::Quote ();use Command::Runner::Timeout;use Config ();use File::pushd ();use IO::Select;use POSIX ();use Time::HiRes ();use constant WIN32=>$^O eq 'MSWin32';our$VERSION='0.200';our$TICK=0.02;sub new {my ($class,%option)=@_;my$command=delete$option{command};my$commandf=delete$option{commandf};die "Cannot specify both command and commandf" if$command && $commandf;my$self=bless {keep=>1,_buffer=>{},%option,($command ? (command=>$command): ()),},$class;$self->commandf(@$commandf)if$commandf;$self}for my$attr (qw(command cwd redirect timeout keep stdout stderr env)){no strict 'refs';*$attr=sub {my$self=shift;$self->{$attr}=$_[0];$self}}sub commandf {my ($self,$format,@args)=@_;require Command::Runner::Format;$self->{command}=Command::Runner::Format::commandf($format,@args);$self}sub run {my$self=shift;my$command=$self->{command};if (ref$command eq 'CODE'){$self->_wrap(sub {$self->_run_code($command)})}elsif (WIN32){$self->_wrap(sub {$self->_system_win32($command)})}else {$self->_exec($command)}}sub _wrap {my ($self,$code)=@_;my ($stdout,$stderr,$res);if ($self->{redirect}){($stdout,$res)=&Capture::Tiny::capture_merged($code)}else {($stdout,$stderr,$res)=&Capture::Tiny::capture($code)}if (length$stdout and my$sub=$self->{stdout}){my$buffer=Command::Runner::LineBuffer->new(buffer=>$stdout);my@line=$buffer->get(1);$sub->($_)for@line}if (!$self->{redirect}and length$stderr and my$sub=$self->{stderr}){my$buffer=Command::Runner::LineBuffer->new(buffer=>$stderr);my@line=$buffer->get(1);$sub->($_)for@line}if ($self->{keep}){$res->{stdout}=$stdout;$res->{stderr}=$stderr}return$res}sub _run_code {my ($self,$code)=@_;my$wrap_code;if ($self->{env}|| $self->{cwd}){$wrap_code=sub {local%ENV=%{$self->{env}}if$self->{env};my$guard=File::pushd::pushd($self->{cwd})if$self->{cwd};$code->()}}if (!$self->{timeout}){my$result=$wrap_code ? $wrap_code->(): $code->();return {pid=>$$,result=>$result }}my ($result,$err);{local$SIG{__DIE__}='DEFAULT';local$SIG{ALRM}=sub {die "__TIMEOUT__\n"};eval {alarm$self->{timeout};$result=$wrap_code ? $wrap_code->(): $code->()};$err=$@;alarm 0}if (!$err){return {pid=>$$,result=>$result,}}elsif ($err eq "__TIMEOUT__\n"){return {pid=>$$,result=>$result,timeout=>1 }}else {die$err}}sub _system_win32 {my ($self,$command)=@_;my$pid;if (ref$command){my@cmd=map {Command::Runner::Quote::quote_win32($_)}@$command;local%ENV=%{$self->{env}}if$self->{env};my$guard=File::pushd::pushd($self->{cwd})if$self->{cwd};$pid=system {$command->[0]}1,@cmd}else {local%ENV=%{$self->{env}}if$self->{env};my$guard=File::pushd::pushd($self->{cwd})if$self->{cwd};$pid=system 1,$command}my$timeout=$self->{timeout}? Command::Runner::Timeout->new($self->{timeout},1): undef;my$INT;local$SIG{INT}=sub {$INT++};my$result;while (1){if ($INT){kill INT=>$pid;$INT=0}my$res=waitpid$pid,POSIX::WNOHANG();if ($res==-1){warn "waitpid($pid, POSIX::WNOHANG()) returns unexpectedly -1";last}elsif ($res > 0){$result=$?;last}else {if ($timeout and my$signal=$timeout->signal){kill$signal=>$pid}Time::HiRes::sleep($TICK)}}return {pid=>$pid,result=>$result,timeout=>$timeout && $timeout->signaled }}sub _exec {my ($self,$command)=@_;pipe my$stdout_read,my$stdout_write;$self->{_buffer}{stdout}=Command::Runner::LineBuffer->new(keep=>$self->{keep});my ($stderr_read,$stderr_write);if (!$self->{redirect}){pipe$stderr_read,$stderr_write;$self->{_buffer}{stderr}=Command::Runner::LineBuffer->new(keep=>$self->{keep})}my$pid=fork;die "fork: $!" unless defined$pid;if ($pid==0){close $_ for grep $_,$stdout_read,$stderr_read;open STDOUT,">&",$stdout_write;if ($self->{redirect}){open STDERR,">&",\*STDOUT}else {open STDERR,">&",$stderr_write}if ($Config::Config{d_setpgrp}){POSIX::setpgid(0,0)or die "setpgid: $!"}if ($self->{cwd}){chdir$self->{cwd}or die "chdir $self->{cwd}: $!"}if ($self->{env}){%ENV=%{$self->{env}}}if (ref$command){exec {$command->[0]}@$command}else {exec$command}exit 127}close $_ for grep $_,$stdout_write,$stderr_write;my$signal_pid=$Config::Config{d_setpgrp}? -$pid : $pid;my$INT;local$SIG{INT}=sub {$INT++};my$timeout=$self->{timeout}? Command::Runner::Timeout->new($self->{timeout},1): undef;my$select=IO::Select->new(grep $_,$stdout_read,$stderr_read);while ($select->count){if ($INT){kill INT=>$signal_pid;$INT=0}if ($timeout and my$signal=$timeout->signal){kill$signal=>$signal_pid}for my$ready ($select->can_read($TICK)){my$type=$ready==$stdout_read ? "stdout" : "stderr";my$len=sysread$ready,my$buf,64*1024;if ($len){my$buffer=$self->{_buffer}{$type};$buffer->add($buf);next unless my@line=$buffer->get;next unless my$sub=$self->{$type};$sub->($_)for@line}else {warn "sysread $type pipe failed: $!" unless defined$len;$select->remove($ready);close$ready}}}for my$type (qw(stdout stderr)){next unless my$sub=$self->{$type};my$buffer=$self->{_buffer}{$type}or next;my@line=$buffer->get(1)or next;$sub->($_)for@line}close $_ for$select->handles;waitpid$pid,0;my$res={pid=>$pid,result=>$?,timeout=>$timeout && $timeout->signaled,stdout=>$self->{_buffer}{stdout}? $self->{_buffer}{stdout}->raw : "",stderr=>$self->{_buffer}{stderr}? $self->{_buffer}{stderr}->raw : "",};$self->{_buffer}= +{};return$res}1; COMMAND_RUNNER $fatpacked{"Command/Runner/Format.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_FORMAT'; package Command::Runner::Format;use strict;use warnings;use Command::Runner::Quote 'quote';use Exporter 'import';our@EXPORT_OK=qw(commandf);my$regex=qr/ (% # leading '%' $1 (-)? # left-align, rather than right $2 (\d*)? # (optional) minimum field width $3 (?:\.(\d*))? # (optional) maximum field width $4 (\{.*?\})? # (optional) stuff inside $5 (\S) # actual format character $6 )/x;sub commandf {if (!$ENV{PERL_COMMAND_RUNNER_SUPPRESS_WARNINGS}){warn "Command::Runner::Format::commandf is deprecated; will be removed in the future version of Command-Runner distribution"}my ($format,@args)=@_;my$i=0;$format =~ s{$regex}{ $6 eq '%' ? '%' : _replace($args[$i++], $1, $6) }ge;$format}sub _replace {my ($arg,$all,$char)=@_;if ($char eq 'q'){return quote$arg}else {return sprintf$all,$arg}}1; COMMAND_RUNNER_FORMAT $fatpacked{"Command/Runner/LineBuffer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_LINEBUFFER'; package Command::Runner::LineBuffer;use strict;use warnings;sub new {my ($class,%args)=@_;my$buffer=exists$args{buffer}? $args{buffer}: "";bless {buffer=>$buffer,$args{keep}? (keep=>$buffer): (),},$class}sub raw {my$self=shift;exists$self->{keep}? $self->{keep}: undef}sub add {my ($self,$buffer)=@_;$self->{buffer}.= $buffer;$self->{keep}.= $buffer if exists$self->{keep};$self}sub get {my ($self,$drain)=@_;if ($drain){if (length$self->{buffer}){my@line=$self->get;if (length$self->{buffer}and $self->{buffer}ne "\x0d"){$self->{buffer}=~ s/[\x0d\x0a]+\z//;push@line,$self->{buffer}}$self->{buffer}="";return@line}else {return}}my@line;while ($self->{buffer}=~ s/\A(.*?(?:\x0d\x0a|\x0d|\x0a))//sm){my$line=$1;next if$line eq "\x0d";$line =~ s/[\x0d\x0a]+\z//;push@line,$line}return@line}1; COMMAND_RUNNER_LINEBUFFER $fatpacked{"Command/Runner/Quote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_QUOTE'; package Command::Runner::Quote;use strict;use warnings;use Win32::ShellQuote ();use String::ShellQuote ();use Exporter 'import';our@EXPORT_OK=qw(quote quote_win32 quote_unix);sub quote_win32 {my$str=shift;Win32::ShellQuote::quote_literal($str,1)}sub quote_unix {my$str=shift;String::ShellQuote::shell_quote_best_effort($str)}if ($^O eq 'MSWin32'){*quote=\"e_win32}else {*quote=\"e_unix}1; COMMAND_RUNNER_QUOTE $fatpacked{"Command/Runner/Timeout.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COMMAND_RUNNER_TIMEOUT'; package Command::Runner::Timeout;use strict;use warnings;use Time::HiRes ();our$_USE_CLOCK_MONOTONIC=0;my$time;{local$SIG{__DIE__}='DEFAULT';local $@;if (eval 'Time::HiRes::clock_gettime( Time::HiRes::CLOCK_MONOTONIC() )'){$time=sub {Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC())};$_USE_CLOCK_MONOTONIC=1}else {$time=\&Time::HiRes::time}}sub new {my ($class,$at,$kill)=@_;my$now=$time->();bless {signaled=>0,at=>$now + $at,at_kill=>$now + $at + $kill },$class}sub signal {my$self=shift;return if!$self->{at}&&!$self->{at_kill};my$now=$time->();if ($self->{at}and $now >= $self->{at}){$self->{at}=undef;$self->{signaled}=1;return 'TERM'}if ($now >= $self->{at_kill}){$self->{at_kill}=undef;$self->{signaled}=1;return 'KILL'}return}sub signaled {my$self=shift;$self->{signaled}}1; COMMAND_RUNNER_TIMEOUT $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;use strict;no strict 'refs';our$Debug=0;our$ExportLevel=0;our$Verbose ||= 0;our$VERSION='5.78';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';our$VERSION='5.78';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];$oops++}}}}if ($oops){require Carp;Carp::croak(join("\n",@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.009';use strict;use warnings;use Config;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;require Data::Dumper;return$self->{serialized}||= Data::Dumper->new($self->{values})->Terse(1)->Sortkeys(1)->Dump}sub but {my ($self,$args)=@_;my%new=%{$self->{values}};for my$key (keys %$args){if (defined$args->{$key}){$new{$key}=$args->{$key}}else {delete$new{$key}}}return bless {values=>\%new },ref$self}1; EXTUTILS_CONFIG $fatpacked{"ExtUtils/Config/MakeMaker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_CONFIG_MAKEMAKER'; package ExtUtils::Config::MakeMaker;$ExtUtils::Config::MakeMaker::VERSION='0.009';use strict;use warnings;use ExtUtils::MakeMaker::Config;sub new {my ($class,$maker)=@_;return bless {maker=>$maker },$class}sub get {my ($self,$key)=@_;return exists$self->{maker}{uc$key}? $self->{maker}{uc$key}: $Config{$key}}sub exists {my ($self,$key)=@_;return exists$Config{$key}}sub all_config {my$self=shift;my%result;for my$key (keys%Config){$result{$key}=$self->get($key)}return \%result}sub values_set {my$self=shift;my%result;for my$key (keys%Config){next if not exists$self->{maker}{uc$key};next if$self->{maker}{uc$key}eq $Config{$key};$result{$key}=$self->{maker}{uc$key}}return \%result}sub serialize {my$self=shift;require Data::Dumper;return$self->{serialized}||= Data::Dumper->new($self->values_set)->Terse(1)->Sortkeys(1)->Dump}sub materialize {my$self=shift;require ExtUtils::Config;return ExtUtils::Config->new($self->values_set)}sub but {my ($self,%args)=@_;return$self->materialize->but(%args)}1; EXTUTILS_CONFIG_MAKEMAKER $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/Install.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALL'; package ExtUtils::Install;use strict;use Config qw(%Config);use Cwd qw(cwd);use Exporter ();use File::Basename qw(dirname);use File::Copy;use File::Path;use File::Spec;our@ISA=('Exporter');our@EXPORT=('install','uninstall','pm_to_blib','install_default');our$MUST_REBOOT;our$VERSION='2.22';$VERSION=eval$VERSION;BEGIN {*_Is_VMS=$^O eq 'VMS' ? sub(){1}: sub(){0};*_Is_Win32=$^O eq 'MSWin32' ? sub(){1}: sub(){0};*_Is_cygwin=$^O eq 'cygwin' ? sub(){1}: sub(){0};*_CanMoveAtBoot=($^O eq 'MSWin32' || $^O eq 'cygwin')? sub(){1}: sub(){0}}my$Inc_uninstall_warn_handler;my$INSTALL_ROOT=$ENV{PERL_INSTALL_ROOT};my$INSTALL_QUIET=$ENV{PERL_INSTALL_QUIET};$INSTALL_QUIET=1 if (!exists$ENV{PERL_INSTALL_QUIET}and defined$ENV{MAKEFLAGS}and $ENV{MAKEFLAGS}=~ /\b(s|silent|quiet)\b/);my$Curdir=File::Spec->curdir;sub _estr(@) {return join "\n",'!' x 72,@_,'!' x 72,''}{my%warned;sub _warnonce(@) {my$first=shift;my$msg=_estr "WARNING: $first",@_;warn$msg unless$warned{$msg}++}}sub _choke(@) {my$first=shift;my$msg=_estr "ERROR: $first",@_;require Carp;Carp::croak($msg)}sub _croak {require Carp;Carp::croak(@_)}sub _confess {require Carp;Carp::confess(@_)}sub _compare {if (-f $_[1]&& -s _==-s $_[0]){require File::Compare;return File::Compare::compare(@_)}return 1}sub _chmod($$;$) {my ($mode,$item,$verbose)=@_;$verbose ||= 0;if (chmod$mode,$item){printf "chmod(0%o, %s)\n",$mode,$item if$verbose > 1}else {my$err="$!";_warnonce sprintf "WARNING: Failed chmod(0%o, %s): %s\n",$mode,$item,$err if -e $item}}{my$Has_Win32API_File;sub _move_file_at_boot {my ($file,$target,$moan)=@_;_confess("Panic: Can't _move_file_at_boot on this platform!")unless _CanMoveAtBoot;my$descr=ref$target ? "'$file' for deletion" : "'$file' for installation as '$target'";$Has_Win32API_File=(_Is_Win32 || _Is_cygwin)? (eval {require Win32API::File;1}|| 0): 0 unless defined$Has_Win32API_File;if (!$Has_Win32API_File){my@msg=("Cannot schedule $descr at reboot.","Try installing Win32API::File to allow operations on locked files","to be scheduled during reboot. Or try to perform the operation by","hand yourself. (You may need to close other perl processes first)");if ($moan){_warnonce(@msg)}else {_choke(@msg)}return 0}my$opts=Win32API::File::MOVEFILE_DELAY_UNTIL_REBOOT();$opts=$opts | Win32API::File::MOVEFILE_REPLACE_EXISTING()unless ref$target;_chmod(0666,$file);_chmod(0666,$target)unless ref$target;if (Win32API::File::MoveFileEx($file,$target,$opts)){$MUST_REBOOT ||= ref$target ? 0 : 1;return 1}else {my@msg=("MoveFileEx $descr at reboot failed: $^E","You may try to perform the operation by hand yourself. ","(You may need to close other perl processes first).",);if ($moan){_warnonce(@msg)}else {_choke(@msg)}}return 0}}sub _unlink_or_rename {my ($file,$tryhard,$installing)=@_;if ($^O =~ /^(dos|os2|MSWin32|VMS)$/){_chmod(0666,$file)}my$unlink_count=0;while (unlink$file){$unlink_count++}return$file if$unlink_count > 0;my$error="$!";_choke("Cannot unlink '$file': $!")unless _CanMoveAtBoot && $tryhard;my$tmp="AAA";++$tmp while -e "$file.$tmp";$tmp="$file.$tmp";warn "WARNING: Unable to unlink '$file': $error\n","Going to try to rename it to '$tmp'.\n";if (rename$file,$tmp){warn "Rename successful. Scheduling '$tmp'\nfor deletion at reboot.\n";_move_file_at_boot($tmp,[],$installing);return$file}elsif ($installing){_warnonce("Rename failed: $!. Scheduling '$tmp'\nfor"." installation as '$file' at reboot.\n");_move_file_at_boot($tmp,$file);return$tmp}else {_choke("Rename failed:$!","Cannot proceed.")}}sub _get_install_skip {my ($skip,$verbose)=@_;if ($ENV{EU_INSTALL_IGNORE_SKIP}){print "EU_INSTALL_IGNORE_SKIP is set, ignore skipfile settings\n" if$verbose>2;return []}if (!defined$skip){print "Looking for install skip list\n" if$verbose>2;for my$file ('INSTALL.SKIP',$ENV{EU_INSTALL_SITE_SKIPFILE}){next unless$file;print "\tChecking for $file\n" if$verbose>2;if (-e $file){$skip=$file;last}}}if ($skip &&!ref$skip){print "Reading skip patterns from '$skip'.\n" if$verbose;if (open my$fh,$skip){my@patterns;while (<$fh>){chomp;next if /^\s*(?:#|$)/;print "\tSkip pattern: $_\n" if$verbose>3;push@patterns,$_}$skip=\@patterns}else {warn "Can't read skip file:'$skip':$!\n";$skip=[]}}elsif (UNIVERSAL::isa($skip,'ARRAY')){print "Using array for skip list\n" if$verbose>2}elsif ($verbose){print "No skip list found.\n" if$verbose>1;$skip=[]}warn "Got @{[0+@$skip]} skip patterns.\n" if$verbose>3;return$skip}{my$has_posix;sub _have_write_access {my$dir=shift;unless (defined$has_posix){$has_posix=(!_Is_cygwin &&!_Is_Win32 && eval {local $^W;require POSIX;1})|| 0}if ($has_posix){return POSIX::access($dir,POSIX::W_OK())}else {return -w $dir}}}sub _can_write_dir {my$dir=shift;return unless defined$dir and length$dir;my ($vol,$dirs,$file)=File::Spec->splitpath($dir,1);my@dirs=File::Spec->splitdir($dirs);unshift@dirs,File::Spec->curdir unless File::Spec->file_name_is_absolute($dir);my$path='';my@make;while (@dirs){if (_Is_VMS){$dir=File::Spec->catdir($vol,@dirs)}else {$dir=File::Spec->catdir(@dirs);$dir=File::Spec->catpath($vol,$dir,'')if defined$vol and length$vol}next if ($dir eq $path);if (!-e $dir){unshift@make,$dir;next}if (_have_write_access($dir)){return 1,$dir,@make}else {return 0,$dir,@make}}continue {pop@dirs}return 0}sub _mkpath {my ($dir,$show,$mode,$verbose,$dry_run)=@_;if ($verbose && $verbose > 1 &&!-d $dir){$show=1;printf "mkpath(%s,%d,%#o)\n",$dir,$show,$mode}if (!$dry_run){my@created;eval {@created=File::Path::mkpath($dir,$show,$mode);1}or _choke("Can't create '$dir'","$@");if (@created){return}}my ($can,$root,@make)=_can_write_dir($dir);if (!$can){my@msg=("Can't create '$dir'",$root ? "Do not have write permissions on '$root'" : "Unknown Error");if ($dry_run){_warnonce@msg}else {_choke@msg}}elsif ($show and $dry_run){print "$_\n" for@make}}sub _copy {my ($from,$to,$verbose,$dry_run)=@_;if ($verbose && $verbose>1){printf "copy(%s,%s)\n",$from,$to}if (!$dry_run){File::Copy::copy($from,$to)or _croak(_estr "ERROR: Cannot copy '$from' to '$to': $!")}}sub _chdir {my ($dir)=@_;my$ret;if (defined wantarray){$ret=cwd}chdir$dir or _choke("Couldn't chdir to '$dir': $!");return$ret}sub install {my($from_to,$verbose,$dry_run,$uninstall_shadows,$skip,$always_copy,$result)=@_;if (@_==1 and eval {1+@$from_to}){my%opts=@$from_to;$from_to=$opts{from_to}or _confess("from_to is a mandatory parameter");$verbose=$opts{verbose};$dry_run=$opts{dry_run};$uninstall_shadows=$opts{uninstall_shadows};$skip=$opts{skip};$always_copy=$opts{always_copy};$result=$opts{result}}$result ||= {};$verbose ||= 0;$dry_run ||= 0;$skip=_get_install_skip($skip,$verbose);$always_copy=$ENV{EU_INSTALL_ALWAYS_COPY}|| $ENV{EU_ALWAYS_COPY}|| 0 unless defined$always_copy;my(%from_to)=%$from_to;my(%pack,$dir,%warned);require ExtUtils::Packlist;my($packlist)=ExtUtils::Packlist->new();local(*DIR);for (qw/read write/){$pack{$_}=$from_to{$_};delete$from_to{$_}}my$tmpfile=install_rooted_file($pack{"read"});$packlist->read($tmpfile)if (-f $tmpfile);my$cwd=cwd();my@found_files;my%check_dirs;require File::Find;my$blib_lib=File::Spec->catdir('blib','lib');my$blib_arch=File::Spec->catdir('blib','arch');my$current_directory=$^O eq 'MacOS' ? $Curdir : '.';MOD_INSTALL: foreach my$source (sort keys%from_to){my$targetroot=install_rooted_dir($from_to{$source});if ($source eq $blib_lib and exists$from_to{$blib_arch}and directory_not_empty($blib_arch)){$targetroot=install_rooted_dir($from_to{$blib_arch});print "Files found in $blib_arch: installing files in $blib_lib into architecture dependent library tree\n"}next unless -d $source;_chdir($source);File::Find::find(sub {my ($mode,$size,$atime,$mtime)=(stat)[2,7,8,9];return if!-f _;my$origfile=$_;return if$origfile eq ".exists";my$targetdir=File::Spec->catdir($targetroot,$File::Find::dir);my$targetfile=File::Spec->catfile($targetdir,$origfile);my$sourcedir=File::Spec->catdir($source,$File::Find::dir);my$sourcefile=File::Spec->catfile($sourcedir,$origfile);for my$pat (@$skip){if ($sourcefile=~/$pat/){print "Skipping $targetfile (filtered)\n" if$verbose>1;$result->{install_filtered}{$sourcefile}=$pat;return}}my$save_cwd=File::Spec->catfile($cwd,$sourcedir);_chdir($cwd);my$diff=$always_copy || _compare($sourcefile,$targetfile);$check_dirs{$targetdir}++ unless -w $targetfile;push@found_files,[$diff,$File::Find::dir,$origfile,$mode,$size,$atime,$mtime,$targetdir,$targetfile,$sourcedir,$sourcefile,];_chdir($save_cwd)},$current_directory);_chdir($cwd)}for my$targetdir (sort keys%check_dirs){_mkpath($targetdir,0,0755,$verbose,$dry_run)}for my$found (@found_files){my ($diff,$ffd,$origfile,$mode,$size,$atime,$mtime,$targetdir,$targetfile,$sourcedir,$sourcefile)=@$found;my$realtarget=$targetfile;if ($diff){eval {if (-f $targetfile){print "_unlink_or_rename($targetfile)\n" if$verbose>1;$targetfile=_unlink_or_rename($targetfile,'tryhard','install')unless$dry_run}elsif (!-d $targetdir){_mkpath($targetdir,0,0755,$verbose,$dry_run)}print "Installing $targetfile\n";_copy($sourcefile,$targetfile,$verbose,$dry_run,);print "utime($atime,$mtime,$targetfile)\n" if$verbose>1;utime($atime,$mtime + _Is_VMS,$targetfile)unless$dry_run>1;$mode=0444 | ($mode & 0111 ? 0111 : 0);$mode=$mode | 0222 if$realtarget ne $targetfile;_chmod($mode,$targetfile,$verbose);$result->{install}{$targetfile}=$sourcefile;1}or do {$result->{install_fail}{$targetfile}=$sourcefile;die $@}}else {$result->{install_unchanged}{$targetfile}=$sourcefile;print "Skipping $targetfile (unchanged)\n" if$verbose}if ($uninstall_shadows){inc_uninstall($sourcefile,$ffd,$verbose,$dry_run,$realtarget ne $targetfile ? $realtarget : "",$result)}$packlist->{$targetfile}++}if ($pack{'write'}){$dir=install_rooted_dir(dirname($pack{'write'}));_mkpath($dir,0,0755,$verbose,$dry_run);print "Writing $pack{'write'}\n" if$verbose;$packlist->write(install_rooted_file($pack{'write'}))unless$dry_run}_do_cleanup($verbose);return$result}sub _do_cleanup {my ($verbose)=@_;if ($MUST_REBOOT){die _estr "Operation not completed! ","You must reboot to complete the installation.","Sorry."}elsif (defined$MUST_REBOOT & $verbose){warn _estr "Installation will be completed at the next reboot.\n","However it is not necessary to reboot immediately.\n"}}sub install_rooted_file {if (defined$INSTALL_ROOT){File::Spec->catfile($INSTALL_ROOT,$_[0])}else {$_[0]}}sub install_rooted_dir {if (defined$INSTALL_ROOT){File::Spec->catdir($INSTALL_ROOT,$_[0])}else {$_[0]}}sub forceunlink {my ($file,$tryhard)=@_;_unlink_or_rename($file,$tryhard,not("installing"))}sub directory_not_empty ($) {my($dir)=@_;my$files=0;require File::Find;File::Find::find(sub {return if $_ eq ".exists";if (-f){$File::Find::prune++;$files=1}},$dir);return$files}sub install_default {@_ < 2 or _croak("install_default should be called with 0 or 1 argument");my$FULLEXT=@_ ? shift : $ARGV[0];defined$FULLEXT or die "Do not know to where to write install log";my$INST_LIB=File::Spec->catdir($Curdir,"blib","lib");my$INST_ARCHLIB=File::Spec->catdir($Curdir,"blib","arch");my$INST_BIN=File::Spec->catdir($Curdir,'blib','bin');my$INST_SCRIPT=File::Spec->catdir($Curdir,'blib','script');my$INST_MAN1DIR=File::Spec->catdir($Curdir,'blib','man1');my$INST_MAN3DIR=File::Spec->catdir($Curdir,'blib','man3');my@INST_HTML;if($Config{installhtmldir}){my$INST_HTMLDIR=File::Spec->catdir($Curdir,'blib','html');@INST_HTML=($INST_HTMLDIR=>$Config{installhtmldir})}install({read=>"$Config{sitearchexp}/auto/$FULLEXT/.packlist",write=>"$Config{installsitearch}/auto/$FULLEXT/.packlist",$INST_LIB=>(directory_not_empty($INST_ARCHLIB))? $Config{installsitearch}: $Config{installsitelib},$INST_ARCHLIB=>$Config{installsitearch},$INST_BIN=>$Config{installbin},$INST_SCRIPT=>$Config{installscript},$INST_MAN1DIR=>$Config{installman1dir},$INST_MAN3DIR=>$Config{installman3dir},@INST_HTML,},1,0,0)}sub uninstall {my($fil,$verbose,$dry_run)=@_;$verbose ||= 0;$dry_run ||= 0;die _estr "ERROR: no packlist file found: '$fil'" unless -f $fil;require ExtUtils::Packlist;my ($packlist)=ExtUtils::Packlist->new($fil);for (sort(keys(%$packlist))){chomp;print "unlink $_\n" if$verbose;forceunlink($_,'tryhard')unless$dry_run}print "unlink $fil\n" if$verbose;forceunlink($fil,'tryhard')unless$dry_run;_do_cleanup($verbose)}sub inc_uninstall {my($filepath,$libdir,$verbose,$dry_run,$ignore,$results)=@_;my($dir);$ignore||="";my$file=(File::Spec->splitpath($filepath))[2];my%seen_dir=();my@PERL_ENV_LIB=split$Config{path_sep},defined$ENV{'PERL5LIB'}? $ENV{'PERL5LIB'}: $ENV{'PERLLIB'}|| '';my@dirs=(@PERL_ENV_LIB,@INC,@Config{qw(archlibexp privlibexp sitearchexp sitelibexp)});my$seen_ours;for$dir (@dirs){my$canonpath=_Is_VMS ? $dir : File::Spec->canonpath($dir);next if$canonpath eq $Curdir;next if$seen_dir{$canonpath}++;my$targetfile=File::Spec->catfile($canonpath,$libdir,$file);next unless -f $targetfile;my$diff=_compare($filepath,$targetfile);print "#$file and $targetfile differ\n" if$diff && $verbose > 1;if (!$diff or $targetfile eq $ignore){$seen_ours=1;next}if ($dry_run){$results->{uninstall}{$targetfile}=$filepath;if ($verbose){$Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new();$libdir =~ s|^\./||s ;$Inc_uninstall_warn_handler->add(File::Spec->catfile($libdir,$file),$targetfile)}}else {print "Unlinking $targetfile (shadowing?)\n" if$verbose;eval {die "Fake die for testing" if$ExtUtils::Install::Testing and ucase(File::Spec->canonpath($ExtUtils::Install::Testing))eq ucase($targetfile);forceunlink($targetfile,'tryhard');$results->{uninstall}{$targetfile}=$filepath;1}or do {$results->{fail_uninstall}{$targetfile}=$filepath;if ($seen_ours){warn "Failed to remove probably harmless shadow file '$targetfile'\n"}else {die "$@\n"}}}}}sub run_filter {my ($cmd,$src,$dest)=@_;local(*CMD,*SRC);open(CMD,"|$cmd >$dest")|| die "Cannot fork: $!";open(SRC,$src)|| die "Cannot open $src: $!";my$buf;my$sz=1024;while (my$len=sysread(SRC,$buf,$sz)){syswrite(CMD,$buf,$len)}close SRC;close CMD or die "Filter command '$cmd' failed for $src"}sub pm_to_blib {my($fromto,$autodir,$pm_filter)=@_;my%dirs;_mkpath($autodir,0,0755)if defined$autodir;while(my($from,$to)=each %$fromto){if(-f $to && -s $from==-s $to && -M $to < -M $from){print "Skip $to (unchanged)\n" unless$INSTALL_QUIET;next}my$need_filtering=defined$pm_filter && length$pm_filter && $from =~ /\.pm$/;if (!$need_filtering &&!_compare($from,$to)){print "Skip $to (unchanged)\n" unless$INSTALL_QUIET;next}if (-f $to){forceunlink($to)}else {my$dirname=dirname($to);if (!$dirs{$dirname}++){_mkpath($dirname,0,0755)}}if ($need_filtering){run_filter($pm_filter,$from,$to);print "$pm_filter <$from >$to\n"}else {_copy($from,$to);print "cp $from $to\n" unless$INSTALL_QUIET}my($mode,$atime,$mtime)=(stat$from)[2,8,9];utime($atime,$mtime+_Is_VMS,$to);_chmod(0444 | ($mode & 0111 ? 0111 : 0),$to);next unless$from =~ /\.pm$/;_autosplit($to,$autodir)if defined$autodir}}sub _autosplit {require AutoSplit;my$retval=AutoSplit::autosplit(@_);close*AutoSplit::IN if defined*AutoSplit::IN{IO};return$retval}package ExtUtils::Install::Warn;sub new {bless {},shift}sub add {my($self,$file,$targetfile)=@_;push @{$self->{$file}},$targetfile}sub DESTROY {unless(defined$INSTALL_ROOT){my$self=shift;my($file,$i,$plural);for$file (sort keys %$self){$plural=@{$self->{$file}}> 1 ? "s" : "";print "## Differing version$plural of $file found. You might like to\n";for (0..$#{$self->{$file}}){print "rm ",$self->{$file}[$_],"\n";$i++}}$plural=$i>1 ? "all those files" : "this file";my$inst=(_invokant()eq 'ExtUtils::MakeMaker')? ($Config::Config{make}|| 'make').' install' .(ExtUtils::Install::_Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1'): './Build install uninst=1';print "## Running '$inst' will unlink $plural for you.\n"}}sub _invokant {my@stack;my$frame=0;while (my$file=(caller($frame++))[1]){push@stack,(File::Spec->splitpath($file))[2]}my$builder;my$top=pop@stack;if ($top =~ /^Build/i || exists($INC{'Module/Build.pm'})){$builder='Module::Build'}else {$builder='ExtUtils::MakeMaker'}return$builder}1; EXTUTILS_INSTALL $fatpacked{"ExtUtils/InstallPaths.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLPATHS'; package ExtUtils::InstallPaths;$ExtUtils::InstallPaths::VERSION='0.013';use 5.006;use strict;use warnings;use File::Spec ();use Carp ();use ExtUtils::Config 0.002;my%complex_accessors=map {$_=>1}qw/prefix_relpaths install_sets/;my%hash_accessors=map {$_=>1}qw/install_path install_base_relpaths original_prefix/;my%defaults=(installdirs=>'site',install_base=>undef,prefix=>undef,verbose=>0,create_packlist=>1,dist_name=>undef,module_name=>undef,destdir=>undef,install_path=>sub {{}},install_sets=>\&_default_install_sets,original_prefix=>\&_default_original_prefix,install_base_relpaths=>\&_default_base_relpaths,prefix_relpaths=>\&_default_prefix_relpaths,);sub _merge_shallow {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);$filter->($_)for grep$filter,values %$override;return {%$defaults,%$override }}}sub _merge_deep {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);my$pair_for=sub {my$key=shift;my%override=%{$override->{$key}|| {}};$filter && $filter->($_)for values%override;return$key=>{%{$defaults->{$key}},%override }};return {map {$pair_for->($_)}keys %$defaults }}}my%allowed_installdir=map {$_=>1}qw/core site vendor/;my$must_be_relative=sub {Carp::croak('Value must be a relative path')if File::Spec->file_name_is_absolute($_[0])};my%deep_filter=map {$_=>$must_be_relative}qw/install_base_relpaths prefix_relpaths/;my%filter=(installdirs=>sub {my$value=shift;$value='core',Carp::carp('Perhaps you meant installdirs to be "core" rather than "perl"?')if$value eq 'perl';Carp::croak('installdirs must be one of "core", "site", or "vendor"')if not $allowed_installdir{$value};return$value},(map {$_=>_merge_shallow($_,$deep_filter{$_})}qw/original_prefix install_base_relpaths/),(map {$_=>_merge_deep($_,$deep_filter{$_})}qw/install_sets prefix_relpaths/),);sub new {my ($class,%args)=@_;my$config=$args{config}|| ExtUtils::Config->new;my%self=(config=>$config,map {$_=>exists$args{$_}? $filter{$_}? $filter{$_}->($args{$_},$config): $args{$_}: ref$defaults{$_}? $defaults{$_}->($config): $defaults{$_}}keys%defaults,);$self{module_name}||= do {my$module_name=$self{dist_name};$module_name =~ s/-/::/g;$module_name}if defined$self{dist_name};return bless \%self,$class}for my$attribute (keys%defaults){no strict qw/refs/;*{$attribute}=$hash_accessors{$attribute}? sub {my ($self,$key)=@_;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$key}}: $complex_accessors{$attribute}? sub {my ($self,$installdirs,$key)=@_;Carp::confess("$attribute needs installdir")if not defined$installdirs;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$installdirs}{$key}}: sub {my$self=shift;return$self->{$attribute}}}my$script=$] > 5.008000 ? 'script' : 'bin';my@install_sets_keys=qw/lib arch bin script bindoc libdoc binhtml libhtml/;my@install_sets_tail=('bin',$script,qw/man1dir man3dir html1dir html3dir/);my%install_sets_values=(core=>[qw/privlib archlib/,@install_sets_tail ],site=>[map {"site$_"}qw/lib arch/,@install_sets_tail ],vendor=>[map {"vendor$_"}qw/lib arch/,@install_sets_tail ],);sub _default_install_sets {my$c=shift;my%ret;for my$installdir (qw/core site vendor/){@{$ret{$installdir}}{@install_sets_keys}=map {$c->get("install$_")}@{$install_sets_values{$installdir}}}return \%ret}sub _default_base_relpaths {my$config=shift;return {lib=>['lib','perl5'],arch=>['lib','perl5',$config->get('archname')],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],}}my%common_prefix_relpaths=(bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],);sub _default_prefix_relpaths {my$c=shift;my@libstyle=$c->get('installstyle')? File::Spec->splitdir($c->get('installstyle')): qw(lib perl5);my$arch=$c->get('archname');my$version=$c->get('version');return {core=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},vendor=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},site=>{lib=>[@libstyle,'site_perl'],arch=>[@libstyle,'site_perl',$version,$arch],%common_prefix_relpaths,},}}sub _default_original_prefix {my$c=shift;my%ret=(core=>$c->get('installprefixexp'),site=>$c->get('siteprefixexp'),vendor=>$c->get('usevendorprefix')? $c->get('vendorprefixexp'): '',);return \%ret}sub _log_verbose {my$self=shift;print @_ if$self->verbose;return}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,$dirs)=@_;my%localdir_for;if ($dirs && %$dirs){%localdir_for=%$dirs}else {for my$type ($self->install_types){$localdir_for{$type}=File::Spec->catdir('blib',$type)}}my (%map,@skipping);for my$type (keys%localdir_for){next if not $self->is_default_installable($type);if (my$dest=$self->install_destination($type)){$map{$localdir_for{$type}}=$dest}else {push@skipping,$type}}warn "WARNING: Can't figure out install path for types: @skipping\nFiles will not be installed.\n" if@skipping;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{"ExtUtils/Installed.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLED'; use strict;package ExtUtils::Installed;use Carp qw();use ExtUtils::Packlist;use ExtUtils::MakeMaker;use Config;use File::Find;use File::Basename;use File::Spec;my$Is_VMS=$^O eq 'VMS';my$DOSISH=($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);require VMS::Filespec if$Is_VMS;our$VERSION='2.22';$VERSION=eval$VERSION;sub _is_prefix {my ($self,$path,$prefix)=@_;return unless defined$prefix && defined$path;if($Is_VMS){$prefix=VMS::Filespec::unixify($prefix);$path=VMS::Filespec::unixify($path)}$prefix=File::Spec->canonpath($prefix);return 1 if substr($path,0,length($prefix))eq $prefix;if ($DOSISH){$path =~ s|\\|/|g;$prefix =~ s|\\|/|g;return 1 if$path =~ m{^\Q$prefix\E}i}return(0)}sub _is_doc {my ($self,$path)=@_;my$man1dir=$self->{':private:'}{Config}{man1direxp};my$man3dir=$self->{':private:'}{Config}{man3direxp};return(($man1dir && $self->_is_prefix($path,$man1dir))|| ($man3dir && $self->_is_prefix($path,$man3dir))? 1 : 0)}sub _is_type {my ($self,$path,$type)=@_;return 1 if$type eq "all";return($self->_is_doc($path))if$type eq "doc";my$conf=$self->{':private:'}{Config};if ($type eq "prog"){return($self->_is_prefix($path,$conf->{prefix}|| $conf->{prefixexp})&&!($self->_is_doc($path))? 1 : 0)}return(0)}sub _is_under {my ($self,$path,@under)=@_;$under[0]="" if (!@under);for my$dir (@under){return(1)if ($self->_is_prefix($path,$dir))}return(0)}sub _fix_dirs {my ($self,@dirs)=@_;if($Is_VMS){$_=VMS::Filespec::unixify($_)for@dirs}if ($DOSISH){s|\\|/|g for@dirs}return wantarray ? @dirs : $dirs[0]}sub _make_entry {my ($self,$module,$packlist_file,$modfile)=@_;my$data={module=>$module,packlist=>scalar(ExtUtils::Packlist->new($packlist_file)),packlist_file=>$packlist_file,};if (!$modfile){$data->{version}=$self->{':private:'}{Config}{version}}else {$data->{modfile}=$modfile;$data->{version}='';for my$dir (@{$self->{':private:'}{INC}}){my$p=File::Spec->catfile($dir,$modfile);if (-r $p){$module=_module_name($p,$module)if$Is_VMS;$data->{version}=MM->parse_version($p);$data->{version_from}=$p;$data->{packlist_valid}=exists$data->{packlist}{$p};last}}}$self->{$module}=$data}our$INSTALLED;sub new {my ($class)=shift(@_);$class=ref($class)|| $class;my%args=@_;return$INSTALLED if$INSTALLED and ($args{default_get}|| $args{default});my$self=bless {},$class;$INSTALLED=$self if$args{default_set}|| $args{default};if ($args{config_override}){eval {$self->{':private:'}{Config}={%{$args{config_override}}}}or Carp::croak("The 'config_override' parameter must be a hash reference.")}else {$self->{':private:'}{Config}=\%Config}for my$tuple ([inc_override=>INC=>[@INC ]],[extra_libs=>EXTRA=>[]]){my ($arg,$key,$val)=@$tuple;if ($args{$arg}){eval {$self->{':private:'}{$key}=[@{$args{$arg}}]}or Carp::croak("The '$arg' parameter must be an array reference.")}elsif ($val){$self->{':private:'}{$key}=$val}}{my%dupe;@{$self->{':private:'}{LIBDIRS}}=grep {$_ ne '.' ||!$args{skip_cwd}}grep {-e $_ &&!$dupe{$_}++}@{$self->{':private:'}{EXTRA}},@{$self->{':private:'}{INC}}}my@dirs=$self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}});my$archlib=$self->_fix_dirs($self->{':private:'}{Config}{archlibexp});$self->_make_entry("Perl",File::Spec->catfile($archlib,'.packlist'));my$root;my$sub=sub {return if $_ ne ".packlist" || $File::Find::dir eq $archlib;my$module=$File::Find::name;my$found=$module =~ s!^.*?/auto/(.*)/.packlist!$1!s or do {return};my$modfile="$module.pm";$module =~ s!/!::!g;return if$self->{$module};$self->_make_entry($module,$File::Find::name,$modfile)};while (@dirs){$root=shift@dirs;next if!-d $root;find($sub,$root)}return$self}sub _module_name {my($file,$orig_module)=@_;my$module='';if (open PACKFH,$file){while (){if (/package\s+(\S+)\s*;/){my$pack=$1;if (lc($pack)eq lc($orig_module)){$module=$pack;last}}}close PACKFH}print STDERR "Couldn't figure out the package name for $file\n" unless$module;return$module}sub modules {my ($self)=@_;$self=$self->new(default=>1)if!ref$self;return wantarray ? sort grep {not /^:private:$/}keys %$self : grep {not /^:private:$/}keys %$self}sub files {my ($self,$module,$type,@under)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));$type="all" if (!defined($type));Carp::croak('type must be "all", "prog" or "doc"')if ($type ne "all" && $type ne "prog" && $type ne "doc");my (@files);for my$file (keys(%{$self->{$module}{packlist}})){push(@files,$file)if ($self->_is_type($file,$type)&& $self->_is_under($file,@under))}return(@files)}sub directories {my ($self,$module,$type,@under)=@_;$self=$self->new(default=>1)if!ref$self;my (%dirs);for my$file ($self->files($module,$type,@under)){$dirs{dirname($file)}++}return sort keys%dirs}sub directory_tree {my ($self,$module,$type,@under)=@_;$self=$self->new(default=>1)if!ref$self;my (%dirs);for my$dir ($self->directories($module,$type,@under)){$dirs{$dir}++;my ($last)=("");while ($last ne $dir){$last=$dir;$dir=dirname($dir);last if!$self->_is_under($dir,@under);$dirs{$dir}++}}return(sort(keys(%dirs)))}sub validate {my ($self,$module,$remove)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));return($self->{$module}{packlist}->validate($remove))}sub packlist {my ($self,$module)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));return($self->{$module}{packlist})}sub version {my ($self,$module)=@_;$self=$self->new(default=>1)if!ref$self;Carp::croak("$module is not installed")if (!exists($self->{$module}));return($self->{$module}{version})}sub _debug_dump {my ($self,$module)=@_;$self=$self->new(default=>1)if!ref$self;local$self->{":private:"}{Config};require Data::Dumper;print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump()}1; EXTUTILS_INSTALLED $fatpacked{"ExtUtils/PL2Bat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_PL2BAT'; package ExtUtils::PL2Bat;$ExtUtils::PL2Bat::VERSION='0.005';use strict;use warnings;use 5.006;use Config;use Carp qw/croak/;sub import {my ($self,@functions)=@_;@functions='pl2bat' if not @functions;my$caller=caller;for my$function (@functions){no strict 'refs';*{"$caller\::$function"}=\&{$function}}}sub pl2bat {my%opts=@_;$opts{ntargs}='-x -S %0 %*' unless exists$opts{ntargs};$opts{otherargs}='-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists$opts{otherargs};$opts{stripsuffix}=qr/\.plx?/ unless exists$opts{stripsuffix};if (not exists$opts{out}){$opts{out}=$opts{in};$opts{out}=~ s/$opts{stripsuffix}$//i;$opts{out}.= '.bat' unless$opts{in}=~ /\.bat$/i or $opts{in}eq '-'}my$head=<<"EOT";$head =~ s/^\s+//gm;my$headlines=2 + ($head =~ tr/\n/\n/);my$tail=<<'EOT';$tail =~ s/^\s+//gm;my$linedone=0;my$taildone=0;my$linenum=0;my$skiplines=0;my$start=$Config{startperl};$start='#!perl' unless$start =~ /^#!.*perl/;open my$in,'<',$opts{in}or croak "Can't open $opts{in}: $!";my@file=<$in>;close$in;for my$line (@file){$linenum++;if ($line =~ /^:endofperl\b/){if (!exists$opts{update}){warn "$opts{in} has already been converted to a batch file!\n";return}$taildone++}if (not $linedone and $line =~ /^#!.*perl/){if (exists$opts{update}){$skiplines=$linenum - 1;$line .= '#line '.(1+$headlines)."\n"}else {$line .= '#line '.($linenum+$headlines)."\n"}$linedone++}if ($line =~ /^#\s*line\b/ and $linenum==2 + $skiplines){$line=''}}open my$out,'>',$opts{out}or croak "Can't open $opts{out}: $!";print$out $head;print$out $start,($opts{usewarnings}? ' -w' : ''),"\n#line ",($headlines+1),"\n" unless$linedone;print$out @file[$skiplines..$#file];print$out $tail unless$taildone;close$out;return$opts{out}}1; \@rem = '--*-Perl-*-- \@set "ErrorLevel=" \@if "%OS%" == "Windows_NT" \@goto WinNT \@perl $opts{otherargs} \@set ErrorLevel=%ErrorLevel% \@goto endofperl :WinNT \@perl $opts{ntargs} \@set ErrorLevel=%ErrorLevel% \@if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" \@goto endofperl \@if %ErrorLevel% == 9009 \@echo You do not have Perl in your PATH. \@goto endofperl \@rem '; EOT __END__ :endofperl @set "ErrorLevel=" & @goto _undefined_label_ 2>NUL || @"%COMSPEC%" /d/c @exit %ErrorLevel% EOT EXTUTILS_PL2BAT $fatpacked{"ExtUtils/Packlist.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_PACKLIST'; package ExtUtils::Packlist;use strict;use Carp qw();use Config;our$Relocations;our$VERSION='2.22';$VERSION=eval$VERSION;my$fhname="FH1";sub mkfh() {no strict;local $^W;my$fh=\*{$fhname++};use strict;return($fh)}sub __find_relocations {my%paths;while (my ($raw_key,$raw_val)=each%Config){my$exp_key=$raw_key ."exp";next unless exists$Config{$exp_key};next unless$raw_val =~ m!\.\.\./!;$paths{$Config{$exp_key}}++}my$alternations=join "|",map {quotemeta $_}sort {length$b <=> length$a}keys%paths;qr/^($alternations)/o}sub new($$) {my ($class,$packfile)=@_;$class=ref($class)|| $class;my%self;tie(%self,$class,$packfile);return(bless(\%self,$class))}sub TIEHASH {my ($class,$packfile)=@_;my$self={packfile=>$packfile };bless($self,$class);$self->read($packfile)if (defined($packfile)&& -f $packfile);return($self)}sub STORE {$_[0]->{data}->{$_[1]}=$_[2]}sub FETCH {return($_[0]->{data}->{$_[1]})}sub FIRSTKEY {my$reset=scalar(keys(%{$_[0]->{data}}));return(each(%{$_[0]->{data}}))}sub NEXTKEY {return(each(%{$_[0]->{data}}))}sub EXISTS {return(exists($_[0]->{data}->{$_[1]}))}sub DELETE {return(delete($_[0]->{data}->{$_[1]}))}sub CLEAR {%{$_[0]->{data}}=()}sub DESTROY {}sub read($;$) {my ($self,$packfile)=@_;$self=tied(%$self)|| $self;if (defined($packfile)){$self->{packfile}=$packfile}else {$packfile=$self->{packfile}}Carp::croak("No packlist filename specified")if (!defined($packfile));my$fh=mkfh();open($fh,"<$packfile")|| Carp::croak("Can't open file $packfile: $!");$self->{data}={};my ($line);while (defined($line=<$fh>)){chomp$line;my ($key,$data)=$line;if ($key =~ /^(.*?)( \w+=.*)$/){$key=$1;$data={map {split('=',$_)}split(' ',$2)};if ($Config{userelocatableinc}&& $data->{relocate_as}){require File::Spec;require Cwd;my ($vol,$dir)=File::Spec->splitpath($packfile);my$newpath=File::Spec->catpath($vol,$dir,$data->{relocate_as});$key=Cwd::realpath($newpath)}}$key =~ s!/\./!/!g;$self->{data}->{$key}=$data}close($fh)}sub write($;$) {my ($self,$packfile)=@_;$self=tied(%$self)|| $self;if (defined($packfile)){$self->{packfile}=$packfile}else {$packfile=$self->{packfile}}Carp::croak("No packlist filename specified")if (!defined($packfile));my$fh=mkfh();open($fh,">$packfile")|| Carp::croak("Can't open file $packfile: $!");for my$key (sort(keys(%{$self->{data}}))){my$data=$self->{data}->{$key};if ($Config{userelocatableinc}){$Relocations ||= __find_relocations();if ($packfile =~ $Relocations){my$prefix=$1;if (File::Spec->no_upwards(File::Spec->abs2rel($key,$prefix))){my$packfile_prefix;(undef,$packfile_prefix)=File::Spec->splitpath($packfile);my$relocate_as=File::Spec->abs2rel($key,$packfile_prefix);if (!ref$data){$data={}}$data->{relocate_as}=$relocate_as}}}print$fh ("$key");if (ref($data)){for my$k (sort(keys(%$data))){print$fh (" $k=$data->{$k}")}}print$fh ("\n")}close($fh)}sub validate($;$) {my ($self,$remove)=@_;$self=tied(%$self)|| $self;my@missing;for my$key (sort(keys(%{$self->{data}}))){if (!-e $key){push(@missing,$key);delete($self->{data}{$key})if ($remove)}}return(@missing)}sub packlist_file($) {my ($self)=@_;$self=tied(%$self)|| $self;return($self->{packfile})}1; EXTUTILS_PACKLIST $fatpacked{"File/Copy/Recursive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_COPY_RECURSIVE'; package File::Copy::Recursive;use strict;BEGIN {$INC{'warnings.pm'}="fake warnings entry for < 5.6 perl ($])" if $] < 5.006}use warnings;use Carp;use File::Copy;use File::Spec;use Cwd ();use vars qw(@ISA @EXPORT_OK $VERSION $MaxDepth $KeepMode $CPRFComp $CopyLink $PFSCheck $RemvBase $NoFtlPth $ForcePth $CopyLoop $RMTrgFil $RMTrgDir $CondCopy $BdTrgWrn $SkipFlop $DirPerms);require Exporter;@ISA=qw(Exporter);@EXPORT_OK=qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir rcopy_glob rmove_glob);$VERSION='0.45';$MaxDepth=0;$KeepMode=1;$CPRFComp=0;$CopyLink=eval {local$SIG{'__DIE__'};symlink '','';1}|| 0;$PFSCheck=1;$RemvBase=0;$NoFtlPth=0;$ForcePth=0;$CopyLoop=0;$RMTrgFil=0;$RMTrgDir=0;$CondCopy={};$BdTrgWrn=0;$SkipFlop=0;$DirPerms=0777;my$samecheck=sub {return 1 if $^O eq 'MSWin32';return if @_!=2 ||!defined $_[0]||!defined $_[1];return if $_[0]eq $_[1];my$one='';if ($PFSCheck){$one=join('-',(stat $_[0])[0,1 ])|| '';my$two=join('-',(stat $_[1])[0,1 ])|| '';if ($one eq $two && $one){carp "$_[0] and $_[1] are identical";return}}if (-d $_[0]&&!$CopyLoop){$one=join('-',(stat $_[0])[0,1 ])if!$one;my$abs=File::Spec->rel2abs($_[1]);my@pth=File::Spec->splitdir($abs);while (@pth){if ($pth[-1]eq '..'){pop@pth;pop@pth unless -l File::Spec->catdir(@pth);next}my$cur=File::Spec->catdir(@pth);last if!$cur;my$two=join('-',(stat$cur)[0,1 ])|| '';if ($one eq $two && $one){carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";return}pop@pth}}return 1};my$glob=sub {my ($do,$src_glob,@args)=@_;local$CPRFComp=1;require File::Glob;my@rt;for my$path (File::Glob::bsd_glob($src_glob)){my@call=[$do->($path,@args)]or return;push@rt,\@call}return@rt};my$move=sub {my$fl=shift;my@x;if ($fl){@x=fcopy(@_)or return}else {@x=dircopy(@_)or return}if (@x){if ($fl){unlink $_[0]or return}else {pathrmdir($_[0])or return}if ($RemvBase){my ($volm,$path)=File::Spec->splitpath($_[0]);pathrm(File::Spec->catpath($volm,$path,''),$ForcePth,$NoFtlPth)or return}}return wantarray ? @x : $x[0]};my$ok_todo_asper_condcopy=sub {my$org=shift;my$copy=1;if (exists$CondCopy->{$org}){if ($CondCopy->{$org}{'md5'}){}if ($copy){}}return$copy};sub fcopy {$samecheck->(@_)or return;if ($RMTrgFil && (-d $_[1]|| -e $_[1])){my$trg=$_[1];if (-d $trg){my@trgx=File::Spec->splitpath($_[0]);$trg=File::Spec->catfile($_[1],$trgx[$#trgx])}$samecheck->($_[0],$trg)or return;if (-e $trg){if ($RMTrgFil==1){unlink$trg or carp "\$RMTrgFil failed: $!"}else {unlink$trg or return}}}my ($volm,$path)=File::Spec->splitpath($_[1]);if ($path &&!-d $path){pathmk(File::Spec->catpath($volm,$path,''),$NoFtlPth)}if (-l $_[0]&& $CopyLink){my$target=readlink(shift());($target)=$target =~ m/(.*)/;carp "Copying a symlink ($_[0]) whose target does not exist" if!-e $target && $BdTrgWrn;my$new=shift();unlink$new if -l $new;symlink($target,$new)or return}elsif (-d $_[0]&& -f $_[1]){return}else {return if -d $_[0];copy(@_)or return;my@base_file=File::Spec->splitpath($_[0]);my$mode_trg= -d $_[1]? File::Spec->catfile($_[1],$base_file[$#base_file]): $_[1];chmod scalar((stat($_[0]))[2]),$mode_trg if$KeepMode}return wantarray ? (1,0,0): 1}sub rcopy {if (-l $_[0]&& $CopyLink){goto&fcopy}goto&dircopy if -d $_[0]|| substr($_[0],(1 * -1),1)eq '*';goto&fcopy}sub rcopy_glob {$glob->(\&rcopy,@_)}sub dircopy {if ($RMTrgDir && -d $_[1]){if ($RMTrgDir==1){pathrmdir($_[1])or carp "\$RMTrgDir failed: $!"}else {pathrmdir($_[1])or return}}my$globstar=0;my$_zero=$_[0];my$_one=$_[1];if (substr($_zero,(1 * -1),1)eq '*'){$globstar=1;$_zero=substr($_zero,0,(length($_zero)- 1))}$samecheck->($_zero,$_[1])or return;if (!-d $_zero || (-e $_[1]&&!-d $_[1])){$!=20;return}if (!-d $_[1]){pathmk($_[1],$NoFtlPth)or return}else {if ($CPRFComp &&!$globstar){my@parts=File::Spec->splitdir($_zero);while ($parts[$#parts]eq ''){pop@parts}$_one=File::Spec->catdir($_[1],$parts[$#parts])}}my$baseend=$_one;my$level=0;my$filen=0;my$dirn=0;my$recurs;$recurs=sub {my ($str,$end,$buf)=@_;$filen++ if$end eq $baseend;$dirn++ if$end eq $baseend;$DirPerms=oct($DirPerms)if substr($DirPerms,0,1)eq '0';mkdir($end,$DirPerms)or return if!-d $end;if ($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth){chmod scalar((stat($str))[2]),$end if$KeepMode;return ($filen,$dirn,$level)if wantarray;return$filen}$level++;my@files;if ($] < 5.006){opendir(STR_DH,$str)or return;@files=grep($_ ne '.' && $_ ne '..',readdir(STR_DH));closedir STR_DH}else {opendir(my$str_dh,$str)or return;@files=grep($_ ne '.' && $_ ne '..',readdir($str_dh));closedir$str_dh}for my$file (@files){my ($file_ut)=$file =~ m{ (.*) }xms;my$org=File::Spec->catfile($str,$file_ut);my$new=File::Spec->catfile($end,$file_ut);if (-l $org && $CopyLink){my$target=readlink($org);($target)=$target =~ m/(.*)/;carp "Copying a symlink ($org) whose target does not exist" if!-e $target && $BdTrgWrn;unlink$new if -l $new;symlink($target,$new)or return}elsif (-d $org){my$rc;if (!-w $org && $KeepMode){local$KeepMode=0;$rc=$recurs->($org,$new,$buf)if defined$buf;$rc=$recurs->($org,$new)if!defined$buf;chmod scalar((stat($org))[2]),$new}else {$rc=$recurs->($org,$new,$buf)if defined$buf;$rc=$recurs->($org,$new)if!defined$buf}if (!$rc){if ($SkipFlop){next}else {return}}$filen++;$dirn++}else {if ($ok_todo_asper_condcopy->($org)){if ($SkipFlop){fcopy($org,$new,$buf)or next if defined$buf;fcopy($org,$new)or next if!defined$buf}else {fcopy($org,$new,$buf)or return if defined$buf;fcopy($org,$new)or return if!defined$buf}chmod scalar((stat($org))[2]),$new if$KeepMode;$filen++}}}$level--;chmod scalar((stat($str))[2]),$end if$KeepMode;1};$recurs->($_zero,$_one,$_[2])or return;return wantarray ? ($filen,$dirn,$level): $filen}sub fmove {$move->(1,@_)}sub rmove {if (-l $_[0]&& $CopyLink){goto&fmove}goto&dirmove if -d $_[0]|| substr($_[0],(1 * -1),1)eq '*';goto&fmove}sub rmove_glob {$glob->(\&rmove,@_)}sub dirmove {$move->(0,@_)}sub pathmk {my ($vol,$dir,$file)=File::Spec->splitpath(shift());my$nofatal=shift;$DirPerms=oct($DirPerms)if substr($DirPerms,0,1)eq '0';if (defined($dir)){my (@dirs)=File::Spec->splitdir($dir);for (my$i=0;$i < scalar(@dirs);$i++ ){my$newdir=File::Spec->catdir(@dirs[0 .. $i ]);my$newpth=File::Spec->catpath($vol,$newdir,"");mkdir($newpth,$DirPerms)or return if!-d $newpth &&!$nofatal;mkdir($newpth,$DirPerms)if!-d $newpth && $nofatal}}if (defined($file)){my$newpth=File::Spec->catpath($vol,$dir,$file);mkdir($newpth,$DirPerms)or return if!-d $newpth &&!$nofatal;mkdir($newpth,$DirPerms)if!-d $newpth && $nofatal}1}sub pathempty {my$pth=shift;my ($orig_dev,$orig_ino)=(lstat$pth)[0,1 ];return 2 if!-d _ ||!defined($orig_dev)|| ($^O ne 'MSWin32' &&!$orig_ino);my$starting_point=Cwd::cwd();my ($starting_dev,$starting_ino)=(lstat$starting_point)[0,1 ];chdir($pth)or Carp::croak("Failed to change directory to “$pth”: $!");$pth='.';_bail_if_changed($pth,$orig_dev,$orig_ino);my@names;my$pth_dh;if ($] < 5.006){opendir(PTH_DH,$pth)or return;@names=grep!/^\.\.?$/,readdir(PTH_DH);closedir PTH_DH}else {opendir($pth_dh,$pth)or return;@names=grep!/^\.\.?$/,readdir($pth_dh);closedir$pth_dh}_bail_if_changed($pth,$orig_dev,$orig_ino);for my$name (@names){my ($name_ut)=$name =~ m{ (.*) }xms;my$flpth=File::Spec->catdir($pth,$name_ut);if (-l $flpth){_bail_if_changed($pth,$orig_dev,$orig_ino);unlink$flpth or return}elsif (-d $flpth){_bail_if_changed($pth,$orig_dev,$orig_ino);pathrmdir($flpth)or return}else {_bail_if_changed($pth,$orig_dev,$orig_ino);unlink$flpth or return}}chdir($starting_point)or Carp::croak("Failed to change directory to “$starting_point”: $!");_bail_if_changed(".",$starting_dev,$starting_ino);return 1}sub pathrm {my ($path,$force,$nofail)=@_;my ($orig_dev,$orig_ino)=(lstat$path)[0,1 ];return 2 if!-d _ ||!defined($orig_dev)||!$orig_ino;if ($force && File::Spec->file_name_is_absolute($path)){Carp::croak("pathrm() w/ force on abspath is not allowed")}my@pth=File::Spec->splitdir($path);my%fs_check;my$aggregate_path;for my$part (@pth){$aggregate_path=defined$aggregate_path ? File::Spec->catdir($aggregate_path,$part): $part;$fs_check{$aggregate_path}=[(lstat$aggregate_path)[0,1 ]]}while (@pth){my$cur=File::Spec->catdir(@pth);last if!$cur;if ($force){_bail_if_changed($cur,$fs_check{$cur}->[0],$fs_check{$cur}->[1]);if (!pathempty($cur)){return unless$nofail}}_bail_if_changed($cur,$fs_check{$cur}->[0],$fs_check{$cur}->[1]);if ($nofail){rmdir$cur}else {rmdir$cur or return}pop@pth}return 1}sub pathrmdir {my$dir=shift;if (-e $dir){return if!-d $dir}else {return 2}my ($orig_dev,$orig_ino)=(lstat$dir)[0,1 ];return 2 if!defined($orig_dev)|| ($^O ne 'MSWin32' &&!$orig_ino);pathempty($dir)or return;_bail_if_changed($dir,$orig_dev,$orig_ino);rmdir$dir or return;return 1}sub _bail_if_changed {my ($path,$orig_dev,$orig_ino)=@_;my ($cur_dev,$cur_ino)=(lstat$path)[0,1 ];if (!defined$cur_dev ||!defined$cur_ino){$cur_dev ||= "undef(path went away?)";$cur_ino ||= "undef(path went away?)"}else {$path=Cwd::abs_path($path)}if ($orig_dev ne $cur_dev || $orig_ino ne $cur_ino){local$Carp::CarpLevel += 1;Carp::croak("directory $path changed: expected dev=$orig_dev ino=$orig_ino, actual dev=$cur_dev ino=$cur_ino, aborting")}}1; FILE_COPY_RECURSIVE $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.18';$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.2311';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;our$DEBUG=0;our$KEEP_ALL=0;use Exporter 5.57 'import';our@EXPORT_OK=qw{tempfile tempdir tmpnam tmpfile mktemp mkstemp mkstemps mkdtemp unlink0 cleanup SEEK_SET SEEK_CUR SEEK_END};our%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"=>0,"ErrStr"=>\$tempErrStr,"file_permissions"=>undef,);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 ()}}my$perms=$options{file_permissions};my$has_perms=defined$perms;$perms=0600 unless$has_perms;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,$perms,'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,$perms)}if ($open_success){chmod($perms,$path)unless$has_perms;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"=>0,"PERMS"=>undef,);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(_wrap_file_spec_tmpdir(),$template)}}else {if ($options{"DIR"}){$template=File::Spec->catfile($options{"DIR"},TEMPXXX)}else {$template=File::Spec->catfile(_wrap_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},"file_permissions"=>$options{PERMS},));_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}}{my ($alt_tmpdir,$checked);sub _wrap_file_spec_tmpdir {return File::Spec->tmpdir unless $^O eq "MSWin32" && ${^TAINT};if ($checked){return$alt_tmpdir ? $alt_tmpdir : File::Spec->tmpdir}my$xxpath=_replace_XX("X" x 10,0);my$tmpdir=File::Spec->tmpdir;my$testpath=File::Spec->catdir($tmpdir,$xxpath);if (mkdir($testpath,0700)){$checked=1;rmdir$testpath;return$tmpdir}require Win32;my$local_app=File::Spec->catdir(Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA()),'Temp');$testpath=File::Spec->catdir($local_app,$xxpath);if (-e $local_app or mkdir($local_app,0700)){if (mkdir($testpath,0700)){$checked=1;rmdir$testpath;return$alt_tmpdir=$local_app}}croak << "HERE"}}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(_wrap_file_spec_tmpdir(),$template)}}}else {if ($options{"DIR"}){$template=File::Spec->catdir($options{"DIR"},TEMPXXX)}else {$template=File::Spec->catdir(_wrap_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=_wrap_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;our$VERSION='0.2311';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; Couldn't find a writable temp directory in taint mode. Tried: $tmpdir $local_app Try setting and untainting the TMPDIR environment variable. HERE FILE_TEMP $fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH'; package File::Which;use strict;use warnings;use base qw(Exporter);use File::Spec ();our$VERSION='1.27';our@EXPORT='which';our@EXPORT_OK='where';use constant IS_VMS=>($^O eq 'VMS');use constant IS_MAC=>($^O eq 'MacOS');use constant IS_WIN=>($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');use constant IS_DOS=>IS_WIN();use constant IS_CYG=>($^O eq 'cygwin' || $^O eq 'msys');our$IMPLICIT_CURRENT_DIR=IS_WIN || IS_VMS || IS_MAC;my@PATHEXT=('');if (IS_WIN){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_WIN and $exec =~ /\// and -f $exec and -x $exec;my@path;if($^O eq 'MSWin32'){@path=split /;/,$ENV{PATH};s/"//g for@path;@path=grep length,@path}else {@path=File::Spec->path}if ($IMPLICIT_CURRENT_DIR){unshift@path,File::Spec->curdir}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_WIN 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.016';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {File::Spec->canonpath($_[0]->{_pushd})},fallback=>1;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;$dir->{_owner}=$$;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->{_owner}==$$ &&!$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.006001;use strict;use warnings;package Getopt::Long;our$VERSION=2.57;use Exporter;use base qw(Exporter);sub GetOptions(@);sub GetOptionsFromArray(@);sub GetOptionsFromString(@);sub Configure(@);sub HelpMessage(@);sub VersionMessage(@);our@EXPORT;our@EXPORT_OK;our ($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER);BEGIN {($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER)=(0..2);@EXPORT=qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);@EXPORT_OK=qw(&HelpMessage &VersionMessage &Configure &GetOptionsFromArray &GetOptionsFromString)}our ($error,$debug,$major_version,$minor_version);our ($autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$passthrough);our ($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}($major_version,$minor_version)=$VERSION =~ /^(\d+)\.(\d+)/;ConfigDefaults();my$default_config=do {Getopt::Long::Configure ()};sub _default_config {$default_config}no warnings 'redefine';sub Getopt::Long::Parser::new {require Getopt::Long::Parser;goto&Getopt::Long::Parser::new}use warnings 'redefine';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 $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;my$starter;($found,$opt,$ctl,$starter,$arg,$key)=FindOption ($argv,$prefix,$argend,$opt,\%opctl);if ($found){next unless defined$opt;my$argcnt=0;while (defined$arg){my$given=$opt;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,given=>$given,ctl=>$ctl,opctl=>\%opctl,linkage=>\%linkage,prefix=>$prefix,starter=>$starter,),$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 || $passthrough)){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)=@_;my$op=$passthrough ? qr/(?: \w+[-\w]* )/x : qr/(?: \w+[-.\w]* )/x;if ($opt !~ m;^ ( # Option name $op # Aliases (?: \| (?: . [^|!+=:]* )? )* )? ( # Either modifiers ... [!+] | # ... or a value/dest/repeat specification [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )? | # ... or an optional-with-default spec : (?: 0[0-7]+ | 0[xX][0-9a-fA-F]+ | 0[bB][01]+ | -?\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 =~ /^:(0[0-7]+|0x[0-9a-f]+|0b[01]+|-?\d+|\+)([@%])?$/i){my$def=$1;my$dest=$2;my$type='i';if ($def eq '+'){$type='I'}elsif ($def =~ /^(0[0-7]+|0[xX][0-9a-fA-F]+|0[bB][01]+)$/){$type='o';$def=oct($def)}elsif ($def =~ /^-?\d+$/){$def=0 + $def}$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){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,$starter,$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){if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,$starter,1)}my$val=defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0;return (1,$opt,$ctl,$starter,$val)}return (1,$opt,$ctl,$starter,$type eq 's' ? '' : 0)if$optargtype==1}if (defined$optarg ? ($optarg eq ''):!(defined$rest || @$argv > 0)){if ($mand || $ctl->[CTL_DEST]==CTL_DEST_HASH){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,$starter,1)}return (1,$opt,$ctl,$starter,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,$starter,$arg,$key)if$mand;return (1,$opt,$ctl,$starter,$arg,$key)if$ctl->[CTL_DEST]==CTL_DEST_HASH;return (1,$opt,$ctl,$starter,$arg,$key)if defined$optarg || defined$rest;return (1,$opt,$ctl,$starter,$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,$starter,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,$starter,$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 $VERSION,"," Perl version ",$] >= 5.006 ? sprintf("%vd",$^V): $],")\n");exit($pa->{-exitval})unless$pa->{-exitval}eq "NOEXIT"}sub HelpMessage(@) {eval {require Pod::Usage;Pod::Usage->import;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')){if (!defined$pa->{-message}){$pa->{-message}=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]if @_ > 1;shift->SUPER::VERSION(@_)}package Getopt::Long::CallBack;sub new {my ($pkg,%atts)=@_;bless {%atts },$pkg}sub name {my$self=shift;''.$self->{name}}sub given {my$self=shift;$self->{given}}use overload '""'=>\&name,fallback=>1;1; GETOPT_LONG $fatpacked{"Getopt/Long/Parser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG_PARSER'; package Getopt::Long::Parser;our$VERSION=2.57;use Getopt::Long ();no warnings 'redefine';sub new {my$that=shift;my$class=ref($that)|| $that;my%atts=@_;my$self={caller_pkg=>(caller)[0]};bless ($self,$class);my$default_config=Getopt::Long::_default_config();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}use warnings 'redefine';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}1; GETOPT_LONG_PARSER $fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY'; package HTTP::Tiny;use strict;use warnings;our$VERSION='0.088';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)=@_;if (exists$args{verify_ssl}){$args{verify_SSL}||= $args{verify_ssl}}my$self={max_redirect=>5,timeout=>defined$args{timeout}? $args{timeout}: 60,keep_alive=>1,verify_SSL=>defined$args{verify_SSL}? $args{verify_SSL}: _verify_SSL_default(),no_proxy=>$ENV{no_proxy},};bless$self,$class;$class->_validate_cookie_jar($args{cookie_jar})if$args{cookie_jar};for my$key (@attributes){$self->{$key}=$args{$key}if exists$args{$key}}$self->agent(exists$args{agent}? $args{agent}: $class->_agent);$self->_set_proxies;return$self}sub _verify_SSL_default {my ($self)=@_;return (($ENV{PERL_HTTP_TINY_SSL_INSECURE_BY_DEFAULT}|| '')eq '1')? 0 : 1}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}=($ENV{CGI_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 patch 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}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|SSL read error)}}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);_croak("form data keys must not be undef")if!defined($key);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}){return$self->{handle}->connected}return}my%DefaultPort=(http=>80,https=>443,);sub _agent {my$class=ref($_[0])|| $_[0];(my$default_agent=$class)=~ s{::}{-}g;my$version=$class->VERSION;$default_agent .= "/$version" if defined$version;return$default_agent}sub _request {my ($self,$method,$url,$args)=@_;my ($scheme,$host,$port,$path_query,$auth)=$self->_split_url($url);if ($scheme ne 'http' && $scheme ne 'https'){die(qq/Unsupported URL scheme '$scheme'\n/)}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;if ('CODE' eq ref$peer){$peer=$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}&& $handle->connected && $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 ($request->{method}eq 'PUT' || $request->{method}eq 'POST'){if (!defined($args->{content})||!length($args->{content})){$request->{headers}{'content-length'}=0}}if (defined$args->{content}){if (ref$args->{content}eq 'CODE'){if (exists$request->{'content-length'}&& $request->{'content-length'}==0){$request->{cb}=sub {""}}else {$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'transfer-encoding'}='chunked' unless exists$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)=@_;return "" if!defined$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}/g;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.32)}? '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=>HTTP::Tiny::_verify_SSL_default(),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}$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 connected {my ($self)=@_;if ($self->{fh}&& $self->{fh}->connected){return wantarray ? ($self->{fh}->peerhost,$self->{fh}->peerport): join(':',$self->{fh}->peerhost,$self->{fh}->peerport)}return}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}local$SIG{PIPE}='IGNORE';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 (exists$request->{headers}{'content-length'}){return unless$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);$reason="" unless defined$reason;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.19';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 patch/){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 patch/){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,{binmode_stdout=>":raw",binmode_stderr=>":raw",}};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,{binmode_stdout=>":raw",binmode_stderr=>":raw",}};if ($@ or $?){return$self->internal_error($url,$@ || $error)}my$res={url=>$url,content=>$output };$self->parse_http_header(_slurp($temp),$res);$res}sub build_options {my($self,$url,$opts)=@_;my@options=('--silent','--show-error','--max-time',($self->{timeout}|| 60),'--user-agent',($self->{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),);if (my$max_redirect=exists$self->{max_redirect}? $self->{max_redirect}: 5){push@options,'--location','--max-redirs',$max_redirect}my%headers;if ($self->{default_headers}){%headers=%{$self->{default_headers}}}if ($opts->{headers}){%headers=(%headers,%{$opts->{headers}})}$self->_translate_headers(\%headers,\@options);unless ($self->{verify_SSL}){push@options,'--insecure'}if ($opts->{content}){my$content;if (ref$opts->{content}eq 'CODE'){while (my$chunk=$opts->{content}->()){$content .= $chunk}}else {$content=$opts->{content}}push@options,'--data',$content}@options}sub _translate_headers {my($self,$headers,$options)=@_;for my$field (keys %$headers){my$value=$headers->{$field};if (ref$value eq 'ARRAY'){push @$options,map {('-H',"$field:$_")}@$value}else {push @$options,'-H',"$field:$value"}}}1; HTTP_TINYISH_CURL $fatpacked{"HTTP/Tinyish/HTTPTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_HTTPTINY'; package HTTP::Tinyish::HTTPTiny;use strict;use parent qw(HTTP::Tinyish::Base);use HTTP::Tiny;my%supports=(http=>1);sub configure {my%meta=("HTTP::Tiny"=>$HTTP::Tiny::VERSION);$supports{https}=HTTP::Tiny->can_ssl;\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attrs)=@_;bless {tiny=>HTTP::Tiny->new(%attrs),},$class}sub request {my$self=shift;$self->{tiny}->request(@_)}sub mirror {my$self=shift;$self->{tiny}->mirror(@_)}1; HTTP_TINYISH_HTTPTINY $fatpacked{"HTTP/Tinyish/LWP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINYISH_LWP'; package HTTP::Tinyish::LWP;use strict;use parent qw(HTTP::Tinyish::Base);use LWP 5.802;use LWP::UserAgent;my%supports=(http=>1);sub configure {my%meta=(LWP=>$LWP::VERSION,);if (eval {require LWP::Protocol::https;require Mozilla::CA;1}){$supports{https}=1;$meta{"LWP::Protocol::https"}=$LWP::Protocol::https::VERSION}\%meta}sub supports {$supports{$_[1]}}sub new {my($class,%attr)=@_;my$ua=LWP::UserAgent->new;bless {ua=>$class->translate_lwp($ua,%attr),},$class}sub _headers_to_hashref {my($self,$hdrs)=@_;my%headers;for my$field ($hdrs->header_field_names){$headers{lc$field}=$hdrs->header($field)}\%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(exists$attr{max_redirect}? $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,{binmode_stdout=>":raw",binmode_stderr=>":raw",}};if ($@ or $?){return$self->internal_error($url,$@ || $stderr)}$stderr =~ s/^ //gm;my$res={url=>$url,content=>$stdout };$self->parse_http_header($stderr,$res);$res}sub build_options {my($self,$method,$url,$opts)=@_;my@options=('--retry-connrefused','--server-response','--timeout',($self->{timeout}|| 60),'--tries',1,'--max-redirect',(exists$self->{max_redirect}? $self->{max_redirect}: 5),'--user-agent',($self->{agent}|| "HTTP-Tinyish/$HTTP::Tinyish::VERSION"),);if ($method_supported){push@options,"--method",$method}else {if ($method eq 'GET' or $method eq 'POST'){}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/Run3.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IPC_RUN3'; use strict;use warnings;package IPC::Run3;our$VERSION='0.049';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$params=[];while (1){my$data=$source->(@$params);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,$out_fh,$err_fh);$in_fh=_spool_data_to_child$in_type,$stdin,$options->{binmode_stdin}if defined$stdin;$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;$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=defined$in_fh ? dup(0): undef;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;$!=0;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 && $errno!=0))&&!$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'; use strict;use warnings;package IPC::Run3::ProfArrayBuffer;our$VERSION=0.049;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'; use strict;use warnings;package IPC::Run3::ProfLogReader;our$VERSION=0.049;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=<$fh>;my@ln=defined$ln ? (split / /,$ln): ();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'; use strict;use warnings;package IPC::Run3::ProfLogger;our$VERSION=0.049;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'; use strict;use warnings;package IPC::Run3::ProfPP;our$VERSION=0.049;require IPC::Run3::ProfReporter;our@ISA=qw(IPC::Run3::ProfReporter);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'; use strict;use warnings;package IPC::Run3::ProfReporter;our$VERSION=0.049;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.008;use strict;use Exporter ();BEGIN {our@ISA=('Exporter')}use overload ();use JSON::PP::Boolean;use Carp ();use Scalar::Util qw(blessed reftype refaddr);our$VERSION='4.16';our@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 P_ALLOW_TAGS=>19;use constant USE_B=>$ENV{PERL_JSON_PP_USE_B}|| 0;use constant CORE_BOOL=>defined&builtin::is_bool;my$invalid_char_re;BEGIN {$invalid_char_re="[";for my$i (0 .. 0x01F,0x22,0x5c){$invalid_char_re .= quotemeta chr utf8::unicode_to_native($i)}$invalid_char_re=qr/$invalid_char_re]/}BEGIN {if (USE_B){require B}}BEGIN {my@xs_compati_bit_properties=qw(latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink allow_blessed convert_blessed relaxed allow_unknown allow_tags);my@pp_bit_properties=qw(allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed);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,};$self->{PROPS}[P_ALLOW_NONREF]=1;bless$self,$class}sub encode {return $_[0]->PP_encode_json($_[1])}sub decode {return $_[0]->PP_decode_json($_[1],0x00000000)}sub decode_prefix {return $_[0]->PP_decode_json($_[1],0x00000001)}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 boolean_values {my$self=shift;if (@_){my ($false,$true)=@_;$self->{false}=$false;$self->{true}=$true;if (CORE_BOOL){BEGIN {CORE_BOOL and warnings->unimport(qw(experimental::builtin))}if (builtin::is_bool($true)&& builtin::is_bool($false)&& $true &&!$false){$self->{core_bools}=!!1}else {delete$self->{core_bools}}}}else {delete$self->{false};delete$self->{true};delete$self->{core_bools}}return$self}sub core_bools {my$self=shift;my$core_bools=defined $_[0]? $_[0]: 1;if ($core_bools){$self->{true}=!!1;$self->{false}=!!0;$self->{core_bools}=!!1}else {$self->{true}=$JSON::PP::true;$self->{false}=$JSON::PP::false;$self->{core_bools}=!!0}return$self}sub get_core_bools {my$self=shift;return!!$self->{core_bools}}sub unblessed_bool {my$self=shift;return$self->core_bools(@_)}sub get_unblessed_bool {my$self=shift;return$self->get_core_bools(@_)}sub get_boolean_values {my$self=shift;if (exists$self->{true}and exists$self->{false}){return @$self{qw/false true/}}return}sub filter_json_object {if (defined $_[1]and ref $_[1]eq 'CODE'){$_[0]->{cb_object}=$_[1]}else {delete $_[0]->{cb_object}}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub filter_json_single_key_object {if (@_==1 or @_ > 3){Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)")}if (defined $_[2]and ref $_[2]eq 'CODE'){$_[0]->{cb_sk_object}->{$_[1]}=$_[2]}else {delete $_[0]->{cb_sk_object}->{$_[1]};delete $_[0]->{cb_sk_object}unless %{$_[0]->{cb_sk_object}|| {}}}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub indent_length {if (!defined $_[1]or $_[1]> 15 or $_[1]< 0){Carp::carp "The acceptable range of indent_length() is 0 to 15."}else {$_[0]->{indent_length}=$_[1]}$_[0]}sub get_indent_length {$_[0]->{indent_length}}sub sort_by {$_[0]->{sort_by}=defined $_[1]? $_[1]: 1;$_[0]}sub allow_bigint {Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead.");$_[0]->allow_bignum}{my$max_depth;my$indent;my$ascii;my$latin1;my$utf8;my$space_before;my$space_after;my$canonical;my$allow_blessed;my$convert_blessed;my$indent_length;my$escape_slash;my$bignum;my$as_nonblessed;my$allow_tags;my$depth;my$indent_count;my$keysort;sub PP_encode_json {my$self=shift;my$obj=shift;$indent_count=0;$depth=0;my$props=$self->{PROPS};($ascii,$latin1,$utf8,$indent,$canonical,$space_before,$space_after,$allow_blessed,$convert_blessed,$escape_slash,$bignum,$as_nonblessed,$allow_tags)=@{$props}[P_ASCII .. P_SPACE_AFTER,P_ALLOW_BLESSED,P_CONVERT_BLESSED,P_ESCAPE_SLASH,P_ALLOW_BIGNUM,P_AS_NONBLESSED,P_ALLOW_TAGS];($max_depth,$indent_length)=@{$self}{qw/max_depth indent_length/};$keysort=$canonical ? sub {$a cmp $b}: undef;if ($self->{sort_by}){$keysort=ref($self->{sort_by})eq 'CODE' ? $self->{sort_by}: $self->{sort_by}=~ /\D+/ ? $self->{sort_by}: sub {$a cmp $b}}encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")if(!ref$obj and!$props->[P_ALLOW_NONREF ]);my$str=$self->object_to_json($obj);$str .= "\n" if ($indent);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 ($allow_tags and $obj->can('FREEZE')){my$obj_class=ref$obj || $obj;$obj=bless$obj,$obj_class;my@results=$obj->FREEZE('JSON');if (@results and ref$results[0]){if (refaddr($obj)eq refaddr($results[0])){encode_error(sprintf("%s::FREEZE method returned same object as was passed instead of a new one",ref$obj))}}return '("'.$obj_class.'")['.join(',',@results).']'}if ($convert_blessed and $obj->can('TO_JSON')){my$result=$obj->TO_JSON();if (defined$result and ref($result)){if (refaddr($obj)eq refaddr($result)){encode_error(sprintf("%s::TO_JSON method returned same object as was passed instead of a new one",ref$obj))}}return$self->object_to_json($result)}return "$obj" if ($bignum and _is_bignum($obj));if ($allow_blessed){return$self->blessed_to_json($obj)if ($as_nonblessed);return 'null'}encode_error(sprintf("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)",$obj))}else {return$self->value_to_json($obj)}}else{return$self->value_to_json($obj)}}sub hash_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');my$del=($space_before ? ' ' : '').':' .($space_after ? ' ' : '');for my$k (_sort($obj)){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){BEGIN {CORE_BOOL and warnings->unimport('experimental::builtin')}if (CORE_BOOL && builtin::is_bool($value)){return$value ? 'true' : 'false'}elsif (_looks_like_number($value)){return$value}return$self->string_to_json($value)}elsif(blessed($value)and $value->isa('JSON::PP::Boolean')){return $$value==1 ? 'true' : 'false'}else {if ((overload::StrVal($value)=~ /=(\w+)/)[0]){return$self->value_to_json("$value")}if ($type eq 'SCALAR' and defined $$value){return $$value eq '1' ? 'true' : $$value eq '0' ? 'false' : $self->{PROPS}->[P_ALLOW_UNKNOWN ]? 'null' : encode_error("cannot encode reference to scalar")}if ($self->{PROPS}->[P_ALLOW_UNKNOWN ]){return 'null'}else {if ($type eq 'SCALAR' or $type eq 'REF'){encode_error("cannot encode reference to scalar")}else {encode_error("encountered $value, but JSON can only represent references to arrays or hashes")}}}}my%esc=("\n"=>'\n',"\r"=>'\r',"\t"=>'\t',"\f"=>'\f',"\b"=>'\b',"\""=>'\"',"\\"=>'\\\\',"\'"=>'\\\'',);sub string_to_json {my ($self,$arg)=@_;$arg =~ s/(["\\\n\r\t\f\b])/$esc{$1}/g;$arg =~ s/\//\\\//g if ($escape_slash);$arg =~ s/([^\n\t\c?[:^cntrl:][:^ascii:]])/'\\u00' . unpack('H2', $1)/eg;if ($ascii){$arg=_encode_ascii($arg)}if ($latin1){$arg=_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 {chr($_)=~ /[[:ascii:]]/ ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_latin1 {join('',map {$_ <= 255 ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_surrogates {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=>"\b",t=>"\t",n=>"\n",f=>"\f",r=>"\r",'\\'=>'\\','"'=>'"','/'=>'/',);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;my$allow_tags;my$alt_true;my$alt_false;sub _detect_utf_encoding {my$text=shift;my@octets=unpack('C4',$text);return 'unknown' unless defined$octets[3];return ($octets[0]and $octets[1])? 'UTF-8' : (!$octets[0]and $octets[1])? 'UTF-16BE' : (!$octets[0]and!$octets[1])? 'UTF-32BE' : ($octets[2])? 'UTF-16LE' : (!$octets[2])? 'UTF-32LE' : 'unknown'}sub PP_decode_json {my ($self,$want_offset);($self,$text,$want_offset)=@_;($at,$ch,$depth)=(0,'',0);if (!defined$text or ref$text){decode_error("malformed JSON string, neither array, object, number, string or atom")}my$props=$self->{PROPS};($utf8,$relaxed,$loose,$allow_bignum,$allow_barekey,$singlequote,$allow_tags)=@{$props}[P_UTF8,P_RELAXED,P_LOOSE .. P_ALLOW_SINGLEQUOTE,P_ALLOW_TAGS];($alt_true,$alt_false)=@$self{qw/true false/};if ($utf8){$encoding=_detect_utf_encoding($text);if ($encoding ne 'UTF-8' and $encoding ne 'unknown'){require Encode;Encode::from_to($text,$encoding,'utf-8')}else {utf8::downgrade($text,1)or Carp::croak("Wide character in subroutine entry")}}else {utf8::encode($text)}$len=length$text;($max_depth,$max_size,$cb_object,$cb_sk_object,$F_HOOK)=@{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/};if ($max_size > 1){use bytes;my$bytes=length$text;decode_error(sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s",$bytes,$max_size),1)if ($bytes > $max_size)}white();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 tag()if($ch eq '(');return string()if($ch eq '"' or ($singlequote and $ch eq "'"));return number()if($ch =~ /[0-9]/ or $ch eq '-');return word()}sub string {my$utf16;my$is_utf8;($is_valid_utf8,$utf8_len)=('',0);my$s='';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 .= _decode_surrogates($utf16,$u)|| next;$utf16=undef}else {if (defined$utf16){decode_error("surrogate pair expected")}my$hex=hex($u);if (chr$u =~ /[[:^ascii:]]/){$is_utf8=1;$s .= _decode_unicode($u)|| next}else {$s .= chr$hex}}}else{unless ($loose){$at -= 2;decode_error('illegal backslash escape sequence in string')}$s .= $ch}}else{if ($ch =~ /[[:^ascii:]]/){unless($ch=is_valid_utf8($ch)){$at -= 1;decode_error("malformed UTF-8 character in JSON string")}else {$at += $utf8_len - 1}$is_utf8=1}if (!$loose){if ($ch =~ $invalid_char_re){if (!$relaxed or $ch ne "\t"){$at--;decode_error(sprintf "invalid character 0x%X" ." encountered while parsing JSON string",ord$ch)}}}$s .= $ch}}}decode_error("unexpected end of string while parsing JSON string")}sub white {while(defined$ch){if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){next_chr()}elsif($relaxed and $ch eq '/'){next_chr();if(defined$ch and $ch eq '/'){1 while(defined(next_chr())and $ch ne "\n" and $ch ne "\r")}elsif(defined$ch and $ch eq '*'){next_chr();while(1){if(defined$ch){if($ch eq '*'){if(defined(next_chr())and $ch eq '/'){next_chr();last}}else{next_chr()}}else{decode_error("Unterminated comment")}}next}else{$at--;decode_error("malformed JSON string, neither array, object, number, string or atom")}}else{if ($relaxed and $ch eq '#'){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 tag {decode_error('malformed JSON string, neither array, object, number, string or atom')unless$allow_tags;next_chr();white();my$tag=value();return unless defined$tag;decode_error('malformed JSON string, (tag) must be a string')if ref$tag;white();if (!defined$ch or $ch ne ')'){decode_error(') expected after tag')}next_chr();white();my$val=value();return unless defined$val;decode_error('malformed JSON string, tag value must be an array')unless ref$val eq 'ARRAY';if (!eval {$tag->can('THAW')}){decode_error('cannot decode perl-object (package does not exist)')if $@;decode_error('cannot decode perl-object (package does not have a THAW method)')}$tag->THAW('JSON',@$val)}sub object {my$o=$_[0]|| {};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 =~ /[\$\w[:^ascii:]]/){$key .= $ch;next_chr()}return$key}sub word {my$word=substr($text,$at-1,4);if($word eq 'true'){$at += 3;next_chr;return defined$alt_true ? $alt_true : $JSON::PP::true}elsif($word eq 'null'){$at += 3;next_chr;return undef}elsif($word eq 'fals'){$at += 3;if(substr($text,$at,1)eq 'e'){$at++;next_chr;return defined$alt_false ? $alt_false : $JSON::PP::false}}$at--;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}my$max_unicode_length=do {no warnings 'utf8';chr 0x10FFFF};utf8::encode($max_unicode_length);$max_unicode_length=length$max_unicode_length;sub is_valid_utf8 {my$start_point=substr($text,$at - 1);my$limit=$max_unicode_length;$limit=length($start_point)if$limit > length($start_point);while ($limit > 0){my$copy=substr($start_point,0,$limit);if (utf8::decode($copy)){$copy=substr($copy,0,1);utf8::encode($copy);$utf8_len=length$copy;return substr($start_point,0,$utf8_len)}$limit--}$utf8_len=0;return}sub decode_error {my$error=shift;my$no_rep=shift;my$str=defined$text ? substr($text,$at): '';my$mess='';my$type='U*';for my$c (unpack($type,$str)){my$chr_c=chr($c);$mess .= $chr_c eq '\\' ? '\\\\' : $chr_c =~ /[[:print:]]/ ? $chr_c : $chr_c eq '\a' ? '\a' : $chr_c eq '\t' ? '\t' : $chr_c eq '\n' ? '\n' : $chr_c eq '\r' ? '\r' : $chr_c eq '\f' ? '\f' : sprintf('\x{%x}',$c);if (length$mess >= 20){$mess .= '...';last}}unless (length$mess){$mess='(end of string)'}Carp::croak ($no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")")}sub _json_object_hook {my$o=$_[0];my@ks=keys %{$o};if ($cb_sk_object and @ks==1 and exists$cb_sk_object->{$ks[0]}and ref$cb_sk_object->{$ks[0]}){my@val=$cb_sk_object->{$ks[0]}->($o->{$ks[0]});if (@val==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar")}}my@val=$cb_object->($o)if ($cb_object);if (@val==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_object callbacks must not return more than one scalar")}}sub PP_decode_box {{text=>$text,at=>$at,ch=>$ch,len=>$len,depth=>$depth,encoding=>$encoding,is_valid_utf8=>$is_valid_utf8,}}}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}sub incr_parse {local$Carp::CarpLevel=1;($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_parse(@_)}sub incr_skip {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_skip}sub incr_reset {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_reset}sub 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}}$JSON::PP::true=do {bless \(my$dummy=1),"JSON::PP::Boolean"};$JSON::PP::false=do {bless \(my$dummy=0),"JSON::PP::Boolean"};sub is_bool {if (blessed $_[0]){return ($_[0]->isa("JSON::PP::Boolean")or $_[0]->isa("Types::Serialiser::BooleanBase")or $_[0]->isa("JSON::XS::Boolean"))}elsif (CORE_BOOL){BEGIN {CORE_BOOL and warnings->unimport('experimental::builtin')}return builtin::is_bool($_[0])}return!!0}sub true {$JSON::PP::true}sub false {$JSON::PP::false}sub null {undef}package 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;use constant INCR_M_TFN=>6;use constant INCR_M_NUM=>7;our$VERSION='1.01';sub new {my ($class)=@_;bless {incr_nest=>0,incr_text=>undef,incr_pos=>0,incr_mode=>0,},$class}sub incr_parse {my ($self,$coder,$text)=@_;$self->{incr_text}='' unless (defined$self->{incr_text});if (defined$text){$self->{incr_text}.= $text}if (defined wantarray){my$max_size=$coder->get_max_size;my$p=$self->{incr_pos};my@ret;{do {unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){$self->_incr_parse($coder);if ($max_size and $self->{incr_pos}> $max_size){Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size")}unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){if ($self->{incr_mode}==INCR_M_WS and $self->{incr_pos}){$self->{incr_pos}=0;$self->{incr_text}=''}last}}unless ($coder->get_utf8){utf8::decode($self->{incr_text})}my ($obj,$offset)=$coder->PP_decode_json($self->{incr_text},0x00000001);push@ret,$obj;use bytes;$self->{incr_text}=substr($self->{incr_text},$offset || 0);$self->{incr_pos}=0;$self->{incr_nest}=0;$self->{incr_mode}=0;last unless wantarray}while (wantarray)}if (wantarray){return@ret}else {return defined$ret[0]? $ret[0]: undef}}}sub _incr_parse {my ($self,$coder)=@_;my$text=$self->{incr_text};my$len=length$text;my$p=$self->{incr_pos};INCR_PARSE: while ($len > $p){my$s=substr($text,$p,1);last INCR_PARSE unless defined$s;my$mode=$self->{incr_mode};if ($mode==INCR_M_WS){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if (ord($s)> ord " "){if ($s eq '#'){$self->{incr_mode}=INCR_M_C0;redo INCR_PARSE}else {$self->{incr_mode}=INCR_M_JSON;redo INCR_PARSE}}$p++}}elsif ($mode==INCR_M_BS){$p++;$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($mode==INCR_M_C0 or $mode==INCR_M_C1){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq "\n"){$self->{incr_mode}=$self->{incr_mode}==INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;last}$p++}next}elsif ($mode==INCR_M_TFN){last INCR_PARSE if$p >= $len && $self->{incr_nest};while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[rueals]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_NUM){last INCR_PARSE if$p >= $len && $self->{incr_nest};while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[0-9eE.+\-]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_STR){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq '"'){$p++;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($s eq '\\'){$p++;if (!defined substr($text,$p,1)){$self->{incr_mode}=INCR_M_BS;last INCR_PARSE}}$p++}}elsif ($mode==INCR_M_JSON){while ($len > $p){$s=substr($text,$p++,1);if ($s eq "\x00"){$p--;last INCR_PARSE}elsif ($s =~ /^[\t\n\r ]$/){if (!$self->{incr_nest}){$p--;last INCR_PARSE}next}elsif ($s eq 't' or $s eq 'f' or $s eq 'n'){$self->{incr_mode}=INCR_M_TFN;redo INCR_PARSE}elsif ($s =~ /^[0-9\-]$/){$self->{incr_mode}=INCR_M_NUM;redo INCR_PARSE}elsif ($s eq '"'){$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($s eq '[' or $s eq '{'){if (++$self->{incr_nest}> $coder->get_max_depth){Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')}next}elsif ($s eq ']' or $s eq '}'){if (--$self->{incr_nest}<= 0){last INCR_PARSE}}elsif ($s eq '#'){$self->{incr_mode}=INCR_M_C1;redo INCR_PARSE}}}}$self->{incr_pos}=$p;$self->{incr_parsing}=$p ? 1 : 0}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 warnings;use overload ();overload::unimport('overload',qw(0+ ++ -- fallback));overload::import('overload',"0+"=>sub {${$_[0]}},"++"=>sub {$_[0]=${$_[0]}+ 1},"--"=>sub {$_[0]=${$_[0]}- 1},fallback=>1,);our$VERSION='4.16';1; JSON_PP_BOOLEAN $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.15';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 {my@check=shift;my@lin;my%found;while (defined(my$check=shift@check)){push@lin,$check;no strict 'refs';unshift@check,grep!$found{$_}++,@{"$check\::ISA"}}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.9022';if ($INC{"App/FatPacker/Trace.pm"}){require version::vpp}sub qs($) {Menlo::Util::shell_quote($_[0])}sub determine_home {my$class=shift;my$homedir=$ENV{HOME}|| eval {require File::HomeDir;File::HomeDir->my_home}|| join('',@ENV{qw(HOMEDRIVE HOMEPATH)});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 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->is_downgrade($version,$local)? "downgraded" : "upgraded" : undef;my$how=$reinstall ? "reinstalled $distname" : $local ? "installed $distname ($action from $local)" : "installed $distname" ;my$msg="Successfully $how";$self->diag_ok;$self->diag("$msg\n",1);$self->{installed_dists}++;$self->save_meta($stuff,$dist,$module_name,\@config_deps,\@deps);return 1}else {my$what=$self->{test_only}? "Testing" : "Installing";$self->diag_fail("$what $stuff failed. See $self->{log} for details. Retry with --force to force install it.",1);return}}sub is_downgrade {my($self,$va,$vb)=@_;eval {version::->new($va)< $vb}}sub opts_in_static_install {my($self,$meta)=@_;return if!$self->{static_install};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.9022';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;use strict;use warnings;use File::Spec ();our$VERSION='0.36';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))}}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/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_METADATA'; package Module::Metadata;sub __clean_eval {eval $_[0]}use strict;use warnings;our$VERSION='1.000038';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 whitespace [;\{] # semicolon line terminator or block start (since 5.16) }x;my$CLASS_REGEXP=qr{ # match a class declaration (core since 5.38) ^[\s\{;]* # intro chars on a line class # the word 'class' \s+ # whitespace ($PKG_NAME_REGEXP) # a package name \s* # optional whitespace ($V_NUM_REGEXP)? # optional version number \s* # optional whitespace [;\{] # semicolon line terminator or block start }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->abs2rel($file,$dir);my@path=File::Spec->splitdir($mapped_filename);(my$prime_package=join('::',@path))=~ s/\.pm$//;my$pm_info=$class->new_from_file($file);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 decode_pod);@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;my$encoding='';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}){if ($self->{decode_pod}&& $line =~ /^=encoding ([\w-]+)/){$encoding=$1}$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 or $line =~ /$CLASS_REGEXP/){$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}if ($self->{decode_pod}&& $encoding){require Encode;$_=Encode::decode($encoding,$_)for values%pod}$self->{versions}=\%vers;$self->{packages}=\@packages;$self->{pod}=\%pod;$self->{pod_headings}=\@pod}sub __uniq (@) {my (%seen,$key);grep!$seen{$key=$_ }++,@_}{my$pn=0;sub _evaluate_version_line {my$self=shift;my($sigil,$variable_name,$line)=@_;$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{"Module/cpmfile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPMFILE'; package Module::cpmfile;use 5.008001;use strict;use warnings;our$VERSION='0.006';use Module::cpmfile::Prereqs;use Module::cpmfile::Util qw(merge_version _yaml_hash);use YAML::PP ();sub load {my ($class,$file)=@_;my ($hash)=YAML::PP->new->load_file($file);$class->new($hash)}sub new {my ($class,$hash)=@_;my$prereqs=Module::cpmfile::Prereqs->new($hash->{prereqs});my%feature;for my$id (sort keys %{$hash->{features}|| +{}}){my$description=$hash->{features}{$id}{description};my$prereqs=Module::cpmfile::Prereqs->new($hash->{features}{$id}{prereqs});$feature{$id}={description=>$description,prereqs=>$prereqs }}bless {prereqs=>$prereqs,features=>\%feature,_mirrors=>[]},$class}sub from_cpanfile {my ($class,$cpanfile)=@_;my%feature;for my$feature ($cpanfile->features){my$id=$feature->{identifier};my$description=$feature->{description};my$prereqs=Module::cpmfile::Prereqs->from_cpanmeta($feature->{prereqs});$feature{$id}={description=>$description,prereqs=>$prereqs }}my$prereqs=Module::cpmfile::Prereqs->from_cpanmeta($cpanfile->prereqs);for my$p ($prereqs,map {$_->{prereqs}}values%feature){$p->walk(undef,undef,sub {my (undef,undef,$package,$original_options)=@_;my$additional_options=$cpanfile->options_for_module($package)|| +{};if (%$additional_options){%$original_options=(%$original_options,%$additional_options)}})}my$mirrors=$cpanfile->mirrors;bless {prereqs=>$prereqs,features=>\%feature,_mirrors=>$mirrors },$class}sub from_cpanmeta {my ($class,$cpanmeta)=@_;my%feature;for my$id (keys %{$cpanmeta->optional_features}){my$f=$cpanmeta->optional_features->{$id};my$description=$f->{description};my$prereqs=Module::cpmfile::Prereqs->from_cpanmeta($f->{prereqs});$feature{$id}={description=>$description,prereqs=>$prereqs }}my$prereqs=Module::cpmfile::Prereqs->from_cpanmeta($cpanmeta->prereqs);bless {prereqs=>$prereqs,features=>\%feature,_mirrors=>[]},$class}sub prereqs {my$self=shift;$self->{prereqs}}sub features {my$self=shift;if (%{$self->{features}}){return$self->{features}}return}sub _feature_prereqs {my ($self,$ids)=@_;my@prereqs;for my$id (@{$ids || []}){my$feature=$self->{features}{$id};next if!$feature ||!$feature->{prereqs};push@prereqs,$feature->{prereqs}}@prereqs}sub effective_requirements {my ($self,$feature_ids,$phases,$types)=@_;my%req;for my$prereqs ($self->{prereqs},$self->_feature_prereqs($feature_ids)){$prereqs->walk($phases,$types,sub {my (undef,undef,$package,$options)=@_;if (exists$req{$package}){my$v1=$req{$package}{version}|| 0;my$v2=$options->{version}|| 0;my$version=merge_version$v1,$v2;$req{$package}= +{%{$req{$package}},%$options,$version ? (version=>$version): (),}}else {$req{$package}=$options}})}\%req}sub to_string {my$self=shift;my@out;push@out,$self->prereqs->to_string;if (my$features=$self->features){push@out,"features:";for my$id (sort keys %$features){my$feature=$features->{$id};push@out," $id:";if (my$desc=$feature->{description}){push@out,_yaml_hash({description=>$desc }," ")}if (my$prereqs=$feature->{prereqs}){push@out,$prereqs->to_string(" ")}}}(join "\n",@out)."\n"}1; MODULE_CPMFILE $fatpacked{"Module/cpmfile/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPMFILE_PREREQS'; package Module::cpmfile::Prereqs;use strict;use warnings;use CPAN::Meta::Prereqs;use Module::cpmfile::Util '_yaml_hash';use Scalar::Util 'blessed';my@PHASE=qw(runtime configure build test develop);my@TYPE=qw(requires recommends suggests);sub new {my$class=shift;my$hash=shift || +{};my$self= +{};for my$phase (@PHASE){for my$type (@TYPE){next if!$hash->{$phase}||!$hash->{$phase}{$type};for my$package (sort keys %{$hash->{$phase}{$type}}){$self->{$phase}{$type}{$package}=$hash->{$phase}{$type}{$package}|| +{}}}}bless$self,$class}sub from_cpanmeta {my ($class,$cpanmeta)=@_;my$hash=$cpanmeta;if (blessed$cpanmeta and $cpanmeta->isa('CPAN::Meta::Prereqs')){$hash=$cpanmeta->as_string_hash}my$out={};for my$phase (sort keys %$hash){for my$type (sort keys %{$hash->{$phase}}){for my$package (sort keys %{$hash->{$phase}{$type}}){my$version=$hash->{$phase}{$type}{$package};my$options= +{$version ? (version=>$version): ()};$out->{$phase}{$type}{$package}=$options}}}$class->new($out)}sub cpanmeta {my$self=shift;my$hash= +{};for my$phase (sort keys %$self){for my$type (sort keys %{$self->{$phase}}){for my$package (sort keys %{$self->{$phase}{$type}}){my$options=$self->{$phase}{$type}{$package};$hash->{$phase}{$type}{$package}=$options->{version}|| 0}}}CPAN::Meta::Prereqs->new($hash)}sub walk {my ($self,$phases,$types,$cb)=@_;$phases ||= \@PHASE;$types ||= \@TYPE;for my$phase (@$phases){for my$type (@$types){next if!$self->{$phase}||!$self->{$phase}{$type};for my$package (sort keys %{$self->{$phase}{$type}}){my$options=$self->{$phase}{$type}{$package};my$ret=$cb->($phase,$type,$package,$options);return if ref($ret)eq 'SCALAR' &&!$$ret}}}}sub to_string {my$self=shift;my$indent=shift || "";my@out;push@out,"prereqs:";for my$phase (@PHASE){my$spec1=$self->{$phase}or next;push@out," $phase:";for my$type (@TYPE){my$spec2=$spec1->{$type}or next;push@out," $type:";for my$package (sort keys %{$spec2}){if (my%option=%{$spec2->{$package}|| +{}}){my@key=keys%option;if (@key==1 && $key[0]eq "version"){push@out," $package: { version: '$option{version}' }"}else {push@out," $package:";push@out,_yaml_hash(\%option," ")}}else {push@out," $package:"}}}}join "\n",map {"$indent$_"}@out}1; MODULE_CPMFILE_PREREQS $fatpacked{"Module/cpmfile/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPMFILE_UTIL'; package Module::cpmfile::Util;use strict;use warnings;use CPAN::Meta::Requirements;use Exporter 'import';our@EXPORT_OK=qw(merge_version _yaml_hash);my$TEST_PACKAGE='__TEST_PACKAGE__';sub merge_version {my ($v1,$v2)=@_;my$r=CPAN::Meta::Requirements->new;$r->add_string_requirement($TEST_PACKAGE,$v1)if defined$v1;$r->add_string_requirement($TEST_PACKAGE,$v2)if defined$v2;$r->requirements_for_module($TEST_PACKAGE)}{my$YAML;sub _yaml_hash {my ($hash,$indent)=@_;$YAML ||= do {require YAML::PP;YAML::PP->new(header=>0)};my@string=split /\n/,$YAML->dump_string($hash);map {"$indent$_"}@string}}1; MODULE_CPMFILE_UTIL $fatpacked{"Parallel/Pipes.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARALLEL_PIPES'; package Parallel::Pipes;use 5.008001;use strict;use warnings;use IO::Handle;use IO::Select;use constant WIN32=>$^O eq 'MSWin32';our$VERSION='0.200';{package Parallel::Pipes::Impl;use Storable ();sub new {my ($class,%option)=@_;my$read_fh=delete$option{read_fh}or die;my$write_fh=delete$option{write_fh}or die;$write_fh->autoflush(1);bless {%option,read_fh=>$read_fh,write_fh=>$write_fh,buf=>'' },$class}sub read :method {my$self=shift;my$_size=$self->_read(4)or return;my$size=unpack 'I',$_size;my$freezed=$self->_read($size);Storable::thaw($freezed)}sub write :method {my ($self,$data)=@_;my$freezed=Storable::freeze({data=>$data});my$size=pack 'I',length($freezed);$self->_write("$size$freezed")}sub _read {my ($self,$size)=@_;my$fh=$self->{read_fh};my$offset=length$self->{buf};while ($offset < $size){my$len=sysread$fh,$self->{buf},65536,$offset;if (!defined$len){die $!}elsif ($len==0){last}else {$offset += $len}}return substr$self->{buf},0,$size,''}sub _write {my ($self,$data)=@_;my$fh=$self->{write_fh};my$size=length$data;my$offset=0;while ($size){my$len=syswrite$fh,$data,$size,$offset;if (!defined$len){die $!}elsif ($len==0){last}else {$size -= $len;$offset += $len}}$size}}{package Parallel::Pipes::Here;our@ISA=qw(Parallel::Pipes::Impl);use Carp ();sub new {my ($class,%option)=@_;$class->SUPER::new(%option,_written=>0)}sub is_written {my$self=shift;$self->{_written}==1}sub read :method {my$self=shift;if (!$self->is_written){Carp::croak("This pipe has not been written; you cannot read it")}$self->{_written}--;return unless my$read=$self->SUPER::read;$read->{data}}sub write :method {my ($self,$task)=@_;if ($self->is_written){Carp::croak("This pipe has already been written; you must read it first")}$self->{_written}++;$self->SUPER::write($task)}}{package Parallel::Pipes::There;our@ISA=qw(Parallel::Pipes::Impl)}{package Parallel::Pipes::Impl::NoFork;use Carp ();sub new {my ($class,%option)=@_;bless {%option},$class}sub is_written {my$self=shift;exists$self->{_result}}sub read :method {my$self=shift;if (!$self->is_written){Carp::croak("This pipe has not been written; you cannot read it")}delete$self->{_result}}sub write :method {my ($self,$task)=@_;if ($self->is_written){Carp::croak("This pipe has already been written; you must read it first")}my$result=$self->{work}->($task);$self->{_result}=$result}}sub new {my ($class,$number,$work,$option)=@_;if (WIN32 and $number!=1){die "The number of pipes must be 1 under WIN32 environment.\n"}my$self=bless {work=>$work,number=>$number,no_fork=>$number==1,pipes=>{},option=>$option || {},},$class;if ($self->no_fork){$self->{pipes}{-1}=Parallel::Pipes::Impl::NoFork->new(pid=>-1,work=>$self->{work})}else {$self->_fork for 1 .. $number}$self}sub no_fork {shift->{no_fork}}sub _fork {my$self=shift;my$work=$self->{work};pipe my$read_fh1,my$write_fh1;pipe my$read_fh2,my$write_fh2;my$pid=fork;die "fork failed" unless defined$pid;if ($pid==0){srand;close $_ for$read_fh1,$write_fh2,map {($_->{read_fh},$_->{write_fh})}$self->pipes;my$there=Parallel::Pipes::There->new(read_fh=>$read_fh2,write_fh=>$write_fh1);while (my$read=$there->read){$there->write($work->($read->{data}))}exit}close $_ for$write_fh1,$read_fh2;$self->{pipes}{$pid}=Parallel::Pipes::Here->new(pid=>$pid,read_fh=>$read_fh1,write_fh=>$write_fh2,)}sub pipes {my$self=shift;map {$self->{pipes}{$_}}sort {$a <=> $b}keys %{$self->{pipes}}}sub is_ready {my$self=shift;return$self->pipes if$self->no_fork;my@pipes=@_ ? @_ : $self->pipes;if (my@ready=grep {$_->{_written}==0}@pipes){return@ready}my$select=IO::Select->new(map {$_->{read_fh}}@pipes);my@ready;if (my$tick=$self->{option}{idle_tick}){while (1){if (my@r=$select->can_read($tick)){@ready=@r,last}$self->{option}{idle_work}->()}}else {@ready=$select->can_read}my@return;for my$pipe (@pipes){if (grep {$pipe->{read_fh}==$_}@ready){push@return,$pipe}}return@return}sub is_written {my$self=shift;grep {$_->is_written}$self->pipes}sub close :method {my$self=shift;return if$self->no_fork;close $_ for map {($_->{write_fh},$_->{read_fh})}$self->pipes;while (%{$self->{pipes}}){my$pid=wait;if (delete$self->{pipes}{$pid}){}else {warn "wait() unexpectedly returns $pid\n"}}}1; PARALLEL_PIPES $fatpacked{"Parallel/Pipes/App.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARALLEL_PIPES_APP'; package Parallel::Pipes::App;use strict;use warnings;use Parallel::Pipes;our$VERSION='0.200';sub _min {$_[0]< $_[1]? $_[0]: $_[1]}sub run {my ($class,%argv)=@_;my$work=$argv{work}or die "need 'work' argument\n";my$num=$argv{num}or die "need 'num' argument\n";my$tasks=$argv{tasks}or die "need 'tasks' argument\n";my$before_work=$argv{before_work};my$after_work=$argv{after_work};my$init_work=$argv{init_work};my$idle_tick=$argv{idle_tick};my$idle_work=$argv{idle_work};my$pipes=Parallel::Pipes->new($num,$work,$idle_tick ? {idle_tick=>$idle_tick,idle_work=>$idle_work }: (),);$init_work->($pipes)if$init_work;while (1){my@ready=$pipes->is_ready;if (my@written=grep {$_->is_written}@ready){for my$written (@written){my$result=$written->read;$after_work->($result,$written)if$after_work}}if (@$tasks){my$min=_min $#{$tasks},$#ready;for my$i (0 .. $min){my$task=shift @$tasks;$before_work->($task,$ready[$i])if$before_work;$ready[$i]->write($task)}}else {if (@ready==$num){last}else {if (my@written=$pipes->is_written){my@ready=$pipes->is_ready(@written);for my$written (@ready){my$result=$written->read;$after_work->($result,$written)if$after_work}}else {die "unexpected"}}}}$pipes->close;1}sub map :method {my ($class,%argv)=@_;my$orig_num=$argv{num}or die "need 'num' argument\n";my$orig_tasks=$argv{tasks}or die "need 'tasks' argument\n";my$orig_work=$argv{work}or die "need 'work' argument\n";my@task=map {[$_,$orig_tasks->[$_]]}0..$#{$orig_tasks};my$work=sub {my ($index,$task)=@{$_[0]};my$result=$orig_work->($task);[$index,$result]};my@result;my$after_work=sub {my ($index,$result)=@{$_[0]};$result[$index]=$result};$class->run(num=>$orig_num,work=>$work,tasks=>\@task,after_work=>$after_work);@result}1; PARALLEL_PIPES_APP $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.47';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;my$eval=qq{ local(\$^W) = 0; Parse::PMFile::_parse_version_safely("$pmcp"); };unless ($self->{UNSAFE}|| $UNSAFE){$comp=Safe->new;$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=$comp ? $comp->reval($eval): eval$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=$comp ? $comp->reval($vstr): eval$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 if ($comp);$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;my$package_or_class='package';my$checked_bom;PLINE: while (<$fh>){chomp;my($pline)=$_;$pline =~ s/\A(?:\x00\x00\xfe\xff|\xff\xfe\x00\x00|\xfe\xff|\xff\xfe|\xef\xbb\xbf)// unless$checked_bom;$checked_bom=1;$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}if ($pline =~ /^[\s\{;]*use\s+(?:feature|experimental)\s+[^;]+\b(?:class|all)[^;]*;/){$package_or_class='package|class'}if ($pline =~ /^[\s\{;]*use\s+(?:Feature::Compat::Class)[^;]*;/){$package_or_class='package|class'}if ($pline =~ /^[\s\{;]*use\s+(?:Object::Pad)[^;]*;/){$package_or_class='package|class|role'}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;$ppp->{$pkg}{version}.= ""}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{"Proc/ForkSafe.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROC_FORKSAFE'; package Proc::ForkSafe;use strict;use warnings;our$VERSION='0.001';sub wrap {my ($class,$new,$destroy)=@_;my$obj=$new->();bless {pid=>$$,obj=>$obj,new=>$new,destroy=>$destroy },$class}sub call {my ($self,$method,@argv)=@_;if ($self->{pid}!=$$){$self->{destroy}->($self->{obj})if$self->{destroy};undef$self->{obj};$self->{obj}=$self->{new}->();$self->{pid}=$$}$self->{obj}->$method(@argv)}1; PROC_FORKSAFE $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;use warnings;require 5.006;our$VERSION="3.31";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{"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{"YAML/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP'; use strict;use warnings;package YAML::PP;our$VERSION='v0.38.0';use YAML::PP::Schema;use YAML::PP::Schema::JSON;use YAML::PP::Loader;use YAML::PP::Dumper;use Scalar::Util qw/blessed/;use Carp qw/croak/;use base 'Exporter';our@EXPORT_OK=qw/Load LoadFile Dump DumpFile/;my%YAML_VERSIONS=('1.1'=>1,'1.2'=>1);sub new {my ($class,%args)=@_;my$bool=delete$args{boolean};$bool='perl' unless defined$bool;my$schemas=delete$args{schema}|| ['+'];my$cyclic_refs=delete$args{cyclic_refs}|| 'fatal';my$indent=delete$args{indent};my$width=delete$args{width};my$writer=delete$args{writer};my$header=delete$args{header};my$footer=delete$args{footer};my$duplicate_keys=delete$args{duplicate_keys};my$yaml_version=$class->_arg_yaml_version(delete$args{yaml_version});my$default_yaml_version=$yaml_version->[0];my$version_directive=delete$args{version_directive};my$preserve=delete$args{preserve};my$parser=delete$args{parser};my$emitter=delete$args{emitter}|| {indent=>$indent,width=>$width,writer=>$writer,};if (keys%args){die "Unexpected arguments: " .join ', ',sort keys%args}my%schemas;for my$v (@$yaml_version){my$schema;if (blessed($schemas)and $schemas->isa('YAML::PP::Schema')){$schema=$schemas}else {$schema=YAML::PP::Schema->new(boolean=>$bool,yaml_version=>$v,);$schema->load_subschemas(@$schemas)}$schemas{$v }=$schema}my$default_schema=$schemas{$default_yaml_version };my$loader=YAML::PP::Loader->new(schemas=>\%schemas,cyclic_refs=>$cyclic_refs,parser=>$parser,default_yaml_version=>$default_yaml_version,preserve=>$preserve,duplicate_keys=>$duplicate_keys,);my$dumper=YAML::PP::Dumper->new(schema=>$default_schema,emitter=>$emitter,header=>$header,footer=>$footer,version_directive=>$version_directive,preserve=>$preserve,);my$self=bless {schema=>\%schemas,loader=>$loader,dumper=>$dumper,},$class;return$self}sub clone {my ($self)=@_;my$clone={schema=>$self->schema,loader=>$self->loader->clone,dumper=>$self->dumper->clone,};return bless$clone,ref$self}sub _arg_yaml_version {my ($class,$version)=@_;my@versions=('1.2');if (defined$version){@versions=();if (not ref$version){$version=[$version]}for my$v (@$version){unless ($YAML_VERSIONS{$v }){croak "YAML Version '$v' not supported"}push@versions,$v}}return \@versions}sub loader {if (@_ > 1){$_[0]->{loader}=$_[1]}return $_[0]->{loader}}sub dumper {if (@_ > 1){$_[0]->{dumper}=$_[1]}return $_[0]->{dumper}}sub schema {if (@_ > 1){$_[0]->{schema}->{'1.2'}=$_[1]}return $_[0]->{schema}->{'1.2'}}sub default_schema {my ($self,%args)=@_;my$schema=YAML::PP::Schema->new(boolean=>$args{boolean},);$schema->load_subschemas(qw/Core/);return$schema}sub load_string {my ($self,$yaml)=@_;return$self->loader->load_string($yaml)}sub load_file {my ($self,$file)=@_;return$self->loader->load_file($file)}sub dump {my ($self,@data)=@_;return$self->dumper->dump(@data)}sub dump_string {my ($self,@data)=@_;return$self->dumper->dump_string(@data)}sub dump_file {my ($self,$file,@data)=@_;return$self->dumper->dump_file($file,@data)}sub Load {my ($yaml)=@_;YAML::PP->new->load_string($yaml)}sub LoadFile {my ($file)=@_;YAML::PP->new->load_file($file)}sub Dump {my (@data)=@_;YAML::PP->new->dump_string(@data)}sub DumpFile {my ($file,@data)=@_;YAML::PP->new->dump_file($file,@data)}sub preserved_scalar {my ($self,$value,%args)=@_;my$scalar=YAML::PP::Preserve::Scalar->new(value=>$value,%args,);return$scalar}sub preserved_mapping {my ($self,$hash,%args)=@_;my$data={};tie %$data,'YAML::PP::Preserve::Hash';%$data=%$hash;my$t=tied %$data;$t->{style}=$args{style};$t->{alias}=$args{alias};return$data}sub preserved_sequence {my ($self,$array,%args)=@_;my$data=[];tie @$data,'YAML::PP::Preserve::Array';push @$data,@$array;my$t=tied @$data;$t->{style}=$args{style};$t->{alias}=$args{alias};return$data}package YAML::PP::Preserve::Hash;use Tie::Hash;use base qw/Tie::StdHash/;use Scalar::Util qw/reftype blessed/;sub TIEHASH {my ($class,%args)=@_;my$self=bless {keys=>[keys%args],data=>{%args },},$class}sub STORE {my ($self,$key,$val)=@_;my$keys=$self->{keys};unless (exists$self->{data}->{$key }){push @$keys,$key}if (ref$val and not blessed($val)){if (reftype($val)eq 'HASH' and not tied %$val){tie %$val,'YAML::PP::Preserve::Hash',%$val}elsif (reftype($val)eq 'ARRAY' and not tied @$val){tie @$val,'YAML::PP::Preserve::Array',@$val}}$self->{data}->{$key }=$val}sub FIRSTKEY {my ($self)=@_;return$self->{keys}->[0]}sub NEXTKEY {my ($self,$last)=@_;my$keys=$self->{keys};for my$i (0 .. $#$keys){if ("$keys->[ $i ]" eq "$last"){return$keys->[$i + 1 ]}}return}sub FETCH {my ($self,$key)=@_;my$val=$self->{data}->{$key }}sub DELETE {my ($self,$key)=@_;@{$self->{keys}}=grep {"$_" ne "$key"}@{$self->{keys}};delete$self->{data}->{$key }}sub EXISTS {my ($self,$key)=@_;return exists$self->{data}->{$key }}sub CLEAR {my ($self)=@_;$self->{keys}=[];$self->{data}={}}sub SCALAR {my ($self)=@_;return scalar %{$self->{data}}}package YAML::PP::Preserve::Array;use Tie::Array;use base qw/Tie::StdArray/;use Scalar::Util qw/reftype blessed/;sub TIEARRAY {my ($class,@items)=@_;my$self=bless {data=>[@items],},$class;return$self}sub FETCH {my ($self,$i)=@_;return$self->{data}->[$i ]}sub FETCHSIZE {my ($self)=@_;return $#{$self->{data}}+ 1}sub _preserve {my ($val)=@_;if (ref$val and not blessed($val)){if (reftype($val)eq 'HASH' and not tied %$val){tie %$val,'YAML::PP::Preserve::Hash',%$val}elsif (reftype($val)eq 'ARRAY' and not tied @$val){tie @$val,'YAML::PP::Preserve::Array',@$val}}return$val}sub STORE {my ($self,$i,$val)=@_;_preserve($val);$self->{data}->[$i ]=$val}sub PUSH {my ($self,@args)=@_;push @{$self->{data}},map {_preserve $_}@args}sub STORESIZE {my ($self,$i)=@_;$#{$self->{data}}=$i - 1}sub DELETE {my ($self,$i)=@_;delete$self->{data}->[$i ]}sub EXISTS {my ($self,$i)=@_;return exists$self->{data}->[$i ]}sub CLEAR {my ($self)=@_;$self->{data}=[]}sub SHIFT {my ($self)=@_;shift @{$self->{data}}}sub UNSHIFT {my ($self,@args)=@_;unshift @{$self->{data}},map {_preserve $_}@args}sub SPLICE {my ($self,$offset,$length,@args)=@_;splice @{$self->{data}},$offset,$length,map {_preserve $_}@args}sub EXTEND {}package YAML::PP::Preserve::Scalar;use overload fallback=>1,'+'=>\&value,'""'=>\&value,'bool'=>\&value,;sub new {my ($class,%args)=@_;my$self={%args,};bless$self,$class}sub value {$_[0]->{value}}sub tag {$_[0]->{tag}}sub style {$_[0]->{style}|| 0}sub alias {$_[0]->{alias}}1; YAML_PP $fatpacked{"YAML/PP/Common.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_COMMON'; use strict;use warnings;package YAML::PP::Common;our$VERSION='v0.38.0';use base 'Exporter';my@p=qw/PRESERVE_ALL PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS/;my@s=qw/YAML_ANY_SCALAR_STYLE YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE YAML_QUOTED_SCALAR_STYLE YAML_ANY_SEQUENCE_STYLE YAML_BLOCK_SEQUENCE_STYLE YAML_FLOW_SEQUENCE_STYLE YAML_ANY_MAPPING_STYLE YAML_BLOCK_MAPPING_STYLE YAML_FLOW_MAPPING_STYLE/;our@EXPORT_OK=(@s,@p);our%EXPORT_TAGS=(PRESERVE=>[@p],STYLES=>[@s],);use constant {YAML_ANY_SCALAR_STYLE=>0,YAML_PLAIN_SCALAR_STYLE=>1,YAML_SINGLE_QUOTED_SCALAR_STYLE=>2,YAML_DOUBLE_QUOTED_SCALAR_STYLE=>3,YAML_LITERAL_SCALAR_STYLE=>4,YAML_FOLDED_SCALAR_STYLE=>5,YAML_QUOTED_SCALAR_STYLE=>'Q',YAML_ANY_SEQUENCE_STYLE=>0,YAML_BLOCK_SEQUENCE_STYLE=>1,YAML_FLOW_SEQUENCE_STYLE=>2,YAML_ANY_MAPPING_STYLE=>0,YAML_BLOCK_MAPPING_STYLE=>1,YAML_FLOW_MAPPING_STYLE=>2,PRESERVE_ORDER=>2,PRESERVE_SCALAR_STYLE=>4,PRESERVE_FLOW_STYLE=>8,PRESERVE_ALIAS=>16,PRESERVE_ALL=>31,};my%scalar_style_to_string=(YAML_PLAIN_SCALAR_STYLE()=>':',YAML_SINGLE_QUOTED_SCALAR_STYLE()=>"'",YAML_DOUBLE_QUOTED_SCALAR_STYLE()=>'"',YAML_LITERAL_SCALAR_STYLE()=>'|',YAML_FOLDED_SCALAR_STYLE()=>'>',);sub event_to_test_suite {my ($event,$args)=@_;my$ev=$event->{name};my$string;my$content=$event->{value};my$properties='';$properties .= " &$event->{anchor}" if defined$event->{anchor};$properties .= " <$event->{tag}>" if defined$event->{tag};if ($ev eq 'document_start_event'){$string="+DOC";$string .= " ---" unless$event->{implicit}}elsif ($ev eq 'document_end_event'){$string="-DOC";$string .= " ..." unless$event->{implicit}}elsif ($ev eq 'stream_start_event'){$string="+STR"}elsif ($ev eq 'stream_end_event'){$string="-STR"}elsif ($ev eq 'mapping_start_event'){$string="+MAP";if ($event->{style}and $event->{style}eq YAML_FLOW_MAPPING_STYLE){$string .= ' {}' if$args->{flow}}$string .= $properties;if (0){}}elsif ($ev eq 'sequence_start_event'){$string="+SEQ";if ($event->{style}and $event->{style}eq YAML_FLOW_SEQUENCE_STYLE){$string .= ' []' if$args->{flow}}$string .= $properties;if (0){}}elsif ($ev eq 'mapping_end_event'){$string="-MAP"}elsif ($ev eq 'sequence_end_event'){$string="-SEQ"}elsif ($ev eq 'scalar_event'){$string='=VAL';$string .= $properties;$content =~ s/\\/\\\\/g;$content =~ s/\t/\\t/g;$content =~ s/\r/\\r/g;$content =~ s/\n/\\n/g;$content =~ s/[\b]/\\b/g;$string .= ' ' .$scalar_style_to_string{$event->{style}}.$content}elsif ($ev eq 'alias_event'){$string="=ALI *$content"}return$string}sub test_suite_to_event {my ($str)=@_;my$event={};if ($str =~ s/^\+STR//){$event->{name}='stream_start_event'}elsif ($str =~ s/^\-STR//){$event->{name}='stream_end_event'}elsif ($str =~ s/^\+DOC//){$event->{name}='document_start_event';if ($str =~ s/^ ---//){$event->{implicit}=0}else {$event->{implicit}=1}}elsif ($str =~ s/^\-DOC//){$event->{name}='document_end_event';if ($str =~ s/^ \.\.\.//){$event->{implicit}=0}else {$event->{implicit}=1}}elsif ($str =~ s/^\+SEQ//){$event->{name}='sequence_start_event';if ($str =~ s/^ \&(\S+)//){$event->{anchor}=$1}if ($str =~ s/^ <(\S+)>//){$event->{tag}=$1}}elsif ($str =~ s/^\-SEQ//){$event->{name}='sequence_end_event'}elsif ($str =~ s/^\+MAP//){$event->{name}='mapping_start_event';if ($str =~ s/^ \&(\S+)//){$event->{anchor}=$1}if ($str =~ s/^ <(\S+)>//){$event->{tag}=$1}}elsif ($str =~ s/^\-MAP//){$event->{name}='mapping_end_event'}elsif ($str =~ s/^=VAL//){$event->{name}='scalar_event';if ($str =~ s/^ <(\S+)>//){$event->{tag}=$1}if ($str =~ s/^ [:'">|]//){$event->{style}=$1}if ($str =~ s/^(.*)//){$event->{value}=$1}}elsif ($str =~ s/^=ALI//){$event->{name}='alias_event';if ($str =~ s/^ \*(.*)//){$event->{value}=$1}}else {die "Could not parse event '$str'"}return$event}1; YAML_PP_COMMON $fatpacked{"YAML/PP/Constructor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_CONSTRUCTOR'; use strict;use warnings;package YAML::PP::Constructor;our$VERSION='v0.38.0';use YAML::PP;use YAML::PP::Common qw/PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS/;use Scalar::Util qw/reftype/;use Carp qw/croak/;use constant DEBUG=>($ENV{YAML_PP_LOAD_DEBUG}or $ENV{YAML_PP_LOAD_TRACE})? 1 : 0;use constant TRACE=>$ENV{YAML_PP_LOAD_TRACE}? 1 : 0;my%cyclic_refs=qw/allow 1 ignore 1 warn 1 fatal 1/;sub new {my ($class,%args)=@_;my$default_yaml_version=delete$args{default_yaml_version};my$duplicate_keys=delete$args{duplicate_keys};unless (defined$duplicate_keys){$duplicate_keys=0}my$preserve=delete$args{preserve}|| 0;if ($preserve==1){$preserve=PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS}my$cyclic_refs=delete$args{cyclic_refs}|| 'fatal';die "Invalid value for cyclic_refs: $cyclic_refs" unless$cyclic_refs{$cyclic_refs };my$schemas=delete$args{schemas};if (keys%args){die "Unexpected arguments: " .join ', ',sort keys%args}my$self=bless {default_yaml_version=>$default_yaml_version,schemas=>$schemas,cyclic_refs=>$cyclic_refs,preserve=>$preserve,duplicate_keys=>$duplicate_keys,},$class;$self->init;return$self}sub clone {my ($self)=@_;my$clone={schemas=>$self->{schemas},schema=>$self->{schema},default_yaml_version=>$self->{default_yaml_version},cyclic_refs=>$self->cyclic_refs,preserve=>$self->{preserve},};return bless$clone,ref$self}sub init {my ($self)=@_;$self->set_docs([]);$self->set_stack([]);$self->set_anchors({});$self->set_yaml_version($self->default_yaml_version);$self->set_schema($self->schemas->{$self->yaml_version })}sub docs {return $_[0]->{docs}}sub stack {return $_[0]->{stack}}sub anchors {return $_[0]->{anchors}}sub set_docs {$_[0]->{docs}=$_[1]}sub set_stack {$_[0]->{stack}=$_[1]}sub set_anchors {$_[0]->{anchors}=$_[1]}sub schemas {return $_[0]->{schemas}}sub schema {return $_[0]->{schema}}sub set_schema {$_[0]->{schema}=$_[1]}sub cyclic_refs {return $_[0]->{cyclic_refs}}sub set_cyclic_refs {$_[0]->{cyclic_refs}=$_[1]}sub yaml_version {return $_[0]->{yaml_version}}sub set_yaml_version {$_[0]->{yaml_version}=$_[1]}sub default_yaml_version {return $_[0]->{default_yaml_version}}sub preserve_order {return $_[0]->{preserve}& PRESERVE_ORDER}sub preserve_scalar_style {return $_[0]->{preserve}& PRESERVE_SCALAR_STYLE}sub preserve_flow_style {return $_[0]->{preserve}& PRESERVE_FLOW_STYLE}sub preserve_alias {return $_[0]->{preserve}& PRESERVE_ALIAS}sub duplicate_keys {return $_[0]->{duplicate_keys}}sub document_start_event {my ($self,$event)=@_;my$stack=$self->stack;if ($event->{version_directive}){my$version=$event->{version_directive};$version="$version->{major}.$version->{minor}";if ($self->{schemas}->{$version }){$self->set_yaml_version($version);$self->set_schema($self->schemas->{$version })}else {$self->set_yaml_version($self->default_yaml_version);$self->set_schema($self->schemas->{$self->default_yaml_version })}}my$ref=[];push @$stack,{type=>'document',ref=>$ref,data=>$ref,event=>$event }}sub document_end_event {my ($self,$event)=@_;my$stack=$self->stack;my$last=pop @$stack;$last->{type}eq 'document' or die "Expected mapping, but got $last->{type}";if (@$stack){die "Got unexpected end of document"}my$docs=$self->docs;push @$docs,$last->{ref}->[0];$self->set_anchors({});$self->set_stack([])}sub mapping_start_event {my ($self,$event)=@_;my ($data,$on_data)=$self->schema->create_mapping($self,$event);my$ref={type=>'mapping',ref=>[],data=>\$data,event=>$event,on_data=>$on_data,};my$stack=$self->stack;my$preserve_order=$self->preserve_order;my$preserve_style=$self->preserve_flow_style;my$preserve_alias=$self->preserve_alias;if (($preserve_order or $preserve_style or $preserve_alias)and not tied(%$data)){tie %$data,'YAML::PP::Preserve::Hash',%$data}if ($preserve_style){my$t=tied %$data;$t->{style}=$event->{style}}push @$stack,$ref;if (defined(my$anchor=$event->{anchor})){if ($preserve_alias){my$t=tied %$data;unless (exists$self->anchors->{$anchor }){$t->{alias}=$anchor}}$self->anchors->{$anchor }={data=>$ref->{data}}}}sub mapping_end_event {my ($self,$event)=@_;my$stack=$self->stack;my$last=pop @$stack;my ($ref,$data)=@{$last}{qw/ref data/};$last->{type}eq 'mapping' or die "Expected mapping, but got $last->{type}";my@merge_keys;my@ref;for (my$i=0;$i < @$ref;$i += 2){my$key=$ref->[$i ];if (ref$key eq 'YAML::PP::Type::MergeKey'){my$merge=$ref->[$i + 1 ];if ((reftype($merge)|| '')eq 'HASH'){push@merge_keys,$merge}elsif ((reftype($merge)|| '')eq 'ARRAY'){for my$item (@$merge){if ((reftype($item)|| '')eq 'HASH'){push@merge_keys,$item}else {die "Expected hash for merge key"}}}else {die "Expected hash or array for merge key"}}else {push@ref,$key,$ref->[$i + 1 ]}}for my$merge (@merge_keys){for my$key (keys %$merge){unless (exists $$data->{$key }){$$data->{$key }=$merge->{$key }}}}my$on_data=$last->{on_data}|| sub {my ($self,$hash,$items)=@_;my%seen;for (my$i=0;$i < @$items;$i += 2){my ($key,$value)=@$items[$i,$i + 1 ];$key='' unless defined$key;if (ref$key){$key=$self->stringify_complex($key)}if ($seen{$key }++ and not $self->duplicate_keys){croak "Duplicate key '$key'"}$$hash->{$key }=$value}};$on_data->($self,$data,\@ref);push @{$stack->[-1]->{ref}},$$data;if (defined(my$anchor=$last->{event}->{anchor})){$self->anchors->{$anchor }->{finished}=1}return}sub sequence_start_event {my ($self,$event)=@_;my ($data,$on_data)=$self->schema->create_sequence($self,$event);my$ref={type=>'sequence',ref=>[],data=>\$data,event=>$event,on_data=>$on_data,};my$stack=$self->stack;my$preserve_style=$self->preserve_flow_style;my$preserve_alias=$self->preserve_alias;if ($preserve_style or $preserve_alias and not tied(@$data)){tie @$data,'YAML::PP::Preserve::Array',@$data;my$t=tied @$data;$t->{style}=$event->{style}}push @$stack,$ref;if (defined(my$anchor=$event->{anchor})){if ($preserve_alias){my$t=tied @$data;unless (exists$self->anchors->{$anchor }){$t->{alias}=$anchor}}$self->anchors->{$anchor }={data=>$ref->{data}}}}sub sequence_end_event {my ($self,$event)=@_;my$stack=$self->stack;my$last=pop @$stack;$last->{type}eq 'sequence' or die "Expected mapping, but got $last->{type}";my ($ref,$data)=@{$last}{qw/ref data/};my$on_data=$last->{on_data}|| sub {my ($self,$array,$items)=@_;push @$$array,@$items};$on_data->($self,$data,$ref);push @{$stack->[-1]->{ref}},$$data;if (defined(my$anchor=$last->{event}->{anchor})){my$test=$self->anchors->{$anchor };$self->anchors->{$anchor }->{finished}=1}return}sub stream_start_event {}sub stream_end_event {}sub scalar_event {my ($self,$event)=@_;DEBUG and warn "CONTENT $event->{value} ($event->{style})\n";my$value=$self->schema->load_scalar($self,$event);my$last=$self->stack->[-1];my$preserve_alias=$self->preserve_alias;my$preserve_style=$self->preserve_scalar_style;if (($preserve_style or $preserve_alias)and not ref$value){my%args=(value=>$value,tag=>$event->{tag},);if ($preserve_style){$args{style}=$event->{style}}if ($preserve_alias and defined$event->{anchor}){my$anchor=$event->{anchor};unless (exists$self->anchors->{$anchor }){$args{alias}=$event->{anchor}}}$value=YAML::PP::Preserve::Scalar->new(%args)}if (defined (my$name=$event->{anchor})){$self->anchors->{$name }={data=>\$value,finished=>1 }}push @{$last->{ref}},$value}sub alias_event {my ($self,$event)=@_;my$value;my$name=$event->{value};if (my$anchor=$self->anchors->{$name }){unless ($anchor->{finished}){my$cyclic_refs=$self->cyclic_refs;if ($cyclic_refs ne 'allow'){if ($cyclic_refs eq 'fatal'){croak "Found cyclic ref for alias '$name'"}if ($cyclic_refs eq 'warn'){$anchor={data=>\undef };warn "Found cyclic ref for alias '$name'"}elsif ($cyclic_refs eq 'ignore'){$anchor={data=>\undef }}}}$value=$anchor->{data}}else {croak "No anchor defined for alias '$name'"}my$last=$self->stack->[-1];push @{$last->{ref}},$$value}sub stringify_complex {my ($self,$data)=@_;return$data if (ref$data eq 'YAML::PP::Preserve::Scalar' and ($self->preserve_scalar_style or $self->preserve_alias));require Data::Dumper;local$Data::Dumper::Quotekeys=0;local$Data::Dumper::Terse=1;local$Data::Dumper::Indent=0;local$Data::Dumper::Useqq=0;local$Data::Dumper::Sortkeys=1;my$string=Data::Dumper->Dump([$data],['data']);$string =~ s/^\$data = //;return$string}1; YAML_PP_CONSTRUCTOR $fatpacked{"YAML/PP/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_DUMPER'; use strict;use warnings;package YAML::PP::Dumper;our$VERSION='v0.38.0';use Scalar::Util qw/blessed refaddr reftype/;use YAML::PP;use YAML::PP::Emitter;use YAML::PP::Representer;use YAML::PP::Writer;use YAML::PP::Writer::File;use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE YAML_ANY_SCALAR_STYLE YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE YAML_BLOCK_MAPPING_STYLE YAML_BLOCK_SEQUENCE_STYLE/;sub new {my ($class,%args)=@_;my$header=delete$args{header};$header=1 unless defined$header;my$footer=delete$args{footer};$footer=0 unless defined$footer;my$version_directive=delete$args{version_directive};my$preserve=delete$args{preserve};my$schema=delete$args{schema}|| YAML::PP->default_schema(boolean=>'perl',);my$emitter=delete$args{emitter}|| YAML::PP::Emitter->new;unless (blessed($emitter)){$emitter=YAML::PP::Emitter->new(%$emitter)}if (keys%args){die "Unexpected arguments: " .join ', ',sort keys%args}my$self=bless {representer=>YAML::PP::Representer->new(schema=>$schema,preserve=>$preserve,),version_directive=>$version_directive,emitter=>$emitter,seen=>{},anchors=>{},anchor_num=>0,header=>$header,footer=>$footer,},$class;return$self}sub clone {my ($self)=@_;my$clone={representer=>$self->representer->clone,emitter=>$self->emitter->clone,version_directive=>$self->version_directive,seen=>{},anchors=>{},anchor_num=>0,header=>$self->header,footer=>$self->footer,};return bless$clone,ref$self}sub init {my ($self)=@_;$self->{seen}={};$self->{anchors}={};$self->{anchor_num}=0}sub emitter {return $_[0]->{emitter}}sub representer {return $_[0]->{representer}}sub set_representer {$_[0]->{representer}=$_[1]}sub header {return $_[0]->{header}}sub footer {return $_[0]->{footer}}sub version_directive {return $_[0]->{version_directive}}sub dump {my ($self,@docs)=@_;$self->emitter->init;$self->emitter->stream_start_event({});for my$i (0 .. $#docs){my$header_implicit=($i==0 and not $self->header);my%args=(implicit=>$header_implicit,);if ($self->version_directive){my ($major,$minor)=split m/\./,$self->representer->schema->yaml_version;$args{version_directive}={major=>$major,minor=>$minor }}$self->emitter->document_start_event(\%args);$self->init;$self->_check_references($docs[$i ]);$self->_dump_node($docs[$i ]);my$footer_implicit=(not $self->footer);$self->emitter->document_end_event({implicit=>$footer_implicit })}$self->emitter->stream_end_event({});my$output=$self->emitter->writer->output;$self->emitter->finish;return$output}sub _dump_node {my ($self,$value)=@_;my$node={value=>$value,};if (ref$value){my$seen=$self->{seen};my$refaddr=refaddr$value;if ($seen->{$refaddr }and $seen->{$refaddr }> 1){my$anchor=$self->{anchors}->{$refaddr };unless (defined$anchor){if ($self->representer->preserve_alias){if (ref$node->{value}eq 'YAML::PP::Preserve::Scalar'){if (defined$node->{value}->alias){$node->{anchor}=$node->{value}->alias;$self->{anchors}->{$refaddr }=$node->{value}->alias}}elsif (reftype$node->{value}eq 'HASH'){if (my$tied=tied %{$node->{value}}){if (defined$tied->{alias}){$node->{anchor}=$tied->{alias};$self->{anchors}->{$refaddr }=$node->{anchor}}}}elsif (reftype$node->{value}eq 'ARRAY'){if (my$tied=tied @{$node->{value}}){if (defined$tied->{alias}){$node->{anchor}=$tied->{alias};$self->{anchors}->{$refaddr }=$node->{anchor}}}}}unless (defined$node->{anchor}){my$num= ++$self->{anchor_num};$self->{anchors}->{$refaddr }=$num;$node->{anchor}=$num}}else {$node->{value}=$anchor;$self->_emit_node([alias=>$node ]);return}}}$node=$self->representer->represent_node($node);$self->_emit_node($node)}sub _emit_node {my ($self,$item)=@_;my ($type,$node,%args)=@$item;if ($type eq 'alias'){$self->emitter->alias_event({value=>$node->{value}});return}if ($type eq 'mapping'){my$style=$args{style}|| YAML_BLOCK_MAPPING_STYLE;if ($node->{items}and @{$node->{items}}==0){}$self->emitter->mapping_start_event({anchor=>$node->{anchor},style=>$style,tag=>$node->{tag},});for (@{$node->{items}}){$self->_dump_node($_)}$self->emitter->mapping_end_event;return}if ($type eq 'sequence'){my$style=$args{style}|| YAML_BLOCK_SEQUENCE_STYLE;if (@{$node->{items}}==0){}$self->emitter->sequence_start_event({anchor=>$node->{anchor},style=>$style,tag=>$node->{tag},});for (@{$node->{items}}){$self->_dump_node($_)}$self->emitter->sequence_end_event;return}$self->emitter->scalar_event({value=>$node->{items}->[0],style=>$node->{style},anchor=>$node->{anchor},tag=>$node->{tag},})}sub dump_string {my ($self,@docs)=@_;my$writer=YAML::PP::Writer->new;$self->emitter->set_writer($writer);my$output=$self->dump(@docs);return$output}sub dump_file {my ($self,$file,@docs)=@_;my$writer=YAML::PP::Writer::File->new(output=>$file);$self->emitter->set_writer($writer);my$output=$self->dump(@docs);return$output}my%_reftypes=(HASH=>1,ARRAY=>1,Regexp=>1,REGEXP=>1,CODE=>1,SCALAR=>1,REF=>1,GLOB=>1,);sub _check_references {my ($self,$doc)=@_;my$reftype=reftype$doc or return;my$seen=$self->{seen};if ($reftype eq 'SCALAR' and grep {ref$doc eq $_}@{$self->representer->schema->bool_class || []}){if (ref$doc eq 'boolean' or ref$doc eq 'JSON::PP::Boolean'){return}}if (++$seen->{refaddr$doc }> 1){return}unless ($_reftypes{$reftype }){die sprintf "Reference %s not implemented",$reftype}if ($reftype eq 'HASH'){$self->_check_references($doc->{$_ })for keys %$doc}elsif ($reftype eq 'ARRAY'){$self->_check_references($_)for @$doc}elsif ($reftype eq 'REF'){$self->_check_references($$doc)}}1; YAML_PP_DUMPER $fatpacked{"YAML/PP/Emitter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_EMITTER'; use strict;use warnings;package YAML::PP::Emitter;our$VERSION='v0.38.0';use Data::Dumper;use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE/;use constant DEBUG=>$ENV{YAML_PP_EMIT_DEBUG}? 1 : 0;use constant DEFAULT_WIDTH=>80;sub new {my ($class,%args)=@_;my$self=bless {indent=>$args{indent}|| 2,writer=>$args{writer},width=>$args{width}|| DEFAULT_WIDTH,},$class;$self->init;return$self}sub clone {my ($self)=@_;my$clone={indent=>$self->indent,};return bless$clone,ref$self}sub event_stack {return $_[0]->{event_stack}}sub set_event_stack {$_[0]->{event_stack}=$_[1]}sub indent {return $_[0]->{indent}}sub width {return $_[0]->{width}}sub line {return $_[0]->{line}}sub column {return $_[0]->{column}}sub set_indent {$_[0]->{indent}=$_[1]}sub writer {$_[0]->{writer}}sub set_writer {$_[0]->{writer}=$_[1]}sub tagmap {return $_[0]->{tagmap}}sub set_tagmap {$_[0]->{tagmap}=$_[1]}sub init {my ($self)=@_;unless ($self->writer){$self->set_writer(YAML::PP::Writer->new)}$self->set_tagmap({'tag:yaml.org,2002:'=>'!!',});$self->{open_ended}=0;$self->{line}=0;$self->{column}=0;$self->writer->init}sub mapping_start_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_start_event\n";my ($self,$info)=@_;my$stack=$self->event_stack;my$last=$stack->[-1];my$indent=$last->{indent};my$new_indent=$indent;my$yaml='';my$props='';my$anchor=$info->{anchor};my$tag=$info->{tag};if (defined$anchor){$anchor="&$anchor"}if (defined$tag){$tag=$self->_emit_tag('map',$tag)}$props=join ' ',grep defined,($anchor,$tag);my$flow=$last->{flow}|| 0;$flow++ if ($info->{style}|| 0)eq YAML_FLOW_MAPPING_STYLE;my$newline=0;if ($flow > 1){if ($last->{type}eq 'SEQ'){if ($last->{newline}){$yaml .= ' '}if ($last->{index}==0){$yaml .= "["}else {$yaml .= ","}}elsif ($last->{type}eq 'MAP'){if ($last->{newline}){$yaml .= ' '}if ($last->{index}==0){$yaml .= "{"}else {$yaml .= ","}}elsif ($last->{type}eq 'MAPVALUE'){if ($last->{index}==0){die "Should not happen (index 0 in MAPVALUE)"}$yaml .= ": "}if ($props){$yaml .= " $props "}$new_indent .= ' ' x $self->indent}else {if ($last->{type}eq 'DOC'){$newline=$last->{newline}}else {if ($last->{newline}){$yaml .= "\n";$last->{column}=0}if ($last->{type}eq 'MAPVALUE'){$new_indent .= ' ' x $self->indent;$newline=1}else {$new_indent=$indent;if (not $props and $self->indent==1){$new_indent .= ' ' x 2}else {$new_indent .= ' ' x $self->indent}if ($last->{column}){my$space=$self->indent > 1 ? ' ' x ($self->indent - 1): ' ';$yaml .= $space}else {$yaml .= $indent}if ($last->{type}eq 'SEQ'){$yaml .= '-'}elsif ($last->{type}eq 'MAP'){$yaml .= "?";$last->{type}='COMPLEX'}elsif ($last->{type}eq 'COMPLEXVALUE'){$yaml .= ":"}else {die "Should not happen ($last->{type} in mapping_start)"}$last->{column}=1}$last->{newline}=0}if ($props){$yaml .= $last->{column}? ' ' : $indent;$yaml .= $props;$newline=1}}$self->_write($yaml);my$new_info={index=>0,indent=>$new_indent,info=>$info,newline=>$newline,column=>$self->column,flow=>$flow,};$new_info->{type}='MAP';push @{$stack},$new_info;$last->{index}++;$self->{open_ended}=0}sub mapping_end_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_end_event\n";my ($self,$info)=@_;my$stack=$self->event_stack;my$last=pop @{$stack};if ($last->{index}==0){my$indent=$last->{indent};my$zero_indent=$last->{zero_indent};if ($last->{zero_indent}){$indent .= ' ' x $self->indent}if ($self->column){$self->_write(" {}\n")}else {$self->_write("$indent\{}\n")}}elsif ($last->{flow}){my$yaml="}";if ($last->{flow}==1){$yaml .= "\n"}$self->_write("$yaml")}$last=$stack->[-1];$last->{column}=$self->column;if ($last->{type}eq 'SEQ'){}elsif ($last->{type}eq 'MAP'){$last->{type}='MAPVALUE'}elsif ($last->{type}eq 'MAPVALUE'){$last->{type}='MAP'}elsif ($last->{type}eq 'COMPLEX'){$last->{type}='COMPLEXVALUE'}elsif ($last->{type}eq 'COMPLEXVALUE'){$last->{type}='MAP'}}sub sequence_start_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_start_event\n";my ($self,$info)=@_;my$stack=$self->event_stack;my$last=$stack->[-1];my$indent=$last->{indent};my$new_indent=$indent;my$yaml='';my$props='';my$anchor=$info->{anchor};my$tag=$info->{tag};if (defined$anchor){$anchor="&$anchor"}if (defined$tag){$tag=$self->_emit_tag('seq',$tag)}$props=join ' ',grep defined,($anchor,$tag);my$flow=$last->{flow}|| 0;$flow++ if$flow or ($info->{style}|| 0)eq YAML_FLOW_SEQUENCE_STYLE;my$newline=0;my$zero_indent=0;if ($flow > 1){if ($last->{type}eq 'SEQ'){if ($last->{newline}){$yaml .= ' '}if ($last->{index}==0){$yaml .= "["}else {$yaml .= ","}}elsif ($last->{type}eq 'MAP'){if ($last->{newline}){$yaml .= ' '}if ($last->{index}==0){$yaml .= "{"}else {$yaml .= ","}}elsif ($last->{type}eq 'MAPVALUE'){if ($last->{index}==0){die "Should not happen (index 0 in MAPVALUE)"}$yaml .= ": "}if ($props){$yaml .= " $props "}$new_indent .= ' ' x $self->indent}else {if ($last->{type}eq 'DOC'){$newline=$last->{newline}}else {if ($last->{newline}){$yaml .= "\n";$last->{column}=0}if ($last->{type}eq 'MAPVALUE'){$zero_indent=1;$newline=1}else {if (not $props and $self->indent==1){$new_indent .= ' ' x 2}else {$new_indent .= ' ' x $self->indent}if ($last->{column}){my$space=$self->indent > 1 ? ' ' x ($self->indent - 1): ' ';$yaml .= $space}else {$yaml .= $indent}if ($last->{type}eq 'SEQ'){$yaml .= "-"}elsif ($last->{type}eq 'MAP'){$last->{type}='COMPLEX';$zero_indent=1;$yaml .= "?"}elsif ($last->{type}eq 'COMPLEXVALUE'){$yaml .= ":";$zero_indent=1}else {die "Should not happen ($last->{type} in sequence_start)"}$last->{column}=1}$last->{newline}=0}if ($props){$yaml .= $last->{column}? ' ' : $indent;$yaml .= $props;$newline=1}}$self->_write($yaml);$last->{index}++;my$new_info={index=>0,indent=>$new_indent,info=>$info,zero_indent=>$zero_indent,newline=>$newline,column=>$self->column,flow=>$flow,};$new_info->{type}='SEQ';push @{$stack},$new_info;$self->{open_ended}=0}sub sequence_end_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_end_event\n";my ($self,$info)=@_;my$stack=$self->event_stack;my$last=pop @{$stack};if ($last->{index}==0){my$indent=$last->{indent};my$zero_indent=$last->{zero_indent};if ($last->{zero_indent}){$indent .= ' ' x $self->indent}my$yaml .= $self->column ? ' ' : $indent;$yaml .= "[]";if ($last->{flow}< 2){$yaml .= "\n"}$self->_write($yaml)}elsif ($last->{flow}){my$yaml="]";if ($last->{flow}==1){$yaml .= "\n"}$self->_write($yaml)}$last=$stack->[-1];$last->{column}=$self->column;if ($last->{type}eq 'SEQ'){}elsif ($last->{type}eq 'MAP'){$last->{type}='MAPVALUE'}elsif ($last->{type}eq 'MAPVALUE'){$last->{type}='MAP'}elsif ($last->{type}eq 'COMPLEX'){$last->{type}='COMPLEXVALUE'}elsif ($last->{type}eq 'COMPLEXVALUE'){$last->{type}='MAP'}}my%forbidden_first=(qw/! 1 & 1 * 1 { 1 } 1 [ 1 ] 1 | 1 > 1 @ 1 ` 1 " 1 ' 1/,'#'=>1,'%'=>1,','=>1," "=>1);my%forbidden_first_plus_space=(qw/? 1 - 1 : 1/);my%control=("\x00"=>'\0',"\x01"=>'\x01',"\x02"=>'\x02',"\x03"=>'\x03',"\x04"=>'\x04',"\x05"=>'\x05',"\x06"=>'\x06',"\x07"=>'\a',"\x08"=>'\b',"\x0b"=>'\v',"\x0c"=>'\f',"\x0e"=>'\x0e',"\x0f"=>'\x0f',"\x10"=>'\x10',"\x11"=>'\x11',"\x12"=>'\x12',"\x13"=>'\x13',"\x14"=>'\x14',"\x15"=>'\x15',"\x16"=>'\x16',"\x17"=>'\x17',"\x18"=>'\x18',"\x19"=>'\x19',"\x1a"=>'\x1a',"\x1b"=>'\e',"\x1c"=>'\x1c',"\x1d"=>'\x1d',"\x1e"=>'\x1e',"\x1f"=>'\x1f',"\x7f"=>'\x7f',"\x80"=>'\x80',"\x81"=>'\x81',"\x82"=>'\x82',"\x83"=>'\x83',"\x84"=>'\x84',"\x86"=>'\x86',"\x87"=>'\x87',"\x88"=>'\x88',"\x89"=>'\x89',"\x8a"=>'\x8a',"\x8b"=>'\x8b',"\x8c"=>'\x8c',"\x8d"=>'\x8d',"\x8e"=>'\x8e',"\x8f"=>'\x8f',"\x90"=>'\x90',"\x91"=>'\x91',"\x92"=>'\x92',"\x93"=>'\x93',"\x94"=>'\x94',"\x95"=>'\x95',"\x96"=>'\x96',"\x97"=>'\x97',"\x98"=>'\x98',"\x99"=>'\x99',"\x9a"=>'\x9a',"\x9b"=>'\x9b',"\x9c"=>'\x9c',"\x9d"=>'\x9d',"\x9e"=>'\x9e',"\x9f"=>'\x9f',"\x{2029}"=>'\P',"\x{2028}"=>'\L',"\x85"=>'\N',"\xa0"=>'\_',);my$control_re='\x00-\x08\x0b\x0c\x0e-\x1f\x7f-\x84\x86-\x9f\x{d800}-\x{dfff}\x{fffe}\x{ffff}\x{2028}\x{2029}\x85\xa0';my%to_escape=("\n"=>'\n',"\t"=>'\t',"\r"=>'\r','\\'=>'\\\\','"'=>'\\"',%control,);my$escape_re=$control_re .'\n\t\r';my$escape_re_without_lb=$control_re .'\t\r';sub scalar_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ scalar_event\n";my ($self,$info)=@_;my$stack=$self->event_stack;my$last=$stack->[-1];my$indent=$last->{indent};my$value=$info->{value};my$flow=$last->{flow};my$props='';my$anchor=$info->{anchor};my$tag=$info->{tag};if (defined$anchor){$anchor="&$anchor"}if (defined$tag){$tag=$self->_emit_tag('scalar',$tag)}$props=join ' ',grep defined,($anchor,$tag);DEBUG and local$Data::Dumper::Useqq=1;$value='' unless defined$value;my$style=$self->_find_best_scalar_style(info=>$info,value=>$value,);my$open_ended=0;if ($style==YAML_PLAIN_SCALAR_STYLE){$value =~ s/\n/\n\n/g}elsif ($style==YAML_SINGLE_QUOTED_SCALAR_STYLE){my$new_indent=$last->{indent}.(' ' x $self->indent);$value =~ s/(\n+)/"\n" x (1 + (length $1))/eg;my@lines=split m/\n/,$value,-1;if (@lines > 1){for my$line (@lines[1 .. $#lines]){$line=$new_indent .$line if length$line}}$value=join "\n",@lines;$value =~ s/'/''/g;$value="'" .$value ."'"}elsif ($style==YAML_LITERAL_SCALAR_STYLE){DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value],['value']);my$indicators='';if ($value =~ m/\A\n* +/){$indicators .= $self->indent}my$indent=$indent .' ' x $self->indent;if ($value !~ m/\n\z/){$indicators .= '-';$value .= "\n"}elsif ($value =~ m/(\n|\A)\n\z/){$indicators .= '+';$open_ended=1}$value =~ s/^(?=.)/$indent/gm;$value="|$indicators\n$value"}elsif ($style==YAML_FOLDED_SCALAR_STYLE){DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value],['value']);my@lines=split /\n/,$value,-1;DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\@lines],['lines']);my$trailing=-1;while (@lines){last if$lines[-1]ne '';pop@lines;$trailing++}my%start_with_space;for my$i (0 .. $#lines){if ($lines[$i ]=~ m/^[ \t]+/){$start_with_space{$i }=1}}my$indicators='';if ($value =~ m/\A\n* +/){$indicators .= $self->indent}my$indent=$indent .' ' x $self->indent;if ($trailing > 0){$indicators .= '+';$open_ended=1}elsif ($trailing < 0){$indicators .= '-'}$value=">$indicators\n";my$got_content=0;for my$i (0 .. $#lines){my$line=$lines[$i ];my$sp=$start_with_space{$i }|| 0;my$spnext=$i==$#lines ? 1 : $start_with_space{$i+1 }|| 0;my$spprev=$i==0 ? 1 : $start_with_space{$i-1 }|| 0;my$empty=length$line ? 0 : 1;my$emptynext=$i==$#lines ? '' : length$lines[$i+1]? 0 : 1;my$nl=0;if ($empty){if ($spnext and $spprev){$nl=1}elsif (not $spnext){$nl=1}elsif (not $got_content){$nl=1}}else {$got_content=1;$value .= "$indent$line\n";if (not $sp and not $spnext){$nl=1}}if ($nl){$value .= "\n"}}$value .= "\n" x ($trailing)if$trailing > 0}else {$value =~ s/([$escape_re"\\])/$to_escape{ $1 } || sprintf '\\u%04x', ord($1)/eg;$value='"' .$value .'"'}DEBUG and warn __PACKAGE__.':'.__LINE__.": (@$stack)\n";my$yaml=$self->_emit_scalar(indent=>$indent,props=>$props,value=>$value,style=>$style,);$last->{index}++;$last->{newline}=0;$self->_write($yaml);$last->{column}=$self->column;$self->{open_ended}=$open_ended}sub _find_best_scalar_style {my ($self,%args)=@_;my$info=$args{info};my$style=$info->{style};my$value=$args{value};my$stack=$self->event_stack;my$last=$stack->[-1];my$flow=$last->{flow};my$first=substr($value,0,1);if ($value eq ''){if ($flow and $last->{type}ne 'MAPVALUE' and $last->{type}ne 'MAP'){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif (not $style){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}}elsif ($value =~ m/[$control_re]/){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}$style ||= YAML_PLAIN_SCALAR_STYLE;if ($style==YAML_SINGLE_QUOTED_SCALAR_STYLE){if ($value =~ m/ \n/ or $value =~ m/\n / or $value =~ m/^\n/ or $value =~ m/\n$/){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}elsif ($value eq "\n"){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}}elsif ($style==YAML_LITERAL_SCALAR_STYLE or $style==YAML_FOLDED_SCALAR_STYLE){if ($value eq ''){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}elsif ($flow){if ($value =~ tr/\n//){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}else {$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}}}elsif ($style==YAML_PLAIN_SCALAR_STYLE){if (not length$value){}elsif ($value =~ m/[$escape_re_without_lb]/){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}elsif ($value eq "\n"){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}elsif ($value !~ tr/ //c){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif ($value !~ tr/ \n//c){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}elsif ($value =~ tr/\n//){$style=$flow ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_LITERAL_SCALAR_STYLE}elsif ($forbidden_first{$first }){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif ($flow and $value =~ tr/,[]{}//){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif (substr($value,0,3)=~ m/^(?:---|\.\.\.)/){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif ($value =~ m/: /){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif ($value =~ m/ #/){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif ($value =~ m/[: \t]\z/){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif ($value =~ m/[^\x20-\x3A\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]/){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}elsif ($forbidden_first_plus_space{$first }){if (length ($value)==1 or substr($value,1,1)=~ m/^\s/){$style=YAML_SINGLE_QUOTED_SCALAR_STYLE}}}if ($style==YAML_SINGLE_QUOTED_SCALAR_STYLE and not $info->{style}){if ($value =~ tr/'// and $value !~ tr/"//){$style=YAML_DOUBLE_QUOTED_SCALAR_STYLE}}return$style}sub _emit_scalar {my ($self,%args)=@_;my$props=$args{props};my$value=$args{value};my$style=$args{style};my$stack=$self->event_stack;my$last=$stack->[-1];my$flow=$last->{flow};my$yaml='';my$pvalue=$props;if ($props and length$value){$pvalue .= " $value"}elsif (length$value){$pvalue .= $value}if ($flow){if ($props and not length$value){$pvalue .= ' '}$yaml=$self->_emit_flow_scalar(value=>$value,pvalue=>$pvalue,style=>$args{style},)}else {$yaml=$self->_emit_block_scalar(props=>$props,value=>$value,pvalue=>$pvalue,indent=>$args{indent},style=>$args{style},)}return$yaml}sub _emit_block_scalar {my ($self,%args)=@_;my$props=$args{props};my$value=$args{value};my$pvalue=$args{pvalue};my$indent=$args{indent};my$style=$args{style};my$stack=$self->event_stack;my$last=$stack->[-1];my$yaml;if ($last->{type}eq 'MAP' or $last->{type}eq 'SEQ'){if ($last->{index}==0 and $last->{newline}){$yaml .= "\n";$last->{column}=0;$last->{newline}=0}}my$space=' ';my$multiline=($style==YAML_LITERAL_SCALAR_STYLE or $style==YAML_FOLDED_SCALAR_STYLE);if ($last->{type}eq 'MAP'){if ($last->{column}){my$space=$self->indent > 1 ? ' ' x ($self->indent - 1): ' ';$yaml .= $space}else {$yaml .= $indent}if ($props and not length$value){$pvalue .= ' '}$last->{type}='MAPVALUE';if ($multiline){$yaml .= "? ";$last->{type}='COMPLEXVALUE'}if (not $multiline){$pvalue .= ":"}}else {if ($last->{type}eq 'MAPVALUE'){$last->{type}='MAP'}elsif ($last->{type}eq 'DOC'){}else {if ($last->{column}){my$space=$self->indent > 1 ? ' ' x ($self->indent - 1): ' ';$yaml .= $space}else {$yaml .= $indent}if ($last->{type}eq 'COMPLEXVALUE'){$last->{type}='MAP';$yaml .= ":"}elsif ($last->{type}eq 'SEQ'){$yaml .= "-"}else {die "Should not happen ($last->{type} in scalar_event)"}$last->{column}=1}if (length$pvalue){if ($last->{column}){$pvalue="$space$pvalue"}}if (not $multiline){$pvalue .= "\n"}}$yaml .= $pvalue;return$yaml}sub _emit_flow_scalar {my ($self,%args)=@_;my$value=$args{value};my$pvalue=$args{pvalue};my$stack=$self->event_stack;my$last=$stack->[-1];my$yaml;if ($last->{type}eq 'SEQ'){if ($last->{index}==0){if ($self->column){$yaml .= ' '}$yaml .= "["}else {$yaml .= ", "}}elsif ($last->{type}eq 'MAP'){if ($last->{index}==0){if ($self->column){$yaml .= ' '}$yaml .= "{"}else {$yaml .= ", "}$last->{type}='MAPVALUE'}elsif ($last->{type}eq 'MAPVALUE'){if ($last->{index}==0){die "Should not happen (index 0 in MAPVALUE)"}$yaml .= ": ";$last->{type}='MAP'}if ($self->column + length$pvalue > $self->width){$yaml .= "\n";$yaml .= $last->{indent};$yaml .= ' ' x $self->indent}$yaml .= $pvalue;return$yaml}sub alias_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ alias_event\n";my ($self,$info)=@_;my$stack=$self->event_stack;my$last=$stack->[-1];my$indent=$last->{indent};my$flow=$last->{flow};my$alias='*' .$info->{value};my$yaml='';if ($last->{type}eq 'MAP' or $last->{type}eq 'SEQ'){if ($last->{index}==0 and $last->{newline}){$yaml .= "\n";$last->{column}=0;$last->{newline}=0}}$yaml .= $last->{column}? ' ' : $indent;if ($flow){my$space='';if ($last->{type}eq 'SEQ'){if ($last->{index}==0){if ($flow==1){$yaml .= ' '}$yaml .= "["}else {$yaml .= ", "}}elsif ($last->{type}eq 'MAP'){if ($last->{index}==0){if ($flow==1){$yaml .= ' '}$yaml .= "{"}else {$yaml .= ", "}$last->{type}='MAPVALUE';$space=' '}elsif ($last->{type}eq 'MAPVALUE'){if ($last->{index}==0){die 23;if ($flow==1){$yaml .= ' '}$yaml .= "{"}else {$yaml .= ": "}$last->{type}='MAP'}$yaml .= "$alias$space"}else {if ($last->{type}eq 'MAP'){$yaml .= "$alias :";$last->{type}='MAPVALUE'}else {if ($last->{type}eq 'MAPVALUE'){$last->{type}='MAP'}elsif ($last->{type}eq 'DOC'){}else {if ($last->{type}eq 'COMPLEXVALUE'){$last->{type}='MAP';$yaml .= ": "}elsif ($last->{type}eq 'COMPLEX'){$yaml .= ": "}elsif ($last->{type}eq 'SEQ'){$yaml .= "- "}else {die "Unexpected"}}$yaml .= "$alias\n"}}$self->_write("$yaml");$last->{index}++;$last->{column}=$self->column;$self->{open_ended}=0}sub document_start_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_start_event\n";my ($self,$info)=@_;my$newline=0;my$implicit=$info->{implicit};if ($info->{version_directive}){if ($self->{open_ended}){$self->_write("...\n")}$self->_write("%YAML $info->{version_directive}->{major}.$info->{version_directive}->{minor}\n");$self->{open_ended}=0;$implicit=0}unless ($implicit){$newline=1;$self->_write("---")}$self->set_event_stack([{type=>'DOC',index=>0,indent=>'',info=>$info,newline=>$newline,column=>$self->column,}])}sub document_end_event {DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_end_event\n";my ($self,$info)=@_;$self->set_event_stack([]);if ($self->{open_ended}or not $info->{implicit}){$self->_write("...\n");$self->{open_ended}=0}else {$self->{open_ended}=1}}sub stream_start_event {}sub stream_end_event {}sub _emit_tag {my ($self,$type,$tag)=@_;my$map=$self->tagmap;for my$key (sort keys %$map){if ($tag =~ m/^\Q$key\E(.*)/){$tag=$map->{$key }.$1;return$tag}}if ($tag =~ m/^(!.*)/){$tag="$1"}else {$tag="!<$tag>"}return$tag}sub finish {my ($self)=@_;$self->writer->finish}sub _write {my ($self,$yaml)=@_;return unless length$yaml;my@lines=split m/\n/,$yaml,-1;my$newlines=@lines - 1;$self->{line}+= $newlines;if (length$lines[-1]){if ($newlines){$self->{column}=length$lines[-1]}else {$self->{column}+= length$lines[-1]}}else {$self->{column}=0}$self->writer->write($yaml)}1; YAML_PP_EMITTER $fatpacked{"YAML/PP/Exception.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_EXCEPTION'; use strict;use warnings;package YAML::PP::Exception;our$VERSION='v0.38.0';use overload '""'=>\&to_string;sub new {my ($class,%args)=@_;my$self=bless {line=>$args{line},msg=>$args{msg},next=>$args{next},where=>$args{where},yaml=>$args{yaml},got=>$args{got},expected=>$args{expected},column=>$args{column},},$class;return$self}sub to_string {my ($self)=@_;my$next=$self->{next};my$line=$self->{line};my$column=$self->{column};my$yaml='';for my$token (@$next){last if$token->{name}eq 'EOL';$yaml .= $token->{value}}$column='???' unless defined$column;my$remaining_yaml=$self->{yaml};$remaining_yaml='' unless defined$remaining_yaml;$yaml .= $remaining_yaml;{local $@;require Data::Dumper;local$Data::Dumper::Useqq=1;local$Data::Dumper::Terse=1;$yaml=Data::Dumper->Dump([$yaml],['yaml']);chomp$yaml}my$lines=5;my@fields;if ($self->{got}and $self->{expected}){$lines=6;$line=$self->{got}->{line};$column=$self->{got}->{column}+ 1;@fields=("Line"=>$line,"Column"=>$column,"Expected",join(" ",@{$self->{expected}}),"Got",$self->{got}->{name},"Where",$self->{where},"YAML",$yaml,)}else {@fields=("Line"=>$line,"Column"=>$column,"Message",$self->{msg},"Where",$self->{where},"YAML",$yaml,)}my$fmt=join "\n",("%-10s: %s")x $lines;my$string=sprintf$fmt,@fields;return$string}1; YAML_PP_EXCEPTION $fatpacked{"YAML/PP/Grammar.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_GRAMMAR'; use strict;use warnings;package YAML::PP::Grammar;our$VERSION='v0.38.0';use base 'Exporter';our@EXPORT_OK=qw/$GRAMMAR/;our$GRAMMAR={};$GRAMMAR={'DIRECTIVE'=>{'DOC_START'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_doc_start_explicit' },'EOL'=>{'new'=>'DIRECTIVE' },'RESERVED_DIRECTIVE'=>{'EOL'=>{'new'=>'DIRECTIVE' },'WS'=>{'new'=>'DIRECTIVE' },'match'=>'cb_reserved_directive' },'TAG_DIRECTIVE'=>{'EOL'=>{'new'=>'DIRECTIVE' },'WS'=>{'new'=>'DIRECTIVE' },'match'=>'cb_tag_directive' },'YAML_DIRECTIVE'=>{'EOL'=>{'new'=>'DIRECTIVE' },'WS'=>{'new'=>'DIRECTIVE' },'match'=>'cb_set_yaml_version_directive' }},'DOCUMENT_END'=>{'DOC_END'=>{'EOL'=>{},'match'=>'cb_end_document' },'DOC_START'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_end_doc_start_document' },'EOL'=>{'new'=>'DOCUMENT_END' }},'END_FLOW'=>{'EOL'=>{'match'=>'cb_end_outer_flow','return'=>1 }},'FLOWMAP'=>{'ANCHOR'=>{'DEFAULT'=>{'new'=>'NEWFLOWMAP_ANCHOR' },'EOL'=>{'new'=>'NEWFLOWMAP_ANCHOR_SPC' },'WS'=>{'new'=>'NEWFLOWMAP_ANCHOR_SPC' },'match'=>'cb_anchor' },'COLON'=>{'EOL'=>{'match'=>'cb_empty_flow_mapkey','new'=>'RULE_FULLFLOWSCALAR' },'WS'=>{'match'=>'cb_empty_flow_mapkey','new'=>'RULE_FULLFLOWSCALAR' }},'DEFAULT'=>{'new'=>'FLOWMAP_CONTENT' },'EOL'=>{'new'=>'FLOWMAP' },'FLOWMAP_END'=>{'match'=>'cb_end_flowmap','return'=>1 },'TAG'=>{'DEFAULT'=>{'new'=>'NEWFLOWMAP_TAG' },'EOL'=>{'new'=>'NEWFLOWMAP_TAG_SPC' },'WS'=>{'new'=>'NEWFLOWMAP_TAG_SPC' },'match'=>'cb_tag' },'WS'=>{'new'=>'FLOWMAP' }},'FLOWMAP_CONTENT'=>{'ALIAS'=>{'match'=>'cb_send_alias','return'=>1 },'COLON'=>{'EOL'=>{'match'=>'cb_empty_flow_mapkey','new'=>'RULE_FULLFLOWSCALAR' },'WS'=>{'match'=>'cb_empty_flow_mapkey','new'=>'RULE_FULLFLOWSCALAR' }},'FLOWMAP_START'=>{'match'=>'cb_start_flowmap','new'=>'NEWFLOWMAP' },'FLOWSEQ_START'=>{'match'=>'cb_start_flowseq','new'=>'NEWFLOWSEQ' },'PLAIN'=>{'match'=>'cb_flowkey_plain','return'=>1 },'PLAIN_MULTI'=>{'match'=>'cb_send_plain_multi','return'=>1 },'QUOTED'=>{'match'=>'cb_flowkey_quoted','return'=>1 },'QUOTED_MULTILINE'=>{'match'=>'cb_quoted_multiline','return'=>1 }},'FLOWMAP_EMPTYKEY'=>{'FLOWMAP_END'=>{'match'=>'cb_end_empty_flowmap_key_value','return'=>1 },'FLOW_COMMA'=>{'match'=>'cb_empty_flowmap_key_value','return'=>1 }},'FLOWMAP_EXPLICIT_KEY'=>{'DEFAULT'=>{'new'=>'FLOWMAP' },'EOL'=>{'new'=>'FLOWMAP_EXPLICIT_KEY' },'FLOWMAP_END'=>{'match'=>'cb_end_empty_flowmap_key_value','return'=>1 },'FLOW_COMMA'=>{'match'=>'cb_empty_flowmap_key_value','return'=>1 },'WS'=>{'new'=>'FLOWMAP_EXPLICIT_KEY' }},'FLOWMAP_PROPS'=>{'COLON'=>{'EOL'=>{'match'=>'cb_empty_flow_mapkey','new'=>'RULE_FULLFLOWSCALAR' },'WS'=>{'match'=>'cb_empty_flow_mapkey','new'=>'RULE_FULLFLOWSCALAR' }},'FLOWMAP_END'=>{'match'=>'cb_end_empty_flowmap_key_value','return'=>1 },'FLOWMAP_START'=>{'match'=>'cb_start_flowmap','new'=>'NEWFLOWMAP' },'FLOWSEQ_START'=>{'match'=>'cb_start_flowseq','new'=>'NEWFLOWSEQ' },'FLOW_COMMA'=>{'match'=>'cb_empty_flowmap_key_value','return'=>1 },'PLAIN'=>{'match'=>'cb_flowkey_plain','return'=>1 },'PLAIN_MULTI'=>{'match'=>'cb_send_plain_multi','return'=>1 },'QUOTED'=>{'match'=>'cb_flowkey_quoted','return'=>1 },'QUOTED_MULTILINE'=>{'match'=>'cb_quoted_multiline','return'=>1 }},'FLOWSEQ'=>{'ALIAS'=>{'match'=>'cb_send_flow_alias','new'=>'FLOWSEQ_NEXT' },'COLON'=>{'EOL'=>{'match'=>'cb_insert_empty_implicit_flowseq_map','new'=>'RULE_FULLFLOWSCALAR' },'WS'=>{'match'=>'cb_insert_empty_implicit_flowseq_map','new'=>'RULE_FULLFLOWSCALAR' }},'FLOWMAP_START'=>{'match'=>'cb_start_flowmap','new'=>'NEWFLOWMAP' },'FLOWSEQ_START'=>{'match'=>'cb_start_flowseq','new'=>'NEWFLOWSEQ' },'PLAIN'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_MAYBE_KEY' },'EOL'=>{'match'=>'cb_send_scalar','new'=>'FLOWSEQ_NEXT' },'match'=>'cb_start_plain' },'PLAIN_MULTI'=>{'match'=>'cb_send_plain_multi','new'=>'FLOWSEQ_NEXT' },'QUOTED'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_MAYBE_KEY' },'EOL'=>{'match'=>'cb_send_scalar','new'=>'FLOWSEQ_NEXT' },'match'=>'cb_take_quoted' },'QUOTED_MULTILINE'=>{'match'=>'cb_quoted_multiline','new'=>'FLOWSEQ_NEXT' }},'FLOWSEQ_EMPTY'=>{'FLOWSEQ_END'=>{'match'=>'cb_empty_flowseq_end','return'=>1 },'FLOW_COMMA'=>{'match'=>'cb_empty_flowseq_comma','return'=>1 }},'FLOWSEQ_MAYBE_KEY'=>{'COLON'=>{'DEFAULT'=>{'match'=>'cb_insert_implicit_flowseq_map','new'=>'RULE_FULLFLOWSCALAR' },'EOL'=>{'match'=>'cb_insert_implicit_flowseq_map','new'=>'RULE_FULLFLOWSCALAR' },'WS'=>{'match'=>'cb_insert_implicit_flowseq_map','new'=>'RULE_FULLFLOWSCALAR' }},'DEFAULT'=>{'new'=>'FLOWSEQ_NEXT' },'WS'=>{'new'=>'FLOWSEQ_MAYBE_KEY' }},'FLOWSEQ_NEXT'=>{'EOL'=>{'new'=>'FLOWSEQ_NEXT' },'FLOWSEQ_END'=>{'match'=>'cb_end_flowseq','return'=>1 },'FLOW_COMMA'=>{'match'=>'cb_flow_comma','return'=>1 },'WS'=>{'new'=>'FLOWSEQ_NEXT' }},'FLOWSEQ_PROPS'=>{'COLON'=>{'EOL'=>{'match'=>'cb_insert_empty_implicit_flowseq_map','new'=>'RULE_FULLFLOWSCALAR' },'WS'=>{'match'=>'cb_insert_empty_implicit_flowseq_map','new'=>'RULE_FULLFLOWSCALAR' }},'FLOWMAP_START'=>{'match'=>'cb_start_flowmap','new'=>'NEWFLOWMAP' },'FLOWSEQ_END'=>{'match'=>'cb_empty_flowseq_end','return'=>1 },'FLOWSEQ_START'=>{'match'=>'cb_start_flowseq','new'=>'NEWFLOWSEQ' },'FLOW_COMMA'=>{'match'=>'cb_empty_flowseq_comma','return'=>1 },'PLAIN'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_MAYBE_KEY' },'EOL'=>{'match'=>'cb_send_scalar','new'=>'FLOWSEQ_NEXT' },'match'=>'cb_start_plain' },'PLAIN_MULTI'=>{'match'=>'cb_send_plain_multi','new'=>'FLOWSEQ_NEXT' },'QUOTED'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_MAYBE_KEY' },'EOL'=>{'match'=>'cb_send_scalar','new'=>'FLOWSEQ_NEXT' },'match'=>'cb_take_quoted' },'QUOTED_MULTILINE'=>{'match'=>'cb_quoted_multiline','new'=>'FLOWSEQ_NEXT' }},'FULLMAPVALUE_INLINE'=>{'ANCHOR'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_ANCHOR' },'WS'=>{'DEFAULT'=>{'new'=>'NODETYPE_MAPVALUE_INLINE' },'TAG'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG_ANCHOR' },'WS'=>{'new'=>'NODETYPE_MAPVALUE_INLINE' },'match'=>'cb_tag' }},'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_MAPVALUE_INLINE' },'TAG'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG' },'WS'=>{'ANCHOR'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG_ANCHOR' },'WS'=>{'new'=>'NODETYPE_MAPVALUE_INLINE' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_MAPVALUE_INLINE' }},'match'=>'cb_tag' }},'FULLNODE'=>{'ANCHOR'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_ANCHOR' },'WS'=>{'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'TAG'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG_ANCHOR' },'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_tag' }},'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_NODE' },'EOL'=>{'new'=>'FULLNODE' },'TAG'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG' },'WS'=>{'ANCHOR'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG_ANCHOR' },'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' }},'match'=>'cb_tag' }},'FULLNODE_ANCHOR'=>{'ANCHOR'=>{'WS'=>{'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'TAG'=>{'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_tag' }},'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_NODE' },'EOL'=>{'new'=>'FULLNODE_ANCHOR' },'TAG'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG_ANCHOR' },'WS'=>{'ANCHOR'=>{'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' }},'match'=>'cb_tag' }},'FULLNODE_TAG'=>{'ANCHOR'=>{'EOL'=>{'match'=>'cb_property_eol','new'=>'FULLNODE_TAG_ANCHOR' },'WS'=>{'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'TAG'=>{'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_tag' }},'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_NODE' },'EOL'=>{'new'=>'FULLNODE_TAG' },'TAG'=>{'WS'=>{'ANCHOR'=>{'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' }},'match'=>'cb_tag' }},'FULLNODE_TAG_ANCHOR'=>{'ANCHOR'=>{'WS'=>{'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'TAG'=>{'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_tag' }},'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_NODE' },'EOL'=>{'new'=>'FULLNODE_TAG_ANCHOR' },'TAG'=>{'WS'=>{'ANCHOR'=>{'WS'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' }},'match'=>'cb_tag' }},'NEWFLOWMAP'=>{'DEFAULT'=>{'new'=>'FLOWMAP' },'EOL'=>{'new'=>'NEWFLOWMAP' },'QUESTION'=>{'match'=>'cb_flow_question','new'=>'FLOWMAP_EXPLICIT_KEY' },'WS'=>{'new'=>'NEWFLOWMAP' }},'NEWFLOWMAP_ANCHOR'=>{'DEFAULT'=>{'new'=>'FLOWMAP_EMPTYKEY' }},'NEWFLOWMAP_ANCHOR_SPC'=>{'DEFAULT'=>{'new'=>'FLOWMAP_PROPS' },'EOL'=>{'new'=>'NEWFLOWMAP_ANCHOR_SPC' },'TAG'=>{'DEFAULT'=>{'new'=>'FLOWMAP_EMPTYKEY' },'EOL'=>{'new'=>'FLOWMAP_PROPS' },'WS'=>{'new'=>'FLOWMAP_PROPS' },'match'=>'cb_tag' },'WS'=>{'new'=>'NEWFLOWMAP_ANCHOR_SPC' }},'NEWFLOWMAP_TAG'=>{'DEFAULT'=>{'new'=>'FLOWMAP_EMPTYKEY' }},'NEWFLOWMAP_TAG_SPC'=>{'ANCHOR'=>{'DEFAULT'=>{'new'=>'FLOWMAP_EMPTYKEY' },'EOL'=>{'new'=>'FLOWMAP_PROPS' },'WS'=>{'new'=>'FLOWMAP_PROPS' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'FLOWMAP_PROPS' },'EOL'=>{'new'=>'NEWFLOWMAP_TAG_SPC' },'WS'=>{'new'=>'NEWFLOWMAP_TAG_SPC' }},'NEWFLOWSEQ'=>{'ANCHOR'=>{'DEFAULT'=>{'new'=>'NEWFLOWSEQ_ANCHOR' },'EOL'=>{'new'=>'NEWFLOWSEQ_ANCHOR_SPC' },'WS'=>{'new'=>'NEWFLOWSEQ_ANCHOR_SPC' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'FLOWSEQ' },'EOL'=>{'new'=>'NEWFLOWSEQ' },'FLOWSEQ_END'=>{'match'=>'cb_end_flowseq','return'=>1 },'TAG'=>{'DEFAULT'=>{'new'=>'NEWFLOWSEQ_TAG' },'EOL'=>{'new'=>'NEWFLOWSEQ_TAG_SPC' },'WS'=>{'new'=>'NEWFLOWSEQ_TAG_SPC' },'match'=>'cb_tag' },'WS'=>{'new'=>'NEWFLOWSEQ' }},'NEWFLOWSEQ_ANCHOR'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_EMPTY' }},'NEWFLOWSEQ_ANCHOR_SPC'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_PROPS' },'EOL'=>{'new'=>'NEWFLOWSEQ_ANCHOR_SPC' },'TAG'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_EMPTY' },'EOL'=>{'new'=>'FLOWSEQ_PROPS' },'WS'=>{'new'=>'FLOWSEQ_PROPS' },'match'=>'cb_tag' },'WS'=>{'new'=>'NEWFLOWSEQ_ANCHOR_SPC' }},'NEWFLOWSEQ_TAG'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_EMPTY' }},'NEWFLOWSEQ_TAG_SPC'=>{'ANCHOR'=>{'DEFAULT'=>{'new'=>'FLOWSEQ_EMPTY' },'EOL'=>{'new'=>'FLOWSEQ_PROPS' },'WS'=>{'new'=>'FLOWSEQ_PROPS' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'FLOWSEQ_PROPS' },'EOL'=>{'new'=>'NEWFLOWSEQ_TAG_SPC' },'WS'=>{'new'=>'NEWFLOWSEQ_TAG_SPC' }},'NODETYPE_COMPLEX'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_complexcolon' },'DEFAULT'=>{'match'=>'cb_empty_complexvalue','new'=>'NODETYPE_MAP' },'EOL'=>{'new'=>'NODETYPE_COMPLEX' }},'NODETYPE_FLOWMAP'=>{'DEFAULT'=>{'new'=>'NEWFLOWMAP' },'EOL'=>{'new'=>'NODETYPE_FLOWMAP' },'FLOWMAP_END'=>{'match'=>'cb_end_flowmap','return'=>1 },'FLOW_COMMA'=>{'match'=>'cb_flow_comma','new'=>'NEWFLOWMAP' },'WS'=>{'new'=>'NODETYPE_FLOWMAP' }},'NODETYPE_FLOWMAPVALUE'=>{'COLON'=>{'DEFAULT'=>{'new'=>'RULE_FULLFLOWSCALAR' },'EOL'=>{'new'=>'RULE_FULLFLOWSCALAR' },'WS'=>{'new'=>'RULE_FULLFLOWSCALAR' },'match'=>'cb_flow_colon' },'EOL'=>{'new'=>'NODETYPE_FLOWMAPVALUE' },'FLOWMAP_END'=>{'match'=>'cb_end_flowmap_empty','return'=>1 },'FLOW_COMMA'=>{'match'=>'cb_empty_flowmap_value','return'=>1 },'WS'=>{'new'=>'NODETYPE_FLOWMAPVALUE' }},'NODETYPE_FLOWSEQ'=>{'DEFAULT'=>{'new'=>'NEWFLOWSEQ' },'EOL'=>{'new'=>'NODETYPE_FLOWSEQ' },'FLOWSEQ_END'=>{'match'=>'cb_end_flowseq','return'=>1 },'WS'=>{'new'=>'NODETYPE_FLOWSEQ' }},'NODETYPE_MAP'=>{'ANCHOR'=>{'WS'=>{'DEFAULT'=>{'new'=>'RULE_MAPKEY' },'TAG'=>{'WS'=>{'new'=>'RULE_MAPKEY' },'match'=>'cb_tag' }},'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'RULE_MAPKEY' },'TAG'=>{'WS'=>{'ANCHOR'=>{'WS'=>{'new'=>'RULE_MAPKEY' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'RULE_MAPKEY' }},'match'=>'cb_tag' }},'NODETYPE_MAPVALUE_INLINE'=>{'ALIAS'=>{'EOL'=>{},'match'=>'cb_send_alias' },'BLOCK_SCALAR'=>{'EOL'=>{},'match'=>'cb_send_block_scalar' },'DOC_END'=>{'EOL'=>{},'match'=>'cb_end_document' },'FLOWMAP_START'=>{'match'=>'cb_start_flowmap','new'=>'NEWFLOWMAP' },'FLOWSEQ_START'=>{'match'=>'cb_start_flowseq','new'=>'NEWFLOWSEQ' },'PLAIN'=>{'EOL'=>{'match'=>'cb_send_scalar' },'match'=>'cb_start_plain' },'PLAIN_MULTI'=>{'EOL'=>{},'match'=>'cb_send_plain_multi' },'QUOTED'=>{'EOL'=>{'match'=>'cb_send_scalar' },'match'=>'cb_take_quoted' },'QUOTED_MULTILINE'=>{'EOL'=>{},'match'=>'cb_quoted_multiline' }},'NODETYPE_NODE'=>{'DASH'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_seqstart' },'DEFAULT'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' }},'NODETYPE_SCALAR_OR_MAP'=>{'ALIAS'=>{'EOL'=>{'match'=>'cb_send_alias_from_stack' },'WS'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_insert_map_alias' }},'match'=>'cb_alias' },'BLOCK_SCALAR'=>{'EOL'=>{},'match'=>'cb_send_block_scalar' },'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_insert_empty_map' },'DOC_END'=>{'EOL'=>{},'match'=>'cb_end_document' },'DOC_START'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_end_doc_start_document' },'EOL'=>{'new'=>'NODETYPE_SCALAR_OR_MAP' },'FLOWMAP_START'=>{'match'=>'cb_start_flowmap','new'=>'NEWFLOWMAP' },'FLOWSEQ_START'=>{'match'=>'cb_start_flowseq','new'=>'NEWFLOWSEQ' },'PLAIN'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_insert_map' },'EOL'=>{'match'=>'cb_send_scalar' },'WS'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_insert_map' }},'match'=>'cb_start_plain' },'PLAIN_MULTI'=>{'EOL'=>{},'match'=>'cb_send_plain_multi' },'QUESTION'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_questionstart' },'QUOTED'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_insert_map' },'EOL'=>{'match'=>'cb_send_scalar' },'WS'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_insert_map' }},'match'=>'cb_take_quoted' },'QUOTED_MULTILINE'=>{'EOL'=>{},'match'=>'cb_quoted_multiline' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' }},'NODETYPE_SEQ'=>{'DASH'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_seqitem' },'DOC_END'=>{'EOL'=>{},'match'=>'cb_end_document' },'DOC_START'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_end_doc_start_document' },'EOL'=>{'new'=>'NODETYPE_SEQ' }},'RULE_FLOWSCALAR'=>{'ALIAS'=>{'match'=>'cb_send_alias','return'=>1 },'FLOWMAP_END'=>{'match'=>'cb_end_flowmap_empty','return'=>1 },'FLOWMAP_START'=>{'match'=>'cb_start_flowmap','new'=>'NEWFLOWMAP' },'FLOWSEQ_START'=>{'match'=>'cb_start_flowseq','new'=>'NEWFLOWSEQ' },'FLOW_COMMA'=>{'match'=>'cb_empty_flow_mapkey','return'=>1 },'PLAIN'=>{'DEFAULT'=>{'match'=>'cb_send_scalar','return'=>1 },'EOL'=>{'match'=>'cb_send_scalar' },'match'=>'cb_start_plain' },'PLAIN_MULTI'=>{'match'=>'cb_send_plain_multi','return'=>1 },'QUOTED'=>{'DEFAULT'=>{'match'=>'cb_send_scalar','return'=>1 },'EOL'=>{'match'=>'cb_send_scalar' },'WS'=>{'match'=>'cb_send_scalar','return'=>1 },'match'=>'cb_take_quoted' },'QUOTED_MULTILINE'=>{'match'=>'cb_quoted_multiline','return'=>1 }},'RULE_FULLFLOWSCALAR'=>{'ANCHOR'=>{'DEFAULT'=>{'new'=>'RULE_FULLFLOWSCALAR_ANCHOR' },'EOL'=>{'new'=>'RULE_FULLFLOWSCALAR_ANCHOR' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'RULE_FLOWSCALAR' },'TAG'=>{'DEFAULT'=>{'new'=>'RULE_FULLFLOWSCALAR_TAG' },'EOL'=>{'new'=>'RULE_FULLFLOWSCALAR_TAG' },'match'=>'cb_tag' }},'RULE_FULLFLOWSCALAR_ANCHOR'=>{'DEFAULT'=>{'new'=>'RULE_FLOWSCALAR' },'TAG'=>{'EOL'=>{'new'=>'RULE_FLOWSCALAR' },'WS'=>{'new'=>'RULE_FLOWSCALAR' },'match'=>'cb_tag' },'WS'=>{'new'=>'RULE_FULLFLOWSCALAR_ANCHOR' }},'RULE_FULLFLOWSCALAR_TAG'=>{'ANCHOR'=>{'EOL'=>{'new'=>'RULE_FLOWSCALAR' },'WS'=>{'new'=>'RULE_FLOWSCALAR' },'match'=>'cb_anchor' },'DEFAULT'=>{'new'=>'RULE_FLOWSCALAR' },'WS'=>{'new'=>'RULE_FULLFLOWSCALAR_TAG' }},'RULE_MAPKEY'=>{'ALIAS'=>{'WS'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' }}},'match'=>'cb_send_alias_key' },'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_empty_mapkey' },'DOC_END'=>{'EOL'=>{},'match'=>'cb_end_document' },'DOC_START'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_end_doc_start_document' },'EOL'=>{'new'=>'RULE_MAPKEY' },'PLAIN'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_send_mapkey' },'WS'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' },'match'=>'cb_send_mapkey' }},'match'=>'cb_mapkey' },'QUESTION'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_question' },'QUOTED'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' }},'WS'=>{'COLON'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLMAPVALUE_INLINE' }}},'match'=>'cb_take_quoted_key' }},'STREAM'=>{'DEFAULT'=>{'match'=>'cb_doc_start_implicit','new'=>'FULLNODE' },'DOC_END'=>{'EOL'=>{},'match'=>'cb_end_document_empty' },'DOC_START'=>{'EOL'=>{'new'=>'FULLNODE' },'WS'=>{'new'=>'FULLNODE' },'match'=>'cb_doc_start_explicit' },'EOL'=>{'new'=>'STREAM' },'RESERVED_DIRECTIVE'=>{'EOL'=>{'new'=>'DIRECTIVE' },'WS'=>{'new'=>'DIRECTIVE' },'match'=>'cb_reserved_directive' },'TAG_DIRECTIVE'=>{'EOL'=>{'new'=>'DIRECTIVE' },'WS'=>{'new'=>'DIRECTIVE' },'match'=>'cb_tag_directive' },'YAML_DIRECTIVE'=>{'EOL'=>{'new'=>'DIRECTIVE' },'WS'=>{'new'=>'DIRECTIVE' },'match'=>'cb_set_yaml_version_directive' }}};1; YAML_PP_GRAMMAR $fatpacked{"YAML/PP/Highlight.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_HIGHLIGHT'; use strict;use warnings;package YAML::PP::Highlight;our$VERSION='v0.38.0';our@EXPORT_OK=qw/Dump/;use base 'Exporter';use YAML::PP;use YAML::PP::Parser;use Encode;sub Dump {my (@docs)=@_;require YAML::PP::Schema::Perl;my$yp=YAML::PP->new(schema=>[qw/+ Perl/]);my$yaml=$yp->dump_string(@docs);my ($error,$tokens)=YAML::PP::Parser->yaml_to_tokens(string=>$yaml);my$highlighted=YAML::PP::Highlight->ansicolored($tokens);encode_utf8$highlighted}my%ansicolors=(ANCHOR=>[qw/green/],ALIAS=>[qw/bold green/],TAG=>[qw/bold blue/],INDENT=>[qw/white on_grey3/],COMMENT=>[qw/grey12/],COLON=>[qw/bold magenta/],DASH=>[qw/bold magenta/],QUESTION=>[qw/bold magenta/],YAML_DIRECTIVE=>[qw/cyan/],TAG_DIRECTIVE=>[qw/bold cyan/],SINGLEQUOTE=>[qw/bold green/],SINGLEQUOTED=>[qw/green/],SINGLEQUOTED_LINE=>[qw/green/],DOUBLEQUOTE=>[qw/bold green/],DOUBLEQUOTED=>[qw/green/],DOUBLEQUOTED_LINE=>[qw/green/],LITERAL=>[qw/bold yellow/],FOLDED=>[qw/bold yellow/],DOC_START=>[qw/bold/],DOC_END=>[qw/bold/],BLOCK_SCALAR_CONTENT=>[qw/yellow/],TAB=>[qw/on_blue/],ERROR=>[qw/bold red/],EOL=>[qw/grey12/],TRAILING_SPACE=>[qw/on_grey6/],FLOWSEQ_START=>[qw/bold magenta/],FLOWSEQ_END=>[qw/bold magenta/],FLOWMAP_START=>[qw/bold magenta/],FLOWMAP_END=>[qw/bold magenta/],FLOW_COMMA=>[qw/bold magenta/],PLAINKEY=>[qw/bright_blue/],);sub ansicolored {my ($class,$tokens,%args)=@_;my$expand_tabs=$args{expand_tabs};$expand_tabs=1 unless defined$expand_tabs;require Term::ANSIColor;local$Term::ANSIColor::EACHLINE="\n";my$ansi='';my$highlighted='';my@list=$class->transform($tokens);for my$token (@list){my$name=$token->{name};my$str=$token->{value};my$color=$ansicolors{$name };if ($color){$str=Term::ANSIColor::colored($color,$str)}$highlighted .= $str}if ($expand_tabs){$highlighted =~ s/\t/' ' x 8/eg}$ansi .= $highlighted;return$ansi}my%htmlcolors=(ANCHOR=>'anchor',ALIAS=>'alias',SINGLEQUOTE=>'singlequote',DOUBLEQUOTE=>'doublequote',SINGLEQUOTED=>'singlequoted',DOUBLEQUOTED=>'doublequoted',SINGLEQUOTED_LINE=>'singlequoted',DOUBLEQUOTED_LINE=>'doublequoted',INDENT=>'indent',DASH=>'dash',COLON=>'colon',QUESTION=>'question',YAML_DIRECTIVE=>'yaml_directive',TAG_DIRECTIVE=>'tag_directive',TAG=>'tag',COMMENT=>'comment',LITERAL=>'literal',FOLDED=>'folded',DOC_START=>'doc_start',DOC_END=>'doc_end',BLOCK_SCALAR_CONTENT=>'block_scalar_content',TAB=>'tab',ERROR=>'error',EOL=>'eol',TRAILING_SPACE=>'trailing_space',FLOWSEQ_START=>'flowseq_start',FLOWSEQ_END=>'flowseq_end',FLOWMAP_START=>'flowmap_start',FLOWMAP_END=>'flowmap_end',FLOW_COMMA=>'flow_comma',PLAINKEY=>'plainkey',NOEOL=>'noeol',);sub htmlcolored {require HTML::Entities;my ($class,$tokens)=@_;my$html='';my@list=$class->transform($tokens);for my$token (@list){my$name=$token->{name};my$str=$token->{value};my$colorclass=$htmlcolors{$name }|| 'default';$str=HTML::Entities::encode_entities($str);$html .= qq{$str}}return$html}sub transform {my ($class,$tokens)=@_;my@list;for my$token (@$tokens){my@values;my$value=$token->{value};my$subtokens=$token->{subtokens};if ($subtokens){@values=@$subtokens}else {@values=$token}for my$token (@values){my$value=defined$token->{orig}? $token->{orig}: $token->{value};if ($token->{name}eq 'EOL' and not length$value){push@list,{name=>'NOEOL',value=>'' };next}push@list,map {$_ =~ tr/\t/\t/ ? {name=>'TAB',value=>$_ }: {name=>$token->{name},value=>$_ }}split m/(\t+)/,$value}}for my$i (0 .. $#list){my$token=$list[$i ];my$name=$token->{name};my$str=$token->{value};my$trailing_space=0;if ($token->{name}eq 'EOL'){if ($str =~ m/ +([\r\n]|\z)/){$token->{name}="TRAILING_SPACE"}}elsif ($i < $#list){if ($name eq 'PLAIN'){for my$n ($i+1 .. $#list){my$next=$list[$n ];last if$next->{name}eq 'EOL';next if$next->{name}=~ m/^(WS|SPACE)$/;if ($next->{name}eq 'COLON'){$token->{name}='PLAINKEY'}}}my$next=$list[$i + 1];if ($next->{name}eq 'EOL'){if ($str =~ m/ \z/ and $name =~ m/^(BLOCK_SCALAR_CONTENT|WS|INDENT)$/){$token->{name}="TRAILING_SPACE"}}}}return@list}1; YAML_PP_HIGHLIGHT $fatpacked{"YAML/PP/Lexer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_LEXER'; use strict;use warnings;package YAML::PP::Lexer;our$VERSION='v0.38.0';use constant TRACE=>$ENV{YAML_PP_TRACE}? 1 : 0;use constant DEBUG=>($ENV{YAML_PP_DEBUG}|| $ENV{YAML_PP_TRACE})? 1 : 0;use YAML::PP::Grammar qw/$GRAMMAR/;use Carp qw/croak/;sub new {my ($class,%args)=@_;my$self=bless {reader=>$args{reader},},$class;$self->init;return$self}sub init {my ($self)=@_;$self->{next_tokens}=[];$self->{next_line}=undef;$self->{line}=0;$self->{offset}=0;$self->{flowcontext}=0}sub next_line {return $_[0]->{next_line}}sub set_next_line {$_[0]->{next_line}=$_[1]}sub reader {return $_[0]->{reader}}sub set_reader {$_[0]->{reader}=$_[1]}sub next_tokens {return $_[0]->{next_tokens}}sub line {return $_[0]->{line}}sub set_line {$_[0]->{line}=$_[1]}sub offset {return $_[0]->{offset}}sub set_offset {$_[0]->{offset}=$_[1]}sub inc_line {return $_[0]->{line}++}sub context {return $_[0]->{context}}sub set_context {$_[0]->{context}=$_[1]}sub flowcontext {return $_[0]->{flowcontext}}sub set_flowcontext {$_[0]->{flowcontext}=$_[1]}sub block {return $_[0]->{block}}sub set_block {$_[0]->{block}=$_[1]}my$RE_WS='[\t ]';my$RE_LB='[\r\n]';my$RE_DOC_END=qr/\A(\.\.\.)(?=$RE_WS|$)/m;my$RE_DOC_START=qr/\A(---)(?=$RE_WS|$)/m;my$RE_EOL=qr/\A($RE_WS+#.*|$RE_WS+)\z/;my$RE_NS_WORD_CHAR='[0-9A-Za-z-]';my$RE_URI_CHAR='(?:' .'%[0-9a-fA-F]{2}' .'|'.q{[0-9A-Za-z#;/?:@&=+$,_.!*'\(\)\[\]-]} .')';my$RE_NS_TAG_CHAR='(?:' .'%[0-9a-fA-F]{2}' .'|'.q{[0-9A-Za-z#;/?:@&=+$_.~*'\(\)-]} .')';my$RE_ANCHOR_CAR='[\x21-\x2B\x2D-\x5A\x5C\x5E-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';my$RE_PLAIN_START='[\x21\x22\x24-\x39\x3B-\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';my$RE_PLAIN_END='[\x21-\x39\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]';my$RE_PLAIN_FIRST='[\x24\x28-\x29\x2B\x2E-\x39\x3B-\x3D\x41-\x5A\x5C\x5E-\x5F\x61-\x7A\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';my$RE_PLAIN_START_FLOW='[\x21\x22\x24-\x2B\x2D-\x39\x3B-\x5A\x5C\x5E-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';my$RE_PLAIN_END_FLOW='[\x21-\x2B\x2D-\x39\x3B-\x5A\x5C\x5E-\x7A\x7C\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]';my$RE_PLAIN_FIRST_FLOW='[\x24\x28-\x29\x2B\x2E-\x39\x3B-\x3D\x41-\x5A\x5C\x5E-\x5F\x61-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';my$RE_PLAIN_WORD="(?::+$RE_PLAIN_END|$RE_PLAIN_START)(?::+$RE_PLAIN_END|$RE_PLAIN_END)*";my$RE_PLAIN_FIRST_WORD="(?:[:?-]+$RE_PLAIN_END|$RE_PLAIN_FIRST)(?::+$RE_PLAIN_END|$RE_PLAIN_END)*";my$RE_PLAIN_WORDS="(?:$RE_PLAIN_FIRST_WORD(?:$RE_WS+$RE_PLAIN_WORD)*)";my$RE_PLAIN_WORDS2="(?:$RE_PLAIN_WORD(?:$RE_WS+$RE_PLAIN_WORD)*)";my$RE_PLAIN_WORD_FLOW="(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_START_FLOW)(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_END_FLOW)*";my$RE_PLAIN_FIRST_WORD_FLOW="(?:[:?-]+$RE_PLAIN_END_FLOW|$RE_PLAIN_FIRST_FLOW)(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_END_FLOW)*";my$RE_PLAIN_WORDS_FLOW="(?:$RE_PLAIN_FIRST_WORD_FLOW(?:$RE_WS+$RE_PLAIN_WORD_FLOW)*)";my$RE_PLAIN_WORDS_FLOW2="(?:$RE_PLAIN_WORD_FLOW(?:$RE_WS+$RE_PLAIN_WORD_FLOW)*)";my$RE_TAG="!(?:$RE_NS_WORD_CHAR*!$RE_NS_TAG_CHAR+|$RE_NS_TAG_CHAR+|<$RE_URI_CHAR+>|)";my$RE_SEQSTART=qr/\A(-)(?=$RE_WS|$)/m;my$RE_COMPLEX=qr/(\?)(?=$RE_WS|$)/m;my$RE_COMPLEXCOLON=qr/\A(:)(?=$RE_WS|$)/m;my$RE_ANCHOR="&$RE_ANCHOR_CAR+";my$RE_ALIAS="\\*$RE_ANCHOR_CAR+";my%REGEXES=(ANCHOR=>qr{($RE_ANCHOR)},TAG=>qr{($RE_TAG)},ALIAS=>qr{($RE_ALIAS)},SINGLEQUOTED=>qr{(?:''|[^'\r\n]+)*},);sub _fetch_next_line {my ($self)=@_;my$next_line=$self->next_line;if (defined$next_line){return$next_line}my$line=$self->reader->readline;unless (defined$line){$self->set_next_line(undef);return}$self->set_block(1);$self->inc_line;$line =~ m/\A( *)([^\r\n]*)([\r\n]|\z)/ or die "Unexpected";$next_line=[$1,$2,$3 ];$self->set_next_line($next_line);if ($line =~ tr/\x00-\x08\x0b-\x0c\x0e-\x1f//){$self->exception("Control characters are not allowed")}return$next_line}my%TOKEN_NAMES=('"'=>'DOUBLEQUOTE',"'"=>'SINGLEQUOTE','|'=>'LITERAL','>'=>'FOLDED','!'=>'TAG','*'=>'ALIAS','&'=>'ANCHOR',':'=>'COLON','-'=>'DASH','?'=>'QUESTION','['=>'FLOWSEQ_START',']'=>'FLOWSEQ_END','{'=>'FLOWMAP_START','}'=>'FLOWMAP_END',','=>'FLOW_COMMA','---'=>'DOC_START','...'=>'DOC_END',);sub fetch_next_tokens {my ($self)=@_;my$next=$self->next_tokens;return$next if @$next;my$next_line=$self->_fetch_next_line;if (not $next_line){return []}my$spaces=$next_line->[0];my$yaml=\$next_line->[1];if (not length $$yaml){$self->_push_tokens([EOL=>join('',@$next_line),$self->line ]);$self->set_next_line(undef);return$next}if (substr($$yaml,0,1)eq '#'){$self->_push_tokens([EOL=>join('',@$next_line),$self->line ]);$self->set_next_line(undef);return$next}if (not $spaces and substr($$yaml,0,1)eq "%"){$self->_fetch_next_tokens_directive($yaml,$next_line->[2]);$self->set_context(0);$self->set_next_line(undef);return$next}if (not $spaces and $$yaml =~ s/\A(---|\.\.\.)(?=$RE_WS|\z)//){$self->_push_tokens([$TOKEN_NAMES{$1 }=>$1,$self->line ])}elsif ($self->flowcontext and $$yaml =~ m/\A[ \t]+(#.*)?\z/){$self->_push_tokens([EOL=>join('',@$next_line),$self->line ]);$self->set_next_line(undef);return$next}else {$self->_push_tokens([SPACE=>$spaces,$self->line ])}my$partial=$self->_fetch_next_tokens($next_line);unless ($partial){$self->set_next_line(undef)}return$next}my%ANCHOR_ALIAS_TAG=('&'=>1,'*'=>1,'!'=>1);my%BLOCK_SCALAR=('|'=>1,'>'=>1);my%COLON_DASH_QUESTION=(':'=>1,'-'=>1,'?'=>1);my%QUOTED=('"'=>1,"'"=>1);my%FLOW=('{'=>1,'['=>1,'}'=>1,']'=>1,','=>1);my%CONTEXT=('"'=>1,"'"=>1,'>'=>1,'|'=>1);my$RE_ESCAPES=qr{(?: \\([ \\\/_0abefnrtvLNP\t"]) | \\x([0-9a-fA-F]{2}) | \\u([A-Fa-f0-9]{4}) | \\U([A-Fa-f0-9]{4,8}) )}x;my%CONTROL=('\\'=>'\\','/'=>'/',n=>"\n",t=>"\t",r=>"\r",b=>"\b",'a'=>"\a",'b'=>"\b",'e'=>"\e",'f'=>"\f",'v'=>"\x0b","\t"=>"\t",'P'=>"\x{2029}",L=>"\x{2028}",'N'=>"\x85",'0'=>"\0",'_'=>"\xa0",' '=>' ',q/"/=>q/"/,);sub _fetch_next_tokens {TRACE and warn __PACKAGE__.':'.__LINE__.": _fetch_next_tokens\n";my ($self,$next_line)=@_;my$yaml=\$next_line->[1];my$eol=$next_line->[2];my@tokens;while (1){unless (length $$yaml){push@tokens,(EOL=>$eol,$self->line);$self->_push_tokens(\@tokens);return}my$first=substr($$yaml,0,1);my$plain=0;if ($self->context){if ($$yaml =~ s/\A($RE_WS*)://){push@tokens,(WS=>$1,$self->line)if $1;push@tokens,(COLON=>':',$self->line);$self->set_context(0);next}if ($$yaml =~ s/\A($RE_WS*(?: #.*))\z//){push@tokens,(EOL=>$1 .$eol,$self->line);$self->_push_tokens(\@tokens);return}$self->set_context(0)}if ($CONTEXT{$first }){push@tokens,(CONTEXT=>$first,$self->line);$self->_push_tokens(\@tokens);return 1}elsif ($COLON_DASH_QUESTION{$first }){my$token_name=$TOKEN_NAMES{$first };if ($$yaml =~ s/\A\Q$first\E($RE_WS+|\z)//){my$after=$1;if (not $self->flowcontext and not $self->block){push@tokens,ERROR=>$first .$after,$self->line;$self->_push_tokens(\@tokens);$self->exception("Tabs can not be used for indentation")}if ($after =~ tr/\t//){$self->set_block(0)}my$token_name=$TOKEN_NAMES{$first };push@tokens,($token_name=>$first,$self->line);if (not defined $1){push@tokens,(EOL=>$eol,$self->line);$self->_push_tokens(\@tokens);return}my$ws=$1;if ($$yaml =~ s/\A(#.*|)\z//){push@tokens,(EOL=>$ws .$1 .$eol,$self->line);$self->_push_tokens(\@tokens);return}push@tokens,(WS=>$ws,$self->line);next}elsif ($self->flowcontext and $$yaml =~ s/\A:(?=[,\{\}\[\]])//){push@tokens,($token_name=>$first,$self->line);next}$plain=1}elsif ($ANCHOR_ALIAS_TAG{$first }){my$token_name=$TOKEN_NAMES{$first };my$REGEX=$REGEXES{$token_name };if ($$yaml =~ s/\A$REGEX//){push@tokens,($token_name=>$1,$self->line)}else {push@tokens,("Invalid $token_name"=>$$yaml,$self->line);$self->_push_tokens(\@tokens);return}}elsif ($first eq ' ' or $first eq "\t"){if ($$yaml =~ s/\A($RE_WS+)//){my$ws=$1;if ($$yaml =~ s/\A((?:#.*)?\z)//){push@tokens,(EOL=>$ws .$1 .$eol,$self->line);$self->_push_tokens(\@tokens);return}push@tokens,(WS=>$ws,$self->line)}}elsif ($FLOW{$first }){push@tokens,($TOKEN_NAMES{$first }=>$first,$self->line);substr($$yaml,0,1,'');my$flowcontext=$self->flowcontext;if ($first eq '{' or $first eq '['){$self->set_flowcontext(++$flowcontext)}elsif ($first eq '}' or $first eq ']'){$self->set_flowcontext(--$flowcontext)}}else {$plain=1}if ($plain){push@tokens,(CONTEXT=>'',$self->line);$self->_push_tokens(\@tokens);return 1}}return}sub fetch_plain {my ($self,$indent,$context)=@_;my$next_line=$self->next_line;my$yaml=\$next_line->[1];my$eol=$next_line->[2];my$REGEX=$RE_PLAIN_WORDS;if ($self->flowcontext){$REGEX=$RE_PLAIN_WORDS_FLOW}my@tokens;unless ($$yaml =~ s/\A($REGEX(?:[:]+(?=\:(\s|\z)))?)//){$self->_push_tokens(\@tokens);$self->exception("Invalid plain scalar")}my$plain=$1;push@tokens,(PLAIN=>$plain,$self->line);if ($$yaml =~ s/\A(?:($RE_WS+#.*)|($RE_WS*))\z//){if (defined $1){push@tokens,(EOL=>$1 .$eol,$self->line);$self->_push_tokens(\@tokens);$self->set_next_line(undef);return}else {push@tokens,(EOL=>$2.$eol,$self->line);$self->set_next_line(undef)}}else {$self->_push_tokens(\@tokens);my$partial=$self->_fetch_next_tokens($next_line);if (not $partial){$self->set_next_line(undef)}return}my$RE2=$RE_PLAIN_WORDS2;if ($self->flowcontext){$RE2=$RE_PLAIN_WORDS_FLOW2}my$fetch_next=0;my@lines=($plain);my@next;LOOP: while (1){$next_line=$self->_fetch_next_line;if (not $next_line){last LOOP}my$spaces=$next_line->[0];my$yaml=\$next_line->[1];my$eol=$next_line->[2];if (not length $$yaml){push@tokens,(EOL=>$spaces .$eol,$self->line);$self->set_next_line(undef);push@lines,'';next LOOP}if (not $spaces and $$yaml =~ s/\A(---|\.\.\.)(?=$RE_WS|\z)//){push@next,$TOKEN_NAMES{$1 }=>$1,$self->line;$fetch_next=1;last LOOP}if ((length$spaces)< $indent){last LOOP}my$ws='';if ($$yaml =~ s/\A($RE_WS+)//){$ws=$1}if (not length $$yaml){push@tokens,(EOL=>$spaces .$ws .$eol,$self->line);$self->set_next_line(undef);push@lines,'';next LOOP}if ($$yaml =~ s/\A(#.*)\z//){push@tokens,(EOL=>$spaces .$ws .$1 .$eol,$self->line);$self->set_next_line(undef);last LOOP}if ($$yaml =~ s/\A($RE2)//){push@tokens,INDENT=>$spaces,$self->line;push@tokens,WS=>$ws,$self->line;push@tokens,PLAIN=>$1,$self->line;push@lines,$1;my$ws='';if ($$yaml =~ s/\A($RE_WS+)//){$ws=$1}if (not length $$yaml){push@tokens,EOL=>$ws .$eol,$self->line;$self->set_next_line(undef);next LOOP}if ($$yaml =~ s/\A(#.*)\z//){push@tokens,EOL=>$ws .$1 .$eol,$self->line;$self->set_next_line(undef);last LOOP}else {push@tokens,WS=>$ws,$self->line if$ws;$fetch_next=1}}else {push@tokens,SPACE=>$spaces,$self->line;push@tokens,WS=>$ws,$self->line;if ($self->flowcontext){$fetch_next=1}else {push@tokens,ERROR=>$$yaml,$self->line}}last LOOP}while (@lines > 1 and $lines[-1]eq ''){pop@lines}if (@lines > 1){my$value=YAML::PP::Render->render_multi_val(\@lines);my@eol;if ($tokens[-3]eq 'EOL'){@eol=splice@tokens,-3}$self->push_subtokens({name=>'PLAIN_MULTI',value=>$value },\@tokens);$self->_push_tokens([@eol,@next ])}else {$self->_push_tokens([@tokens,@next ])}@tokens=();if ($fetch_next){my$partial=$self->_fetch_next_tokens($next_line);if (not $partial){$self->set_next_line(undef)}}return}sub fetch_block {my ($self,$indent,$context)=@_;my$next_line=$self->next_line;my$yaml=\$next_line->[1];my$eol=$next_line->[2];my@tokens;my$token_name=$TOKEN_NAMES{$context };$$yaml =~ s/\A\Q$context\E// or die "Unexpected";push@tokens,($token_name=>$context,$self->line);my$current_indent=$indent;my$started=0;my$set_indent=0;my$chomp='';if ($$yaml =~ s/\A([1-9])([+-]?)//){push@tokens,(BLOCK_SCALAR_INDENT=>$1,$self->line);$set_indent=$1;$chomp=$2 if $2;push@tokens,(BLOCK_SCALAR_CHOMP=>$2,$self->line)if $2}elsif ($$yaml =~ s/\A([+-])([1-9])?//){push@tokens,(BLOCK_SCALAR_CHOMP=>$1,$self->line);$chomp=$1;push@tokens,(BLOCK_SCALAR_INDENT=>$2,$self->line)if $2;$set_indent=$2 if $2}if ($set_indent){$started=1;$indent-- if$indent > 0;$current_indent=$indent + $set_indent}if (not length $$yaml){push@tokens,(EOL=>$eol,$self->line)}elsif ($$yaml =~ s/\A($RE_WS*(?:$RE_WS#.*|))\z//){push@tokens,(EOL=>$1 .$eol,$self->line)}else {$self->_push_tokens(\@tokens);$self->exception("Invalid block scalar")}my@lines;while (1){$self->set_next_line(undef);$next_line=$self->_fetch_next_line;if (not $next_line){last}my$spaces=$next_line->[0];my$content=$next_line->[1];my$eol=$next_line->[2];if (not $spaces and $content =~ m/\A(---|\.\.\.)(?=$RE_WS|\z)/){last}if ((length$spaces)< $current_indent){if (length$content){if ($content =~ m/\A\t/){$self->_push_tokens(\@tokens);$self->exception("Invalid block scalar")}last}else {push@lines,'';push@tokens,(EOL=>$spaces .$eol,$self->line);next}}if ((length$spaces)> $current_indent){if ($started){($spaces,my$more_spaces)=unpack "a${current_indent}a*",$spaces;$content=$more_spaces .$content}}unless (length$content){push@lines,'';push@tokens,(INDENT=>$spaces,$self->line,EOL=>$eol,$self->line);unless ($started){$current_indent=length$spaces}next}unless ($started){$started=1;$current_indent=length$spaces}push@lines,$content;push@tokens,(INDENT=>$spaces,$self->line,BLOCK_SCALAR_CONTENT=>$content,$self->line,EOL=>$eol,$self->line,)}my$value=YAML::PP::Render->render_block_scalar($context,$chomp,\@lines);my@eol=splice@tokens,-3;$self->push_subtokens({name=>'BLOCK_SCALAR',value=>$value },\@tokens);$self->_push_tokens([@eol ]);return 0}sub fetch_quoted {my ($self,$indent,$context)=@_;my$next_line=$self->next_line;my$yaml=\$next_line->[1];my$spaces=$next_line->[0];my$token_name=$TOKEN_NAMES{$context };$$yaml =~ s/\A\Q$context// or die "Unexpected";;my@tokens=($token_name=>$context,$self->line);my$start=1;my@values;while (1){unless ($start){$next_line=$self->_fetch_next_line or do {for (my$i=0;$i < @tokens;$i+= 3){my$token=$tokens[$i + 1 ];if (ref$token){$tokens[$i + 1 ]=$token->{orig}}}$self->_push_tokens(\@tokens);$self->exception("Missing closing quote <$context> at EOF")};$start=0;$spaces=$next_line->[0];$yaml=\$next_line->[1];if (not length $$yaml){push@tokens,(EOL=>$spaces .$next_line->[2],$self->line);$self->set_next_line(undef);push@values,{value=>'',orig=>'' };next}elsif (not $spaces and $$yaml =~ m/\A(---|\.\.\.)(?=$RE_WS|\z)/){for (my$i=0;$i < @tokens;$i+= 3){my$token=$tokens[$i + 1 ];if (ref$token){$tokens[$i + 1 ]=$token->{orig}}}$self->_push_tokens(\@tokens);$self->exception("Missing closing quote <$context> or invalid document marker")}elsif ((length$spaces)< $indent){for (my$i=0;$i < @tokens;$i+= 3){my$token=$tokens[$i + 1 ];if (ref$token){$tokens[$i + 1 ]=$token->{orig}}}$self->_push_tokens(\@tokens);$self->exception("Wrong indendation or missing closing quote <$context>")}if ($$yaml =~ s/\A($RE_WS+)//){$spaces .= $1}push@tokens,(WS=>$spaces,$self->line)}my$v=$self->_read_quoted_tokens($start,$context,$yaml,\@tokens);push@values,$v;if ($tokens[-3]eq $token_name){if ($start){$self->push_subtokens({name=>'QUOTED',value=>$v->{value}},\@tokens)}else {my$value=YAML::PP::Render->render_quoted($context,\@values);$self->push_subtokens({name=>'QUOTED_MULTILINE',value=>$value },\@tokens)}$self->set_context(1)if$self->flowcontext;if (length $$yaml){my$partial=$self->_fetch_next_tokens($next_line);if (not $partial){$self->set_next_line(undef)}return 0}else {@tokens=();push@tokens,(EOL=>$next_line->[2],$self->line);$self->_push_tokens(\@tokens);$self->set_next_line(undef);return}}$tokens[-2].= $next_line->[2];$self->set_next_line(undef);$start=0}}sub _read_quoted_tokens {my ($self,$start,$first,$yaml,$tokens)=@_;my$quoted='';my$decoded='';my$token_name=$TOKEN_NAMES{$first };my$eol='';if ($first eq "'"){my$regex=$REGEXES{SINGLEQUOTED};if ($$yaml =~ s/\A($regex)//){$quoted .= $1;$decoded .= $1;$decoded =~ s/''/'/g}unless (length $$yaml){if ($quoted =~ s/($RE_WS+)\z//){$eol=$1;$decoded =~ s/($eol)\z//}}}else {($quoted,$decoded,$eol)=$self->_read_doublequoted($yaml)}my$value={value=>$decoded,orig=>$quoted };if ($$yaml =~ s/\A$first//){if ($start){push @$tokens,($token_name .'D'=>$value,$self->line)}else {push @$tokens,($token_name .'D_LINE'=>$value,$self->line)}push @$tokens,($token_name=>$first,$self->line);return$value}if (length $$yaml){push @$tokens,($token_name .'D'=>$value->{orig},$self->line);$self->_push_tokens($tokens);$self->exception("Invalid quoted <$first> string")}push @$tokens,($token_name .'D_LINE'=>$value,$self->line);push @$tokens,(EOL=>$eol,$self->line);return$value}sub _read_doublequoted {my ($self,$yaml)=@_;my$quoted='';my$decoded='';my$eol='';while (1){my$last=1;if ($$yaml =~ s/\A([^"\\ \t]+)//){$quoted .= $1;$decoded .= $1;$last=0}if ($$yaml =~ s/\A($RE_ESCAPES)//){$quoted .= $1;my$dec=defined $2 ? $CONTROL{$2 }: defined $3 ? chr hex $3 : defined $4 ? chr hex $4 : chr hex $5;$decoded .= $dec;$last=0}if ($$yaml =~ s/\A([ \t]+)//){my$spaces=$1;if (length $$yaml){$quoted .= $spaces;$decoded .= $spaces;$last=0}else {$eol=$spaces;last}}if ($$yaml =~ s/\A(\\)\z//){$quoted .= $1;$decoded .= $1;last}last if$last}return ($quoted,$decoded,$eol)}sub _fetch_next_tokens_directive {my ($self,$yaml,$eol)=@_;my@tokens;my$trailing_ws='';my$warn=$ENV{YAML_PP_RESERVED_DIRECTIVE}|| 'warn';if ($$yaml =~ s/\A(\s*%YAML[ \t]+([0-9]+\.[0-9]+))//){my$dir=$1;my$version=$2;if ($$yaml =~ s/\A($RE_WS+)//){$trailing_ws=$1}elsif (length $$yaml){push@tokens,('Invalid directive'=>$dir.$$yaml.$eol,$self->line);$self->_push_tokens(\@tokens);return}if ($version !~ m/^1\.[12]$/){if ($warn eq 'warn'){warn "Unsupported YAML version '$dir'"}elsif ($warn eq 'fatal'){push@tokens,('Unsupported YAML version'=>$dir,$self->line);$self->_push_tokens(\@tokens);return}}push@tokens,(YAML_DIRECTIVE=>$dir,$self->line)}elsif ($$yaml =~ s/\A(\s*%TAG[ \t]+(!$RE_NS_WORD_CHAR*!|!)[ \t]+(tag:\S+|!$RE_URI_CHAR+))($RE_WS*)//){push@tokens,(TAG_DIRECTIVE=>$1,$self->line);my$tag_alias=$2;my$tag_url=$3;$trailing_ws=$4}elsif ($$yaml =~ s/\A(\s*\A%(?:\w+).*)//){push@tokens,(RESERVED_DIRECTIVE=>$1,$self->line);if ($warn eq 'warn'){warn "Found reserved directive '$1'"}elsif ($warn eq 'fatal'){die "Found reserved directive '$1'"}}else {push@tokens,('Invalid directive'=>$$yaml,$self->line);push@tokens,(EOL=>$eol,$self->line);$self->_push_tokens(\@tokens);return}if (not length $$yaml){push@tokens,(EOL=>$eol,$self->line)}elsif ($trailing_ws and $$yaml =~ s/\A(#.*)?\z//){push@tokens,(EOL=>"$trailing_ws$1$eol",$self->line);$self->_push_tokens(\@tokens);return}elsif ($$yaml =~ s/\A([ \t]+#.*)?\z//){push@tokens,(EOL=>"$1$eol",$self->line);$self->_push_tokens(\@tokens);return}else {push@tokens,('Invalid directive'=>$trailing_ws.$$yaml,$self->line);push@tokens,(EOL=>$eol,$self->line)}$self->_push_tokens(\@tokens);return}sub _push_tokens {my ($self,$new_tokens)=@_;my$next=$self->next_tokens;my$line=$self->line;my$column=$self->offset;for (my$i=0;$i < @$new_tokens;$i += 3){my$value=$new_tokens->[$i + 1 ];my$name=$new_tokens->[$i ];my$line=$new_tokens->[$i + 2 ];my$push={name=>$name,line=>$line,column=>$column,value=>$value,};$column += length$value unless$name eq 'CONTEXT';push @$next,$push;if ($name eq 'EOL'){$column=0}}$self->set_offset($column);return$next}sub push_subtokens {my ($self,$token,$subtokens)=@_;my$next=$self->next_tokens;my$line=$self->line;my$column=$self->offset;$token->{column}=$column;$token->{subtokens}=\my@sub;for (my$i=0;$i < @$subtokens;$i+=3){my$name=$subtokens->[$i ];my$value=$subtokens->[$i + 1 ];my$line=$subtokens->[$i + 2 ];my$push={name=>$subtokens->[$i ],line=>$line,column=>$column,};if (ref$value eq 'HASH'){%$push=(%$push,%$value);$column += length$value->{orig}}else {$push->{value}=$value;$column += length$value}if ($push->{name}eq 'EOL'){$column=0}push@sub,$push}$token->{line}=$sub[0]->{line};push @$next,$token;$self->set_offset($column);return$next}sub exception {my ($self,$msg)=@_;my$next=$self->next_tokens;$next=[];my$line=@$next ? $next->[0]->{line}: $self->line;my@caller=caller(0);my$yaml='';if (my$nl=$self->next_line){$yaml=join '',@$nl;$yaml=$nl->[1]}my$e=YAML::PP::Exception->new(line=>$line,column=>$self->offset + 1,msg=>$msg,next=>$next,where=>$caller[1].' line ' .$caller[2],yaml=>$yaml,);croak$e}1; YAML_PP_LEXER $fatpacked{"YAML/PP/Loader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_LOADER'; use strict;use warnings;package YAML::PP::Loader;our$VERSION='v0.38.0';use YAML::PP::Parser;use YAML::PP::Constructor;use YAML::PP::Reader;sub new {my ($class,%args)=@_;my$cyclic_refs=delete$args{cyclic_refs}|| 'fatal';my$default_yaml_version=delete$args{default_yaml_version}|| '1.2';my$preserve=delete$args{preserve};my$duplicate_keys=delete$args{duplicate_keys};my$schemas=delete$args{schemas};$schemas ||= {'1.2'=>YAML::PP->default_schema(boolean=>'perl',)};my$constructor=delete$args{constructor}|| YAML::PP::Constructor->new(schemas=>$schemas,cyclic_refs=>$cyclic_refs,default_yaml_version=>$default_yaml_version,preserve=>$preserve,duplicate_keys=>$duplicate_keys,);my$parser=delete$args{parser};unless ($parser){$parser=YAML::PP::Parser->new(default_yaml_version=>$default_yaml_version,)}unless ($parser->receiver){$parser->set_receiver($constructor)}if (keys%args){die "Unexpected arguments: " .join ', ',sort keys%args}my$self=bless {parser=>$parser,constructor=>$constructor,},$class;return$self}sub clone {my ($self)=@_;my$clone={parser=>$self->parser->clone,constructor=>$self->constructor->clone,};bless$clone,ref$self;$clone->parser->set_receiver($clone->constructor);return$clone}sub parser {return $_[0]->{parser}}sub constructor {return $_[0]->{constructor}}sub filename {my ($self)=@_;my$reader=$self->parser->reader;if ($reader->isa('YAML::PP::Reader::File')){return$reader->input}die "Reader is not a YAML::PP::Reader::File"}sub load_string {my ($self,$yaml)=@_;$self->parser->set_reader(YAML::PP::Reader->new(input=>$yaml));$self->load()}sub load_file {my ($self,$file)=@_;$self->parser->set_reader(YAML::PP::Reader::File->new(input=>$file));$self->load()}sub load {my ($self)=@_;my$parser=$self->parser;my$constructor=$self->constructor;$constructor->init;$parser->parse();my$docs=$constructor->docs;return wantarray ? @$docs : $docs->[0]}1; YAML_PP_LOADER $fatpacked{"YAML/PP/Parser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_PARSER'; use strict;use warnings;package YAML::PP::Parser;our$VERSION='v0.38.0';use constant TRACE=>$ENV{YAML_PP_TRACE}? 1 : 0;use constant DEBUG=>($ENV{YAML_PP_DEBUG}|| $ENV{YAML_PP_TRACE})? 1 : 0;use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE/;use YAML::PP::Render;use YAML::PP::Lexer;use YAML::PP::Grammar qw/$GRAMMAR/;use YAML::PP::Exception;use YAML::PP::Reader;use Carp qw/croak/;sub new {my ($class,%args)=@_;my$reader=delete$args{reader}|| YAML::PP::Reader->new;my$default_yaml_version=delete$args{default_yaml_version};my$self=bless {default_yaml_version=>$default_yaml_version || '1.2',lexer=>YAML::PP::Lexer->new(reader=>$reader,),},$class;my$receiver=delete$args{receiver};if ($receiver){$self->set_receiver($receiver)}return$self}sub clone {my ($self)=@_;my$clone={default_yaml_version=>$self->default_yaml_version,lexer=>YAML::PP::Lexer->new(),};return bless$clone,ref$self}sub receiver {return $_[0]->{receiver}}sub set_receiver {my ($self,$receiver)=@_;my$callback;if (ref$receiver eq 'CODE'){$callback=$receiver}else {$callback=sub {my ($self,$event,$info)=@_;return$receiver->$event($info)}}$self->{callback}=$callback;$self->{receiver}=$receiver}sub reader {return $_[0]->lexer->{reader}}sub set_reader {my ($self,$reader)=@_;$self->lexer->set_reader($reader)}sub lexer {return $_[0]->{lexer}}sub callback {return $_[0]->{callback}}sub set_callback {$_[0]->{callback}=$_[1]}sub level {return $#{$_[0]->{offset}}}sub offset {return $_[0]->{offset}}sub set_offset {$_[0]->{offset}=$_[1]}sub events {return $_[0]->{events}}sub set_events {$_[0]->{events}=$_[1]}sub new_node {return $_[0]->{new_node}}sub set_new_node {$_[0]->{new_node}=$_[1]}sub tagmap {return $_[0]->{tagmap}}sub set_tagmap {$_[0]->{tagmap}=$_[1]}sub tokens {return $_[0]->{tokens}}sub set_tokens {$_[0]->{tokens}=$_[1]}sub event_stack {return $_[0]->{event_stack}}sub set_event_stack {$_[0]->{event_stack}=$_[1]}sub default_yaml_version {return $_[0]->{default_yaml_version}}sub yaml_version {return $_[0]->{yaml_version}}sub set_yaml_version {$_[0]->{yaml_version}=$_[1]}sub yaml_version_directive {return $_[0]->{yaml_version_directive}}sub set_yaml_version_directive {$_[0]->{yaml_version_directive}=$_[1]}sub rule {return $_[0]->{rule}}sub set_rule {my ($self,$name)=@_;no warnings 'uninitialized';DEBUG and $self->info("set_rule($name)");$self->{rule}=$name}sub init {my ($self)=@_;$self->set_offset([]);$self->set_events([]);$self->set_new_node(0);$self->set_tagmap({'!!'=>"tag:yaml.org,2002:",});$self->set_tokens([]);$self->set_rule(undef);$self->set_event_stack([]);$self->set_yaml_version($self->default_yaml_version);$self->set_yaml_version_directive(undef);$self->lexer->init}sub parse_string {my ($self,$yaml)=@_;$self->set_reader(YAML::PP::Reader->new(input=>$yaml));$self->parse()}sub parse_file {my ($self,$file)=@_;$self->set_reader(YAML::PP::Reader::File->new(input=>$file));$self->parse()}my%nodetypes=(MAPVALUE=>'NODETYPE_COMPLEX',MAP=>'NODETYPE_MAP',SEQ=>'NODETYPE_SEQ',SEQ0=>'NODETYPE_SEQ',FLOWMAP=>'NODETYPE_FLOWMAP',FLOWMAPVALUE=>'NODETYPE_FLOWMAPVALUE',FLOWSEQ=>'NODETYPE_FLOWSEQ',FLOWSEQ_NEXT=>'FLOWSEQ_NEXT',DOC=>'FULLNODE',DOC_END=>'DOCUMENT_END',STR=>'STREAM',END_FLOW=>'END_FLOW',);sub parse {my ($self)=@_;TRACE and warn "=== parse()\n";TRACE and $self->debug_yaml;$self->init;$self->lexer->init;eval {$self->start_stream;$self->set_rule('STREAM');$self->parse_tokens();$self->end_stream};if (my$error=$@){if (ref$error){croak "$error\n "}croak$error}DEBUG and $self->highlight_yaml;TRACE and $self->debug_tokens}sub lex_next_tokens {my ($self)=@_;DEBUG and $self->info("----------------> lex_next_tokens");TRACE and $self->debug_events;my$indent=$self->offset->[-1];my$event_types=$self->events;my$next_tokens=$self->lexer->fetch_next_tokens($indent);return unless @$next_tokens;my$next=$next_tokens->[0];return 1 if ($next->{name}ne 'SPACE');my$flow=$event_types->[-1]=~ m/^FLOW/;my$space=length$next->{value};my$tokens=$self->tokens;if (not $space){shift @$next_tokens}else {push @$tokens,shift @$next_tokens}if ($flow){if ($space >= $indent){return 1}$self->exception("Bad indendation in " .$self->events->[-1])}$next=$next_tokens->[0];if ($space > $indent){return 1 if$indent < 0;unless ($self->new_node){$self->exception("Bad indendation in " .$self->events->[-1])}return 1}if ($self->new_node){if ($space < $indent){$self->scalar_event({style=>YAML_PLAIN_SCALAR_STYLE,value=>'' });$self->remove_nodes($space)}else {my$exp=$self->events->[-1];my$seq_start=$next->{name}eq 'DASH';if ($seq_start and ($exp eq 'MAPVALUE' or $exp eq 'MAP')){}else {$self->scalar_event({style=>YAML_PLAIN_SCALAR_STYLE,value=>'' })}}}else {if ($space < $indent){$self->remove_nodes($space)}}my$exp=$self->events->[-1];if ($exp eq 'SEQ0' and $next->{name}ne 'DASH'){TRACE and $self->info("In unindented sequence");$self->end_sequence;$exp=$self->events->[-1]}if ($self->offset->[-1]!=$space){$self->exception("Expected " .$self->events->[-1])}return 1}my%next_event=(MAP=>'MAPVALUE',IMAP=>'IMAPVALUE',MAPVALUE=>'MAP',IMAPVALUE=>'IMAP',SEQ=>'SEQ',SEQ0=>'SEQ0',DOC=>'DOC_END',STR=>'STR',FLOWSEQ=>'FLOWSEQ_NEXT',FLOWSEQ_NEXT=>'FLOWSEQ',FLOWMAP=>'FLOWMAPVALUE',FLOWMAPVALUE=>'FLOWMAP',);my%event_to_method=(MAP=>'mapping',IMAP=>'mapping',FLOWMAP=>'mapping',SEQ=>'sequence',SEQ0=>'sequence',FLOWSEQ=>'sequence',DOC=>'document',STR=>'stream',VAL=>'scalar',ALI=>'alias',MAPVALUE=>'mapping',IMAPVALUE=>'mapping',);my%fetch_method=('"'=>'fetch_quoted',"'"=>'fetch_quoted','|'=>'fetch_block','>'=>'fetch_block',''=>'fetch_plain',);sub parse_tokens {my ($self)=@_;my$event_types=$self->events;my$offsets=$self->offset;my$tokens=$self->tokens;my$next_tokens=$self->lexer->next_tokens;unless ($self->lex_next_tokens){$self->end_document(1);return 0}unless ($self->new_node){if ($self->level > 0){my$new_rule=$nodetypes{$event_types->[-1]}or die "Did not find '$event_types->[-1]'";$self->set_rule($new_rule)}}my$rule_name=$self->rule;DEBUG and $self->info("----------------> parse_tokens($rule_name)");my$rule=$GRAMMAR->{$rule_name }or die "Could not find rule $rule_name";TRACE and $self->debug_rules($rule);TRACE and $self->debug_yaml;DEBUG and $self->debug_next_line;RULE: while ($rule_name){DEBUG and $self->info("RULE: $rule_name");TRACE and $self->debug_tokens($next_tokens);unless (@$next_tokens){$self->exception("No more tokens")}TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$next_tokens->[0]],['next_token']);my$got=$next_tokens->[0]->{name};if ($got eq 'CONTEXT'){my$context=shift @$next_tokens;my$indent=$offsets->[-1];$indent++ unless$self->lexer->flowcontext;my$method=$fetch_method{$context->{value}};my$partial=$self->lexer->$method($indent,$context->{value});next RULE}my$def=$rule->{$got };if ($def){push @$tokens,shift @$next_tokens}elsif ($def=$rule->{DEFAULT}){$got='DEFAULT'}else {$self->expected(expected=>[keys %$rule],got=>$next_tokens->[0],)}DEBUG and $self->got("---got $got");if (my$sub=$def->{match}){DEBUG and $self->info("CALLBACK $sub");$self->$sub(@$tokens ? $tokens->[-1]: ())}my$eol=$got eq 'EOL';my$new=$def->{new};if ($new){DEBUG and $self->got("NEW: $new");$rule_name=$new;$self->set_rule($rule_name)}elsif ($eol){}elsif ($def->{return}){$rule_name=$nodetypes{$event_types->[-1]}or die "Unexpected event type $event_types->[-1]";$self->set_rule($rule_name)}else {$rule_name .= " - $got";$rule=$def;next RULE}if ($eol){unless ($self->lex_next_tokens){if ($rule_name eq 'DIRECTIVE'){$self->exception("Directive needs document start")}$self->end_document(1);return 0}unless ($self->new_node){if ($self->level > 0){$rule_name=$nodetypes{$event_types->[-1]}or die "Did not find '$event_types->[-1]'";$self->set_rule($rule_name)}}$rule_name=$self->rule}$rule=$GRAMMAR->{$rule_name }or die "Unexpected rule $rule_name"}die "Unexpected"}sub end_sequence {my ($self)=@_;my$event_types=$self->events;pop @{$event_types};pop @{$self->offset};my$info={name=>'sequence_end_event' };$self->callback->($self,$info->{name}=>$info);$event_types->[-1]=$next_event{$event_types->[-1]}}sub remove_nodes {my ($self,$space)=@_;my$offset=$self->offset;my$event_types=$self->events;my$exp=$event_types->[-1];while (@$offset){if ($offset->[-1 ]<= $space){last}if ($exp eq 'MAPVALUE'){$self->scalar_event({style=>YAML_PLAIN_SCALAR_STYLE,value=>'' });$exp='MAP'}my$info={name=>$exp };$info->{name}=$event_to_method{$exp }.'_end_event';pop @{$event_types};pop @{$offset};$self->callback->($self,$info->{name}=>$info);$event_types->[-1]=$next_event{$event_types->[-1]};$exp=$event_types->[-1]}return$exp}sub start_stream {my ($self)=@_;push @{$self->events},'STR';push @{$self->offset},-1;$self->callback->($self,'stream_start_event',{name=>'stream_start_event',})}sub start_document {my ($self,$implicit)=@_;push @{$self->events},'DOC';push @{$self->offset},-1;my$directive=$self->yaml_version_directive;my%directive;if ($directive){my ($major,$minor)=split m/\./,$self->yaml_version;%directive=(version_directive=>{major=>$major,minor=>$minor })}$self->callback->($self,'document_start_event',{name=>'document_start_event',implicit=>$implicit,%directive,});$self->set_yaml_version_directive(undef);$self->set_rule('FULLNODE');$self->set_new_node(1)}sub start_sequence {my ($self,$offset)=@_;my$offsets=$self->offset;if ($offsets->[-1]==$offset){push @{$self->events},'SEQ0'}else {push @{$self->events},'SEQ'}push @{$offsets},$offset;my$event_stack=$self->event_stack;my$info={name=>'sequence_start_event' };if (@$event_stack and $event_stack->[-1]->[0]eq 'properties'){my$properties=pop @$event_stack;$self->node_properties($properties->[1],$info)}$self->callback->($self,'sequence_start_event',$info)}sub start_flow_sequence {my ($self,$offset)=@_;my$offsets=$self->offset;my$new_offset=$offsets->[-1];my$event_types=$self->events;if ($new_offset < 0){$new_offset=0}elsif ($self->new_node){if ($event_types->[-1]!~ m/^FLOW/){$new_offset++}}push @{$self->events},'FLOWSEQ';push @{$offsets},$new_offset;my$event_stack=$self->event_stack;my$info={style=>YAML_FLOW_SEQUENCE_STYLE,name=>'sequence_start_event' };if (@$event_stack and $event_stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($event_stack,$info)}$self->callback->($self,'sequence_start_event',$info)}sub start_flow_mapping {my ($self,$offset,$implicit_flowseq_map)=@_;my$offsets=$self->offset;my$new_offset=$offsets->[-1];my$event_types=$self->events;if ($new_offset < 0){$new_offset=0}elsif ($self->new_node){if ($event_types->[-1]!~ m/^FLOW/){$new_offset++}}push @{$self->events},$implicit_flowseq_map ? 'IMAP' : 'FLOWMAP';push @{$offsets},$new_offset;my$event_stack=$self->event_stack;my$info={name=>'mapping_start_event',style=>YAML_FLOW_MAPPING_STYLE };if (@$event_stack and $event_stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($event_stack,$info)}$self->callback->($self,'mapping_start_event',$info)}sub end_flow_sequence {my ($self)=@_;my$event_types=$self->events;pop @{$event_types};pop @{$self->offset};my$info={name=>'sequence_end_event' };$self->callback->($self,$info->{name},$info);if ($event_types->[-1]=~ m/^FLOW|^IMAP/){$event_types->[-1]=$next_event{$event_types->[-1]}}else {push @$event_types,'END_FLOW'}}sub end_flow_mapping {my ($self)=@_;my$event_types=$self->events;pop @{$event_types};pop @{$self->offset};my$info={name=>'mapping_end_event' };$self->callback->($self,$info->{name},$info);if ($event_types->[-1]=~ m/^FLOW|^IMAP/){$event_types->[-1]=$next_event{$event_types->[-1]}}else {push @$event_types,'END_FLOW'}}sub cb_end_outer_flow {my ($self)=@_;my$event_types=$self->events;pop @$event_types;$event_types->[-1]=$next_event{$event_types->[-1]}}sub start_mapping {my ($self,$offset)=@_;my$offsets=$self->offset;push @{$self->events},'MAP';push @{$offsets},$offset;my$event_stack=$self->event_stack;my$info={name=>'mapping_start_event' };if (@$event_stack and $event_stack->[-1]->[0]eq 'properties'){my$properties=pop @$event_stack;$self->node_properties($properties->[1],$info)}$self->callback->($self,'mapping_start_event',$info)}sub end_document {my ($self,$implicit)=@_;my$event_types=$self->events;if ($event_types->[-1]=~ m/FLOW/){die "Unexpected end of flow context"}if ($self->new_node){$self->scalar_event({style=>YAML_PLAIN_SCALAR_STYLE,value=>'' })}$self->remove_nodes(-1);if ($event_types->[-1]eq 'STR'){return}my$last=pop @{$event_types};if ($last ne 'DOC' and $last ne 'DOC_END'){$self->exception("Unexpected event type $last")}pop @{$self->offset};$self->callback->($self,'document_end_event',{name=>'document_end_event',implicit=>$implicit,});if ($self->yaml_version eq '1.2'){$self->set_tagmap({'!!'=>"tag:yaml.org,2002:" })}$event_types->[-1]=$next_event{$event_types->[-1]};$self->set_rule('STREAM')}sub end_stream {my ($self)=@_;my$last=pop @{$self->events};$self->exception("Unexpected event type $last")unless$last eq 'STR';pop @{$self->offset};$self->callback->($self,'stream_end_event',{name=>'stream_end_event',})}sub fetch_inline_properties {my ($self,$stack,$info)=@_;my$properties=$stack->[-1];$properties=$properties->[1];my$property_offset;if ($properties){for my$p (@{$properties->{inline}}){my$type=$p->{type};if (exists$info->{$type }){$self->exception("A node can only have one $type")}$info->{$type }=$p->{value};unless (defined$property_offset){$property_offset=$p->{offset};$info->{offset}=$p->{offset}}}delete$properties->{inline};undef$properties unless$properties->{newline}}unless ($properties){pop @$stack}}sub node_properties {my ($self,$properties,$info)=@_;if ($properties){for my$p (@{$properties->{newline}}){my$type=$p->{type};if (exists$info->{$type }){$self->exception("A node can only have one $type")}$info->{$type }=$p->{value}}undef$properties}}sub scalar_event {my ($self,$info)=@_;my$event_types=$self->events;my$event_stack=$self->event_stack;if (@$event_stack and $event_stack->[-1]->[0]eq 'properties'){my$properties=pop @$event_stack;$properties=$self->node_properties($properties->[1],$info)}$info->{name}='scalar_event';$self->callback->($self,'scalar_event',$info);$self->set_new_node(0);$event_types->[-1]=$next_event{$event_types->[-1]}}sub alias_event {my ($self,$info)=@_;my$event_stack=$self->event_stack;if (@$event_stack and $event_stack->[-1]->[0]eq 'properties'){$self->exception("Parse error: Alias not allowed in this context")}my$event_types=$self->events;$info->{name}='alias_event';$self->callback->($self,'alias_event',$info);$self->set_new_node(0);$event_types->[-1]=$next_event{$event_types->[-1]}}sub yaml_to_tokens {my ($class,$type,$input)=@_;my$yp=YAML::PP::Parser->new(receiver=>sub {});my@docs=eval {$type eq 'string' ? $yp->parse_string($input): $yp->parse_file($input)};my$error=$@;my$tokens=$yp->tokens;if ($error){my$remaining_tokens=$yp->_remaining_tokens;push @$tokens,map {+{%$_,name=>'ERROR' }}@$remaining_tokens}return$error,$tokens}sub _remaining_tokens {my ($self)=@_;my@tokens;my$next=$self->lexer->next_tokens;push@tokens,@$next;my$next_line=$self->lexer->next_line;my$remaining='';if ($next_line){if ($self->lexer->offset > 0){$remaining=$next_line->[1].$next_line->[2]}else {$remaining=join '',@$next_line}}$remaining .= $self->reader->read;$remaining='' unless defined$remaining;push@tokens,{name=>"ERROR",value=>$remaining };return \@tokens}sub event_to_test_suite {my ($self,$event)=@_;if (ref$event eq 'ARRAY'){return YAML::PP::Common::event_to_test_suite($event->[1])}return YAML::PP::Common::event_to_test_suite($event)}sub debug_events {my ($self)=@_;$self->note("EVENTS: (" .join (' | ',@{$_[0]->events}).')');$self->debug_offset}sub debug_offset {my ($self)=@_;$self->note(qq{OFFSET: (} .join (' | ',map {defined $_ ? sprintf "%-3d",$_ : '?'}@{$_[0]->offset}).qq/) level=@{[ $_[0]->level ]}]}/)}sub debug_yaml {my ($self)=@_;my$line=$self->lexer->line;$self->note("LINE NUMBER: $line");my$next_tokens=$self->lexer->next_tokens;if (@$next_tokens){$self->debug_tokens($next_tokens)}}sub debug_next_line {my ($self)=@_;my$next_line=$self->lexer->next_line || [];my$line=$next_line->[0];$line='' unless defined$line;$line =~ s/( +)$/'·' x length $1/e;$line =~ s/\t/▸/g;$self->note("NEXT LINE: >>$line<<")}sub note {my ($self,$msg)=@_;$self->_colorize_warn(["yellow"],"============ $msg")}sub info {my ($self,$msg)=@_;$self->_colorize_warn(["cyan"],"============ $msg")}sub got {my ($self,$msg)=@_;$self->_colorize_warn(["green"],"============ $msg")}sub _colorize_warn {my ($self,$colors,$text)=@_;require Term::ANSIColor;warn Term::ANSIColor::colored($colors,$text),"\n"}sub debug_event {my ($self,$event)=@_;my$str=YAML::PP::Common::event_to_test_suite($event);require Term::ANSIColor;warn Term::ANSIColor::colored(["magenta"],"============ $str"),"\n"}sub debug_rules {my ($self,$rules)=@_;local$Data::Dumper::Maxdepth=2;$self->note("RULES:");for my$rule ($rules){if (ref$rule eq 'ARRAY'){my$first=$rule->[0];if (ref$first eq 'SCALAR'){$self->info("-> $$first")}else {if (ref$first eq 'ARRAY'){$first=$first->[0]}$self->info("TYPE $first")}}else {eval {my@keys=sort keys %$rule;$self->info("@keys")}}}}sub debug_tokens {my ($self,$tokens)=@_;$tokens ||= $self->tokens;require Term::ANSIColor;for my$token (@$tokens){my$type=Term::ANSIColor::colored(["green"],sprintf "%-22s L %2d C %2d ",$token->{name},$token->{line},$token->{column}+ 1);local$Data::Dumper::Useqq=1;local$Data::Dumper::Terse=1;require Data::Dumper;my$str=Data::Dumper->Dump([$token->{value}],['str']);chomp$str;$str =~ s/(^.|.$)/Term::ANSIColor::colored(['blue'], $1)/ge;warn "$type$str\n"}}sub highlight_yaml {my ($self)=@_;require YAML::PP::Highlight;my$tokens=$self->tokens;my$highlighted=YAML::PP::Highlight->ansicolored($tokens);warn$highlighted}sub exception {my ($self,$msg,%args)=@_;my$next=$self->lexer->next_tokens;my$line=@$next ? $next->[0]->{line}: $self->lexer->line;my$offset=@$next ? $next->[0]->{column}: $self->lexer->offset;$offset++;my$next_line=$self->lexer->next_line;my$remaining='';if ($next_line){if ($self->lexer->offset > 0){$remaining=$next_line->[1].$next_line->[2]}else {$remaining=join '',@$next_line}}my$caller=$args{caller}|| [caller(0)];my$e=YAML::PP::Exception->new(got=>$args{got},expected=>$args{expected},line=>$line,column=>$offset,msg=>$msg,next=>$next,where=>$caller->[1].' line ' .$caller->[2],yaml=>$remaining,);croak$e}sub expected {my ($self,%args)=@_;my$expected=$args{expected};@$expected=sort grep {m/^[A-Z_]+$/}@$expected;my$got=$args{got}->{name};my@caller=caller(0);$self->exception("Expected (@$expected), but got $got",caller=>\@caller,expected=>$expected,got=>$args{got},)}sub cb_tag {my ($self,$token)=@_;my$stack=$self->event_stack;if (!@$stack or $stack->[-1]->[0]ne 'properties'){push @$stack,[properties=>{}]}my$last=$stack->[-1]->[1];my$tag=$self->_read_tag($token->{value},$self->tagmap);$last->{inline}||= [];push @{$last->{inline}},{type=>'tag',value=>$tag,offset=>$token->{column},}}sub _read_tag {my ($self,$tag,$map)=@_;if ($tag eq '!'){return "!"}elsif ($tag =~ m/^!<(.*)>/){return $1}elsif ($tag =~ m/^(![^!]*!|!)(.+)/){my$alias=$1;my$name=$2;$name =~ s/%([0-9a-fA-F]{2})/chr hex $1/eg;if (exists$map->{$alias }){$tag=$map->{$alias }.$name}else {if ($alias ne '!' and $alias ne '!!'){die "Found undefined tag handle '$alias'"}$tag="!$name"}}else {die "Invalid tag"}return$tag}sub cb_anchor {my ($self,$token)=@_;my$anchor=$token->{value};$anchor=substr($anchor,1);my$stack=$self->event_stack;if (!@$stack or $stack->[-1]->[0]ne 'properties'){push @$stack,[properties=>{}]}my$last=$stack->[-1]->[1];$last->{inline}||= [];push @{$last->{inline}},{type=>'anchor',value=>$anchor,offset=>$token->{column},}}sub cb_property_eol {my ($self,$res)=@_;my$stack=$self->event_stack;my$last=$stack->[-1]->[1];my$inline=delete$last->{inline}or return;my$newline=$last->{newline}||= [];push @$newline,@$inline}sub cb_mapkey {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}push @{$stack},[scalar=>$info ]}sub cb_send_mapkey {my ($self,$res)=@_;my$last=pop @{$self->event_stack};$self->scalar_event($last->[1]);$self->set_new_node(1)}sub cb_send_scalar {my ($self,$res)=@_;my$last=pop @{$self->event_stack};return unless$last;$self->scalar_event($last->[1]);my$e=$self->events;if ($e->[-1]eq 'IMAP'){$self->end_flow_mapping}}sub cb_empty_mapkey {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>'',offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}$self->scalar_event($info);$self->set_new_node(1)}sub cb_send_flow_alias {my ($self,$token)=@_;my$alias=substr($token->{value},1);$self->alias_event({value=>$alias })}sub cb_send_alias {my ($self,$token)=@_;my$alias=substr($token->{value},1);$self->alias_event({value=>$alias })}sub cb_send_alias_key {my ($self,$token)=@_;my$alias=substr($token->{value},1);$self->alias_event({value=>$alias });$self->set_new_node(1)}sub cb_send_alias_from_stack {my ($self,$token)=@_;my$last=pop @{$self->event_stack};$self->alias_event($last->[1])}sub cb_alias {my ($self,$token)=@_;my$alias=substr($token->{value},1);push @{$self->event_stack},[alias=>{value=>$alias,offset=>$token->{column},}]}sub cb_question {my ($self,$res)=@_;$self->set_new_node(1)}sub cb_flow_question {my ($self,$res)=@_;$self->set_new_node(2)}sub cb_empty_complexvalue {my ($self,$res)=@_;$self->scalar_event({style=>YAML_PLAIN_SCALAR_STYLE,value=>'' })}sub cb_questionstart {my ($self,$token)=@_;$self->start_mapping($token->{column})}sub cb_complexcolon {my ($self,$res)=@_;$self->set_new_node(1)}sub cb_seqstart {my ($self,$token)=@_;my$column=$token->{column};$self->start_sequence($column);$self->set_new_node(1)}sub cb_seqitem {my ($self,$res)=@_;$self->set_new_node(1)}sub cb_take_quoted {my ($self,$token)=@_;my$subtokens=$token->{subtokens};my$stack=$self->event_stack;my$info={style=>$subtokens->[0]->{value}eq '"' ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_SINGLE_QUOTED_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}push @{$stack},[scalar=>$info ]}sub cb_quoted_multiline {my ($self,$token)=@_;my$subtokens=$token->{subtokens};my$stack=$self->event_stack;my$info={style=>$subtokens->[0]->{value}eq '"' ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_SINGLE_QUOTED_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}push @{$stack},[scalar=>$info ];$self->cb_send_scalar}sub cb_take_quoted_key {my ($self,$token)=@_;$self->cb_take_quoted($token);$self->cb_send_mapkey}sub cb_send_plain_multi {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}push @{$stack},[scalar=>$info ];$self->cb_send_scalar}sub cb_start_plain {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}push @{$stack},[scalar=>$info ]}sub cb_start_flowseq {my ($self,$token)=@_;$self->start_flow_sequence($token->{column})}sub cb_start_flowmap {my ($self,$token)=@_;$self->start_flow_mapping($token->{column})}sub cb_end_flowseq {my ($self,$res)=@_;$self->cb_send_scalar;$self->end_flow_sequence;$self->set_new_node(0)}sub cb_flow_comma {my ($self)=@_;my$event_types=$self->events;$self->set_new_node(0);if ($event_types->[-1]=~ m/^FLOWSEQ/){$self->cb_send_scalar;$event_types->[-1]=$next_event{$event_types->[-1]}}}sub cb_flow_colon {my ($self)=@_;$self->set_new_node(1)}sub cb_empty_flow_mapkey {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>'',offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}$self->scalar_event($info)}sub cb_end_flowmap {my ($self,$res)=@_;$self->end_flow_mapping;$self->set_new_node(0)}sub cb_end_flowmap_empty {my ($self,$res)=@_;$self->cb_empty_flowmap_value;$self->end_flow_mapping;$self->set_new_node(0)}sub cb_flowkey_plain {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}$self->scalar_event($info)}sub cb_flowkey_quoted {my ($self,$token)=@_;my$stack=$self->event_stack;my$subtokens=$token->{subtokens};my$info={style=>$subtokens->[0]->{value}eq '"' ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_SINGLE_QUOTED_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}$self->scalar_event($info)}sub cb_empty_flowmap_key_value {my ($self,$token)=@_;$self->cb_empty_flow_mapkey($token);$self->cb_empty_flowmap_value;$self->cb_flow_comma}sub cb_end_empty_flowmap_key_value {my ($self,$token)=@_;$self->cb_empty_flow_mapkey($token);$self->cb_empty_flowmap_value;$self->cb_flow_comma;$self->cb_end_flowmap}sub cb_empty_flowmap_value {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>'',offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}$self->scalar_event($info)}sub cb_empty_flowseq_comma {my ($self,$token)=@_;$self->cb_empty_flowmap_value($token);$self->cb_flow_comma}sub cb_empty_flowseq_end {my ($self,$token)=@_;$self->cb_empty_flowmap_value($token);$self->cb_end_flowseq}sub cb_insert_map_alias {my ($self,$res)=@_;my$stack=$self->event_stack;my$scalar=pop @$stack;my$info=$scalar->[1];$self->start_mapping($info->{offset});$self->alias_event($info);$self->set_new_node(1)}sub cb_insert_map {my ($self,$res)=@_;my$stack=$self->event_stack;my$scalar=pop @$stack;my$info=$scalar->[1];$self->start_mapping($info->{offset});$self->scalar_event($info);$self->set_new_node(1)}sub cb_insert_implicit_flowseq_map {my ($self,$res)=@_;my$stack=$self->event_stack;my$scalar=pop @$stack;my$info=$scalar->[1];$self->start_flow_mapping($info->{offset},1);$self->scalar_event($info);$self->set_new_node(1)}sub cb_insert_empty_implicit_flowseq_map {my ($self,$res)=@_;my$stack=$self->event_stack;my$scalar=pop @$stack;my$info=$scalar->[1];$self->start_flow_mapping($info->{offset},1);$self->cb_empty_flowmap_value;$self->set_new_node(2)}sub cb_insert_empty_map {my ($self,$token)=@_;my$stack=$self->event_stack;my$info={style=>YAML_PLAIN_SCALAR_STYLE,value=>'',offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}$self->start_mapping($info->{offset});$self->scalar_event($info);$self->set_new_node(1)}sub cb_send_block_scalar {my ($self,$token)=@_;my$type=$token->{subtokens}->[0]->{value};my$stack=$self->event_stack;my$info={style=>$type eq '|' ? YAML_LITERAL_SCALAR_STYLE : YAML_FOLDED_SCALAR_STYLE,value=>$token->{value},offset=>$token->{column},};if (@$stack and $stack->[-1]->[0]eq 'properties'){$self->fetch_inline_properties($stack,$info)}push @{$self->event_stack},[scalar=>$info ];$self->cb_send_scalar}sub cb_end_document {my ($self,$token)=@_;$self->end_document(0)}sub cb_end_document_empty {my ($self,$token)=@_;$self->end_document(0)}sub cb_doc_start_implicit {my ($self,$token)=@_;$self->start_document(1)}sub cb_doc_start_explicit {my ($self,$token)=@_;$self->start_document(0)}sub cb_end_doc_start_document {my ($self,$token)=@_;$self->end_document(1);$self->start_document(0)}sub cb_tag_directive {my ($self,$token)=@_;my ($name,$tag_alias,$tag_url)=split ' ',$token->{value};$self->tagmap->{$tag_alias }=$tag_url}sub cb_reserved_directive {}sub cb_set_yaml_version_directive {my ($self,$token)=@_;if ($self->yaml_version_directive){croak "Found duplicate YAML directive"}my ($version)=$token->{value}=~ m/^%YAML[ \t]+(1\.[12])/;$self->set_yaml_version($version || '1.2');$self->set_yaml_version_directive(1)}1; YAML_PP_PARSER $fatpacked{"YAML/PP/Perl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_PERL'; use strict;use warnings;package YAML::PP::Perl;our$VERSION='v0.38.0';use base 'Exporter';use base 'YAML::PP';our@EXPORT_OK=qw/Load Dump LoadFile DumpFile/;use YAML::PP;use YAML::PP::Schema::Perl;sub new {my ($class,%args)=@_;$args{schema}||= [qw/Core Perl/];$class->SUPER::new(%args)}sub Load {my ($yaml)=@_;__PACKAGE__->new->load_string($yaml)}sub LoadFile {my ($file)=@_;__PACKAGE__->new->load_file($file)}sub Dump {my (@data)=@_;__PACKAGE__->new->dump_string(@data)}sub DumpFile {my ($file,@data)=@_;__PACKAGE__->new->dump_file($file,@data)}1; YAML_PP_PERL $fatpacked{"YAML/PP/Reader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_READER'; use strict;use warnings;package YAML::PP::Reader;our$VERSION='v0.38.0';sub input {return $_[0]->{input}}sub set_input {$_[0]->{input}=$_[1]}sub new {my ($class,%args)=@_;my$input=delete$args{input};return bless {input=>$input,},$class}sub read {my ($self)=@_;my$pos=pos$self->{input}|| 0;my$yaml=substr($self->{input},$pos);$self->{input}='';return$yaml}sub readline {my ($self)=@_;unless (length$self->{input}){return}if ($self->{input}=~ m/\G([^\r\n]*(?:\n|\r\n|\r|\z))/g){my$line=$1;unless (length$line){$self->{input}='';return}return$line}return}package YAML::PP::Reader::File;use Scalar::Util qw/openhandle/;our@ISA=qw/YAML::PP::Reader/;use Carp qw/croak/;sub open_handle {if (openhandle($_[0]->{input})){return $_[0]->{input}}open my$fh,'<:encoding(UTF-8)',$_[0]->{input}or croak "Could not open '$_[0]->{input}' for reading: $!";return$fh}sub read {my$fh=$_[0]->{filehandle}||= $_[0]->open_handle;if (wantarray){my@yaml=<$fh>;return@yaml}else {local $/;my$yaml=<$fh>;return$yaml}}sub readline {my$fh=$_[0]->{filehandle}||= $_[0]->open_handle;return scalar <$fh>}1; YAML_PP_READER $fatpacked{"YAML/PP/Render.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_RENDER'; use strict;use warnings;package YAML::PP::Render;our$VERSION='v0.38.0';use constant TRACE=>$ENV{YAML_PP_TRACE}? 1 : 0;sub render_quoted {my ($self,$style,$lines)=@_;my$quoted='';my$addspace=0;for my$i (0 .. $#$lines){my$line=$lines->[$i ];my$value=$line->{value};my$last=$i==$#$lines;my$first=$i==0;if ($value eq ''){if ($first){$addspace=1}elsif ($last){$quoted .= ' ' if$addspace}else {$addspace=0;$quoted .= "\n"}next}$quoted .= ' ' if$addspace;$addspace=1;if ($style eq '"'){if ($line->{orig}=~ m/\\$/){$line->{value}=~ s/\\$//;$value =~ s/\\$//;$addspace=0}}$quoted .= $value}return$quoted}sub render_block_scalar {my ($self,$block_type,$chomp,$lines)=@_;my ($folded,$keep,$trim);if ($block_type eq '>'){$folded=1}if ($chomp eq '+'){$keep=1}elsif ($chomp eq '-'){$trim=1}my$string='';if (not $keep){while (@$lines){last if$lines->[-1]ne '';pop @$lines}}if ($folded){my$prev='START';my$trailing='';if ($keep){while (@$lines and $lines->[-1]eq ''){pop @$lines;$trailing .= "\n"}}for my$i (0 .. $#$lines){my$line=$lines->[$i ];my$type=$line eq '' ? 'EMPTY' : $line =~ m/\A[ \t]/ ? 'MORE' : 'CONTENT';if ($prev eq 'MORE' and $type eq 'EMPTY'){$type='MORE'}elsif ($prev eq 'CONTENT'){if ($type ne 'CONTENT'){$string .= "\n"}elsif ($type eq 'CONTENT'){$string .= ' '}}elsif ($prev eq 'START' and $type eq 'EMPTY'){$string .= "\n";$type='START'}elsif ($prev eq 'EMPTY' and $type ne 'CONTENT'){$string .= "\n"}$string .= $line;if ($type eq 'MORE' and $i < $#$lines){$string .= "\n"}$prev=$type}if ($keep){$string .= $trailing}$string .= "\n" if @$lines and not $trim}else {for my$i (0 .. $#$lines){$string .= $lines->[$i ];$string .= "\n" if ($i!=$#$lines or not $trim)}}TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$string],['string']);return$string}sub render_multi_val {my ($self,$multi)=@_;my$string='';my$start=1;for my$line (@$multi){if (not $start){if ($line eq ''){$string .= "\n";$start=1}else {$string .= " $line"}}else {$string .= $line;$start=0}}return$string}1; YAML_PP_RENDER $fatpacked{"YAML/PP/Representer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_REPRESENTER'; use strict;use warnings;package YAML::PP::Representer;our$VERSION='v0.38.0';use Scalar::Util qw/reftype blessed refaddr/;use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE YAML_ANY_SCALAR_STYLE YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE YAML_BLOCK_MAPPING_STYLE YAML_BLOCK_SEQUENCE_STYLE PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS/;use B;sub new {my ($class,%args)=@_;my$preserve=delete$args{preserve}|| 0;if ($preserve==1){$preserve=PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS}my$self=bless {schema=>delete$args{schema},preserve=>$preserve,},$class;if (keys%args){die "Unexpected arguments: " .join ', ',sort keys%args}return$self}sub clone {my ($self)=@_;my$clone={schema=>$self->schema,preserve=>$self->{preserve},};return bless$clone,ref$self}sub schema {return $_[0]->{schema}}sub preserve_order {return $_[0]->{preserve}& PRESERVE_ORDER}sub preserve_scalar_style {return $_[0]->{preserve}& PRESERVE_SCALAR_STYLE}sub preserve_flow_style {return $_[0]->{preserve}& PRESERVE_FLOW_STYLE}sub preserve_alias {return $_[0]->{preserve}& PRESERVE_ALIAS}sub represent_node {my ($self,$node)=@_;my$preserve_alias=$self->preserve_alias;my$preserve_style=$self->preserve_scalar_style;if ($preserve_style or $preserve_alias){if (ref$node->{value}eq 'YAML::PP::Preserve::Scalar'){my$value=$node->{value}->value;if ($preserve_style){$node->{style}=$node->{value}->style}$node->{value}=$value}}$node->{reftype}=reftype($node->{value});if (not $node->{reftype}and reftype(\$node->{value})eq 'GLOB'){$node->{reftype}='GLOB'}if ($node->{reftype}){$self->_represent_noderef($node)}else {$self->_represent_node_nonref($node)}$node->{reftype}=(reftype$node->{data})|| '';if ($node->{reftype}eq 'HASH' and my$tied=tied(%{$node->{data}})){my$representers=$self->schema->representers;$tied=ref$tied;if (my$def=$representers->{tied_equals}->{$tied }){my$code=$def->{code};my$done=$code->($self,$node)}}if ($node->{reftype}eq 'HASH'){unless (defined$node->{items}){my@keys;if ($self->preserve_order){@keys=keys %{$node->{data}}}else {@keys=sort keys %{$node->{data}}}for my$key (@keys){push @{$node->{items}},$key,$node->{data}->{$key }}}my%args;if ($self->preserve_flow_style and reftype$node->{value}eq 'HASH'){if (my$tied=tied %{$node->{value}}){$args{style}=$tied->{style}}}return [mapping=>$node,%args ]}elsif ($node->{reftype}eq 'ARRAY'){unless (defined$node->{items}){@{$node->{items}}=@{$node->{data}}}my%args;if ($self->preserve_flow_style and reftype$node->{value}eq 'ARRAY'){if (my$tied=tied @{$node->{value}}){$args{style}=$tied->{style}}}return [sequence=>$node,%args ]}elsif ($node->{reftype}){die "Cannot handle reftype '$node->{reftype}' (you might want to enable YAML::PP::Schema::Perl)"}else {unless (defined$node->{items}){$node->{items}=[$node->{data}]}return [scalar=>$node ]}}my$bool_code=<<'EOM';my$is_bool;sub _represent_node_nonref {my ($self,$node)=@_;my$representers=$self->schema->representers;if (not defined$node->{value}){if (my$undef=$representers->{undef}){return 1 if$undef->($self,$node)}else {$node->{style}=YAML_SINGLE_QUOTED_SCALAR_STYLE;$node->{data}='';return 1}}if ($] >= 5.036000 and my$rep=$representers->{bool}){$is_bool ||= eval$bool_code;if ($is_bool->($node->{value})){return$rep->{code}->($self,$node)}}for my$rep (@{$representers->{flags}}){my$check_flags=$rep->{flags};my$flags=B::svref_2object(\$node->{value})->FLAGS;if ($flags & $check_flags){return 1 if$rep->{code}->($self,$node)}}if (my$rep=$representers->{equals}->{$node->{value}}){return 1 if$rep->{code}->($self,$node)}for my$rep (@{$representers->{regex}}){if ($node->{value}=~ $rep->{regex}){return 1 if$rep->{code}->($self,$node)}}unless (defined$node->{data}){$node->{data}=$node->{value}}unless (defined$node->{style}){$node->{style}=YAML_ANY_SCALAR_STYLE;$node->{style}=""}}sub _represent_noderef {my ($self,$node)=@_;my$representers=$self->schema->representers;if (my$classname=blessed($node->{value})){if (my$def=$representers->{class_equals}->{$classname }){my$code=$def->{code};return 1 if$code->($self,$node)}for my$matches (@{$representers->{class_matches}}){my ($re,$code)=@$matches;if (ref$re and $classname =~ $re or $re){return 1 if$code->($self,$node)}}for my$isa (@{$representers->{class_isa}}){my ($class_name,$code)=@$isa;if ($node->{value }->isa($class_name)){return 1 if$code->($self,$node)}}}if ($node->{reftype}eq 'SCALAR' and my$scalarref=$representers->{scalarref}){my$code=$scalarref->{code};return 1 if$code->($self,$node)}if ($node->{reftype}eq 'REF' and my$refref=$representers->{refref}){my$code=$refref->{code};return 1 if$code->($self,$node)}if ($node->{reftype}eq 'CODE' and my$coderef=$representers->{coderef}){my$code=$coderef->{code};return 1 if$code->($self,$node)}if ($node->{reftype}eq 'GLOB' and my$glob=$representers->{glob}){my$code=$glob->{code};return 1 if$code->($self,$node)}$node->{data}=$node->{value}}1; sub { my ($x) = @_; use experimental qw/ builtin /; builtin::is_bool($x); } EOM YAML_PP_REPRESENTER $fatpacked{"YAML/PP/Schema.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA'; use strict;use warnings;package YAML::PP::Schema;use B;use Module::Load qw//;our$VERSION='v0.38.0';use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE/;use Scalar::Util qw/blessed/;sub new {my ($class,%args)=@_;my$yaml_version=delete$args{yaml_version};my$bool=delete$args{boolean};$bool='perl' unless defined$bool;if (keys%args){die "Unexpected arguments: " .join ', ',sort keys%args}my$true;my$false;my@bool_class;my@bools=split m/,/,$bool;for my$b (@bools){if ($b eq '*'){push@bool_class,('boolean','JSON::PP::Boolean');last}elsif ($b eq 'JSON::PP'){require JSON::PP;$true ||= \&_bool_jsonpp_true;$false ||= \&_bool_jsonpp_false;push@bool_class,'JSON::PP::Boolean'}elsif ($b eq 'boolean'){require boolean;$true ||= \&_bool_booleanpm_true;$false ||= \&_bool_booleanpm_false;push@bool_class,'boolean'}elsif ($b eq 'perl' or $b eq 'perl_experimental'){push@bool_class,'perl'}else {die "Invalid value for 'boolean': '$b'. Allowed: ('perl', 'boolean', 'JSON::PP')"}}$true ||= \&_bool_perl_true;$false ||= \&_bool_perl_false;my%representers=('undef'=>undef,flags=>[],equals=>{},regex=>[],class_equals=>{},class_matches=>[],class_isa=>[],scalarref=>undef,refref=>undef,coderef=>undef,glob=>undef,tied_equals=>{},bool=>undef,);my$self=bless {yaml_version=>$yaml_version,resolvers=>{},representers=>\%representers,true=>$true,false=>$false,bool_class=>\@bool_class,},$class;return$self}sub resolvers {return $_[0]->{resolvers}}sub representers {return $_[0]->{representers}}sub true {return $_[0]->{true}}sub false {return $_[0]->{false}}sub bool_class {return @{$_[0]->{bool_class}}? $_[0]->{bool_class}: undef}sub yaml_version {return $_[0]->{yaml_version}}my%LOADED_SCHEMA=(JSON=>1,);my%DEFAULT_SCHEMA=('1.2'=>'Core','1.1'=>'YAML1_1',);sub load_subschemas {my ($self,@schemas)=@_;my$yaml_version=$self->yaml_version;my$i=0;while ($i < @schemas){my$item=$schemas[$i ];if ($item eq '+'){$item=$DEFAULT_SCHEMA{$yaml_version }}$i++;if (blessed($item)){$item->register(schema=>$self,);next}my@options;while ($i < @schemas and ($schemas[$i ]=~ m/^[^A-Za-z]/ or $schemas[$i ]=~ m/^[a-zA-Z0-9]+=/)){push@options,$schemas[$i ];$i++}my$class;if ($item =~ m/^\:(.*)/){$class="$1";unless ($class =~ m/\A[A-Za-z0-9_:]+\z/){die "Module name '$class' is invalid"}Module::Load::load$class}else {$class="YAML::PP::Schema::$item";unless ($class =~ m/\A[A-Za-z0-9_:]+\z/){die "Module name '$class' is invalid"}$LOADED_SCHEMA{$item }||= Module::Load::load$class}$class->register(schema=>$self,options=>\@options,)}}sub add_resolver {my ($self,%args)=@_;my$tag=$args{tag};my$rule=$args{match};my$resolvers=$self->resolvers;my ($type,@rule)=@$rule;my$implicit=$args{implicit};$implicit=1 unless defined$implicit;my$resolver_list=[];if ($tag){if (ref$tag eq 'Regexp'){my$res=$resolvers->{tags}||= [];push @$res,[$tag,{}];push @$resolver_list,$res->[-1]->[1]}else {my$res=$resolvers->{tag}->{$tag }||= {};push @$resolver_list,$res}}if ($implicit){push @$resolver_list,$resolvers->{value}||= {}}for my$res (@$resolver_list){if ($type eq 'equals'){my ($match,$value)=@rule;unless (exists$res->{equals}->{$match }){$res->{equals}->{$match }=$value}next}elsif ($type eq 'regex'){my ($match,$value)=@rule;push @{$res->{regex}},[$match=>$value ]}elsif ($type eq 'all'){my ($value)=@rule;$res->{all}=$value}}}sub add_sequence_resolver {my ($self,%args)=@_;return$self->add_collection_resolver(sequence=>%args)}sub add_mapping_resolver {my ($self,%args)=@_;return$self->add_collection_resolver(mapping=>%args)}sub add_collection_resolver {my ($self,$type,%args)=@_;my$tag=$args{tag};my$implicit=$args{implicit};my$resolvers=$self->resolvers;if ($tag and ref$tag eq 'Regexp'){my$res=$resolvers->{$type }->{tags}||= [];push @$res,[$tag,{on_create=>$args{on_create},on_data=>$args{on_data},}]}elsif ($tag){my$res=$resolvers->{$type }->{tag}->{$tag }||= {on_create=>$args{on_create},on_data=>$args{on_data},}}}sub add_representer {my ($self,%args)=@_;my$representers=$self->representers;if (my$flags=$args{flags}){my$rep=$representers->{flags};push @$rep,\%args;return}if (my$regex=$args{regex}){my$rep=$representers->{regex};push @$rep,\%args;return}if (my$regex=$args{class_matches}){my$rep=$representers->{class_matches};push @$rep,[$args{class_matches},$args{code}];return}if (my$bool=$args{bool}and $] >= 5.036000){$representers->{bool}={code=>$args{code},};return}if (my$class_equals=$args{class_equals}){my$rep=$representers->{class_equals};$rep->{$class_equals }={code=>$args{code},};return}if (my$class_isa=$args{class_isa}){my$rep=$representers->{class_isa};push @$rep,[$args{class_isa},$args{code}];return}if (my$tied_equals=$args{tied_equals}){my$rep=$representers->{tied_equals};$rep->{$tied_equals }={code=>$args{code},};return}if (defined(my$equals=$args{equals})){my$rep=$representers->{equals};$rep->{$equals }={code=>$args{code},};return}if (defined(my$scalarref=$args{scalarref})){$representers->{scalarref}={code=>$args{code},};return}if (defined(my$refref=$args{refref})){$representers->{refref}={code=>$args{code},};return}if (defined(my$coderef=$args{coderef})){$representers->{coderef}={code=>$args{code},};return}if (defined(my$glob=$args{glob})){$representers->{glob}={code=>$args{code},};return}if (my$undef=$args{undefined}){$representers->{undef}=$undef;return}}sub load_scalar {my ($self,$constructor,$event)=@_;my$tag=$event->{tag};my$value=$event->{value};my$resolvers=$self->resolvers;my$res;if ($tag){$res=$resolvers->{tag}->{$tag };if (not $res and my$matches=$resolvers->{tags}){for my$match (@$matches){my ($re,$rule)=@$match;if ($tag =~ $re){$res=$rule;last}}}}else {$res=$resolvers->{value};if ($event->{style}ne YAML_PLAIN_SCALAR_STYLE){return$value}}if (my$equals=$res->{equals}){if (exists$equals->{$value }){my$res=$equals->{$value };if (ref$res eq 'CODE'){return$res->($constructor,$event)}return$res}}if (my$regex=$res->{regex}){for my$item (@$regex){my ($re,$sub)=@$item;my@matches=$value =~ $re;if (@matches){return$sub->($constructor,$event,\@matches)}}}if (my$catch_all=$res->{all}){if (ref$catch_all eq 'CODE'){return$catch_all->($constructor,$event)}return$catch_all}return$value}sub create_sequence {my ($self,$constructor,$event)=@_;my$tag=$event->{tag};my$data=[];my$on_data;my$resolvers=$self->resolvers->{sequence};if ($tag){if (my$equals=$resolvers->{tag}->{$tag }){my$on_create=$equals->{on_create};$on_data=$equals->{on_data};$on_create and $data=$on_create->($constructor,$event);return ($data,$on_data)}if (my$matches=$resolvers->{tags}){for my$match (@$matches){my ($re,$actions)=@$match;my$on_create=$actions->{on_create};if ($tag =~ $re){$on_data=$actions->{on_data};$on_create and $data=$on_create->($constructor,$event);return ($data,$on_data)}}}}return ($data,$on_data)}sub create_mapping {my ($self,$constructor,$event)=@_;my$tag=$event->{tag};my$data={};my$on_data;my$resolvers=$self->resolvers->{mapping};if ($tag){if (my$equals=$resolvers->{tag}->{$tag }){my$on_create=$equals->{on_create};$on_data=$equals->{on_data};$on_create and $data=$on_create->($constructor,$event);return ($data,$on_data)}if (my$matches=$resolvers->{tags}){for my$match (@$matches){my ($re,$actions)=@$match;my$on_create=$actions->{on_create};if ($tag =~ $re){$on_data=$actions->{on_data};$on_create and $data=$on_create->($constructor,$event);return ($data,$on_data)}}}}return ($data,$on_data)}sub _bool_jsonpp_true {JSON::PP::true()}sub _bool_booleanpm_true {boolean::true()}sub _bool_perl_true {!!1}sub _bool_jsonpp_false {JSON::PP::false()}sub _bool_booleanpm_false {boolean::false()}sub _bool_perl_false {!!0}1; YAML_PP_SCHEMA $fatpacked{"YAML/PP/Schema/Binary.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_BINARY'; use strict;use warnings;package YAML::PP::Schema::Binary;our$VERSION='v0.38.0';use MIME::Base64 qw/decode_base64 encode_base64/;use YAML::PP::Common qw/YAML_ANY_SCALAR_STYLE/;sub register {my ($self,%args)=@_;my$schema=$args{schema};$schema->add_resolver(tag=>'tag:yaml.org,2002:binary',match=>[all=>sub {my ($constructor,$event)=@_;my$base64=$event->{value};my$binary=decode_base64($base64);return$binary}],implicit=>0,);$schema->add_representer(regex=>qr{.*},code=>sub {my ($rep,$node)=@_;my$binary=$node->{value};unless ($binary =~ m/[\x{7F}-\x{10FFFF}]/){return}if (utf8::is_utf8($binary)){return}my$base64=encode_base64($binary);$node->{style}=YAML_ANY_SCALAR_STYLE;$node->{data}=$base64;$node->{tag}="tag:yaml.org,2002:binary";return 1},)}1; YAML_PP_SCHEMA_BINARY $fatpacked{"YAML/PP/Schema/Core.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_CORE'; use strict;use warnings;package YAML::PP::Schema::Core;our$VERSION='v0.38.0';use YAML::PP::Schema::JSON qw/represent_int represent_float represent_literal represent_bool represent_undef/;use B;use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE/;my$RE_INT_CORE=qr{^([+-]?(?:[0-9]+))$};my$RE_FLOAT_CORE=qr{^([+-]?(?:\.[0-9]+|[0-9]+(?:\.[0-9]*)?)(?:[eE][+-]?[0-9]+)?)$};my$RE_INT_OCTAL=qr{^0o([0-7]+)$};my$RE_INT_HEX=qr{^0x([0-9a-fA-F]+)$};sub _from_oct {oct $_[2]->[0]}sub _from_hex {hex $_[2]->[0]}sub register {my ($self,%args)=@_;my$schema=$args{schema};$schema->add_resolver(tag=>'tag:yaml.org,2002:null',match=>[equals=>$_=>undef ],)for (qw/null NULL Null ~/,'');$schema->add_resolver(tag=>'tag:yaml.org,2002:bool',match=>[equals=>$_=>$schema->true ],)for (qw/true TRUE True/);$schema->add_resolver(tag=>'tag:yaml.org,2002:bool',match=>[equals=>$_=>$schema->false ],)for (qw/false FALSE False/);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT_CORE=>\&YAML::PP::Schema::JSON::_to_int ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT_OCTAL=>\&_from_oct ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT_HEX=>\&_from_hex ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[regex=>$RE_FLOAT_CORE=>\&YAML::PP::Schema::JSON::_to_float ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[equals=>$_=>0 + "inf" ],)for (qw/.inf .Inf .INF +.inf +.Inf +.INF/);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[equals=>$_=>0 - "inf" ],)for (qw/-.inf -.Inf -.INF/);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[equals=>$_=>0 + "nan" ],)for (qw/.nan .NaN .NAN/);$schema->add_resolver(tag=>'tag:yaml.org,2002:str',match=>[all=>sub {$_[1]->{value}}],);my$int_flags=B::SVp_IOK;my$float_flags=B::SVp_NOK;$schema->add_representer(flags=>$int_flags,code=>\&represent_int,);$schema->add_representer(flags=>$float_flags,code=>\&represent_float,);$schema->add_representer(undefined=>\&represent_undef,);$schema->add_representer(equals=>$_,code=>\&represent_literal,)for ("",qw/true TRUE True false FALSE False null NULL Null ~ .inf .Inf .INF +.inf +.Inf +.INF -.inf -.Inf -.INF .nan .NaN .NAN/);$schema->add_representer(regex=>qr{$RE_INT_CORE|$RE_FLOAT_CORE|$RE_INT_OCTAL|$RE_INT_HEX},code=>\&represent_literal,);if ($schema->bool_class){for my$class (@{$schema->bool_class}){if ($class eq 'perl'){$schema->add_representer(bool=>1,code=>\&represent_bool,);next}$schema->add_representer(class_equals=>$class,code=>\&represent_bool,)}}return}1; YAML_PP_SCHEMA_CORE $fatpacked{"YAML/PP/Schema/Failsafe.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_FAILSAFE'; use strict;use warnings;package YAML::PP::Schema::Failsafe;our$VERSION='v0.38.0';sub register {my ($self,%args)=@_;return}1; YAML_PP_SCHEMA_FAILSAFE $fatpacked{"YAML/PP/Schema/Include.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_INCLUDE'; use strict;use warnings;package YAML::PP::Schema::Include;our$VERSION='v0.38.0';use Carp qw/croak/;use Scalar::Util qw/weaken/;use File::Basename qw/dirname/;sub new {my ($class,%args)=@_;my$paths=delete$args{paths};if (defined$paths){unless (ref$paths eq 'ARRAY'){$paths=[$paths]}}else {$paths=[]}my$allow_absolute=$args{allow_absolute}|| 0;my$loader=$args{loader}|| \&default_loader;my$self=bless {paths=>$paths,allow_absolute=>$allow_absolute,last_includes=>[],cached=>{},loader=>$loader,},$class;return$self}sub init {my ($self)=@_;$self->{last_includes}=[];$self->{cached}=[]}sub paths {$_[0]->{paths}}sub allow_absolute {$_[0]->{allow_absolute}}sub yp {my ($self,$yp)=@_;if (@_==2){$self->{yp}=$yp;weaken$self->{yp};return$yp}return$self->{yp}}sub register {my ($self,%args)=@_;my$schema=$args{schema};$schema->add_resolver(tag=>'!include',match=>[all=>sub {$self->include(@_)}],implicit=>0,)}sub include {my ($self,$constructor,$event)=@_;my$yp=$self->yp;my$search_paths=$self->paths;my$allow_absolute=$self->allow_absolute;my$relative=not @$search_paths;if ($relative){my$last_includes=$self->{last_includes};if (@$last_includes){$search_paths=[$last_includes->[-1]]}else {my$filename=$yp->loader->filename;$search_paths=[dirname$filename]}}my$filename=$event->{value};my$fullpath;if (File::Spec->file_name_is_absolute($filename)){unless ($allow_absolute){croak "Absolute filenames not allowed"}$fullpath=$filename}else {my@paths=File::Spec->splitdir($filename);unless ($allow_absolute){@paths=File::Spec->no_upwards(@paths)}for my$candidate (@$search_paths){my$test=File::Spec->catfile($candidate,@paths);if (-e $test){$fullpath=$test;last}}croak "File '$filename' not found" unless defined$fullpath}if ($self->{cached}->{$fullpath }++){croak "Circular include '$fullpath'"}if ($relative){push @{$self->{last_includes}},dirname$fullpath}my$clone=$yp->clone;my ($data)=$self->loader->($clone,$fullpath);if ($relative){pop @{$self->{last_includes}}}unless (--$self->{cached}->{$fullpath }){delete$self->{cached}->{$fullpath }}return$data}sub loader {my ($self,$code)=@_;if (@_==2){$self->{loader}=$code;return$code}return$self->{loader}}sub default_loader {my ($yp,$filename)=@_;$yp->load_file($filename)}1; YAML_PP_SCHEMA_INCLUDE $fatpacked{"YAML/PP/Schema/JSON.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_JSON'; use strict;use warnings;package YAML::PP::Schema::JSON;our$VERSION='v0.38.0';use base 'Exporter';our@EXPORT_OK=qw/represent_int represent_float represent_literal represent_bool represent_undef/;use B;use Carp qw/croak/;use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE/;my$RE_INT=qr{^(-?(?:0|[1-9][0-9]*))$};my$RE_FLOAT=qr{^(-?(?:0|[1-9][0-9]*)(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?)$};sub _to_int {0 + $_[2]->[0]}sub _to_float {unpack F=>pack F=>$_[2]->[0]}sub register {my ($self,%args)=@_;my$schema=$args{schema};my$options=$args{options};my$empty_null=0;for my$opt (@$options){if ($opt eq 'empty=str'){}elsif ($opt eq 'empty=null'){$empty_null=1}else {croak "Invalid option for JSON Schema: '$opt'"}}$schema->add_resolver(tag=>'tag:yaml.org,2002:null',match=>[equals=>null=>undef ],);if ($empty_null){$schema->add_resolver(tag=>'tag:yaml.org,2002:null',match=>[equals=>''=>undef ],implicit=>1,)}else {$schema->add_resolver(tag=>'tag:yaml.org,2002:str',match=>[equals=>''=>'' ],implicit=>1,)}$schema->add_resolver(tag=>'tag:yaml.org,2002:bool',match=>[equals=>true=>$schema->true ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:bool',match=>[equals=>false=>$schema->false ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT=>\&_to_int ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[regex=>$RE_FLOAT=>\&_to_float ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:str',match=>[all=>sub {$_[1]->{value}}],);$schema->add_representer(undefined=>\&represent_undef,);my$int_flags=B::SVp_IOK;my$float_flags=B::SVp_NOK;$schema->add_representer(flags=>$int_flags,code=>\&represent_int,);my%special=((0+'nan').''=>'.nan',(0+'inf').''=>'.inf',(0-'inf').''=>'-.inf');$schema->add_representer(flags=>$float_flags,code=>\&represent_float,);$schema->add_representer(equals=>$_,code=>\&represent_literal,)for ("",qw/true false null/);$schema->add_representer(regex=>qr{$RE_INT|$RE_FLOAT},code=>\&represent_literal,);if ($schema->bool_class){for my$class (@{$schema->bool_class}){if ($class eq 'perl'){$schema->add_representer(bool=>1,code=>\&represent_bool,);next}$schema->add_representer(class_equals=>$class,code=>\&represent_bool,)}}return}sub represent_undef {my ($rep,$node)=@_;$node->{style}=YAML_PLAIN_SCALAR_STYLE;$node->{data}='null';return 1}sub represent_literal {my ($rep,$node)=@_;$node->{style}||= YAML_SINGLE_QUOTED_SCALAR_STYLE;$node->{data}="$node->{value}";return 1}sub represent_int {my ($rep,$node)=@_;if (int($node->{value})ne $node->{value}){return 0}$node->{style}=YAML_PLAIN_SCALAR_STYLE;$node->{data}="$node->{value}";return 1}my%special=((0+'nan').''=>'.nan',(0+'inf').''=>'.inf',(0-'inf').''=>'-.inf');sub represent_float {my ($rep,$node)=@_;if (exists$special{$node->{value}}){$node->{style}=YAML_PLAIN_SCALAR_STYLE;$node->{data}=$special{$node->{value}};return 1}if (0.0 + $node->{value}ne $node->{value}){return 0}if (int($node->{value})eq $node->{value}and not $node->{value}=~ m/\./){$node->{value}.= '.0'}$node->{style}=YAML_PLAIN_SCALAR_STYLE;$node->{data}="$node->{value}";return 1}sub represent_bool {my ($rep,$node)=@_;my$string=$node->{value}? 'true' : 'false';$node->{style}=YAML_PLAIN_SCALAR_STYLE;@{$node->{items}}=$string;$node->{data}=$string;return 1}1; YAML_PP_SCHEMA_JSON $fatpacked{"YAML/PP/Schema/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_MERGE'; use strict;use warnings;package YAML::PP::Schema::Merge;our$VERSION='v0.38.0';use YAML::PP::Type::MergeKey;sub register {my ($self,%args)=@_;my$schema=$args{schema};$schema->add_resolver(tag=>'tag:yaml.org,2002:merge',match=>[equals=>'<<'=>YAML::PP::Type::MergeKey->new ],)}1; YAML_PP_SCHEMA_MERGE $fatpacked{"YAML/PP/Schema/Perl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_PERL'; use strict;use warnings;package YAML::PP::Schema::Perl;our$VERSION='v0.38.0';use Scalar::Util qw/blessed reftype/;my$qr_prefix;{$qr_prefix=qr{\(\?-xism\:};if ($] >= 5.014){$qr_prefix=qr{\(\?\^(?:[uadl])?\:}}}sub new {my ($class,%args)=@_;my$tags=$args{tags}|| [];my$loadcode=$args{loadcode}|| 0;my$dumpcode=$args{dumpcode};$dumpcode=1 unless defined$dumpcode;my$classes=$args{classes};my$self=bless {tags=>$tags,loadcode=>$loadcode,dumpcode=>$dumpcode,classes=>$classes,},$class}sub register {my ($self,%args)=@_;my$schema=$args{schema};my$tags;my$loadcode=0;my$dumpcode=1;my$classes;if (blessed($self)){$tags=$self->{tags};@$tags=('!perl')unless @$tags;$loadcode=$self->{loadcode};$dumpcode=$self->{dumpcode};$classes=$self->{classes}}else {my$options=$args{options};my$tagtype='!perl';for my$option (@$options){if ($option =~ m/^tags?=(.+)$/){$tagtype=$1}elsif ($option eq '+loadcode'){$loadcode=1}elsif ($option eq '-dumpcode'){$dumpcode=0}}$tags=[split m/\+/,$tagtype]}my$perl_tag;my%tagtypes;my@perl_tags;for my$type (@$tags){if ($type eq '!perl'){$perl_tag ||= $type;push@perl_tags,'!perl'}elsif ($type eq '!!perl'){$perl_tag ||= 'tag:yaml.org,2002:perl';push@perl_tags,'tag:yaml.org,2002:perl'}else {die "Invalid tagtype '$type'"}$tagtypes{$type }=1}my$perl_regex='!perl';if ($tagtypes{'!perl'}and $tagtypes{'!!perl'}){$perl_regex='(?:tag:yaml\\.org,2002:|!)perl'}elsif ($tagtypes{'!perl'}){$perl_regex='!perl'}elsif ($tagtypes{'!!perl'}){$perl_regex='tag:yaml\\.org,2002:perl'}my$class_regex=qr{.+};my$no_objects=0;if ($classes){if (@$classes){$class_regex='(' .join('|',map "\Q$_\E",@$classes).')'}else {$no_objects=1;$class_regex=''}}if ($loadcode){my$load_code=sub {my ($constructor,$event)=@_;return$self->evaluate_code($event->{value})};my$load_code_blessed=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/code:}{};my$sub=$self->evaluate_code($event->{value});return$self->object($sub,$class)};$schema->add_resolver(tag=>"$_/code",match=>[all=>$load_code],implicit=>0,)for@perl_tags;$schema->add_resolver(tag=>qr{^$perl_regex/code:$class_regex$},match=>[all=>$load_code_blessed ],implicit=>0,);$schema->add_resolver(tag=>qr{^$perl_regex/code:.+},match=>[all=>$load_code ],implicit=>0,)if$no_objects}else {my$loadcode_dummy=sub {return sub {}};my$loadcode_blessed_dummy=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/code:}{};return$self->object(sub {},$class)};$schema->add_resolver(tag=>"$_/code",match=>[all=>$loadcode_dummy ],implicit=>0,)for@perl_tags;$schema->add_resolver(tag=>qr{^$perl_regex/code:$class_regex$},match=>[all=>$loadcode_blessed_dummy ],implicit=>0,);$schema->add_resolver(tag=>qr{^$perl_regex/code:.+},match=>[all=>$loadcode_dummy ],implicit=>0,)if$no_objects}my$load_glob=sub {my$value=undef;return \$value};my$load_glob_blessed=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/glob:}{};my$value=undef;return$self->object(\$value,$class)};$schema->add_mapping_resolver(tag=>"$_/glob",on_create=>$load_glob,on_data=>sub {my ($constructor,$ref,$list)=@_;$$ref=$self->construct_glob($list)},)for@perl_tags;if ($no_objects){$schema->add_mapping_resolver(tag=>qr{^$perl_regex/glob:.+$},on_create=>$load_glob,on_data=>sub {my ($constructor,$ref,$list)=@_;$$ref=$self->construct_glob($list)},)}else {$schema->add_mapping_resolver(tag=>qr{^$perl_regex/glob:$class_regex$},on_create=>$load_glob_blessed,on_data=>sub {my ($constructor,$ref,$list)=@_;$$$ref=$self->construct_glob($list)},)}my$load_regex=sub {my ($constructor,$event)=@_;return$self->construct_regex($event->{value})};my$load_regex_blessed=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/regexp:}{};my$qr=$self->construct_regex($event->{value});return$self->object($qr,$class)};$schema->add_resolver(tag=>"$_/regexp",match=>[all=>$load_regex ],implicit=>0,)for@perl_tags;$schema->add_resolver(tag=>qr{^$perl_regex/regexp:$class_regex$},match=>[all=>$load_regex_blessed ],implicit=>0,);$schema->add_resolver(tag=>qr{^$perl_regex/regexp:$class_regex$},match=>[all=>$load_regex ],implicit=>0,)if$no_objects;my$load_sequence=sub {return []};my$load_sequence_blessed=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/array:}{};return$self->object([],$class)};$schema->add_sequence_resolver(tag=>"$_/array",on_create=>$load_sequence,)for@perl_tags;$schema->add_sequence_resolver(tag=>qr{^$perl_regex/array:$class_regex$},on_create=>$load_sequence_blessed,);$schema->add_sequence_resolver(tag=>qr{^$perl_regex/array:.+$},on_create=>$load_sequence,)if$no_objects;my$load_mapping=sub {return {}};my$load_mapping_blessed=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/hash:}{};return$self->object({},$class)};$schema->add_mapping_resolver(tag=>"$_/hash",on_create=>$load_mapping,)for@perl_tags;$schema->add_mapping_resolver(tag=>qr{^$perl_regex/hash:$class_regex$},on_create=>$load_mapping_blessed,);$schema->add_mapping_resolver(tag=>qr{^$perl_regex/hash:.+$},on_create=>$load_mapping,)if$no_objects;my$load_ref=sub {my$value=undef;return \$value};my$load_ref_blessed=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/ref:}{};my$value=undef;return$self->object(\$value,$class)};$schema->add_mapping_resolver(tag=>"$_/ref",on_create=>$load_ref,on_data=>sub {my ($constructor,$ref,$list)=@_;$$$ref=$self->construct_ref($list)},)for@perl_tags;$schema->add_mapping_resolver(tag=>qr{^$perl_regex/ref:$class_regex$},on_create=>$load_ref_blessed,on_data=>sub {my ($constructor,$ref,$list)=@_;$$$ref=$self->construct_ref($list)},);$schema->add_mapping_resolver(tag=>qr{^$perl_regex/ref:.+$},on_create=>$load_ref,on_data=>sub {my ($constructor,$ref,$list)=@_;$$$ref=$self->construct_ref($list)},)if$no_objects;my$load_scalar_ref=sub {my$value=undef;return \$value};my$load_scalar_ref_blessed=sub {my ($constructor,$event)=@_;my$class=$event->{tag};$class =~ s{^$perl_regex/scalar:}{};my$value=undef;return$self->object(\$value,$class)};$schema->add_mapping_resolver(tag=>"$_/scalar",on_create=>$load_scalar_ref,on_data=>sub {my ($constructor,$ref,$list)=@_;$$$ref=$self->construct_scalar($list)},)for@perl_tags;$schema->add_mapping_resolver(tag=>qr{^$perl_regex/scalar:$class_regex$},on_create=>$load_scalar_ref_blessed,on_data=>sub {my ($constructor,$ref,$list)=@_;$$$ref=$self->construct_scalar($list)},);$schema->add_mapping_resolver(tag=>qr{^$perl_regex/scalar:.+$},on_create=>$load_scalar_ref,on_data=>sub {my ($constructor,$ref,$list)=@_;$$$ref=$self->construct_scalar($list)},)if$no_objects;$schema->add_representer(scalarref=>1,code=>sub {my ($rep,$node)=@_;$node->{tag}=$perl_tag ."/scalar";$node->{data}=$self->represent_scalar($node->{value})},);$schema->add_representer(refref=>1,code=>sub {my ($rep,$node)=@_;$node->{tag}=$perl_tag ."/ref";$node->{data}=$self->represent_ref($node->{value})},);$schema->add_representer(coderef=>1,code=>sub {my ($rep,$node)=@_;$node->{tag}=$perl_tag ."/code";$node->{data}=$dumpcode ? $self->represent_code($node->{value}): '{ "DUMMY" }'},);$schema->add_representer(glob=>1,code=>sub {my ($rep,$node)=@_;$node->{tag}=$perl_tag ."/glob";$node->{data}=$self->represent_glob($node->{value})},);$schema->add_representer(class_matches=>1,code=>sub {my ($rep,$node)=@_;my$blessed=blessed$node->{value};my$tag_blessed=":$blessed";if ($blessed !~ m/^$class_regex$/){$tag_blessed=''}$node->{tag}=sprintf "$perl_tag/%s%s",lc($node->{reftype}),$tag_blessed;if ($node->{reftype}eq 'HASH'){$node->{data}=$node->{value}}elsif ($node->{reftype}eq 'ARRAY'){$node->{data}=$node->{value}}elsif ($node->{reftype}eq 'REGEXP'){if ($blessed eq 'Regexp'){$node->{tag}=$perl_tag ."/regexp"}$node->{data}=$self->represent_regex($node->{value})}elsif ($node->{reftype}eq 'SCALAR'){if ($blessed eq 'Regexp'){$node->{tag}=$perl_tag .'/regexp';$node->{data}=$self->represent_regex($node->{value})}elsif ($] <= 5.010001 and not defined ${$node->{value}}and $node->{value}=~ m/^\(\?/){$node->{tag}=$perl_tag .'/regexp' .$tag_blessed;$node->{data}=$self->represent_regex($node->{value})}else {$node->{data}=$self->represent_scalar($node->{value})}}elsif ($node->{reftype}eq 'REF'){$node->{data}=$self->represent_ref($node->{value})}elsif ($node->{reftype}eq 'CODE'){$node->{data}=$dumpcode ? $self->represent_code($node->{value}): '{ "DUMMY" }'}elsif ($node->{reftype}eq 'GLOB'){$node->{data}=$self->represent_glob($node->{value})}else {die "Reftype '$node->{reftype}' not implemented"}return 1},);return}sub evaluate_code {my ($self,$code)=@_;unless ($code =~ m/^ \s* \{ .* \} \s* \z/xs){die "Malformed code"}$code="sub $code";my$sub=eval$code;if ($@){die "Couldn't eval code: $@>>$code<<"}return$sub}sub construct_regex {my ($self,$regex)=@_;if ($regex =~ m/^$qr_prefix(.*)\)\z/s){$regex=$1}my$qr=qr{$regex};return$qr}sub construct_glob {my ($self,$list)=@_;if (@$list % 2){die "Unexpected data in perl/glob construction"}my%globdata=@$list;my$name=delete$globdata{NAME}or die "Missing NAME in perl/glob";my$pkg=delete$globdata{PACKAGE};$pkg='main' unless defined$pkg;my@allowed=qw(SCALAR ARRAY HASH CODE IO);delete@globdata{@allowed };if (my@keys=keys%globdata){die "Unexpected keys in perl/glob: @keys"}no strict 'refs';return *{"${pkg}::$name"}}sub construct_scalar {my ($self,$list)=@_;if (@$list!=2){die "Unexpected data in perl/scalar construction"}my ($key,$value)=@$list;unless ($key eq '='){die "Unexpected data in perl/scalar construction"}return$value}sub construct_ref {&construct_scalar}sub represent_scalar {my ($self,$value)=@_;return {'='=>$$value }}sub represent_ref {&represent_scalar}sub represent_code {my ($self,$code)=@_;require B::Deparse;my$deparse=B::Deparse->new("-p","-sC");return$deparse->coderef2text($code)}my@stats=qw/device inode mode links uid gid rdev size atime mtime ctime blksize blocks/;sub represent_glob {my ($self,$glob)=@_;my%glob;for my$type (qw/PACKAGE NAME SCALAR ARRAY HASH CODE IO/){my$value=*{$glob}{$type};if ($type eq 'SCALAR'){$value=$$value}elsif ($type eq 'IO'){if (defined$value){undef$value;$value->{stat}={};if ($value->{fileno}=fileno(*{$glob})){@{$value->{stat}}{@stats }=stat(*{$glob});$value->{tell}=tell *{$glob}}}}$glob{$type }=$value if defined$value}return \%glob}sub represent_regex {my ($self,$regex)=@_;$regex="$regex";if ($regex =~ m/^$qr_prefix(.*)\)\z/s){$regex=$1}return$regex}sub object {my ($self,$data,$class)=@_;return bless$data,$class}1; YAML_PP_SCHEMA_PERL $fatpacked{"YAML/PP/Schema/Tie/IxHash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_TIE_IXHASH'; use strict;use warnings;package YAML::PP::Schema::Tie::IxHash;our$VERSION='v0.38.0';use base 'YAML::PP::Schema';use Scalar::Util qw/blessed reftype/;my$ixhash=eval {require Tie::IxHash};sub register {my ($self,%args)=@_;my$schema=$args{schema};unless ($ixhash){die "You need to install Tie::IxHash in order to use this module"}$schema->add_representer(tied_equals=>'Tie::IxHash',code=>sub {my ($rep,$node)=@_;$node->{items}=[%{$node->{data}}];return 1},);return}1; YAML_PP_SCHEMA_TIE_IXHASH $fatpacked{"YAML/PP/Schema/YAML1_1.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_YAML1_1'; use strict;use warnings;package YAML::PP::Schema::YAML1_1;our$VERSION='v0.38.0';use YAML::PP::Schema::JSON qw/represent_int represent_float represent_literal represent_bool represent_undef/;use YAML::PP::Common qw/YAML_PLAIN_SCALAR_STYLE/;my$RE_INT_1_1=qr{^([+-]?(?:0|[1-9][0-9_]*))$};my$RE_FLOAT_1_1=qr{^([+-]?(?:[0-9][0-9_]*)?\.[0-9_]*(?:[eE][+-][0-9]+)?)$};my$RE_SEXAGESIMAL=qr{^([+-]?[0-9][0-9_]*(:[0-5]?[0-9])+\.[0-9_]*)$};my$RE_SEXAGESIMAL_INT=qr{^([-+]?[1-9][0-9_]*(:[0-5]?[0-9])+)$};my$RE_INT_OCTAL_1_1=qr{^([+-]?)0([0-7_]+)$};my$RE_INT_HEX_1_1=qr{^([+-]?)(0x[0-9a-fA-F_]+)$};my$RE_INT_BIN_1_1=qr{^([-+]?)(0b[0-1_]+)$};sub _from_oct {my ($constructor,$event,$matches)=@_;my ($sign,$oct)=@$matches;$oct =~ tr/_//d;my$result=oct$oct;$result= -$result if$sign eq '-';return$result}sub _from_hex {my ($constructor,$event,$matches)=@_;my ($sign,$hex)=@$matches;my$result=hex$hex;$result= -$result if$sign eq '-';return$result}sub _sexa_to_float {my ($constructor,$event,$matches)=@_;my ($float)=@$matches;my$result=0;my$i=0;my$sign=1;$float =~ s/^-// and $sign=-1;for my$part (reverse split m/:/,$float){$result += $part * (60 ** $i);$i++}$result=unpack F=>pack F=>$result;return$result * $sign}sub _to_float {my ($constructor,$event,$matches)=@_;my ($float)=@$matches;$float =~ tr/_//d;$float=unpack F=>pack F=>$float;return$float}sub _to_int {my ($constructor,$event,$matches)=@_;my ($int)=@$matches;$int =~ tr/_//d;0 + $int}sub register {my ($self,%args)=@_;my$schema=$args{schema};$schema->add_resolver(tag=>'tag:yaml.org,2002:null',match=>[equals=>$_=>undef ],)for (qw/null NULL Null ~/,'');$schema->add_resolver(tag=>'tag:yaml.org,2002:bool',match=>[equals=>$_=>$schema->true ],)for (qw/true TRUE True y Y yes Yes YES on On ON/);$schema->add_resolver(tag=>'tag:yaml.org,2002:bool',match=>[equals=>$_=>$schema->false ],)for (qw/false FALSE False n N no No NO off Off OFF/);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT_OCTAL_1_1=>\&_from_oct ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT_1_1=>\&_to_int ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT_HEX_1_1=>\&_from_hex ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[regex=>$RE_FLOAT_1_1=>\&_to_float ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_INT_BIN_1_1=>\&_from_oct ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:int',match=>[regex=>$RE_SEXAGESIMAL_INT=>\&_sexa_to_float ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[regex=>$RE_SEXAGESIMAL=>\&_sexa_to_float ],);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[equals=>$_=>0 + "inf" ],)for (qw/.inf .Inf .INF +.inf +.Inf +.INF/);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[equals=>$_=>0 - "inf" ],)for (qw/-.inf -.Inf -.INF/);$schema->add_resolver(tag=>'tag:yaml.org,2002:float',match=>[equals=>$_=>0 + "nan" ],)for (qw/.nan .NaN .NAN/);$schema->add_resolver(tag=>'tag:yaml.org,2002:str',match=>[all=>sub {$_[1]->{value}}],implicit=>0,);my$int_flags=B::SVp_IOK;my$float_flags=B::SVp_NOK;$schema->add_representer(flags=>$int_flags,code=>\&represent_int,);$schema->add_representer(flags=>$float_flags,code=>\&represent_float,);$schema->add_representer(undefined=>\&represent_undef,);$schema->add_representer(equals=>$_,code=>\&represent_literal,)for ("",qw/true TRUE True y Y yes Yes YES on On ON false FALSE False n N n no No NO off Off OFF null NULL Null ~ .inf .Inf .INF -.inf -.Inf -.INF +.inf +.Inf +.INF .nan .NaN .NAN/);$schema->add_representer(regex=>qr{$RE_INT_1_1|$RE_FLOAT_1_1|$RE_INT_OCTAL_1_1|$RE_INT_HEX_1_1|$RE_INT_BIN_1_1|$RE_SEXAGESIMAL_INT|$RE_SEXAGESIMAL},code=>\&represent_literal,);if ($schema->bool_class){for my$class (@{$schema->bool_class}){if ($class eq 'perl'){$schema->add_representer(bool=>1,code=>\&represent_bool,);next}$schema->add_representer(class_equals=>$class,code=>\&represent_bool,)}}return}1; YAML_PP_SCHEMA_YAML1_1 $fatpacked{"YAML/PP/Type/MergeKey.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_TYPE_MERGEKEY'; use strict;use warnings;package YAML::PP::Type::MergeKey;our$VERSION='v0.38.0';sub new {my ($class)=@_;return bless {},$class}1; YAML_PP_TYPE_MERGEKEY $fatpacked{"YAML/PP/Writer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_WRITER'; use strict;use warnings;package YAML::PP::Writer;our$VERSION='v0.38.0';sub output {return $_[0]->{output}}sub set_output {$_[0]->{output}=$_[1]}sub new {my ($class,%args)=@_;my$output=delete$args{output};$output='' unless defined$output;return bless {output=>$output,},$class}sub write {my ($self,$line)=@_;$self->{output}.= $line}sub init {$_[0]->set_output('')}sub finish {my ($self)=@_;$_[0]->set_output(undef)}1; YAML_PP_WRITER $fatpacked{"YAML/PP/Writer/File.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_WRITER_FILE'; use strict;use warnings;package YAML::PP::Writer::File;our$VERSION='v0.38.0';use Scalar::Util qw/openhandle/;use base qw/YAML::PP::Writer/;use Carp qw/croak/;sub _open_handle {my ($self)=@_;if (openhandle($self->{output})){$self->{filehandle}=$self->{output};return$self->{output}}open my$fh,'>:encoding(UTF-8)',$self->{output}or croak "Could not open '$self->{output}' for writing: $!";$self->{filehandle}=$fh;return$fh}sub write {my ($self,$line)=@_;my$fh=$self->{filehandle};print$fh $line}sub init {my ($self)=@_;my$fh=$self->_open_handle}sub finish {my ($self)=@_;if (openhandle($self->{output})){return}close$self->{filehandle}}1; YAML_PP_WRITER_FILE $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.000029';$VERSION =~ tr/_//d;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::GetCwd()if _WIN32 && defined&Win32::GetCwd &&!$drive;local@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};delete@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 eq '--always'){$attr{always}=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$/ ? " 2>"._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{"newgetopt.pl"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NEWGETOPT.PL'; {package newgetopt;$REQUIRE_ORDER=0;$PERMUTE=1;$RETURN_IN_ORDER=2;if (defined$ENV{"POSIXLY_CORRECT"}){$autoabbrev=0;$getopt_compat=0;$option_start="(--|-)";$order=$REQUIRE_ORDER;$bundling=0;$passthrough=0}else {$autoabbrev=1;$getopt_compat=1;$option_start="(--|-|\\+)";$order=$PERMUTE;$bundling=0;$passthrough=0}$debug=0;$ignorecase=1;$argv_end="--"}use Getopt::Long;sub NGetOpt {$Getopt::Long::debug=$newgetopt::debug if defined$newgetopt::debug;$Getopt::Long::autoabbrev=$newgetopt::autoabbrev if defined$newgetopt::autoabbrev;$Getopt::Long::getopt_compat=$newgetopt::getopt_compat if defined$newgetopt::getopt_compat;$Getopt::Long::option_start=$newgetopt::option_start if defined$newgetopt::option_start;$Getopt::Long::order=$newgetopt::order if defined$newgetopt::order;$Getopt::Long::bundling=$newgetopt::bundling if defined$newgetopt::bundling;$Getopt::Long::ignorecase=$newgetopt::ignorecase if defined$newgetopt::ignorecase;$Getopt::Long::ignorecase=$newgetopt::ignorecase if defined$newgetopt::ignorecase;$Getopt::Long::passthrough=$newgetopt::passthrough if defined$newgetopt::passthrough;&GetOptions}1; NEWGETOPT.PL $fatpacked{"parent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARENT'; package parent;use strict;our$VERSION='0.241';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.9932';our$CLASS='version';our (@ISA,$STRICT,$LAX);{local$SIG{'__DIE__'};eval "use version::vxs $VERSION";if ($@){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;*version::to_decimal=\&version::vpp::to_decimal;*version::to_dotted_decimal=\&version::vpp::to_dotted_decimal;*version::tuple=\&version::vpp::tuple;*version::from_tuple=\&version::vpp::from_tuple;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;*version::to_decimal=\&version::vxs::to_decimal;*version::to_dotted_decimal=\&version::vxs::to_dotted_decimal;*version::tuple=\&version::vxs::tuple;*version::from_tuple=\&version::vxs::from_tuple;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.9932';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.9932';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 to_decimal {my ($self)=@_;return ref($self)->new($self->numify)}sub to_dotted_decimal {my ($self)=@_;return ref($self)->new($self->normal)}sub vcmp {my ($left,$right,$swap)=@_;die "Usage: version::vcmp(lobj, robj, ...)" if @_ < 2;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 tuple {my ($self)=@_;return @{$self->{version}}}sub from_tuple {my ($proto,@args)=@_;my$class=ref($proto)|| $proto;my@version=map 0+$_,@args;die if@args < 1;return bless {version=>\@version,qv=>!!1,'v' .join('.',@version),},$class}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 warnings; use App::cpm; $App::cpm::GIT_DESCRIBE = '0.997017'; $App::cpm::GIT_URL = 'https://github.com/skaji/cpm/tree/0.997017'; use App::cpm::CLI; exit App::cpm::CLI->new->run(@ARGV); __END__ =head1 NAME cpm - a fast CPAN module installer =head1 SYNOPSIS # install modules into local/ > cpm install Module1 Module2 ... # install modules from one of # * cpm.yml # * cpanfile # * META.json (with dynamic_config false) # * Build.PL # * Makefile.PL > cpm install # install module into current @INC instead of local/ > cpm install -g Module # read modules from STDIN by specifying "-" as an argument > cat module-list.txt | cpm install - # prefer TRIAL release > cpm install --dev Moose # install modules as if version of your perl is 5.8.5 # so that modules which are not core in 5.8.5 will be installed > cpm install --target-perl 5.8.5 # resolve distribution names from DARKPAN/modules/02packages.details.txt.gz # and fetch distributions from DARKPAN/authors/id/... > cpm install --resolver 02packages,http://example.com/darkpan Your::Module > cpm install --resolver 02packages,file:///path/to/darkpan Your::Module # specify types/phases in cpmfile/cpanfile/metafile by "--with-*" and "--without-*" options > cpm install --with-recommends --without-test =head1 OPTIONS -w, --workers=N number of workers, default: 5 -L, --local-lib-contained=DIR directory to install modules into, default: local/ -g, --global install modules into current @INC instead of local/ -v, --verbose verbose mode; you can see what is going on --prebuilt, --no-prebuilt save builds for CPAN distributions; and later, install the prebuilts if available default: on; you can also set $ENV{PERL_CPM_PREBUILT} false to disable this option. usage of --test and/or --man-pages disables this option. --target-perl=VERSION (EXPERIMENTAL) install modules as if version is your perl is VERSION --mirror=URL base url for the CPAN mirror to use, cannot be used multiple times. Use --resolver instead. default: https://cpan.metacpan.org --pp, --pureperl-only prefer pureperl only build --static-install, --no-static-install enable/disable the static install, default: enable -r, --resolver=class,args (EXPERIMENTAL, will be removed or renamed) specify resolvers, you can use --resolver multiple times available classes: metadb/metacpan/02packages/snapshot --no-default-resolvers even if you specify --resolver, cpm continues using the default resolvers. if you just want to use your resolvers specified by --resolver, you should specify --no-default-resolvers too --reinstall reinstall the distribution even if you already have the latest version installed --dev (EXPERIMENTAL) resolve TRIAL distributions too --color, --no-color turn on/off color output, default: on --test, --no-test run test cases, default: no --man-pages generate man pages --retry, --no-retry retry configure/build/test/install if fails, default: retry --show-build-log-on-failure show build.log on failure, default: off --configure-timeout=sec, --build-timeout=sec, --test-timeout=sec specify configure/build/test timeout second, default: 60sec, 3600sec, 1800sec --show-progress, --no-show-progress show progress, default: on --cpmfile=path specify cpmfile path, default: ./cpm.yml --cpanfile=path specify cpanfile path, default: ./cpanfile --metafile=path specify META file path, default: N/A --snapshot=path specify cpanfile.snapshot path, default: ./cpanfile.snapshot -V, --version show version -h, --help show this help --feature=identifier specify the feature to enable in cpmfile/cpanfile/metafile; you can use --feature multiple times --with-requires, --without-requires (default: with) --with-recommends, --without-recommends (default: without) --with-suggests, --without-suggests (default: without) --with-configure, --without-configure (default: without) --with-build, --without-build (default: with) --with-test, --without-test (default: with) --with-runtime, --without-runtime (default: with) --with-develop, --without-develop (default: without) specify types/phases of dependencies in cpmfile/cpanfile/metafile to be installed --with-all shortcut for --with-requires, --with-recommends, --with-suggests, --with-configure, --with-build, --with-test, --with-runtime and --with-develop =head1 COPYRIGHT AND LICENSE Copyright 2015 Shoichi Kaji Eskaji@cpan.orgE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut