perlbrew

#!/usr/bin/env perl
# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;

$fatpacked{"App/perlbrew.pm"} = <<'APP_PERLBREW';
  package App::perlbrew;
  use strict;
  use warnings;
  use 5.008;
  use Getopt::Long ();
  use File::Spec::Functions qw( catfile );
  use File::Path::Tiny;
  use FindBin;
  
  our $VERSION = "0.28";
  our $CONF;
  
  my $ROOT             = $ENV{PERLBREW_ROOT} || "$ENV{HOME}/perl5/perlbrew";
  my $PB_HOME          = $ENV{PERLBREW_HOME} || "$ENV{HOME}/.perlbrew";
  my $CONF_FILE        = catfile( $ROOT, 'Conf.pm' );
  my $CURRENT_PERL     = $ENV{PERLBREW_PERL};
  my $SIMILAR_DISTANCE = 6;
  
  local $SIG{__DIE__} = sub {
      my $message = shift;
      warn $message;
      exit 1;
  };
  
  sub current_perl { $CURRENT_PERL || '' }
  
  sub BASHRC_CONTENT() {
      return <<'RC';
  if [[ -z "$PERLBREW_HOME" ]]; then
      export PERLBREW_HOME="$HOME/.perlbrew"
  fi
  
  if [[ ! -n "$PERLBREW_SKIP_INIT" ]]; then
      if [[ -f "$PERLBREW_HOME/init" ]]; then
          . "$PERLBREW_HOME/init"
      fi
  fi
  
  __perlbrew_reinit () {
      if [[ ! -d "$PERLBREW_HOME" ]]; then
          mkdir -p "$PERLBREW_HOME"
      fi
  
      echo '# DO NOT EDIT THIS FILE' >| "$PERLBREW_HOME/init"
      command perlbrew env $1 >> "$PERLBREW_HOME/init"
      . "$PERLBREW_HOME/init"
      __perlbrew_set_path
  }
  
  __perlbrew_set_path () {
      [[ -z "$PERLBREW_ROOT" ]] && return 1
      [[ -n $(alias perl 2>/dev/null) ]] && unalias perl 2>/dev/null
  
      export PATH_WITHOUT_PERLBREW=$(perl -e 'print join ":", grep { index($_, $ENV{PERLBREW_ROOT}) } split/:/,$ENV{PATH};')
  
      if [[ -z "$PERLBREW_PATH" ]]; then
          export PERLBREW_PATH="$PERLBREW_ROOT/bin"
      fi
  
      export PATH=$PERLBREW_PATH:$PATH_WITHOUT_PERLBREW
  }
  __perlbrew_set_path
  
  perlbrew () {
      local exit_status
      local short_option
      export SHELL
  
      if [[ `echo $1 | awk 'BEGIN{FS=""}{print $1}'` = '-' ]]; then
          short_option=$1
          shift
      else
          short_option=""
      fi
  
      case $1 in
          (use)
              if [[ -z "$2" ]] ; then
                  if [[ -z "$PERLBREW_PERL" ]] ; then
                      echo "No version in use; defaulting to system"
                  else
                      echo "Using $PERLBREW_PERL version"
                  fi
              elif [[ -x "$PERLBREW_ROOT/perls/$2/bin/perl" ]]; then
                  eval $(command perlbrew $short_option env $2)
                  __perlbrew_set_path
              elif [[ -x "$PERLBREW_ROOT/perls/perl-$2/bin/perl" ]]; then
                  eval $(command perlbrew $short_option env "perl-$2")
                  __perlbrew_set_path
              else
                  echo "$2 is not installed" >&2
                  exit_status=1
              fi
              ;;
  
          (switch)
                if [[ -n "$2" ]] ; then
                    if [[ -x "$PERLBREW_ROOT/perls/$2/bin/perl" ]]; then
                        perlbrew $short_option use $2
                        __perlbrew_reinit $2
                    elif [[ -x "$PERLBREW_ROOT/perls/perl-$2/bin/perl" ]]; then
                        perlbrew $short_option use "perl-$2"
                        __perlbrew_reinit "perl-$2"
                    else
                        echo "$2 is not installed" >&2
                        exit_status=1
                    fi
                else
                    command perlbrew switch
                fi
                ;;
  
          (off)
              unset PERLBREW_PERL
              eval `perlbrew env`
              __perlbrew_set_path
              echo "perlbrew is turned off."
              ;;
  
          (switch-off)
              unset PERLBREW_PERL
              __perlbrew_reinit
              echo "perlbrew is switched off."
              ;;
  
          (*)
              command perlbrew $short_option "$@"
              exit_status=$?
              ;;
      esac
      hash -r
      return ${exit_status:-0}
  }
  
  RC
  
  }
  
  sub CSHRC_CONTENT {
      return <<'CSHRC';
  if ( $?PERLBREW_SKIP_INIT == 0 ) then
      if ( -f "$HOME/.perlbrew/init" ) then
          source "$HOME/.perlbrew/init"
      endif
  endif
  
  setenv PATH_WITHOUT_PERLBREW `perl -e 'print join ":", grep { index($_, $ENV{PERLBREW_ROOT}) } split/:/,$ENV{PATH};'`
  setenv PATH ${PERLBREW_PATH}:${PATH_WITHOUT_PERLBREW}
  CSHRC
  }
  
  sub mkpath {
      File::Path::Tiny::mk(@_);
  }
  
  sub rmpath {
      File::Path::Tiny::rm(@_)
  }
  
  {
  
  no warnings;
  
  # Text::Levenshtein::_min
  sub _min
  {
  	return $_[0] < $_[1]
  		? $_[0] < $_[2] ? $_[0] : $_[2]
  		: $_[1] < $_[2] ? $_[1] : $_[2];
  }
  
  # Text::Levenshtein::fastdistance
  sub fastdistance
  {
  	my $word1 = shift;
  	my $word2 = shift;
  
  	return 0 if $word1 eq $word2;
  	my @d;
  
  	my $len1 = length $word1;
  	my $len2 = length $word2;
  
  	$d[0][0] = 0;
  	for (1 .. $len1) {
  		$d[$_][0] = $_;
  		return $_ if $_!=$len1 && substr($word1,$_) eq substr($word2,$_);
  	}
  	for (1 .. $len2) {
  		$d[0][$_] = $_;
  		return $_ if $_!=$len2 && substr($word1,$_) eq substr($word2,$_);
  	}
  
  	for my $i (1 .. $len1) {
  		my $w1 = substr($word1,$i-1,1);
  		for (1 .. $len2) {
  			$d[$i][$_] = _min($d[$i-1][$_]+1, $d[$i][$_-1]+1, $d[$i-1][$_-1]+($w1 eq substr($word2,$_-1,1) ? 0 : 1));
  		}
  	}
  	return $d[$len1][$len2];
  }
  
  }
  
  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 = (
                  # curl's --fail option makes the exit code meaningful
                  [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' # Exit code is 22 on 404s etc
              and $? >> 8 == 22; # exit code is packed into $?; see perlvar
          die 'Server issued an error response.'
              if $command[0] eq 'wget' # Exit code is 8 on 404s etc
              and $? >> 8 == 8;
  
          return $cb ? $cb->($body) : $body;
      }
  }
  
  sub new {
      my($class, @argv) = @_;
  
      my %opt = (
          original_argv  => \@argv,
          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);
  
      $opt{args} = \@ARGV;
  
      # fix up the effect of 'bundling'
      foreach my $flags (@opt{qw(D U A)}) {
          foreach 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->get_args);
  }
  
  sub get_args {
      my ( $self ) = @_;
      return @{ $self->{args} };
  }
  
  sub get_command_list {
      my ( $self ) = @_;
  
      my $package =  ref $self ? ref $self : $self;
  
      my @commands;
      my $symtable = do {
          no strict 'refs';
          \%{$package . '::'};
      };
  
      foreach my $sym (keys %$symtable) {
          if($sym =~ /^run_command_/) {
              my $glob = $symtable->{$sym};
              if(defined *$glob{CODE}) {
                  $sym =~ s/^run_command_//;
                  push @commands, $sym;
              }
          }
      }
  
      return @commands;
  }
  
  sub find_similar_commands {
      my ( $self, $command ) = @_;
  
      my @commands = $self->get_command_list;
  
      foreach my $cmd (@commands) {
          my $dist = fastdistance($cmd, $command);
          if($dist < $SIMILAR_DISTANCE) {
              $cmd = [ $cmd, $dist ];
          } else {
              undef $cmd;
          }
      }
      @commands = grep { defined } @commands;
      @commands = sort { $a->[1] <=> $b->[1] } @commands;
      if(@commands) {
          my $best  = $commands[0][1];
          @commands = grep { $_->[1] == $best } @commands;
          @commands = map { $_->[0] } @commands;
      }
  
      return @commands;
  }
  
  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");
      }
  
      unless($s) {
          my @commands = $self->find_similar_commands($x);
  
          if(@commands > 1) {
              @commands = map { '    ' . $_ } @commands;
              die "Unknown command: `$x`. Did you mean one of the following?\n" . join("\n", @commands) . "\n";
          } elsif(@commands == 1) {
              die "Unknown command: `$x`. Did you mean `$commands[0]`?\n";
          } else {
              die "Unknown command: `$x`. Typo?\n";
          }
      }
  
      # Assume 5.12.3 means perl-5.12.3, for example.
      if ($x =~ /\A(?:switch|use|env)\Z/ and my $name = shift @args) {
          my $fullname = $self->resolve_installation_name($name);
          if ($fullname) {
              unshift @args, $fullname;
          }
          else {
              die "Unknown installation name: $name\n";
          }
      }
      elsif ($x eq 'install') {
          # prepend "perl-" to version number, but only if there is an argument
          $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";
  $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_available {
      my ( $self, $dist, $opts ) = @_;
  
      my @available = $self->get_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 get_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 run_command_init {
      my $self = shift;
      my $HOME = $self->env('HOME');
  
      mkpath($_) for (
          "$PB_HOME",
          "$ROOT/perls", "$ROOT/dists", "$ROOT/build", "$ROOT/etc",
          "$ROOT/bin"
      );
  
      open BASHRC, "> $ROOT/etc/bashrc";
      print BASHRC BASHRC_CONTENT;
      close BASHRC;
  
      open CSHRC, "> $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";
      }
      else {
          $shrc = $yourshrc = 'bashrc';
      }
  
      system("$0 env @{[ $self->current_perl ]}> ${PB_HOME}/init");
  
      $self->run_command_symlink_executables;
  
      my $root_dir = $self->path_with_tilde($ROOT);
      my $pb_home_dir = $self->path_with_tilde($PB_HOME);
  
      print <<INSTRUCTION;
  Perlbrew environment initiated, required directories are created under
  
      $root_dir
  
  Paste the following line(s) to the end of your ~/.${yourshrc} and start a
  new shell, perlbrew should be up and fully functional from there:
  
  INSTRUCTION
  
      if ($PB_HOME ne "$ENV{HOME}/.perlbrew") {
          print "export PERLBREW_HOME=$pb_home_dir\n";
      }
  
      print <<INSTRUCTION;
      source $root_dir/etc/${shrc}
  
  For further instructions, simply run `perlbrew` to see the help message.
  
  Enjoy perlbrew at \$HOME!!
  INSTRUCTION
  
  }
  
  sub run_command_install_perlbrew {
      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($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);
  
      http_get(
          'https://raw.github.com/gist/962406/5aa30dd2ec33cd9cea42ed2125154dcc1406edbc',
          undef,
          sub {
              my ( $body ) = @_;
  
              my $patchperl_path = catfile($ROOT, 'bin', 'patchperl');
  
              open my $fh, '>', $patchperl_path or die "Couldn't write patchperl: $!";
              print $fh $body;
              close $fh;
              chmod 0755, $patchperl_path;
          }
      );
  
      my $path = $self->path_with_tilde($target);
  
      print <<HELP;
  The perlbrew is installed as:
  
      $path
  
  You may trash the downloaded $executable from now on.
  
  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';
      # need the period to account for the file extension
      my ($dist_version) = $dist =~ m/-([\d.]+(?:-RC\d+)?|git)\./;
      my ($dist_tarball) = $dist =~ m{/([^/]*)$};
  
      my $dist_tarball_path = "$ROOT/dists/$dist_tarball";
      my $dist_tarball_url  = $dist;
      $dist = "$dist_name-$dist_version"; # we install it as this name later
  
      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;
  
      # Was broken on Solaris, where GNU tar is probably
      # installed as 'gtar' - RT #61042
      my $tarx =
          ($^O eq 'solaris' ? 'gtar ' : 'tar ') .
          ( $dist_tarball =~ m/bz2$/ ? 'xjf' : 'xzf' );
      my $extract_command = "cd $ROOT/build; $tarx $dist_tarball";
      die "Failed to extract $dist_tarball" if system($extract_command);
      $dist_tarball =~ s{.*/([^/]+)\.tar\.(?:gz|bz2)$}{$1};
      return "$ROOT/build/$dist_tarball"; # Note that this is incorrect for blead
  }
  
  sub do_install_blead {
      my $self = shift;
      my $dist = shift;
  
      my $dist_name           = 'perl';
      my $dist_git_describe   = 'blead';
      my $dist_version        = 'blead';
  
      # We always blindly overwrite anything that's already there,
      # because blead is a moving target.
      my $dist_tarball = 'blead.tar.gz';
      my $dist_tarball_path = "$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;
          }
      );
  
      # Returns the wrong extracted dir for blead
      $self->do_extract_tarball($dist_tarball_path);
  
      local *DIRH;
      opendir DIRH, "$ROOT/build" or die "Couldn't open $ROOT/build: $!";
      my @contents = readdir DIRH;
      closedir DIRH or warn "Couldn't close $ROOT/build: $!";
      my @candidates = grep { m/^perl-[0-9a-f]{7,8}$/ } @contents;
      # Use a Schwartzian Transform in case there are lots of dirs that
      # look like "perl-$SHA1", which is what's inside blead.tar.gz,
      # so we stat each one only once.
      @candidates =   map  { $_->[0] }
                      sort { $b->[1] <=> $a->[1] } # descending
                      map  { [ $_, (stat("$ROOT/build/$_"))[9] ] }
                          @candidates;
      my $dist_extracted_dir = "$ROOT/build/$candidates[0]"; # take the newest one
      $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 $mirror = $self->conf->{mirror};
      my $header = $mirror ? { 'Cookie' => "cpan=$mirror->{url}" } : undef;
      my $html = http_get("http://search.cpan.org/dist/$dist", $header);
  
      unless ($html) {
          die "ERROR: Failed to download $dist tarball.";
      }
  
      my ($dist_path, $dist_tarball) =
          $html =~ m[<a href="(/CPAN/authors/id/.+/(${dist}.tar.(gz|bz2)))">Download</a>];
      die "ERROR: Cannot find the tarball for $dist\n"
          if !$dist_path and !$dist_tarball;
  
      my $dist_tarball_path = "${ROOT}/dists/${dist_tarball}";
      my $dist_tarball_url  = "http://search.cpan.org${dist_path}";
  
      if (-f $dist_tarball_path) {
          print "Use the previously fetched ${dist_tarball}\n";
      }
      else {
          print "Fetching $dist as $dist_tarball_path\n";
          http_get(
              $dist_tarball_url,
              $header,
              sub {
                  my ($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_install_perlbrew();
          return
      }
  
      my $installation_name = $self->{as} || $dist;
      if ($self->is_installed( $installation_name )) {
          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) { # some kind of special install
          if (-d "$dist/.git") {
              $self->do_install_git($dist);
          }
          if (-f $dist) {
              $self->do_install_archive($dist);
          }
          elsif ($dist =~ m/^(?:https?|ftp|file)/) { # more protocols needed?
              $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} };
      $as = $self->{as} if $self->{as};
  
      unshift @d_options, qq(prefix=$ROOT/perls/$as);
      push @d_options, "usedevel" if $dist_version =~ /5\.1[13579]|git|blead/;
      print "Installing $dist_extracted_dir into " . $self->path_with_tilde("$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->path_with_tilde($self->{log_file}) ]}
  
  INSTALL
  
      my $configure_flags = '-des';
      $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";
      }
      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
      );
      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 (!system($cmd)) {
          unless (-e "$ROOT/perls/$as/bin/perl") {
              $self->run_command_symlink_executables($as);
          }
  
          print <<SUCCESS;
  Installed $dist_extracted_dir as $as successfully. Run the following command to switch to it.
  
    perlbrew switch $as
  
  SUCCESS
      }
      else {
          die <<FAIL;
  Installing $dist_extracted_dir failed. See $self->{log_file} to see why.
  If you want to force install the distribution, try:
  
    perlbrew --force install $self->{dist_name}
  
  FAIL
      }
      return;
  }
  
  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;
  
      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 => (current_perl eq $name),
              is_external => 0
          };
      }
  
      my $current_perl_executable = `which perl`;
      $current_perl_executable =~ s/\n$//;
  
      my $current_perl_executable_version;
      for ( grep { -f $_ && -x $_ } uniq map { s/\/+$//; "$_/perl" } split(":", $self->env('PATH')) ) {
          $current_perl_executable_version =
            $self->format_perl_version(`$_ -e 'print \$]'`);
          push @result, {
              name => $_,
              version => $current_perl_executable_version,
              is_current => $current_perl_executable && ($_ eq $current_perl_executable),
              is_external => 1
          } unless index($_, $ROOT) == 0;
      }
  
      return @result;
  }
  
  sub is_installed {
      my ($self, $name) = @_;
      my @installed = grep { !$_->{is_external} } $self->installed_perls;
      return grep { $name eq $_->{name} } @installed;
  }
  
  # 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) {
          if(-d "$ROOT/perls/$perl/bin") {
              $env{PERLBREW_PERL} = $perl;
              $env{PERLBREW_PATH} .= ":$ROOT/perls/$perl/bin";
          }
      }
      elsif ( $self->env("PERLBREW_PERL") ) {
          $env{PERLBREW_PERL} = $self->env("PERLBREW_PERL");
          $env{PERLBREW_PATH} .= ":$ROOT/perls/$env{PERLBREW_PERL}/bin";
      }
  
      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}) < $[) ? " ($i->{version})" : "",
              "\n";
      }
  }
  
  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;
      }
  
      my $shell = $self->env('SHELL');
      my %env = ($self->perlbrew_env($perl), PERLBREW_SKIP_INIT => 1);
  
      my $command = "env ";
      while (my ($k, $v) = each(%env)) {
          $command .= "$k=$v ";
      }
      $command .= " $shell";
  
      print "\nA sub-shell is launched with $perl as the activated perl. Run 'exit' to finish it.\n\n";
      exec($command);
  }
  
  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-/;
  
      my $vers = $dist;
  
      die "${dist} is not installed\n" unless -d "$ROOT/perls/${dist}";
  
      local $ENV{PERLBREW_PERL} = $dist;
      my $HOME = $self->env('HOME');
  
      mkpath("${HOME}/.perlbrew");
      system("$0 env $dist > ${HOME}/.perlbrew/init");
  
      print "Switched to $vers. To use it immediately, run this line in this terminal:\n\n    exec @{[ $self->env('SHELL') ]}\n\n";
  }
  
  sub run_command_off {
      my $self = shift;
  
      my $shell = $self->env('SHELL');
  
      $ENV{PERLBREW_PERL} = "";
      my %env = ($self->perlbrew_env, PERLBREW_SKIP_INIT => 1);
  
      my $command = "env ";
      while (my ($k, $v) = each(%env)) {
          $command .= "$k=$v ";
      }
      $command .= " $shell";
  
      print "\nA sub-shell is launched with perlbrew turned off. Run 'exit' to finish it.\n\n";
      exec($command);
  }
  
  sub run_command_switch_off {
      my $self = shift;
      my $pb_home = $self->env("PERLBREW_HOME") || $PB_HOME;
  
      mkpath($pb_home);
      system("env PERLBREW_PERL= $0 env > ${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 retrive the mirror list.\n\n";
      }
  
      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;
              $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->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|k|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, @perls) = @_;
  
      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 $body = http_get('https://github.com/miyagawa/cpanminus/raw/master/cpanm');
  
      unless ($body) {
          die "\nERROR: Failed to retrive cpanm executable.\n\n";
      }
  
      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_self_upgrade {
      my ($self) = @_;
  
      unless(-w $FindBin::Bin) {
          die "Your perlbrew installation appears to be system-wide.  Please upgrade through your package manager.\n";
      }
  
      http_get('https://raw.github.com/gugod/App-perlbrew/master/perlbrew', 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
  
  Usage: perlbrew uninstall <name>
  
      The name is the installation name as in the output of `perlbrew list`
  
  USAGE
      }
  
      my $dir = "$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 @args = @{$self->{original_argv}};
      shift @args;
  
      for my $i ( $self->installed_perls ) {
          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});
  
          print "$i->{name}\n==========\n";
          system @args;
          print "\n\n";
          # print "\n<===\n\n\n";
      }
  }
  
  sub run_command_clean {
      my ($self) = @_;
      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;
  
  Usage: perlbrew alias [-f] <action> <name> [<alias>]
  
      perlbrew alias create <name> <alias>
      perlbrew alias delete <alias>
      perlbrew alias rename <old_alias> <new_alias>
  
  USAGE
          return;
      }
  
      unless ( $self->is_installed($name) ) {
          die "\nABORT: The installation `${name}` does not exist.\n\n";
      }
  
      my $path_name  = catfile($ROOT, "perls", $name);
      my $path_alias = catfile($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 resolve_installation_name {
      my ($self, $name) = @_;
      die "App::perlbrew->resolve_installation_name requires one argument." unless $name;
  
      if ( $self->is_installed($name) ) {
          return $name;
      }
      elsif ($self->is_installed("perl-$name")) {
          return "perl-$name";
      }
  
      return undef;
  }
  
  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) = @_;
  
      if ( ! -e $CONF_FILE ) {
          local $CONF = {} if ! $CONF;
          $self->_save_conf;
      }
  
      open my $FH, '<', $CONF_FILE or die "Unable to open conf ($CONF_FILE): $!\n";
      my $raw = do { local $/; my $rv = <$FH>; $rv };
      close $FH;
  
      my $rv = eval $raw;
      if ( $@ ) {
          warn "Error loading conf: $@\n";
          $CONF = {};
          return;
      }
      $CONF = {} if ! $CONF;
      return;
  }
  
  1;
  
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  App::perlbrew - Manage perl installations in your $HOME
  
  =head1 SYNOPSIS
  
      # Initialize
      perlbrew init
  
      # Pick a preferred CPAN mirror
      perlbrew mirror
  
      # See what is available
      perlbrew available
  
      # Install some Perls
      perlbrew install 5.14.0
      perlbrew install perl-5.8.1
      perlbrew install perl-5.13.6
  
      # See what were installed
      perlbrew list
  
      # Switch perl in the $PATH
      perlbrew switch perl-5.12.2
      perl -v
  
      # Temporarily use another version only in current shell.
      perlbrew use perl-5.8.1
      perl -v
  
      # Or turn it off completely. Useful when you messed up too deep.
      # Or want to go back to the system Perl.
      perlbrew off
  
      # Use 'switch' command to turn it back on.
      perlbrew switch perl-5.12.2
  
      # Exec something with all perlbrew-ed perls
      perlbrew exec perl -E 'say $]'
  
  =head1 DESCRIPTION
  
  perlbrew is a program to automate the building and installation of
  perl in the users HOME. At the moment, it installs everything to
  C<~/perl5/perlbrew>, and requires you to tweak your PATH by including a
  bashrc/cshrc file it provides. You then can benefit from not having
  to run 'sudo' commands to install cpan modules because those are
  installed inside your HOME too. It's a completely separate perl
  environment.
  
  =head1 INSTALLATION
  
  To use C<perlbrew>, it is required to install C<curl> or C<wget>
  first. C<perlbrew> depends on one of this two external commmands to be
  there in order to fetch files from the internet.
  
  The recommended way to install perlbrew is to run this statement in
  your shell:
  
      curl -kL http://xrl.us/perlbrewinstall | bash
  
  After that, C<perlbrew> installs itself to C<~/perl5/perlbrew/bin>,
  and you should follow the instruction on screen to setup your
  C<.bashrc> or C<.cshrc> to put it in your PATH.
  
  The downloaded perlbrew is a self-contained standalone program that
  embeds all non-core modules it uses. It should be runnable with perl
  5.8 or later versions of perl.
  
  This installer also installs a packed version of C<patchperl> to
  C<~/perl5/perlbrew/bin>, which is required to build old perls.
  
  The directory C<~/perl5/perlbrew> will contain all install perl
  executables, libraries, documentations, lib, site_libs. If you need to
  install C<perlbrew>, and the perls it brews, into somewhere else
  because, say, your HOME has limited quota, you can do that by setting
  a C<PERLBREW_ROOT> environment variable before running the installer:
  
      export PERLBREW_ROOT=/opt/perlbrew
      curl -kL http://xrl.us/perlbrewinstall | bash
  
  By default, C<perlbrew> looks for the intialization file that exports
  C<PERLBREW_ROOT> in C<~/.perlbrew/init>.  In some cases (for instance,
  if your home directory is shared across multiple machines), you may
  wish to have several different perlbrew setting per-machine. If so,
  you can use the C<PERLBREW_HOME> environment variable to tell perlbrew
  where to look for the initialization file.
  
   # on machine a
   $ PERLBREW_HOME=~/.perlbrew-a PERLBREW_ROOT=~/perl5/perlbrew-a ./perlbrew install
  
   # on machine b
   $ PERLBREW_HOME=~/.perlbrew-b PERLBREW_ROOT=~/perl5/perlbrew-b ./perlbrew install
  
  If you specify C<PERLBREW_HOME>, you will also need to specify both
  C<PERLBREW_HOME> and C<PERLBREW_ROOT> when you first install perlbrew.
  After that, you'll need to make sure C<PERLBREW_HOME> is exported when
  you log in, before you source C<$PERLBREW_ROOT/etc/bashrc> (or
  C<cshrc>). Example C<.bashrc>:
  
      if [ "$(hostname)" == "machine-a" ]; then
          export PERLBREW_HOME=~/.perlbrew-a
          source ~/perl5/perlbrew-a/etc/bashrc
      elif [ "$(hostname)" == "machine-b" ]; then
          export PERLBREW_HOME=~/.perlbrew-b
          source ~/perl5/perlbrew-b/etc/bashrc
      fi
  
  You may also install perlbrew from CPAN:
  
      cpan App::perlbrew
  
  However, please make sure not to run this with one of the perls brewed
  with perlbrew. It's the best to turn perlbrew off before you run that,
  if you're upgrading.
  
      perlbrew off
      cpan App::perlbrew
  
  You should always use system cpan (like /usr/bin/cpan) to install
  C<App::perlbrew> because then it will be installed under a system PATH
  like C</usr/bin>, which is not affected by perlbrew C<switch> or
  C<use> command.
  
  However, it is still recommended to let C<perlbrew> install itself. It's
  easier, and it works better.
  
  =head1 USAGE
  
  Please read the program usage by running
  
      perlbrew
  
  (No arguments.) To read a more detailed one:
  
      perlbrew -h
  
  =head1 PROJECT DEVELOPMENT
  
  perlbrew project uses github
  L<http://github.com/gugod/App-perlbrew/issues> and RT
  <https://rt.cpan.org/Dist/Display.html?Queue=App-perlbrew> for issue
  tracking. Issues sent to these two systems will eventually be reviewed
  and handled.
  
  =head1 AUTHOR
  
  Kang-min Liu  C<< <gugod@gugod.org> >>
  
  =head1 COPYRIGHT
  
  Copyright (c) 2010, 2011 Kang-min Liu C<< <gugod@gugod.org> >>.
  
  =head1 LICENCE
  
  The MIT License
  
  =head1 CONTRIBUTORS
  
  See L<https://github.com/gugod/App-perlbrew/contributors>
  
  =head1 DISCLAIMER OF WARRANTY
  
  BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
  FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
  OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
  PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
  EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
  ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
  YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
  NECESSARY SERVICING, REPAIR, OR CORRECTION.
  
  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
  WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
  REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
  LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
  OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
  THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
  RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
  FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
  SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
  SUCH DAMAGES.
  
  =cut
APP_PERLBREW

$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'; # 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 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;
FILE_PATH_TINY

s/^  //mg for values %fatpacked;

unshift @INC, sub {
  if (my $fat = $fatpacked{$_[1]}) {
    open my $fh, '<', \$fat
      or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
    return $fh;
  }
  return
};

} # END OF FATPACK CODE
#!perl
use strict;
use 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
        uninstall      Uninstall the given installation
        list           List installed perls
        use            Use the specified perl in current shell
        available      List perls available to install
        switch         Permanently use the specified perl as default
        mirror         Pick a preferred mirror site
        off            Permanently turn off perlbrew, go back to system Perl
        version        Display version
        help           Read more detailed instructions

    Examples:
        perlbrew install perl-5.14.0
        perlbrew install 5.12.3

        perlbrew list

        perlbrew use perl-5.12.3
        perlbrew switch perl-5.14.0

        perlbrew switch /path/to/special/perl
        perlbrew switch /path/to/special/perl special-perl

        # later
        perlbrew switch special-perl


=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<install> perl-<version-number>

=item B<install> <version-number>

Build and install the given version of perl.

Version numbers usually look like "5.x.xx", or
"perl-5.xx.x-RCx" for release candidates.

The specified perl is downloaded from the CPAN website, unless mirror
setting are present.


=item B<install> perl-blead

=item B<install> blead

A special way to install the blead version of perl.

The blead version is downloaded from:

    http://perl5.git.perl.org/perl.git/snapshot/blead.tar.gz

This command does not consult mirror settings.


=item B<install> /path/to/perl/git/checkout/dir

Build and install from the given git checkout dir.

=item B<install> /path/to/perl-5.14.0.tar.gz

Build and install from the given archive file.

=item B<install> http://example.com/mirror/perl-5.12.3.tar.gz

Build and install from the given URL. Supported URL schemes are C<http://>,
C<https://>, C<ftp://> and C<file://>.

=item B<uninstall> <target>

Uninstalls the given version.

=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<list>

List the installed versions of perl.

=item B<available>

List the available versions of perl on CPAN.

=item B<use> [perl-<version>]

=item B<use> [<version>]

Use the given version perl in current shell. This will not effect newly opened
shells.

Without a parameter, shows the version of perl currently in use.

=item B<switch> [perl-<version>]

=item B<switch> [<version>]

Switch to the given version, and makes it the default for this and all
future terminal sessions.

Without a parameter, shows the version of perl currently selected.

=item B<alias> [-f] create <name> <alias>

Create an alias for the installation named <name>.

=item B<alias> [-f] rename <old_alias> <new_alias>

Rename the alias to a new name.

=item B<alias> delete <alias>

Delete the given alias.

=item B<off>

Temporarily disable perlbrew in the current shell.

Re-enables the default system Perl, whatever that is.

=item B<switch-off>

Permananently disable perlbrew. Use C<switch> command to re-enable it.

Re-enables the default system Perl, whatever that is.

=item B<exec> command

Execute command for all perls.

For example, run a Hello program:

    perlbrew exec perl -e 'print "Hello from $]\n"'

The output depends on your perl installations, and looks like this:

    perl-5.12.2
    ==========
    Hello word from perl-5.012002
    
    perl-5.12.3
    ==========
    Hello word from perl-5.012003
    
    perl-5.13.10
    ==========
    Hello word from perl-5.013010
    
    perl-5.14.0
    ==========
    Hello word from perl-5.014000

Notice that the command is not executed in parallel.

=item B<env> [perl-version]

Low-level command. Use this command to see the list of environment
variables that are set by C<perlbrew> itself for shell integration.

The output is something similar to this (if your shell is bash):

    export PERLBREW_ROOT=/Users/gugod/perl5/perlbrew
    export PERLBREW_VERSION=0.28
    export PERLBREW_PATH=/Users/gugod/perl5/perlbrew/bin:/Users/gugod/perl5/perlbrew/perls/current/bin
    export PERLBREW_PERL=perl-5.14.1

You can also ask for the proper variables for a specific perl version.

=item B<symlink_executables> <perl-version>

Low-level command. This command is used to create the C<perl> executable
symbolic link to, say, C<perl5.13.6>. This is only required for
development version of perls.

You don't need to do this unless you have been using old perlbrew to
install perls. The installation layout is changed since version 0.11.

If you just upgraded perlbrew (from 0.11 or earlier versions) and 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

Newly installed perls, whether they are development versions or not, does not
need manually treatment with this command.

=item B<install-cpanm>

Install the C<cpanm> standalone executable in C<$PERLBREW_ROOT/bin>.

For more rationale about the existence of this command, read
<http://www.perlbrew.pl/Perlbrew-and-Friends.html>

=item B<self-upgrade>

This command upgrades Perlbrew to its latest version.

=item B<version>

Show the version of perlbrew.

=back


=head1 OPTIONS

=over 4

=item B<-h| --help>

prints this help.

=item B<-f| --force>

Force installation of a perl.

=item B<-j>

Enable parallel make and test (if supported by the target perl)

  perlbrew install -j 5 perl-5.12.3

=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 as F<$PERLBREW_ROOT/build.log>, which is, by default, F<~/perl5/perlbrew/build.log>.

=item B<-v| --verbose>

Log output to STDOUT rather than a log file.

=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 UPGRADE NOTES

If you upgraded C<perlbrew> from version 0.16 or older, you should do
this cleanup your setup. Failure to do so might make the C<use>
command to fail.

Note the version of perl currently selected with C<perlbrew switch>.
Then turn C<perlbrew off>, and switched back again with C<perlbrew
switch previous-perl-version>.


=head1 SEE ALSO

L<App::perlbrew>, L<App::cpanminus>

=cut