Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 960 lines (739 sloc) 24.885 kb
#!/usr/bin/env perl
# DO NOT EDIT -- this is an auto generated file
package App::perlbrew;
use strict;
use warnings;
use 5.008;
use Getopt::Long ();
use File::Spec::Functions qw( catfile );
our $VERSION = "0.16";
our $CONF;
my $ROOT = $ENV{PERLBREW_ROOT} || "$ENV{HOME}/perl5/perlbrew";
my $CONF_FILE = catfile( $ROOT, 'Conf.pm' );
my $CURRENT_PERL = $ENV{PERLBREW_PERL};
sub current_perl { $CURRENT_PERL || '' }
sub BASHRC_CONTENT() {
return <<'RC';
if [[ -f $HOME/.perlbrew/init ]]; then
source $HOME/.perlbrew/init
fi
short_option=""
__perlbrew_reinit () {
echo '# DO NOT EDIT THIS FILE' > $HOME/.perlbrew/init
command perlbrew $short_option env $1 >> $HOME/.perlbrew/init
source $HOME/.perlbrew/init
__perlbrew_set_path
}
__perlbrew_set_path () {
[[ -z "$PERLBREW_ROOT" ]] && return 1
export PATH_WITHOUT_PERLBREW=$(perl -e 'print join ":", grep { index($_, $ENV{PERLBREW_ROOT}) } split/:/,$ENV{PATH};')
export PATH=$PERLBREW_PATH:$PATH_WITHOUT_PERLBREW
}
__perlbrew_set_path
perlbrew () {
local exit_status
if [[ `echo $1 | awk 'BEGIN{FS=""}{print $1}'` = '-' ]]; then
short_option=$1
shift
fi
case $1 in
(use)
if [[ -x "$PERLBREW_ROOT/perls/$2/bin/perl" ]]; then
eval $(command perlbrew $short_option env $2)
__perlbrew_set_path
elif [[ "$2" = "system" ]]; then
unset PERLBREW_PERL
eval $(command perlbrew $short_option env)
__perlbrew_set_path
else
echo "$2 is not installed" >&2
exit_status=1
fi
;;
(switch)
if [[ ! -d $HOME/.perlbrew ]]; then
mkdir -p $HOME/.perlbrew
fi
if [[ -x "$PERLBREW_ROOT/perls/$2/bin/perl" ]]; then
__perlbrew_reinit $2
elif [[ "$2" = "system" ]]; then
perlbrew off
return $?
else
echo "$2 is not installed" >&2
exit_status=1
fi
;;
(off)
if [[ ! -d $HOME/.perlbrew ]]; then
mkdir -p $HOME/.perlbrew
fi
unset PERLBREW_PERL
command perlbrew $short_option off
__perlbrew_reinit
;;
(*)
command perlbrew $short_option $*
exit_status=$?
;;
esac
hash -r
return ${exit_status:-0}
}
RC
}
# File::Path::Tiny::mk
sub mkpath {
my ($path,$mask) = @_;
return 2 if -d $path;
if (-e $path) { $! = 20;return; }
$mask ||= '0777'; # Perl::Critic == Integer with leading zeros at ...
$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 uniq(@) {
my %a;
grep { ++$a{$_} == 1 } @_;
}
{
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 )],
[qw( wget --no-check-certificate --quiet -O - )],
);
for my $command (@commands) {
my $program = $command->[0];
if (! system("$program --version >/dev/null 2>&1")) {
@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;
return $cb ? $cb->($body) : $body;
}
}
sub new {
my($class, @argv) = @_;
my %opt = (
force => 0,
quiet => 1,
D => [],
U => [],
A => [],
);
# build a local @ARGV to allow us to use an older
# Getopt::Long API in case we are building on an older system
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',
# options passed directly to Configure
'D=s@',
'U=s@',
'A=s@',
'j=i'
)
or run_command_help(1);
# fix up the effect of 'bundling'
foreach my $flags (@opt{qw(D U A)}) {
foreach my $value(@{$flags}) {
$value =~ s/^=//;
}
}
$opt{args} = \@ARGV;
return bless \%opt, $class;
}
sub env {
my ($self, $name) = @_;
return $ENV{$name} if $name;
return \%ENV;
}
sub run {
my($self) = @_;
$self->run_command($self->get_args);
}
sub get_args {
my ( $self ) = @_;
return @{ $self->{args} };
}
sub run_command {
my ( $self, $x, @args ) = @_;
$self->{log_file} ||= "$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);
}
my $s = $self->can("run_command_$x");
unless ($s) {
$x =~ s/-/_/;
$s = $self->can("run_command_$x");
}
die "Unknown command: `$x`. Typo?\n" unless $s;
$self->$s(@args);
}
sub run_command_version {
my ( $self ) = @_;
my $package = ref $self;
my $version = $self->VERSION;
print <<"VERSION";
$0 - $package/$version
VERSION
}
sub run_command_help {
my ($self, $status, $verbose) = @_;
require Pod::Usage;
Pod::Usage::pod2usage(-verbose => $verbose||0, -exitval => (defined $status ? $status : 1));
}
sub run_command_init {
my $self = shift;
my $HOME = $self->env('HOME');
mkpath($_) for (
"$HOME/.perlbrew",
"$ROOT/perls", "$ROOT/dists", "$ROOT/build", "$ROOT/etc",
"$ROOT/bin"
);
open BASHRC, "> $ROOT/etc/bashrc";
print BASHRC BASHRC_CONTENT;
system <<RC;
echo 'setenv PATH $ROOT/bin:$ROOT/perls/current/bin:\$PATH' > $ROOT/etc/cshrc
RC
my ( $shrc, $yourshrc );
if ( $self->env('SHELL') =~ /(t?csh)/ ) {
$shrc = 'cshrc';
$yourshrc = $1 . "rc";
}
else {
$shrc = $yourshrc = 'bashrc';
}
system("$0 env > ${HOME}/.perlbrew/init");
print <<INSTRUCTION;
Perlbrew environment initiated, required directories are created under
$ROOT
Well-done! Congratulations! Please add the following line to the end
of your ~/.${yourshrc}
source $ROOT/etc/${shrc}
After that, exit this shell, start a new one, and install some fresh
perls:
perlbrew install perl-5.12.1
perlbrew install perl-5.10.1
For further instructions, simply run:
perlbrew
The default help messages will popup and tell you what to do!
Enjoy perlbrew at \$HOME!!
INSTRUCTION
}
sub run_command_install {
my ( $self, $dist, $opts ) = @_;
unless ($dist) {
require File::Copy;
my $executable = $0;
unless (File::Spec->file_name_is_absolute($executable)) {
$executable = File::Spec->rel2abs($executable);
}
my $target = catfile($ROOT, "bin", "perlbrew");
if ($executable eq $target) {
print "You are already running the installed perlbrew:\n\n $executable\n";
exit;
}
mkpath("$ROOT/bin");
File::Copy::copy($executable, $target);
chmod(0755, $target);
print <<HELP;
The perlbrew is installed as:
$target
You may trash the downloaded $executable from now on.
Next, if this is the first time you install perlbrew, run:
$target init
And follow the instruction on screen.
HELP
return;
}
my ($dist_name, $dist_version) = $dist =~ m/^(.*)-([\d.]+(?:-RC\d+)?|git)$/;
my $dist_git_describe;
if (-d $dist && !$dist_name || !$dist_version) {
if (-d "$dist/.git") {
if (`git describe` =~ /v((5\.\d+\.\d+)(-\d+-\w+)?)$/) {
$dist_name = "perl";
$dist_git_describe = "v$1";
$dist_version = $2;
}
}
else {
print <<HELP;
The given directory $dist is not a git checkout of perl repository. To
brew a perl from git, clone it first:
git clone git://github.com/mirrors/perl.git
perlbrew install perl
HELP
return;
}
}
if ($dist_name eq 'perl') {
my ($dist_path, $dist_tarball, $dist_commit);
unless ($dist_git_describe) {
my $mirror = $self->conf->{mirror};
my $header = $mirror ? { 'Cookie' => "cpan=$mirror->{url}" } : undef;
my $html = http_get("http://search.cpan.org/dist/$dist", $header);
($dist_path, $dist_tarball) =
$html =~ m[<a href="(/CPAN/authors/id/.+/(${dist}.tar.(gz|bz2)))">Download</a>];
my $dist_tarball_path = "${ROOT}/dists/${dist_tarball}";
if (-f $dist_tarball_path) {
print "Use the previously fetched ${dist_tarball}\n";
}
else {
print "Fetching $dist as $dist_tarball_path\n";
http_get(
"http://search.cpan.org${dist_path}",
$header,
sub {
my ($body) = @_;
open my $BALL, "> $dist_tarball_path";
print $BALL $body;
close $BALL;
}
);
}
}
my @d_options = @{ $self->{D} };
my @u_options = @{ $self->{U} };
my @a_options = @{ $self->{A} };
my $as = $self->{as} || ($dist_git_describe ? "perl-$dist_git_describe" : $dist);
unshift @d_options, qq(prefix=$ROOT/perls/$as);
push @d_options, "usedevel" if $dist_version =~ /5\.1[13579]|git/ ? "-Dusedevel" : "";
print "Installing $dist into $ROOT/perls/$as\n";
print <<INSTALL if $self->{quiet} && !$self->{verbose};
This could take a while. You can run the following command on another shell to track the status:
tail -f $self->{log_file}
INSTALL
my ($extract_command, $configure_flags) = ("", "-des");
my $dist_extracted_dir;
if ($dist_git_describe) {
$extract_command = "echo 'Building perl in the git checkout dir'";
$dist_extracted_dir = File::Spec->rel2abs( $dist );
} else {
$dist_extracted_dir = "$ROOT/build/${dist}";
# Was broken on Solaris, where GNU tar is probably
# installed as 'gtar' - RT #61042
my $tarx = ($^O eq 'solaris' ? 'gtar ' : 'tar ') . ( $dist_tarball =~ /bz2/ ? 'xjf' : 'xzf' );
$extract_command = "cd $ROOT/build; $tarx $ROOT/dists/${dist_tarball}";
$configure_flags = '-de';
}
# 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
# development release before 5.8.0.
my $test_target = "test";
if ($dist_version =~ /^5\.(\d+)\.(\d+)/
&& ($1 >= 8 || $1 == 7 && $2 == 3)) {
$test_target = "test_harness";
}
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 ";",
(
$extract_command,
"cd $dist_extracted_dir",
"rm -f config.sh Policy.sh",
"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
);
$cmd = "($cmd) >> '$self->{log_file}' 2>&1 "
if ( $self->{quiet} && !$self->{verbose} );
print $cmd, "\n";
delete $ENV{$_} for qw(PERL5LIB PERL5OPT);
if (!system($cmd)) {
if ($dist_version =~ /5\.1[13579]|git/) {
$self->run_command_symlink_executables($as);
}
print <<SUCCESS;
Installed $dist as $as successfully. Run the following command to switch to it.
perlbrew switch $as
SUCCESS
}
else {
print <<FAIL;
Installing $dist failed. See $self->{log_file} to see why.
If you want to force install the distribution, try:
perlbrew --force install $dist_name
FAIL
}
}
}
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 $current = readlink("$ROOT/perls/current");
my @result;
for (<$ROOT/perls/*>) {
next if m/current/;
my ($name) = $_ =~ m/\/([^\/]+$)/;
push @result, { name => $name, is_current => (current_perl eq $name) };
}
my $current_perl_executable = readlink("$ROOT/bin/perl") || `which perl`;
$current_perl_executable =~ s/\n$//;
my $current_perl_executable_version;
for ( uniq grep { -f $_ && -x $_ } map { "$_/perl" } split(":", $self->env('PATH')) ) {
$current_perl_executable_version =
$self->format_perl_version(`$_ -e 'print \$]'`);
push @result, {
name => $_ . " (" . $current_perl_executable_version . ")",
is_current => $current_perl_executable && ($_ eq $current_perl_executable)
} unless index($_, $ROOT) == 0;
}
return @result;
}
# Return a hash of PERLBREW_* variables
sub perlbrew_env {
my ($self, $perl) = @_;
my %env = (
PERLBREW_VERSION => $VERSION,
PERLBREW_PATH => "$ROOT/bin",
PERLBREW_ROOT => $ROOT
);
if ($perl && -d "$ROOT/perls/$perl/bin") {
$env{PERLBREW_PERL} = $perl;
$env{PERLBREW_PATH} .= ":$ROOT/perls/$perl/bin";
}
return %env;
}
sub run_command_list {
my $self = shift;
for my $i ( $self->installed_perls ) {
print $i->{is_current} ? '* ': ' ', $i->{name}, "\n";
}
}
sub run_command_switch {
my ( $self, $dist ) = @_;
unless ( $dist ) {
# If no args were given to switch, show the current perl.
my $current = readlink ( -d "$ROOT/perls/current"
? "$ROOT/perls/current"
: "$ROOT/bin/perl" );
printf "Currently switched %s\n",
( $current ? "to $current" : 'off' );
return;
}
if (-x $dist) {
unlink "$ROOT/perls/current";
system "ln -fs $dist $ROOT/bin/perl";
print "Switched to $dist\n";
return;
}
die "${dist} is not installed\n" unless -d "$ROOT/perls/${dist}";
unlink "$ROOT/perls/current";
system "cd $ROOT/perls; ln -s $dist current";
for my $executable (<$ROOT/perls/current/bin/*>) {
my ($name) = $executable =~ m/bin\/(.+?)(5\.\d.*)?$/;
my $target = "$ROOT/bin/${name}";
next unless -l $target || !-e $target;
system("ln -fs $executable $target");
}
}
sub run_command_off {
local $_ = "$ROOT/perls/current";
unlink if -l;
for my $executable (<$ROOT/bin/*>) {
unlink($executable) if -l $executable;
}
}
sub run_command_mirror {
my($self) = @_;
print "Fetching mirror list\n";
my $raw = http_get("http://search.cpan.org/mirror");
my $found;
my @mirrors;
foreach 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) =~ s/&#(\d+);/chr $1/seg;
push @mirrors, { url => $url, name => $name };
}
}
my $select;
require ExtUtils::MakeMaker;
MIRROR: foreach my $id ( 0..$#mirrors ) {
my $mirror = $mirrors[$id];
printf "[% 3d] %s\n", $id + 1, $mirror->{name};
if ( $id > 0 ) {
my $test = $id / 19;
if ( $test == int $test ) {
my $remaining = $#mirrors - $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 );
next MIRROR if ! $val;
last MIRROR if $val eq 'q';
$select = $val;
if($select 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 };
}
elsif ( ! $select || $select - 1 > $#mirrors ) {
die "Bogus mirror ID: $select";
}
$select = $mirrors[$select - 1] unless ($select eq 'm');
die "Mirror ID is invalid" if ! $select;
last MIRROR;
}
}
}
die "You didn't select a mirror!\n" if ! $select;
print "Selected $select->{name} ($select->{url}) as the mirror\n";
my $conf = $self->conf;
$conf->{mirror} = $select;
$self->_save_conf;
return;
}
sub run_command_env {
my($self, $perl) = @_;
my %env = $self->perlbrew_env($perl);
if ($self->env('SHELL') =~ /(ba|z|\/)sh$/) {
while (my ($k, $v) = each(%env)) {
print "export $k=$v\n";
}
}
else {
while (my ($k, $v) = each(%env)) {
print "setenv $k $v\n";
}
}
}
sub run_command_symlink_executables {
my($self, $perl) = @_;
return "" unless $perl;
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 $body = http_get('https://github.com/miyagawa/cpanminus/raw/master/cpanm');
open my $CPANM, '>', "$ROOT/bin/cpanm" or die "cannot open file($ROOT/bin/cpanm): $!";
print $CPANM $body;
close $CPANM;
chmod 0755, "$ROOT/bin/cpanm";
print "cpanm is installed to $ROOT/bin/cpanm\n" if $self->{verbose};
}
sub run_command_exec {
my ($self, @args) = @_;
for my $i ( $self->installed_perls ) {
my %env = $self->perlbrew_env($i->{name});
my $command = "";
while ( my($name, $value) = each %env) {
$command .= "$name=$value ";
}
$command .= ' PATH=${PERLBREW_PATH}:${PATH} ';
$command .= "; " . join " ", map { quotemeta($_) } @args;
print "$i->{name}\n==========\n";
system "$command\n";
print "\n\n";
# print "\n<===\n\n\n";
}
}
sub conf {
my($self) = @_;
$self->_get_conf if ! $CONF;
return $CONF;
}
sub _save_conf {
my($self) = @_;
require Data::Dumper;
open my $FH, '>', $CONF_FILE or die "Unable to open conf ($CONF_FILE): $!";
my $d = Data::Dumper->new([$CONF],['App::perlbrew::CONF']);
print $FH $d->Dump;
close $FH;
}
sub _get_conf {
my($self) = @_;
print "Attempting to load conf from $CONF_FILE\n";
if ( ! -e $CONF_FILE ) {
local $CONF = {} if ! $CONF;
$self->_save_conf;
}
open my $FH, '<', $CONF_FILE or die "Unable to open conf ($CONF_FILE): $!";
my $raw = do { local $/; my $rv = <$FH>; $rv };
close $FH;
my $rv = eval $raw;
if ( $@ ) {
warn "Error loading conf: $@";
$CONF = {};
return;
}
$CONF = {} if ! $CONF;
return;
}
1;
$INC{'App/perlbrew.pm'} = __FILE__;
package main;
#!perl
use strict;
require App::perlbrew;
my $app = App::perlbrew->new(@ARGV);
$app->run();
__END__
=head1 NAME
perlbrew - Perl Environment manager.
=head1 SYNOPSIS
perlbrew <command> [options] [arguments]
Commonly used commands:
init Initialize perlbrew environment.
install Install perl
list List installed perls
use Use the specified perl in current shell
switch Permanently use the specified perl as default
mirror Pick a preffered mirror site
off Permanently turn off perlbrew
version Display version
help Read more detail instructions
Examples:
perlbrew install perl-5.12.2
perlbrew install perl-5.13.6
perlbrew list
perlbrew use perl-5.13.6
perlbrew switch perl-5.12.2
=head1 COMMANDS
=over 4
=item B<init>
Run this once to setup the C<perlbrew> directory ready for installing
perls into. Run it again if you decide to change C<PERLBREW_ROOT>.
=item B<mirror>
Run this if you want to choose a specific CPAN mirror to install the
perls from. It will display a list of mirrors for you to pick
from. Hit 'q' to cancel the selection.
=item B<install> perl-<version>
Build and install the given version of perl.
=item B<install> /path/to/perl/git/checkout/dir
Build and install from the given git checkout dir.
=item B<list>
List the installed versions of perl.
=item B<use> perl-<version>
Notice: this only works in bash and zsh.
Switch to the given version of perl only in the current shell. This
will not effect newly opened shells.
=item B<switch> perl-<version>
Switch to the given version. You may need to run 'rehash' (or 'hash
-r') after this command.
=item B<version>
Show the version of perbrew.
=item B<off>
Disable perlbrew. Use C<switch> command to re-enable it.
=item B<env>
Low-level command. Use this command to see the list of environment
variables that are set by C<perlbrew> itself for bash integration.
The output is something similar to this:
export PERLBREW_ROOT=/Users/gugod/perl5/perlbrew
export PERLBREW_VERSION=0.13
export PERLBREW_PATH=/Users/gugod/perl5/perlbrew/bin
=item B<symlink_executables> <perl-version>
Low-level command. Use this command to create the C<perl> executable
symbolic link to C<perl5.13.6>.
You don't need to do this unless you were using old perlbrew to
install perls. The installation layout is changed since version 0.11.
If you just upgraded perlbrew and found C<perlbrew switch> failed to work
after you switch to a development release of perl, say, perl-5.13.6, run this command:
perlbrew symlink_executables perl-5.13.6
This essentially creates this symlink:
${PERLBREW_ROOT}/perls/perl-5.13.6/bin/perl
-> ${PERLBREW_ROOT}/perls/perl-5.13.6/bin/perl5.13.6
=item B<install-cpanm>
Install the C<cpanm> standalone executable in C<$PERLBREW_ROOT/bin>.
=back
=head1 OPTIONS
=over 4
=item B<-h| --help>
prints this help.
=item B<-f| --force>
Force installation of a perl.
=item B<-n| --notest>
Skip the test suite
=item B<-q| --quiet>
Log output to a log file rather than STDOUT. This is the default. The log file is saved in F<$ROOT/build.log>
=item B<-v| --verbose>
Log output to STDOUT rather than a logfile.
=item B<--as>
Install a given perl under an alias.
perlbrew install perl-5.6.2 --as legacy-perl
=item B<-D>, B<-U>, B<-A>
pass through switches to the perl Configure script.
perlbrew install perl-5.10.1 -D usemymalloc -U uselargefiles
=back
=head1 CONFIGURATION
=over 4
=item PERLBREW_ROOT
By default, perlbrew builds and installs perls into
C<$ENV{HOME}/perl5/perlbrew> directory. To use a different directory,
set this environment variable in your C<bashrc> to the directory
before running perlbrew.
=back
=head1 SEE ALSO
L<App::perlbrew>, L<App::cpanminus>
=cut
Jump to Line
Something went wrong with that request. Please try again.