Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add support for upgrading older perls in-place.

This fixes GH #150
  • Loading branch information...
commit 8ccd855fd96da0f689797a9c6b7c0daf6e6d4c63 1 parent a8d7b46
@hoelzro authored
Showing with 107 additions and 0 deletions.
  1. +7 −0 bin/perlbrew
  2. +50 −0 lib/App/perlbrew.pm
  3. +50 −0 perlbrew
View
7 bin/perlbrew
@@ -26,6 +26,7 @@ Commands:
available List perls available to install
lib Manage local::lib directories.
alias Give perl installations a new name
+ upgrade-perl Upgrade the current perl
list List perl installations
use Use the specified perl in current shell
@@ -472,6 +473,12 @@ When C<use>ing or C<switch>ing to a lib, always provide the long name. A simple
rule: the argument to C<use> or C<siwtch> command should appear in the output of
C<perlbrew list>.
+=head1 COMMAND: UPGRADE-PERL
+
+Minor Perl releases (ex. 5.x.*) are binary compatible with one another, so
+this command offers you the ability to upgrade older perlbrew environments
+in place.
+
=head1 UPGRADE NOTES
If you plan to upgrade C<perlbrew> from version 0.16 or order to a recent
View
50 lib/App/perlbrew.pm
@@ -1722,6 +1722,56 @@ sub run_command_lib_list {
}
}
+sub run_command_upgrade_perl {
+ my ($self) = @_;
+
+ my $PERL_VERSION_RE = qr/(\d+)\.(\d+)\.(\d+)/;
+
+ my ( $current ) = grep { $_->{is_current} } $self->installed_perls;
+
+ unless(defined $current) {
+ print "no perlbrew environment is currently in use\n";
+ exit 1;
+ }
+
+ my ( $major, $minor, $release );
+
+ if($current->{version} =~ /^$PERL_VERSION_RE$/) {
+ ( $major, $minor, $release ) = ( $1, $2, $3 );
+ } else {
+ print "unable to parse version '$current->{version}'\n";
+ exit 1;
+ }
+
+ my @available = grep {
+ /^perl-$major\.$minor/
+ } $self->available_perls;
+
+ my $latest_available_perl = $release;
+
+ foreach my $perl (@available) {
+ if($perl =~ /^perl-$PERL_VERSION_RE$/) {
+ my $this_release = $3;
+ if($this_release > $latest_available_perl) {
+ $latest_available_perl = $this_release;
+ }
+ }
+ }
+
+ if($latest_available_perl == $release) {
+ print "This perlbrew environment ($current->{name}) is already up-to-date.\n";
+ exit 0;
+ }
+
+ my $dist_version = "$major.$minor.$latest_available_perl";
+ my $dist = "perl-$dist_version";
+
+ print "Upgrading $current->{name} to $dist_version\n";
+ local $self->{as} = $current->{name};
+ local $self->{dist_name} = $dist;
+ $self->do_install_release($dist);
+}
+
sub resolve_installation_name {
my ($self, $name) = @_;
die "App::perlbrew->resolve_installation_name requires one argument." unless $name;
View
50 perlbrew
@@ -1729,6 +1729,56 @@ $fatpacked{"App/perlbrew.pm"} = <<'APP_PERLBREW';
}
}
+ sub run_command_upgrade_perl {
+ my ($self) = @_;
+
+ my $PERL_VERSION_RE = qr/(\d+)\.(\d+)\.(\d+)/;
+
+ my ( $current ) = grep { $_->{is_current} } $self->installed_perls;
+
+ unless(defined $current) {
+ print "no perlbrew perl is currently in use\n";
+ exit 1;
+ }
+
+ my ( $major, $minor, $release );
+
+ if($current->{version} =~ /^$PERL_VERSION_RE$/) {
+ ( $major, $minor, $release ) = ( $1, $2, $3 );
+ } else {
+ print "unable to parse version '$current->{version}'\n";
+ exit 1;
+ }
+
+ my @available = grep {
+ /^perl-$major\.$minor/
+ } $self->available_perls;
+
+ my $latest_available_perl = $release;
+
+ foreach my $perl (@available) {
+ if($perl =~ /^perl-$PERL_VERSION_RE$/) {
+ my $this_release = $3;
+ if($this_release > $latest_available_perl) {
+ $latest_available_perl = $this_release;
+ }
+ }
+ }
+
+ if($latest_available_perl == $release) {
+ print "This perlbrew environment ($current->{name}) is already up-to-date.\n";
+ exit 0;
+ }
+
+ my $dist_version = "$major.$minor.$latest_available_perl";
+ my $dist = "perl-$dist_version";
+
+ print "Upgrading $current->{name} to $dist_version\n";
+ local $self->{as} = $current->{name};
+ local $self->{dist_name} = $dist;
+ $self->do_install_release($dist);
+ }
+
sub resolve_installation_name {
my ($self, $name) = @_;
die "App::perlbrew->resolve_installation_name requires one argument." unless $name;
Please sign in to comment.
Something went wrong with that request. Please try again.