Permalink
Browse files

Merge branch 'release/0.43'

  • Loading branch information...
2 parents 13f760a + 2f15d78 commit 9934afeeeeff560829a2e1b19020131043d10ef5 @gugod committed May 27, 2012
Showing with 313 additions and 56 deletions.
  1. +6 −0 Changes
  2. +4 −4 Makefile.PL
  3. +2 −2 README
  4. +4 −0 bin/perlbrew
  5. +173 −36 lib/App/perlbrew.pm
  6. +101 −13 perlbrew
  7. +2 −0 perlbrew-install
  8. +18 −1 t/command-lib.t
  9. +3 −0 t/installation-perlbrew.t
View
6 Changes
@@ -1,3 +1,9 @@
+0.43:
+- cpantester-error fixes
+- csh support. Big thanks to matzsoft.
+- support 'fetch' command on FreeBSD.
+- Fix a bug that perlbrew failed to resolve version number when dist path contain "perl5"
+
0.42:
- Improvement: die when running perlbrew (use|switch) with unknown installation name.
- clean 'build.log' on install. ref: RT #69168.
View
8 Makefile.PL
@@ -7,11 +7,11 @@ all_from 'lib/App/perlbrew.pm';
repository 'git://github.com/gugod/App-perlbrew.git';
requires
- 'File::Path::Tiny' => '0.1',
- 'Devel::PatchPerl' => '0.62',
+ 'File::Path::Tiny' => '0.3',
+ 'Devel::PatchPerl' => '0.70',
'local::lib' => '1.008',
- 'Capture::Tiny' => '0.13',
- 'CPAN::Perl::Releases' => '0.40';
+ 'Capture::Tiny' => '0.18',
+ 'CPAN::Perl::Releases' => '0.58';
test_requires
'Test::Simple' => '0.98',
View
4 README
@@ -55,7 +55,7 @@ INSTALLATION
The recommended way to install perlbrew is to run these statements in
your shell:
- curl -L http://xrl.us/perlbrewinstall | bash
+ curl -Lk http://xrl.us/perlbrewinstall | bash
After that, "perlbrew" installs itself to "~/perl5/perlbrew/bin", and
you should follow the instruction on screen to setup your ".bashrc" or
@@ -75,7 +75,7 @@ INSTALLATION
"PERLBREW_ROOT" environment variable before running the installer:
export PERLBREW_ROOT=/opt/perlbrew
- curl -L http://xrl.us/perlbrewinstall | bash
+ curl -Lk http://xrl.us/perlbrewinstall | bash
You may also install perlbrew from CPAN:
View
4 bin/perlbrew
@@ -72,6 +72,10 @@ your terminal:
curl -kL http://install.perlbrew.pl | bash
+Or this one, if you have C<fetch> (default on FreeBSD):
+
+ fetch -o- http://install.perlbrew.pl | sh
+
After that, C<perlbrew> installs itself to C<~/perl5/perlbrew/bin>, and you
should follow the instruction on screen to modify your shell rc file to put it
in your PATH.
View
209 lib/App/perlbrew.pm
@@ -5,11 +5,12 @@ use 5.008;
use Capture::Tiny;
use Getopt::Long ();
use File::Spec::Functions qw( catfile catdir );
+use File::Basename;
use File::Path::Tiny;
use FindBin;
use CPAN::Perl::Releases;
-our $VERSION = "0.42";
+our $VERSION = "0.43";
our $CONFIG;
our $PERLBREW_ROOT = $ENV{PERLBREW_ROOT} || catdir($ENV{HOME}, "perl5", "perlbrew");
@@ -166,6 +167,109 @@ complete -F _perlbrew_compgen perlbrew
COMPLETION
}
+sub CSH_WRAPPER_CONTENT {
+ return <<'WRAPPER';
+set perlbrew_exit_status=0
+
+if ( $1 =~ -* ) then
+ set perlbrew_short_option=$1
+ shift
+else
+ set perlbrew_short_option=""
+endif
+
+switch ( $1 )
+ case use:
+ if ( $%2 == 0 ) then
+ if ( $?PERLBREW_PERL == 0 ) then
+ echo "Currently using system perl"
+ else
+ if ( $%PERLBREW_PERL == 0 ) then
+ echo "Currently using system perl"
+ else
+ echo "Currently using $PERLBREW_PERL"
+ endif
+ endif
+ else
+ set perlbrew_line_count=0
+ foreach perlbrew_line ( "`\perlbrew env $2`" )
+ eval $perlbrew_line
+ @ perlbrew_line_count++
+ end
+ if ( $perlbrew_line_count == 0 ) then
+ set perlbrew_exit_status=1
+ else
+ source "$PERLBREW_ROOT/etc/csh_set_path"
+ endif
+ endif
+ breaksw
+
+ case switch:
+ if ( $%2 == 0 ) then
+ \perlbrew switch
+ else
+ perlbrew use $2 && source $PERLBREW_ROOT/etc/csh_reinit $2
+ endif
+ breaksw
+
+ case off:
+ unsetenv PERLBREW_PERL
+ foreach perlbrew_line ( "`\perlbrew env`" )
+ eval $perlbrew_line
+ end
+ source $PERLBREW_ROOT/etc/csh_set_path
+ echo "perlbrew is turned off."
+ breaksw
+
+ case switch-off:
+ unsetenv PERLBREW_PERL
+ source $PERLBREW_ROOT/etc/csh_reinit ''
+ echo "perlbrew is switched off."
+ breaksw
+
+ default:
+ \perlbrew $perlbrew_short_option $argv
+ set perlbrew_exit_status=$?
+ breaksw
+endsw
+rehash
+exit $perlbrew_exit_status
+WRAPPER
+}
+
+sub CSH_REINIT_CONTENT {
+ return <<'REINIT';
+if ( ! -d "$PERLBREW_HOME" ) then
+ mkdir -p "$PERLBREW_HOME"
+endif
+
+echo '# DO NOT EDIT THIS FILE' >! "$PERLBREW_HOME/init"
+\perlbrew env $1 >> "$PERLBREW_HOME/init"
+source "$PERLBREW_HOME/init"
+source "$PERLBREW_ROOT/etc/csh_set_path"
+REINIT
+}
+
+sub CSH_SET_PATH_CONTENT {
+ return <<'SETPATH';
+unalias perl
+
+if ( $?PERLBREW_PATH == 0 ) then
+ setenv PERLBREW_PATH "$PERLBREW_ROOT/bin"
+endif
+
+setenv PATH_WITHOUT_PERLBREW `perl -e 'print join ":", grep { index($_, $ENV{PERLBREW_ROOT}) } split/:/,$ENV{PATH};'`
+setenv PATH ${PERLBREW_PATH}:${PATH_WITHOUT_PERLBREW}
+
+setenv MANPATH_WITHOUT_PERLBREW `perl -e 'print join ":", grep { index($_, $ENV{PERLBREW_ROOT}) } split/:/,$ENV{MANPATH};'`
+if ( $?PERLBREW_MANPATH == 1 ) then
+ setenv MANPATH ${PERLBREW_MANPATH}:${MANPATH_WITHOUT_PERLBREW}
+else
+ setenv MANPATH ${MANPATH_WITHOUT_PERLBREW}
+endif
+SETPATH
+}
+
sub CSHRC_CONTENT {
return "setenv PERLBREW_CSHRC_VERSION $VERSION\n\n" . <<'CSHRC';
@@ -187,15 +291,8 @@ if ( $?PERLBREW_PATH == 0 ) then
setenv PERLBREW_PATH "$PERLBREW_ROOT/bin"
endif
-setenv PATH_WITHOUT_PERLBREW `perl -e 'print join ":", grep { index($_, $ENV{PERLBREW_ROOT}) } split/:/,$ENV{PATH};'`
-setenv PATH ${PERLBREW_PATH}:${PATH_WITHOUT_PERLBREW}
-
-setenv MANPATH_WITHOUT_PERLBREW `perl -e 'print join ":", grep { index($_, $ENV{PERLBREW_ROOT}) } split/:/,$ENV{MANPATH};'`
-if ( $?PERLBREW_MANPATH == 1 ) then
- setenv MANPATH ${PERLBREW_MANPATH}:${MANPATH_WITHOUT_PERLBREW}
-else
- setenv MANPATH ${MANPATH_WITHOUT_PERLBREW}
-endif
+source "$PERLBREW_ROOT/etc/csh_set_path"
+alias perlbrew 'source $PERLBREW_ROOT/etc/csh_wrapper'
CSHRC
}
@@ -235,6 +332,7 @@ sub min(@) {
my @commands = (
# curl's --fail option makes the exit code meaningful
[qw( curl --silent --location --fail --insecure )],
+ [qw( fetch -o - )],
[qw( wget --no-check-certificate --quiet -O - )],
);
for my $command (@commands) {
@@ -258,6 +356,9 @@ sub min(@) {
die 'Page not retrieved; HTTP error code 400 or above.'
if $command[0] eq 'curl' # Exit code is 22 on 404s etc
and $? >> 8 == 22; # exit code is packed into $?; see perlvar
+ die 'Page not retrieved: fetch failed.'
+ if $command[0] eq 'fetch' # Exit code is not 0 on error
+ and $?;
die 'Server issued an error response.'
if $command[0] eq 'wget' # Exit code is 8 on 404s etc
and $? >> 8 == 8;
@@ -507,7 +608,11 @@ sub run_command_help {
}
}
else {
- Pod::Usage::pod2usage(-verbose => $verbose||0, -exitval => (defined $status ? $status : 1));
+ Pod::Usage::pod2usage(
+ -noperldoc => 1,
+ -verbose => $verbose||0,
+ -exitval => (defined $status ? $status : 1)
+ );
}
}
@@ -651,6 +756,18 @@ sub run_command_init {
print BASH_COMPLETION BASH_COMPLETION_CONTENT;
close BASH_COMPLETION;
+ open CSH_WRAPPER, ">", catfile($self->root, "etc", "csh_wrapper");
+ print CSH_WRAPPER CSH_WRAPPER_CONTENT;
+ close CSH_WRAPPER;
+
+ open CSH_REINIT, ">", catfile($self->root, "etc", "csh_reinit");
+ print CSH_REINIT CSH_REINIT_CONTENT;
+ close CSH_REINIT;
+
+ open CSH_SET_PATH, ">", catfile($self->root, "etc", "csh_set_path");
+ print CSH_SET_PATH CSH_SET_PATH_CONTENT;
+ close CSH_SET_PATH;
+
open CSHRC, ">", catfile($self->root, "etc", "cshrc");
print CSHRC CSHRC_CONTENT;
close CSHRC;
@@ -943,13 +1060,13 @@ sub do_install_archive {
my $dist_version;
my $installation_name;
- if ($dist_tarball_path =~ m{perl-?(5.+)\.tar\.(gz|bz2)\Z}) {
+ if (basename($dist_tarball_path) =~ m{perl-?(5.+)\.tar\.(gz|bz2)\Z}) {
$dist_version = $1;
$installation_name = "perl-${dist_version}";
}
unless ($dist_version && $installation_name) {
- die "Unable to determin perl version from archive filename.\n\nThe archive name should look like perl-5.x.y.tar.gz or perl-5.x.y.tar.bz2\n";
+ die "Unable to determine perl version from archive filename.\n\nThe archive name should look like perl-5.x.y.tar.gz or perl-5.x.y.tar.bz2\n";
}
my $dist_extracted_path = $self->do_extract_tarball($dist_tarball_path);
@@ -990,7 +1107,30 @@ This could take a while. You can run the following command on another shell to t
INSTALL
+ my @preconfigure_commands = (
+ "cd $dist_extracted_dir",
+ "rm -f config.sh Policy.sh",
+ $patchperl,
+ );
+
my $configure_flags = '-de';
+ my @configure_commands = (
+ "sh Configure $configure_flags " .
+ join( ' ',
+ ( map { qq{'-D$_'} } @d_options ),
+ ( map { qq{'-U$_'} } @u_options ),
+ ( map { qq{'-A$_'} } @a_options ),
+ ),
+ $dist_version =~ /^5\.(\d+)\.(\d+)/
+ && ($1 < 8 || $1 == 8 && $2 < 9)
+ ? ("$^X -i -nle 'print unless /command-line/' makefile x2p/makefile")
+ : ()
+ );
+
+ my @build_commands = (
+ "make " . ($self->{j} ? "-j$self->{j}" : "")
+ );
+
# Test via "make test_harness" if available so we'll get
# automatic parallel testing via $HARNESS_OPTIONS. The
# "test_harness" target was added in 5.7.3, which was the last
@@ -1003,27 +1143,15 @@ INSTALL
local $ENV{TEST_JOBS}=$self->{j}
if $test_target eq "test_harness" && ($self->{j}||1) > 1;
- my $make = "make " . ($self->{j} ? "-j$self->{j}" : "");
- my @install = $self->{notest} ? "make install" : ("make $test_target", "make install");
- @install = join " && ", @install unless($self->{force});
+ my @install_commands = $self->{notest} ? "make install" : ("make $test_target", "make install");
+ @install_commands = join " && ", @install_commands unless($self->{force});
my $cmd = join ";",
(
- "cd $dist_extracted_dir",
- "rm -f config.sh Policy.sh",
- $patchperl,
- "sh Configure $configure_flags " .
- join( ' ',
- ( map { qq{'-D$_'} } @d_options ),
- ( map { qq{'-U$_'} } @u_options ),
- ( map { qq{'-A$_'} } @a_options ),
- ),
- $dist_version =~ /^5\.(\d+)\.(\d+)/
- && ($1 < 8 || $1 == 8 && $2 < 9)
- ? ("$^X -i -nle 'print unless /command-line/' makefile x2p/makefile")
- : (),
- $make,
- @install
+ @preconfigure_commands,
+ @configure_commands,
+ @build_commands,
+ @install_commands
);
unlink($self->{log_file});
@@ -1039,7 +1167,7 @@ INSTALL
delete $ENV{$_} for qw(PERL5LIB PERL5OPT);
if ($self->do_system($cmd)) {
- my $newperl = catfile($self->root, "perls", $as, "bin", "perl");
+ my $newperl = catfile($self->root, "perls", $as, "bin", "perl");
unless (-e $newperl) {
$self->run_command_symlink_executables($as);
}
@@ -1697,10 +1825,8 @@ sub run_command_display_cshrc {
print CSHRC_CONTENT;
}
-sub run_command_lib {
- my ($self, $subcommand, @args) = @_;
- unless ($subcommand) {
- print <<'USAGE';
+sub lib_usage {
+ my $usage = <<'USAGE';
Usage: perlbrew lib <action> <name> [<name> <name> ...]
@@ -1712,6 +1838,13 @@ Usage: perlbrew lib <action> <name> [<name> <name> ...]
perlbrew lib delete perl-5.12.3@nobita shizuka
USAGE
+ return $usage;
+}
+
+sub run_command_lib {
+ my ($self, $subcommand, @args) = @_;
+ unless ($subcommand) {
+ print lib_usage;
return;
}
@@ -1727,6 +1860,8 @@ USAGE
sub run_command_lib_create {
my ($self, $name) = @_;
+ die "ERROR: No lib name\n", lib_usage unless $name;
+
$name =~ s/^/@/ unless $name =~ /@/;
my ($perl_name, $lib_name) = $self->resolve_installation_name($name);
@@ -1754,6 +1889,8 @@ sub run_command_lib_create {
sub run_command_lib_delete {
my ($self, $name) = @_;
+ die "ERROR: No lib to delete\n", lib_usage unless $name;
+
$name =~ s/^/@/ unless $name =~ /@/;
my ($perl_name, $lib_name) = $self->resolve_installation_name($name);
View
114 perlbrew
@@ -5,7 +5,7 @@ BEGIN {
my %fatpacked;
$fatpacked{"App/perlbrew.pm"} = <<'APP_PERLBREW';
- package App::perlbrew;use strict;use warnings;use 5.008;use Capture::Tiny;use Getopt::Long ();use File::Spec::Functions qw(catfile catdir);use File::Path::Tiny;use FindBin;use CPAN::Perl::Releases;our$VERSION="0.42";our$CONFIG;our$PERLBREW_ROOT=$ENV{PERLBREW_ROOT}|| catdir($ENV{HOME},"perl5","perlbrew");our$PERLBREW_HOME=$ENV{PERLBREW_HOME}|| catdir($ENV{HOME},".perlbrew");local$SIG{__DIE__}=sub {my$message=shift;warn$message;exit 1};sub root {my ($self,$new_root)=@_;if (defined($new_root)){$self->{root}=$new_root}return$self->{root}|| $PERLBREW_ROOT}sub current_perl {my ($self,$v)=@_;if ($v){$self->{current_perl}=$v}return$self->{current_perl}|| $self->env('PERLBREW_PERL')|| ''}sub BASHRC_CONTENT() {return "export PERLBREW_BASHRC_VERSION=$VERSION\n\n" .<<'RC'}sub BASH_COMPLETION_CONTENT() {return <<'COMPLETION'}sub CSHRC_CONTENT {return "setenv PERLBREW_CSHRC_VERSION $VERSION\n\n" .<<'CSHRC'}sub mkpath {File::Path::Tiny::mk(@_)}sub rmpath {File::Path::Tiny::rm(@_)}sub uniq(@) {my%a;grep {++$a{$_}==1}@_}sub min(@) {my@a=@_;my$m=$a[0];for my$x (@a){$m=$x if$x < $m}return$m}{my@command;sub http_get {my ($url,$header,$cb)=@_;if (ref($header)eq 'CODE'){$cb=$header;$header=undef}if (!@command){my@commands=([qw(curl --silent --location --fail --insecure)],[qw(wget --no-check-certificate --quiet -O -)],);for my$command (@commands){my$program=$command->[0];my$code=system("$program --version >/dev/null 2>&1")>> 8;if ($code!=127){@command=@$command;last}}die "You have to install either curl or wget\n" unless@command}open my$fh,'-|',@command,$url or die "open() for '@command $url': $!";local $/;my$body=<$fh>;close$fh;die 'Page not retrieved; HTTP error code 400 or above.' if$command[0]eq 'curl' and $? >> 8==22;die 'Server issued an error response.' if$command[0]eq 'wget' and $? >> 8==8;return$cb ? $cb->($body): $body}}sub new {my($class,@argv)=@_;my%opt=(original_argv=>\@argv,force=>0,quiet=>0,D=>[],U=>[],A=>[],sitecustomize=>'',);local (@ARGV)=@argv;Getopt::Long::Configure('pass_through','no_ignore_case','bundling',);Getopt::Long::GetOptions(\%opt,'force|f!','notest|n!','quiet|q!','verbose|v','as=s','help|h','version','root=s','D=s@','U=s@','A=s@','j=i','sitecustomize=s',)or run_command_help(1);$opt{args}=\@ARGV;for my$flags (@opt{qw(D U A)}){for my$value(@{$flags}){$value =~ s/^=//}}return bless \%opt,$class}sub env {my ($self,$name)=@_;return$ENV{$name}if$name;return \%ENV}sub path_with_tilde {my ($self,$dir)=@_;my$home=$self->env('HOME');$dir =~ s/^$home/~/ if$home;return$dir}sub is_shell_csh {my ($self)=@_;return 1 if$self->env('SHELL')=~ /(t?csh)/;return 0}sub run {my($self)=@_;$self->run_command($self->args)}sub args {my ($self)=@_;return @{$self->{args}}}sub commands {my ($self)=@_;my$package=ref$self ? ref$self : $self;my@commands;my$symtable=do {no strict 'refs';\%{$package .'::'}};for my$sym (keys %$symtable){if($sym =~ /^run_command_/){my$glob=$symtable->{$sym};if(defined *$glob{CODE}){$sym =~ s/^run_command_//;$sym =~ s/_/-/g;push@commands,$sym}}}return@commands}sub editdist {my@a=split //,shift;my@b=split //,shift;my@d;$d[$_][0]=$_ for (0 .. @a);$d[0][$_]=$_ for (0 .. @b);for my$i (1 .. @a){for my$j (1 .. @b){$d[$i][$j]=($a[$i-1]eq $b[$j-1]? $d[$i-1][$j-1]: 1 + min($d[$i-1][$j],$d[$i][$j-1],$d[$i-1][$j-1]))}}return$d[@a][@b]}sub find_similar_commands {my ($self,$command)=@_;my$SIMILAR_DISTANCE=6;my@commands=sort {$a->[1]<=> $b->[1]}grep {defined}map {my$d=editdist($_,$command);($d < $SIMILAR_DISTANCE)? [$_,$d ]: undef}$self->commands;if(@commands){my$best=$commands[0][1];@commands=map {$_->[0]}grep {$_->[1]==$best}@commands}return@commands}sub run_command {my ($self,$x,@args)=@_;my$command=$x;$self->{log_file}||=catfile($self->root,"build.log");if($self->{version}){$x='version'}elsif(!$x){$x='help';@args=(0,$self->{help}? 2 : 0)}elsif($x eq 'help'){@args=(0,2)unless@args}my$s=$self->can("run_command_$x");unless ($s){$x =~ y/-/_/;$s=$self->can("run_command_$x")}unless($s){my@commands=$self->find_similar_commands($x);if(@commands > 1){@commands=map {' ' .$_}@commands;die "Unknown command: `$command`. Did you mean one of the following?\n" .join("\n",@commands)."\n"}elsif(@commands==1){die "Unknown command: `$command`. Did you mean `$commands[0]`?\n"}else {die "Unknown command: `$command`. Typo?\n"}}if ($x eq 'install'){$args[0]=~ s/\A((?:\d+\.)*\d+)\Z/perl-$1/ if@args}$self->$s(@args)}sub run_command_version {my ($self)=@_;my$package=ref$self;my$version=$self->VERSION;print <<"VERSION"}sub run_command_help {my ($self,$status,$verbose)=@_;require Pod::Usage;if ($status &&!defined($verbose)){if ($self->can("run_command_help_${status}")){$self->can("run_command_help_${status}")->($self)}else {my$out="";open my$fh,">",\$out;Pod::Usage::pod2usage(-exitval=>"NOEXIT",-verbose=>99,-sections=>"COMMAND: " .uc($status),-output=>$fh,-noperldoc=>1);$out =~ s/\A[^\n]+\n//s;$out =~ s/^ //gm;if ($out =~ /\A\s*\Z/){$out="Cannot find documentation for '$status'\n\n"}print "\n$out";close$fh}}else {Pod::Usage::pod2usage(-verbose=>$verbose||0,-exitval=>(defined$status ? $status : 1))}}my%comp_installed=(use=>1,switch=>1,);sub run_command_compgen {my($self,$cur,@args)=@_;$cur=0 unless defined($cur);if($self->env('PERLBREW_DEBUG_COMPLETION')){open my$log,'>>','bashcomp.log';print$log "[$$] $cur of [@args]\n"}my$subcommand=$args[1];my$subcommand_completed=($cur >= 2);if(!$subcommand_completed){$self->_compgen($subcommand,$self->commands)}else {if($comp_installed{$subcommand}){if($cur <= 2){my$part;if(defined($part=$args[2])){$part=qr/ \Q$part\E /xms}$self->_compgen($part,map{$_->{name}}$self->installed_perls())}}elsif($subcommand eq 'help'){if($cur <= 2){$self->_compgen($args[2],$self->commands())}}else {}}}sub _compgen {my($self,$part,@reply)=@_;if(defined$part){$part=qr/\A \Q$part\E /xms if ref($part)ne ref(qr//);@reply=grep {/$part/}@reply}for my$word(@reply){print$word,"\n"}}sub run_command_available {my ($self,$dist,$opts)=@_;my@available=$self->available_perls(@_);my@installed=$self->installed_perls(@_);my$is_installed;for my$available (@available){$is_installed=0;for my$installed (@installed){my$name=$installed->{name};my$cur=$installed->{is_current};if ($available eq $installed->{name}){$is_installed=1;last}}print$is_installed ? 'i ' : ' ',$available,"\n"}}sub available_perls {my ($self,$dist,$opts)=@_;my$url="http://www.cpan.org/src/README.html";my$html=http_get($url,undef,undef);unless($html){die "\nERROR: Unable to retrieve the list of perls.\n\n"}my@available_versions;for (split "\n",$html){push@available_versions,$1 if m|<td><a href="http://www.cpan.org/src/.+?">(.+?)</a></td>|}s/\.tar\.gz// for@available_versions;return@available_versions}sub perl_release {my ($self,$version)=@_;my$tarballs=CPAN::Perl::Releases::perl_tarballs($version);my$x=(values %$tarballs)[0];if ($x){my$dist_tarball=(split("/",$x))[-1];my$dist_tarball_url="http://search.cpan.org/CPAN/authors/id/$x";return ($dist_tarball,$dist_tarball_url)}my$mirror=$self->config->{mirror};my$header=$mirror ? {'Cookie'=>"cpan=$mirror->{url}"}: undef;my$html=http_get("http://search.cpan.org/dist/perl-${version}",$header);unless ($html){die "ERROR: Failed to download perl-${version} tarball."}my ($dist_path,$dist_tarball)=$html =~ m[<a href="(/CPAN/authors/id/.+/(perl-${version}.tar.(gz|bz2)))">Download</a>];die "ERROR: Cannot find the tarball for perl-$version\n" if!$dist_path and!$dist_tarball;my$dist_tarball_url="http://search.cpan.org${dist_path}";return ($dist_tarball,$dist_tarball_url)}sub run_command_init {my$self=shift;my$HOME=$self->env('HOME');mkpath($_)for (map {catdir($self->root,$_)}qw(perls dists build etc bin));open BASHRC,">",catfile($self->root,"etc","bashrc");print BASHRC BASHRC_CONTENT;close BASHRC;open BASH_COMPLETION,">",catfile($self->root,"etc","perlbrew-completion.bash");print BASH_COMPLETION BASH_COMPLETION_CONTENT;close BASH_COMPLETION;open CSHRC,">",catfile($self->root,"etc","cshrc");print CSHRC CSHRC_CONTENT;close CSHRC;my ($shrc,$yourshrc);if ($self->is_shell_csh){$shrc='cshrc';$self->env("SHELL")=~ m/(t?csh)/;$yourshrc=$1 ."rc"}elsif ($self->env("SHELL")=~ m/zsh$/){$shrc="bashrc";$yourshrc='zshenv'}else {$shrc="bashrc";$yourshrc="bash_profile"}my$root_dir=$self->path_with_tilde($self->root);my$pb_home_dir=$self->path_with_tilde($PERLBREW_HOME);print <<INSTRUCTION;if ($PERLBREW_HOME ne catdir($ENV{HOME},".perlbrew")){print "export PERLBREW_HOME=$pb_home_dir\n"}print <<INSTRUCTION}sub run_command_self_install {my$self=shift;require File::Copy;my$executable=$0;unless (File::Spec->file_name_is_absolute($executable)){$executable=File::Spec->rel2abs($executable)}my$target=catfile($self->root,"bin","perlbrew");if ($executable eq $target){print "You are already running the installed perlbrew:\n\n $executable\n";exit}mkpath(catdir($self->root,"bin"));File::Copy::copy($executable,$target);chmod(0755,$target);my$path=$self->path_with_tilde($target);print <<HELP;$self->run_command_init();return}sub do_install_git {my$self=shift;my$dist=shift;my$dist_name;my$dist_git_describe;my$dist_version;require Cwd;my$cwd=Cwd::cwd();chdir$dist;if (`git describe` =~ /v((5\.\d+\.\d+(?:-RC\d)?)(-\d+-\w+)?)$/){$dist_name='perl';$dist_git_describe="v$1";$dist_version=$2}chdir$cwd;my$dist_extracted_dir=File::Spec->rel2abs($dist);$self->do_install_this($dist_extracted_dir,$dist_version,"$dist_name-$dist_version");return}sub do_install_url {my$self=shift;my$dist=shift;my$dist_name='perl';my ($dist_version)=$dist =~ m/-([\d.]+(?:-RC\d+)?|git)\./;my ($dist_tarball)=$dist =~ m{/([^/]*)$};my$dist_tarball_path=catfile($self->root,"dists",$dist_tarball);my$dist_tarball_url=$dist;$dist="$dist_name-$dist_version";if ($dist_tarball_url =~ m/^file/){print "Installing $dist from local archive $dist_tarball_url\n";$dist_tarball_url =~ s/^file:\/+/\//;$dist_tarball_path=$dist_tarball_url}else {print "Fetching $dist as $dist_tarball_path\n";http_get($dist_tarball_url,undef,sub {my ($body)=@_;open my$BALL,"> $dist_tarball_path" or die "Couldn't open $dist_tarball_path: $!";print$BALL $body;close$BALL})}my$dist_extracted_path=$self->do_extract_tarball($dist_tarball_path);$self->do_install_this($dist_extracted_path,$dist_version,$dist);return}sub do_extract_tarball {my$self=shift;my$dist_tarball=shift;my$tarx=($^O eq 'solaris' ? 'gtar ' : 'tar ').($dist_tarball =~ m/bz2$/ ? 'xjf' : 'xzf');my$extract_command="cd @{[ $self->root ]}/build; $tarx $dist_tarball";die "Failed to extract $dist_tarball" if system($extract_command);$dist_tarball =~ s{.*/([^/]+)\.tar\.(?:gz|bz2)$}{$1};return "@{[ $self->root ]}/build/$dist_tarball"}sub do_install_blead {my$self=shift;my$dist=shift;my$dist_name='perl';my$dist_git_describe='blead';my$dist_version='blead';my$dist_tarball='blead.tar.gz';my$dist_tarball_path=catfile($self->root,"dists",$dist_tarball);print "Fetching $dist_git_describe as $dist_tarball_path\n";http_get("http://perl5.git.perl.org/perl.git/snapshot/$dist_tarball",sub {my ($body)=@_;unless ($body){die "\nERROR: Failed to download perl-blead tarball.\n\n"}open my$BALL,"> $dist_tarball_path" or die "Couldn't open $dist_tarball_path: $!";print$BALL $body;close$BALL});$self->do_extract_tarball($dist_tarball_path);my$build_dir=catdir($self->root,"build");local*DIRH;opendir DIRH,$build_dir or die "Couldn't open ${build_dir}: $!";my@contents=readdir DIRH;closedir DIRH or warn "Couldn't close ${build_dir}: $!";my@candidates=grep {m/^perl-[0-9a-f]{7,8}$/}@contents;@candidates=map {$_->[0]}sort {$b->[1]<=> $a->[1]}map {[$_,(stat(catdir($build_dir,$_)))[9]]}@candidates;my$dist_extracted_dir=catdir($self->root,"build",$candidates[0]);$self->do_install_this($dist_extracted_dir,$dist_version,"$dist_name-$dist_version");return}sub do_install_release {my$self=shift;my$dist=shift;my ($dist_name,$dist_version)=$dist =~ m/^(.*)-([\d.]+(?:-RC\d+)?)$/;my ($dist_tarball,$dist_tarball_url)=$self->perl_release($dist_version);my$dist_tarball_path=catfile($self->root,"dists",$dist_tarball);if (-f $dist_tarball_path){print "Use the previously fetched ${dist_tarball}\n" if$self->{verbose}}else {print "Fetching $dist as $dist_tarball_path\n" unless$self->{quiet};my$mirror=$self->config->{mirror};my$header=$mirror ? {'Cookie'=>"cpan=$mirror->{url}"}: undef;http_get($dist_tarball_url,$header,sub {my ($body)=@_;die "ERROR: Failed to download $dist tarball.\n" unless$body;open my$BALL,"> $dist_tarball_path";print$BALL $body;close$BALL})}my$dist_extracted_path=$self->do_extract_tarball($dist_tarball_path);$self->do_install_this($dist_extracted_path,$dist_version,$dist);return}sub run_command_install {my ($self,$dist,$opts)=@_;$self->{dist_name}=$dist;unless ($dist){$self->run_command_self_install();return}my$installation_name=$self->{as}|| $dist;if ($self->is_installed($installation_name)&&!$self->{force}){die "\nABORT: $installation_name is already installed.\n\n"}my$help_message="Unknown installation target \"$dist\", abort.\nPlease see `perlbrew help` for the instruction on using the install command.\n\n";my ($dist_name,$dist_version)=$dist =~ m/^(.*)-([\d.]+(?:-RC\d+)?|git)$/;if (!$dist_name ||!$dist_version){if (-d "$dist/.git"){$self->do_install_git($dist)}if (-f $dist){$self->do_install_archive($dist)}elsif ($dist =~ m/^(?:https?|ftp|file)/){$self->do_install_url($dist)}elsif ($dist =~ m/(?:perl-)?blead$/){$self->do_install_blead($dist)}else {die$help_message}}elsif ($dist_name eq 'perl'){$self->do_install_release($dist)}else {die$help_message}return}sub do_install_archive {my$self=shift;my$dist_tarball_path=shift;my$dist_version;my$installation_name;if ($dist_tarball_path =~ m{perl-?(5.+)\.tar\.(gz|bz2)\Z}){$dist_version=$1;$installation_name="perl-${dist_version}"}unless ($dist_version && $installation_name){die "Unable to determin perl version from archive filename.\n\nThe archive name should look like perl-5.x.y.tar.gz or perl-5.x.y.tar.bz2\n"}my$dist_extracted_path=$self->do_extract_tarball($dist_tarball_path);$self->do_install_this($dist_extracted_path,$dist_version,$installation_name);return}sub do_install_this {my ($self,$dist_extracted_dir,$dist_version,$as)=@_;my@d_options=@{$self->{D}};my@u_options=@{$self->{U}};my@a_options=@{$self->{A}};my$sitecustomize=$self->{sitecustomize};$as=$self->{as}if$self->{as};if ($sitecustomize){die "Could not read sitecustomize file '$sitecustomize'\n" unless -r $sitecustomize;push@d_options,"usesitecustomize"}my$perlpath=$self->root ."/perls/$as";my$patchperl=$self->root ."/bin/patchperl";unless (-x $patchperl && -f _){$patchperl="patchperl"}unshift@d_options,qq(prefix=$perlpath);push@d_options,"usedevel" if$dist_version =~ /5\.1[13579]|git|blead/;print "Installing $dist_extracted_dir into " .$self->path_with_tilde("@{[ $self->root ]}/perls/$as")."\n";print <<INSTALL if!$self->{verbose};my$configure_flags='-de';my$test_target="test";if ($dist_version =~ /^5\.(\d+)\.(\d+)/ && ($1 >= 8 || $1==7 && $2==3)){$test_target="test_harness"}local$ENV{TEST_JOBS}=$self->{j}if$test_target eq "test_harness" && ($self->{j}||1)> 1;my$make="make " .($self->{j}? "-j$self->{j}" : "");my@install=$self->{notest}? "make install" : ("make $test_target","make install");@install=join " && ",@install unless($self->{force});my$cmd=join ";",("cd $dist_extracted_dir","rm -f config.sh Policy.sh",$patchperl,"sh Configure $configure_flags " .join(' ',(map {qq{'-D$_'}}@d_options),(map {qq{'-U$_'}}@u_options),(map {qq{'-A$_'}}@a_options),),$dist_version =~ /^5\.(\d+)\.(\d+)/ && ($1 < 8 || $1==8 && $2 < 9)? ("$^X -i -nle 'print unless /command-line/' makefile x2p/makefile"): (),$make,@install);unlink($self->{log_file});if($self->{verbose}){$cmd="($cmd) 2>&1 | tee $self->{log_file}";print "$cmd\n" if$self->{verbose}}else {$cmd="($cmd) >> '$self->{log_file}' 2>&1 "}delete$ENV{$_}for qw(PERL5LIB PERL5OPT);if ($self->do_system($cmd)){my$newperl=catfile($self->root,"perls",$as,"bin","perl");unless (-e $newperl){$self->run_command_symlink_executables($as)}if ($sitecustomize){my$capture=$self->do_capture("$newperl -V:sitelib");my ($sitelib)=$capture =~ /sitelib='(.*)';/;mkpath($sitelib)unless -d $sitelib;my$target="$sitelib/sitecustomize.pl";open my$dst,">",$target or die "Could not open '$target' for writing: $!\n";open my$src,"<",$sitecustomize or die "Could not open '$sitecustomize' for reading: $!\n";print {$dst}do {local $/;<$src>}}print <<SUCCESS}else {die <<FAIL}return}sub do_system {my ($self,@cmd)=@_;return!system(@cmd)}sub do_capture {my ($self,$cmd)=@_;return Capture::Tiny::capture {$self->do_system($cmd)}}sub format_perl_version {my$self=shift;my$version=shift;return sprintf "%d.%d.%d",substr($version,0,1),substr($version,2,3),substr($version,5)}sub installed_perls {my$self=shift;my@result;my$root=$self->root;for (<$root/perls/*>){my ($name)=$_ =~ m/\/([^\/]+$)/;my$executable=catfile($_,'bin','perl');push@result,{name=>$name,version=>$self->format_perl_version(`$executable -e 'print \$]'`),is_current=>($self->current_perl eq $name)&&!$self->env("PERLBREW_LIB"),libs=>[$self->local_libs($name)]}}return@result}sub local_libs {my ($self,$perl_name)=@_;my@libs=map {substr($_,length($PERLBREW_HOME)+ 6)}<$PERLBREW_HOME/libs/*>;if ($perl_name){@libs=grep {/^$perl_name\@/}@libs}my$current=$self->current_perl .'@' .($self->env("PERLBREW_LIB")|| '');@libs=map {my ($p,$l)=split(/@/,$_);+{name=>$_,is_current=>$_ eq $current,perl_name=>$p,lib_name=>$l }}@libs;return@libs}sub is_installed {my ($self,$name)=@_;return grep {$name eq $_->{name}}$self->installed_perls}sub perlbrew_env {my ($self,$name)=@_;my%env=(PERLBREW_VERSION=>$VERSION,PERLBREW_PATH=>catdir($self->root,"bin"),PERLBREW_MANPATH=>"",PERLBREW_ROOT=>$self->root);if ($name){my ($perl_name,$lib_name)=$self->resolve_installation_name($name);unless ($perl_name){die "\nERROR: The installation \"$name\" is unknown.\n\n"}if(-d "@{[ $self->root ]}/perls/$perl_name/bin"){$env{PERLBREW_PERL}=$perl_name;$env{PERLBREW_PATH}.= ":" .catdir($self->root,"perls",$perl_name,"bin");$env{PERLBREW_MANPATH}=catdir($self->root,"perls",$perl_name,"man")}if ($lib_name){require local::lib;if ($ENV{PERL_LOCAL_LIB_ROOT}&& $ENV{PERL_LOCAL_LIB_ROOT}=~ /^$PERLBREW_HOME/){my%deactivate_env=local::lib->build_deact_all_environment_vars_for($ENV{PERL_LOCAL_LIB_ROOT});@env{keys%deactivate_env}=values%deactivate_env}my$base="$PERLBREW_HOME/libs/${perl_name}\@${lib_name}";if (-d $base){delete$ENV{PERL_LOCAL_LIB_ROOT};@ENV{keys%env}=values%env;my%lib_env=local::lib->build_environment_vars_for($base,0,1);$env{PERLBREW_PATH}=catdir($base,"bin").":" .$env{PERLBREW_PATH};$env{PERLBREW_MANPATH}=catdir($base,"man").":" .$env{PERLBREW_MANPATH};$env{PERLBREW_LIB}=$lib_name;$env{PERL_MM_OPT}=$lib_env{PERL_MM_OPT};$env{PERL_MB_OPT}=$lib_env{PERL_MB_OPT};$env{PERL5LIB}=$lib_env{PERL5LIB};$env{PERL_LOCAL_LIB_ROOT}=$lib_env{PERL_LOCAL_LIB_ROOT}}}else {if ($self->env("PERLBREW_LIB")){$env{PERLBREW_LIB}=undef;$env{PERL_MM_OPT}=undef;$env{PERL_MB_OPT}=undef;$env{PERL5LIB}=undef;$env{PERL_LOCAL_LIB_ROOT}=undef}}}else {$env{PERLBREW_PERL}=""}return%env}sub run_command_list {my$self=shift;for my$i ($self->installed_perls){print$i->{is_current}? '* ': ' ',$i->{name},(index($i->{name},$i->{version})< 0)? " ($i->{version})" : "","\n";for my$lib (@{$i->{libs}}){print$lib->{is_current}? "* " : " ",$lib->{name},"\n"}}}sub launch_sub_shell {my ($self,$name)=@_;my$shell=$self->env('SHELL');my$shell_opt="";if ($shell =~ /\/zsh$/){$shell_opt="-d -f";if ($^O eq 'darwin'){my$root_dir=$self->root;print <<"WARNINGONMAC"}}elsif ($shell =~ /\/bash$/){$shell_opt="--noprofile --norc"}my%env=($self->perlbrew_env($name),PERLBREW_SKIP_INIT=>1);unless ($ENV{PERLBREW_VERSION}){my$root=$self->root;$env{PATH}=$env{PERLBREW_PATH}.":" .join ":",grep {!/$root/}split ":",$ENV{PATH};$env{MANPATH}=$env{PERLBREW_MANPATH}.":" .join ":",grep {!/$root/}split ":",$ENV{MANPATH}}my$command="env ";while (my ($k,$v)=each(%env)){$command .= "$k=\"$v\" "}$command .= " $shell $shell_opt";print "\nA sub-shell is launched with $name as the activated perl. Run 'exit' to finish it.\n\n";exec($command)}sub run_command_use {my$self=shift;my$perl=shift;if (!$perl){my$current=$self->current_perl;if ($current){print "Currently using $current\n"}else {print "No version in use; defaulting to system\n"}return}$self->launch_sub_shell($perl)}sub run_command_switch {my ($self,$dist,$alias)=@_;unless ($dist){my$current=$self->current_perl;printf "Currently switched %s\n",($current ? "to $current" : 'off');return}die "Cannot use for alias something that starts with 'perl-'\n" if$alias && $alias =~ /^perl-/;die "${dist} is not installed\n" unless -d catdir($self->root,"perls",$dist);if ($self->env("PERLBREW_BASHRC_VERSION")){local$ENV{PERLBREW_PERL}=$dist;my$HOME=$self->env('HOME');my$pb_home=$self->env("PERLBREW_HOME")|| $PERLBREW_HOME;mkpath($pb_home);system("$0 env $dist > " .catfile($pb_home,"init"));print "Switched to $dist.\n\n"}else {$self->launch_sub_shell($dist)}}sub run_command_off {my$self=shift;$self->launch_sub_shell}sub run_command_switch_off {my$self=shift;my$pb_home=$self->env("PERLBREW_HOME")|| $PERLBREW_HOME;mkpath($pb_home);system("env PERLBREW_PERL= $0 env > " .catfile($pb_home,"init"));print "\nperlbrew is switched off. Please exit this shell and start a new one to make it effective.\n";print "To immediately make it effective, run this line in this terminal:\n\n exec @{[ $self->env('SHELL') ]}\n\n"}sub run_command_mirror {my($self)=@_;print "Fetching mirror list\n";my$raw=http_get("http://search.cpan.org/mirror");unless ($raw){die "\nERROR: Failed to retrieve the mirror list.\n\n"}my$found;my@mirrors;for my$line (split m{\n},$raw){$found=1 if$line =~ m{<select name="mirror">};next if!$found;last if$line =~ m{</select>};if ($line =~ m{<option value="(.+?)">(.+?)</option>}){my$url=$1;my$name=$2;$name =~ s/&#(\d+);/chr $1/seg;$url =~ s/&#(\d+);/chr $1/seg;push@mirrors,{url=>$url,name=>$name }}}require ExtUtils::MakeMaker;my$select;my$max=@mirrors;my$id=0;while (@mirrors){my@page=splice(@mirrors,0,20);my$base=$id;printf "[% 3d] %s\n",++$id,$_->{name}for@page;my$remaining=$max - $id;my$ask="Select a mirror by number or press enter to see the rest " ."($remaining more) [q to quit, m for manual entry]";my$val=ExtUtils::MakeMaker::prompt($ask);if (!length$val){next}elsif ($val eq 'q'){last}elsif ($val eq 'm'){my$url=ExtUtils::MakeMaker::prompt("Enter the URL of your CPAN mirror:");my$name=ExtUtils::MakeMaker::prompt("Enter a Name: [default: My CPAN Mirror]")|| "My CPAN Mirror";$select={name=>$name,url=>$url };last}elsif (not $val =~ /\s*(\d+)\s*/){die "Invalid answer: must be 'q', 'm' or a number\n"}elsif (1 <= $val and $val <= $max){$select=$page[$val - 1 - $base ];last}else {die "Invalid ID: must be between 1 and $max\n"}}die "You didn't select a mirror!\n" if!$select;print "Selected $select->{name} ($select->{url}) as the mirror\n";my$conf=$self->config;$conf->{mirror}=$select;$self->_save_config;return}sub run_command_env {my($self,$perl)=@_;my%env=$self->perlbrew_env($perl);if ($self->env('SHELL')=~ /(ba|k|z|\/)sh$/){while (my ($k,$v)=each(%env)){if (defined$v){$v =~ s/(\\")/\\$1/g;print "export $k=\"$v\"\n"}else {print "unset $k\n"}}}else {while (my ($k,$v)=each(%env)){if (defined$v){$v =~ s/(\\")/\\$1/g;print "setenv $k \"$v\"\n"}else {print "unsetenv $k\n"}}}}sub run_command_symlink_executables {my($self,@perls)=@_;my$root=$self->root;unless (@perls){@perls=map {m{/([^/]+)$}}grep {-d $_ &&!-l $_}<$root/perls/*>}for my$perl (@perls){for my$executable (<$root/perls/$perl/bin/*>){my ($name,$version)=$executable =~ m/bin\/(.+?)(5\.\d.*)?$/;system("ln -fs $executable $root/perls/$perl/bin/$name")if$version}}}sub run_command_install_cpanm {my ($self,$perl)=@_;my$out="@{[ $self->root ]}/bin/cpanm";if (-f $out &&!$self->{force}){require ExtUtils::MakeMaker;my$ans=ExtUtils::MakeMaker::prompt("\n$out already exists, are you sure to override ? [y/N]","N");if ($ans !~ /^Y/i){print "\ncpanm installation skipped.\n\n" unless$self->{quiet};exit}}my$body=http_get('https://github.com/miyagawa/cpanminus/raw/master/cpanm');unless ($body){die "\nERROR: Failed to retrieve cpanm executable.\n\n"}mkpath("@{[ $self->root ]}/bin")unless -d "@{[ $self->root ]}/bin";open my$CPANM,'>',$out or die "cannot open file($out): $!";print$CPANM $body;close$CPANM;chmod 0755,$out;print "\ncpanm is installed to\n\n\t$out\n\n" unless$self->{quiet}}sub run_command_install_patchperl {my ($self)=@_;my$out="@{[ $self->root ]}/bin/patchperl";if (-f $out &&!$self->{force}){require ExtUtils::MakeMaker;my$ans=ExtUtils::MakeMaker::prompt("\n$out already exists, are you sure to override ? [y/N]","N");if ($ans !~ /^Y/i){print "\npatchperl installation skipped.\n\n" unless$self->{quiet};exit}}my$body=http_get('https://raw.github.com/gugod/patchperl-packing/master/patchperl');unless ($body){die "\nERROR: Failed to retrieve patchperl executable.\n\n"}mkpath("@{[ $self->root ]}/bin")unless -d "@{[ $self->root ]}/bin";open my$OUT,'>',$out or die "cannot open file($out): $!";print$OUT $body;close$OUT;chmod 0755,$out;print "\npatchperl is installed to\n\n\t$out\n\n" unless$self->{quiet}}sub run_command_self_upgrade {my ($self)=@_;my$TMPDIR=$ENV{TMPDIR}|| "/tmp";my$TMP_PERLBREW=catfile($TMPDIR,"perlbrew");unless(-w $FindBin::Bin){die "Your perlbrew installation appears to be system-wide. Please upgrade through your package manager.\n"}http_get('http://get.perlbrew.pl',undef,sub {my ($body)=@_;open my$fh,'>',$TMP_PERLBREW or die "Unable to write perlbrew: $!";print$fh $body;close$fh});chmod 0755,$TMP_PERLBREW;my$new_version=qx($TMP_PERLBREW version);chomp$new_version;if($new_version =~ /App::perlbrew\/(\d+\.\d+)$/){$new_version=$1}else {die "Unable to detect version of new perlbrew!\n"}if($new_version <= $VERSION){print "Your perlbrew is up-to-date.\n";return}system$TMP_PERLBREW,"install";unlink$TMP_PERLBREW}sub run_command_uninstall {my ($self,$target)=@_;unless($target){die <<USAGE}my$dir="@{[ $self->root ]}/perls/$target";if (-l $dir){die "\nThe given name `$target` is an alias, not a real installation. Cannot perform uninstall.\nTo delete the alias, run:\n\n perlbrew alias delete $target\n\n"}unless(-d $dir){die "'$target' is not installed\n"}exec 'rm','-rf',$dir}sub run_command_exec {my$self=shift;my%opts;local (@ARGV)=@{$self->{original_argv}};shift@ARGV;Getopt::Long::GetOptions(\%opts,'with=s',);my@exec_with=$self->installed_perls;if ($opts{with}){@exec_with=grep {$_->{name}eq $opts{with}}@exec_with}for my$i (@exec_with){next if -l $self->root .'/perls/' .$i->{name};my%env=$self->perlbrew_env($i->{name});next if!$env{PERLBREW_PERL};local@ENV{keys%env }=values%env;local$ENV{PATH}=join(':',$env{PERLBREW_PATH},$ENV{PATH});local$ENV{MANPATH}=join(':',$env{PERLBREW_MANPATH},$ENV{MANPATH}||"");print "$i->{name}\n==========\n";$self->do_system(@ARGV);print "\n\n"}}sub run_command_clean {my ($self)=@_;my$root=$self->root;my@build_dirs=<$root/build/*>;for my$dir (@build_dirs){print "Remove $dir\n";rmpath($dir)}print "\nDone\n"}sub run_command_alias {my ($self,$cmd,$name,$alias)=@_;if (!$cmd){print <<USAGE;return}unless ($self->is_installed($name)){die "\nABORT: The installation `${name}` does not exist.\n\n"}my$path_name=catfile($self->root,"perls",$name);my$path_alias=catfile($self->root,"perls",$alias)if$alias;if ($alias && -e $path_alias &&!-l $path_alias){die "\nABORT: The installation name `$alias` is not an alias, cannot override.\n\n"}if ($cmd eq 'create'){if ($self->is_installed($alias)&&!$self->{force}){die "\nABORT: The installation `${alias}` already exists. Cannot override.\n\n"}unlink($path_alias)if -e $path_alias;symlink($path_name,$path_alias)}elsif($cmd eq 'delete'){unless (-l $path_name){die "\nABORT: The installation name `$name` is not an alias, cannot remove.\n\n"}unlink($path_name)}elsif($cmd eq 'rename'){unless (-l $path_name){die "\nABORT: The installation name `$name` is not an alias, cannot rename.\n\n"}if (-l $path_alias &&!$self->{force}){die "\nABORT: The alias `$alias` already exists, cannot rename to it.\n\n"}rename($path_name,$path_alias)}else {die "\nERROR: Unrecognized action: `${cmd}`.\n\n"}}sub run_command_display_bashrc {print BASHRC_CONTENT}sub run_command_display_cshrc {print CSHRC_CONTENT}sub run_command_lib {my ($self,$subcommand,@args)=@_;unless ($subcommand){print <<'USAGE';return}my$sub="run_command_lib_$subcommand";if ($self->can($sub)){$self->$sub(@args)}else {print "Unknown command: $subcommand\n"}}sub run_command_lib_create {my ($self,$name)=@_;$name =~ s/^/@/ unless$name =~ /@/;my ($perl_name,$lib_name)=$self->resolve_installation_name($name);if (!$perl_name){my ($perl_name,$lib_name)=split('@',$name);die "ERROR: '$perl_name' is not installed yet, '$name' cannot be created.\n"}my$fullname=$perl_name .'@' .$lib_name;my$dir=catdir($PERLBREW_HOME,"libs",$fullname);if (-d $dir){die "$fullname is already there.\n"}mkpath($dir);print "lib '$fullname' is created.\n" unless$self->{quiet};return}sub run_command_lib_delete {my ($self,$name)=@_;$name =~ s/^/@/ unless$name =~ /@/;my ($perl_name,$lib_name)=$self->resolve_installation_name($name);if (!$perl_name){}my$fullname=$perl_name .'@' .$lib_name;my$current=$self->current_perl .'@' .($self->env("PERLBREW_LIB")|| "");my$dir=catdir($PERLBREW_HOME,"libs",$fullname);if (-d $dir){if ($fullname eq $current){die "$fullname is currently being used in the current shell, it cannot be deleted.\n"}rmpath($dir);print "lib '$fullname' is deleted.\n" unless$self->{quiet}}else {die "ERROR: '$fullname' does not exist.\n"}return}sub run_command_lib_list {my ($self)=@_;my$current="";if ($self->current_perl && $self->env("PERLBREW_LIB")){$current=$self->current_perl ."@" .$self->env("PERLBREW_LIB")}my$dir=catdir($PERLBREW_HOME,"libs");return unless -d $dir;opendir my$dh,$dir or die "open $dir failed: $!";my@libs=grep {!/^\./ && /\@/}readdir($dh);for (@libs){print$current eq $_ ? "* " : " ";print "$_\n"}}sub resolve_installation_name {my ($self,$name)=@_;die "App::perlbrew->resolve_installation_name requires one argument." unless$name;my ($perl_name,$lib_name)=split('@',$name);$perl_name=$name unless$lib_name;$perl_name ||=$self->current_perl;if (!$self->is_installed($perl_name)){if ($self->is_installed("perl-${perl_name}")){$perl_name="perl-${perl_name}"}else {return undef}}return wantarray ? ($perl_name,$lib_name): $perl_name}sub config {my($self)=@_;$self->_load_config if!$CONFIG;return$CONFIG}sub config_file {my ($self)=@_;catfile($self->root,'Config.pm')}sub _save_config {my($self)=@_;require Data::Dumper;open my$FH,'>',$self->config_file or die "Unable to open config (@{[ $self->config_file ]}): $!";my$d=Data::Dumper->new([$CONFIG],['App::perlbrew::CONFIG']);print$FH $d->Dump;close$FH}sub _load_config {my($self)=@_;if (!-e $self->config_file){local$CONFIG={}if!$CONFIG;$self->_save_config}open my$FH,'<',$self->config_file or die "Unable to open config (@{[ $self->config_file ]}): $!\n";my$raw=do {local $/;my$rv=<$FH>;$rv};close$FH;my$rv=eval$raw;if ($@){warn "Error loading conf: $@\n";$CONFIG={};return}$CONFIG={}if!$CONFIG;return}1;
+ package App::perlbrew;use strict;use warnings;use 5.008;use Capture::Tiny;use Getopt::Long ();use File::Spec::Functions qw(catfile catdir);use File::Basename;use File::Path::Tiny;use FindBin;use CPAN::Perl::Releases;our$VERSION="0.43";our$CONFIG;our$PERLBREW_ROOT=$ENV{PERLBREW_ROOT}|| catdir($ENV{HOME},"perl5","perlbrew");our$PERLBREW_HOME=$ENV{PERLBREW_HOME}|| catdir($ENV{HOME},".perlbrew");local$SIG{__DIE__}=sub {my$message=shift;warn$message;exit 1};sub root {my ($self,$new_root)=@_;if (defined($new_root)){$self->{root}=$new_root}return$self->{root}|| $PERLBREW_ROOT}sub current_perl {my ($self,$v)=@_;if ($v){$self->{current_perl}=$v}return$self->{current_perl}|| $self->env('PERLBREW_PERL')|| ''}sub BASHRC_CONTENT() {return "export PERLBREW_BASHRC_VERSION=$VERSION\n\n" .<<'RC'}sub BASH_COMPLETION_CONTENT() {return <<'COMPLETION'}sub CSH_WRAPPER_CONTENT {return <<'WRAPPER'}sub CSH_REINIT_CONTENT {return <<'REINIT'}sub CSH_SET_PATH_CONTENT {return <<'SETPATH'}sub CSHRC_CONTENT {return "setenv PERLBREW_CSHRC_VERSION $VERSION\n\n" .<<'CSHRC'}sub mkpath {File::Path::Tiny::mk(@_)}sub rmpath {File::Path::Tiny::rm(@_)}sub uniq(@) {my%a;grep {++$a{$_}==1}@_}sub min(@) {my@a=@_;my$m=$a[0];for my$x (@a){$m=$x if$x < $m}return$m}{my@command;sub http_get {my ($url,$header,$cb)=@_;if (ref($header)eq 'CODE'){$cb=$header;$header=undef}if (!@command){my@commands=([qw(curl --silent --location --fail --insecure)],[qw(fetch -o -)],[qw(wget --no-check-certificate --quiet -O -)],);for my$command (@commands){my$program=$command->[0];my$code=system("$program --version >/dev/null 2>&1")>> 8;if ($code!=127){@command=@$command;last}}die "You have to install either curl or wget\n" unless@command}open my$fh,'-|',@command,$url or die "open() for '@command $url': $!";local $/;my$body=<$fh>;close$fh;die 'Page not retrieved; HTTP error code 400 or above.' if$command[0]eq 'curl' and $? >> 8==22;die 'Page not retrieved: fetch failed.' if$command[0]eq 'fetch' and $?;die 'Server issued an error response.' if$command[0]eq 'wget' and $? >> 8==8;return$cb ? $cb->($body): $body}}sub new {my($class,@argv)=@_;my%opt=(original_argv=>\@argv,force=>0,quiet=>0,D=>[],U=>[],A=>[],sitecustomize=>'',);local (@ARGV)=@argv;Getopt::Long::Configure('pass_through','no_ignore_case','bundling',);Getopt::Long::GetOptions(\%opt,'force|f!','notest|n!','quiet|q!','verbose|v','as=s','help|h','version','root=s','D=s@','U=s@','A=s@','j=i','sitecustomize=s',)or run_command_help(1);$opt{args}=\@ARGV;for my$flags (@opt{qw(D U A)}){for my$value(@{$flags}){$value =~ s/^=//}}return bless \%opt,$class}sub env {my ($self,$name)=@_;return$ENV{$name}if$name;return \%ENV}sub path_with_tilde {my ($self,$dir)=@_;my$home=$self->env('HOME');$dir =~ s/^$home/~/ if$home;return$dir}sub is_shell_csh {my ($self)=@_;return 1 if$self->env('SHELL')=~ /(t?csh)/;return 0}sub run {my($self)=@_;$self->run_command($self->args)}sub args {my ($self)=@_;return @{$self->{args}}}sub commands {my ($self)=@_;my$package=ref$self ? ref$self : $self;my@commands;my$symtable=do {no strict 'refs';\%{$package .'::'}};for my$sym (keys %$symtable){if($sym =~ /^run_command_/){my$glob=$symtable->{$sym};if(defined *$glob{CODE}){$sym =~ s/^run_command_//;$sym =~ s/_/-/g;push@commands,$sym}}}return@commands}sub editdist {my@a=split //,shift;my@b=split //,shift;my@d;$d[$_][0]=$_ for (0 .. @a);$d[0][$_]=$_ for (0 .. @b);for my$i (1 .. @a){for my$j (1 .. @b){$d[$i][$j]=($a[$i-1]eq $b[$j-1]? $d[$i-1][$j-1]: 1 + min($d[$i-1][$j],$d[$i][$j-1],$d[$i-1][$j-1]))}}return$d[@a][@b]}sub find_similar_commands {my ($self,$command)=@_;my$SIMILAR_DISTANCE=6;my@commands=sort {$a->[1]<=> $b->[1]}grep {defined}map {my$d=editdist($_,$command);($d < $SIMILAR_DISTANCE)? [$_,$d ]: undef}$self->commands;if(@commands){my$best=$commands[0][1];@commands=map {$_->[0]}grep {$_->[1]==$best}@commands}return@commands}sub run_command {my ($self,$x,@args)=@_;my$command=$x;$self->{log_file}||=catfile($self->root,"build.log");if($self->{version}){$x='version'}elsif(!$x){$x='help';@args=(0,$self->{help}? 2 : 0)}elsif($x eq 'help'){@args=(0,2)unless@args}my$s=$self->can("run_command_$x");unless ($s){$x =~ y/-/_/;$s=$self->can("run_command_$x")}unless($s){my@commands=$self->find_similar_commands($x);if(@commands > 1){@commands=map {' ' .$_}@commands;die "Unknown command: `$command`. Did you mean one of the following?\n" .join("\n",@commands)."\n"}elsif(@commands==1){die "Unknown command: `$command`. Did you mean `$commands[0]`?\n"}else {die "Unknown command: `$command`. Typo?\n"}}if ($x eq 'install'){$args[0]=~ s/\A((?:\d+\.)*\d+)\Z/perl-$1/ if@args}$self->$s(@args)}sub run_command_version {my ($self)=@_;my$package=ref$self;my$version=$self->VERSION;print <<"VERSION"}sub run_command_help {my ($self,$status,$verbose)=@_;require Pod::Usage;if ($status &&!defined($verbose)){if ($self->can("run_command_help_${status}")){$self->can("run_command_help_${status}")->($self)}else {my$out="";open my$fh,">",\$out;Pod::Usage::pod2usage(-exitval=>"NOEXIT",-verbose=>99,-sections=>"COMMAND: " .uc($status),-output=>$fh,-noperldoc=>1);$out =~ s/\A[^\n]+\n//s;$out =~ s/^ //gm;if ($out =~ /\A\s*\Z/){$out="Cannot find documentation for '$status'\n\n"}print "\n$out";close$fh}}else {Pod::Usage::pod2usage(-noperldoc=>1,-verbose=>$verbose||0,-exitval=>(defined$status ? $status : 1))}}my%comp_installed=(use=>1,switch=>1,);sub run_command_compgen {my($self,$cur,@args)=@_;$cur=0 unless defined($cur);if($self->env('PERLBREW_DEBUG_COMPLETION')){open my$log,'>>','bashcomp.log';print$log "[$$] $cur of [@args]\n"}my$subcommand=$args[1];my$subcommand_completed=($cur >= 2);if(!$subcommand_completed){$self->_compgen($subcommand,$self->commands)}else {if($comp_installed{$subcommand}){if($cur <= 2){my$part;if(defined($part=$args[2])){$part=qr/ \Q$part\E /xms}$self->_compgen($part,map{$_->{name}}$self->installed_perls())}}elsif($subcommand eq 'help'){if($cur <= 2){$self->_compgen($args[2],$self->commands())}}else {}}}sub _compgen {my($self,$part,@reply)=@_;if(defined$part){$part=qr/\A \Q$part\E /xms if ref($part)ne ref(qr//);@reply=grep {/$part/}@reply}for my$word(@reply){print$word,"\n"}}sub run_command_available {my ($self,$dist,$opts)=@_;my@available=$self->available_perls(@_);my@installed=$self->installed_perls(@_);my$is_installed;for my$available (@available){$is_installed=0;for my$installed (@installed){my$name=$installed->{name};my$cur=$installed->{is_current};if ($available eq $installed->{name}){$is_installed=1;last}}print$is_installed ? 'i ' : ' ',$available,"\n"}}sub available_perls {my ($self,$dist,$opts)=@_;my$url="http://www.cpan.org/src/README.html";my$html=http_get($url,undef,undef);unless($html){die "\nERROR: Unable to retrieve the list of perls.\n\n"}my@available_versions;for (split "\n",$html){push@available_versions,$1 if m|<td><a href="http://www.cpan.org/src/.+?">(.+?)</a></td>|}s/\.tar\.gz// for@available_versions;return@available_versions}sub perl_release {my ($self,$version)=@_;my$tarballs=CPAN::Perl::Releases::perl_tarballs($version);my$x=(values %$tarballs)[0];if ($x){my$dist_tarball=(split("/",$x))[-1];my$dist_tarball_url="http://search.cpan.org/CPAN/authors/id/$x";return ($dist_tarball,$dist_tarball_url)}my$mirror=$self->config->{mirror};my$header=$mirror ? {'Cookie'=>"cpan=$mirror->{url}"}: undef;my$html=http_get("http://search.cpan.org/dist/perl-${version}",$header);unless ($html){die "ERROR: Failed to download perl-${version} tarball."}my ($dist_path,$dist_tarball)=$html =~ m[<a href="(/CPAN/authors/id/.+/(perl-${version}.tar.(gz|bz2)))">Download</a>];die "ERROR: Cannot find the tarball for perl-$version\n" if!$dist_path and!$dist_tarball;my$dist_tarball_url="http://search.cpan.org${dist_path}";return ($dist_tarball,$dist_tarball_url)}sub run_command_init {my$self=shift;my$HOME=$self->env('HOME');mkpath($_)for (map {catdir($self->root,$_)}qw(perls dists build etc bin));open BASHRC,">",catfile($self->root,"etc","bashrc");print BASHRC BASHRC_CONTENT;close BASHRC;open BASH_COMPLETION,">",catfile($self->root,"etc","perlbrew-completion.bash");print BASH_COMPLETION BASH_COMPLETION_CONTENT;close BASH_COMPLETION;open CSH_WRAPPER,">",catfile($self->root,"etc","csh_wrapper");print CSH_WRAPPER CSH_WRAPPER_CONTENT;close CSH_WRAPPER;open CSH_REINIT,">",catfile($self->root,"etc","csh_reinit");print CSH_REINIT CSH_REINIT_CONTENT;close CSH_REINIT;open CSH_SET_PATH,">",catfile($self->root,"etc","csh_set_path");print CSH_SET_PATH CSH_SET_PATH_CONTENT;close CSH_SET_PATH;open CSHRC,">",catfile($self->root,"etc","cshrc");print CSHRC CSHRC_CONTENT;close CSHRC;my ($shrc,$yourshrc);if ($self->is_shell_csh){$shrc='cshrc';$self->env("SHELL")=~ m/(t?csh)/;$yourshrc=$1 ."rc"}elsif ($self->env("SHELL")=~ m/zsh$/){$shrc="bashrc";$yourshrc='zshenv'}else {$shrc="bashrc";$yourshrc="bash_profile"}my$root_dir=$self->path_with_tilde($self->root);my$pb_home_dir=$self->path_with_tilde($PERLBREW_HOME);print <<INSTRUCTION;if ($PERLBREW_HOME ne catdir($ENV{HOME},".perlbrew")){print "export PERLBREW_HOME=$pb_home_dir\n"}print <<INSTRUCTION}sub run_command_self_install {my$self=shift;require File::Copy;my$executable=$0;unless (File::Spec->file_name_is_absolute($executable)){$executable=File::Spec->rel2abs($executable)}my$target=catfile($self->root,"bin","perlbrew");if ($executable eq $target){print "You are already running the installed perlbrew:\n\n $executable\n";exit}mkpath(catdir($self->root,"bin"));File::Copy::copy($executable,$target);chmod(0755,$target);my$path=$self->path_with_tilde($target);print <<HELP;$self->run_command_init();return}sub do_install_git {my$self=shift;my$dist=shift;my$dist_name;my$dist_git_describe;my$dist_version;require Cwd;my$cwd=Cwd::cwd();chdir$dist;if (`git describe` =~ /v((5\.\d+\.\d+(?:-RC\d)?)(-\d+-\w+)?)$/){$dist_name='perl';$dist_git_describe="v$1";$dist_version=$2}chdir$cwd;my$dist_extracted_dir=File::Spec->rel2abs($dist);$self->do_install_this($dist_extracted_dir,$dist_version,"$dist_name-$dist_version");return}sub do_install_url {my$self=shift;my$dist=shift;my$dist_name='perl';my ($dist_version)=$dist =~ m/-([\d.]+(?:-RC\d+)?|git)\./;my ($dist_tarball)=$dist =~ m{/([^/]*)$};my$dist_tarball_path=catfile($self->root,"dists",$dist_tarball);my$dist_tarball_url=$dist;$dist="$dist_name-$dist_version";if ($dist_tarball_url =~ m/^file/){print "Installing $dist from local archive $dist_tarball_url\n";$dist_tarball_url =~ s/^file:\/+/\//;$dist_tarball_path=$dist_tarball_url}else {print "Fetching $dist as $dist_tarball_path\n";http_get($dist_tarball_url,undef,sub {my ($body)=@_;open my$BALL,"> $dist_tarball_path" or die "Couldn't open $dist_tarball_path: $!";print$BALL $body;close$BALL})}my$dist_extracted_path=$self->do_extract_tarball($dist_tarball_path);$self->do_install_this($dist_extracted_path,$dist_version,$dist);return}sub do_extract_tarball {my$self=shift;my$dist_tarball=shift;my$tarx=($^O eq 'solaris' ? 'gtar ' : 'tar ').($dist_tarball =~ m/bz2$/ ? 'xjf' : 'xzf');my$extract_command="cd @{[ $self->root ]}/build; $tarx $dist_tarball";die "Failed to extract $dist_tarball" if system($extract_command);$dist_tarball =~ s{.*/([^/]+)\.tar\.(?:gz|bz2)$}{$1};return "@{[ $self->root ]}/build/$dist_tarball"}sub do_install_blead {my$self=shift;my$dist=shift;my$dist_name='perl';my$dist_git_describe='blead';my$dist_version='blead';my$dist_tarball='blead.tar.gz';my$dist_tarball_path=catfile($self->root,"dists",$dist_tarball);print "Fetching $dist_git_describe as $dist_tarball_path\n";http_get("http://perl5.git.perl.org/perl.git/snapshot/$dist_tarball",sub {my ($body)=@_;unless ($body){die "\nERROR: Failed to download perl-blead tarball.\n\n"}open my$BALL,"> $dist_tarball_path" or die "Couldn't open $dist_tarball_path: $!";print$BALL $body;close$BALL});$self->do_extract_tarball($dist_tarball_path);my$build_dir=catdir($self->root,"build");local*DIRH;opendir DIRH,$build_dir or die "Couldn't open ${build_dir}: $!";my@contents=readdir DIRH;closedir DIRH or warn "Couldn't close ${build_dir}: $!";my@candidates=grep {m/^perl-[0-9a-f]{7,8}$/}@contents;@candidates=map {$_->[0]}sort {$b->[1]<=> $a->[1]}map {[$_,(stat(catdir($build_dir,$_)))[9]]}@candidates;my$dist_extracted_dir=catdir($self->root,"build",$candidates[0]);$self->do_install_this($dist_extracted_dir,$dist_version,"$dist_name-$dist_version");return}sub do_install_release {my$self=shift;my$dist=shift;my ($dist_name,$dist_version)=$dist =~ m/^(.*)-([\d.]+(?:-RC\d+)?)$/;my ($dist_tarball,$dist_tarball_url)=$self->perl_release($dist_version);my$dist_tarball_path=catfile($self->root,"dists",$dist_tarball);if (-f $dist_tarball_path){print "Use the previously fetched ${dist_tarball}\n" if$self->{verbose}}else {print "Fetching $dist as $dist_tarball_path\n" unless$self->{quiet};my$mirror=$self->config->{mirror};my$header=$mirror ? {'Cookie'=>"cpan=$mirror->{url}"}: undef;http_get($dist_tarball_url,$header,sub {my ($body)=@_;die "ERROR: Failed to download $dist tarball.\n" unless$body;open my$BALL,"> $dist_tarball_path";print$BALL $body;close$BALL})}my$dist_extracted_path=$self->do_extract_tarball($dist_tarball_path);$self->do_install_this($dist_extracted_path,$dist_version,$dist);return}sub run_command_install {my ($self,$dist,$opts)=@_;$self->{dist_name}=$dist;unless ($dist){$self->run_command_self_install();return}my$installation_name=$self->{as}|| $dist;if ($self->is_installed($installation_name)&&!$self->{force}){die "\nABORT: $installation_name is already installed.\n\n"}my$help_message="Unknown installation target \"$dist\", abort.\nPlease see `perlbrew help` for the instruction on using the install command.\n\n";my ($dist_name,$dist_version)=$dist =~ m/^(.*)-([\d.]+(?:-RC\d+)?|git)$/;if (!$dist_name ||!$dist_version){if (-d "$dist/.git"){$self->do_install_git($dist)}if (-f $dist){$self->do_install_archive($dist)}elsif ($dist =~ m/^(?:https?|ftp|file)/){$self->do_install_url($dist)}elsif ($dist =~ m/(?:perl-)?blead$/){$self->do_install_blead($dist)}else {die$help_message}}elsif ($dist_name eq 'perl'){$self->do_install_release($dist)}else {die$help_message}return}sub do_install_archive {my$self=shift;my$dist_tarball_path=shift;my$dist_version;my$installation_name;if (basename($dist_tarball_path)=~ m{perl-?(5.+)\.tar\.(gz|bz2)\Z}){$dist_version=$1;$installation_name="perl-${dist_version}"}unless ($dist_version && $installation_name){die "Unable to determine perl version from archive filename.\n\nThe archive name should look like perl-5.x.y.tar.gz or perl-5.x.y.tar.bz2\n"}my$dist_extracted_path=$self->do_extract_tarball($dist_tarball_path);$self->do_install_this($dist_extracted_path,$dist_version,$installation_name);return}sub do_install_this {my ($self,$dist_extracted_dir,$dist_version,$as)=@_;my@d_options=@{$self->{D}};my@u_options=@{$self->{U}};my@a_options=@{$self->{A}};my$sitecustomize=$self->{sitecustomize};$as=$self->{as}if$self->{as};if ($sitecustomize){die "Could not read sitecustomize file '$sitecustomize'\n" unless -r $sitecustomize;push@d_options,"usesitecustomize"}my$perlpath=$self->root ."/perls/$as";my$patchperl=$self->root ."/bin/patchperl";unless (-x $patchperl && -f _){$patchperl="patchperl"}unshift@d_options,qq(prefix=$perlpath);push@d_options,"usedevel" if$dist_version =~ /5\.1[13579]|git|blead/;print "Installing $dist_extracted_dir into " .$self->path_with_tilde("@{[ $self->root ]}/perls/$as")."\n";print <<INSTALL if!$self->{verbose};my@preconfigure_commands=("cd $dist_extracted_dir","rm -f config.sh Policy.sh",$patchperl,);my$configure_flags='-de';my@configure_commands=("sh Configure $configure_flags " .join(' ',(map {qq{'-D$_'}}@d_options),(map {qq{'-U$_'}}@u_options),(map {qq{'-A$_'}}@a_options),),$dist_version =~ /^5\.(\d+)\.(\d+)/ && ($1 < 8 || $1==8 && $2 < 9)? ("$^X -i -nle 'print unless /command-line/' makefile x2p/makefile"): ());my@build_commands=("make " .($self->{j}? "-j$self->{j}" : ""));my$test_target="test";if ($dist_version =~ /^5\.(\d+)\.(\d+)/ && ($1 >= 8 || $1==7 && $2==3)){$test_target="test_harness"}local$ENV{TEST_JOBS}=$self->{j}if$test_target eq "test_harness" && ($self->{j}||1)> 1;my@install_commands=$self->{notest}? "make install" : ("make $test_target","make install");@install_commands=join " && ",@install_commands unless($self->{force});my$cmd=join ";",(@preconfigure_commands,@configure_commands,@build_commands,@install_commands);unlink($self->{log_file});if($self->{verbose}){$cmd="($cmd) 2>&1 | tee $self->{log_file}";print "$cmd\n" if$self->{verbose}}else {$cmd="($cmd) >> '$self->{log_file}' 2>&1 "}delete$ENV{$_}for qw(PERL5LIB PERL5OPT);if ($self->do_system($cmd)){my$newperl=catfile($self->root,"perls",$as,"bin","perl");unless (-e $newperl){$self->run_command_symlink_executables($as)}if ($sitecustomize){my$capture=$self->do_capture("$newperl -V:sitelib");my ($sitelib)=$capture =~ /sitelib='(.*)';/;mkpath($sitelib)unless -d $sitelib;my$target="$sitelib/sitecustomize.pl";open my$dst,">",$target or die "Could not open '$target' for writing: $!\n";open my$src,"<",$sitecustomize or die "Could not open '$sitecustomize' for reading: $!\n";print {$dst}do {local $/;<$src>}}print <<SUCCESS}else {die <<FAIL}return}sub do_system {my ($self,@cmd)=@_;return!system(@cmd)}sub do_capture {my ($self,$cmd)=@_;return Capture::Tiny::capture {$self->do_system($cmd)}}sub format_perl_version {my$self=shift;my$version=shift;return sprintf "%d.%d.%d",substr($version,0,1),substr($version,2,3),substr($version,5)}sub installed_perls {my$self=shift;my@result;my$root=$self->root;for (<$root/perls/*>){my ($name)=$_ =~ m/\/([^\/]+$)/;my$executable=catfile($_,'bin','perl');push@result,{name=>$name,version=>$self->format_perl_version(`$executable -e 'print \$]'`),is_current=>($self->current_perl eq $name)&&!$self->env("PERLBREW_LIB"),libs=>[$self->local_libs($name)]}}return@result}sub local_libs {my ($self,$perl_name)=@_;my@libs=map {substr($_,length($PERLBREW_HOME)+ 6)}<$PERLBREW_HOME/libs/*>;if ($perl_name){@libs=grep {/^$perl_name\@/}@libs}my$current=$self->current_perl .'@' .($self->env("PERLBREW_LIB")|| '');@libs=map {my ($p,$l)=split(/@/,$_);+{name=>$_,is_current=>$_ eq $current,perl_name=>$p,lib_name=>$l }}@libs;return@libs}sub is_installed {my ($self,$name)=@_;return grep {$name eq $_->{name}}$self->installed_perls}sub perlbrew_env {my ($self,$name)=@_;my%env=(PERLBREW_VERSION=>$VERSION,PERLBREW_PATH=>catdir($self->root,"bin"),PERLBREW_MANPATH=>"",PERLBREW_ROOT=>$self->root);if ($name){my ($perl_name,$lib_name)=$self->resolve_installation_name($name);unless ($perl_name){die "\nERROR: The installation \"$name\" is unknown.\n\n"}if(-d "@{[ $self->root ]}/perls/$perl_name/bin"){$env{PERLBREW_PERL}=$perl_name;$env{PERLBREW_PATH}.= ":" .catdir($self->root,"perls",$perl_name,"bin");$env{PERLBREW_MANPATH}=catdir($self->root,"perls",$perl_name,"man")}if ($lib_name){require local::lib;if ($ENV{PERL_LOCAL_LIB_ROOT}&& $ENV{PERL_LOCAL_LIB_ROOT}=~ /^$PERLBREW_HOME/){my%deactivate_env=local::lib->build_deact_all_environment_vars_for($ENV{PERL_LOCAL_LIB_ROOT});@env{keys%deactivate_env}=values%deactivate_env}my$base="$PERLBREW_HOME/libs/${perl_name}\@${lib_name}";if (-d $base){delete$ENV{PERL_LOCAL_LIB_ROOT};@ENV{keys%env}=values%env;my%lib_env=local::lib->build_environment_vars_for($base,0,1);$env{PERLBREW_PATH}=catdir($base,"bin").":" .$env{PERLBREW_PATH};$env{PERLBREW_MANPATH}=catdir($base,"man").":" .$env{PERLBREW_MANPATH};$env{PERLBREW_LIB}=$lib_name;$env{PERL_MM_OPT}=$lib_env{PERL_MM_OPT};$env{PERL_MB_OPT}=$lib_env{PERL_MB_OPT};$env{PERL5LIB}=$lib_env{PERL5LIB};$env{PERL_LOCAL_LIB_ROOT}=$lib_env{PERL_LOCAL_LIB_ROOT}}}else {if ($self->env("PERLBREW_LIB")){$env{PERLBREW_LIB}=undef;$env{PERL_MM_OPT}=undef;$env{PERL_MB_OPT}=undef;$env{PERL5LIB}=undef;$env{PERL_LOCAL_LIB_ROOT}=undef}}}else {$env{PERLBREW_PERL}=""}return%env}sub run_command_list {my$self=shift;for my$i ($self->installed_perls){print$i->{is_current}? '* ': ' ',$i->{name},(index($i->{name},$i->{version})< 0)? " ($i->{version})" : "","\n";for my$lib (@{$i->{libs}}){print$lib->{is_current}? "* " : " ",$lib->{name},"\n"}}}sub launch_sub_shell {my ($self,$name)=@_;my$shell=$self->env('SHELL');my$shell_opt="";if ($shell =~ /\/zsh$/){$shell_opt="-d -f";if ($^O eq 'darwin'){my$root_dir=$self->root;print <<"WARNINGONMAC"}}elsif ($shell =~ /\/bash$/){$shell_opt="--noprofile --norc"}my%env=($self->perlbrew_env($name),PERLBREW_SKIP_INIT=>1);unless ($ENV{PERLBREW_VERSION}){my$root=$self->root;$env{PATH}=$env{PERLBREW_PATH}.":" .join ":",grep {!/$root/}split ":",$ENV{PATH};$env{MANPATH}=$env{PERLBREW_MANPATH}.":" .join ":",grep {!/$root/}split ":",$ENV{MANPATH}}my$command="env ";while (my ($k,$v)=each(%env)){$command .= "$k=\"$v\" "}$command .= " $shell $shell_opt";print "\nA sub-shell is launched with $name as the activated perl. Run 'exit' to finish it.\n\n";exec($command)}sub run_command_use {my$self=shift;my$perl=shift;if (!$perl){my$current=$self->current_perl;if ($current){print "Currently using $current\n"}else {print "No version in use; defaulting to system\n"}return}$self->launch_sub_shell($perl)}sub run_command_switch {my ($self,$dist,$alias)=@_;unless ($dist){my$current=$self->current_perl;printf "Currently switched %s\n",($current ? "to $current" : 'off');return}die "Cannot use for alias something that starts with 'perl-'\n" if$alias && $alias =~ /^perl-/;die "${dist} is not installed\n" unless -d catdir($self->root,"perls",$dist);if ($self->env("PERLBREW_BASHRC_VERSION")){local$ENV{PERLBREW_PERL}=$dist;my$HOME=$self->env('HOME');my$pb_home=$self->env("PERLBREW_HOME")|| $PERLBREW_HOME;mkpath($pb_home);system("$0 env $dist > " .catfile($pb_home,"init"));print "Switched to $dist.\n\n"}else {$self->launch_sub_shell($dist)}}sub run_command_off {my$self=shift;$self->launch_sub_shell}sub run_command_switch_off {my$self=shift;my$pb_home=$self->env("PERLBREW_HOME")|| $PERLBREW_HOME;mkpath($pb_home);system("env PERLBREW_PERL= $0 env > " .catfile($pb_home,"init"));print "\nperlbrew is switched off. Please exit this shell and start a new one to make it effective.\n";print "To immediately make it effective, run this line in this terminal:\n\n exec @{[ $self->env('SHELL') ]}\n\n"}sub run_command_mirror {my($self)=@_;print "Fetching mirror list\n";my$raw=http_get("http://search.cpan.org/mirror");unless ($raw){die "\nERROR: Failed to retrieve the mirror list.\n\n"}my$found;my@mirrors;for my$line (split m{\n},$raw){$found=1 if$line =~ m{<select name="mirror">};next if!$found;last if$line =~ m{</select>};if ($line =~ m{<option value="(.+?)">(.+?)</option>}){my$url=$1;my$name=$2;$name =~ s/&#(\d+);/chr $1/seg;$url =~ s/&#(\d+);/chr $1/seg;push@mirrors,{url=>$url,name=>$name }}}require ExtUtils::MakeMaker;my$select;my$max=@mirrors;my$id=0;while (@mirrors){my@page=splice(@mirrors,0,20);my$base=$id;printf "[% 3d] %s\n",++$id,$_->{name}for@page;my$remaining=$max - $id;my$ask="Select a mirror by number or press enter to see the rest " ."($remaining more) [q to quit, m for manual entry]";my$val=ExtUtils::MakeMaker::prompt($ask);if (!length$val){next}elsif ($val eq 'q'){last}elsif ($val eq 'm'){my$url=ExtUtils::MakeMaker::prompt("Enter the URL of your CPAN mirror:");my$name=ExtUtils::MakeMaker::prompt("Enter a Name: [default: My CPAN Mirror]")|| "My CPAN Mirror";$select={name=>$name,url=>$url };last}elsif (not $val =~ /\s*(\d+)\s*/){die "Invalid answer: must be 'q', 'm' or a number\n"}elsif (1 <= $val and $val <= $max){$select=$page[$val - 1 - $base ];last}else {die "Invalid ID: must be between 1 and $max\n"}}die "You didn't select a mirror!\n" if!$select;print "Selected $select->{name} ($select->{url}) as the mirror\n";my$conf=$self->config;$conf->{mirror}=$select;$self->_save_config;return}sub run_command_env {my($self,$perl)=@_;my%env=$self->perlbrew_env($perl);if ($self->env('SHELL')=~ /(ba|k|z|\/)sh$/){while (my ($k,$v)=each(%env)){if (defined$v){$v =~ s/(\\")/\\$1/g;print "export $k=\"$v\"\n"}else {print "unset $k\n"}}}else {while (my ($k,$v)=each(%env)){if (defined$v){$v =~ s/(\\")/\\$1/g;print "setenv $k \"$v\"\n"}else {print "unsetenv $k\n"}}}}sub run_command_symlink_executables {my($self,@perls)=@_;my$root=$self->root;unless (@perls){@perls=map {m{/([^/]+)$}}grep {-d $_ &&!-l $_}<$root/perls/*>}for my$perl (@perls){for my$executable (<$root/perls/$perl/bin/*>){my ($name,$version)=$executable =~ m/bin\/(.+?)(5\.\d.*)?$/;system("ln -fs $executable $root/perls/$perl/bin/$name")if$version}}}sub run_command_install_cpanm {my ($self,$perl)=@_;my$out="@{[ $self->root ]}/bin/cpanm";if (-f $out &&!$self->{force}){require ExtUtils::MakeMaker;my$ans=ExtUtils::MakeMaker::prompt("\n$out already exists, are you sure to override ? [y/N]","N");if ($ans !~ /^Y/i){print "\ncpanm installation skipped.\n\n" unless$self->{quiet};exit}}my$body=http_get('https://github.com/miyagawa/cpanminus/raw/master/cpanm');unless ($body){die "\nERROR: Failed to retrieve cpanm executable.\n\n"}mkpath("@{[ $self->root ]}/bin")unless -d "@{[ $self->root ]}/bin";open my$CPANM,'>',$out or die "cannot open file($out): $!";print$CPANM $body;close$CPANM;chmod 0755,$out;print "\ncpanm is installed to\n\n\t$out\n\n" unless$self->{quiet}}sub run_command_install_patchperl {my ($self)=@_;my$out="@{[ $self->root ]}/bin/patchperl";if (-f $out &&!$self->{force}){require ExtUtils::MakeMaker;my$ans=ExtUtils::MakeMaker::prompt("\n$out already exists, are you sure to override ? [y/N]","N");if ($ans !~ /^Y/i){print "\npatchperl installation skipped.\n\n" unless$self->{quiet};exit}}my$body=http_get('https://raw.github.com/gugod/patchperl-packing/master/patchperl');unless ($body){die "\nERROR: Failed to retrieve patchperl executable.\n\n"}mkpath("@{[ $self->root ]}/bin")unless -d "@{[ $self->root ]}/bin";open my$OUT,'>',$out or die "cannot open file($out): $!";print$OUT $body;close$OUT;chmod 0755,$out;print "\npatchperl is installed to\n\n\t$out\n\n" unless$self->{quiet}}sub run_command_self_upgrade {my ($self)=@_;my$TMPDIR=$ENV{TMPDIR}|| "/tmp";my$TMP_PERLBREW=catfile($TMPDIR,"perlbrew");unless(-w $FindBin::Bin){die "Your perlbrew installation appears to be system-wide. Please upgrade through your package manager.\n"}http_get('http://get.perlbrew.pl',undef,sub {my ($body)=@_;open my$fh,'>',$TMP_PERLBREW or die "Unable to write perlbrew: $!";print$fh $body;close$fh});chmod 0755,$TMP_PERLBREW;my$new_version=qx($TMP_PERLBREW version);chomp$new_version;if($new_version =~ /App::perlbrew\/(\d+\.\d+)$/){$new_version=$1}else {die "Unable to detect version of new perlbrew!\n"}if($new_version <= $VERSION){print "Your perlbrew is up-to-date.\n";return}system$TMP_PERLBREW,"install";unlink$TMP_PERLBREW}sub run_command_uninstall {my ($self,$target)=@_;unless($target){die <<USAGE}my$dir="@{[ $self->root ]}/perls/$target";if (-l $dir){die "\nThe given name `$target` is an alias, not a real installation. Cannot perform uninstall.\nTo delete the alias, run:\n\n perlbrew alias delete $target\n\n"}unless(-d $dir){die "'$target' is not installed\n"}exec 'rm','-rf',$dir}sub run_command_exec {my$self=shift;my%opts;local (@ARGV)=@{$self->{original_argv}};shift@ARGV;Getopt::Long::GetOptions(\%opts,'with=s',);my@exec_with=$self->installed_perls;if ($opts{with}){@exec_with=grep {$_->{name}eq $opts{with}}@exec_with}for my$i (@exec_with){next if -l $self->root .'/perls/' .$i->{name};my%env=$self->perlbrew_env($i->{name});next if!$env{PERLBREW_PERL};local@ENV{keys%env }=values%env;local$ENV{PATH}=join(':',$env{PERLBREW_PATH},$ENV{PATH});local$ENV{MANPATH}=join(':',$env{PERLBREW_MANPATH},$ENV{MANPATH}||"");print "$i->{name}\n==========\n";$self->do_system(@ARGV);print "\n\n"}}sub run_command_clean {my ($self)=@_;my$root=$self->root;my@build_dirs=<$root/build/*>;for my$dir (@build_dirs){print "Remove $dir\n";rmpath($dir)}print "\nDone\n"}sub run_command_alias {my ($self,$cmd,$name,$alias)=@_;if (!$cmd){print <<USAGE;return}unless ($self->is_installed($name)){die "\nABORT: The installation `${name}` does not exist.\n\n"}my$path_name=catfile($self->root,"perls",$name);my$path_alias=catfile($self->root,"perls",$alias)if$alias;if ($alias && -e $path_alias &&!-l $path_alias){die "\nABORT: The installation name `$alias` is not an alias, cannot override.\n\n"}if ($cmd eq 'create'){if ($self->is_installed($alias)&&!$self->{force}){die "\nABORT: The installation `${alias}` already exists. Cannot override.\n\n"}unlink($path_alias)if -e $path_alias;symlink($path_name,$path_alias)}elsif($cmd eq 'delete'){unless (-l $path_name){die "\nABORT: The installation name `$name` is not an alias, cannot remove.\n\n"}unlink($path_name)}elsif($cmd eq 'rename'){unless (-l $path_name){die "\nABORT: The installation name `$name` is not an alias, cannot rename.\n\n"}if (-l $path_alias &&!$self->{force}){die "\nABORT: The alias `$alias` already exists, cannot rename to it.\n\n"}rename($path_name,$path_alias)}else {die "\nERROR: Unrecognized action: `${cmd}`.\n\n"}}sub run_command_display_bashrc {print BASHRC_CONTENT}sub run_command_display_cshrc {print CSHRC_CONTENT}sub lib_usage {my$usage=<<'USAGE';return$usage}sub run_command_lib {my ($self,$subcommand,@args)=@_;unless ($subcommand){print lib_usage;return}my$sub="run_command_lib_$subcommand";if ($self->can($sub)){$self->$sub(@args)}else {print "Unknown command: $subcommand\n"}}sub run_command_lib_create {my ($self,$name)=@_;die "ERROR: No lib name\n",lib_usage unless$name;$name =~ s/^/@/ unless$name =~ /@/;my ($perl_name,$lib_name)=$self->resolve_installation_name($name);if (!$perl_name){my ($perl_name,$lib_name)=split('@',$name);die "ERROR: '$perl_name' is not installed yet, '$name' cannot be created.\n"}my$fullname=$perl_name .'@' .$lib_name;my$dir=catdir($PERLBREW_HOME,"libs",$fullname);if (-d $dir){die "$fullname is already there.\n"}mkpath($dir);print "lib '$fullname' is created.\n" unless$self->{quiet};return}sub run_command_lib_delete {my ($self,$name)=@_;die "ERROR: No lib to delete\n",lib_usage unless$name;$name =~ s/^/@/ unless$name =~ /@/;my ($perl_name,$lib_name)=$self->resolve_installation_name($name);if (!$perl_name){}my$fullname=$perl_name .'@' .$lib_name;my$current=$self->current_perl .'@' .($self->env("PERLBREW_LIB")|| "");my$dir=catdir($PERLBREW_HOME,"libs",$fullname);if (-d $dir){if ($fullname eq $current){die "$fullname is currently being used in the current shell, it cannot be deleted.\n"}rmpath($dir);print "lib '$fullname' is deleted.\n" unless$self->{quiet}}else {die "ERROR: '$fullname' does not exist.\n"}return}sub run_command_lib_list {my ($self)=@_;my$current="";if ($self->current_perl && $self->env("PERLBREW_LIB")){$current=$self->current_perl ."@" .$self->env("PERLBREW_LIB")}my$dir=catdir($PERLBREW_HOME,"libs");return unless -d $dir;opendir my$dh,$dir or die "open $dir failed: $!";my@libs=grep {!/^\./ && /\@/}readdir($dh);for (@libs){print$current eq $_ ? "* " : " ";print "$_\n"}}sub resolve_installation_name {my ($self,$name)=@_;die "App::perlbrew->resolve_installation_name requires one argument." unless$name;my ($perl_name,$lib_name)=split('@',$name);$perl_name=$name unless$lib_name;$perl_name ||=$self->current_perl;if (!$self->is_installed($perl_name)){if ($self->is_installed("perl-${perl_name}")){$perl_name="perl-${perl_name}"}else {return undef}}return wantarray ? ($perl_name,$lib_name): $perl_name}sub config {my($self)=@_;$self->_load_config if!$CONFIG;return$CONFIG}sub config_file {my ($self)=@_;catfile($self->root,'Config.pm')}sub _save_config {my($self)=@_;require Data::Dumper;open my$FH,'>',$self->config_file or die "Unable to open config (@{[ $self->config_file ]}): $!";my$d=Data::Dumper->new([$CONFIG],['App::perlbrew::CONFIG']);print$FH $d->Dump;close$FH}sub _load_config {my($self)=@_;if (!-e $self->config_file){local$CONFIG={}if!$CONFIG;$self->_save_config}open my$FH,'<',$self->config_file or die "Unable to open config (@{[ $self->config_file ]}): $!\n";my$raw=do {local $/;my$rv=<$FH>;$rv};close$FH;my$rv=eval$raw;if ($@){warn "Error loading conf: $@\n";$CONFIG={};return}$CONFIG={}if!$CONFIG;return}1;
[[ -z "$PERLBREW_ROOT" ]] && export PERLBREW_ROOT="$HOME/perl5/perlbrew"
[[ -z "$PERLBREW_HOME" ]] && export PERLBREW_HOME="$HOME/.perlbrew"
@@ -122,20 +122,82 @@ $fatpacked{"App/perlbrew.pm"} = <<'APP_PERLBREW';
}
complete -F _perlbrew_compgen perlbrew
COMPLETION
+ set perlbrew_exit_status=0
- if ( $?PERLBREW_HOME == 0 ) then
- setenv PERLBREW_HOME "$HOME/.perlbrew"
+ if ( $1 =~ -* ) then
+ set perlbrew_short_option=$1
+ shift
+ else
+ set perlbrew_short_option=""
endif
- if ( $?PERLBREW_ROOT == 0 ) then
- setenv PERLBREW_ROOT "$HOME/perl5/perlbrew"
+ switch ( $1 )
+ case use:
+ if ( $%2 == 0 ) then
+ if ( $?PERLBREW_PERL == 0 ) then
+ echo "Currently using system perl"
+ else
+ if ( $%PERLBREW_PERL == 0 ) then
+ echo "Currently using system perl"
+ else
+ echo "Currently using $PERLBREW_PERL"
+ endif
+ endif
+ else
+ set perlbrew_line_count=0
+ foreach perlbrew_line ( "`\perlbrew env $2`" )
+ eval $perlbrew_line
+ @ perlbrew_line_count++
+ end
+ if ( $perlbrew_line_count == 0 ) then
+ set perlbrew_exit_status=1
+ else
+ source "$PERLBREW_ROOT/etc/csh_set_path"
+ endif
+ endif
+ breaksw
+
+ case switch:
+ if ( $%2 == 0 ) then
+ \perlbrew switch
+ else
+ perlbrew use $2 && source $PERLBREW_ROOT/etc/csh_reinit $2
+ endif
+ breaksw
+
+ case off:
+ unsetenv PERLBREW_PERL
+ foreach perlbrew_line ( "`\perlbrew env`" )
+ eval $perlbrew_line
+ end
+ source $PERLBREW_ROOT/etc/csh_set_path
+ echo "perlbrew is turned off."
+ breaksw
+
+ case switch-off:
+ unsetenv PERLBREW_PERL
+ source $PERLBREW_ROOT/etc/csh_reinit ''
+ echo "perlbrew is switched off."
+ breaksw
+
+ default:
+ \perlbrew $perlbrew_short_option $argv
+ set perlbrew_exit_status=$?
+ breaksw
+ endsw
+ rehash
+ exit $perlbrew_exit_status
+ WRAPPER
+ if ( ! -d "$PERLBREW_HOME" ) then
+ mkdir -p "$PERLBREW_HOME"
endif
- if ( $?PERLBREW_SKIP_INIT == 0 ) then
- if ( -f "$PERLBREW_HOME/init" ) then
- source "$PERLBREW_HOME/init"
- endif
- endif
+ echo '# DO NOT EDIT THIS FILE' >! "$PERLBREW_HOME/init"
+ \perlbrew env $1 >> "$PERLBREW_HOME/init"
+ source "$PERLBREW_HOME/init"
+ source "$PERLBREW_ROOT/etc/csh_set_path"
+ REINIT
+ unalias perl
if ( $?PERLBREW_PATH == 0 ) then
setenv PERLBREW_PATH "$PERLBREW_ROOT/bin"
@@ -150,6 +212,28 @@ $fatpacked{"App/perlbrew.pm"} = <<'APP_PERLBREW';
else
setenv MANPATH ${MANPATH_WITHOUT_PERLBREW}
endif
+ SETPATH
+
+ if ( $?PERLBREW_HOME == 0 ) then
+ setenv PERLBREW_HOME "$HOME/.perlbrew"
+ endif
+
+ if ( $?PERLBREW_ROOT == 0 ) then
+ setenv PERLBREW_ROOT "$HOME/perl5/perlbrew"
+ endif
+
+ if ( $?PERLBREW_SKIP_INIT == 0 ) then
+ if ( -f "$PERLBREW_HOME/init" ) then
+ source "$PERLBREW_HOME/init"
+ endif
+ endif
+
+ if ( $?PERLBREW_PATH == 0 ) then
+ setenv PERLBREW_PATH "$PERLBREW_ROOT/bin"
+ endif
+
+ source "$PERLBREW_ROOT/etc/csh_set_path"
+ alias perlbrew 'source $PERLBREW_ROOT/etc/csh_wrapper'
CSHRC
$0 - $package/$version
VERSION
@@ -237,15 +321,15 @@ $fatpacked{"App/perlbrew.pm"} = <<'APP_PERLBREW';
APP_PERLBREW
$fatpacked{"CPAN/Perl/Releases.pm"} = <<'CPAN_PERL_RELEASES';
- package CPAN::Perl::Releases;{$CPAN::Perl::Releases::VERSION='0.40'}use strict;use warnings;use vars qw[@ISA @EXPORT_OK];use Exporter;@ISA=qw(Exporter);@EXPORT_OK=qw(perl_tarballs);our$data={"5.003_07"=>{"tar.gz"=>"A/AN/ANDYD/perl5.003_07.tar.gz",},"5.004"=>{"tar.gz"=>"C/CH/CHIPS/perl5.004.tar.gz",},"5.004_01"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_01.tar.gz",},"5.004_02"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_02.tar.gz",},"5.004_03"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_03.tar.gz",},"5.004_04"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_04.tar.gz",},"5.004_05"=>{"tar.gz"=>"C/CH/CHIPS/perl5.004_05.tar.gz",},"5.005"=>{"tar.gz"=>"G/GS/GSAR/perl5.005.tar.gz",},"5.005_01"=>{"tar.gz"=>"G/GS/GSAR/perl5.005_01.tar.gz",},"5.005_02"=>{"tar.gz"=>"G/GS/GSAR/perl5.005_02.tar.gz",},"5.005_03"=>{"tar.gz"=>"G/GB/GBARR/perl5.005_03.tar.gz",},"5.005_04"=>{"tar.gz"=>"L/LB/LBROCARD/perl5.005_04.tar.gz",},"5.10.0"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.10.0.tar.gz",},"5.10.0-RC1"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.10.0-RC1.tar.gz",},"5.10.0-RC2"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.10.0-RC2.tar.gz",},"5.10.1"=>{"tar.bz2"=>"D/DA/DAPM/perl-5.10.1.tar.bz2","tar.gz"=>"D/DA/DAPM/perl-5.10.1.tar.gz",},"5.11.0"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.11.0.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.11.0.tar.gz",},"5.11.1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.11.1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.11.1.tar.gz",},"5.11.2"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.11.2.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.11.2.tar.gz",},"5.11.3"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.11.3.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.11.3.tar.gz",},"5.11.4"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.11.4.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.11.4.tar.gz",},"5.11.5"=>{"tar.bz2"=>"S/SH/SHAY/perl-5.11.5.tar.bz2","tar.gz"=>"S/SH/SHAY/perl-5.11.5.tar.gz",},"5.12.0"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.0.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.0.tar.gz",},"5.12.1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.1.tar.gz",},"5.12.1-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.1-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.1-RC1.tar.gz",},"5.12.1-RC2"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.1-RC2.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.1-RC2.tar.gz",},"5.12.2"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.2.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.2.tar.gz",},"5.12.2-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.2-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.2-RC1.tar.gz",},"5.12.3"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.12.3.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.12.3.tar.gz",},"5.12.4-RC1"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.12.4-RC1.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.12.4-RC1.tar.gz",},"5.12.4-RC2"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.12.4-RC2.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.12.4-RC2.tar.gz",},"5.12.4"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.12.4.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.12.4.tar.gz",},"5.13.0"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.13.0.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.13.0.tar.gz",},"5.13.1"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.13.1.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.13.1.tar.gz",},"5.13.10"=>{"tar.bz2"=>"A/AV/AVAR/perl-5.13.10.tar.bz2","tar.gz"=>"A/AV/AVAR/perl-5.13.10.tar.gz",},"5.13.11"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.13.11.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.13.11.tar.gz",},"5.13.2"=>{"tar.bz2"=>"M/MS/MSTROUT/perl-5.13.2.tar.bz2","tar.gz"=>"M/MS/MSTROUT/perl-5.13.2.tar.gz",},"5.13.3"=>{"tar.bz2"=>"D/DA/DAGOLDEN/perl-5.13.3.tar.bz2","tar.gz"=>"D/DA/DAGOLDEN/perl-5.13.3.tar.gz",},"5.13.4"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.13.4.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.13.4.tar.gz",},"5.13.5"=>{"tar.bz2"=>"S/SH/SHAY/perl-5.13.5.tar.bz2","tar.gz"=>"S/SH/SHAY/perl-5.13.5.tar.gz",},"5.13.6"=>{"tar.bz2"=>"M/MI/MIYAGAWA/perl-5.13.6.tar.bz2","tar.gz"=>"M/MI/MIYAGAWA/perl-5.13.6.tar.gz",},"5.13.7"=>{"tar.bz2"=>"B/BI/BINGOS/perl-5.13.7.tar.bz2","tar.gz"=>"B/BI/BINGOS/perl-5.13.7.tar.gz",},"5.13.8"=>{"tar.bz2"=>"Z/ZE/ZEFRAM/perl-5.13.8.tar.bz2","tar.gz"=>"Z/ZE/ZEFRAM/perl-5.13.8.tar.gz",},"5.13.9"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.13.9.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.13.9.tar.gz",},"5.14.0"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0.tar.gz",},"5.14.0-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0-RC1.tar.gz",},"5.14.0-RC2"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0-RC2.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0-RC2.tar.gz",},"5.14.0-RC3"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0-RC3.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0-RC3.tar.gz",},"5.14.1-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.1-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.1-RC1.tar.gz",},"5.14.1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.1.tar.gz",},"5.14.2-RC1"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.14.2-RC1.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.14.2-RC1.tar.gz",},"5.14.2"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.14.2.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.14.2.tar.gz",},"5.15.0"=>{"tar.bz2"=>"D/DA/DAGOLDEN/perl-5.15.0.tar.bz2","tar.gz"=>"D/DA/DAGOLDEN/perl-5.15.0.tar.gz",},"5.15.1"=>{"tar.bz2"=>"Z/ZE/ZEFRAM/perl-5.15.1.tar.bz2","tar.gz"=>"Z/ZE/ZEFRAM/perl-5.15.1.tar.gz",},"5.15.2"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.15.2.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.15.2.tar.gz",},"5.15.3"=>{"tar.bz2"=>"S/ST/STEVAN/perl-5.15.3.tar.bz2","tar.gz"=>"S/ST/STEVAN/perl-5.15.3.tar.gz",},"5.15.4"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.15.4.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.15.4.tar.gz",},"5.15.5"=>{"tar.bz2"=>"S/SH/SHAY/perl-5.15.5.tar.bz2","tar.gz"=>"S/SH/SHAY/perl-5.15.5.tar.gz",},"5.15.6"=>{"tar.bz2"=>"D/DR/DROLSKY/perl-5.15.6.tar.bz2","tar.gz"=>"D/DR/DROLSKY/perl-5.15.6.tar.gz",},"5.6.0"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.0.tar.gz",},"5.6.1"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1.tar.gz",},"5.6.1-TRIAL1"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1-TRIAL1.tar.gz",},"5.6.1-TRIAL2"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1-TRIAL2.tar.gz",},"5.6.1-TRIAL3"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1-TRIAL3.tar.gz",},"5.6.2"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.6.2.tar.gz",},"5.7.0"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.0.tar.gz",},"5.7.1"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.1.tar.gz",},"5.7.2"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.2.tar.gz",},"5.7.3"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.3.tar.gz",},"5.8.0"=>{"tar.gz"=>"J/JH/JHI/perl-5.8.0.tar.gz",},"5.8.1"=>{"tar.gz"=>"J/JH/JHI/perl-5.8.1.tar.gz",},"5.8.2"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.2.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.2.tar.gz",},"5.8.3"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.3.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.3.tar.gz",},"5.8.4"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.4.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.4.tar.gz",},"5.8.5"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.5.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.5.tar.gz",},"5.8.6"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.6.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.6.tar.gz",},"5.8.7"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.7.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.7.tar.gz",},"5.8.8"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.8.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.8.tar.gz",},"5.8.9"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.9.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.9.tar.gz",},"5.9.0"=>{"tar.bz2"=>"H/HV/HVDS/perl-5.9.0.tar.bz2","tar.gz"=>"H/HV/HVDS/perl-5.9.0.tar.gz",},"5.9.1"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.1.tar.gz",},"5.9.2"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.2.tar.gz",},"5.9.3"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.3.tar.gz",},"5.9.4"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.4.tar.gz",},"5.9.5"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.5.tar.gz",},};sub perl_tarballs {my$vers=shift;$vers=shift if eval {$vers->isa(__PACKAGE__)};return unless exists$data->{$vers };return {%{$data->{$vers }}}}q|Acme::Why::Did::I::Not::Read::The::Fecking::Memo|;
+ package CPAN::Perl::Releases;{$CPAN::Perl::Releases::VERSION='0.46'}use strict;use warnings;use vars qw[@ISA @EXPORT_OK];use Exporter;@ISA=qw(Exporter);@EXPORT_OK=qw(perl_tarballs);our$data={"5.003_07"=>{"tar.gz"=>"A/AN/ANDYD/perl5.003_07.tar.gz",},"5.004"=>{"tar.gz"=>"C/CH/CHIPS/perl5.004.tar.gz",},"5.004_01"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_01.tar.gz",},"5.004_02"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_02.tar.gz",},"5.004_03"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_03.tar.gz",},"5.004_04"=>{"tar.gz"=>"T/TI/TIMB/perl5.004_04.tar.gz",},"5.004_05"=>{"tar.gz"=>"C/CH/CHIPS/perl5.004_05.tar.gz",},"5.005"=>{"tar.gz"=>"G/GS/GSAR/perl5.005.tar.gz",},"5.005_01"=>{"tar.gz"=>"G/GS/GSAR/perl5.005_01.tar.gz",},"5.005_02"=>{"tar.gz"=>"G/GS/GSAR/perl5.005_02.tar.gz",},"5.005_03"=>{"tar.gz"=>"G/GB/GBARR/perl5.005_03.tar.gz",},"5.005_04"=>{"tar.gz"=>"L/LB/LBROCARD/perl5.005_04.tar.gz",},"5.10.0"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.10.0.tar.gz",},"5.10.0-RC1"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.10.0-RC1.tar.gz",},"5.10.0-RC2"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.10.0-RC2.tar.gz",},"5.10.1"=>{"tar.bz2"=>"D/DA/DAPM/perl-5.10.1.tar.bz2","tar.gz"=>"D/DA/DAPM/perl-5.10.1.tar.gz",},"5.11.0"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.11.0.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.11.0.tar.gz",},"5.11.1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.11.1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.11.1.tar.gz",},"5.11.2"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.11.2.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.11.2.tar.gz",},"5.11.3"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.11.3.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.11.3.tar.gz",},"5.11.4"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.11.4.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.11.4.tar.gz",},"5.11.5"=>{"tar.bz2"=>"S/SH/SHAY/perl-5.11.5.tar.bz2","tar.gz"=>"S/SH/SHAY/perl-5.11.5.tar.gz",},"5.12.0"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.0.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.0.tar.gz",},"5.12.1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.1.tar.gz",},"5.12.1-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.1-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.1-RC1.tar.gz",},"5.12.1-RC2"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.1-RC2.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.1-RC2.tar.gz",},"5.12.2"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.2.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.2.tar.gz",},"5.12.2-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.12.2-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.12.2-RC1.tar.gz",},"5.12.3"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.12.3.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.12.3.tar.gz",},"5.12.4-RC1"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.12.4-RC1.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.12.4-RC1.tar.gz",},"5.12.4-RC2"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.12.4-RC2.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.12.4-RC2.tar.gz",},"5.12.4"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.12.4.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.12.4.tar.gz",},"5.13.0"=>{"tar.bz2"=>"L/LB/LBROCARD/perl-5.13.0.tar.bz2","tar.gz"=>"L/LB/LBROCARD/perl-5.13.0.tar.gz",},"5.13.1"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.13.1.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.13.1.tar.gz",},"5.13.10"=>{"tar.bz2"=>"A/AV/AVAR/perl-5.13.10.tar.bz2","tar.gz"=>"A/AV/AVAR/perl-5.13.10.tar.gz",},"5.13.11"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.13.11.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.13.11.tar.gz",},"5.13.2"=>{"tar.bz2"=>"M/MS/MSTROUT/perl-5.13.2.tar.bz2","tar.gz"=>"M/MS/MSTROUT/perl-5.13.2.tar.gz",},"5.13.3"=>{"tar.bz2"=>"D/DA/DAGOLDEN/perl-5.13.3.tar.bz2","tar.gz"=>"D/DA/DAGOLDEN/perl-5.13.3.tar.gz",},"5.13.4"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.13.4.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.13.4.tar.gz",},"5.13.5"=>{"tar.bz2"=>"S/SH/SHAY/perl-5.13.5.tar.bz2","tar.gz"=>"S/SH/SHAY/perl-5.13.5.tar.gz",},"5.13.6"=>{"tar.bz2"=>"M/MI/MIYAGAWA/perl-5.13.6.tar.bz2","tar.gz"=>"M/MI/MIYAGAWA/perl-5.13.6.tar.gz",},"5.13.7"=>{"tar.bz2"=>"B/BI/BINGOS/perl-5.13.7.tar.bz2","tar.gz"=>"B/BI/BINGOS/perl-5.13.7.tar.gz",},"5.13.8"=>{"tar.bz2"=>"Z/ZE/ZEFRAM/perl-5.13.8.tar.bz2","tar.gz"=>"Z/ZE/ZEFRAM/perl-5.13.8.tar.gz",},"5.13.9"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.13.9.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.13.9.tar.gz",},"5.14.0"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0.tar.gz",},"5.14.0-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0-RC1.tar.gz",},"5.14.0-RC2"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0-RC2.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0-RC2.tar.gz",},"5.14.0-RC3"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.0-RC3.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.0-RC3.tar.gz",},"5.14.1-RC1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.1-RC1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.1-RC1.tar.gz",},"5.14.1"=>{"tar.bz2"=>"J/JE/JESSE/perl-5.14.1.tar.bz2","tar.gz"=>"J/JE/JESSE/perl-5.14.1.tar.gz",},"5.14.2-RC1"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.14.2-RC1.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.14.2-RC1.tar.gz",},"5.14.2"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.14.2.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.14.2.tar.gz",},"5.15.0"=>{"tar.bz2"=>"D/DA/DAGOLDEN/perl-5.15.0.tar.bz2","tar.gz"=>"D/DA/DAGOLDEN/perl-5.15.0.tar.gz",},"5.15.1"=>{"tar.bz2"=>"Z/ZE/ZEFRAM/perl-5.15.1.tar.bz2","tar.gz"=>"Z/ZE/ZEFRAM/perl-5.15.1.tar.gz",},"5.15.2"=>{"tar.bz2"=>"R/RJ/RJBS/perl-5.15.2.tar.bz2","tar.gz"=>"R/RJ/RJBS/perl-5.15.2.tar.gz",},"5.15.3"=>{"tar.bz2"=>"S/ST/STEVAN/perl-5.15.3.tar.bz2","tar.gz"=>"S/ST/STEVAN/perl-5.15.3.tar.gz",},"5.15.4"=>{"tar.bz2"=>"F/FL/FLORA/perl-5.15.4.tar.bz2","tar.gz"=>"F/FL/FLORA/perl-5.15.4.tar.gz",},"5.15.5"=>{"tar.bz2"=>"S/SH/SHAY/perl-5.15.5.tar.bz2","tar.gz"=>"S/SH/SHAY/perl-5.15.5.tar.gz",},"5.15.6"=>{"tar.bz2"=>"D/DR/DROLSKY/perl-5.15.6.tar.bz2","tar.gz"=>"D/DR/DROLSKY/perl-5.15.6.tar.gz",},"5.15.7"=>{"tar.bz2"=>"B/BI/BINGOS/perl-5.15.7.tar.bz2","tar.gz"=>"B/BI/BINGOS/perl-5.15.7.tar.gz",},"5.15.8"=>{"tar.bz2"=>"C/CO/CORION/perl-5.15.8.tar.bz2","tar.gz"=>"C/CO/CORION/perl-5.15.8.tar.gz",},"5.15.9"=>{"tar.bz2"=>"A/AB/ABIGAIL/perl-5.15.9.tar.bz2","tar.gz"=>"A/AB/ABIGAIL/perl-5.15.9.tar.gz",},"5.6.0"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.0.tar.gz",},"5.6.1"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1.tar.gz",},"5.6.1-TRIAL1"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1-TRIAL1.tar.gz",},"5.6.1-TRIAL2"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1-TRIAL2.tar.gz",},"5.6.1-TRIAL3"=>{"tar.gz"=>"G/GS/GSAR/perl-5.6.1-TRIAL3.tar.gz",},"5.6.2"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.6.2.tar.gz",},"5.7.0"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.0.tar.gz",},"5.7.1"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.1.tar.gz",},"5.7.2"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.2.tar.gz",},"5.7.3"=>{"tar.gz"=>"J/JH/JHI/perl-5.7.3.tar.gz",},"5.8.0"=>{"tar.gz"=>"J/JH/JHI/perl-5.8.0.tar.gz",},"5.8.1"=>{"tar.gz"=>"J/JH/JHI/perl-5.8.1.tar.gz",},"5.8.2"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.2.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.2.tar.gz",},"5.8.3"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.3.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.3.tar.gz",},"5.8.4"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.4.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.4.tar.gz",},"5.8.5"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.5.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.5.tar.gz",},"5.8.6"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.6.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.6.tar.gz",},"5.8.7"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.7.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.7.tar.gz",},"5.8.8"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.8.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.8.tar.gz",},"5.8.9"=>{"tar.bz2"=>"N/NW/NWCLARK/perl-5.8.9.tar.bz2","tar.gz"=>"N/NW/NWCLARK/perl-5.8.9.tar.gz",},"5.9.0"=>{"tar.bz2"=>"H/HV/HVDS/perl-5.9.0.tar.bz2","tar.gz"=>"H/HV/HVDS/perl-5.9.0.tar.gz",},"5.9.1"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.1.tar.gz",},"5.9.2"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.2.tar.gz",},"5.9.3"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.3.tar.gz",},"5.9.4"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.4.tar.gz",},"5.9.5"=>{"tar.gz"=>"R/RG/RGARCIA/perl-5.9.5.tar.gz",},};sub perl_tarballs {my$vers=shift;$vers=shift if eval {$vers->isa(__PACKAGE__)};return unless exists$data->{$vers };return {%{$data->{$vers }}}}q|Acme::Why::Did::I::Not::Read::The::Fecking::Memo|;
CPAN_PERL_RELEASES
$fatpacked{"Capture/Tiny.pm"} = <<'CAPTURE_TINY';
- use 5.006;use strict;use warnings;package Capture::Tiny;our$VERSION='0.15';use Carp ();use Exporter ();use IO::Handle ();use File::Spec ();use File::Temp qw/tempfile tmpnam/;use Scalar::Util qw/reftype blessed/;BEGIN {local $@;eval {require PerlIO;PerlIO->can('get_layers')}or *PerlIO::get_layers=sub {return ()}}my%api=(capture=>[1,1,0,0],capture_stdout=>[1,0,0,0],capture_stderr=>[0,1,0,0],capture_merged=>[1,0,1,0],tee=>[1,1,0,1],tee_stdout=>[1,0,0,1],tee_stderr=>[0,1,0,1],tee_merged=>[1,0,1,1],);for my$sub (keys%api){my$args=join q{, },@{$api{$sub}};eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"}our@ISA=qw/Exporter/;our@EXPORT_OK=keys%api;our%EXPORT_TAGS=('all'=>\@EXPORT_OK);my$IS_WIN32=$^O eq 'MSWin32';our$TIMEOUT=30;my@cmd=($^X,'-e','$SIG{HUP}=sub{exit}; ' .'if( my $fn=shift ){ open my $fh, qq{>$fn}; print {$fh} $$; close $fh;} ' .'my $buf; while (sysread(STDIN, $buf, 2048)) { ' .'syswrite(STDOUT, $buf); syswrite(STDERR, $buf)}');sub _relayer {my ($fh,$layers)=@_;my%seen=(unix=>1,perlio=>1);my@unique=grep {!$seen{$_}++}@$layers;binmode($fh,join(":",":raw",@unique))}sub _name {my$glob=shift;no strict 'refs';return *{$glob}{NAME}}sub _open {open $_[0],$_[1]or Carp::confess "Error from open(" .join(q{, },@_)."): $!"}sub _close {close $_[0]or Carp::confess "Error from close(" .join(q{, },@_)."): $!"}my%dup;my%proxy_count;sub _proxy_std {my%proxies;if (!defined fileno STDIN){$proxy_count{stdin}++;if (defined$dup{stdin}){_open \*STDIN,"<&=" .fileno($dup{stdin})}else {_open \*STDIN,"<" .File::Spec->devnull;_open$dup{stdin}=IO::Handle->new,"<&=STDIN"}$proxies{stdin}=\*STDIN;binmode(STDIN,':utf8')if $] >= 5.008}if (!defined fileno STDOUT){$proxy_count{stdout}++;if (defined$dup{stdout}){_open \*STDOUT,">&=" .fileno($dup{stdout})}else {_open \*STDOUT,">" .File::Spec->devnull;_open$dup{stdout}=IO::Handle->new,">&=STDOUT"}$proxies{stdout}=\*STDOUT;binmode(STDOUT,':utf8')if $] >= 5.008}if (!defined fileno STDERR){$proxy_count{stderr}++;if (defined$dup{stderr}){_open \*STDERR,">&=" .fileno($dup{stderr})}else {_open \*STDERR,">" .File::Spec->devnull;_open$dup{stderr}=IO::Handle->new,">&=STDERR"}$proxies{stderr}=\*STDERR;binmode(STDERR,':utf8')if $] >= 5.008}return%proxies}sub _unproxy {my (%proxies)=@_;for my$p (keys%proxies){$proxy_count{$p}--;if (!$proxy_count{$p}){_close$proxies{$p};_close$dup{$p}unless $] < 5.008;delete$dup{$p}}}}sub _copy_std {my%handles=map {$_,IO::Handle->new}qw/stdin stdout stderr/;_open$handles{stdin},"<&STDIN";_open$handles{stdout},">&STDOUT";_open$handles{stderr},">&STDERR";return \%handles}sub _open_std {my ($handles)=@_;_open \*STDIN,"<&" .fileno$handles->{stdin};_open \*STDOUT,">&" .fileno$handles->{stdout};_open \*STDERR,">&" .fileno$handles->{stderr}}sub _start_tee {my ($which,$stash)=@_;$stash->{$_}{$which}=IO::Handle->new for qw/tee reader/;pipe$stash->{reader}{$which},$stash->{tee}{$which};select((select($stash->{tee}{$which}),$|=1)[0]);$stash->{new}{$which}=$stash->{tee}{$which};$stash->{child}{$which}={stdin=>$stash->{reader}{$which},stdout=>$stash->{old}{$which},stderr=>$stash->{capture}{$which},};$stash->{flag_files}{$which}=scalar tmpnam();if ($IS_WIN32){local $@;eval "use Win32API::File qw/CloseHandle GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";my$os_fhandle=GetOsFHandle($stash->{tee}{$which});if (SetHandleInformation($os_fhandle,HANDLE_FLAG_INHERIT(),0)){}else {}_open_std($stash->{child}{$which});$stash->{pid}{$which}=system(1,@cmd,$stash->{flag_files}{$which})}else {_fork_exec($which,$stash)}}sub _fork_exec {my ($which,$stash)=@_;my$pid=fork;if (not defined$pid){Carp::confess "Couldn't fork(): $!"}elsif ($pid==0){untie*STDIN;untie*STDOUT;untie*STDERR;_close$stash->{tee}{$which};_open_std($stash->{child}{$which});exec@cmd,$stash->{flag_files}{$which}}$stash->{pid}{$which}=$pid}my$have_usleep=eval "use Time::HiRes 'usleep'; 1";sub _files_exist {return 1 if @_==grep {-f}@_;Time::HiRes::usleep(1000)if$have_usleep;return 0}sub _wait_for_tees {my ($stash)=@_;my$start=time;my@files=values %{$stash->{flag_files}};my$timeout=defined$ENV{PERL_CAPTURE_TINY_TIMEOUT}? $ENV{PERL_CAPTURE_TINY_TIMEOUT}: $TIMEOUT;1 until _files_exist(@files)|| ($timeout && (time - $start > $timeout));Carp::confess "Timed out waiting for subprocesses to start" if!_files_exist(@files);unlink $_ for@files}sub _kill_tees {my ($stash)=@_;if ($IS_WIN32){CloseHandle(GetOsFHandle($_))for values %{$stash->{tee}};my$start=time;1 until wait==-1 || (time - $start > 30)}else {_close $_ for values %{$stash->{tee}};waitpid $_,0 for values %{$stash->{pid}}}}sub _slurp {my ($name,$stash)=@_;my ($fh,$pos)=map {$stash->{$_}{$name}}qw/capture pos/;seek($fh,$pos,0)or die "Couldn't seek on capture handle for $name\n";my$text=do {local $/;scalar readline$fh};return defined($text)? $text : ""}sub _capture_tee {my ($do_stdout,$do_stderr,$do_merge,$do_tee,$code,@opts)=@_;my%do=($do_stdout ? (stdout=>1): (),$do_stderr ? (stderr=>1): ());Carp::confess("Custom capture options must be given as key/value pairs\n")unless@opts % 2==0;my$stash={capture=>{@opts }};for (keys %{$stash->{capture}}){my$fh=$stash->{capture}{$_};Carp::confess "Custom handle for $_ must be seekable\n" unless ref($fh)eq 'GLOB' || (blessed($fh)&& $fh->isa("IO::Seekable"))}local*CT_ORIG_STDIN=*STDIN ;local*CT_ORIG_STDOUT=*STDOUT;local*CT_ORIG_STDERR=*STDERR;my%layers=(stdin=>[PerlIO::get_layers(\*STDIN)],stdout=>[PerlIO::get_layers(\*STDOUT)],stderr=>[PerlIO::get_layers(\*STDERR)],);$layers{stdout}=[PerlIO::get_layers(tied*STDOUT)]if tied(*STDOUT)&& (reftype tied*STDOUT eq 'GLOB');$layers{stderr}=[PerlIO::get_layers(tied*STDERR)]if tied(*STDERR)&& (reftype tied*STDERR eq 'GLOB');my%localize;$localize{stdin}++,local(*STDIN)if grep {$_ eq 'scalar'}@{$layers{stdin}};$localize{stdout}++,local(*STDOUT)if$do_stdout && grep {$_ eq 'scalar'}@{$layers{stdout}};$localize{stderr}++,local(*STDERR)if ($do_stderr || $do_merge)&& grep {$_ eq 'scalar'}@{$layers{stderr}};$localize{stdout}++,local(*STDOUT),_open(\*STDOUT,">&=1")if$do_stdout && tied*STDOUT && $] >= 5.008;$localize{stderr}++,local(*STDERR),_open(\*STDERR,">&=2")if ($do_stderr || $do_merge)&& tied*STDERR && $] >= 5.008;my%proxy_std=_proxy_std();$layers{stdin}=[PerlIO::get_layers(\*STDIN)]if$proxy_std{stdin};$layers{stdout}=[PerlIO::get_layers(\*STDOUT)]if$proxy_std{stdout};$layers{stderr}=[PerlIO::get_layers(\*STDERR)]if$proxy_std{stderr};$stash->{old}=_copy_std();$stash->{new}={%{$stash->{old}}};for (keys%do){$stash->{new}{$_}=($stash->{capture}{$_}||=File::Temp->new);seek($stash->{capture}{$_},0,2)or die "Could not seek on capture handle for $_\n";$stash->{pos}{$_}=tell$stash->{capture}{$_};_start_tee($_=>$stash)if$do_tee}_wait_for_tees($stash)if$do_tee;$stash->{new}{stderr}=$stash->{new}{stdout}if$do_merge;_open_std($stash->{new});my ($exit_code,$inner_error,$outer_error,@result);{local*STDIN=*CT_ORIG_STDIN if$localize{stdin};local*STDERR=*STDOUT if$do_merge;_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;local $@;eval {@result=$code->();$inner_error=$@};$exit_code=$?;$outer_error=$@}_open_std($stash->{old});_close($_)for values %{$stash->{old}};_unproxy(%proxy_std);_kill_tees($stash)if$do_tee;my%got;for (keys%do){_relayer($stash->{capture}{$_},$layers{$_});$got{$_}=_slurp($_,$stash)}print CT_ORIG_STDOUT$got{stdout}if$do_stdout && $do_tee && $localize{stdout};print CT_ORIG_STDERR$got{stderr}if$do_stderr && $do_tee && $localize{stderr};$?=$exit_code;$@=$inner_error if$inner_error;die$outer_error if$outer_error;my@return;push@return,$got{stdout}if$do_stdout;push@return,$got{stderr}if$do_stderr;push@return,@result;return wantarray ? @return : $return[0]}1;
+ use 5.006;use strict;use warnings;package Capture::Tiny;our$VERSION='0.17';use Carp ();use Exporter ();use IO::Handle ();use File::Spec ();use File::Temp qw/tempfile tmpnam/;use Scalar::Util qw/reftype blessed/;BEGIN {local $@;eval {require PerlIO;PerlIO->can('get_layers')}or *PerlIO::get_layers=sub {return ()}}my%api=(capture=>[1,1,0,0],capture_stdout=>[1,0,0,0],capture_stderr=>[0,1,0,0],capture_merged=>[1,0,1,0],tee=>[1,1,0,1],tee_stdout=>[1,0,0,1],tee_stderr=>[0,1,0,1],tee_merged=>[1,0,1,1],);for my$sub (keys%api){my$args=join q{, },@{$api{$sub}};eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"}our@ISA=qw/Exporter/;our@EXPORT_OK=keys%api;our%EXPORT_TAGS=('all'=>\@EXPORT_OK);my$IS_WIN32=$^O eq 'MSWin32';our$TIMEOUT=30;my@cmd=($^X,'-e','$SIG{HUP}=sub{exit}; ' .'if( my $fn=shift ){ open my $fh, qq{>$fn}; print {$fh} $$; close $fh;} ' .'my $buf; while (sysread(STDIN, $buf, 2048)) { ' .'syswrite(STDOUT, $buf); syswrite(STDERR, $buf)}');sub _relayer {my ($fh,$layers)=@_;my%seen=(unix=>1,perlio=>1);my@unique=grep {!$seen{$_}++}@$layers;binmode($fh,join(":",":raw",@unique))}sub _name {my$glob=shift;no strict 'refs';return *{$glob}{NAME}}sub _open {open $_[0],$_[1]or Carp::confess "Error from open(" .join(q{, },@_)."): $!"}sub _close {close $_[0]or Carp::confess "Error from close(" .join(q{, },@_)."): $!"}my%dup;my%proxy_count;sub _proxy_std {my%proxies;if (!defined fileno STDIN){$proxy_count{stdin}++;if (defined$dup{stdin}){_open \*STDIN,"<&=" .fileno($dup{stdin})}else {_open \*STDIN,"<" .File::Spec->devnull;_open$dup{stdin}=IO::Handle->new,"<&=STDIN"}$proxies{stdin}=\*STDIN;binmode(STDIN,':utf8')if $] >= 5.008}if (!defined fileno STDOUT){$proxy_count{stdout}++;if (defined$dup{stdout}){_open \*STDOUT,">&=" .fileno($dup{stdout})}else {_open \*STDOUT,">" .File::Spec->devnull;_open$dup{stdout}=IO::Handle->new,">&=STDOUT"}$proxies{stdout}=\*STDOUT;binmode(STDOUT,':utf8')if $] >= 5.008}if (!defined fileno STDERR){$proxy_count{stderr}++;if (defined$dup{stderr}){_open \*STDERR,">&=" .fileno($dup{stderr})}else {_open \*STDERR,">" .File::Spec->devnull;_open$dup{stderr}=IO::Handle->new,">&=STDERR"}$proxies{stderr}=\*STDERR;binmode(STDERR,':utf8')if $] >= 5.008}return%proxies}sub _unproxy {my (%proxies)=@_;for my$p (keys%proxies){$proxy_count{$p}--;if (!$proxy_count{$p}){_close$proxies{$p};_close$dup{$p}unless $] < 5.008;delete$dup{$p}}}}sub _copy_std {my%handles=map {$_,IO::Handle->new}qw/stdin stdout stderr/;_open$handles{stdin},"<&STDIN";_open$handles{stdout},">&STDOUT";_open$handles{stderr},">&STDERR";return \%handles}sub _open_std {my ($handles)=@_;_open \*STDIN,"<&" .fileno$handles->{stdin};_open \*STDOUT,">&" .fileno$handles->{stdout};_open \*STDERR,">&" .fileno$handles->{stderr}}sub _start_tee {my ($which,$stash)=@_;$stash->{$_}{$which}=IO::Handle->new for qw/tee reader/;pipe$stash->{reader}{$which},$stash->{tee}{$which};select((select($stash->{tee}{$which}),$|=1)[0]);$stash->{new}{$which}=$stash->{tee}{$which};$stash->{child}{$which}={stdin=>$stash->{reader}{$which},stdout=>$stash->{old}{$which},stderr=>$stash->{capture}{$which},};$stash->{flag_files}{$which}=scalar tmpnam();if ($IS_WIN32){local $@;eval "use Win32API::File qw/CloseHandle GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";my$os_fhandle=GetOsFHandle($stash->{tee}{$which});if (SetHandleInformation($os_fhandle,HANDLE_FLAG_INHERIT(),0)){}else {}_open_std($stash->{child}{$which});$stash->{pid}{$which}=system(1,@cmd,$stash->{flag_files}{$which})}else {_fork_exec($which,$stash)}}sub _fork_exec {my ($which,$stash)=@_;my$pid=fork;if (not defined$pid){Carp::confess "Couldn't fork(): $!"}elsif ($pid==0){untie*STDIN;untie*STDOUT;untie*STDERR;_close$stash->{tee}{$which};_open_std($stash->{child}{$which});exec@cmd,$stash->{flag_files}{$which}}$stash->{pid}{$which}=$pid}my$have_usleep=eval "use Time::HiRes 'usleep'; 1";sub _files_exist {return 1 if @_==grep {-f}@_;Time::HiRes::usleep(1000)if$have_usleep;return 0}sub _wait_for_tees {my ($stash)=@_;my$start=time;my@files=values %{$stash->{flag_files}};my$timeout=defined$ENV{PERL_CAPTURE_TINY_TIMEOUT}? $ENV{PERL_CAPTURE_TINY_TIMEOUT}: $TIMEOUT;1 until _files_exist(@files)|| ($timeout && (time - $start > $timeout));Carp::confess "Timed out waiting for subprocesses to start" if!_files_exist(@files);unlink $_ for@files}sub _kill_tees {my ($stash)=@_;if ($IS_WIN32){CloseHandle(GetOsFHandle($_))for values %{$stash->{tee}};my$start=time;1 until wait==-1 || (time - $start > 30)}else {_close $_ for values %{$stash->{tee}};waitpid $_,0 for values %{$stash->{pid}}}}sub _slurp {my ($name,$stash)=@_;my ($fh,$pos)=map {$stash->{$_}{$name}}qw/capture pos/;seek($fh,$pos,0)or die "Couldn't seek on capture handle for $name\n";my$text=do {local $/;scalar readline$fh};return defined($text)? $text : ""}sub _capture_tee {my ($do_stdout,$do_stderr,$do_merge,$do_tee,$code,@opts)=@_;my%do=($do_stdout ? (stdout=>1): (),$do_stderr ? (stderr=>1): ());Carp::confess("Custom capture options must be given as key/value pairs\n")unless@opts % 2==0;my$stash={capture=>{@opts }};for (keys %{$stash->{capture}}){my$fh=$stash->{capture}{$_};Carp::confess "Custom handle for $_ must be seekable\n" unless ref($fh)eq 'GLOB' || (blessed($fh)&& $fh->isa("IO::Seekable"))}local*CT_ORIG_STDIN=*STDIN ;local*CT_ORIG_STDOUT=*STDOUT;local*CT_ORIG_STDERR=*STDERR;my%layers=(stdin=>[PerlIO::get_layers(\*STDIN)],stdout=>[PerlIO::get_layers(\*STDOUT)],stderr=>[PerlIO::get_layers(\*STDERR)],);$layers{stdout}=[PerlIO::get_layers(tied*STDOUT)]if tied(*STDOUT)&& (reftype tied*STDOUT eq 'GLOB');$layers{stderr}=[PerlIO::get_layers(tied*STDERR)]if tied(*STDERR)&& (reftype tied*STDERR eq 'GLOB');my%localize;$localize{stdin}++,local(*STDIN)if grep {$_ eq 'scalar'}@{$layers{stdin}};$localize{stdout}++,local(*STDOUT)if$do_stdout && grep {$_ eq 'scalar'}@{$layers{stdout}};$localize{stderr}++,local(*STDERR)if ($do_stderr || $do_merge)&& grep {$_ eq 'scalar'}@{$layers{stderr}};$localize{stdout}++,local(*STDOUT),_open(\*STDOUT,">&=1")if$do_stdout && tied*STDOUT && $] >= 5.008;$localize{stderr}++,local(*STDERR),_open(\*STDERR,">&=2")if ($do_stderr || $do_merge)&& tied*STDERR && $] >= 5.008;my%proxy_std=_proxy_std();$layers{stdin}=[PerlIO::get_layers(\*STDIN)]if$proxy_std{stdin};$layers{stdout}=[PerlIO::get_layers(\*STDOUT)]if$proxy_std{stdout};$layers{stderr}=[PerlIO::get_layers(\*STDERR)]if$proxy_std{stderr};$stash->{old}=_copy_std();$stash->{new}={%{$stash->{old}}};for (keys%do){$stash->{new}{$_}=($stash->{capture}{$_}||=File::Temp->new);seek($stash->{capture}{$_},0,2)or die "Could not seek on capture handle for $_\n";$stash->{pos}{$_}=tell$stash->{capture}{$_};_start_tee($_=>$stash)if$do_tee}_wait_for_tees($stash)if$do_tee;$stash->{new}{stderr}=$stash->{new}{stdout}if$do_merge;_open_std($stash->{new});my ($exit_code,$inner_error,$outer_error,@result);{local*STDIN=*CT_ORIG_STDIN if$localize{stdin};local*STDERR=*STDOUT if$do_merge;_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;local $@;eval {@result=$code->();$inner_error=$@};$exit_code=$?;$outer_error=$@}_open_std($stash->{old});_close($_)for values %{$stash->{old}};_unproxy(%proxy_std);_kill_tees($stash)if$do_tee;my%got;for (keys%do){_relayer($stash->{capture}{$_},$layers{$_});$got{$_}=_slurp($_,$stash)}print CT_ORIG_STDOUT$got{stdout}if$do_stdout && $do_tee && $localize{stdout};print CT_ORIG_STDERR$got{stderr}if$do_stderr && $do_tee && $localize{stderr};$?=$exit_code;$@=$inner_error if$inner_error;die$outer_error if$outer_error;my@return;push@return,$got{stdout}if$do_stdout;push@return,$got{stderr}if$do_stderr;push@return,@result;return wantarray ? @return : $return[0]}1;
CAPTURE_TINY
$fatpacked{"File/Path/Tiny.pm"} = <<'FILE_PATH_TINY';
- package File::Path::Tiny;$File::Path::Tiny::VERSION=0.1;sub mk {my ($path,$mask)=@_;return 2 if -d $path;if (-e $path){$!=20;return}$mask ||='0777';$mask=oct($mask)if substr($mask,0,1)eq '0';require File::Spec;my ($progressive,@parts)=File::Spec->splitdir($path);if (!$progressive){$progressive=File::Spec->catdir($progressive,shift(@parts))}if(!-d $progressive){mkdir($progressive,$mask)or return}for my$part (@parts){$progressive=File::Spec->catdir($progressive,$part);if (!-d $progressive){mkdir($progressive,$mask)or return}}return 1 if -d $path;return}sub rm {my ($path)=@_;if (-e $path &&!-d $path){$!=20;return}return 2 if!-d $path;opendir(DIR,$path)or return;my@contents=grep {$_ ne '.' && $_ ne '..'}readdir(DIR);closedir DIR;require File::Spec if@contents;for my$thing (@contents){my$long=File::Spec->catdir($path,$thing);if (!-l $long && -d $long){rm($long)or return}else {unlink$long or return}}rmdir($path)or return;return 1}1;
+ package File::Path::Tiny;$File::Path::Tiny::VERSION=0.3;sub mk {my ($path,$mask)=@_;return 2 if -d $path;if (-e $path){$!=20;return}$mask ||='0777';$mask=oct($mask)if substr($mask,0,1)eq '0';require File::Spec;my ($progressive,@parts)=File::Spec->splitdir($path);if (!$progressive){$progressive=File::Spec->catdir($progressive,shift(@parts))}if (!-d $progressive){mkdir($progressive,$mask)or return}for my$part (@parts){$progressive=File::Spec->catdir($progressive,$part);if (!-d $progressive){mkdir($progressive,$mask)or return}}return 1 if -d $path;return}sub rm {my ($path)=@_;if (-e $path &&!-d $path){$!=20;return}return 2 if!-d $path;empty_dir($path)or return;rmdir($path)or return;return 1}sub empty_dir {my ($path)=@_;if (-e $path &&!-d $path){$!=20;return}opendir(DIR,$path)or return;my@contents=grep {$_ ne '.' && $_ ne '..'}readdir(DIR);closedir DIR;require File::Spec if@contents;for my$thing (@contents){my$long=File::Spec->catdir($path,$thing);if (!-l $long && -d $long){rm($long)or return}else {unlink$long or return}}return 1}1;
FILE_PATH_TINY
$fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
@@ -349,6 +433,10 @@ your terminal:
curl -kL http://install.perlbrew.pl | bash
+Or this one, if you have C<fetch> (default on FreeBSD):
+
+ fetch -o- http://install.perlbrew.pl | sh
+
After that, C<perlbrew> installs itself to C<~/perl5/perlbrew/bin>, and you
should follow the instruction on screen to modify your shell rc file to put it
in your PATH.
View
2 perlbrew-install
@@ -17,6 +17,8 @@ LOCALINSTALLER="perlbrew-$$"
echo
if type curl >/dev/null 2>&1; then
PERLBREWDOWNLOAD="curl -k -f -sS -Lo $LOCALINSTALLER $PERLBREWURL"
+elif type fetch >/dev/null 2>&1; then
+ PERLBREWDOWNLOAD="fetch -o $LOCALINSTALLER $PERLBREWURL"
elif type wget >/dev/null 2>&1; then
PERLBREWDOWNLOAD="wget --no-check-certificate -nv -O $LOCALINSTALLER $PERLBREWURL"
else
View
19 t/command-lib.t
@@ -24,6 +24,24 @@ describe "lib command," => sub {
} qr/usage/i;
};
+ describe "without lib name" => sub {
+ it "create errs gracefully showing usage" => sub {
+ my $app = App::perlbrew->new;
+ throws_ok {
+ $app->{args} = [ "lib", "create"];
+ $app->run;
+ } qr/ERROR: /i;
+ };
+ it "delte errs gracefully showing usage" => sub {
+ my $app = App::perlbrew->new;
+ throws_ok {
+ $app->{args} = [ "lib", "delete"];
+ $app->run;
+ } qr/ERROR: /i;
+ };
+ };
+
+
describe "`create` sub-command," => sub {
my ($app, $libdir);
@@ -123,4 +141,3 @@ describe "lib command," => sub {
};
runtests unless caller;
-
View
3 t/installation-perlbrew.t
@@ -25,6 +25,9 @@ subtest "`perlbrew self-install` initialize the required dir structure under PER
ok -f file($ENV{PERLBREW_ROOT}, "bin", "perlbrew");
ok -f file($ENV{PERLBREW_ROOT}, "etc", "bashrc");
ok -f file($ENV{PERLBREW_ROOT}, "etc", "cshrc");
+ ok -f file($ENV{PERLBREW_ROOT}, "etc", "csh_reinit");
+ ok -f file($ENV{PERLBREW_ROOT}, "etc", "csh_set_path");
+ ok -f file($ENV{PERLBREW_ROOT}, "etc", "csh_wrapper");
};
done_testing;

0 comments on commit 9934afe

Please sign in to comment.