#!/usr/bin/env perl $App::plx::VERSION = 0.902003; # 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{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH'; package File::Which; use strict; use warnings; use Exporter (); use File::Spec (); # ABSTRACT: Perl implementation of the which utility as an API our $VERSION = '1.23'; # VERSION our @ISA = 'Exporter'; our @EXPORT = 'which'; our @EXPORT_OK = 'where'; use constant IS_VMS => ($^O eq 'VMS'); use constant IS_MAC => ($^O eq 'MacOS'); use constant IS_WIN => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2'); use constant IS_DOS => IS_WIN(); use constant IS_CYG => ($^O eq 'cygwin' || $^O eq 'msys'); our $IMPLICIT_CURRENT_DIR = IS_WIN || IS_VMS || IS_MAC; # For Win32 systems, stores the extensions used for # executable files # For others, the empty string is used # because 'perl' . '' eq 'perl' => easier my @PATHEXT = (''); if ( IS_WIN ) { # WinNT. PATHEXT might be set on Cygwin, but not used. if ( $ENV{PATHEXT} ) { push @PATHEXT, split ';', $ENV{PATHEXT}; } else { # Win9X or other: doesn't have PATHEXT, so needs hardcoded. push @PATHEXT, qw{.com .exe .bat}; } } elsif ( IS_VMS ) { push @PATHEXT, qw{.exe .com}; } elsif ( IS_CYG ) { # See this for more info # http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-exe push @PATHEXT, qw{.exe .com}; } sub which { my ($exec) = @_; return undef unless defined $exec; return undef if $exec eq ''; my $all = wantarray; my @results = (); # check for aliases first if ( IS_VMS ) { my $symbol = `SHOW SYMBOL $exec`; chomp($symbol); unless ( $? ) { return $symbol unless $all; push @results, $symbol; } } if ( IS_MAC ) { my @aliases = split /\,/, $ENV{Aliases}; foreach my $alias ( @aliases ) { # This has not been tested!! # PPT which says MPW-Perl cannot resolve `Alias $alias`, # let's just hope it's fixed if ( lc($alias) eq lc($exec) ) { chomp(my $file = `Alias $alias`); last unless $file; # if it failed, just go on the normal way return $file unless $all; push @results, $file; # we can stop this loop as if it finds more aliases matching, # it'll just be the same result anyway last; } } } return $exec if !IS_VMS and !IS_MAC and !IS_WIN and $exec =~ /\// and -f $exec and -x $exec; my @path; if($^O eq 'MSWin32') { # File::Spec (at least recent versions) # add the implicit . for you on MSWin32, # but we may or may not want to include # that. @path = split(';', $ENV{PATH}); s/"//g for @path; @path = grep length, @path; } else { @path = File::Spec->path; } if ( $IMPLICIT_CURRENT_DIR ) { unshift @path, File::Spec->curdir; } foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) { for my $ext ( @PATHEXT ) { my $file = $base.$ext; # We don't want dirs (as they are -x) next if -d $file; if ( # Executable, normal case -x _ or ( # MacOS doesn't mark as executable so we check -e IS_MAC || ( ( IS_WIN or IS_CYG ) and grep { $file =~ /$_\z/i } @PATHEXT[1..$#PATHEXT] ) # DOSish systems don't pass -x on # non-exe/bat/com files. so we check -e. # However, we don't want to pass -e on files # that aren't in PATHEXT, like README. and -e _ ) ) { return $file unless $all; push @results, $file; } } } if ( $all ) { return @results; } else { return undef; } } sub where { # force wantarray my @res = which($_[0]); return @res; } 1; __END__ =pod =encoding UTF-8 =head1 NAME File::Which - Perl implementation of the which utility as an API =head1 VERSION version 1.23 =head1 SYNOPSIS use File::Which; # exports which() use File::Which qw(which where); # exports which() and where() my $exe_path = which 'perldoc'; my @paths = where 'perl'; # Or my @paths = which 'perl'; # an array forces search for all of them =head1 DESCRIPTION L<File::Which> finds the full or relative paths to executable programs on the system. This is normally the function of C<which> utility. C<which> is typically implemented as either a program or a built in shell command. On some platforms, such as Microsoft Windows it is not provided as part of the core operating system. This module provides a consistent API to this functionality regardless of the underlying platform. The focus of this module is correctness and portability. As a consequence platforms where the current directory is implicitly part of the search path such as Microsoft Windows will find executables in the current directory, whereas on platforms such as UNIX where this is not the case executables in the current directory will only be found if the current directory is explicitly added to the path. If you need a portable C<which> on the command line in an environment that does not provide it, install L<App::pwhich> which provides a command line interface to this API. =head2 Implementations L<File::Which> searches the directories of the user's C<PATH> (the current implementation uses L<File::Spec#path> to determine the correct C<PATH>), looking for executable files having the name specified as a parameter to L</which>. Under Win32 systems, which do not have a notion of directly executable files, but uses special extensions such as C<.exe> and C<.bat> to identify them, C<File::Which> takes extra steps to assure that you will find the correct file (so for example, you might be searching for C<perl>, it'll try F<perl.exe>, F<perl.bat>, etc.) =head3 Linux, *BSD and other UNIXes There should not be any surprises here. The current directory will not be searched unless it is explicitly added to the path. =head3 Modern Windows (including NT, XP, Vista, 7, 8, 10 etc) Windows NT has a special environment variable called C<PATHEXT>, which is used by the shell to look for executable files. Usually, it will contain a list in the form C<.EXE;.BAT;.COM;.JS;.VBS> etc. If C<File::Which> finds such an environment variable, it parses the list and uses it as the different extensions. =head3 Cygwin Cygwin provides a Unix-like environment for Microsoft Windows users. In most ways it works like other Unix and Unix-like environments, but in a few key aspects it works like Windows. As with other Unix environments, the current directory is not included in the search unless it is explicitly included in the search path. Like on Windows, files with C<.EXE> or <.BAT> extensions will be discovered even if they are not part of the query. C<.COM> or extensions specified using the C<PATHEXT> environment variable will NOT be discovered without the fully qualified name, however. =head3 Windows ME, 98, 95, MS-DOS, OS/2 This set of operating systems don't have the C<PATHEXT> variable, and usually you will find executable files there with the extensions C<.exe>, C<.bat> and (less likely) C<.com>. C<File::Which> uses this hardcoded list if it's running under Win32 but does not find a C<PATHEXT> variable. As of 2015 none of these platforms are tested frequently (or perhaps ever), but the current maintainer is determined not to intentionally remove support for older operating systems. =head3 VMS Same case as Windows 9x: uses C<.exe> and C<.com> (in that order). As of 2015 the current maintainer does not test on VMS, and is in fact not certain it has ever been tested on VMS. If this platform is important to you and you can help me verify and or support it on that platform please contact me. =head1 FUNCTIONS =head2 which my $path = which $short_exe_name; my @paths = which $short_exe_name; Exported by default. C<$short_exe_name> is the name used in the shell to call the program (for example, C<perl>). If it finds an executable with the name you specified, C<which()> will return the absolute path leading to this executable (for example, F</usr/bin/perl> or F<C:\Perl\Bin\perl.exe>). If it does I<not> find the executable, it returns C<undef>. If C<which()> is called in list context, it will return I<all> the matches. =head2 where my @paths = where $short_exe_name; Not exported by default. Same as L</which> in array context. Similar to the C<where> csh built-in command or C<which -a> command for platforms that support the C<-a> option. Will return an array containing all the path names matching C<$short_exe_name>. =head1 GLOBALS =head2 $IMPLICIT_CURRENT_DIR True if the current directory is included in the search implicitly on whatever platform you are using. Normally the default is reasonable, but on Windows the current directory is included implicitly for older shells like C<cmd.exe> and C<command.com>, but not for newer shells like PowerShell. If you overrule this default, you should ALWAYS localize the variable to the tightest scope possible, since setting this variable from a module can affect other modules. Thus on Windows you can get the correct result if the user is running either C<cmd.exe> or PowerShell on Windows you can do this: use File::Which qw( which ); use Shell::Guess; my $path = do { my $is_power = Shell::Guess->running_shell->is_power; local $File::Which::IMPLICIT_CURRENT_DIR = !$is_power; which 'foo'; }; For a variety of reasons it is difficult to accurately compute the shell that a user is using, but L<Shell::Guess> makes a reasonable effort. =head1 CAVEATS This module has no non-core requirements for Perl 5.6.2 and better. This module is fully supported back to Perl 5.8.1. It may work on 5.8.0. It should work on Perl 5.6.x and I may even test on 5.6.2. I will accept patches to maintain compatibility for such older Perls, but you may need to fix it on 5.6.x / 5.8.0 and send me a patch. Not tested on VMS although there is platform specific code for those. Anyone who haves a second would be very kind to send me a report of how it went. =head1 SUPPORT Bugs should be reported via the GitHub issue tracker L<https://github.com/plicease/File-Which/issues> For other issues, contact the maintainer. =head1 SEE ALSO =over 4 =item L<pwhich>, L<App::pwhich> Command line interface to this module. =item L<IPC::Cmd> This module provides (among other things) a C<can_run> function, which is similar to C<which>. It is a much heavier module since it does a lot more, and if you use C<can_run> it pulls in L<ExtUtils::MakeMaker>. This combination may be overkill for applications which do not need L<IPC::Cmd>'s complicated interface for running programs, or do not need the memory overhead required for installing Perl modules. At least some older versions will find executables in the current directory, even if the current directory is not in the search path (which is the default on modern Unix). C<can_run> converts directory path name to the 8.3 version on Windows using C<Win32::GetShortPathName> in some cases. This is frequently useful for tools that just need to run something using C<system> in scalar mode, but may be inconvenient for tools like L<App::pwhich> where user readability is a premium. Relying on C<Win32::GetShortPathName> to produce filenames without spaces is problematic, as 8.3 filenames can be turned off with tweaks to the registry (see L<https://technet.microsoft.com/en-us/library/cc959352.aspx>). =item L<Devel::CheckBin> This module purports to "check that a command is available", but does not provide any documentation on how you might use it. =back =head1 AUTHORS =over 4 =item * Per Einar Ellefsen <pereinar@cpan.org> =item * Adam Kennedy <adamk@cpan.org> =item * Graham Ollis <plicease@cpan.org> =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2002 by Per Einar Ellefsen <pereinar@cpan.org>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut FILE_WHICH $fatpacked{"local/lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCAL_LIB'; package local::lib; use 5.006; BEGIN { if ($ENV{RELEASE_TESTING}) { require strict; strict->import; require warnings; warnings->import; } } use Config (); our $VERSION = '2.000024'; $VERSION = eval $VERSION; BEGIN { *_WIN32 = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'symbian') ? sub(){1} : sub(){0}; # punt on these systems *_USE_FSPEC = ($^O eq 'MacOS' || $^O eq 'VMS' || $INC{'File/Spec.pm'}) ? sub(){1} : sub(){0}; } my $_archname = $Config::Config{archname}; my $_version = $Config::Config{version}; my @_inc_version_list = reverse split / /, $Config::Config{inc_version_list}; my $_path_sep = $Config::Config{path_sep}; our $_DIR_JOIN = _WIN32 ? '\\' : '/'; our $_DIR_SPLIT = (_WIN32 || $^O eq 'cygwin') ? qr{[\\/]} : qr{/}; our $_ROOT = _WIN32 ? do { my $UNC = qr{[\\/]{2}[^\\/]+[\\/][^\\/]+}; qr{^(?:$UNC|[A-Za-z]:|)$_DIR_SPLIT}; } : qr{^/}; our $_PERL; sub _perl { if (!$_PERL) { # untaint and validate ($_PERL, my $exe) = $^X =~ /((?:.*$_DIR_SPLIT)?(.+))/; $_PERL = 'perl' if $exe !~ /perl/; if (_is_abs($_PERL)) { } elsif (-x $Config::Config{perlpath}) { $_PERL = $Config::Config{perlpath}; } elsif ($_PERL =~ $_DIR_SPLIT && -x $_PERL) { $_PERL = _rel2abs($_PERL); } else { ($_PERL) = map { /(.*)/ } grep { -x $_ } map { ($_, _WIN32 ? ("$_.exe") : ()) } map { join($_DIR_JOIN, $_, $_PERL) } split /\Q$_path_sep\E/, $ENV{PATH}; } } $_PERL; } sub _cwd { if (my $cwd = defined &Cwd::sys_cwd ? \&Cwd::sys_cwd : defined &Cwd::cwd ? \&Cwd::cwd : undef ) { no warnings 'redefine'; *_cwd = $cwd; goto &$cwd; } my $drive = shift; return Win32::Cwd() if _WIN32 && defined &Win32::Cwd && !$drive; local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; my $cmd = $drive ? "eval { Cwd::getdcwd(q($drive)) }" : 'getcwd'; my $perl = _perl; my $cwd = `"$perl" -MCwd -le "print $cmd"`; chomp $cwd; if (!length $cwd && $drive) { $cwd = $drive; } $cwd =~ s/$_DIR_SPLIT?$/$_DIR_JOIN/; $cwd; } sub _catdir { if (_USE_FSPEC) { require File::Spec; File::Spec->catdir(@_); } else { my $dir = join($_DIR_JOIN, @_); $dir =~ s{($_DIR_SPLIT)(?:\.?$_DIR_SPLIT)+}{$1}g; $dir; } } sub _is_abs { if (_USE_FSPEC) { require File::Spec; File::Spec->file_name_is_absolute($_[0]); } else { $_[0] =~ $_ROOT; } } sub _rel2abs { my ($dir, $base) = @_; return $dir if _is_abs($dir); $base = _WIN32 && $dir =~ s/^([A-Za-z]:)// ? _cwd("$1") : $base ? _rel2abs($base) : _cwd; return _catdir($base, $dir); } our $_DEVNULL; sub _devnull { return $_DEVNULL ||= _USE_FSPEC ? (require File::Spec, File::Spec->devnull) : _WIN32 ? 'nul' : $^O eq 'os2' ? '/dev/nul' : '/dev/null'; } sub import { my ($class, @args) = @_; if ($0 eq '-') { push @args, @ARGV; require Cwd; } my @steps; my %opts; my %attr; my $shelltype; while (@args) { my $arg = shift @args; # check for lethal dash first to stop processing before causing problems # the fancy dash is U+2212 or \xE2\x88\x92 if ($arg =~ /\xE2\x88\x92/) { die <<'DEATH'; WHOA THERE! It looks like you've got some fancy dashes in your commandline! These are *not* the traditional -- dashes that software recognizes. You probably got these by copy-pasting from the perldoc for this module as rendered by a UTF8-capable formatter. This most typically happens on an OS X terminal, but can happen elsewhere too. Please try again after replacing the dashes with normal minus signs. DEATH } elsif ($arg eq '--self-contained') { die <<'DEATH'; FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise). DEATH } elsif( $arg =~ /^--deactivate(?:=(.*))?$/ ) { my $path = defined $1 ? $1 : shift @args; push @steps, ['deactivate', $path]; } elsif ( $arg eq '--deactivate-all' ) { push @steps, ['deactivate_all']; } elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) { $shelltype = defined $1 ? $1 : shift @args; } elsif ( $arg eq '--no-create' ) { $opts{no_create} = 1; } elsif ( $arg eq '--quiet' ) { $attr{quiet} = 1; } elsif ( $arg =~ /^--/ ) { die "Unknown import argument: $arg"; } else { push @steps, ['activate', $arg, \%opts]; } } if (!@steps) { push @steps, ['activate', undef, \%opts]; } my $self = $class->new(%attr); for (@steps) { my ($method, @args) = @$_; $self = $self->$method(@args); } if ($0 eq '-') { print $self->environment_vars_string($shelltype); exit 0; } else { $self->setup_local_lib; } } sub new { my $class = shift; bless {@_}, $class; } sub clone { my $self = shift; bless {%$self, @_}, ref $self; } sub inc { $_[0]->{inc} ||= \@INC } sub libs { $_[0]->{libs} ||= [ \'PERL5LIB' ] } sub bins { $_[0]->{bins} ||= [ \'PATH' ] } sub roots { $_[0]->{roots} ||= [ \'PERL_LOCAL_LIB_ROOT' ] } sub extra { $_[0]->{extra} ||= {} } sub quiet { $_[0]->{quiet} } sub _as_list { my $list = shift; grep length, map { !(ref $_ && ref $_ eq 'SCALAR') ? $_ : ( defined $ENV{$$_} ? split(/\Q$_path_sep/, $ENV{$$_}) : () ) } ref $list ? @$list : $list; } sub _remove_from { my ($list, @remove) = @_; return @$list if !@remove; my %remove = map { $_ => 1 } @remove; grep !$remove{$_}, _as_list($list); } my @_lib_subdirs = ( [$_version, $_archname], [$_version], [$_archname], (map [$_], @_inc_version_list), [], ); sub install_base_bin_path { my ($class, $path) = @_; return _catdir($path, 'bin'); } sub install_base_perl_path { my ($class, $path) = @_; return _catdir($path, 'lib', 'perl5'); } sub install_base_arch_path { my ($class, $path) = @_; _catdir($class->install_base_perl_path($path), $_archname); } sub lib_paths_for { my ($class, $path) = @_; my $base = $class->install_base_perl_path($path); return map { _catdir($base, @$_) } @_lib_subdirs; } sub _mm_escape_path { my $path = shift; $path =~ s/\\/\\\\/g; if ($path =~ s/ /\\ /g) { $path = qq{"$path"}; } return $path; } sub _mb_escape_path { my $path = shift; $path =~ s/\\/\\\\/g; return qq{"$path"}; } sub installer_options_for { my ($class, $path) = @_; return ( PERL_MM_OPT => defined $path ? "INSTALL_BASE="._mm_escape_path($path) : undef, PERL_MB_OPT => defined $path ? "--install_base "._mb_escape_path($path) : undef, ); } sub active_paths { my ($self) = @_; $self = ref $self ? $self : $self->new; return grep { # screen out entries that aren't actually reflected in @INC my $active_ll = $self->install_base_perl_path($_); grep { $_ eq $active_ll } @{$self->inc}; } _as_list($self->roots); } sub deactivate { my ($self, $path) = @_; $self = $self->new unless ref $self; $path = $self->resolve_path($path); $path = $self->normalize_path($path); my @active_lls = $self->active_paths; if (!grep { $_ eq $path } @active_lls) { warn "Tried to deactivate inactive local::lib '$path'\n"; return $self; } my %args = ( bins => [ _remove_from($self->bins, $self->install_base_bin_path($path)) ], libs => [ _remove_from($self->libs, $self->install_base_perl_path($path)) ], inc => [ _remove_from($self->inc, $self->lib_paths_for($path)) ], roots => [ _remove_from($self->roots, $path) ], ); $args{extra} = { $self->installer_options_for($args{roots}[0]) }; $self->clone(%args); } sub deactivate_all { my ($self) = @_; $self = $self->new unless ref $self; my @active_lls = $self->active_paths; my %args; if (@active_lls) { %args = ( bins => [ _remove_from($self->bins, map $self->install_base_bin_path($_), @active_lls) ], libs => [ _remove_from($self->libs, map $self->install_base_perl_path($_), @active_lls) ], inc => [ _remove_from($self->inc, map $self->lib_paths_for($_), @active_lls) ], roots => [ _remove_from($self->roots, @active_lls) ], ); } $args{extra} = { $self->installer_options_for(undef) }; $self->clone(%args); } sub activate { my ($self, $path, $opts) = @_; $opts ||= {}; $self = $self->new unless ref $self; $path = $self->resolve_path($path); $self->ensure_dir_structure_for($path, { quiet => $self->quiet }) unless $opts->{no_create}; $path = $self->normalize_path($path); my @active_lls = $self->active_paths; if (grep { $_ eq $path } @active_lls[1 .. $#active_lls]) { $self = $self->deactivate($path); } my %args; if ($opts->{always} || !@active_lls || $active_lls[0] ne $path) { %args = ( bins => [ $self->install_base_bin_path($path), @{$self->bins} ], libs => [ $self->install_base_perl_path($path), @{$self->libs} ], inc => [ $self->lib_paths_for($path), @{$self->inc} ], roots => [ $path, @{$self->roots} ], ); } $args{extra} = { $self->installer_options_for($path) }; $self->clone(%args); } sub normalize_path { my ($self, $path) = @_; $path = ( Win32::GetShortPathName($path) || $path ) if $^O eq 'MSWin32'; return $path; } sub build_environment_vars_for { my $self = $_[0]->new->activate($_[1], { always => 1 }); $self->build_environment_vars; } sub build_activate_environment_vars_for { my $self = $_[0]->new->activate($_[1], { always => 1 }); $self->build_environment_vars; } sub build_deactivate_environment_vars_for { my $self = $_[0]->new->deactivate($_[1]); $self->build_environment_vars; } sub build_deact_all_environment_vars_for { my $self = $_[0]->new->deactivate_all; $self->build_environment_vars; } sub build_environment_vars { my $self = shift; ( PATH => join($_path_sep, _as_list($self->bins)), PERL5LIB => join($_path_sep, _as_list($self->libs)), PERL_LOCAL_LIB_ROOT => join($_path_sep, _as_list($self->roots)), %{$self->extra}, ); } sub setup_local_lib_for { my $self = $_[0]->new->activate($_[1]); $self->setup_local_lib; } sub setup_local_lib { my $self = shift; # if Carp is already loaded, ensure Carp::Heavy is also loaded, to avoid # $VERSION mismatch errors (Carp::Heavy loads Carp, so we do not need to # check in the other direction) require Carp::Heavy if $INC{'Carp.pm'}; $self->setup_env_hash; @INC = @{$self->inc}; } sub setup_env_hash_for { my $self = $_[0]->new->activate($_[1]); $self->setup_env_hash; } sub setup_env_hash { my $self = shift; my %env = $self->build_environment_vars; for my $key (keys %env) { if (defined $env{$key}) { $ENV{$key} = $env{$key}; } else { delete $ENV{$key}; } } } sub print_environment_vars_for { print $_[0]->environment_vars_string_for(@_[1..$#_]); } sub environment_vars_string_for { my $self = $_[0]->new->activate($_[1], { always => 1}); $self->environment_vars_string; } sub environment_vars_string { my ($self, $shelltype) = @_; $shelltype ||= $self->guess_shelltype; my $extra = $self->extra; my @envs = ( PATH => $self->bins, PERL5LIB => $self->libs, PERL_LOCAL_LIB_ROOT => $self->roots, map { $_ => $extra->{$_} } sort keys %$extra, ); $self->_build_env_string($shelltype, \@envs); } sub _build_env_string { my ($self, $shelltype, $envs) = @_; my @envs = @$envs; my $build_method = "build_${shelltype}_env_declaration"; my $out = ''; while (@envs) { my ($name, $value) = (shift(@envs), shift(@envs)); if ( ref $value && @$value == 1 && ref $value->[0] && ref $value->[0] eq 'SCALAR' && ${$value->[0]} eq $name) { next; } $out .= $self->$build_method($name, $value); } my $wrap_method = "wrap_${shelltype}_output"; if ($self->can($wrap_method)) { return $self->$wrap_method($out); } return $out; } sub build_bourne_env_declaration { my ($class, $name, $args) = @_; my $value = $class->_interpolate($args, '${%s:-}', qr/["\\\$!`]/, '\\%s'); if (!defined $value) { return qq{unset $name;\n}; } $value =~ s/(^|\G|$_path_sep)\$\{$name:-\}$_path_sep/$1\${$name}\${$name:+$_path_sep}/g; $value =~ s/$_path_sep\$\{$name:-\}$/\${$name:+$_path_sep\${$name}}/; qq{${name}="$value"; export ${name};\n} } sub build_csh_env_declaration { my ($class, $name, $args) = @_; my ($value, @vars) = $class->_interpolate($args, '${%s}', qr/["\$]/, '"\\%s"'); if (!defined $value) { return qq{unsetenv $name;\n}; } my $out = ''; for my $var (@vars) { $out .= qq{if ! \$?$name setenv $name '';\n}; } my $value_without = $value; if ($value_without =~ s/(?:^|$_path_sep)\$\{$name\}(?:$_path_sep|$)//g) { $out .= qq{if "\${$name}" != '' setenv $name "$value";\n}; $out .= qq{if "\${$name}" == '' }; } $out .= qq{setenv $name "$value_without";\n}; return $out; } sub build_cmd_env_declaration { my ($class, $name, $args) = @_; my $value = $class->_interpolate($args, '%%%s%%', qr(%), '%s'); if (!$value) { return qq{\@set $name=\n}; } my $out = ''; my $value_without = $value; if ($value_without =~ s/(?:^|$_path_sep)%$name%(?:$_path_sep|$)//g) { $out .= qq{\@if not "%$name%"=="" set "$name=$value"\n}; $out .= qq{\@if "%$name%"=="" }; } $out .= qq{\@set "$name=$value_without"\n}; return $out; } sub build_powershell_env_declaration { my ($class, $name, $args) = @_; my $value = $class->_interpolate($args, '$env:%s', qr/["\$]/, '`%s'); if (!$value) { return qq{Remove-Item -ErrorAction 0 Env:\\$name;\n}; } my $maybe_path_sep = qq{\$(if("\$env:$name"-eq""){""}else{"$_path_sep"})}; $value =~ s/(^|\G|$_path_sep)\$env:$name$_path_sep/$1\$env:$name"+$maybe_path_sep+"/g; $value =~ s/$_path_sep\$env:$name$/"+$maybe_path_sep+\$env:$name+"/; qq{\$env:$name = \$("$value");\n}; } sub wrap_powershell_output { my ($class, $out) = @_; return $out || " \n"; } sub build_fish_env_declaration { my ($class, $name, $args) = @_; my $value = $class->_interpolate($args, '$%s', qr/[\\"'$ ]/, '\\%s'); if (!defined $value) { return qq{set -e $name;\n}; } # fish has special handling for PATH, CDPATH, and MANPATH. They are always # treated as arrays, and joined with ; when storing the environment. Other # env vars can be arrays, but will be joined without a separator. We only # really care about PATH, but might as well make this routine more general. if ($name =~ /^(?:CD|MAN)?PATH$/) { $value =~ s/$_path_sep/ /g; my $silent = $name =~ /^(?:CD)?PATH$/ ? " ^"._devnull : ''; return qq{set -x $name $value$silent;\n}; } my $out = ''; my $value_without = $value; if ($value_without =~ s/(?:^|$_path_sep)\$$name(?:$_path_sep|$)//g) { $out .= qq{set -q $name; and set -x $name $value;\n}; $out .= qq{set -q $name; or }; } $out .= qq{set -x $name $value_without;\n}; $out; } sub _interpolate { my ($class, $args, $var_pat, $escape, $escape_pat) = @_; return unless defined $args; my @args = ref $args ? @$args : $args; return unless @args; my @vars = map { $$_ } grep { ref $_ eq 'SCALAR' } @args; my $string = join $_path_sep, map { ref $_ eq 'SCALAR' ? sprintf($var_pat, $$_) : do { s/($escape)/sprintf($escape_pat, $1)/ge; $_; }; } @args; return wantarray ? ($string, \@vars) : $string; } sub pipeline; sub pipeline { my @methods = @_; my $last = pop(@methods); if (@methods) { \sub { my ($obj, @args) = @_; $obj->${pipeline @methods}( $obj->$last(@args) ); }; } else { \sub { shift->$last(@_); }; } } sub resolve_path { my ($class, $path) = @_; $path = $class->${pipeline qw( resolve_relative_path resolve_home_path resolve_empty_path )}($path); $path; } sub resolve_empty_path { my ($class, $path) = @_; if (defined $path) { $path; } else { '~/perl5'; } } sub resolve_home_path { my ($class, $path) = @_; $path =~ /^~([^\/]*)/ or return $path; my $user = $1; my $homedir = do { if (! length($user) && defined $ENV{HOME}) { $ENV{HOME}; } else { require File::Glob; File::Glob::bsd_glob("~$user", File::Glob::GLOB_TILDE()); } }; unless (defined $homedir) { require Carp; require Carp::Heavy; Carp::croak( "Couldn't resolve homedir for " .(defined $user ? $user : 'current user') ); } $path =~ s/^~[^\/]*/$homedir/; $path; } sub resolve_relative_path { my ($class, $path) = @_; _rel2abs($path); } sub ensure_dir_structure_for { my ($class, $path, $opts) = @_; $opts ||= {}; my @dirs; foreach my $dir ( $class->lib_paths_for($path), $class->install_base_bin_path($path), ) { my $d = $dir; while (!-d $d) { push @dirs, $d; require File::Basename; $d = File::Basename::dirname($d); } } warn "Attempting to create directory ${path}\n" if !$opts->{quiet} && @dirs; my %seen; foreach my $dir (reverse @dirs) { next if $seen{$dir}++; mkdir $dir or -d $dir or die "Unable to create $dir: $!" } return; } sub guess_shelltype { my $shellbin = defined $ENV{SHELL} && length $ENV{SHELL} ? ($ENV{SHELL} =~ /([\w.]+)$/)[-1] : ( $^O eq 'MSWin32' && exists $ENV{'!EXITCODE'} ) ? 'bash' : ( $^O eq 'MSWin32' && $ENV{PROMPT} && $ENV{COMSPEC} ) ? ($ENV{COMSPEC} =~ /([\w.]+)$/)[-1] : ( $^O eq 'MSWin32' && !$ENV{PROMPT} ) ? 'powershell.exe' : 'sh'; for ($shellbin) { return /csh$/ ? 'csh' : /fish$/ ? 'fish' : /command(?:\.com)?$/i ? 'cmd' : /cmd(?:\.exe)?$/i ? 'cmd' : /4nt(?:\.exe)?$/i ? 'cmd' : /powershell(?:\.exe)?$/i ? 'powershell' : 'bourne'; } } 1; __END__ =encoding utf8 =head1 NAME local::lib - create and use a local lib/ for perl modules with PERL5LIB =head1 SYNOPSIS In code - use local::lib; # sets up a local lib at ~/perl5 use local::lib '~/foo'; # same, but ~/foo # Or... use FindBin; use local::lib "$FindBin::Bin/../support"; # app-local support library From the shell - # Install LWP and its missing dependencies to the '~/perl5' directory perl -MCPAN -Mlocal::lib -e 'CPAN::install(LWP)' # Just print out useful shell commands $ perl -Mlocal::lib PERL_MB_OPT='--install_base /home/username/perl5'; export PERL_MB_OPT; PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'; export PERL_MM_OPT; PERL5LIB="/home/username/perl5/lib/perl5"; export PERL5LIB; PATH="/home/username/perl5/bin:$PATH"; export PATH; PERL_LOCAL_LIB_ROOT="/home/usename/perl5:$PERL_LOCAL_LIB_ROOT"; export PERL_LOCAL_LIB_ROOT; From a F<.bash_profile> or F<.bashrc> file - eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)" =head2 The bootstrapping technique A typical way to install local::lib is using what is known as the "bootstrapping" technique. You would do this if your system administrator hasn't already installed local::lib. In this case, you'll need to install local::lib in your home directory. Even if you do have administrative privileges, you will still want to set up your environment variables, as discussed in step 4. Without this, you would still install the modules into the system CPAN installation and also your Perl scripts will not use the lib/ path you bootstrapped with local::lib. By default local::lib installs itself and the CPAN modules into ~/perl5. Windows users must also see L</Differences when using this module under Win32>. =over 4 =item 1. Download and unpack the local::lib tarball from CPAN (search for "Download" on the CPAN page about local::lib). Do this as an ordinary user, not as root or administrator. Unpack the file in your home directory or in any other convenient location. =item 2. Run this: perl Makefile.PL --bootstrap If the system asks you whether it should automatically configure as much as possible, you would typically answer yes. In order to install local::lib into a directory other than the default, you need to specify the name of the directory when you call bootstrap, as follows: perl Makefile.PL --bootstrap=~/foo =item 3. Run this: (local::lib assumes you have make installed on your system) make test && make install =item 4. Now we need to setup the appropriate environment variables, so that Perl starts using our newly generated lib/ directory. If you are using bash or any other Bourne shells, you can add this to your shell startup script this way: echo 'eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"' >>~/.bashrc If you are using C shell, you can do this as follows: /bin/csh echo $SHELL /bin/csh echo 'eval `perl -I$HOME/perl5/lib/perl5 -Mlocal::lib`' >> ~/.cshrc If you passed to bootstrap a directory other than default, you also need to give that as import parameter to the call of the local::lib module like this way: echo 'eval "$(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)"' >>~/.bashrc After writing your shell configuration file, be sure to re-read it to get the changed settings into your current shell's environment. Bourne shells use C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>. =back If you're on a slower machine, or are operating under draconian disk space limitations, you can disable the automatic generation of manpages from POD when installing modules by using the C<--no-manpages> argument when bootstrapping: perl Makefile.PL --bootstrap --no-manpages To avoid doing several bootstrap for several Perl module environments on the same account, for example if you use it for several different deployed applications independently, you can use one bootstrapped local::lib installation to install modules in different directories directly this way: cd ~/mydir1 perl -Mlocal::lib=./ eval $(perl -Mlocal::lib=./) ### To set the environment for this shell alone printenv ### You will see that ~/mydir1 is in the PERL5LIB perl -MCPAN -e install ... ### whatever modules you want cd ../mydir2 ... REPEAT ... If you use F<.bashrc> to activate a local::lib automatically, the local::lib will be re-enabled in any sub-shells used, overriding adjustments you may have made in the parent shell. To avoid this, you can initialize the local::lib in F<.bash_profile> rather than F<.bashrc>, or protect the local::lib invocation with a C<$SHLVL> check: [ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)" If you are working with several C<local::lib> environments, you may want to remove some of them from the current environment without disturbing the others. You can deactivate one environment like this (using bourne sh): eval $(perl -Mlocal::lib=--deactivate,~/path) which will generate and run the commands needed to remove C<~/path> from your various search paths. Whichever environment was B<activated most recently> will remain the target for module installations. That is, if you activate C<~/path_A> and then you activate C<~/path_B>, new modules you install will go in C<~/path_B>. If you deactivate C<~/path_B> then modules will be installed into C<~/pathA> -- but if you deactivate C<~/path_A> then they will still be installed in C<~/pathB> because pathB was activated later. You can also ask C<local::lib> to clean itself completely out of the current shell's environment with the C<--deactivate-all> option. For multiple environments for multiple apps you may need to include a modified version of the C<< use FindBin >> instructions in the "In code" sample above. If you did something like the above, you have a set of Perl modules at C<< ~/mydir1/lib >>. If you have a script at C<< ~/mydir1/scripts/myscript.pl >>, you need to tell it where to find the modules you installed for it at C<< ~/mydir1/lib >>. In C<< ~/mydir1/scripts/myscript.pl >>: use strict; use warnings; use local::lib "$FindBin::Bin/.."; ### points to ~/mydir1 and local::lib finds lib use lib "$FindBin::Bin/../lib"; ### points to ~/mydir1/lib Put this before any BEGIN { ... } blocks that require the modules you installed. =head2 Differences when using this module under Win32 To set up the proper environment variables for your current session of C<CMD.exe>, you can use this: C:\>perl -Mlocal::lib set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5 set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5 set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5 set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH% ### To set the environment for this shell alone C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\tmp.bat ### instead of $(perl -Mlocal::lib=./) If you want the environment entries to persist, you'll need to add them to the Control Panel's System applet yourself or use L<App::local::lib::Win32Helper>. The "~" is translated to the user's profile directory (the directory named for the user under "Documents and Settings" (Windows XP or earlier) or "Users" (Windows Vista or later)) unless $ENV{HOME} exists. After that, the home directory is translated to a short name (which means the directory must exist) and the subdirectories are created. =head3 PowerShell local::lib also supports PowerShell, and can be used with the C<Invoke-Expression> cmdlet. Invoke-Expression "$(perl -Mlocal::lib)" =head1 RATIONALE The version of a Perl package on your machine is not always the version you need. Obviously, the best thing to do would be to update to the version you need. However, you might be in a situation where you're prevented from doing this. Perhaps you don't have system administrator privileges; or perhaps you are using a package management system such as Debian, and nobody has yet gotten around to packaging up the version you need. local::lib solves this problem by allowing you to create your own directory of Perl packages downloaded from CPAN (in a multi-user system, this would typically be within your own home directory). The existing system Perl installation is not affected; you simply invoke Perl with special options so that Perl uses the packages in your own local package directory rather than the system packages. local::lib arranges things so that your locally installed version of the Perl packages takes precedence over the system installation. If you are using a package management system (such as Debian), you don't need to worry about Debian and CPAN stepping on each other's toes. Your local version of the packages will be written to an entirely separate directory from those installed by Debian. =head1 DESCRIPTION This module provides a quick, convenient way of bootstrapping a user-local Perl module library located within the user's home directory. It also constructs and prints out for the user the list of environment variables using the syntax appropriate for the user's current shell (as specified by the C<SHELL> environment variable), suitable for directly adding to one's shell configuration file. More generally, local::lib allows for the bootstrapping and usage of a directory containing Perl modules outside of Perl's C<@INC>. This makes it easier to ship an application with an app-specific copy of a Perl module, or collection of modules. Useful in cases like when an upstream maintainer hasn't applied a patch to a module of theirs that you need for your application. On import, local::lib sets the following environment variables to appropriate values: =over 4 =item PERL_MB_OPT =item PERL_MM_OPT =item PERL5LIB =item PATH =item PERL_LOCAL_LIB_ROOT =back When possible, these will be appended to instead of overwritten entirely. These values are then available for reference by any code after import. =head1 CREATING A SELF-CONTAINED SET OF MODULES See L<lib::core::only> for one way to do this - but note that there are a number of caveats, and the best approach is always to perform a build against a clean perl (i.e. site and vendor as close to empty as possible). =head1 IMPORT OPTIONS Options are values that can be passed to the C<local::lib> import besides the directory to use. They are specified as C<use local::lib '--option'[, path];> or C<perl -Mlocal::lib=--option[,path]>. =head2 --deactivate Remove the chosen path (or the default path) from the module search paths if it was added by C<local::lib>, instead of adding it. =head2 --deactivate-all Remove all directories that were added to search paths by C<local::lib> from the search paths. =head2 --shelltype Specify the shell type to use for output. By default, the shell will be detected based on the environment. Should be one of: C<bourne>, C<csh>, C<cmd>, or C<powershell>. =head2 --no-create Prevents C<local::lib> from creating directories when activating dirs. This is likely to cause issues on Win32 systems. =head1 CLASS METHODS =head2 ensure_dir_structure_for =over 4 =item Arguments: $path =item Return value: None =back Attempts to create a local::lib directory, including subdirectories and all required parent directories. Throws an exception on failure. =head2 print_environment_vars_for =over 4 =item Arguments: $path =item Return value: None =back Prints to standard output the variables listed above, properly set to use the given path as the base directory. =head2 build_environment_vars_for =over 4 =item Arguments: $path =item Return value: %environment_vars =back Returns a hash with the variables listed above, properly set to use the given path as the base directory. =head2 setup_env_hash_for =over 4 =item Arguments: $path =item Return value: None =back Constructs the C<%ENV> keys for the given path, by calling L</build_environment_vars_for>. =head2 active_paths =over 4 =item Arguments: None =item Return value: @paths =back Returns a list of active C<local::lib> paths, according to the C<PERL_LOCAL_LIB_ROOT> environment variable and verified against what is really in C<@INC>. =head2 install_base_perl_path =over 4 =item Arguments: $path =item Return value: $install_base_perl_path =back Returns a path describing where to install the Perl modules for this local library installation. Appends the directories C<lib> and C<perl5> to the given path. =head2 lib_paths_for =over 4 =item Arguments: $path =item Return value: @lib_paths =back Returns the list of paths perl will search for libraries, given a base path. This includes the base path itself, the architecture specific subdirectory, and perl version specific subdirectories. These paths may not all exist. =head2 install_base_bin_path =over 4 =item Arguments: $path =item Return value: $install_base_bin_path =back Returns a path describing where to install the executable programs for this local library installation. Appends the directory C<bin> to the given path. =head2 installer_options_for =over 4 =item Arguments: $path =item Return value: %installer_env_vars =back Returns a hash of environment variables that should be set to cause installation into the given path. =head2 resolve_empty_path =over 4 =item Arguments: $path =item Return value: $base_path =back Builds and returns the base path into which to set up the local module installation. Defaults to C<~/perl5>. =head2 resolve_home_path =over 4 =item Arguments: $path =item Return value: $home_path =back Attempts to find the user's home directory. If installed, uses C<File::HomeDir> for this purpose. If no definite answer is available, throws an exception. =head2 resolve_relative_path =over 4 =item Arguments: $path =item Return value: $absolute_path =back Translates the given path into an absolute path. =head2 resolve_path =over 4 =item Arguments: $path =item Return value: $absolute_path =back Calls the following in a pipeline, passing the result from the previous to the next, in an attempt to find where to configure the environment for a local library installation: L</resolve_empty_path>, L</resolve_home_path>, L</resolve_relative_path>. Passes the given path argument to L</resolve_empty_path> which then returns a result that is passed to L</resolve_home_path>, which then has its result passed to L</resolve_relative_path>. The result of this final call is returned from L</resolve_path>. =head1 OBJECT INTERFACE =head2 new =over 4 =item Arguments: %attributes =item Return value: $local_lib =back Constructs a new C<local::lib> object, representing the current state of C<@INC> and the relevant environment variables. =head1 ATTRIBUTES =head2 roots An arrayref representing active C<local::lib> directories. =head2 inc An arrayref representing C<@INC>. =head2 libs An arrayref representing the PERL5LIB environment variable. =head2 bins An arrayref representing the PATH environment variable. =head2 extra A hashref of extra environment variables (e.g. C<PERL_MM_OPT> and C<PERL_MB_OPT>) =head2 no_create If set, C<local::lib> will not try to create directories when activating them. =head1 OBJECT METHODS =head2 clone =over 4 =item Arguments: %attributes =item Return value: $local_lib =back Constructs a new C<local::lib> object based on the existing one, overriding the specified attributes. =head2 activate =over 4 =item Arguments: $path =item Return value: $new_local_lib =back Constructs a new instance with the specified path active. =head2 deactivate =over 4 =item Arguments: $path =item Return value: $new_local_lib =back Constructs a new instance with the specified path deactivated. =head2 deactivate_all =over 4 =item Arguments: None =item Return value: $new_local_lib =back Constructs a new instance with all C<local::lib> directories deactivated. =head2 environment_vars_string =over 4 =item Arguments: [ $shelltype ] =item Return value: $shell_env_string =back Returns a string to set up the C<local::lib>, meant to be run by a shell. =head2 build_environment_vars =over 4 =item Arguments: None =item Return value: %environment_vars =back Returns a hash with the variables listed above, properly set to use the given path as the base directory. =head2 setup_env_hash =over 4 =item Arguments: None =item Return value: None =back Constructs the C<%ENV> keys for the given path, by calling L</build_environment_vars>. =head2 setup_local_lib Constructs the C<%ENV> hash using L</setup_env_hash>, and set up C<@INC>. =head1 A WARNING ABOUT UNINST=1 Be careful about using local::lib in combination with "make install UNINST=1". The idea of this feature is that will uninstall an old version of a module before installing a new one. However it lacks a safety check that the old version and the new version will go in the same directory. Used in combination with local::lib, you can potentially delete a globally accessible version of a module while installing the new version in a local place. Only combine "make install UNINST=1" and local::lib if you understand these possible consequences. =head1 LIMITATIONS =over 4 =item * Directory names with spaces in them are not well supported by the perl toolchain and the programs it uses. Pure-perl distributions should support spaces, but problems are more likely with dists that require compilation. A workaround you can do is moving your local::lib to a directory with spaces B<after> you installed all modules inside your local::lib bootstrap. But be aware that you can't update or install CPAN modules after the move. =item * Rather basic shell detection. Right now anything with csh in its name is assumed to be a C shell or something compatible, and everything else is assumed to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is not set, a Bourne-compatible shell is assumed. =item * Kills any existing PERL_MM_OPT or PERL_MB_OPT. =item * Should probably auto-fixup CPAN config if not already done. =item * On VMS and MacOS Classic (pre-OS X), local::lib loads L<File::Spec>. This means any L<File::Spec> version installed in the local::lib will be ignored by scripts using local::lib. A workaround for this is using C<use lib "$local_lib/lib/perl5";> instead of using C<local::lib> directly. =item * Conflicts with L<ExtUtils::MakeMaker>'s C<PREFIX> option. C<local::lib> uses the C<INSTALL_BASE> option, as it has more predictable and sane behavior. If something attempts to use the C<PREFIX> option when running a F<Makefile.PL>, L<ExtUtils::MakeMaker> will refuse to run, as the two options conflict. This can be worked around by temporarily unsetting the C<PERL_MM_OPT> environment variable. =item * Conflicts with L<Module::Build>'s C<--prefix> option. Similar to the previous limitation, but any C<--prefix> option specified will be ignored. This can be worked around by temporarily unsetting the C<PERL_MB_OPT> environment variable. =back Patches very much welcome for any of the above. =over 4 =item * On Win32 systems, does not have a way to write the created environment variables to the registry, so that they can persist through a reboot. =back =head1 TROUBLESHOOTING If you've configured local::lib to install CPAN modules somewhere in to your home directory, and at some point later you try to install a module with C<cpan -i Foo::Bar>, but it fails with an error like: C<Warning: You do not have permissions to install into /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux at /usr/lib64/perl5/5.8.8/Foo/Bar.pm> and buried within the install log is an error saying C<'INSTALL_BASE' is not a known MakeMaker parameter name>, then you've somehow lost your updated ExtUtils::MakeMaker module. To remedy this situation, rerun the bootstrapping procedure documented above. Then, run C<rm -r ~/.cpan/build/Foo-Bar*> Finally, re-run C<cpan -i Foo::Bar> and it should install without problems. =head1 ENVIRONMENT =over 4 =item SHELL =item COMSPEC local::lib looks at the user's C<SHELL> environment variable when printing out commands to add to the shell configuration file. On Win32 systems, C<COMSPEC> is also examined. =back =head1 SEE ALSO =over 4 =item * L<Perl Advent article, 2011|http://perladvent.org/2011/2011-12-01.html> =back =head1 SUPPORT IRC: Join #toolchain on irc.perl.org. =head1 AUTHOR Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/ auto_install fixes kindly sponsored by http://www.takkle.com/ =head1 CONTRIBUTORS Patches to correctly output commands for csh style shells, as well as some documentation additions, contributed by Christopher Nehren <apeiron@cpan.org>. Doc patches for a custom local::lib directory, more cleanups in the english documentation and a L<german documentation|POD2::DE::local::lib> contributed by Torsten Raudssus <torsten@raudssus.de>. Hans Dieter Pearcey <hdp@cpan.org> sent in some additional tests for ensuring things will install properly, submitted a fix for the bug causing problems with writing Makefiles during bootstrapping, contributed an example program, and submitted yet another fix to ensure that local::lib can install and bootstrap properly. Many, many thanks! pattern of Freenode IRC contributed the beginnings of the Troubleshooting section. Many thanks! Patch to add Win32 support contributed by Curtis Jewell <csjewell@cpan.org>. Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced by a patch from Marco Emilio Poleggi. Mark Stosberg <mark@summersault.com> provided the code for the now deleted '--self-contained' option. Documentation patches to make win32 usage clearer by David Mertens <dcmertens.perl@gmail.com> (run4flat). Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc patches contributed by Breno G. de Oliveira <garu@cpan.org>. Improvements to stacking multiple local::lib dirs and removing them from the environment later on contributed by Andrew Rodland <arodland@cpan.org>. Patch for Carp version mismatch contributed by Hakim Cassimally <osfameron@cpan.org>. Rewrite of internals and numerous bug fixes and added features contributed by Graham Knop <haarg@haarg.org>. =head1 COPYRIGHT Copyright (c) 2007 - 2013 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as listed above. =head1 LICENSE This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut LOCAL_LIB 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 BEGIN { our $INLINE_CPANM = <<'CPANM'; #!/usr/bin/perl # # This is a pre-compiled source code for the cpanm (cpanminus) program. # For more details about how to install cpanm, go to the following URL: # # https://github.com/miyagawa/cpanminus # # Quickstart: Run the following command and it will install itself for # you. You might want to run it as a root with sudo if you want to install # to places like /usr/local/bin. # # % curl -L https://cpanmin.us | perl - App::cpanminus # # If you don't have curl but wget, replace `curl -L` with `wget -O -`. # DO NOT EDIT -- this is an auto generated file # This chunk of stuff was generated by App::FatPacker. To find the original # file's code, look for the end of this BEGIN block or the string 'FATPACK' BEGIN { my %fatpacked; $fatpacked{"App/cpanminus.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS'; package App::cpanminus;our$VERSION="1.7044";1; APP_CPANMINUS $fatpacked{"App/cpanminus/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_DEPENDENCY'; package App::cpanminus::Dependency;use strict;use CPAN::Meta::Requirements;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 new {my($class,$module,$version,$type)=@_;bless {module=>$module,version=>$version,type=>$type || 'requires',},$class}sub module {$_[0]->{module}}sub version {$_[0]->{version}}sub type {$_[0]->{type}}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; APP_CPANMINUS_DEPENDENCY $fatpacked{"App/cpanminus/script.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_SCRIPT'; package App::cpanminus::script;use strict;use Config;use Cwd ();use App::cpanminus;use App::cpanminus::Dependency;use File::Basename ();use File::Find ();use File::Path ();use File::Spec ();use File::Copy ();use File::Temp ();use Getopt::Long ();use Symbol ();use String::ShellQuote ();use version ();use constant WIN32=>$^O eq 'MSWin32';use constant BAD_TAR=>($^O eq 'solaris' || $^O eq 'hpux');use constant CAN_SYMLINK=>eval {symlink("","");1};our$VERSION=$App::cpanminus::VERSION;if ($INC{"App/FatPacker/Trace.pm"}){require version::vpp}my$quote=WIN32 ? q/"/ : q/'/;sub agent {my$self=shift;my$agent="cpanminus/$VERSION";$agent .= " perl/$]" if$self->{report_perl_version};$agent}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;bless {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,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}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},'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 <<DIE}else {die <<DIE}}}sub check_libs {my$self=shift;return if$self->{_checked}++;$self->bootstrap_local_lib}sub setup_verify {my$self=shift;my$has_modules=eval {require Module::Signature;require Digest::SHA;1};$self->{cpansign}=$self->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 doit {my$self=shift;my$code;eval {$code=($self->_doit==0)};if (my$e=$@){warn$e;$code=1}return$code}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 (App::cpanminus) $VERSION on perl $] built for $Config{archname}\n" ."Work directory is $self->{base}\n")}sub package_index_for {my ($self,$mirror)=@_;return$self->source_for($mirror)."/02packages.details.txt"}sub generate_mirror_index {my ($self,$mirror)=@_;my$file=$self->package_index_for($mirror);my$gz_file=$file .'.gz';my$index_mtime=(stat$gz_file)[9];unless (-e $file && (stat$file)[9]>= $index_mtime){$self->chat("Uncompressing index file...\n");if (eval {require Compress::Zlib}){my$gz=Compress::Zlib::gzopen($gz_file,"rb")or do {$self->diag_fail("$Compress::Zlib::gzerrno opening compressed index");return};open my$fh,'>',$file or do {$self->diag_fail("$! opening uncompressed index for write");return};my$buffer;while (my$status=$gz->gzread($buffer)){if ($status < 0){$self->diag_fail($gz->gzerror ." reading compressed index");return}print$fh $buffer}}else {if (system("gunzip -c $gz_file > $file")){$self->diag_fail("Cannot uncompress -- please install gunzip or Compress::Zlib");return}}utime$index_mtime,$index_mtime,$file}return 1}sub search_mirror_index {my ($self,$mirror,$module,$version)=@_;$self->search_mirror_index_file($self->package_index_for($mirror),$module,$version)}sub search_mirror_index_file {my($self,$file,$module,$version)=@_;open my$fh,'<',$file or return;my$found;while (<$fh>){if (m!^\Q$module\E\s+([\w\.]+)\s+(\S*)!m){$found=$self->cpan_module($module,$2,$1);last}}return$found unless$self->{cascade_search};if ($found){if ($self->satisfy_version($module,$found->{module_version},$version)){return$found}else {$self->chat("Found $module $found->{module_version} which doesn't satisfy $version.\n")}}return}sub with_version_range {my($self,$version)=@_;defined($version)&& $version =~ /(?:<|!=|==)/}sub encode_json {my($self,$data)=@_;require JSON::PP;my$json=JSON::PP::encode_json($data);$self->uri_escape($json)}sub decode_json {my($self,$json)=@_;require JSON::PP;JSON::PP::decode_json($json)}sub uri_escape {my($self,$fragment)=@_;$fragment =~ s/([^A-Za-z0-9\-\._~])/uc sprintf("%%%02X", ord($1))/eg;$fragment}sub uri_params {my($self,@params)=@_;my@param_strings;while (my$key=shift@params){my$value=shift@params;push@param_strings,join '=',map$self->uri_escape($_),$key,$value}return join '&',@param_strings}sub numify_ver {my($self,$ver)=@_;eval version->new($ver)->numify}sub search_metacpan {my($self,$module,$version,$dev_release)=@_;my$metacpan_uri='http://fastapi.metacpan.org/v1/download_url/';my$url=$metacpan_uri .$module;my$query=$self->uri_params(($version ? (version=>$version): ()),($dev_release ? (dev=>1): ()),);$url .= '?' .$query if length$query;my$dist_json=$self->get($url);my$dist_meta=eval {$self->decode_json($dist_json)};if ($dist_meta && $dist_meta->{download_url}){(my$distfile=$dist_meta->{download_url})=~ s!.+/authors/id/!!;local$self->{mirrors}=$self->{mirrors};$self->{mirrors}=['http://cpan.metacpan.org' ];return$self->cpan_module($module,$distfile,$dist_meta->{version})}$self->chat("! Could not find a release matching $module".($version?" ($version)":'')." on MetaCPAN.\n");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)=@_;$self->chat("Searching $module ($version) on cpanmetadb ...\n");if ($self->with_version_range($version)){return$self->search_cpanmetadb_history($module,$version,$dev_release)}else {return$self->search_cpanmetadb_package($module,$version,$dev_release)}}sub search_cpanmetadb_package {my($self,$module,$version,$dev_release)=@_;require CPAN::Meta::YAML;(my$uri=$self->{cpanmetadb})=~ s{/?$}{/package/$module};my$yaml=$self->get($uri);my$meta=eval {CPAN::Meta::YAML::Load($yaml)};if ($meta && $meta->{distfile}){return$self->cpan_module($module,$meta->{distfile},$meta->{version})}$self->diag_fail("Finding $module on cpanmetadb failed.");return}sub search_cpanmetadb_history {my($self,$module,$version)=@_;(my$uri=$self->{cpanmetadb})=~ s{/?$}{/history/$module};my$content=$self->get($uri)or return;my@found;for my$line (split /\r?\n/,$content){if ($line =~ /^$module\s+(\S+)\s+(\S+)$/){push@found,{version=>$1,version_obj=>version::->parse($1),distfile=>$2,}}}return unless@found;$found[-1]->{latest}=1;my$match;for my$try (sort {$b->{version_obj}cmp $a->{version_obj}}@found){if ($self->satisfy_version($module,$try->{version_obj},$version)){local$self->{mirrors}=$self->{mirrors};unshift @{$self->{mirrors}},'http://backpan.perl.org' unless$try->{latest};return$self->cpan_module($module,$try->{distfile},$try->{version})}}$self->diag_fail("Finding $module ($version) 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_file($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$name='02packages.details.txt.gz';my$uri="$mirror/modules/$name";my$gz_file=$self->package_index_for($mirror).'.gz';unless ($self->{pkgs}{$uri}){$self->mask_output(chat=>"Downloading index file $uri ...\n");$self->mirror($uri,$gz_file);$self->generate_mirror_index($mirror)or next MIRROR;$self->{pkgs}{$uri}="!!retrieved!!"}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 (App::cpanminus) version $VERSION ($0)\n";print "perl version $] ($^X)\n\n";print " \%Config:\n";for my$key (qw(archname installsitelib installsitebin installman1dir installman3dir sitearchexp sitelibexp vendorarch vendorlibexp archlibexp privlibexp)){print " $key=$Config{$key}\n" if$Config{$key}}print " \%ENV:\n";for my$key (grep /^PERL/,sort keys%ENV){print " $key=$ENV{$key}\n"}print " \@INC:\n";for my$inc (@INC){print " $inc\n" unless ref($inc)eq 'CODE'}return 1}sub show_help {my$self=shift;if ($_[0]){print <<USAGE;return}print <<HELP;return 1}sub _writable {my$dir=shift;my@dir=File::Spec->splitdir($dir);while (@dir){$dir=File::Spec->catdir(@dir);if (-e $dir){return -w _}pop@dir}return}sub maybe_abs {my($self,$lib)=@_;if ($lib eq '_' or $lib =~ /^~/ or File::Spec->file_name_is_absolute($lib)){return$lib}else {return File::Spec->canonpath(File::Spec->catdir(Cwd::cwd(),$lib))}}sub local_lib_target {my($self,$root)=@_;(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(<<DIAG,1);sleep 2}sub upgrade_toolchain {my($self,$config_deps)=@_;my%deps=map {$_->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"}||= App::cpanminus::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 _diff {my($self,$old,$new)=@_;my@diff;my%old=map {$_=>1}@$old;for my$n (@$new){push@diff,$n unless exists$old{$n}}@diff}sub _setup_local_lib_env {my($self,$base)=@_;$self->diag(<<WARN,1)if$base =~ /\s/;local$SIG{__WARN__}=sub {};local::lib->setup_env_hash_for($base,0)}sub setup_local_lib {my($self,$base,$no_env)=@_;$base=undef if$base eq '_';require local::lib;{local $0='cpanm';$base ||= "~/perl5";$base=local::lib->resolve_path($base);if ($self->{self_contained}){my@inc=$self->_core_only_inc($base);$self->{search_inc}=[@inc ]}else {$self->{search_inc}=[local::lib->install_base_arch_path($base),local::lib->install_base_perl_path($base),@INC,]}$self->_setup_local_lib_env($base)unless$no_env;$self->{local_lib}=$base}}sub prompt_bool {my($self,$mess,$def)=@_;my$val=$self->prompt($mess,$def);return lc$val eq 'y'}sub prompt {my($self,$mess,$def)=@_;my$isa_tty=-t STDIN && (-t STDOUT ||!(-f STDOUT || -c STDOUT));my$dispdef=defined$def ? "[$def] " : " ";$def=defined$def ? $def : "";if (!$self->{prompt}|| (!$isa_tty && eof STDIN)){return$def}local $|=1;local $\;my$ans;eval {local$SIG{ALRM}=sub {undef$ans;die "alarm\n"};print STDOUT "$mess $dispdef";alarm$self->{prompt_timeout}if$self->{prompt_timeout};$ans=<STDIN>;alarm 0};if (defined$ans){chomp$ans}else {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 {my($self,$cmd)=@_;if (WIN32){$cmd=$self->shell_quote(@$cmd)if ref$cmd eq 'ARRAY';unless ($self->{verbose}){$cmd .= " >> " .$self->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 .= " >> " .$self->shell_quote($self->{log})." 2>&1"}exec$cmd}}sub run_timeout {my($self,$cmd,$timeout)=@_;return$self->run($cmd)if 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($cmd)}}sub append_args {my($self,$cmd,$phase)=@_;if (my$args=$self->{build_args}{$phase}){$cmd=join ' ',$self->shell_quote(@$cmd),$args}$cmd}sub configure {my($self,$cmd,$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}=1 unless exists$ENV{PERL_USE_UNSAFE_INC};$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,$depth)=@_;local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{PERL_USE_UNSAFE_INC}=1 unless exists$ENV{PERL_USE_UNSAFE_INC};$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,$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,$depth)=@_;return 1 if$self->{notest};local$ENV{PERL_MM_USE_DEFAULT}=!$self->{interactive};local$ENV{NONINTERACTIVE_TESTING}=!$self->{interactive};$cmd=$self->append_args($cmd,'test')if$depth==0;local$ENV{PERL_USE_UNSAFE_INC}=1 unless exists$ENV{PERL_USE_UNSAFE_INC};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,$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,$depth)=@_;if ($depth==0 && $self->{test_only}){return 1}local$ENV{PERL_USE_UNSAFE_INC}=1 unless exists$ENV{PERL_USE_UNSAFE_INC};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($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=$self->which($pager);next unless$pager;last}if ($pager){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}=['App::cpanminus' ];return}sub install_module {my($self,$module,$depth,$version)=@_;$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);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(<<DIAG,1);return}my@uninst_files=$self->uninstall_target($metadata,$packlist);$self->ask_permission($module,\@uninst_files)or return;$self->uninstall_files(@uninst_files,$packlist);$self->diag("Successfully uninstalled $module\n",1);return 1}sub packlists_containing {my($self,$module,$inc)=@_;require Module::Metadata;my$metadata=Module::Metadata->new_from_module($module,inc=>$inc)or return;my$packlist;my$wanted=sub {return unless $_ eq '.packlist' && -f $_;for my$file ($self->unpack_packlist($File::Find::name)){$packlist ||= $File::Find::name if$file eq $metadata->filename}};{require File::pushd;my$pushd=File::pushd::pushd();my@search=grep -d $_,map File::Spec->catdir($_,'auto'),@$inc;File::Find::find($wanted,@search)}return$metadata,$packlist}sub uninstall_target {my($self,$metadata,$packlist)=@_;if ($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->sha1_for($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 sha1_for {my($self,$file)=@_;require Digest::SHA;open my$fh,"<",$file or die "$file: $!";my$dg=Digest::SHA->new(256);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=`$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)=@_;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 {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)=@_;$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=@{$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(['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(['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 setup_module_build_patch {my$self=shift;open my$out,">$self->{base}/ModuleBuildSkipMan.pm" or die $!;print$out <<EOF}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)}$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 : {};my@config_deps;if ($dist->{cpanmeta}){push@config_deps,App::cpanminus::Dependency->from_prereqs($dist->{cpanmeta}->effective_prereqs,['configure'],$self->{install_types},)}if (-e 'Build.PL' &&!$self->should_use_mm($dist->{dist})&&!@config_deps){push@config_deps,App::cpanminus::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};{$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$root_target=(($self->{installdeps}or $self->{showdeps})and $depth==0);$dist->{want_phases}=$self->{notest}&&!$root_target ? [qw(build runtime)]: [qw(build test runtime)];push @{$dist->{want_phases}},'develop' if$self->{with_develop}&& $depth==0;push @{$dist->{want_phases}},'configure' if$self->{with_configure}&& $depth==0;my@deps=$self->find_prereqs($dist);my$module_name=$self->find_module_name($configure_state)|| $dist->{meta}{name};$module_name =~ s/-/::/g;if ($self->{showdeps}){for my$dep (@config_deps,@deps){print$dep->module,($dep->version ? ("~".$dep->version): ""),"\n"}return 1}my$distname=$dist->{meta}{name}? "$dist->{meta}{name}-$dist->{meta}{version}" : $stuff;my$walkup;if ($self->{scandeps}){$walkup=$self->scandeps_append_child($dist)}$self->install_deps_bailout($distname,$dist->{dir},$depth,@deps)or return;if ($self->{scandeps}){unless ($configure_state->{configured_ok}){my$diag=<<DIAG;if (@config_deps){my@tree=@{$self->{scandeps_tree}};$diag .= "!\n" .join("",map "! * $_->[0]{module}\n",@tree[0..$#tree-1])if@tree}$self->diag("!\n$diag!\n",1)}$walkup->();return 1}if ($self->{installdeps}&& $depth==0){if ($configure_state->{configured_ok}){$self->diag("<== Installed dependencies for $stuff. Finishing.\n");return 1}else {$self->diag("! Configuring $distname failed. See $self->{log} for details.\n",1);return}}my$installed;if ($configure_state->{use_module_build}&& -e 'Build' && -f _){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{perl},"./Build" ],$distname,$depth)&& $self->test([$self->{perl},"./Build","test" ],$distname,$depth)&& $self->install([$self->{perl},"./Build","install" ],["--uninst",1 ],$depth)&& $installed++}elsif ($self->{make}&& -e 'Makefile'){$self->diag_progress("Building " .($self->{notest}? "" : "and testing ").$distname);$self->build([$self->{make}],$distname,$depth)&& $self->test([$self->{make},"test" ],$distname,$depth)&& $self->install([$self->{make},"install" ],["UNINST=1" ],$depth)&& $installed++}else {my$why;my$configure_failed=$configure_state->{configured}&&!$configure_state->{configured_ok};if ($configure_failed){$why="Configure failed for $distname."}elsif ($self->{make}){$why="The distribution doesn't have a proper Makefile.PL/Build.PL"}else {$why="Can't configure the distribution. You probably need to have 'make'."}$self->diag_fail("$why See $self->{log} for details.",1);return}if ($installed && $self->{test_only}){$self->diag_ok;$self->diag("Successfully tested $distname\n",1)}elsif ($installed){my$local=$self->{local_versions}{$dist->{module}|| ''};my$version=$dist->{module_version}|| $dist->{meta}{version}|| $dist->{version};my$reinstall=$local && ($local eq $version);my$action=$local &&!$reinstall ? $self->numify_ver($version)< $self->numify_ver($local)? "downgraded" : "upgraded" : undef;my$how=$reinstall ? "reinstalled $distname" : $local ? "installed $distname ($action from $local)" : "installed $distname" ;my$msg="Successfully $how";$self->diag_ok;$self->diag("$msg\n",1);$self->{installed_dists}++;$self->save_meta($stuff,$dist,$module_name,\@config_deps,\@deps);return 1}else {my$what=$self->{test_only}? "Testing" : "Installing";$self->diag_fail("$what $stuff failed. See $self->{log} for details. Retry with --force to force install it.",1);return}}sub perl_requirements {my($self,@requires)=@_;my@perl;for my$requires (grep defined,@requires){if (exists$requires->{perl}){push@perl,App::cpanminus::Dependency->new(perl=>$requires->{perl})}}return@perl}sub should_use_mm {my($self,$dist)=@_;my%should_use_mm=map {$_=>1}qw(version ExtUtils-ParseXS ExtUtils-Install ExtUtils-Manifest);$should_use_mm{$dist}}sub configure_this {my($self,$dist,$depth)=@_;if (-e $self->{cpanfile_path}&& $self->{installdeps}&& $depth==0){require Module::CPANfile;$dist->{cpanfile}=eval {Module::CPANfile->load($self->{cpanfile_path})};$self->diag_fail($@,1)if $@;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,}}my$state={};my$try_eumm=sub {if (-e 'Makefile.PL'){$self->chat("Running Makefile.PL\n");if ($self->configure([$self->{perl},"Makefile.PL" ],$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" ],$depth)){$state->{configured_ok}=-e 'Build' && -f _}$state->{use_module_build}++;$state->{configured}++}};my@try;if ($dist->{dist}&& $self->should_use_mm($dist->{dist})){@try=($try_eumm,$try_mb)}else {@try=($try_mb,$try_eumm)}for my$try (@try){$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 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";$self->safe_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$self->safe_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);if (-e "MYMETA.json"){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(\@cmd)}sub _merge_hashref {my($self,@hashrefs)=@_;my%hash;for my$h (@hashrefs){%hash=(%hash,%$h)}return \%hash}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 safe_eval {my($self,$code)=@_;eval$code}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})}}}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 App::cpanminus::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}require CPAN::Meta;my@deps;my($meta_file)=grep -f,qw(MYMETA.json MYMETA.yml);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)}}if (-e '_build/prereqs'){$self->chat("Checking dependencies from _build/prereqs ...\n");my$prereqs=do {open my$in,"_build/prereqs";$self->safe_eval(join "",<$in>)};my$meta=CPAN::Meta->new({name=>$dist->{meta}{name},version=>$dist->{meta}{version},%$prereqs },{lazy_validation=>1 },);@deps=$self->extract_prereqs($meta,$dist)}elsif (-e 'Makefile'){$self->chat("Finding PREREQ from Makefile ...\n");open my$mf,"Makefile";while (<$mf>){if (/^\#\s+PREREQ_PM => \{\s*(.*?)\s*\}/){my@all;my@pairs=split ', ',$1;for (@pairs){my ($pkg,$v)=split '=>',$_;push@all,[$pkg,$v ]}my$list=join ", ",map {"'$_->[0]' => $_->[1]"}@all;my$prereq=$self->safe_eval("no strict; +{ $list }");push@deps,App::cpanminus::Dependency->from_versions($prereq)if$prereq;last}}}return@deps}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,App::cpanminus::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=$self->soften_makemaker_prereqs($meta->effective_prereqs(\@features)->clone);return App::cpanminus::Dependency->from_prereqs($prereqs,$dist->{want_phases},$self->{install_types})}sub soften_makemaker_prereqs {my($self,$prereqs)=@_;return$prereqs unless -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)}}$prereqs}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 YAML;print 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 shell_quote {my($self,@stuff)=@_;if (WIN32){join ' ',map {/^${quote}.+${quote}$/ ? $_ : ($quote .$_ .$quote)}@stuff}else {String::ShellQuote::shell_quote_best_effort(@stuff)}}sub which {my($self,$name)=@_;if (File::Spec->file_name_is_absolute($name)){if (-x $name &&!-d _){return$name}}my$exe_ext=$Config{_exe};for my$dir (File::Spec->path){my$fullpath=File::Spec->catfile($dir,$name);if ((-x $fullpath || -x ($fullpath .= $exe_ext))&&!-d _){if ($fullpath =~ /\s/){$fullpath=$self->shell_quote($fullpath)}return$fullpath}}return}sub get {my($self,$uri)=@_;if ($uri =~ /^file:/){$self->file_get($uri)}else {$self->{_backends}{get}->(@_)}}sub mirror {my($self,$uri,$local)=@_;if ($uri =~ /^file:/){$self->file_mirror($uri,$local)}else {$self->{_backends}{mirror}->(@_)}}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 has_working_lwp {my($self,$mirrors)=@_;my$https=grep /^https:/,@$mirrors;eval {require LWP::UserAgent;LWP::UserAgent->VERSION(5.802);require LWP::Protocol::https if$https;1}}sub init_tools {my$self=shift;return if$self->{initialized}++;if ($self->{make}=$self->which($Config{make})){$self->chat("You have make $self->{make}\n")}if ($self->{try_lwp}&& $self->has_working_lwp($self->{mirrors})){$self->chat("You have LWP $LWP::VERSION\n");my$ua=sub {LWP::UserAgent->new(parse_head=>0,env_proxy=>1,agent=>$self->agent,timeout=>30,@_,)};$self->{_backends}{get}=sub {my$self=shift;my$res=$ua->()->request(HTTP::Request->new(GET=>$_[0]));return unless$res->is_success;return$res->decoded_content};$self->{_backends}{mirror}=sub {my$self=shift;my$res=$ua->()->mirror(@_);die$res->content if$res->code==501;$res->code}}elsif ($self->{try_wget}and my$wget=$self->which('wget')){$self->chat("You have $wget\n");my@common=('--user-agent',$self->agent,'--retry-connrefused',($self->{verbose}? (): ('-q')),);$self->{_backends}{get}=sub {my($self,$uri)=@_;$self->safeexec(my$fh,$wget,$uri,@common,'-O','-')or die "wget $uri: $!";local $/;<$fh>};$self->{_backends}{mirror}=sub {my($self,$uri,$path)=@_;$self->safeexec(my$fh,$wget,$uri,@common,'-O',$path)or die "wget $uri: $!";local $/;<$fh>}}elsif ($self->{try_curl}and my$curl=$self->which('curl')){$self->chat("You have $curl\n");my@common=('--location','--user-agent',$self->agent,($self->{verbose}? (): '-s'),);$self->{_backends}{get}=sub {my($self,$uri)=@_;$self->safeexec(my$fh,$curl,@common,$uri)or die "curl $uri: $!";local $/;<$fh>};$self->{_backends}{mirror}=sub {my($self,$uri,$path)=@_;$self->safeexec(my$fh,$curl,@common,$uri,'-#','-o',$path)or die "curl $uri: $!";local $/;<$fh>}}else {require HTTP::Tiny;$self->chat("Falling back to HTTP::Tiny $HTTP::Tiny::VERSION\n");my%common=(agent=>$self->agent,);$self->{_backends}{get}=sub {my$self=shift;my$res=HTTP::Tiny->new(%common)->get($_[0]);return unless$res->{success};return$res->{content}};$self->{_backends}{mirror}=sub {my$self=shift;my$res=HTTP::Tiny->new(%common)->mirror(@_);return$res->{status}}}my$tar=$self->which('tar');my$tar_ver;my$maybe_bad_tar=sub {WIN32 || BAD_TAR || (($tar_ver=`$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)=`$tar ${ar}tf $tarfile` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "$tar $ar$xf $tarfile";return$root if -d $root;$self->diag_fail("Bad archive: $tarfile");return undef}}elsif ($tar and my$gzip=$self->which('gzip')and my$bzip2=$self->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)=`$ar -dc $tarfile | $tar tf -` or return undef;FILE: {chomp$root;$root =~ s!^\./!!;$root =~ s{^(.+?)/.*$}{$1};if (!length($root)){$root=shift(@others);redo FILE if$root}}system "$ar -dc $tarfile | $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=$self->which('unzip')){$self->chat("You have $unzip\n");$self->{_backends}{unzip}=sub {my($self,$zipfile)=@_;my$opt=$self->{verbose}? '' : '-q';my(undef,$root,@others)=`$unzip -t $zipfile` or return undef;FILE: {chomp$root;if ($root !~ s{^\s+testing:\s+([^/]+)/.*?\s+OK$}{$1}){$root=shift(@others);redo FILE if$root}}system "$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 safeexec {my$self=shift;my$rdr=$_[0]||= Symbol::gensym();if (WIN32){my$cmd=$self->shell_quote(@_[1..$#_]);return open($rdr,"$cmd |")}if (my$pid=open($rdr,'-|')){return$pid}elsif (defined$pid){exec(@_[1 .. $#_ ]);exit 1}else {return}}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 package ModuleBuildSkipMan; CHECK { if (%Module::Build::) { no warnings 'redefine'; *Module::Build::Base::ACTION_manpages = sub {}; *Module::Build::Base::ACTION_docs = sub {}; } } 1; EOF ! Configuring $distname failed. See $self->{log} for details. ! You might have to install the following modules first to get --scandeps working correctly. DIAG APP_CPANMINUS_SCRIPT $fatpacked{"CPAN/DistnameInfo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_DISTNAMEINFO'; package CPAN::DistnameInfo;$VERSION="0.12";use strict;sub distname_info {my$file=shift or return;my ($dist,$version)=$file =~ /^ ((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))* (?: [A-Za-z](?=[^A-Za-z]|$) | \d(?=-) )(?<![._-][vV]) )+)(.*) $/xs or return ($file,undef,undef);if ($dist =~ /-undef\z/ and!length$version){$dist =~ s/-undef\z//}$version =~ s/-withoutworldwriteables$//;if ($version =~ /^(-[Vv].*)-(\d.*)/){$dist .= $1;$version=$2}if ($version =~ /(.+_.*)-(\d.*)/){$dist .= $1;$version=$2}$dist =~ s{\.pm$}{};$version=$1 if!length$version and $dist =~ s/-(\d+\w)$//;$version=$1 .$version if$version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;if ($version =~ /\d\.\d/){$version =~ s/^[-_.]+//}else {$version =~ s/^[-_]+//}my$dev;if (length$version){if ($file =~ /^perl-?\d+\.(\d+)(?:\D(\d+))?(-(?:TRIAL|RC)\d+)?$/){$dev=1 if (($1 > 6 and $1 & 1)or ($2 and $2 >= 50))or $3}elsif ($version =~ /\d\D\d+_\d/ or $version =~ /-TRIAL/){$dev=1}}else {$version=undef}($dist,$version,$dev)}sub new {my$class=shift;my$distfile=shift;$distfile =~ s,//+,/,g;my%info=(pathname=>$distfile);($info{filename}=$distfile)=~ s,^(((.*?/)?authors/)?id/)?([A-Z])/(\4[A-Z])/(\5[-A-Z0-9]*)/,, and $info{cpanid}=$6;if ($distfile =~ m,([^/]+)\.(tar\.(?:g?z|bz2)|zip|tgz)$,i){$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.150005';use Carp qw(carp croak);use CPAN::Meta::Feature;use CPAN::Meta::Prereqs;use CPAN::Meta::Converter;use CPAN::Meta::Validator;use Parse::CPAN::Meta 1.4414 ();BEGIN {*_dclone=\&CPAN::Meta::Converter::_dclone}BEGIN {my@STRING_READERS=qw(abstract description dynamic_config generated_by name release_status version);no strict 'refs';for my$attr (@STRING_READERS){*$attr=sub {$_[0]{$attr }}}}BEGIN {my@LIST_READERS=qw(author keywords license);no strict 'refs';for my$attr (@LIST_READERS){*$attr=sub {my$value=$_[0]{$attr };croak "$attr must be called in list context" unless wantarray;return @{_dclone($value)}if ref$value;return$value}}}sub authors {$_[0]->author}sub licenses {$_[0]->license}BEGIN {my@MAP_READERS=qw(meta-spec resources provides no_index prereqs optional_features);no strict 'refs';for my$attr (@MAP_READERS){(my$subname=$attr)=~ s/-/_/;*$subname=sub {my$value=$_[0]{$attr };return _dclone($value)if$value;return {}}}}sub custom_keys {return grep {/^x_/i}keys %{$_[0]}}sub custom {my ($self,$attr)=@_;my$value=$self->{$attr};return _dclone($value)if ref$value;return$value}sub _new {my ($class,$struct,$options)=@_;my$self;if ($options->{lazy_validation}){my$cmc=CPAN::Meta::Converter->new($struct);$self=$cmc->convert(version=>2);return bless$self,$class}else {my$cmv=CPAN::Meta::Validator->new($struct);unless ($cmv->is_valid){die "Invalid metadata structure. Errors: " .join(", ",$cmv->errors)."\n"}}my$version=$struct->{'meta-spec'}{version}|| '1.0';if ($version==2){$self=$struct}else {my$cmc=CPAN::Meta::Converter->new($struct);$self=$cmc->convert(version=>2)}return bless$self,$class}sub new {my ($class,$struct,$options)=@_;my$self=eval {$class->_new($struct,$options)};croak($@)if $@;return$self}sub create {my ($class,$struct,$options)=@_;my$version=__PACKAGE__->VERSION || 2;$struct->{generated_by}||= __PACKAGE__ ." version $version" ;$struct->{'meta-spec'}{version}||= int($version);my$self=eval {$class->_new($struct,$options)};croak ($@)if $@;return$self}sub load_file {my ($class,$file,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};croak "load_file() requires a valid, readable filename" unless -r $file;my$self;eval {my$struct=Parse::CPAN::Meta->load_file($file);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub load_yaml_string {my ($class,$yaml,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};my$self;eval {my ($struct)=Parse::CPAN::Meta->load_yaml_string($yaml);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub load_json_string {my ($class,$json,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};my$self;eval {my$struct=Parse::CPAN::Meta->load_json_string($json);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub load_string {my ($class,$string,$options)=@_;$options->{lazy_validation}=1 unless exists$options->{lazy_validation};my$self;eval {my$struct=Parse::CPAN::Meta->load_string($string);$self=$class->_new($struct,$options)};croak($@)if $@;return$self}sub save {my ($self,$file,$options)=@_;my$version=$options->{version}|| '2';my$layer=$] ge '5.008001' ? ':utf8' : '';if ($version ge '2'){carp "'$file' should end in '.json'" unless$file =~ m{\.json$}}else {carp "'$file' should end in '.yml'" unless$file =~ m{\.yml$}}my$data=$self->as_string($options);open my$fh,">$layer",$file or die "Error opening '$file' for writing: $!\n";print {$fh}$data;close$fh or die "Error closing '$file': $!\n";return 1}sub meta_spec_version {my ($self)=@_;return$self->meta_spec->{version}}sub effective_prereqs {my ($self,$features)=@_;$features ||= [];my$prereq=CPAN::Meta::Prereqs->new($self->prereqs);return$prereq unless @$features;my@other=map {;$self->feature($_)->prereqs}@$features;return$prereq->with_merged_prereqs(\@other)}sub should_index_file {my ($self,$filename)=@_;for my$no_index_file (@{$self->no_index->{file}|| []}){return if$filename eq $no_index_file}for my$no_index_dir (@{$self->no_index->{directory}}){$no_index_dir =~ s{$}{/} unless$no_index_dir =~ m{/\z};return if index($filename,$no_index_dir)==0}return 1}sub should_index_package {my ($self,$package)=@_;for my$no_index_pkg (@{$self->no_index->{package}|| []}){return if$package eq $no_index_pkg}for my$no_index_ns (@{$self->no_index->{namespace}}){return if index($package,"${no_index_ns}::")==0}return 1}sub features {my ($self)=@_;my$opt_f=$self->optional_features;my@features=map {;CPAN::Meta::Feature->new($_=>$opt_f->{$_ })}keys %$opt_f;return@features}sub feature {my ($self,$ident)=@_;croak "no feature named $ident" unless my$f=$self->optional_features->{$ident };return CPAN::Meta::Feature->new($ident,$f)}sub as_struct {my ($self,$options)=@_;my$struct=_dclone($self);if ($options->{version}){my$cmc=CPAN::Meta::Converter->new($struct);$struct=$cmc->convert(version=>$options->{version})}return$struct}sub as_string {my ($self,$options)=@_;my$version=$options->{version}|| '2';my$struct;if ($self->meta_spec_version ne $version){my$cmc=CPAN::Meta::Converter->new($self->as_struct);$struct=$cmc->convert(version=>$version)}else {$struct=$self->as_struct}my ($data,$backend);if ($version ge '2'){$backend=Parse::CPAN::Meta->json_backend();local$struct->{x_serialization_backend}=sprintf '%s version %s',$backend,$backend->VERSION;$data=$backend->new->pretty->canonical->encode($struct)}else {$backend=Parse::CPAN::Meta->yaml_backend();local$struct->{x_serialization_backend}=sprintf '%s version %s',$backend,$backend->VERSION;$data=eval {no strict 'refs';&{"$backend\::Dump"}($struct)};if ($@){croak$backend->can('errstr')? $backend->errstr : $@}}return$data}sub TO_JSON {return {%{$_[0]}}}1; CPAN_META $fatpacked{"CPAN/Meta/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CHECK'; package CPAN::Meta::Check;$CPAN::Meta::Check::VERSION='0.012';use strict;use warnings;use base 'Exporter';our@EXPORT=qw//;our@EXPORT_OK=qw/check_requirements requirements_for verify_dependencies/;our%EXPORT_TAGS=(all=>[@EXPORT,@EXPORT_OK ]);use CPAN::Meta::Prereqs '2.132830';use CPAN::Meta::Requirements 2.121;use Module::Metadata 1.000023;sub _check_dep {my ($reqs,$module,$dirs)=@_;$module eq 'perl' and return ($reqs->accepts_module($module,$])? (): sprintf "Your Perl (%s) is not in the range '%s'",$],$reqs->requirements_for_module($module));my$metadata=Module::Metadata->new_from_module($module,inc=>$dirs);return "Module '$module' is not installed" if not defined$metadata;my$version=eval {$metadata->version};return "Missing version info for module '$module'" if$reqs->requirements_for_module($module)and not $version;return sprintf 'Installed version (%s) of %s is not in range \'%s\'',$version,$module,$reqs->requirements_for_module($module)if not $reqs->accepts_module($module,$version || 0);return}sub _check_conflict {my ($reqs,$module,$dirs)=@_;my$metadata=Module::Metadata->new_from_module($module,inc=>$dirs);return if not defined$metadata;my$version=eval {$metadata->version};return "Missing version info for module '$module'" if not $version;return sprintf 'Installed version (%s) of %s is in range \'%s\'',$version,$module,$reqs->requirements_for_module($module)if$reqs->accepts_module($module,$version);return}sub requirements_for {my ($meta,$phases,$type)=@_;my$prereqs=ref($meta)eq 'CPAN::Meta' ? $meta->effective_prereqs : $meta;return$prereqs->merged_requirements(ref($phases)? $phases : [$phases ],[$type ])}sub check_requirements {my ($reqs,$type,$dirs)=@_;return +{map {$_=>$type ne 'conflicts' ? scalar _check_dep($reqs,$_,$dirs): scalar _check_conflict($reqs,$_,$dirs)}$reqs->required_modules }}sub verify_dependencies {my ($meta,$phases,$type,$dirs)=@_;my$reqs=requirements_for($meta,$phases,$type);my$issues=check_requirements($reqs,$type,$dirs);return grep {defined}values %{$issues}}1; CPAN_META_CHECK $fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER'; use 5.006;use strict;use warnings;package CPAN::Meta::Converter;our$VERSION='2.150005';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}};sub _dclone {my$ref=shift;no warnings 'once';no warnings 'redefine';local*UNIVERSAL::TO_JSON=sub {"$_[0]"};my$json=Parse::CPAN::Meta->json_backend()->new ->utf8 ->allow_blessed ->convert_blessed;$json->decode($json->encode($ref))}my%known_specs=('2'=>'http://search.cpan.org/perldoc?CPAN::Meta::Spec','1.4'=>'http://module-build.sourceforge.net/META-spec-v1.4.html','1.3'=>'http://module-build.sourceforge.net/META-spec-v1.3.html','1.2'=>'http://module-build.sourceforge.net/META-spec-v1.2.html','1.1'=>'http://module-build.sourceforge.net/META-spec-v1.1.html','1.0'=>'http://module-build.sourceforge.net/META-spec-v1.0.html');my@spec_list=sort {$a <=> $b}keys%known_specs;my ($LOWEST,$HIGHEST)=@spec_list[0,-1];sub _keep {$_[0]}sub _keep_or_one {defined($_[0])? $_[0]: 1}sub _keep_or_zero {defined($_[0])? $_[0]: 0}sub _keep_or_unknown {defined($_[0])&& length($_[0])? $_[0]: "unknown"}sub _generated_by {my$gen=shift;my$sig=__PACKAGE__ ." version " .(__PACKAGE__->VERSION || "<dev>");return$sig unless defined$gen and length$gen;return$gen if$gen =~ /\Q$sig/;return "$gen, $sig"}sub _listify {!defined $_[0]? undef : ref $_[0]eq 'ARRAY' ? $_[0]: [$_[0]]}sub _prefix_custom {my$key=shift;$key =~ s/^(?!x_) # Unless it already starts with x_ (?:x-?)? # Remove leading x- or x (if present) /x_/ix;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 '<undef>');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 '<undef>'){$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.150005';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.150005';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.150005';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 _improvize {my ($left,$right,$path)=@_;my ($name)=reverse @{$path};if ($name =~ /^x_/){if (ref($left)eq 'ARRAY'){return _set_addition($left,$right,$path)}elsif (ref($left)eq 'HASH'){return _uniq_map($left,$right,$path)}else {return _identical($left,$right,$path)}}croak sprintf "Can't merge '%s'",join '.',@{$path}}sub _optional_features {my ($left,$right,$path)=@_;for my$key (keys %{$right}){if (not exists$left->{$key}){$left->{$key}=$right->{$key}}else {for my$subkey (keys %{$right->{$key}}){next if$subkey eq 'prereqs';if (not exists$left->{$key}{$subkey}){$left->{$key}{$subkey}=$right->{$key}{$subkey}}else {Carp::croak "Cannot merge two optional_features named '$key' with different '$subkey' values" if do {no warnings 'uninitialized';$left->{$key}{$subkey}ne $right->{$key}{$subkey}}}}require CPAN::Meta::Prereqs;$left->{$key}{prereqs}=CPAN::Meta::Prereqs->new($left->{$key}{prereqs})->with_merged_prereqs(CPAN::Meta::Prereqs->new($right->{$key}{prereqs}))->as_string_hash}}return$left}my%default=(abstract=>\&_identical,author=>\&_set_addition,dynamic_config=>sub {my ($left,$right)=@_;return$left || $right},generated_by=>sub {my ($left,$right)=@_;return join ', ',_uniq(split(/, /,$left),split(/, /,$right))},license=>\&_set_addition,'meta-spec'=>{version=>\&_identical,url=>\&_identical },name=>\&_identical,release_status=>\&_identical,version=>\&_identical,description=>\&_identical,keywords=>\&_set_addition,no_index=>{map {($_=>\&_set_addition)}qw/file directory package namespace/ },optional_features=>\&_optional_features,prereqs=>sub {require CPAN::Meta::Prereqs;my ($left,$right)=map {CPAN::Meta::Prereqs->new($_)}@_[0,1];return$left->with_merged_prereqs($right)->as_string_hash},provides=>\&_uniq_map,resources=>{license=>\&_set_addition,homepage=>\&_identical,bugtracker=>\&_uniq_map,repository=>\&_uniq_map,':default'=>\&_improvize,},':default'=>\&_improvize,);sub new {my ($class,%arguments)=@_;croak 'default version required' if not exists$arguments{default_version};my%mapping=%default;my%extra=%{$arguments{extra_mappings}|| {}};for my$key (keys%extra){if (ref($mapping{$key})eq 'HASH'){$mapping{$key}={%{$mapping{$key}},%{$extra{$key}}}}else {$mapping{$key}=$extra{$key}}}return bless {default_version=>$arguments{default_version},mapping=>_coerce_mapping(\%mapping,[]),},$class}my%coderef_for=(set_addition=>\&_set_addition,uniq_map=>\&_uniq_map,identical=>\&_identical,improvize=>\&_improvize,);sub _coerce_mapping {my ($orig,$map_path)=@_;my%ret;for my$key (keys %{$orig}){my$value=$orig->{$key};if (ref($orig->{$key})eq 'CODE'){$ret{$key}=$value}elsif (ref($value)eq 'HASH'){my$mapping=_coerce_mapping($value,[@{$map_path},$key ]);$ret{$key}=sub {my ($left,$right,$path)=@_;return _merge($left,$right,$mapping,[@{$path}])}}elsif ($coderef_for{$value}){$ret{$key}=$coderef_for{$value}}else {croak "Don't know what to do with " .join '.',@{$map_path},$key}}return \%ret}sub merge {my ($self,@items)=@_;my$current={};for my$next (@items){if (blessed($next)&& $next->isa('CPAN::Meta')){$next=$next->as_struct}elsif (ref($next)eq 'HASH'){my$cmc=CPAN::Meta::Converter->new($next,default_version=>$self->{default_version});$next=$cmc->upgrade_fragment}else {croak "Don't know how to merge '$next'"}$current=_merge($current,$next,$self->{mapping},[])}return$current}1; 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.150005';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 with_merged_prereqs {my ($self,$other)=@_;my@other=blessed($other)? $other : @$other;my@prereq_objs=($self,@other);my%new_arg;for my$phase ($self->__legal_phases){for my$type ($self->__legal_types){my$req=CPAN::Meta::Requirements->new;for my$prereq (@prereq_objs){my$this_req=$prereq->requirements_for($phase,$type);next unless$this_req->required_modules;$req->add_requirements($this_req)}next unless$req->required_modules;$new_arg{$phase }{$type }=$req->as_string_hash}}return (ref$self)->new(\%new_arg)}sub 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->__legal_phases){for my$type ($self->__legal_types){my$req=$self->requirements_for($phase,$type);next unless$req->required_modules;$hash{$phase }{$type }=$req->as_string_hash}}return \%hash}sub is_finalized {$_[0]{finalized}}sub finalize {my ($self)=@_;$self->{finalized}=1;for my$phase (keys %{$self->{prereqs}}){$_->finalize for values %{$self->{prereqs}{$phase}}}}sub clone {my ($self)=@_;my$clone=(ref$self)->new($self->as_string_hash)}1; CPAN_META_PREREQS $fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS'; use strict;use warnings;package CPAN::Meta::Requirements;our$VERSION='2.133';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' || _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}eval {local$SIG{__WARN__}=sub {die "Invalid version: $_[0]"};$vobj=version->new($version)};if (my$err=$@){my$hook=$self->{bad_version_hook};$vobj=eval {$hook->($version,$module)}if ref$hook eq 'CODE';unless (eval {$vobj->isa("version")}){$err =~ s{ at .* line \d+.*$}{};die "Can't convert '$version': $err"}}}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)}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 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);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_modifiers {return [[exact_version=>$_[0]{version}]]}sub _clone {(ref $_[0])->_new(version->new($_[0]{version}))}sub with_exact_version {my ($self,$version)=@_;return$self->_clone if$self->_accepts($version);Carp::confess("illegal requirements: unequal exact version specified")}sub with_minimum {my ($self,$minimum)=@_;return$self->_clone if$self->{version}>= $minimum;Carp::confess("illegal requirements: minimum above exact specification")}sub with_maximum {my ($self,$maximum)=@_;return$self->_clone if$self->{version}<= $maximum;Carp::confess("illegal requirements: maximum below exact specification")}sub with_exclusion {my ($self,$exclusion)=@_;return$self->_clone unless$exclusion==$self->{version};Carp::confess("illegal requirements: excluded exact specification")}}{package CPAN::Meta::Requirements::_Range::Range;sub _self {ref($_[0])? $_[0]: (bless {}=>$_[0])}sub _clone {return (bless {}=>$_[0])unless ref $_[0];my ($s)=@_;my%guts=((exists$s->{minimum}? (minimum=>version->new($s->{minimum})): ()),(exists$s->{maximum}? (maximum=>version->new($s->{maximum})): ()),(exists$s->{exclusions}? (exclusions=>[map {version->new($_)}@{$s->{exclusions}}]): ()),);bless \%guts=>ref($s)}sub as_modifiers {my ($self)=@_;my@mods;push@mods,[add_minimum=>$self->{minimum}]if exists$self->{minimum};push@mods,[add_maximum=>$self->{maximum}]if exists$self->{maximum};push@mods,map {;[add_exclusion=>$_ ]}@{$self->{exclusions}|| []};return \@mods}sub as_string {my ($self)=@_;return 0 if!keys %$self;return "$self->{minimum}" if (keys %$self)==1 and exists$self->{minimum};my@exclusions=@{$self->{exclusions}|| []};my@parts;for my$pair ([qw(>= > minimum) ],[qw(<= < maximum) ],){my ($op,$e_op,$k)=@$pair;if (exists$self->{$k}){my@new_exclusions=grep {$_!=$self->{$k }}@exclusions;if (@new_exclusions==@exclusions){push@parts,"$op $self->{ $k }"}else {push@parts,"$e_op $self->{ $k }";@exclusions=@new_exclusions}}}push@parts,map {;"!= $_"}@exclusions;return join q{, },@parts}sub with_exact_version {my ($self,$version)=@_;$self=$self->_clone;Carp::confess("illegal requirements: exact specification outside of range")unless$self->_accepts($version);return CPAN::Meta::Requirements::_Range::Exact->_new($version)}sub _simplify {my ($self)=@_;if (defined$self->{minimum}and defined$self->{maximum}){if ($self->{minimum}==$self->{maximum}){Carp::confess("illegal requirements: excluded all values")if grep {$_==$self->{minimum}}@{$self->{exclusions}|| []};return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum})}Carp::confess("illegal requirements: minimum exceeds maximum")if$self->{minimum}> $self->{maximum}}if ($self->{exclusions}){my%seen;@{$self->{exclusions}}=grep {(!defined$self->{minimum}or $_ >= $self->{minimum})and (!defined$self->{maximum}or $_ <= $self->{maximum})and !$seen{$_}++}@{$self->{exclusions}}}return$self}sub with_minimum {my ($self,$minimum)=@_;$self=$self->_clone;if (defined (my$old_min=$self->{minimum})){$self->{minimum}=(sort {$b cmp $a}($minimum,$old_min))[0]}else {$self->{minimum}=$minimum}return$self->_simplify}sub with_maximum {my ($self,$maximum)=@_;$self=$self->_clone;if (defined (my$old_max=$self->{maximum})){$self->{maximum}=(sort {$a cmp $b}($maximum,$old_max))[0]}else {$self->{maximum}=$maximum}return$self->_simplify}sub with_exclusion {my ($self,$exclusion)=@_;$self=$self->_clone;push @{$self->{exclusions}||= []},$exclusion;return$self->_simplify}sub _accepts {my ($self,$version)=@_;return if defined$self->{minimum}and $version < $self->{minimum};return if defined$self->{maximum}and $version > $self->{maximum};return if defined$self->{exclusions}and grep {$version==$_}@{$self->{exclusions}};return 1}}1; 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.150005';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.150005';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 || "<undef>";if(defined$spec->{value}){$spec->{value}->($self,'list',$value)}elsif(defined$spec->{'map'}){$self->check_map($spec->{'map'},$value)}elsif(defined$spec->{'list'}){$self->check_list($spec->{'list'},$value)}elsif ($spec->{':key'}){$self->check_map($spec,$value)}else {$self->_error("$spec_error associated with '$self->{stack}[-2]'")}pop @{$self->{stack}}}}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='<undef>' unless(defined$value);$self->_error("'$value' for '$key' is not a valid version.");return 0}sub version {my ($self,$key,$value)=@_;if(defined$value){return 0 unless($value || $value =~ /0/);return 1 if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/)}else {$value='<undef>'}$self->_error("'$value' for '$key' is not a valid version.");return 0}sub boolean {my ($self,$key,$value)=@_;if(defined$value){return 1 if($value =~ /^(0|1|true|false)$/)}else {$value='<undef>'}$self->_error("'$value' for '$key' is not a boolean value.");return 0}my%v1_licenses=('perl'=>'http://dev.perl.org/licenses/','gpl'=>'http://www.opensource.org/licenses/gpl-license.php','apache'=>'http://apache.org/licenses/LICENSE-2.0','artistic'=>'http://opensource.org/licenses/artistic-license.php','artistic_2'=>'http://opensource.org/licenses/artistic-license-2.0.php','lgpl'=>'http://www.opensource.org/licenses/lgpl-license.php','bsd'=>'http://www.opensource.org/licenses/bsd-license.php','gpl'=>'http://www.opensource.org/licenses/gpl-license.php','mit'=>'http://opensource.org/licenses/mit-license.php','mozilla'=>'http://opensource.org/licenses/mozilla1.1.php','open_source'=>undef,'unrestricted'=>undef,'restrictive'=>undef,'unknown'=>undef,);my%v2_licenses=map {$_=>1}qw(agpl_3 apache_1_1 apache_2_0 artistic_1 artistic_2 bsd freebsd gfdl_1_2 gfdl_1_3 gpl_1 gpl_2 gpl_3 lgpl_2_1 lgpl_3_0 mit mozilla_1_0 mozilla_1_1 openssl perl_5 qpl_1_0 ssleay sun zlib open_source restricted unrestricted unknown);sub license {my ($self,$key,$value)=@_;my$licenses=$self->{spec}< 2 ? \%v1_licenses : \%v2_licenses;if(defined$value){return 1 if($value && exists$licenses->{$value})}else {$value='<undef>'}$self->_error("License '$value' is invalid");return 0}sub custom_1 {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/)}else {$key='<undef>'}$self->_error("Custom resource '$key' must be in CamelCase.");return 0}sub custom_2 {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^x_/i)}else {$key='<undef>'}$self->_error("Custom key '$key' must begin with 'x_' or 'X_'.");return 0}sub identifier {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^([a-z][_a-z]+)$/i)}else {$key='<undef>'}$self->_error("Key '$key' is not a legal identifier.");return 0}sub module {my ($self,$key)=@_;if(defined$key){return 1 if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/)}else {$key='<undef>'}$self->_error("Key '$key' is not a legal module name.");return 0}my@valid_phases=qw/configure build test runtime develop/;sub phase {my ($self,$key)=@_;if(defined$key){return 1 if(length$key && grep {$key eq $_}@valid_phases);return 1 if$key =~ /x_/i}else {$key='<undef>'}$self->_error("Key '$key' is not a legal phase.");return 0}my@valid_relations=qw/requires recommends suggests conflicts/;sub relation {my ($self,$key)=@_;if(defined$key){return 1 if(length$key && grep {$key eq $_}@valid_relations);return 1 if$key =~ /x_/i}else {$key='<undef>'}$self->_error("Key '$key' is not a legal prereq relationship.");return 0}sub _error {my$self=shift;my$mess=shift;$mess .= ' ('.join(' -> ',@{$self->{stack}}).')' if($self->{stack});$mess .= " [Validation: $self->{spec}]";push @{$self->{errors}},$mess}1; 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.016';;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{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER'; package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||=0;our$VERSION='5.70';our (%Cache);sub as_heavy {require Exporter::Heavy;my$c=(caller(1))[3];$c =~ s/.*:://;\&{"Exporter::Heavy::heavy_$c"}}sub export {goto &{as_heavy()}}sub import {my$pkg=shift;my$callpkg=caller($ExportLevel);if ($pkg eq "Exporter" and @_ and $_[0]eq "import"){*{$callpkg."::import"}=\&import;return}my$exports=\@{"$pkg\::EXPORT"};my$fail=${$pkg .'::'}{EXPORT_FAIL}&& \@{"$pkg\::EXPORT_FAIL"};return export$pkg,$callpkg,@_ if$Verbose or $Debug or $fail && @$fail > 1;my$export_cache=($Cache{$pkg}||={});my$args=@_ or @_=@$exports;if ($args and not %$export_cache){s/^&//,$export_cache->{$_}=1 foreach (@$exports,@{"$pkg\::EXPORT_OK"})}my$heavy;if ($args or $fail){($heavy=(/\W/ or $args and not exists$export_cache->{$_}or $fail and @$fail and $_ eq $fail->[0]))and last foreach (@_)}else {($heavy=/\W/)and last foreach (@_)}return export$pkg,$callpkg,($args ? @_ : ())if$heavy;local$SIG{__WARN__}=sub {require Carp;&Carp::carp}if not $SIG{__WARN__};*{"$callpkg\::$_"}=\&{"$pkg\::$_"}foreach @_}sub export_fail {my$self=shift;@_}sub export_to_level {goto &{as_heavy()}}sub export_tags {goto &{as_heavy()}}sub export_ok_tags {goto &{as_heavy()}}sub require_version {goto &{as_heavy()}}1; EXPORTER $fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY'; package Exporter::Heavy;use strict;no strict 'refs';require Exporter;our$VERSION=$Exporter::VERSION;sub _rebuild_cache {my ($pkg,$exports,$cache)=@_;s/^&// foreach @$exports;@{$cache}{@$exports}=(1)x @$exports;my$ok=\@{"${pkg}::EXPORT_OK"};if (@$ok){s/^&// foreach @$ok;@{$cache}{@$ok}=(1)x @$ok}}sub heavy_export {my$oldwarn=$SIG{__WARN__};local$SIG{__WARN__}=sub {local$SIG{__WARN__}=$oldwarn;my$text=shift;if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//){require Carp;local$Carp::CarpLevel=1;Carp::carp($text)}else {warn$text}};local$SIG{__DIE__}=sub {require Carp;local$Carp::CarpLevel=1;Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")if $_[0]=~ /^Unable to create sub named "(.*?)::"/};my($pkg,$callpkg,@imports)=@_;my($type,$sym,$cache_is_current,$oops);my($exports,$export_cache)=(\@{"${pkg}::EXPORT"},$Exporter::Cache{$pkg}||={});if (@imports){if (!%$export_cache){_rebuild_cache ($pkg,$exports,$export_cache);$cache_is_current=1}if (grep m{^[/!:]},@imports){my$tagsref=\%{"${pkg}::EXPORT_TAGS"};my$tagdata;my%imports;my($remove,$spec,@names,@allexports);unshift@imports,':DEFAULT' if$imports[0]=~ m/^!/;for$spec (@imports){$remove=$spec =~ s/^!//;if ($spec =~ s/^://){if ($spec eq 'DEFAULT'){@names=@$exports}elsif ($tagdata=$tagsref->{$spec}){@names=@$tagdata}else {warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];++$oops;next}}elsif ($spec =~ m:^/(.*)/$:){my$patn=$1;@allexports=keys %$export_cache unless@allexports;@names=grep(/$patn/,@allexports)}else {@names=($spec)}warn "Import ".($remove ? "del":"add").": @names " if$Exporter::Verbose;if ($remove){for$sym (@names){delete$imports{$sym}}}else {@imports{@names}=(1)x @names}}@imports=keys%imports}my@carp;for$sym (@imports){if (!$export_cache->{$sym}){if ($sym =~ m/^\d/){$pkg->VERSION($sym);if (@imports==1){@imports=@$exports;last}if (@imports==2 and!$imports[1]){@imports=();last}}elsif ($sym !~ s/^&// ||!$export_cache->{$sym}){unless ($cache_is_current){%$export_cache=();_rebuild_cache ($pkg,$exports,$export_cache);$cache_is_current=1}if (!$export_cache->{$sym}){push@carp,qq["$sym" is not exported by the $pkg module\n];$oops++}}}}if ($oops){require Carp;Carp::croak("@{carp}Can't continue after import errors")}}else {@imports=@$exports}my($fail,$fail_cache)=(\@{"${pkg}::EXPORT_FAIL"},$Exporter::FailCache{$pkg}||={});if (@$fail){if (!%$fail_cache){my@expanded=map {/^\w/ ? ($_,'&'.$_): $_}@$fail;warn "${pkg}::EXPORT_FAIL cached: @expanded" if$Exporter::Verbose;@{$fail_cache}{@expanded}=(1)x @expanded}my@failed;for$sym (@imports){push(@failed,$sym)if$fail_cache->{$sym}}if (@failed){@failed=$pkg->export_fail(@failed);for$sym (@failed){require Carp;Carp::carp(qq["$sym" is not implemented by the $pkg module ],"on this architecture")}if (@failed){require Carp;Carp::croak("Can't continue after import errors")}}}warn "Importing into $callpkg from $pkg: ",join(", ",sort@imports)if$Exporter::Verbose;for$sym (@imports){(*{"${callpkg}::$sym"}=\&{"${pkg}::$sym"},next)unless$sym =~ s/^(\W)//;$type=$1;no warnings 'once';*{"${callpkg}::$sym"}=$type eq '&' ? \&{"${pkg}::$sym"}: $type eq '$' ? \${"${pkg}::$sym"}: $type eq '@' ? \@{"${pkg}::$sym"}: $type eq '%' ? \%{"${pkg}::$sym"}: $type eq '*' ? *{"${pkg}::$sym"}: do {require Carp;Carp::croak("Can't export symbol: $type$sym")}}}sub heavy_export_to_level {my$pkg=shift;my$level=shift;(undef)=shift;my$callpkg=caller($level);$pkg->export($callpkg,@_)}sub _push_tags {my($pkg,$var,$syms)=@_;my@nontag=();my$export_tags=\%{"${pkg}::EXPORT_TAGS"};push(@{"${pkg}::$var"},map {$export_tags->{$_}? @{$export_tags->{$_}}: scalar(push(@nontag,$_),$_)}(@$syms)? @$syms : keys %$export_tags);if (@nontag and $^W){require Carp;Carp::carp(join(", ",@nontag)." are not tags of $pkg")}}sub heavy_require_version {my($self,$wanted)=@_;my$pkg=ref$self || $self;return ${pkg}->VERSION($wanted)}sub heavy_export_tags {_push_tags((caller)[0],"EXPORT",\@_)}sub heavy_export_ok_tags {_push_tags((caller)[0],"EXPORT_OK",\@_)}1; EXPORTER_HEAVY $fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD'; use strict;use warnings;package File::pushd;our$VERSION='1.009';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 {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 {my ($options)=@_;my$dir;eval {$dir=pushd(File::Temp::tempdir(CLEANUP=>0),$options)};croak $@ if $@;$dir->{_tempd}=1;return$dir}sub preserve {my$self=shift;return 1 if!$self->{"_tempd"};if (@_==0){return$self->{_preserve}=1}else {return$self->{_preserve}=$_[0]? 1 : 0}}sub DESTROY {my ($self)=@_;my$orig=$self->{_original};chdir$orig if$orig;if ($self->{_tempd}&&!$self->{_preserve}){my$err=do {local $@;eval {rmtree($self->{_pushd})};$@};carp$err if$err}}1; FILE_PUSHD $fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY'; package HTTP::Tiny;use strict;use warnings;our$VERSION='0.056';use Carp ();my@attributes;BEGIN {@attributes=qw(cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy timeout 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 new {my($class,%args)=@_;my$self={max_redirect=>5,timeout=>60,keep_alive=>1,verify_SSL=>$args{verify_SSL}|| $args{verify_ssl}|| 0,no_proxy=>$ENV{no_proxy},};bless$self,$class;$class->_validate_cookie_jar($args{cookie_jar})if$args{cookie_jar};for my$key (@attributes){$self->{$key}=$args{$key}if exists$args{$key}}$self->agent(exists$args{agent}? $args{agent}: $class->_agent);$self->_set_proxies;return$self}sub _set_proxies {my ($self)=@_;if (!exists$self->{proxy}){$self->{proxy}=$ENV{all_proxy}|| $ENV{ALL_PROXY}}if (defined$self->{proxy}){$self->_split_proxy('generic proxy'=>$self->{proxy})}else {delete$self->{proxy}}if (!exists$self->{http_proxy}){local$ENV{HTTP_PROXY}if$ENV{REQUEST_METHOD};$self->{http_proxy}=$ENV{http_proxy}|| $ENV{HTTP_PROXY}|| $self->{proxy}}if (defined$self->{http_proxy}){$self->_split_proxy(http_proxy=>$self->{http_proxy});$self->{_has_proxy}{http}=1}else {delete$self->{http_proxy}}if (!exists$self->{https_proxy}){$self->{https_proxy}=$ENV{https_proxy}|| $ENV{HTTPS_PROXY}|| $self->{proxy}}if ($self->{https_proxy}){$self->_split_proxy(https_proxy=>$self->{https_proxy});$self->{_has_proxy}{https}=1}else {delete$self->{https_proxy}}unless (ref$self->{no_proxy}eq 'ARRAY'){$self->{no_proxy}=(defined$self->{no_proxy})? [split /\s*,\s*/,$self->{no_proxy}]: []}return}for my$sub_name (qw/get head put post delete/){my$req_method=uc$sub_name;no strict 'refs';eval <<"HERE"}sub post_form {my ($self,$url,$data,$args)=@_;(@_==3 || @_==4 && ref$args eq 'HASH')or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ ."\n");my$headers={};while (my ($key,$value)=each %{$args->{headers}|| {}}){$headers->{lc$key}=$value}delete$args->{headers};return$self->request('POST',$url,{%$args,content=>$self->www_form_urlencode($data),headers=>{%$headers,'content-type'=>'application/x-www-form-urlencoded' },})}sub mirror {my ($self,$url,$file,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ ."\n");if (-e $file and my$mtime=(stat($file))[9]){$args->{headers}{'if-modified-since'}||= $self->_http_date($mtime)}my$tempfile=$file .int(rand(2**31));require Fcntl;sysopen my$fh,$tempfile,Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()or Carp::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 Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);if ($response->{success}){rename$tempfile,$file or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);my$lm=$response->{headers}{'last-modified'};if ($lm and my$mtime=$self->_parse_http_date($lm)){utime$mtime,$mtime,$file}}$response->{success}||= $response->{status}eq '304';unlink$tempfile;return$response}my%idempotent=map {$_=>1}qw/GET HEAD PUT DELETE OPTIONS TRACE/;sub request {my ($self,$method,$url,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ ."\n");$args ||= {};my$response;for (0 .. 1){$response=eval {$self->_request($method,$url,$args)};last unless $@ && $idempotent{$method}&& $@ =~ m{^(?:Socket closed|Unexpected end)}}if (my$e=$@){if (ref$e eq 'HASH' && exists$e->{status}){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,}}}return$response}sub www_form_urlencode {my ($self,$data)=@_;(@_==2 && ref$data)or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ ."\n");(ref$data eq 'HASH' || ref$data eq 'ARRAY')or Carp::croak("form data must be a hash or array reference\n");my@params=ref$data eq 'HASH' ? %$data : @$data;@params % 2==0 or Carp::croak("form data reference must have an even number of terms\n");my@terms;while(@params){my ($key,$value)=splice(@params,0,2);if (ref$value eq 'ARRAY'){unshift@params,map {$key=>$_}@$value}else {push@terms,join("=",map {$self->_uri_escape($_)}$key,$value)}}return join("&",(ref$data eq 'ARRAY')? (@terms): (sort@terms))}sub can_ssl {my ($self)=@_;my($ok,$reason)=(1,'');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}my%DefaultPort=(http=>80,https=>443,);sub _agent {my$class=ref($_[0])|| $_[0];(my$default_agent=$class)=~ s{::}{-}g;return$default_agent ."/" .$class->VERSION}sub _request {my ($self,$method,$url,$args)=@_;my ($scheme,$host,$port,$path_query,$auth)=$self->_split_url($url);my$request={method=>$method,scheme=>$scheme,host=>$host,port=>$port,host_port=>($port==$DefaultPort{$scheme}? $host : "$host:$port"),uri=>$path_query,headers=>{},};my$handle=delete$self->{handle};if ($handle){unless ($handle->can_reuse($scheme,$host,$port)){$handle->close;undef$handle}}$handle ||= $self->_open_handle($request,$scheme,$host,$port);$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};if (my@redir_args=$self->_maybe_redirect($request,$response,$args)){$handle->close;return$self->_request(@redir_args,$args)}my$known_message_length;if ($method eq 'HEAD' || $response->{status}=~ /^[23]04/){$known_message_length=1}else {my$data_cb=$self->_prepare_data_cb($response,$args);$known_message_length=$handle->read_body($data_cb,$response)}if ($self->{keep_alive}&& $known_message_length && $response->{protocol}eq 'HTTP/1.1' && ($response->{headers}{connection}|| '')ne 'close'){$self->{handle}=$handle}else {$handle->close}$response->{success}=substr($response->{status},0,1)eq '2';$response->{url}=$url;return$response}sub _open_handle {my ($self,$request,$scheme,$host,$port)=@_;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)}}sub _proxy_connect {my ($self,$request,$handle)=@_;my@proxy_vars;if ($request->{scheme}eq 'https'){Carp::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'){Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}})}}else {Carp::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);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 '/'){Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n})}return ($scheme,$host,$port,$auth)}sub _create_proxy_tunnel {my ($self,$request,$handle)=@_;$handle->_assert_ssl;my$agent=exists($request->{headers}{'user-agent'})? $request->{headers}{'user-agent'}: $self->{agent};my$connect_request={method=>'CONNECT',uri=>"$request->{host}:$request->{port}",headers=>{host=>"$request->{host}:$request->{port}",'user-agent'=>$agent,}};if ($request->{headers}{'proxy-authorization'}){$connect_request->{headers}{'proxy-authorization'}=delete$request->{headers}{'proxy-authorization'}}$handle->write_request($connect_request);my$response;do {$response=$handle->read_response_header}until (substr($response->{status},0,1)ne '1');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}}if (exists$request->{headers}{'host'}){die(qq/The 'Host' header must not be provided as header option\n/)}$request->{headers}{'host'}=$request->{host_port};$request->{headers}{'user-agent'}||= $self->{agent};$request->{headers}{'connection'}="close" unless$self->{keep_alive};if (defined$args->{content}){if (ref$args->{content}eq 'CODE'){$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'transfer-encoding'}='chunked' unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=$args->{content}}elsif (length$args->{content}){my$content=$args->{content};if ($] ge '5.008'){utf8::downgrade($content,1)or die(qq/Wide character in request message body\n/)}$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'content-length'}=length$content unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=sub {substr$content,0,length$content,''}}$request->{trailer_cb}=$args->{trailer_callback}if ref$args->{trailer_callback}eq 'CODE'}if ($self->{cookie_jar}){my$cookies=$self->cookie_jar->cookie_header($url);$request->{headers}{cookie}=$cookies if length$cookies}if (length$auth &&!defined$request->{headers}{authorization}){$self->_add_basic_auth_header($request,'authorization'=>$auth)}return}sub _add_basic_auth_header {my ($self,$request,$header,$auth)=@_;require MIME::Base64;$request->{headers}{$header}="Basic " .MIME::Base64::encode_base64($auth,"");return}sub _prepare_data_cb {my ($self,$response,$args)=@_;my$data_cb=$args->{data_callback};$response->{content}='';if (!$data_cb || $response->{status}!~ /^2/){if (defined$self->{max_size}){$data_cb=sub {$_[1]->{content}.= $_[0];die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)if length $_[1]->{content}> $self->{max_size}}}else {$data_cb=sub {$_[1]->{content}.= $_[0]}}}return$data_cb}sub _update_cookie_jar {my ($self,$url,$response)=@_;my$cookies=$response->{headers}->{'set-cookie'};return unless defined$cookies;my@cookies=ref$cookies ? @$cookies : $cookies;$self->cookie_jar->add($url,$_)for@cookies;return}sub _validate_cookie_jar {my ($class,$jar)=@_;for my$method (qw/add cookie_header/){Carp::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});if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))and $headers->{location}and ++$args->{redirects}<= $self->{max_redirect}){my$location=($headers->{location}=~ /^\//)? "$request->{scheme}://$request->{host_port}$headers->{location}" : $headers->{location};return (($status eq '303' ? 'GET' : $method),$location)}return}sub _split_url {my$url=pop;my ($scheme,$host,$path_query)=$url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> or die(qq/Cannot parse URL: '$url'\n/);$scheme=lc$scheme;$path_query="/$path_query" unless$path_query =~ m<\A/>;my$auth='';if ((my$i=index$host,'@')!=-1){$auth=substr$host,0,$i,'';substr$host,0,1,'';$auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg}my$port=$host =~ s/:(\d*)\z// && length $1 ? $1 : $scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef;return ($scheme,(length$host ? lc$host : "localhost"),$port,$path_query,$auth)}my$DoW="Sun|Mon|Tue|Wed|Thu|Fri|Sat";my$MoY="Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";sub _http_date {my ($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime($_[1]);return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",substr($DoW,$wday*4,3),$mday,substr($MoY,$mon*4,3),$year+1900,$hour,$min,$sec)}sub _parse_http_date {my ($self,$str)=@_;require Time::Local;my@tl_parts;if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/){@tl_parts=($5,$4,$3,$2,(index($MoY,$1)/4),$6)}return eval {my$t=@tl_parts ? Time::Local::timegm(@tl_parts): -1;$t < 0 ? undef : $t}}my%escapes=map {chr($_)=>sprintf("%%%02X",$_)}0..255;$escapes{' '}="+";my$unsafe_char=qr/[^A-Za-z0-9\-\._~]/;sub _uri_escape {my ($self,$str)=@_;if ($] ge '5.008'){utf8::encode($str)}else {$str=pack("U*",unpack("C*",$str))if (length$str==do {use bytes;length$str});$str=pack("C*",unpack("C*",$str))}$str =~ s/($unsafe_char)/$escapes{$1}/ge;return$str}package HTTP::Tiny::Handle;use strict;use warnings;use Errno qw[EINTR EPIPE];use IO::Socket qw[SOCK_STREAM];my$SOCKET_CLASS=$ENV{PERL_HTTP_TINY_IPV4_ONLY}? 'IO::Socket::INET' : eval {require IO::Socket::IP;IO::Socket::IP->VERSION(0.25)}? 'IO::Socket::IP' : 'IO::Socket::INET';sub BUFSIZE () {32768}my$Printable=sub {local $_=shift;s/\r/\\r/g;s/\n/\\n/g;s/\t/\\t/g;s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;$_};my$Token=qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;sub new {my ($class,%args)=@_;return bless {rbuf=>'',timeout=>60,max_line_size=>16384,max_header_lines=>64,verify_SSL=>0,SSL_options=>{},%args },$class}sub connect {@_==4 || die(q/Usage: $handle->connect(scheme, host, port)/ ."\n");my ($self,$scheme,$host,$port)=@_;if ($scheme eq 'https'){$self->_assert_ssl}elsif ($scheme ne 'http'){die(qq/Unsupported URL scheme '$scheme'\n/)}$self->{fh}=$SOCKET_CLASS->new(PeerHost=>$host,PeerPort=>$port,$self->{local_address}? (LocalAddr=>$self->{local_address}): (),Proto=>'tcp',Type=>SOCK_STREAM,Timeout=>$self->{timeout},KeepAlive=>!!$self->{keep_alive})or die(qq/Could not connect to '$host:$port': $@\n/);binmode($self->{fh})or die(qq/Could not binmode() socket: '$!'\n/);$self->start_ssl($host)if$scheme eq 'https';$self->{scheme}=$scheme;$self->{host}=$host;$self->{port}=$port;$self->{pid}=$$;$self->{tid}=_get_tid();return$self}sub start_ssl {my ($self,$host)=@_;if (ref($self->{fh})eq 'IO::Socket::SSL'){unless ($self->{fh}->stop_SSL){my$ssl_err=IO::Socket::SSL->errstr;die(qq/Error halting prior SSL connection: $ssl_err/)}}my$ssl_args=$self->_ssl_args($host);IO::Socket::SSL->start_SSL($self->{fh},%$ssl_args,SSL_create_ctx_callback=>sub {my$ctx=shift;Net::SSLeay::CTX_set_mode($ctx,Net::SSLeay::MODE_AUTO_RETRY())},);unless (ref($self->{fh})eq 'IO::Socket::SSL'){my$ssl_err=IO::Socket::SSL->errstr;die(qq/SSL connection failed for $host: $ssl_err\n/)}}sub close {@_==1 || die(q/Usage: $handle->close()/ ."\n");my ($self)=@_;CORE::close($self->{fh})or die(qq/Could not close socket: '$!'\n/)}sub write {@_==2 || die(q/Usage: $handle->write(buf)/ ."\n");my ($self,$buf)=@_;if ($] ge '5.008'){utf8::downgrade($buf,1)or die(qq/Wide character in write()\n/)}my$len=length$buf;my$off=0;local$SIG{PIPE}='IGNORE';while (){$self->can_write or die(qq/Timed out while waiting for socket to become ready for writing\n/);my$r=syswrite($self->{fh},$buf,$len,$off);if (defined$r){$len -= $r;$off += $r;last unless$len > 0}elsif ($!==EPIPE){die(qq/Socket closed by remote server: $!\n/)}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not write to SSL socket: '$err'\n /)}else {die(qq/Could not write to socket: '$!'\n/)}}}return$off}sub read {@_==2 || @_==3 || die(q/Usage: $handle->read(len [, allow_partial])/ ."\n");my ($self,$len,$allow_partial)=@_;my$buf='';my$got=length$self->{rbuf};if ($got){my$take=($got < $len)? $got : $len;$buf=substr($self->{rbuf},0,$take,'');$len -= $take}while ($len > 0){$self->can_read or die(q/Timed out while waiting for socket to become ready for reading/ ."\n");my$r=sysread($self->{fh},$buf,$len,length$buf);if (defined$r){last unless$r;$len -= $r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}if ($len &&!$allow_partial){die(qq/Unexpected end of stream\n/)}return$buf}sub readline {@_==1 || die(q/Usage: $handle->readline()/ ."\n");my ($self)=@_;while (){if ($self->{rbuf}=~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x){return $1}if (length$self->{rbuf}>= $self->{max_line_size}){die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/)}$self->can_read or die(qq/Timed out while waiting for socket to become ready for reading\n/);my$r=sysread($self->{fh},$self->{rbuf},BUFSIZE,length$self->{rbuf});if (defined$r){last unless$r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}die(qq/Unexpected end of stream while looking for line\n/)}sub read_header_lines {@_==1 || @_==2 || die(q/Usage: $handle->read_header_lines([headers])/ ."\n");my ($self,$headers)=@_;$headers ||= {};my$lines=0;my$val;while (){my$line=$self->readline;if (++$lines >= $self->{max_header_lines}){die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/)}elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x){my ($field_name)=lc $1;if (exists$headers->{$field_name}){for ($headers->{$field_name}){$_=[$_]unless ref $_ eq "ARRAY";push @$_,$2;$val=\$_->[-1]}}else {$val=\($headers->{$field_name}=$2)}}elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x){$val or die(qq/Unexpected header continuation line\n/);next unless length $1;$$val .= ' ' if length $$val;$$val .= $1}elsif ($line =~ /\A \x0D?\x0A \z/x){last}else {die(q/Malformed header line: / .$Printable->($line)."\n")}}return$headers}sub write_request {@_==2 || die(q/Usage: $handle->write_request(request)/ ."\n");my($self,$request)=@_;$self->write_request_header(@{$request}{qw/method uri headers/});$self->write_body($request)if$request->{cb};return}my%HeaderCase=('content-md5'=>'Content-MD5','etag'=>'ETag','te'=>'TE','www-authenticate'=>'WWW-Authenticate','x-xss-protection'=>'X-XSS-Protection',);sub write_header_lines {(@_==2 || @_==3 && ref $_[1]eq 'HASH')|| die(q/Usage: $handle->write_header_lines(headers[,prefix])/ ."\n");my($self,$headers,$prefix_data)=@_;my$buf=(defined$prefix_data ? $prefix_data : '');while (my ($k,$v)=each %$headers){my$field_name=lc$k;if (exists$HeaderCase{$field_name}){$field_name=$HeaderCase{$field_name}}else {$field_name =~ /\A $Token+ \z/xo or die(q/Invalid HTTP header field name: / .$Printable->($field_name)."\n");$field_name =~ s/\b(\w)/\u$1/g;$HeaderCase{lc$field_name}=$field_name}for (ref$v eq 'ARRAY' ? @$v : $v){$_='' unless defined $_;$buf .= "$field_name: $_\x0D\x0A"}}$buf .= "\x0D\x0A";return$self->write($buf)}sub read_body {@_==3 || die(q/Usage: $handle->read_body(callback, response)/ ."\n");my ($self,$cb,$response)=@_;my$te=$response->{headers}{'transfer-encoding'}|| '';my$chunked=grep {/chunked/i}(ref$te eq 'ARRAY' ? @$te : $te);return$chunked ? $self->read_chunked_body($cb,$response): $self->read_content_body($cb,$response)}sub write_body {@_==2 || die(q/Usage: $handle->write_body(request)/ ."\n");my ($self,$request)=@_;if ($request->{headers}{'content-length'}){return$self->write_content_body($request)}else {return$self->write_chunked_body($request)}}sub read_content_body {@_==3 || @_==4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ ."\n");my ($self,$cb,$response,$content_length)=@_;$content_length ||= $response->{headers}{'content-length'};if (defined$content_length){my$len=$content_length;while ($len > 0){my$read=($len > BUFSIZE)? BUFSIZE : $len;$cb->($self->read($read,0),$response);$len -= $read}return length($self->{rbuf})==0}my$chunk;$cb->($chunk,$response)while length($chunk=$self->read(BUFSIZE,1));return}sub write_content_body {@_==2 || die(q/Usage: $handle->write_content_body(request)/ ."\n");my ($self,$request)=@_;my ($len,$content_length)=(0,$request->{headers}{'content-length'});while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_content()\n/)}$len += $self->write($data)}$len==$content_length or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);return$len}sub read_chunked_body {@_==3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ ."\n");my ($self,$cb,$response)=@_;while (){my$head=$self->readline;$head =~ /\A ([A-Fa-f0-9]+)/x or die(q/Malformed chunk head: / .$Printable->($head)."\n");my$len=hex($1)or last;$self->read_content_body($cb,$response,$len);$self->read(2)eq "\x0D\x0A" or die(qq/Malformed chunk: missing CRLF after chunk data\n/)}$self->read_header_lines($response->{headers});return 1}sub write_chunked_body {@_==2 || die(q/Usage: $handle->write_chunked_body(request)/ ."\n");my ($self,$request)=@_;my$len=0;while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_chunked_body()\n/)}$len += length$data;my$chunk=sprintf '%X',length$data;$chunk .= "\x0D\x0A";$chunk .= $data;$chunk .= "\x0D\x0A";$self->write($chunk)}$self->write("0\x0D\x0A");$self->write_header_lines($request->{trailer_cb}->())if ref$request->{trailer_cb}eq 'CODE';return$len}sub read_response_header {@_==1 || die(q/Usage: $handle->read_response_header()/ ."\n");my ($self)=@_;my$line=$self->readline;$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x or die(q/Malformed Status-Line: / .$Printable->($line)."\n");my ($protocol,$version,$status,$reason)=($1,$2,$3,$4);die (qq/Unsupported HTTP protocol: $protocol\n/)unless$version =~ /0*1\.0*[01]/;return {status=>$status,reason=>$reason,headers=>$self->read_header_lines,protocol=>$protocol,}}sub write_request_header {@_==4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ ."\n");my ($self,$method,$request_uri,$headers)=@_;return$self->write_header_lines($headers,"$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)=@_;return 0 if $self->{pid}!=$$ || $self->{tid}!=_get_tid()|| length($self->{rbuf})|| $scheme ne $self->{scheme}|| $host ne $self->{host}|| $port ne $self->{port}|| eval {$self->can_read(0)}|| $@ ;return 1}sub _find_CA_file {my$self=shift();if ($self->{SSL_options}->{SSL_ca_file}){unless (-r $self->{SSL_options}->{SSL_ca_file}){die qq/SSL_ca_file '$self->{SSL_options}->{SSL_ca_file}' not found or not readable\n/}return$self->{SSL_options}->{SSL_ca_file}}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 Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n"); return \$self->request('$req_method', \$url, \$args || {}); } HERE HTTP_TINY $fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP'; package JSON::PP;use 5.005;use strict;use base qw(Exporter);use overload ();use Carp ();use B ();$JSON::PP::VERSION='2.27300';@JSON::PP::EXPORT=qw(encode_json decode_json from_json to_json);use constant P_ASCII=>0;use constant P_LATIN1=>1;use constant P_UTF8=>2;use constant P_INDENT=>3;use constant P_CANONICAL=>4;use constant P_SPACE_BEFORE=>5;use constant P_SPACE_AFTER=>6;use constant P_ALLOW_NONREF=>7;use constant P_SHRINK=>8;use constant P_ALLOW_BLESSED=>9;use constant P_CONVERT_BLESSED=>10;use constant P_RELAXED=>11;use constant P_LOOSE=>12;use constant P_ALLOW_BIGNUM=>13;use constant P_ALLOW_BAREKEY=>14;use constant P_ALLOW_SINGLEQUOTE=>15;use constant P_ESCAPE_SLASH=>16;use constant P_AS_NONBLESSED=>17;use constant P_ALLOW_UNKNOWN=>18;use constant OLD_PERL=>$] < 5.008 ? 1 : 0;BEGIN {my@xs_compati_bit_properties=qw(latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink allow_blessed convert_blessed relaxed allow_unknown);my@pp_bit_properties=qw(allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed);if ($] < 5.008){my$helper=$] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';eval qq| require $helper |;if ($@){Carp::croak $@}}for my$name (@xs_compati_bit_properties,@pp_bit_properties){my$flag_name='P_' .uc($name);eval qq/ sub $name { my \$enable = defined \$_[1] ? \$_[1] : 1; if (\$enable) { \$_[0]->{PROPS}->[$flag_name] = 1; } else { \$_[0]->{PROPS}->[$flag_name] = 0; } \$_[0]; } sub get_$name { \$_[0]->{PROPS}->[$flag_name] ? 1 : ''; } /}}my%encode_allow_method =map {($_=>1)}qw/utf8 pretty allow_nonref latin1 self_encode escape_slash allow_blessed convert_blessed indent indent_length allow_bignum as_nonblessed/;my%decode_allow_method =map {($_=>1)}qw/utf8 allow_nonref loose allow_singlequote allow_bignum allow_barekey max_size relaxed/;my$JSON;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=>0,FLAGS=>0,fallback=>sub {encode_error('Invalid value. JSON can only reference.')},indent_length=>3,};bless$self,$class}sub encode {return $_[0]->PP_encode_json($_[1])}sub decode {return $_[0]->PP_decode_json($_[1],0x00000000)}sub decode_prefix {return $_[0]->PP_decode_json($_[1],0x00000001)}sub pretty {my ($self,$v)=@_;my$enable=defined$v ? $v : 1;if ($enable){$self->indent(1)->indent_length(3)->space_before(1)->space_after(1)}else {$self->indent(0)->space_before(0)->space_after(0)}$self}sub max_depth {my$max=defined $_[1]? $_[1]: 0x80000000;$_[0]->{max_depth}=$max;$_[0]}sub get_max_depth {$_[0]->{max_depth}}sub max_size {my$max=defined $_[1]? $_[1]: 0;$_[0]->{max_size}=$max;$_[0]}sub get_max_size {$_[0]->{max_size}}sub filter_json_object {$_[0]->{cb_object}=defined $_[1]? $_[1]: 0;$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub filter_json_single_key_object {if (@_ > 1){$_[0]->{cb_sk_object}->{$_[1]}=$_[2]}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub indent_length {if (!defined $_[1]or $_[1]> 15 or $_[1]< 0){Carp::carp "The acceptable range of indent_length() is 0 to 15."}else {$_[0]->{indent_length}=$_[1]}$_[0]}sub get_indent_length {$_[0]->{indent_length}}sub sort_by {$_[0]->{sort_by}=defined $_[1]? $_[1]: 1;$_[0]}sub allow_bigint {Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted.")}{my$max_depth;my$indent;my$ascii;my$latin1;my$utf8;my$space_before;my$space_after;my$canonical;my$allow_blessed;my$convert_blessed;my$indent_length;my$escape_slash;my$bignum;my$as_nonblessed;my$depth;my$indent_count;my$keysort;sub PP_encode_json {my$self=shift;my$obj=shift;$indent_count=0;$depth=0;my$idx=$self->{PROPS};($ascii,$latin1,$utf8,$indent,$canonical,$space_before,$space_after,$allow_blessed,$convert_blessed,$escape_slash,$bignum,$as_nonblessed)=@{$idx}[P_ASCII .. P_SPACE_AFTER,P_ALLOW_BLESSED,P_CONVERT_BLESSED,P_ESCAPE_SLASH,P_ALLOW_BIGNUM,P_AS_NONBLESSED];($max_depth,$indent_length)=@{$self}{qw/max_depth indent_length/};$keysort=$canonical ? sub {$a cmp $b}: undef;if ($self->{sort_by}){$keysort=ref($self->{sort_by})eq 'CODE' ? $self->{sort_by}: $self->{sort_by}=~ /\D+/ ? $self->{sort_by}: sub {$a cmp $b}}encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")if(!ref$obj and!$idx->[P_ALLOW_NONREF ]);my$str=$self->object_to_json($obj);$str .= "\n" if ($indent);unless ($ascii or $latin1 or $utf8){utf8::upgrade($str)}if ($idx->[P_SHRINK ]){utf8::downgrade($str,1)}return$str}sub object_to_json {my ($self,$obj)=@_;my$type=ref($obj);if($type eq 'HASH'){return$self->hash_to_json($obj)}elsif($type eq 'ARRAY'){return$self->array_to_json($obj)}elsif ($type){if (blessed($obj)){return$self->value_to_json($obj)if ($obj->isa('JSON::PP::Boolean'));if ($convert_blessed and $obj->can('TO_JSON')){my$result=$obj->TO_JSON();if (defined$result and ref($result)){if (refaddr($obj)eq refaddr($result)){encode_error(sprintf("%s::TO_JSON method returned same object as was passed instead of a new one",ref$obj))}}return$self->object_to_json($result)}return "$obj" if ($bignum and _is_bignum($obj));return$self->blessed_to_json($obj)if ($allow_blessed and $as_nonblessed);encode_error(sprintf("encountered object '%s', but neither allow_blessed " ."nor convert_blessed settings are enabled",$obj))unless ($allow_blessed);return 'null'}else {return$self->value_to_json($obj)}}else{return$self->value_to_json($obj)}}sub hash_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');my$del=($space_before ? ' ' : '').':' .($space_after ? ' ' : '');for my$k (_sort($obj)){if (OLD_PERL){utf8::decode($k)}push@res,string_to_json($self,$k).$del .($self->object_to_json($obj->{$k})|| $self->value_to_json($obj->{$k}))}--$depth;$self->_down_indent()if ($indent);return '{' .(@res ? $pre : '').(@res ? join(",$pre",@res).$post : '').'}'}sub array_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');for my$v (@$obj){push@res,$self->object_to_json($v)|| $self->value_to_json($v)}--$depth;$self->_down_indent()if ($indent);return '[' .(@res ? $pre : '').(@res ? join(",$pre",@res).$post : '').']'}sub value_to_json {my ($self,$value)=@_;return 'null' if(!defined$value);my$b_obj=B::svref_2object(\$value);my$flags=$b_obj->FLAGS;return$value if$flags & (B::SVp_IOK | B::SVp_NOK)and!($flags & B::SVp_POK);my$type=ref($value);if(!$type){return string_to_json($self,$value)}elsif(blessed($value)and $value->isa('JSON::PP::Boolean')){return $$value==1 ? 'true' : 'false'}elsif ($type){if ((overload::StrVal($value)=~ /=(\w+)/)[0]){return$self->value_to_json("$value")}if ($type eq 'SCALAR' and defined $$value){return $$value eq '1' ? 'true' : $$value eq '0' ? 'false' : $self->{PROPS}->[P_ALLOW_UNKNOWN ]? 'null' : encode_error("cannot encode reference to scalar")}if ($self->{PROPS}->[P_ALLOW_UNKNOWN ]){return 'null'}else {if ($type eq 'SCALAR' or $type eq 'REF'){encode_error("cannot encode reference to scalar")}else {encode_error("encountered $value, but JSON can only represent references to arrays or hashes")}}}else {return$self->{fallback}->($value)if ($self->{fallback}and ref($self->{fallback})eq 'CODE');return 'null'}}my%esc=("\n"=>'\n',"\r"=>'\r',"\t"=>'\t',"\f"=>'\f',"\b"=>'\b',"\""=>'\"',"\\"=>'\\\\',"\'"=>'\\\'',);sub string_to_json {my ($self,$arg)=@_;$arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;$arg =~ s/\//\\\//g if ($escape_slash);$arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;if ($ascii){$arg=JSON_PP_encode_ascii($arg)}if ($latin1){$arg=JSON_PP_encode_latin1($arg)}if ($utf8){utf8::encode($arg)}return '"' .$arg .'"'}sub blessed_to_json {my$reftype=reftype($_[1])|| '';if ($reftype eq 'HASH'){return $_[0]->hash_to_json($_[1])}elsif ($reftype eq 'ARRAY'){return $_[0]->array_to_json($_[1])}else {return 'null'}}sub encode_error {my$error=shift;Carp::croak "$error"}sub _sort {defined$keysort ? (sort$keysort (keys %{$_[0]})): keys %{$_[0]}}sub _up_indent {my$self=shift;my$space=' ' x $indent_length;my ($pre,$post)=('','');$post="\n" .$space x $indent_count;$indent_count++;$pre="\n" .$space x $indent_count;return ($pre,$post)}sub _down_indent {$indent_count--}sub PP_encode_box {{depth=>$depth,indent_count=>$indent_count,}}}sub _encode_ascii {join('',map {$_ <= 127 ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_latin1 {join('',map {$_ <= 255 ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_surrogates {my$uni=$_[0]- 0x10000;return ($uni / 0x400 + 0xD800,$uni % 0x400 + 0xDC00)}sub _is_bignum {$_[0]->isa('Math::BigInt')or $_[0]->isa('Math::BigFloat')}my$max_intsize;BEGIN {my$checkint=1111;for my$d (5..64){$checkint .= 1;my$int=eval qq| $checkint |;if ($int =~ /[eE]/){$max_intsize=$d - 1;last}}}{my%escapes=(b=>"\x8",t=>"\x9",n=>"\xA",f=>"\xC",r=>"\xD",'\\'=>'\\','"'=>'"','/'=>'/',);my$text;my$at;my$ch;my$len;my$depth;my$encoding;my$is_valid_utf8;my$utf8_len;my$utf8;my$max_depth;my$max_size;my$relaxed;my$cb_object;my$cb_sk_object;my$F_HOOK;my$allow_bigint;my$singlequote;my$loose;my$allow_barekey;sub PP_decode_json {my ($self,$opt);($self,$text,$opt)=@_;($at,$ch,$depth)=(0,'',0);if (!defined$text or ref$text){decode_error("malformed JSON string, neither array, object, number, string or atom")}my$idx=$self->{PROPS};($utf8,$relaxed,$loose,$allow_bigint,$allow_barekey,$singlequote)=@{$idx}[P_UTF8,P_RELAXED,P_LOOSE .. P_ALLOW_SINGLEQUOTE];if ($utf8){utf8::downgrade($text,1)or Carp::croak("Wide character in subroutine entry")}else {utf8::upgrade($text);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)}my@octets=unpack('C4',$text);$encoding=($octets[0]and $octets[1])? 'UTF-8' : (!$octets[0]and $octets[1])? 'UTF-16BE' : (!$octets[0]and!$octets[1])? 'UTF-32BE' : ($octets[2])? 'UTF-16LE' : (!$octets[2])? 'UTF-32LE' : 'unknown';white();my$valid_start=defined$ch;my$result=value();return undef if (!$result && ($opt & 0x10000000));decode_error("malformed JSON string, neither array, object, number, string or atom")unless$valid_start;if (!$idx->[P_ALLOW_NONREF ]and!ref$result){decode_error('JSON text must be an object or array (but found number, string, true, false or null,' .' use allow_nonref to allow this)',1)}Carp::croak('something wrong.')if$len < $at;my$consumed=defined$ch ? $at - 1 : $at;white();if ($ch){return ($result,$consumed)if ($opt & 0x00000001);decode_error("garbage after JSON object")}($opt & 0x00000001)? ($result,$consumed): $result}sub next_chr {return$ch=undef if($at >= $len);$ch=substr($text,$at++,1)}sub value {white();return if(!defined$ch);return object()if($ch eq '{');return array()if($ch eq '[');return string()if($ch eq '"' or ($singlequote and $ch eq "'"));return number()if($ch =~ /[0-9]/ or $ch eq '-');return word()}sub string {my ($i,$s,$t,$u);my$utf16;my$is_utf8;($is_valid_utf8,$utf8_len)=('',0);$s='';if($ch eq '"' or ($singlequote and $ch eq "'")){my$boundChar=$ch;OUTER: while(defined(next_chr())){if($ch eq $boundChar){next_chr();if ($utf16){decode_error("missing low surrogate character in surrogate pair")}utf8::decode($s)if($is_utf8);return$s}elsif($ch eq '\\'){next_chr();if(exists$escapes{$ch}){$s .= $escapes{$ch}}elsif($ch eq 'u'){my$u='';for(1..4){$ch=next_chr();last OUTER if($ch !~ /[0-9a-fA-F]/);$u .= $ch}if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/){$utf16=$u}elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/){unless (defined$utf16){decode_error("missing high surrogate character in surrogate pair")}$is_utf8=1;$s .= JSON_PP_decode_surrogates($utf16,$u)|| next;$utf16=undef}else {if (defined$utf16){decode_error("surrogate pair expected")}if ((my$hex=hex($u))> 127){$is_utf8=1;$s .= JSON_PP_decode_unicode($u)|| next}else {$s .= chr$hex}}}else{unless ($loose){$at -= 2;decode_error('illegal backslash escape sequence in string')}$s .= $ch}}else{if (ord$ch > 127){unless($ch=is_valid_utf8($ch)){$at -= 1;decode_error("malformed UTF-8 character in JSON string")}else {$at += $utf8_len - 1}$is_utf8=1}if (!$loose){if ($ch =~ /[\x00-\x1f\x22\x5c]/){$at--;decode_error('invalid character encountered while parsing JSON string')}}$s .= $ch}}}decode_error("unexpected end of string while parsing JSON string")}sub white {while(defined$ch){if($ch le ' '){next_chr()}elsif($ch eq '/'){next_chr();if(defined$ch and $ch eq '/'){1 while(defined(next_chr())and $ch ne "\n" and $ch ne "\r")}elsif(defined$ch and $ch eq '*'){next_chr();while(1){if(defined$ch){if($ch eq '*'){if(defined(next_chr())and $ch eq '/'){next_chr();last}}else{next_chr()}}else{decode_error("Unterminated comment")}}next}else{$at--;decode_error("malformed JSON string, neither array, object, number, string or atom")}}else{if ($relaxed and $ch eq '#'){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}}}decode_error(", or ] expected while parsing array")}sub object {my$o=$_[0]|| {};my$k;decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')if (++$depth > $max_depth);next_chr();white();if(defined$ch and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}else {while (defined$ch){$k=($allow_barekey and $ch ne '"' and $ch ne "'")? bareKey(): string();white();if(!defined$ch or $ch ne ':'){$at--;decode_error("':' expected")}next_chr();$o->{$k}=value();white();last if (!defined$ch);if($ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}if($ch ne ','){last}next_chr();white();if ($relaxed and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}}}$at--;decode_error(", or } expected while parsing object/hash")}sub bareKey {my$key;while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){$key .= $ch;next_chr()}return$key}sub word {my$word=substr($text,$at-1,4);if($word eq 'true'){$at += 3;next_chr;return$JSON::PP::true}elsif($word eq 'null'){$at += 3;next_chr;return undef}elsif($word eq 'fals'){$at += 3;if(substr($text,$at,1)eq 'e'){$at++;next_chr;return$JSON::PP::false}}$at--;decode_error("'null' expected")if ($word =~ /^n/);decode_error("'true' expected")if ($word =~ /^t/);decode_error("'false' expected")if ($word =~ /^f/);decode_error("malformed JSON string, neither array, object, number, string or atom")}sub number {my$n='';my$v;if($ch eq '0'){my$peek=substr($text,$at,1);my$hex=$peek =~ /[xX]/;if($hex){decode_error("malformed number (leading zero must not be followed by another digit)");($n)=(substr($text,$at+1)=~ /^([0-9a-fA-F]+)/)}else{($n)=(substr($text,$at)=~ /^([0-7]+)/);if (defined$n and length$n > 1){decode_error("malformed number (leading zero must not be followed by another digit)")}}if(defined$n and length($n)){if (!$hex and length($n)==1){decode_error("malformed number (leading zero must not be followed by another digit)")}$at += length($n)+ $hex;next_chr;return$hex ? hex($n): oct($n)}}if($ch eq '-'){$n='-';next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after initial minus)")}}while(defined$ch and $ch =~ /\d/){$n .= $ch;next_chr}if(defined$ch and $ch eq '.'){$n .= '.';next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after decimal point)")}else {$n .= $ch}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}if(defined$ch and ($ch eq 'e' or $ch eq 'E')){$n .= $ch;next_chr;if(defined($ch)and ($ch eq '+' or $ch eq '-')){$n .= $ch;next_chr;if (!defined$ch or $ch =~ /\D/){decode_error("malformed number (no digits after exp sign)")}$n .= $ch}elsif(defined($ch)and $ch =~ /\d/){$n .= $ch}else {decode_error("malformed number (no digits after exp sign)")}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}$v .= $n;if ($v !~ /[.eE]/ and length$v > $max_intsize){if ($allow_bigint){require Math::BigInt;return Math::BigInt->new($v)}else {return "$v"}}elsif ($allow_bigint){require Math::BigFloat;return Math::BigFloat->new($v)}return 0+$v}sub is_valid_utf8 {$utf8_len=$_[0]=~ /[\x00-\x7F]/ ? 1 : $_[0]=~ /[\xC2-\xDF]/ ? 2 : $_[0]=~ /[\xE0-\xEF]/ ? 3 : $_[0]=~ /[\xF0-\xF4]/ ? 4 : 0 ;return unless$utf8_len;my$is_valid_utf8=substr($text,$at - 1,$utf8_len);return ($is_valid_utf8 =~ /^(?: [\x00-\x7F] |[\xC2-\xDF][\x80-\xBF] |[\xE0][\xA0-\xBF][\x80-\xBF] |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] |[\xED][\x80-\x9F][\x80-\xBF] |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] )$/x)? $is_valid_utf8 : ''}sub decode_error {my$error=shift;my$no_rep=shift;my$str=defined$text ? substr($text,$at): '';my$mess='';my$type=$] >= 5.008 ? 'U*' : $] < 5.006 ? 'C*' : utf8::is_utf8($str)? 'U*' : 'C*' ;for my$c (unpack($type,$str)){$mess .= $c==0x07 ? '\a' : $c==0x09 ? '\t' : $c==0x0a ? '\n' : $c==0x0d ? '\r' : $c==0x0c ? '\f' : $c < 0x20 ? sprintf('\x{%x}',$c): $c==0x5c ? '\\\\' : $c < 0x80 ? chr($c): sprintf('\x{%x}',$c);if (length$mess >= 20){$mess .= '...';last}}unless (length$mess){$mess='(end of string)'}Carp::croak ($no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")")}sub _json_object_hook {my$o=$_[0];my@ks=keys %{$o};if ($cb_sk_object and @ks==1 and exists$cb_sk_object->{$ks[0]}and ref$cb_sk_object->{$ks[0]}){my@val=$cb_sk_object->{$ks[0]}->($o->{$ks[0]});if (@val==1){return$val[0]}}my@val=$cb_object->($o)if ($cb_object);if (@val==0 or @val > 1){return$o}else {return$val[0]}}sub PP_decode_box {{text=>$text,at=>$at,ch=>$ch,len=>$len,depth=>$depth,encoding=>$encoding,is_valid_utf8=>$is_valid_utf8,}}}sub _decode_surrogates {my$uni=0x10000 + (hex($_[0])- 0xD800)* 0x400 + (hex($_[1])- 0xDC00);my$un=pack('U*',$uni);utf8::encode($un);return$un}sub _decode_unicode {my$un=pack('U',hex shift);utf8::encode($un);return$un}BEGIN {unless (defined&utf8::is_utf8){require Encode;*utf8::is_utf8=*Encode::is_utf8}if ($] >= 5.008){*JSON::PP::JSON_PP_encode_ascii=\&_encode_ascii;*JSON::PP::JSON_PP_encode_latin1=\&_encode_latin1;*JSON::PP::JSON_PP_decode_surrogates=\&_decode_surrogates;*JSON::PP::JSON_PP_decode_unicode=\&_decode_unicode}if ($] >= 5.008 and $] < 5.008003){package JSON::PP;require subs;subs->import('join');eval q| sub join { return '' if (@_ < 2); my $j = shift; my $str = shift; for (@_) { $str .= $j . $_; } return $str; } |}sub JSON::PP::incr_parse {local$Carp::CarpLevel=1;($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_parse(@_)}sub JSON::PP::incr_skip {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_skip}sub JSON::PP::incr_reset {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_reset}eval q{ sub JSON::PP::incr_text : lvalue { $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new; if ( $_[0]->{_incr_parser}->{incr_parsing} ) { Carp::croak("incr_text can not be called when the incremental parser already started parsing"); } $_[0]->{_incr_parser}->{incr_text}; } } if ($] >= 5.006)}BEGIN {eval 'require Scalar::Util';unless($@){*JSON::PP::blessed=\&Scalar::Util::blessed;*JSON::PP::reftype=\&Scalar::Util::reftype;*JSON::PP::refaddr=\&Scalar::Util::refaddr}else{eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';*JSON::PP::blessed=sub {local($@,$SIG{__DIE__},$SIG{__WARN__});ref($_[0])? eval {$_[0]->a_sub_not_likely_to_be_here}: undef};my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP);*JSON::PP::reftype=sub {my$r=shift;return undef unless length(ref($r));my$t=ref(B::svref_2object($r));return exists$tmap{$t}? $tmap{$t}: length(ref($$r))? 'REF' : 'SCALAR'};*JSON::PP::refaddr=sub {return undef unless length(ref($_[0]));my$addr;if(defined(my$pkg=blessed($_[0]))){$addr .= bless $_[0],'Scalar::Util::Fake';bless $_[0],$pkg}else {$addr .= $_[0]}$addr =~ /0x(\w+)/;local $^W;hex($1)}}}$JSON::PP::true=do {bless \(my$dummy=1),"JSON::PP::Boolean"};$JSON::PP::false=do {bless \(my$dummy=0),"JSON::PP::Boolean"};sub is_bool {defined $_[0]and UNIVERSAL::isa($_[0],"JSON::PP::Boolean")}sub true {$JSON::PP::true}sub false {$JSON::PP::false}sub null {undef}package JSON::PP::Boolean;use overload ("0+"=>sub {${$_[0]}},"++"=>sub {$_[0]=${$_[0]}+ 1},"--"=>sub {$_[0]=${$_[0]}- 1},fallback=>1,);package JSON::PP::IncrParser;use strict;use constant INCR_M_WS=>0;use constant INCR_M_STR=>1;use constant INCR_M_BS=>2;use constant INCR_M_JSON=>3;use constant INCR_M_C0=>4;use constant INCR_M_C1=>5;$JSON::PP::IncrParser::VERSION='1.01';my$unpack_format=$] < 5.006 ? 'C*' : 'U*';sub new {my ($class)=@_;bless {incr_nest=>0,incr_text=>undef,incr_parsing=>0,incr_p=>0,},$class}sub incr_parse {my ($self,$coder,$text)=@_;$self->{incr_text}='' unless (defined$self->{incr_text});if (defined$text){if (utf8::is_utf8($text)and!utf8::is_utf8($self->{incr_text})){utf8::upgrade($self->{incr_text});utf8::decode($self->{incr_text})}$self->{incr_text}.= $text}my$max_size=$coder->get_max_size;if (defined wantarray){$self->{incr_mode}=INCR_M_WS unless defined$self->{incr_mode};if (wantarray){my@ret;$self->{incr_parsing}=1;do {push@ret,$self->_incr_parse($coder,$self->{incr_text});unless (!$self->{incr_nest}and $self->{incr_mode}==INCR_M_JSON){$self->{incr_mode}=INCR_M_WS if$self->{incr_mode}!=INCR_M_STR}}until (length$self->{incr_text}>= $self->{incr_p});$self->{incr_parsing}=0;return@ret}else {$self->{incr_parsing}=1;my$obj=$self->_incr_parse($coder,$self->{incr_text});$self->{incr_parsing}=0 if defined$obj;return$obj ? $obj : undef}}}sub _incr_parse {my ($self,$coder,$text,$skip)=@_;my$p=$self->{incr_p};my$restore=$p;my@obj;my$len=length$text;if ($self->{incr_mode}==INCR_M_WS){while ($len > $p){my$s=substr($text,$p,1);$p++ and next if (0x20 >= unpack($unpack_format,$s));$self->{incr_mode}=INCR_M_JSON;last}}while ($len > $p){my$s=substr($text,$p++,1);if ($s eq '"'){if (substr($text,$p - 2,1)eq '\\'){next}if ($self->{incr_mode}!=INCR_M_STR){$self->{incr_mode}=INCR_M_STR}else {$self->{incr_mode}=INCR_M_JSON;unless ($self->{incr_nest}){last}}}if ($self->{incr_mode}==INCR_M_JSON){if ($s eq '[' or $s eq '{'){if (++$self->{incr_nest}> $coder->get_max_depth){Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')}}elsif ($s eq ']' or $s eq '}'){last if (--$self->{incr_nest}<= 0)}elsif ($s eq '#'){while ($len > $p){last if substr($text,$p++,1)eq "\n"}}}}$self->{incr_p}=$p;return if ($self->{incr_mode}==INCR_M_STR and not $self->{incr_nest});return if ($self->{incr_mode}==INCR_M_JSON and $self->{incr_nest}> 0);return '' unless (length substr($self->{incr_text},0,$p));local$Carp::CarpLevel=2;$self->{incr_p}=$restore;$self->{incr_c}=$p;my ($obj,$tail)=$coder->PP_decode_json(substr($self->{incr_text},0,$p),0x10000001);$self->{incr_text}=substr($self->{incr_text},$p);$self->{incr_p}=0;return$obj || ''}sub incr_text {if ($_[0]->{incr_parsing}){Carp::croak("incr_text can not be called when the incremental parser already started parsing")}$_[0]->{incr_text}}sub incr_skip {my$self=shift;$self->{incr_text}=substr($self->{incr_text},$self->{incr_c});$self->{incr_p}=0}sub incr_reset {my$self=shift;$self->{incr_text}=undef;$self->{incr_p}=0;$self->{incr_mode}=0;$self->{incr_nest}=0;$self->{incr_parsing}=0}1; JSON_PP $fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN'; use JSON::PP ();use strict;1; JSON_PP_BOOLEAN $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.1000';sub new {my($class,$file)=@_;bless {},$class}sub load {my($proto,$file)=@_;my$self=ref$proto ? $proto : $proto->new;$self->parse($file || Cwd::abs_path('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>};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$prereqs=$self->prereqs;my@others=map {$self->feature($_)->prereqs}@feature_identifiers;$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 _dump {my$str=shift;require Data::Dumper;chomp(my$value=Data::Dumper->new([$str])->Terse(1)->Dump);$value}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 .= sprintf "feature %s, %s => sub {\n",_dump($feature->{identifier}),_dump($feature->{description});$code .= $self->_dump_prereqs($feature->{spec},$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 '$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)).$indent;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 '$mod';\n" : "${indent}$type '$mod', '$ver';\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(<<EVAL);$err=$@}if ($err){die "Parsing $self->{file} failed: $err"};return 1}sub _evaluate {my$_environment=$_[0];eval $_[1]}sub prereqs {$_[0]->{prereqs}}sub mirrors {$_[0]->{mirrors}}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_prereq(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}}sub match_feature {my($self,$identifier)=@_;no warnings 'uninitialized';$self->feature eq $identifier}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_prereq(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_prereq {my($self,%args)=@_;$self->add(Module::CPANfile::Prereq->new(%args))}sub add {my($self,$prereq)=@_;push @{$self->{prereqs}},$prereq}sub as_cpan_meta {my$self=shift;$self->{cpanmeta}||= $self->build_cpan_meta}sub build_cpan_meta {my($self,$identifier)=@_;my$prereq_spec={};$self->prereq_each($identifier,sub {my$prereq=shift;$prereq_spec->{$prereq->phase}{$prereq->type}{$prereq->module}=$prereq->requirement->version});CPAN::Meta::Prereqs->new($prereq_spec)}sub prereq_each {my($self,$identifier,$code)=@_;for my$prereq (@{$self->{prereqs}}){next unless$prereq->match_feature($identifier);$code->($prereq)}}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$prereq (@{$self->{prereqs}}){return$prereq if$prereq->module eq $module}return}sub identifiers {my$self=shift;keys %{$self->{features}}}sub feature {my($self,$identifier)=@_;my$data=$self->{features}{$identifier}or Carp::croak("Unknown feature '$identifier'");my$prereqs=$self->build_cpan_meta($identifier);CPAN::Meta::Feature->new($identifier,{description=>$data->{description},prereqs=>$prereqs->as_string_hash,})}1; MODULE_CPANFILE_PREREQS $fatpacked{"Module/CPANfile/Requirement.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_REQUIREMENT'; package Module::CPANfile::Requirement;use strict;sub new {my ($class,%args)=@_;$args{version}||= 0;bless +{name=>delete$args{name},version=>delete$args{version},options=>\%args,},$class}sub name {$_[0]->{name}}sub version {$_[0]->{version}}sub options {$_[0]->{options}}sub has_options {keys %{$_[0]->{options}}> 0}1; MODULE_CPANFILE_REQUIREMENT $fatpacked{"Module/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_METADATA'; package Module::Metadata;sub __clean_eval {eval $_[0]}use strict;use warnings;our$VERSION='1.000027';use Carp qw/croak/;use File::Spec;BEGIN {eval {require Fcntl;Fcntl->import('SEEK_SET');1}or *SEEK_SET=sub {0}}use version 0.87;BEGIN {if ($INC{'Log/Contextual.pm'}){require "Log/Contextual/WarnLogger.pm";Log::Contextual->import('log_info','-default_logger'=>Log::Contextual::WarnLogger->new({env_prefix=>'MODULE_METADATA',}),)}else {*log_info=sub (&) {warn $_[0]->()}}}use File::Find qw(find);my$V_NUM_REGEXP=qr{v?[0-9._]+};my$PKG_FIRST_WORD_REGEXP=qr{ # the FIRST word in a package name [a-zA-Z_] # the first word CANNOT start with a digit (?: [\w']? # can contain letters, digits, _, or ticks \w # But, NO multi-ticks or trailing ticks )* }x;my$PKG_ADDL_WORD_REGEXP=qr{ # the 2nd+ word in a package name \w # the 2nd+ word CAN start with digits (?: [\w']? # and can contain letters or ticks \w # But, NO multi-ticks or trailing ticks )* }x;my$PKG_NAME_REGEXP=qr{ # match a package name (?: :: )? # a pkg name can start with arisdottle $PKG_FIRST_WORD_REGEXP # a package word (?: (?: :: )+ ### arisdottle (allow one or many times) $PKG_ADDL_WORD_REGEXP ### a package word )* # ^ zero, one or many times (?: :: # allow trailing arisdottle )? }x;my$PKG_REGEXP=qr{ # match a package declaration ^[\s\{;]* # intro chars on a line package # the word 'package' \s+ # whitespace ($PKG_NAME_REGEXP) # a package name \s* # optional whitespace ($V_NUM_REGEXP)? # optional version number \s* # optional whitesapce [;\{] # semicolon line terminator or block start (since 5.16) }x;my$VARNAME_REGEXP=qr{ # match fully-qualified VERSION name ([\$*]) # sigil - $ or * ( ( # optional leading package name (?:::|\')? # possibly starting like just :: (a la $::VERSION) (?:\w+(?:::|\'))* # Foo::Bar:: ... )? VERSION )\b }x;my$VERS_REGEXP=qr{ # match a VERSION definition (?: \(\s*$VARNAME_REGEXP\s*\) # with parens | $VARNAME_REGEXP # without parens ) \s* =[^=~>] # = but not ==, nor =~, nor => }x;sub new_from_file {my$class=shift;my$filename=File::Spec->rel2abs(shift);return undef unless defined($filename)&& -f $filename;return$class->_init(undef,$filename,@_)}sub new_from_handle {my$class=shift;my$handle=shift;my$filename=shift;return undef unless defined($handle)&& defined($filename);$filename=File::Spec->rel2abs($filename);return$class->_init(undef,$filename,@_,handle=>$handle)}sub new_from_module {my$class=shift;my$module=shift;my%props=@_;$props{inc}||= \@INC;my$filename=$class->find_module_by_name($module,$props{inc});return undef unless defined($filename)&& -f $filename;return$class->_init($module,$filename,%props)}{my$compare_versions=sub {my ($v1,$op,$v2)=@_;$v1=version->new($v1)unless UNIVERSAL::isa($v1,'version');my$eval_str="\$v1 $op \$v2";my$result=eval$eval_str;log_info {"error comparing versions: '$eval_str' $@"}if $@;return$result};my$normalize_version=sub {my ($version)=@_;if ($version =~ /[=<>!,]/){}elsif (ref$version eq 'version'){$version=$version->is_qv ? $version->normal : $version->stringify}elsif ($version =~ /^[^v][^.]*\.[^.]+\./){$version="v$version"}else {}return$version};my$resolve_module_versions=sub {my$packages=shift;my($file,$version);my$err='';for my$p (@$packages){if (defined($p->{version})){if (defined($version)){if ($compare_versions->($version,'!=',$p->{version})){$err .= " $p->{file} ($p->{version})\n"}else {}}else {$file=$p->{file};$version=$p->{version}}}$file ||= $p->{file}if defined($p->{file})}if ($err){$err=" $file ($version)\n" .$err}my%result=(file=>$file,version=>$version,err=>$err);return \%result};sub provides {my$class=shift;croak "provides() requires key/value pairs \n" if @_ % 2;my%args=@_;croak "provides() takes only one of 'dir' or 'files'\n" if$args{dir}&& $args{files};croak "provides() requires a 'version' argument" unless defined$args{version};croak "provides() does not support version '$args{version}' metadata" unless grep {$args{version}eq $_}qw/1.4 2/;$args{prefix}='lib' unless defined$args{prefix};my$p;if ($args{dir}){$p=$class->package_versions_from_directory($args{dir})}else {croak "provides() requires 'files' to be an array reference\n" unless ref$args{files}eq 'ARRAY';$p=$class->package_versions_from_directory($args{files})}if (length$args{prefix}){$args{prefix}=~ s{/$}{};for my$v (values %$p){$v->{file}="$args{prefix}/$v->{file}"}}return$p}sub package_versions_from_directory {my ($class,$dir,$files)=@_;my@files;if ($files){@files=@$files}else {find({wanted=>sub {push@files,$_ if -f $_ && /\.pm$/},no_chdir=>1,},$dir)}my(%prime,%alt);for my$file (@files){my$mapped_filename=File::Spec::Unix->abs2rel($file,$dir);my@path=split(/\//,$mapped_filename);(my$prime_package=join('::',@path))=~ s/\.pm$//;my$pm_info=$class->new_from_file($file);for my$package ($pm_info->packages_inside){next if$package eq 'main';next if$package eq 'DB';next if grep /^_/,split(/::/,$package);my$version=$pm_info->version($package);$prime_package=$package if lc($prime_package)eq lc($package);if ($package eq $prime_package){if (exists($prime{$package})){croak "Unexpected conflict in '$package'; multiple versions found.\n"}else {$mapped_filename="$package.pm" if lc("$package.pm")eq lc($mapped_filename);$prime{$package}{file}=$mapped_filename;$prime{$package}{version}=$version if defined($version)}}else {push(@{$alt{$package}},{file=>$mapped_filename,version=>$version,})}}}for my$package (keys(%alt)){my$result=$resolve_module_versions->($alt{$package});if (exists($prime{$package})){if ($result->{err}){log_info {"Found conflicting versions for package '$package'\n" ." $prime{$package}{file} ($prime{$package}{version})\n" .$result->{err}}}elsif (defined($result->{version})){if (exists($prime{$package}{version})&& defined($prime{$package}{version})){if ($compare_versions->($prime{$package}{version},'!=',$result->{version})){log_info {"Found conflicting versions for package '$package'\n" ." $prime{$package}{file} ($prime{$package}{version})\n" ." $result->{file} ($result->{version})\n"}}}else {$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}}}else {}}else {if ($result->{err}){log_info {"Found conflicting versions for package '$package'\n" .$result->{err}}}$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}if defined($result->{version})}}for (grep defined $_->{version},values%prime){$_->{version}=$normalize_version->($_->{version})}return \%prime}}sub _init {my$class=shift;my$module=shift;my$filename=shift;my%props=@_;my$handle=delete$props{handle};my(%valid_props,@valid_props);@valid_props=qw(collect_pod inc);@valid_props{@valid_props}=delete(@props{@valid_props});warn "Unknown properties: @{[keys %props]}\n" if scalar(%props);my%data=(module=>$module,filename=>$filename,version=>undef,packages=>[],versions=>{},pod=>{},pod_headings=>[],collect_pod=>0,%valid_props,);my$self=bless(\%data,$class);if (not $handle){my$filename=$self->{filename};open$handle,'<',$filename or croak("Can't open '$filename': $!");$self->_handle_bom($handle,$filename)}$self->_parse_fh($handle);unless($self->{module}and length($self->{module})){my ($v,$d,$f)=File::Spec->splitpath($self->{filename});if($f =~ /\.pm$/){$f =~ s/\..+$//;my@candidates=grep /$f$/,@{$self->{packages}};$self->{module}=shift(@candidates)}else {if(grep /main/,@{$self->{packages}}){$self->{module}='main'}else {$self->{module}=$self->{packages}[0]|| ''}}}$self->{version}=$self->{versions}{$self->{module}}if defined($self->{module});return$self}sub _do_find_module {my$class=shift;my$module=shift || croak 'find_module_by_name() requires a package name';my$dirs=shift || \@INC;my$file=File::Spec->catfile(split(/::/,$module));for my$dir (@$dirs){my$testfile=File::Spec->catfile($dir,$file);return [File::Spec->rel2abs($testfile),$dir ]if -e $testfile and!-d _;$testfile .= '.pm';return [File::Spec->rel2abs($testfile),$dir ]if -e $testfile}return}sub find_module_by_name {my$found=shift()->_do_find_module(@_)or return;return$found->[0]}sub find_module_dir_by_name {my$found=shift()->_do_find_module(@_)or return;return$found->[1]}sub _parse_version_expression {my$self=shift;my$line=shift;my($sigil,$variable_name,$package);if ($line =~ /$VERS_REGEXP/o){($sigil,$variable_name,$package)=$2 ? ($1,$2,$3): ($4,$5,$6);if ($package){$package=($package eq '::')? 'main' : $package;$package =~ s/::$//}}return ($sigil,$variable_name,$package)}sub _handle_bom {my ($self,$fh,$filename)=@_;my$pos=tell$fh;return unless defined$pos;my$buf=' ' x 2;my$count=read$fh,$buf,length$buf;return unless defined$count and $count >= 2;my$encoding;if ($buf eq "\x{FE}\x{FF}"){$encoding='UTF-16BE'}elsif ($buf eq "\x{FF}\x{FE}"){$encoding='UTF-16LE'}elsif ($buf eq "\x{EF}\x{BB}"){$buf=' ';$count=read$fh,$buf,length$buf;if (defined$count and $count >= 1 and $buf eq "\x{BF}"){$encoding='UTF-8'}}if (defined$encoding){if ("$]" >= 5.008){binmode($fh,":encoding($encoding)")}}else {seek$fh,$pos,SEEK_SET or croak(sprintf "Can't reset position to the top of '$filename'")}return$encoding}sub _parse_fh {my ($self,$fh)=@_;my($in_pod,$seen_end,$need_vers)=(0,0,0);my(@packages,%vers,%pod,@pod);my$package='main';my$pod_sect='';my$pod_data='';my$in_end=0;while (defined(my$line=<$fh>)){my$line_num=$.;chomp($line);my$is_cut;if ($line =~ /^=([a-zA-Z].*)/){my$cmd=$1;$is_cut=$cmd =~ /^cut(?:[^a-zA-Z]|$)/;$in_pod=!$is_cut}if ($in_pod){if ($line =~ /^=head[1-4]\s+(.+)\s*$/){push(@pod,$1);if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data;$pod_data=''}$pod_sect=$1}elsif ($self->{collect_pod}){$pod_data .= "$line\n"}}elsif ($is_cut){if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data;$pod_data=''}$pod_sect=''}else {next if$in_end;next if$line =~ /^\s*#/;if ($line eq '__END__'){$in_end++;next}last if$line eq '__DATA__';my($version_sigil,$version_fullname,$version_package)=index($line,'VERSION')>= 1 ? $self->_parse_version_expression($line): ();if ($line =~ /$PKG_REGEXP/o){$package=$1;my$version=$2;push(@packages,$package)unless grep($package eq $_,@packages);$need_vers=defined$version ? 0 : 1;if (not exists$vers{$package}and defined$version){my$dwim_version=eval {_dwim_version($version)};croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n" unless defined$dwim_version;$vers{$package}=$dwim_version}}elsif ($version_fullname && $version_package){push(@packages,$version_package)unless grep($version_package eq $_,@packages);$need_vers=0 if$version_package eq $package;unless (defined$vers{$version_package}&& length$vers{$version_package}){$vers{$version_package}=$self->_evaluate_version_line($version_sigil,$version_fullname,$line)}}elsif ($package eq 'main' && $version_fullname &&!exists($vers{main})){$need_vers=0;my$v=$self->_evaluate_version_line($version_sigil,$version_fullname,$line);$vers{$package}=$v;push(@packages,'main')}elsif ($package eq 'main' &&!exists($vers{main})&& $line =~ /\w/){$need_vers=1;$vers{main}='';push(@packages,'main')}elsif ($version_fullname && $need_vers){$need_vers=0;my$v=$self->_evaluate_version_line($version_sigil,$version_fullname,$line);unless (defined$vers{$package}&& length$vers{$package}){$vers{$package}=$v}}}}if ($self->{collect_pod}&& length($pod_data)){$pod{$pod_sect}=$pod_data}$self->{versions}=\%vers;$self->{packages}=\@packages;$self->{pod}=\%pod;$self->{pod_headings}=\@pod}{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; \$$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{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META'; use 5.008001;use strict;package Parse::CPAN::Meta;our$VERSION='1.4414';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)=@_;my$data=eval {$class->json_backend()->new->decode($string)};croak $@ if $@;return$data || {}}sub yaml_backend {if (!defined$ENV{PERL_YAML_BACKEND}){_can_load('CPAN::Meta::YAML',0.011)or croak "CPAN::Meta::YAML 0.011 is not available\n";return "CPAN::Meta::YAML"}else {my$backend=$ENV{PERL_YAML_BACKEND};_can_load($backend)or croak "Could not load PERL_YAML_BACKEND '$backend'\n";$backend->can("Load")or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";return$backend}}sub json_backend {if (!$ENV{PERL_JSON_BACKEND}or $ENV{PERL_JSON_BACKEND}eq 'JSON::PP'){_can_load('JSON::PP'=>2.27103)or croak "JSON::PP 2.27103 is not available\n";return 'JSON::PP'}else {_can_load('JSON'=>2.5)or croak "JSON 2.5 is required for " ."\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";return "JSON"}}sub _slurp {require Encode;open my$fh,"<:raw","$_[0]" 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.36';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}}$checked_in{$package}=$ppp->{$package}}return (wantarray && %errors)? (\%checked_in,\%errors): \%checked_in}sub _perm_check {my ($self,$package)=@_;my$userid=$self->{USERID};my$module=$self->{PERMISSIONS}->module_permissions($package);return 1 if!$module;return 1 if defined$module->m && $module->m eq $userid;return 1 if defined$module->f && $module->f eq $userid;return 1 if defined$module->c && grep {$_ eq $userid}@{$module->c};return}sub _parse_version {my$self=shift;use strict;my$pmfile=$self->{PMFILE};my$tmpfile=File::Spec->catfile(File::Spec->tmpdir,"ParsePMFile$$" .rand(1000));my$pmcp=$pmfile;for ($pmcp){s/([^\\](\\\\)*)@/$1\\@/g}my($v);{package main;my$pid;if ($self->{FORK}|| $FORK){$pid=fork();die "Can't fork: $!" unless defined$pid}if ($pid){waitpid($pid,0);if (open my$fh,'<',$tmpfile){$v=<$fh>}}else {my($comp)=Safe->new;my$eval=qq{ local(\$^W) = 0; Parse::PMFile::_parse_version_safely("$pmcp"); };$comp->permit("entereval");$comp->share("*Parse::PMFile::_parse_version_safely");$comp->share("*version::new");$comp->share("*version::numify");$comp->share_from('main',['*version::','*charstar::','*Exporter::','*DynaLoader::']);$comp->share_from('version',['&qv']);$comp->permit(":base_math");$comp->deny(qw/enteriter iter unstack goto/);version->import('qv')if$self->{UNSAFE}|| $UNSAFE;{no strict;$v=($self->{UNSAFE}|| $UNSAFE)? eval$eval : $comp->reval($eval)}if ($@){my$err=$@;if (ref$err){if ($err->{line}=~ /([\$*])([\w\:\']*)\bVERSION\b.*?\=(.*)/){local($^W)=0;my ($sigil,$vstr)=($1,$3);$self->_restore_overloaded_stuff(1)if$err->{line}=~ /use\s+version\b|version\->|qv\(/;$v=($self->{UNSAFE}|| $UNSAFE)? eval$vstr : $comp->reval($vstr);$v=$$v if$sigil eq '*' && ref$v}if ($@ or!$v){$self->_verbose(1,sprintf("reval failed: err[%s] for eval[%s]",JSON::PP::encode_json($err),$eval,));$v=JSON::PP::encode_json($err)}}else {$v=JSON::PP::encode_json({openerr=>$err })}}if (defined$v){$v=$v->numify if ref($v)=~ /^version(::vpp)?$/}else {$v=""}if ($self->{FORK}|| $FORK){open my$fh,'>:utf8',$tmpfile;print$fh $v;exit 0}else {utf8::encode($v);$v=undef if defined$v &&!length$v;$comp->erase;$self->_restore_overloaded_stuff}}}unlink$tmpfile if ($self->{FORK}|| $FORK)&& -e $tmpfile;return$self->_normalize_version($v)}sub _restore_overloaded_stuff {my ($self,$used_version_in_safe)=@_;return if$self->{UNSAFE}|| $UNSAFE;no strict 'refs';no warnings 'redefine';my$restored;if ($INC{'version/vxs.pm'}){*{'version::(""'}=\&version::vxs::stringify;*{'version::(0+'}=\&version::vxs::numify;*{'version::(cmp'}=\&version::vxs::VCMP;*{'version::(<=>'}=\&version::vxs::VCMP;*{'version::(bool'}=\&version::vxs::boolean;$restored=1}if ($INC{'version/vpp.pm'}){{package charstar;overload->import}if (!$used_version_in_safe){package version::vpp;overload->import}unless ($restored){*{'version::(""'}=\&version::vpp::stringify;*{'version::(0+'}=\&version::vpp::numify;*{'version::(cmp'}=\&version::vpp::vcmp;*{'version::(<=>'}=\&version::vpp::vcmp;*{'version::(bool'}=\&version::vpp::vbool}*{'version::vpp::(""'}=\&version::vpp::stringify;*{'version::vpp::(0+'}=\&version::vpp::numify;*{'version::vpp::(cmp'}=\&version::vpp::vcmp;*{'version::vpp::(<=>'}=\&version::vpp::vcmp;*{'version::vpp::(bool'}=\&version::vpp::vbool;*{'charstar::(""'}=\&charstar::thischar;*{'charstar::(0+'}=\&charstar::thischar;*{'charstar::(++'}=\&charstar::increment;*{'charstar::(--'}=\&charstar::decrement;*{'charstar::(+'}=\&charstar::plus;*{'charstar::(-'}=\&charstar::minus;*{'charstar::(*'}=\&charstar::multiply;*{'charstar::(cmp'}=\&charstar::cmp;*{'charstar::(<=>'}=\&charstar::spaceship;*{'charstar::(bool'}=\&charstar::thischar;*{'charstar::(='}=\&charstar::clone;$restored=1}if (!$restored){*{'version::(""'}=\&version::stringify;*{'version::(0+'}=\&version::numify;*{'version::(cmp'}=\&version::vcmp;*{'version::(<=>'}=\&version::vcmp;*{'version::(bool'}=\&version::boolean}}sub _packages_per_pmfile {my$self=shift;my$ppp={};my$pmfile=$self->{PMFILE};my$filemtime=$self->{MTIME};my$version=$self->{VERSION};open my$fh,"<","$pmfile" or return$ppp;local $/="\n";my$inpod=0;PLINE: while (<$fh>){chomp;my($pline)=$_;$inpod=$pline =~ /^=(?!cut)/ ? 1 : $pline =~ /^=cut/ ? 0 : $inpod;next if$inpod;next if substr($pline,0,4)eq "=cut";$pline =~ s/\#.*//;next if$pline =~ /^\s*$/;if ($pline =~ /^__(?:END|DATA)__\b/ and $pmfile !~ /\.PL$/){last PLINE}my$pkg;my$strict_version;if ($pline =~ m{ # (.*) # takes too much time if $pline is long (?<![*\$\\@%&]) # no sigils \bpackage\s+ ([\w\:\']+) \s* (?: $ | [\}\;] | \{ | \s+($version::STRICT) ) }x){$pkg=$1;$strict_version=$2;if ($pkg eq "DB"){next PLINE}}if ($pkg){$pkg =~ s/\'/::/;next PLINE unless$pkg =~ /^[A-Za-z]/;next PLINE unless$pkg =~ /\w$/;next PLINE if$pkg eq "main";next PLINE if length($pkg)> 128;$ppp->{$pkg}{parsed}++;$ppp->{$pkg}{infile}=$pmfile;if ($self->_simile($pmfile,$pkg)){$ppp->{$pkg}{simile}=$pmfile;if ($self->_version_from_meta_ok){my$provides=$self->{META_CONTENT}{provides};if (exists$provides->{$pkg}){if (defined$provides->{$pkg}{version}){my$v=$provides->{$pkg}{version};if ($v =~ /[_\s]/ &&!$self->{ALLOW_DEV_VERSION}&&!$ALLOW_DEV_VERSION){next PLINE}unless (eval {$version=$self->_normalize_version($v);1}){$self->_verbose(1,"error with version in $pmfile: $@");next}$ppp->{$pkg}{version}=$version}else {$ppp->{$pkg}{version}="undef"}}}else {if (defined$strict_version){$ppp->{$pkg}{version}=$strict_version }else {$ppp->{$pkg}{version}=defined$version ? $version : ""}no warnings;if ($version eq 'undef'){$ppp->{$pkg}{version}=$version unless defined$ppp->{$pkg}{version}}else {$ppp->{$pkg}{version}=$version if$version > $ppp->{$pkg}{version}|| $version gt $ppp->{$pkg}{version}}}}else {$ppp->{$pkg}{version}=$version unless defined$ppp->{$pkg}{version}&& length($ppp->{$pkg}{version})}$ppp->{$pkg}{filemtime}=$filemtime}else {}}close$fh;$ppp}{no strict;sub _parse_version_safely {my($parsefile)=@_;my$result;local*FH;local $/="\n";open(FH,$parsefile)or die "Could not open '$parsefile': $!";my$inpod=0;while (<FH>){$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 /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*(?<![!><=])\=(?![=>])/;my$current_parsed_line=$_;my$eval=qq{ package # ExtUtils::MakeMaker::_version; local $1$2; \$$2=undef; do { $_ }; \$$2 };local $^W=0;local$SIG{__WARN__}=sub {};$result=__clean_eval($eval);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/){$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(.+)/){$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{"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{"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;use strict;use warnings;use Config;our$VERSION='2.000015';$VERSION=eval$VERSION;BEGIN {*_WIN32=($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'symbian')? sub(){1}: sub(){0};*_USE_FSPEC=($^O eq 'MacOS' || $^O eq 'VMS' || $INC{'File/Spec.pm'})? sub(){1}: sub(){0}}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 _cwd {my$drive=shift;if (!$_PERL){($_PERL)=$^X =~ /(.+)/;if (_is_abs($_PERL)){}elsif (-x $Config{perlpath}){$_PERL=$Config{perlpath}}else {($_PERL)=map {/(.*)/}grep {-x $_}map {join($_DIR_JOIN,$_,$_PERL)}split /\Q$Config{path_sep}\E/,$ENV{PATH}}}local@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};my$cmd=$drive ? "eval { Cwd::getdcwd(q($drive)) }" : 'getcwd';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 ? $base : _cwd;return _catdir($base,$dir)}sub import {my ($class,@args)=@_;push@args,@ARGV if $0 eq '-';my@steps;my%opts;my$shelltype;while (@args){my$arg=shift@args;if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/){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 =~ /^--/){die "Unknown import argument: $arg"}else {push@steps,['activate',$arg]}}if (!@steps){push@steps,['activate',undef]}my$self=$class->new(%opts);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 no_create {$_[0]->{no_create}}my$_archname=$Config{archname};my$_version=$Config{version};my@_inc_version_list=reverse split / /,$Config{inc_version_list};my$_path_sep=$Config{path_sep};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],(@_inc_version_list ? \@_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)=@_;$self=$self->new unless ref$self;$path=$self->resolve_path($path);$self->ensure_dir_structure_for($path)unless$self->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 (!@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]);$self->build_environment_vars}sub build_activate_environment_vars_for {my$self=$_[0]->new->activate($_[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]);$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}','"','"\\%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','"','`%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}}$value =~ s/$_path_sep/ /g;qq{set -x $name $value;\n}}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)=@_;unless (-d $path){warn "Attempting to create directory ${path}\n"}require File::Basename;my@dirs;while(!-d $path){push@dirs,$path;$path=File::Basename::dirname($path)}mkdir $_ for reverse@dirs;return}sub guess_shelltype {my$shellbin =defined$ENV{SHELL}? ($ENV{SHELL}=~ /([\w.]+)$/)[-1]: ($^O eq 'MSWin32' && exists$ENV{'!EXITCODE'})? 'bash' : ($^O eq 'MSWin32' && $ENV{PROMPT}&& $ENV{COMSPEC})? ($ENV{COMSPEC}=~ /([\w.]+)$/)[-1]: ($^O eq 'MSWin32' &&!$ENV{PROMPT})? 'powershell.exe' : 'sh';for ($shellbin){return /csh$/ ? 'csh' : /fish/ ? 'fish' : /command(?:\.com)?$/i ? 'cmd' : /cmd(?:\.exe)?$/i ? 'cmd' : /4nt(?:\.exe)?$/i ? 'cmd' : /powershell(?:\.exe)?$/i ? 'powershell' : 'bourne'}}1; WHOA THERE! It looks like you've got some fancy dashes in your commandline! These are *not* the traditional -- dashes that software recognizes. You probably got these by copy-pasting from the perldoc for this module as rendered by a UTF8-capable formatter. This most typically happens on an OS X terminal, but can happen elsewhere too. Please try again after replacing the dashes with normal minus signs. DEATH FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained provided (although quite possibly not what you originally thought it provided due to the poor quality of the documentation, for which we apologise). DEATH LOCAL_LIB $fatpacked{"parent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARENT'; package parent;use strict;use vars qw($VERSION);$VERSION='0.228';sub import {my$class=shift;my$inheritor=caller(0);if (@_ and $_[0]eq '-norequire'){shift @_}else {for (my@filename=@_){if ($_ eq $inheritor){warn "Class '$inheritor' tried to inherit from itself\n"};s{::|'}{/}g;require "$_.pm"}}{no strict 'refs';push @{"$inheritor\::ISA"},@_}};"All your base are belong to us" 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/)}use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);$VERSION=0.9912;$CLASS='version';{local$SIG{'__DIE__'};if (1){eval "use version::vpp $VERSION";die "$@" if ($@);push@ISA,"version::vpp";local $^W;*version::qv=\&version::vpp::qv;*version::declare=\&version::vpp::declare;*version::_VERSION=\&version::vpp::_VERSION;*version::vcmp=\&version::vpp::vcmp;*version::new=\&version::vpp::new;*version::numify=\&version::vpp::numify;*version::normal=\&version::vpp::normal;if ($] >= 5.009000){no strict 'refs';*version::stringify=\&version::vpp::stringify;*{'version::(""'}=\&version::vpp::stringify;*{'version::(<=>'}=\&version::vpp::vcmp;*version::parse=\&version::vpp::parse}}else {push@ISA,"version::vxs";local $^W;*version::declare=\&version::vxs::declare;*version::qv=\&version::vxs::qv;*version::_VERSION=\&version::vxs::_VERSION;*version::vcmp=\&version::vxs::VCMP;*version::new=\&version::vxs::new;*version::numify=\&version::vxs::numify;*version::normal=\&version::vxs::normal;if ($] >= 5.009000){no strict 'refs';*version::stringify=\&version::vxs::stringify;*{'version::(""'}=\&version::vxs::stringify;*{'version::(<=>'}=\&version::vxs::VCMP;*version::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;*STRICT=\$version::regex::STRICT;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;use vars qw($VERSION $CLASS $STRICT $LAX);$VERSION=0.9912;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]+/;my$STRICT_DECIMAL_VERSION=qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;my$STRICT_DOTTED_DECIMAL_VERSION=qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;$STRICT=qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;my$LAX_DECIMAL_VERSION=qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )? | $FRACTION_PART $LAX_ALPHA_PART? /x;my$LAX_DOTTED_DECIMAL_VERSION=qr/ v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )? | $LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART? /x;$LAX=qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_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;use vars qw($VERSION $CLASS @ISA $LAX $STRICT $WARN_CATEGORY);$VERSION=0.9912;$CLASS='version::vpp';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++}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){$orev=$rev;$rev += $s * $mult;$mult /= 10;if ((abs($orev)> abs($rev))|| (abs($rev)> $VERSION_MAX)){warn("Integer overflow in version %d",$VERSION_MAX);$s=$end - 1;$rev=$VERSION_MAX;$vinf=1}$s++;if ($s eq '_'){$s++}}}else {while (--$end >= $s){$orev=$rev;$rev += $end * $mult;$mult *= 10;if ((abs($orev)> abs($rev))|| (abs($rev)> $VERSION_MAX)){warn("Integer overflow in version");$end=$s - 1;$rev=$VERSION_MAX;$vinf=1}}}}push@av,$rev;if ($vinf){$s=$last;last}elsif ($pos eq '.'){$pos++;if ($qv){while ($pos eq '0'){$pos++}}$s=$pos}elsif ($pos eq '_' && isDIGIT($pos+1)){$s=++$pos}elsif ($pos eq ',' && isDIGIT($pos+1)){$s=++$pos}elsif (isDIGIT($pos)){$s=$pos}else {$s=$pos;last}if ($qv){while (isDIGIT($pos)){$pos++}}else {my$digits=0;while ((isDIGIT($pos)|| $pos eq '_')&& $digits < 3){if ($pos ne '_'){$digits++}$pos++}}}}if ($qv){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("Version string '%s' contains invalid data; " ."ignoring: '%s'",$value,$s)}return ($self)}*parse=\&new;sub numify {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}my$width=$self->{width}|| 3;my$alpha=$self->{alpha}|| "";my$len=$#{$self->{version}};my$digit=$self->{version}[0];my$string=sprintf("%d.",$digit);if ($alpha and warnings::enabled()){warnings::warn($WARN_CATEGORY,'alpha->numify() is lossy')}for (my$i=1 ;$i < $len ;$i++ ){$digit=$self->{version}[$i];if ($width < 3){my$denom=10**(3-$width);my$quot=int($digit/$denom);my$rem=$digit - ($quot * $denom);$string .= sprintf("%0".$width."d_%d",$quot,$rem)}else {$string .= sprintf("%03d",$digit)}}if ($len > 0){$digit=$self->{version}[$len];if ($alpha && $width==3){$string .= "_"}$string .= sprintf("%0".$width."d",$digit)}else {$string .= sprintf("000")}return$string}sub normal {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}my$alpha=$self->{alpha}|| "";my$qv=$self->{qv}|| "";my$len=$#{$self->{version}};my$digit=$self->{version}[0];my$string=sprintf("v%d",$digit);for (my$i=1 ;$i < $len ;$i++ ){$digit=$self->{version}[$i];$string .= sprintf(".%d",$digit)}if ($len > 0){$digit=$self->{version}[$len];if ($alpha){$string .= sprintf("_%0d",$digit)}else {$string .= sprintf(".%0d",$digit)}}if ($len <= 2){for ($len=2 - $len;$len!=0;$len-- ){$string .= sprintf(".%0d",0)}}return$string}sub stringify {my ($self)=@_;unless (_verify($self)){require Carp;Carp::croak("Invalid version object")}return exists$self->{original}? $self->{original}: exists$self->{qv}? $self->normal : $self->numify}sub vcmp {require UNIVERSAL;my ($left,$right,$swap)=@_;my$class=ref($left);unless (UNIVERSAL::isa($right,$class)){$right=$class->new($right)}if ($swap){($left,$right)=($right,$left)}unless (_verify($left)){require Carp;Carp::croak("Invalid version object")}unless (_verify($right)){require Carp;Carp::croak("Invalid version format")}my$l=$#{$left->{version}};my$r=$#{$right->{version}};my$m=$l < $r ? $l : $r;my$lalpha=$left->is_alpha;my$ralpha=$right->is_alpha;my$retval=0;my$i=0;while ($i <= $m && $retval==0){$retval=$left->{version}[$i]<=> $right->{version}[$i];$i++}if ($retval==0 && $l==$r && $left->{version}[$m]==$right->{version}[$m]&& ($lalpha || $ralpha)){if ($lalpha &&!$ralpha){$retval=-1}elsif ($ralpha &&!$lalpha){$retval=+1}}if ($retval==0 && $l!=$r){if ($l < $r){while ($i <= $r && $retval==0){if ($right->{version}[$i]!=0){$retval=-1}$i++}}else {while ($i <= $l && $retval==0){if ($left->{version}[$i]!=0){$retval=+1}$i++}}}return$retval}sub vbool {my ($self)=@_;return vcmp($self,$self->new("0"),1)}sub vnoop {require Carp;Carp::croak("operation not supported with version object")}sub is_alpha {my ($self)=@_;return (exists$self->{alpha})}sub qv {my$value=shift;my$class=$CLASS;if (@_){$class=ref($value)|| $value;$value=shift}$value=_un_vstring($value);$value='v'.$value unless$value =~ /(^v|\d+\.\d+\.\d)/;my$obj=$CLASS->new($value);return bless$obj,$class}*declare=\&qv;sub is_qv {my ($self)=@_;return (exists$self->{qv})}sub _verify {my ($self)=@_;if (ref($self)&& eval {exists$self->{version}}&& ref($self->{version})eq 'ARRAY'){return 1}else {return 0}}sub _is_non_alphanumeric {my$s=shift;$s=new charstar$s;while ($s){return 0 if isSPACE($s);return 1 unless (isALPHA($s)|| isDIGIT($s)|| $s =~ /[.-]/);$s++}return 0}sub _un_vstring {my$value=shift;if (length($value)>= 1 && $value !~ /[,._]/ && _is_non_alphanumeric($value)){my$tvalue;if ($] >= 5.008_001){$tvalue=_find_magic_vstring($value);$value=$tvalue if length$tvalue}elsif ($] >= 5.006_000){$tvalue=sprintf("v%vd",$value);if ($tvalue =~ /^v\d+(\.\d+)*$/){$value=$tvalue}}}return$value}sub _find_magic_vstring {my$value=shift;my$tvalue='';require B;my$sv=B::svref_2object(\$value);my$magic=ref($sv)eq 'B::PVMG' ? $sv->MAGIC : undef;while ($magic){if ($magic->TYPE eq 'V'){$tvalue=$magic->PTR;$tvalue =~ s/^v?(.+)$/v$1/;last}else {$magic=$magic->MOREMAGIC}}return$tvalue}sub _VERSION {my ($obj,$req)=@_;my$class=ref($obj)|| $obj;no strict 'refs';if (exists$INC{"$class.pm"}and not %{"$class\::"}and $] >= 5.008){require Carp;Carp::croak("$class defines neither package nor VERSION" ."--version check failed")}my$version=eval "\$$class\::VERSION";if (defined$version){local $^W if $] <= 5.008;$version=version::vpp->new($version)}if (defined$req){unless (defined$version){require Carp;my$msg=$] < 5.006 ? "$class version $req required--this is only version " : "$class does not define \$$class\::VERSION" ."--version check failed";if ($ENV{VERSION_DEBUG}){Carp::confess($msg)}else {Carp::croak($msg)}}$req=version::vpp->new($req);if ($req > $version){require Carp;if ($req->is_qv){Carp::croak(sprintf ("%s version %s required--"."this is only version %s",$class,$req->normal,$version->normal))}else {Carp::croak(sprintf ("%s version %s required--"."this is only version %s",$class,$req->stringify,$version->stringify))}}}return defined$version ? $version->stringify : undef}1; VERSION_VPP s/^ //mg for values %fatpacked; my $class = 'FatPacked::'.(0+\%fatpacked); no strict 'refs'; *{"${class}::files"} = sub { keys %{$_[0]} }; if ($] < 5.008) { *{"${class}::INC"} = sub { if (my $fat = $_[0]{$_[1]}) { my $pos = 0; my $last = length $fat; return (sub { return 0 if $pos == $last; my $next = (1 + index $fat, "\n", $pos) || $last; $_ .= substr $fat, $pos, $next - $pos; $pos = $next; return 1; }); } }; } else { *{"${class}::INC"} = sub { if (my $fat = $_[0]{$_[1]}) { open my $fh, '<', \$fat or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; return $fh; } return; }; } unshift @INC, bless \%fatpacked, $class; } # END OF FATPACK CODE use strict; use App::cpanminus::script; unless (caller) { my $app = App::cpanminus::script->new; $app->parse_options(@ARGV); exit $app->doit; } __END__ =head1 NAME cpanm - get, unpack build and install modules from CPAN =head1 SYNOPSIS cpanm Test::More # install Test::More cpanm MIYAGAWA/Plack-0.99_05.tar.gz # full distribution path cpanm http://example.org/LDS/CGI.pm-3.20.tar.gz # install from URL cpanm ~/dists/MyCompany-Enterprise-1.00.tar.gz # install from a local file cpanm --interactive Task::Kensho # Configure interactively cpanm . # install from local directory cpanm --installdeps . # install all the deps for the current directory cpanm -L extlib Plack # install Plack and all non-core deps into extlib cpanm --mirror http://cpan.cpantesters.org/ DBI # use the fast-syncing mirror cpanm --from https://cpan.metacpan.org/ Plack # use only the HTTPS mirror =head1 COMMANDS =over 4 =item (arguments) Command line arguments can be either a module name, distribution file, local file path, HTTP URL or git repository URL. Following commands will all work as you expect. cpanm Plack cpanm Plack/Request.pm cpanm MIYAGAWA/Plack-1.0000.tar.gz cpanm /path/to/Plack-1.0000.tar.gz cpanm http://cpan.metacpan.org/authors/id/M/MI/MIYAGAWA/Plack-0.9990.tar.gz cpanm git://github.com/plack/Plack.git Additionally, you can use the notation using C<~> and C<@> to specify version for a given module. C<~> specifies the version requirement in the L<CPAN::Meta::Spec> format, while C<@> pins the exact version, and is a shortcut for C<~"== VERSION">. cpanm Plack~1.0000 # 1.0000 or later cpanm Plack~">= 1.0000, < 2.0000" # latest of 1.xxxx cpanm Plack@0.9990 # specific version. same as Plack~"== 0.9990" The version query including specific version or range will be sent to L<MetaCPAN> to search for previous releases. The query will search for BackPAN archives by default, unless you specify C<--dev> option, in which case, archived versions will be filtered out. For a git repository, you can specify a branch, tag, or commit SHA to build. The default is C<master> cpanm git://github.com/plack/Plack.git@1.0000 # tag cpanm git://github.com/plack/Plack.git@devel # branch =item -i, --install Installs the modules. This is a default behavior and this is just a compatibility option to make it work like L<cpan> or L<cpanp>. =item --self-upgrade Upgrades itself. It's just an alias for: cpanm App::cpanminus =item --info Displays the distribution information in C<AUTHOR/Dist-Name-ver.tar.gz> format in the standard out. =item --installdeps Installs the dependencies of the target distribution but won't build itself. Handy if you want to try the application from a version controlled repository such as git. cpanm --installdeps . =item --look Download and unpack the distribution and then open the directory with your shell. Handy to poke around the source code or do manual testing. =item -h, --help Displays the help message. =item -V, --version Displays the version number. =back =head1 OPTIONS You can specify the default options in C<PERL_CPANM_OPT> environment variable. =over 4 =item -f, --force Force install modules even when testing failed. =item -n, --notest Skip the testing of modules. Use this only when you just want to save time for installing hundreds of distributions to the same perl and architecture you've already tested to make sure it builds fine. Defaults to false, and you can say C<--no-notest> to override when it is set in the default options in C<PERL_CPANM_OPT>. =item --test-only Run the tests only, and do not install the specified module or distributions. Handy if you want to verify the new (or even old) releases pass its unit tests without installing the module. Note that if you specify this option with a module or distribution that has dependencies, these dependencies will be installed if you don't currently have them. =item -S, --sudo Switch to the root user with C<sudo> when installing modules. Use this if you want to install modules to the system perl include path. Defaults to false, and you can say C<--no-sudo> to override when it is set in the default options in C<PERL_CPANM_OPT>. =item -v, --verbose Makes the output verbose. It also enables the interactive configuration. (See --interactive) =item -q, --quiet Makes the output even more quiet than the default. It only shows the successful/failed dependencies to the output. =item -l, --local-lib Sets the L<local::lib> compatible path to install modules to. You don't need to set this if you already configure the shell environment variables using L<local::lib>, but this can be used to override that as well. =item -L, --local-lib-contained Same with C<--local-lib> but with L<--self-contained> set. All non-core dependencies will be installed even if they're already installed. For instance, cpanm -L extlib Plack would install Plack and all of its non-core dependencies into the directory C<extlib>, which can be loaded from your application with: use local::lib '/path/to/extlib'; Note that this option does B<NOT> reliably work with perl installations supplied by operating system vendors that strips standard modules from perl, such as RHEL, Fedora and CentOS, B<UNLESS> you also install packages supplying all the modules that have been stripped. For these systems you will probably want to install the C<perl-core> meta-package which does just that. =item --self-contained When examining the dependencies, assume no non-core modules are installed on the system. Handy if you want to bundle application dependencies in one directory so you can distribute to other machines. =item --exclude-vendor Don't include modules installed under the 'vendor' paths when searching for core modules when the C<--self-contained> flag is in effect. This restores the behaviour from before version 1.7023 =item --mirror Specifies the base URL for the CPAN mirror to use, such as C<http://cpan.cpantesters.org/> (you can omit the trailing slash). You can specify multiple mirror URLs by repeating the command line option. You can use a local directory that has a CPAN mirror structure (created by tools such as L<OrePAN> or L<Pinto>) by using a special URL scheme C<file://>. If the given URL begins with `/` (without any scheme), it is considered as a file scheme as well. cpanm --mirror file:///path/to/mirror cpanm --mirror ~/minicpan # Because shell expands ~ to /home/user Defaults to C<http://www.cpan.org/>. =item --mirror-only Download the mirror's 02packages.details.txt.gz index file instead of querying the CPAN Meta DB. This will also effectively opt out sending your local perl versions to backend database servers such as CPAN Meta DB and MetaCPAN. Select this option if you are using a local mirror of CPAN, such as minicpan when you're offline, or your own CPAN index (a.k.a darkpan). =item --from, -M cpanm -M https://cpan.metacpan.org/ cpanm --from https://cpan.metacpan.org/ Use the given mirror URL and its index as the I<only> source to search and download modules from. It works similar to C<--mirror> and C<--mirror-only> combined, with a small difference: unlike C<--mirror> which I<appends> the URL to the list of mirrors, C<--from> (or C<-M> for short) uses the specified URL as its I<only> source to download index and modules from. This makes the option always override the default mirror, which might have been set via global options such as the one set by C<PERL_CPANM_OPT> environment variable. B<Tip:> It might be useful if you name these options with your shell aliases, like: alias minicpanm='cpanm --from ~/minicpan' alias darkpan='cpanm --from http://mycompany.example.com/DPAN' =item --mirror-index B<EXPERIMENTAL>: Specifies the file path to C<02packages.details.txt> for module search index. =item --cpanmetadb B<EXPERIMENTAL>: Specifies an alternate URI for CPAN MetaDB index lookups. =item --metacpan Prefers MetaCPAN API over CPAN MetaDB. =item --cpanfile B<EXPERIMENTAL>: Specified an alternate path for cpanfile to search for, when C<--installdeps> command is in use. Defaults to C<cpanfile>. =item --prompt Prompts when a test fails so that you can skip, force install, retry or look in the shell to see what's going wrong. It also prompts when one of the dependency failed if you want to proceed the installation. Defaults to false, and you can say C<--no-prompt> to override if it's set in the default options in C<PERL_CPANM_OPT>. =item --dev B<EXPERIMENTAL>: search for a newer developer release as well. Defaults to false. =item --reinstall cpanm, when given a module name in the command line (i.e. C<cpanm Plack>), checks the locally installed version first and skips if it is already installed. This option makes it skip the check, so: cpanm --reinstall Plack would reinstall L<Plack> even if your locally installed version is latest, or even newer (which would happen if you install a developer release from version control repositories). Defaults to false. =item --interactive Makes the configuration (such as C<Makefile.PL> and C<Build.PL>) interactive, so you can answer questions in the distribution that requires custom configuration or Task:: distributions. Defaults to false, and you can say C<--no-interactive> to override when it's set in the default options in C<PERL_CPANM_OPT>. =item --pp, --pureperl Prefer Pure perl build of modules by setting C<PUREPERL_ONLY=1> for MakeMaker and C<--pureperl-only> for Build.PL based distributions. Note that not all of the CPAN modules support this convention yet. =item --with-recommends, --with-suggests B<EXPERIMENTAL>: Installs dependencies declared as C<recommends> and C<suggests> respectively, per META spec. When these dependencies fail to install, cpanm continues the installation, since they're just recommendation/suggestion. Enabling this could potentially make a circular dependency for a few modules on CPAN, when C<recommends> adds a module that C<recommends> back the module in return. There's also C<--without-recommend> and C<--without-suggests> to override the default decision made earlier in C<PERL_CPANM_OPT>. Defaults to false for both. =item --with-develop B<EXPERIMENTAL>: Installs develop phase dependencies in META files or C<cpanfile> when used with C<--installdeps>. Defaults to false. =item --with-configure B<EXPERIMENTAL>: Installs configure phase dependencies in C<cpanfile> when used with C<--installdeps>. Defaults to false. =item --with-feature, --without-feature, --with-all-features B<EXPERIMENTAL>: Specifies the feature to enable, if a module supports optional features per META spec 2.0. cpanm --with-feature=opt_csv Spreadsheet::Read the features can also be interactively chosen when C<--interactive> option is enabled. C<--with-all-features> enables all the optional features, and C<--without-feature> can select a feature to disable. =item --configure-timeout, --build-timeout, --test-timeout Specify the timeout length (in seconds) to wait for the configure, build and test process. Current default values are: 60 for configure, 3600 for build and 1800 for test. =item --configure-args, --build-args, --test-args, --install-args B<EXPERIMENTAL>: Pass arguments for configure/build/test/install commands respectively, for a given module to install. cpanm DBD::mysql --configure-args="--cflags=... --libs=..." The argument is only enabled for the module passed as a command line argument, not dependencies. =item --scandeps B<DEPRECATED>: Scans the depencencies of given modules and output the tree in a text format. (See C<--format> below for more options) Because this command doesn't actually install any distributions, it will be useful that by typing: cpanm --scandeps Catalyst::Runtime you can make sure what modules will be installed. This command takes into account which modules you already have installed in your system. If you want to see what modules will be installed against a vanilla perl installation, you might want to combine it with C<-L> option. =item --format B<DEPRECATED>: Determines what format to display the scanned dependency tree. Available options are C<tree>, C<json>, C<yaml> and C<dists>. =over 8 =item tree Displays the tree in a plain text format. This is the default value. =item json, yaml Outputs the tree in a JSON or YAML format. L<JSON> and L<YAML> modules need to be installed respectively. The output tree is represented as a recursive tuple of: [ distribution, dependencies ] and the container is an array containing the root elements. Note that there may be multiple root nodes, since you can give multiple modules to the C<--scandeps> command. =item dists C<dists> is a special output format, where it prints the distribution filename in the I<depth first order> after the dependency resolution, like: GAAS/MIME-Base64-3.13.tar.gz GAAS/URI-1.58.tar.gz PETDANCE/HTML-Tagset-3.20.tar.gz GAAS/HTML-Parser-3.68.tar.gz GAAS/libwww-perl-5.837.tar.gz which means you can install these distributions in this order without extra dependencies. When combined with C<-L> option, it will be useful to replay installations on other machines. =back =item --save-dists Specifies the optional directory path to copy downloaded tarballs in the CPAN mirror compatible directory structure i.e. I<authors/id/A/AU/AUTHORS/Foo-Bar-version.tar.gz> If the distro tarball did not come from CPAN, for example from a local file or from GitHub, then it will be saved under I<vendor/Foo-Bar-version.tar.gz>. =item --uninst-shadows Uninstalls the shadow files of the distribution that you're installing. This eliminates the confusion if you're trying to install core (dual-life) modules from CPAN against perl 5.10 or older, or modules that used to be XS-based but switched to pure perl at some version. If you run cpanm as root and use C<INSTALL_BASE> or equivalent to specify custom installation path, you SHOULD disable this option so you won't accidentally uninstall dual-life modules from the core include path. Defaults to true if your perl version is smaller than 5.12, and you can disable that with C<--no-uninst-shadows>. B<NOTE>: Since version 1.3000 this flag is turned off by default for perl newer than 5.12, since with 5.12 @INC contains site_perl directory I<before> the perl core library path, and uninstalling shadows is not necessary anymore and does more harm by deleting files from the core library path. =item --uninstall, -U Uninstalls a module from the library path. It finds a packlist for given modules, and removes all the files included in the same distribution. If you enable local::lib, it only removes files from the local::lib directory. If you try to uninstall a module in C<perl> directory (i.e. core module), an error will be thrown. A dialog will be prompted to confirm the files to be deleted. If you pass C<-f> option as well, the dialog will be skipped and uninstallation will be forced. =item --cascade-search B<EXPERIMENTAL>: Specifies whether to cascade search when you specify multiple mirrors and a mirror doesn't have a module or has a lower version of the module than requested. Defaults to false. =item --skip-installed Specifies whether a module given in the command line is skipped if its latest version is already installed. Defaults to true. B<NOTE>: The C<PERL5LIB> environment variable have to be correctly set for this to work with modules installed using L<local::lib>, unless you always use the C<-l> option. =item --skip-satisfied B<EXPERIMENTAL>: Specifies whether a module (and version) given in the command line is skipped if it's already installed. If you run: cpanm --skip-satisfied CGI DBI~1.2 cpanm won't install them if you already have CGI (for whatever versions) or have DBI with version higher than 1.2. It is similar to C<--skip-installed> but while C<--skip-installed> checks if the I<latest> version of CPAN is installed, C<--skip-satisfied> checks if a requested version (or not, which means any version) is installed. Defaults to false. =item --verify Verify the integrity of distribution files retrieved from PAUSE using CHECKSUMS and SIGNATURES (if found). Defaults to false. =item --report-perl-version Whether it reports the locally installed perl version to the various web server as part of User-Agent. Defaults to true unless CI related environment variables such as C<TRAVIS>, C<CI> or C<AUTOMATED_TESTING> is enabled. You can disable it by using C<--no-report-perl-version>. =item --auto-cleanup Specifies the number of days in which cpanm's work directories expire. Defaults to 7, which means old work directories will be cleaned up in one week. You can set the value to C<0> to make cpan never cleanup those directories. =item --man-pages Generates man pages for executables (man1) and libraries (man3). Defaults to true (man pages generated) unless C<-L|--local-lib-contained> option is supplied in which case it's set to false. You can disable it with C<--no-man-pages>. =item --lwp Uses L<LWP> module to download stuff over HTTP. Defaults to true, and you can say C<--no-lwp> to disable using LWP, when you want to upgrade LWP from CPAN on some broken perl systems. =item --wget Uses GNU Wget (if available) to download stuff. Defaults to true, and you can say C<--no-wget> to disable using Wget (versions of Wget older than 1.9 don't support the C<--retry-connrefused> option used by cpanm). =item --curl Uses cURL (if available) to download stuff. Defaults to true, and you can say C<--no-curl> to disable using cURL. Normally with C<--lwp>, C<--wget> and C<--curl> options set to true (which is the default) cpanm tries L<LWP>, Wget, cURL and L<HTTP::Tiny> (in that order) and uses the first one available. =back =head1 ENVIRONMENT VARIABLES =over 4 =item PERL_CPANM_HOME The directory cpanm should use to store downloads and build and test modules. Defaults to the C<.cpanm> directory in your user's home directory. =item PERL_CPANM_OPT If set, adds a set of default options to every cpanm command. These options come first, and so are overridden by command-line options. =back =head1 SEE ALSO L<App::cpanminus> =head1 COPYRIGHT Copyright 2010- Tatsuhiko Miyagawa. =head1 AUTHOR Tatsuhiko Miyagawa =cut CPANM if (@ARGV and $ARGV[0] eq "--spiner") { shift @ARGV; my $cpanm = $INLINE_CPANM; $cpanm =~ s/^ //mg; $cpanm =~ s/\Qunless (caller)/if (1)/; warn "Running packed cpanm\n"; eval $cpanm; die $@ if $@; exit 0; } } local *App::plx::find_cpanm = sub { return ($0, "--spiner") unless $0 eq "-"; require File::Temp; # the tempfile will get unlinked when the local of this sub vanishes use feature state; state $tempfile = do { my $fh = File::Temp->new; my $cpanm = $INLINE_CPANM; $cpanm =~ s/^ //mg; print $fh $cpanm; close $fh; $fh; }; return ($tempfile->filename); }; #!perl package App::plx; our $VERSION = '0.902003'; # 0.902.3 $VERSION = eval $VERSION; use strict; use warnings; use File::Spec; use File::Basename (); use Cwd (); use lib (); use Config; use File::Which (); use List::Util (); use local::lib (); BEGIN { our %orig_env = %ENV; { local $0 = $0 eq '-' ? 'plx' : $0; local::lib->import('--deactivate-all') } delete @ENV{grep /^PERL/, keys %ENV} } no lib @Config{qw(sitearch sitelibexp)}; my $fs = 'File::Spec'; my $self = do { package Perl::Layout::Executor::_self; sub self { package DB; () = caller(2); $DB::args[0] } use overload '%{}' => sub { self }, fallback => 1; sub AUTOLOAD { my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/); self->$meth(@_[1..$#_]); } sub DESTROY {} bless([], __PACKAGE__); }; sub barf { die "$_[0]\n" } sub stderr { warn "$_[0]\n" } sub say { print "$_[0]\n" } sub new { my $class = shift; bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class; } sub layout_base_dir { $self->{layout_base_dir} //= $self->_build_layout_base_dir } sub layout_perl { $self->{layout_perl} //= $self->_build_layout_perl } sub _build_layout_base_dir { my @parts = $fs->splitdir(Cwd::realpath(Cwd::getcwd())); my $cand; my $reason = ''; while (@parts > 1) { # go back to one step before root at most $cand = $fs->catdir(@parts); return $cand if -d $fs->catdir($cand, '.plx'); if (-d $fs->catdir($cand, '.git')) { # don't escape current repository $reason = ' due to .git directory'; last; } pop @parts; } barf "Couldn't find .plx directory (stopped searching at ${cand}${reason})"; } sub _build_layout_perl { my $perl_bin = $self->read_config_entry('perl'); unless ($perl_bin) { my $perl_spec = $self->read_config_entry('perl.spec'); barf "No perl and no perl.spec in config" unless $perl_spec; $self->run_config_perl_set($perl_spec); $perl_bin = $self->read_config_entry('perl'); barf "Rehydration of perl from perl.spec failed" unless $perl_bin; } barf "perl binary ${perl_bin} not executable" unless -x $perl_bin; return $perl_bin; } sub layout_libspec_config { [ grep $_->[1], map [ $_, $self->read_config_entry([ libspec => $_ ]) ], $self->list_config_names('libspec') ]; } sub layout_lib_specs { my $base_dir = $self->layout_base_dir; local *_ = sub { Cwd::realpath($fs->rel2abs(shift, $base_dir)) }; [ map [ ($_->[0] =~ /\.([^.]+)$/), _($_->[1]) ], @{$self->layout_libspec_config} ]; } sub layout_file { my ($self, @path) = @_; $fs->catfile($self->layout_base_dir, @path); } sub layout_dir { my ($self, @path) = @_; $fs->catdir($self->layout_base_dir, @path); } sub ensure_layout_config_dir { barf ".plx directory does not exist" unless -d $self->layout_dir('.plx'); my $format = $self->read_config_entry('format'); barf ".plx directory has no format specifier" unless $format; barf ".plx format ${format} unknown" unless $format eq '1'; } sub layout_config_file { shift->layout_file('.plx', @_) } sub layout_config_dir { shift->layout_dir('.plx', @_) } sub write_config_entry { my ($self, $path, $value) = @_; my $file = $self->layout_config_file(ref($path) ? @$path : $path); open my $wfh, '>', $file or die "Couldn't open ${file}: $!"; print $wfh "${value}\n"; } sub clear_config_entry { my ($self, $path) = @_; my $file = $self->layout_config_file(ref($path) ? @$path : $path); unlink($file) or barf "Failed to unlink ${file}: $!" if -e $file; } sub read_config_entry { my ($self, $path) = @_; my $file = $self->layout_config_file(ref($path) ? @$path : $path); return undef unless -f $file; open my $rfh, '<', $file or die "Couldn't open ${file}: $!"; chomp(my $value = <$rfh>); return $value; } sub list_config_names { my ($self, $path) = @_; my $dir = $self->layout_config_dir(ref($path) ? @$path : $path); return () unless -d $dir; opendir my($dh), $dir or die "Couldn't opendir ${dir}: $!"; return grep -f $fs->catfile($dir, $_), sort readdir($dh); } sub slurp_command { my ($self, @cmd) = @_; open my $slurp_fh, '-|', @cmd or barf "Failed to start command (".join(' ', @cmd)."): $!"; chomp(my @slurp = <$slurp_fh>); return @slurp; } sub prepend_env { my ($self, $env, @parts) = @_; $ENV{$env} = join(':', @parts, $ENV{$env}||()); } sub setup_env_for_ll { my ($self, $path) = @_; local $0 = $0 eq '-' ? 'plx' : $0; local::lib->import($path); } sub setup_env_for_dir { my ($self, $path) = @_; $self->prepend_env(PERL5LIB => $path); } sub setup_env { $ENV{PERL_PLX_BASE} = $self->layout_base_dir; my ($site_libs) = $self->slurp_command( $self->layout_perl, '-MConfig', '-e', 'print join(",", @Config{qw(sitearch sitelibexp)})' ); $ENV{PERL5OPT} = '-M-lib='.$site_libs; $ENV{$_} = $self->read_config_entry([ env => $_ ]) for $self->list_config_names('env'); my $perl_dirname = File::Basename::dirname($self->layout_perl); our %orig_env; unless (grep $_ eq $perl_dirname, split ':', $orig_env{PATH}) { $self->prepend_env(PATH => $perl_dirname); } foreach my $lib_spec (@{$self->layout_lib_specs}) { my ($type, $path) = @$lib_spec; next unless $path and -d $path; $self->${\"setup_env_for_${type}"}($path); } return; } sub cmd_search_path { qw(.plx/cmd dev bin) } sub run_action_commands { my ($self, $filter) = @_; $self->ensure_layout_config_dir; my @commands; my %seen; foreach my $dirname ($self->cmd_search_path) { next unless -d (my $dir = $self->layout_dir($dirname)); opendir my ($dh), $dir or barf "Couldn't open ${dir}: $!"; foreach my $entry (sort readdir($dh)) { next if $entry =~ /^\.+$/; my $file = $self->layout_file($dirname, $entry); next unless -f $file; unless ($seen{$entry}++) { push @commands, [ $entry, "${dirname}/${entry}" ]; } } } my $path = do { local $ENV{PATH} = ''; $self->setup_env; $ENV{PATH} }; foreach my $dir (split ':', $path) { opendir my ($dh), $dir; foreach my $entry (sort readdir($dh)) { next if $entry =~ /^\.+$/; my $file = $fs->catfile($dir, $entry); next unless -x $file; push @commands, [ $entry, $file ] unless $seen{$entry}++; } } if ($filter) { my $match = $filter =~ m{^/(.+)/$} ? $1 : qr/^\Q${filter}/; @commands = grep { $_->[0] =~ $match } @commands; } my $max = List::Util::max(map length($_->[0]), @commands); my $base = $self->layout_base_dir; my $home = $ENV{HOME}; foreach my $command (@commands) { my ($name, $path) = @$command; $path =~ s/^\Q${base}\///; $path =~ s/^\Q${home}/~/ if $home; say sprintf("%-${max}s %s", $name, $path); } } sub run_action_bareinit { my ($self, $perl) = @_; my $dir = $fs->catdir($self->{layout_base_dir}||Cwd::getcwd(), '.plx'); if (-d $dir) { if ($perl) { stderr <<END; .plx already initialised - if you wanted to set the perl to ${perl} run: plx --config perl set ${perl} END } return; } mkdir($dir) or barf "Couldn't create ${dir}: $!"; $self->run_config_perl_set($perl||'perl'); $self->write_config_entry(format => 1); } sub run_action_userinit { my ($self, @args) = @_; my @perl = ( (@args and !ref($args[0]) and $args[0] ne '[') ? shift(@args) : () ); barf "--userinit requires \$HOME to be set" unless $ENV{HOME}; $self->run_action_base( $ENV{HOME}, '--multi' => [ '--bareinit', @perl ], [ qw(--config libspec add 25.perl5.ll perl5) ], (@args ? [ '--multi', @args ] : ()), ); } sub run_action_userstrap { my ($self, @args) = @_; my @perl = ( (@args and !ref($args[0]) and $args[0] ne '[') ? shift(@args) : () ); $self->run_action_userinit( @perl, [ '--installself' ], [ '--installenv' ], @args ); } sub run_action_installself { my $last_ll; foreach my $lib_spec (@{$self->layout_lib_specs}) { my ($type, $path) = @$lib_spec; $last_ll = $path if $type eq 'll'; } barf "No local::lib in libspec config" unless $last_ll; $self->run_action_cpanm( "-l${last_ll}", '-n', qw(App::cpanminus App::plx) ); } sub run_action_installenv { $self->ensure_layout_config_dir; barf "--installenv action currently assumes bash" unless $ENV{SHELL} =~ /bash/; barf "Couldn't find .bashrc" unless -f (my $bashrc = $fs->catfile($ENV{HOME}, ".bashrc")); my $plx_bin = do { local %ENV = our %orig_env; File::Which::which('plx-packed'); } || do { local %ENV = %ENV; $self->setup_env; File::Which::which('plx-packed'); }; barf "Couldn't find plx in PATH" unless $plx_bin; { open my $fh, '<', $bashrc or die "Couldn't open ${bashrc} to read: $!"; if (my ($line) = grep /plx-packed/, <$fh>) { chomp($line); stderr("Found line in .bashrc: $line"); return; } } my $base = $self->layout_base_dir; stderr("Appending to .bashrc"); open my $fh, '>>', $bashrc or die "Couldn't open ${bashrc} to append: $!"; print $fh "\neval \$(${plx_bin} --base ${base} --env)\n"; } sub run_action_init { my ($self, $perl) = @_; $self->run_action_bareinit($perl); my $libspec_dir = $self->layout_config_dir('libspec'); mkdir($libspec_dir) or barf "Couldn't create ${libspec_dir}: $!"; $self->run_config_libspec_add(@$_) for ( [ '25-local.ll' => 'local' ], [ '50-devel.ll' => 'devel' ], [ '75-lib.dir' => 'lib' ], ); } sub _which { my ($self, @args) = @_; $self->ensure_layout_config_dir; my @env; push @env, shift @args while $args[0] =~ /^\w+=/; my $cmd = shift @args; barf "--cmd <cmd> <args>" unless $cmd; if ($fs->file_name_is_absolute($cmd)) { return (exec => @env => $cmd => @args); } if ($cmd eq 'perl') { return (perl => @env => @args); } if ($cmd =~ m{/}) { return (perl => @env => $cmd, @args); } if ($cmd =~ /^-/) { my @optargs = ($cmd, @args); foreach my $optarg (@optargs) { next if $optarg =~ /^-/; foreach my $dirname ($self->cmd_search_path) { if (-f (my $file = $self->layout_file($dirname => $optarg))) { $optarg = $file; last; } } last; } return (perl => @env => @optargs); } foreach my $dirname ($self->cmd_search_path) { if (-f (my $file = $self->layout_file($dirname => $cmd))) { return (perl => @env => $file, @args); } } return (exec => @env => $cmd, @args); } sub run_action_which { my ($self, @args) = @_; my ($action, @call) = $self->_which(@args); say join(' ', 'plx', "--${action}", @call); } sub run_action_cmd { my ($self, @args) = @_; my ($action, @call) = $self->_which(@args); $self->${\"run_action_${action}"}(@call); } sub run_action_perl { my ($self, @call) = @_; $self->ensure_layout_config_dir; return $self->show_config_perl unless @call; my @env; push @env, shift @call while $call[0] =~ /^\w+=/; $self->run_action_exec(@env, $self->layout_perl, @call); } sub run_action_exec { my ($self, @exec) = @_; $self->ensure_layout_config_dir; $self->setup_env; shift @exec and $ENV{$1} = $2 while $exec[0] =~ /^(\w+)=(.*)$/; exec(@exec) or barf "exec of (".join(' ', @exec).") failed: $!"; } sub find_cpanm { local %ENV = our %orig_env; barf "Couldn't find cpanm in \$PATH" unless my $cpanm = File::Which::which('cpanm'); $cpanm; } sub run_action_cpanm { my ($self, @args) = @_; $self->ensure_layout_config_dir; my @cpanm = $self->find_cpanm; unless (@args and $args[0] =~ /^-[lL]/) { barf "--cpanm args must start with -l or -L to specify target local::lib"; } $self->setup_env; system($self->layout_perl, @cpanm, @args); } sub run_action_config { my ($self, $config, @args) = @_; $self->ensure_layout_config_dir; unless ($config) { say "# perl"; $self->show_config_perl; say "# libspec"; $self->show_config_libspec; if ($self->list_config_names('env')) { say "# env"; $self->show_config_env; } return; } barf "Unknown config key ${config}" unless my $show = $self->can("show_config_${config}"); return $self->$show unless @args; if (my $code = $self->can("run_config_${config}")) { return $self->$code(@args); } my ($subcmd, @rest) = @args; barf "Invalid subcommand ${subcmd} for config key ${config}" unless my $code = $self->can("run_config_${config}_${subcmd}"); return $self->$code(@rest); } sub show_config_perl { say $self->layout_perl } sub resolve_perl_via_perlbrew { my ($self, $perl) = @_; stderr "Resolving perl '${perl}' via perlbrew"; local %ENV = our %orig_env; barf "Couldn't find perlbrew in \$PATH" unless my $perlbrew = File::Which::which('perlbrew'); my @list = $self->slurp_command($perlbrew, 'list'); barf join( "\n", "No such perlbrew perl '${perl}', choose from:\n", @list, '' ) unless grep $_ eq $perl, map /(\S+)/, @list; my ($perl_path) = $self->slurp_command( $perlbrew, qw(exec --with), $perl, qw(perl -e), 'print $^X' ); return $perl_path; } sub run_config_perl_set { my ($self, $new_perl) = @_; barf "plx --config perl set <perl>" unless $new_perl; my $perl_spec = $new_perl; unless ($new_perl =~ m{/}) { $new_perl = "perl${new_perl}" if $new_perl =~ /^5/; $new_perl =~ s/perl-5/perl5/; # perlbrew name to perl binary require File::Which; stderr "Resolving perl '${new_perl}' via PATH"; if (my $resolved = File::Which::which($new_perl)) { $new_perl = $resolved; } else { $new_perl =~ s/^perl5/perl-5/; # perl binary to perlbrew name $new_perl = $self->resolve_perl_via_perlbrew($new_perl); } } barf "Not executable: $new_perl" unless -x $new_perl; $self->write_config_entry('perl.spec' => $perl_spec); $self->write_config_entry(perl => $new_perl); } sub show_config_libspec { my @ent = @{$self->layout_libspec_config}; my $max = List::Util::max(map length($_->[0]), @ent); say sprintf("%-${max}s %s", @$_) for @ent; } sub run_named_config_add { my ($self, $type, $name, $value) = @_; barf "plx --config ${type} add <name> <value>" unless $name and defined($value); unless (-d (my $dir = $self->layout_config_dir($type))) { mkdir($dir) or die "Couldn't make config dir ${dir}: $!"; } $self->write_config_entry([ $type => $name ], $value); } sub run_named_config_del { my ($self, $type, $name) = @_; barf "plx --config ${type} dev <name>" unless $name; $self->clear_config_entry([ $type => $name ]); } sub run_config_libspec_add { shift->run_named_config_add(libspec => @_) } sub run_config_libspec_del { shift->run_named_config_del(libspec => @_) } sub show_config_env { my $max = List::Util::max( map length, my @names = $self->list_config_names('env') ); say sprintf("%-${max}s %s", $_, $self->read_config_entry([ env => $_ ])) for @names; } sub run_config_env_add { shift->run_named_config_add(env => @_) } sub run_config_env_del { shift->run_named_config_del(env => @_) } sub show_env { my ($self, $env) = @_; $self->ensure_layout_config_dir; local $ENV{$env} = ''; $self->setup_env; say $_ for split ':', $ENV{$env}; } sub run_action_libs { $self->show_env('PERL5LIB') } sub run_action_paths { $self->show_env('PATH') } sub run_action_env { $self->ensure_layout_config_dir; $self->setup_env; my @env_change; our %orig_env; foreach my $key (sort(keys %{{ %orig_env, %ENV }})) { my ($oval, $eval) = ($orig_env{$key}, $ENV{$key}); if (!defined($eval) or ($oval//'') ne $eval) { push @env_change, [ $key, $eval ]; } } my $shelltype = local::lib->guess_shelltype; my $shellbuild = "build_${shelltype}_env_declaration"; foreach my $change (@env_change) { print +local::lib->$shellbuild(@$change); } } sub run_action_help { require Pod::Usage; Pod::Usage::pod2usage(); } sub run_action_version { say sprintf "%f", $VERSION; } sub run_action_base { my ($self, $base, @chain) = @_; unless ($base) { say $self->layout_base_dir; return; } barf "--base <base> <action> <args>" unless @chain; $self->new({ layout_base_dir => $base })->run(@chain); } sub _parse_multi { my ($self, @args) = @_; my @multi; MULTI: while (@args) { barf "Expected multi arg [, got: $args[0]" unless $args[0] eq '['; shift @args; my @action; while (my $el = shift @args) { push @multi, \@action and next MULTI if $el eq ']'; push @action, $el; } barf "Missing closing ] for multi"; } return @multi; } sub run_action_multi { my ($self, @args) = @_; return $self->run_multi(@args) if @args and ref($args[0]); my @multi = $self->_parse_multi(@args); $self->run_multi(@multi); } sub run_multi { my ($self, @multi) = @_; foreach my $multi (@multi) { my @debug_multi = map +(ref($_) ? ('[', @$_, ']') : $_), @$multi; stderr '# '.join(' ', plx => @debug_multi); $self->run(@$multi); } } sub run_action_showmulti { my ($self, @args) = @_; my @multi = $self->_parse_multi(@args); say join(' ', plx => @$_) for @multi; } sub run { my ($self, $cmd, @args) = @_; $cmd ||= '--help'; if ($cmd eq '[') { return $self->run_action_multi($cmd, @args); } if ($cmd =~ s/^--//) { if ($cmd) { my $method = join('_', 'run_action', split '-', $cmd); if (my $code = $self->can($method)) { return $self->$code(@args); } barf "No such action --${cmd}, see 'perldoc plx' for the full list"; } $cmd = shift @args; } $self->ensure_layout_config_dir; return $self->run_action_cmd($cmd, @args); } caller() ? 1 : __PACKAGE__->new->run(@ARGV); =head1 NAME App::plx - Perl Layout Executor =head1 SYNOPSIS plx --help # This output plx --init <perl> # Initialize layout config plx --perl # Show layout perl binary plx --libs # Show layout $PERL5LIB entries plx --paths # Show layout additional $PATH entries plx --env # Show layout env var changes plx --cpanm -llocal --installdeps . # Run cpanm from outside $PATH plx perl <args> # Run perl within layout plx -E '...' # (ditto) plx script-in-dev <args> # Run dev/ script within layout plx script-in-bin <args> # Run bin/ script within layout plx ./script <args> # Run script within layout plx script/in/cwd <args> # (ditto) plx program <args> # Run program from layout $PATH =head1 WHY PLX While perl has many tools for configuring per-project development environments, using them can still be a little on the lumpy side. With L<Carton>, you find yourself running one of perl -Ilocal/lib/perl -Ilib bin/myapp carton exec perl -Ilib bin/myapp With L<App::perlbrew>, perlbrew switch perl-5.28.0@libname perl -Ilib bin/myapp With L<https://github.com/tokuhirom/plenv>, plenv exec perl -Ilib bin/myapp and if you have more than one distinct layer of dependencies, while L<local::lib> will happily handle that, integrating it with everything else becomes a pain in the buttocks. As a result of this, your not-so-humble author found himself regularly having a miniature perl executor script at the root of git clones that looked something like: #!/bin/sh eval $(perl -Mlocal::lib=--deactivate-all) export PERL5LIB=$PWD/local/lib/perl5 bin=$1 shift ~/perl5/perlbrew/perls/perl-5.28.0/bin/$bin "$@" and then running: ./pl perl -Ilib bin/myapp However, much like back in 2007 frustration with explaining to other developers how to set up L<CPAN> to install into C<~/perl5> and how to set up one's environment variables to then find the modules so installed led to the exercise in rage driven development that first created L<local::lib>, walking newbies through the creation and subsequent use of such a script was not the most enjoyable experience for anybody involved. Thus, the creation of this module to reduce the setup process to: cpanm App::plx cd MyProject plx --init 5.28.0 plx --cpanm -llocal --notest --installdeps . Follwed by being able to immediately (and even more concisely) run: plx myapp which will execute C<perl -Ilib bin/myapp> with the correct C<perl> and the relevant L<local::lib> already in scope. If this seems of use to you, the L</QUICKSTART> is next and the L</ACTIONS> section of this document lists the full capabilities of plx. Onwards! =head1 QUICKSTART Let's assume we're going to be working on Foo-Bar, so we start with: git clone git@github.com:arthur-nonymous/Foo-Bar.git cd Foo-Bar Assuming the perl we'd get from running just C<perl> suffices, then we next run: plx --init If we want a different perl - say, we have a C<perl5.30.1> in our path, or a C<perl-5.30.1> built in perlbrew, we'd instead run: plx --init 5.30.1 To quickly get our dependencies available, we then run: plx --cpanm -llocal --notest --installdeps . If the project is designed to use L<Carton> and has a C<cpanfile.snapshot>, instead we would run: plx --cpanm -ldevel --notest Carton plx carton install If the goal is to test this against our current development version of another library, then we'd also want to run: plx --config libspec add 40otherlib.dir ../Other-Lib/lib If we want our ~/perl L<local::lib> available within the plx environment, we can add that as the least significant libspec with: plx --config libspec add 00tilde.ll $HOME/perl5 At which point, we're ready to go, and can run: plx myapp # to run bin/myapp plx t/foo.t # to run one test file plx prove # to run all t/*.t test files plx -E 'say for @INC' # to run a one liner within the layout To learn everything else plx is capable of, read on to the L</ACTIONS> section coming next. Have fun! =head1 BOOTSTRAP Under normal circumstances, one would run something like: cpanm App::plx However, if you want a self-contained plx script without having a cpan installer available, you can run: mkdir bin wget https://raw.githubusercontent.com/shadowcat-mst/plx/master/bin/plx-packed -O bin/plx to get the current latest packed version. The packed version bundles L<local::lib> and L<File::Which>, and also includes a modified C<--cpanm> action that uses an inline C<App::cpanminus>. =head1 ENVIRONMENT C<plx> actions that execute external commands all clear any existing environment variables that start with C<PERL> to keep an encapsulated setup for commands being run within the layouts - and also set C<PERL5OPT> to exclude C<site_perl> (but not C<vendor_perl>) to avoid locally installed modules causing unexpected effects. Having done so, C<plx> then loads each env config entry and sets those variables - then prepends the C<plx> specific entries to both C<PATH> and C<PERL5LIB>. You can add env config entries with L</--config>: plx --config env add NAME VALUE The changes that will be made to your environment can be output by calling the L</--env> command. Additionally, environment variable overrides may be provided to the L</--cmd>, L</--exec> and L</--perl> commands by providing them in C<NAME=VALUE> format: # do not do this, it will be deleted PERL_RL=Perl5 plx <something> # do this instead, it will provide the environment variable to the command plx PERL_RL=Perl5 <something> =head1 ACTIONS plx --help # Print synopsis plx --version # Print plx version plx --init <perl> # Initialize layout config for . plx --bareinit <perl> # Initialize bare layout config for . plx --base # Show layout base dir plx --base <base> <action> <args> # Run action with specified base dir plx --perl # Show layout perl binary plx --libs # Show layout $PERL5LIB entries plx --paths # Show layout additional $PATH entries plx --env # Show layout env var changes plx --cpanm -llocal --installdeps . # Run cpanm from outside $PATH plx --config perl # Show perl binary plx --config perl set /path/to/perl # Select exact perl binary plx --config perl set perl-5.xx.y # Select perl via $PATH or perlbrew plx --config libspec # Show lib specifications plx --config libspec add <name> <path> # Add lib specification plx --config libspec del <name> <path> # Delete lib specification plx --config env # Show additional env vars plx --config env add <name> <path> # Add env var plx --config env del <name> <path> # Delete env var plx --exec <cmd> <args> # exec()s with env vars set plx --perl <args> # Run perl with args plx --cmd <cmd> <args> # DWIM command: cmd = perl -> --perl <args> cmd = -<flag> -> --perl -<flag> <args> cmd = some/file -> --perl some/file <args> cmd = ./file -> --perl ./file <args> cmd = name -> exists .plx/cmd/<name> -> --perl .plx/cmd/<name> <args> exists dev/<name> -> --perl dev/<name> <args> exists bin/<name> -> --perl bin/<name> <args> else -> --exec <name> <args> plx --which <cmd> # Expands --cmd <cmd> without running plx <something> <args> # Shorthand for plx --cmd plx --commands <filter>? # List available commands plx --multi [ <cmd1> <args1> ] [ ... ] # Run multiple actions plx --showmulti [ ... ] [ ... ] # Show multiple action running plx [ ... ] [ ... ] # Shorthand for plx --multi plx --userinit <perl> # Init ~/.plx with ~/perl5 ll plx --installself # Installs plx and cpanm into layout plx --installenv # Appends plx --env call to .bashrc plx --userstrap <perl> # userinit+installself+installenv =head2 --help Prints out the usage information (i.e. the L</SYNOPSIS>) for plx. =head2 --init plx --init # resolve 'perl' in $PATH plx --init perl # (ditto) plx --init 5.28.0 # looks for perl5.28.0 in $PATH # or perl-5.28.0 in perlbrew plx --init /path/to/some/perl # uses the absolute path directly Initializes the layout. If a perl name is passed, attempts to resolve it via C<$PATH> and C<perlbrew> and sets the result as the layout perl; if not looks for just C<perl>. Creates the following libspec config: 25-local.ll local 50-devel.ll devel 75-lib.dir lib =head2 --bareinit Identical to C<--init> but creates no default configs except for C<perl>. =head2 --base plx --base plx --base <base> <action> <args> Without arguments, shows the selected base dir - C<plx> finds this by checking for a C<.plx> directory in the current directory, and if not tries the parent directory, recursively. The search stops either when C<plx> finds a C<.git> directory, to avoid accidentally escaping a project repository, or at the last directory before the root - i.e. C<plx> will test C</home> but not C</>. With arguments, specifies a base dir to use, and then invokes the rest of the arguments with that base dir selected - so for example one can make a default configuration in C<$HOME> available as C<plh> by running: plx --init $HOME alias plh='plx --base $HOME' =head2 --libs Prints the directories that will be added to C<PERL5LIB>, one per line. These will include the C<lib/perl5> subdirectory for each C<ll> entry in the libspecs, and the directory for each C<dir> entry. =head2 --paths Prints the directories that will be added to C<PATH>, one per line. These will include the containing directory of the environment's perl binary if not already in C<PATH>, followed by the C<bin> directories of any C<ll> entries in the libspecs. =head2 --env Prints the changes that will be made to your environment variables, in a syntax that is (hopefully) correct for your current shell. =head2 --cpanm plx --cpanm -Llocal --installdeps . plx --cpanm -ldevel App::Ack Finds the C<cpanm> binary in the C<PATH> that C<plx> was executed I<from>, and executes it using the layout's perl binary and environment variables. Requires the user to specify a L<local::lib> to install into via C<-l> or C<-L> in order to avoid installing modules into unexpected places. Note that this action exists primarily for bootstrapping, and if you want to use a different installer such as L<App::cpm>, you'd install it with: plx --cpanm -ldevel App::cpm and then subsequently run e.g. plx cpm install App::Ack to install modules. =head2 --exec plx --exec <command> <args> Sets up the layout's environment variables and C<exec>s the command. =head2 --perl plx --perl plx --perl <options> <script> <args> Without arguments, sugar for C<--config perl>. Otherwise, sets up the layout's environment variables and C<exec>s the layout's perl with the given options and arguments. =head2 --cmd plx --cmd <cmd> <args> cmd = perl -> --perl <args> cmd = -<flag> -> --perl -<flag> <args> cmd = some/file -> --perl some/file <args> cmd = ./file -> --perl ./file <args> cmd = name -> exists .plx/cmd/<name> -> --perl .plx/cmd/<name> <args> exists dev/<name> -> --perl dev/<name> <args> exists bin/<name> -> --perl bin/<name> <args> else -> --exec <name> <args> B<Note>: Much like the C<devel> L<local::lib> is created to allow for the installation of out-of-band dependencies that aren't going to be needed in production, the C<dev> directory is supported to allow for the easy addition of development time only sugar commands. Note that since C<perl> will re-exec anything with a non-perl shebang, one can add wrappers here ala: $ cat dev/prove #!/bin/sh exec prove -j8 "$@" =head2 --which plx --which <cmd> Outputs the expanded form of a C<--cmd> invocation without running it. =head2 --config plx --config # Show current config plx --config <name> # Show current <name> config plx --config <name> <operation> # Invoke config operation =head3 perl plx --config perl plx --config perl set <spec> If the spec passed to C<set> contains a C</> character, plx assumes that it's an absolute bath and records it as-is. If not, we go a-hunting. First, if the spec begins with a C<5>, we replace it with C<perl5>. Second, we search C<$PATH> for a binary of that name, and record it if so. Third, if the (current) spec begins C<perl5>, we replace it with C<perl-5>. Fourth, we search C<$PATH> for a C<perlbrew> binary, and ask it if it has a perl named after the spec, and record that if so. Fifth, we shrug and hope the user can come up with an absolute path next time. B<Note:> The original spec passed to C<set> is recorded in C<.plx/perl.spec>, so if you intend to share the C<.plx> directory across multiple machines via version control or otherwise, remove/exclude the C<.plx/perl> file and plx will automatically attempt to re-locate the perl on first invocation. =head3 libspec plx --config libspec plx --config libspec add <name> <spec> plx --config libspec del <name> <spec> A libspec config entry consists of a name and a spec, and the show output prints them space separated one per line, with enough spaces to make the specs align: 25-local.ll local 50-devel.ll devel 75-lib.dir lib The part of the name before the last C<.> is not semantically significant to plx, but is used for asciibetical sorting of the libspec entries to determine in which order to apply them. The part after must be either C<ll> for a L<local::lib>, or C<dir> for a bare L<lib> directory. When loaded, the spec is (if relative) resolved to an absolute path relative to the layout root, then all C<..> entries and symlinks resolved to give a final path used to set up the layout environment. =head3 env plx --config env plx --config env add <name> <value> plx --config env del <name> <value> Manages additional environment variables, which are set immediately before any environment changes required for the current L</libspec> and L</perl> settings are processed. =head2 --commands plx --commands # all commands plx --commands c # all commands starting with c plx --commands /json/ # all commands matching /json/ Lists available commands, name first, then full path. If a filter argument is given, treats it as a fixed prefix to filter the command list, unless the filter is C</re/> in which case the slashes are stripped and the filter is treated as a regexp. =head2 --multi plx --multi [ --init ] [ --config perl set 5.28.0 ] Runs multiple plx commands from a single invocation delimited by C<[ ... ]>. =head2 --showmulti plx --showmulti [ --init ] [ --config perl set 5.28.0 ] Outputs approximate plx invocations that would be run by C<--multi>. =head2 --userinit Same as C<--init> but assumes C<$HOME> as base and sets up only a single libspec pointing at C<$HOME/perl5>. =head2 --installself Installs L<App::plx> and L<App::cpanminus> into the highest-numbered L<local::lib> within the layout. =head2 --installenv (bash only currently) Appends an eval line to set up the layout environment to the user's bashrc. =head2 --userstrap Convenience command for C<--userinit> plus C<--installself> plus C<--installenv>. =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk> =head1 CONTRIBUTORS None yet - maybe this software is perfect! (ahahahahahahahahaha) =head1 COPYRIGHT Copyright (c) 2020 the App::plx L</AUTHOR> and L</CONTRIBUTORS> as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself.