r77383 - in /branches/upstream/perlbrew/current: Changes MANIFEST META.yml Makefile.PL lib/App/perlbrew.pm t/09.exit_status.t t/10.resolve.t t/command-exec.t

ghedo-guest at users.alioth.debian.org ghedo-guest at users.alioth.debian.org
Mon Jul 11 18:06:47 UTC 2011


Author: ghedo-guest
Date: Mon Jul 11 18:06:35 2011
New Revision: 77383

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=77383
Log:
[svn-upgrade] new version perlbrew (0.27)

Added:
    branches/upstream/perlbrew/current/t/10.resolve.t
    branches/upstream/perlbrew/current/t/command-exec.t
Modified:
    branches/upstream/perlbrew/current/Changes
    branches/upstream/perlbrew/current/MANIFEST
    branches/upstream/perlbrew/current/META.yml
    branches/upstream/perlbrew/current/Makefile.PL
    branches/upstream/perlbrew/current/lib/App/perlbrew.pm
    branches/upstream/perlbrew/current/t/09.exit_status.t

Modified: branches/upstream/perlbrew/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/Changes?rev=77383&op=diff
==============================================================================
--- branches/upstream/perlbrew/current/Changes (original)
+++ branches/upstream/perlbrew/current/Changes Mon Jul 11 18:06:35 2011
@@ -1,3 +1,13 @@
+0.27:
+- Hotfix for `perlbrew install` command
+
+0.26:
+- Fix GH #119 
+- Fix t/08.exit_status.t for cpantesters
+- Fix several bugs in `exec` command
+- Implement GH #103 - install -v shows build.log
+- Add -Dusedevel when installing blead perl
+
 0.25:
 - suggest when user types wrong commands. hoelzro++
 - Improvements about self-upgrade by hoelzro++

Modified: branches/upstream/perlbrew/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/MANIFEST?rev=77383&op=diff
==============================================================================
--- branches/upstream/perlbrew/current/MANIFEST (original)
+++ branches/upstream/perlbrew/current/MANIFEST Mon Jul 11 18:06:35 2011
@@ -33,5 +33,7 @@
 t/08.error_install_cpanm.t
 t/08.error_mirror.t
 t/09.exit_status.t
+t/10.resolve.t
+t/command-exec.t
 t/installation.t
 t/installation2.t

Modified: branches/upstream/perlbrew/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/META.yml?rev=77383&op=diff
==============================================================================
--- branches/upstream/perlbrew/current/META.yml (original)
+++ branches/upstream/perlbrew/current/META.yml Mon Jul 11 18:06:35 2011
@@ -4,6 +4,7 @@
   - 'Kang-min Liu  C<< <gugod at gugod.org> >>'
 build_requires:
   ExtUtils::MakeMaker: 6.42
+  File::Temp: 0
   IO::All: 0
   Path::Class: 0
   Test::Exception: 0
@@ -32,4 +33,4 @@
 resources:
   license: http://opensource.org/licenses/mit-license.php
   repository: git://github.com/gugod/App-perlbrew.git
-version: 0.25
+version: 0.27

Modified: branches/upstream/perlbrew/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/Makefile.PL?rev=77383&op=diff
==============================================================================
--- branches/upstream/perlbrew/current/Makefile.PL (original)
+++ branches/upstream/perlbrew/current/Makefile.PL Mon Jul 11 18:06:35 2011
@@ -58,6 +58,7 @@
 test_requires 'Test::Spec';
 test_requires 'Path::Class';
 test_requires 'IO::All';
+test_requires 'File::Temp';
 
 install_script 'bin/perlbrew';
 

Modified: branches/upstream/perlbrew/current/lib/App/perlbrew.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/lib/App/perlbrew.pm?rev=77383&op=diff
==============================================================================
--- branches/upstream/perlbrew/current/lib/App/perlbrew.pm (original)
+++ branches/upstream/perlbrew/current/lib/App/perlbrew.pm Mon Jul 11 18:06:35 2011
@@ -6,7 +6,7 @@
 use File::Spec::Functions qw( catfile );
 use FindBin;
 
-our $VERSION = "0.25";
+our $VERSION = "0.27";
 our $CONF;
 
 my $ROOT             = $ENV{PERLBREW_ROOT} || "$ENV{HOME}/perl5/perlbrew";
@@ -444,13 +444,19 @@
     }
 
     # Assume 5.12.3 means perl-5.12.3, for example.
-    if ($x =~ /\A(?:switch|use|install|env)\Z/ and my $dist = shift @args) {
-        if ($dist =~ /\A(?:\d+\.)*\d+\Z/) {
-            unshift @args, "perl-$dist";
+    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 {
-            unshift @args, $dist;
-        }
+            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);
@@ -858,7 +864,7 @@
     $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/;
+    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};
 
@@ -904,9 +910,13 @@
         $make,
         @install
     );
-    $cmd = "($cmd) >> '$self->{log_file}' 2>&1 ";
-
-    print "$cmd\n" if $self->{verbose};
+    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);
 
@@ -1259,17 +1269,11 @@
         my %env = $self->perlbrew_env($i->{name});
         next if !$env{PERLBREW_PERL};
 
-        my $command = "";
-
-        while ( my($name, $value) = each %env) {
-            $command .= "$name=$value ";
-        }
-
-        $command .= ' PATH=${PERLBREW_PATH}:${PATH} ';
-        $command .= "; " . join " ", map { quotemeta($_) } @args;
+        local @ENV{ keys %env } = values %env;
+        local $ENV{PATH} = join(':', $env{PERLBREW_PATH}, $ENV{PATH});
 
         print "$i->{name}\n==========\n";
-        system "$command\n";
+        system @args;
         print "\n\n";
         # print "\n<===\n\n\n";
     }
@@ -1344,6 +1348,20 @@
     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 {

Modified: branches/upstream/perlbrew/current/t/09.exit_status.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/t/09.exit_status.t?rev=77383&op=diff
==============================================================================
--- branches/upstream/perlbrew/current/t/09.exit_status.t (original)
+++ branches/upstream/perlbrew/current/t/09.exit_status.t Mon Jul 11 18:06:35 2011
@@ -10,6 +10,8 @@
     $ENV{PERLBREW_ROOT} = file(__FILE__)->dir->subdir("mock_perlbrew_root");
 }
 
+my $bin_perlbrew = file(__FILE__)->dir->parent->subdir("bin")->file("perlbrew");
+
 use App::perlbrew;
 
 throws_ok(
@@ -20,10 +22,10 @@
     qr[unknown_command]
 );
 
-`perlbrew unknown-command 2>&1`;
+system("perl -Ilib ${bin_perlbrew} unknown-command 2>&1");
 ok($? != 0);
 
-`perlbrew version 2>&1`;
+system("perl -Ilib ${bin_perlbrew} version 2>&1");
 ok($? == 0);
 
 done_testing;

Added: branches/upstream/perlbrew/current/t/10.resolve.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/t/10.resolve.t?rev=77383&op=file
==============================================================================
--- branches/upstream/perlbrew/current/t/10.resolve.t (added)
+++ branches/upstream/perlbrew/current/t/10.resolve.t Mon Jul 11 18:06:35 2011
@@ -1,0 +1,73 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Path::Class;
+use IO::All;
+BEGIN {
+    $ENV{PERLBREW_ROOT} = file(__FILE__)->dir->subdir("mock_perlbrew_root");
+}
+
+use App::perlbrew;
+use Test::Spec;
+use Test::Exception;
+
+App::perlbrew::rmpath( $ENV{PERLBREW_ROOT} );
+## mock
+
+no warnings 'redefine';
+
+sub App::perlbrew::do_install_release {
+    my ($self, $name) = @_;
+
+    $name = $self->{as} if $self->{as};
+
+    my $root = dir($ENV{PERLBREW_ROOT});
+    my $installation_dir = $root->subdir("perls", $name);
+    App::perlbrew::mkpath($installation_dir);
+    App::perlbrew::mkpath($root->subdir("perls", $name, "bin"));
+
+    my $perl = $root->subdir("perls", $name, "bin")->file("perl");
+    io($perl)->print("#!/bin/sh\nperl \"\$@\";\n");
+    chmod 0755, $perl;
+}
+
+use warnings;
+
+App::perlbrew->new("install", "perl-5.8.9")->run();
+App::perlbrew->new("install", "perl-5.14.0")->run();
+App::perlbrew->new("install", "--as" => "5.8.9", "perl-5.8.9")->run();
+App::perlbrew->new("install", "--as" => "perl-shiny", "perl-5.14.0")->run();
+
+## spec
+
+describe "App::perlbrew->resolve_installation_name" => sub {
+    my $app;
+
+    before each => sub {
+        $app = App::perlbrew->new;
+    };
+
+    it "takes exactly one argument, which means the `shortname` that needs to be resolved to a `longname`", sub {
+        ok $app->resolve_installation_name("5.8.9");
+        dies_ok {
+            $app->resolve_installation_name; # no args
+        };
+    };
+
+    it "returns the same value as the argument if there is an installation with exactly the same name", sub {
+        is $app->resolve_installation_name("5.8.9"), "5.8.9";
+        is $app->resolve_installation_name("perl-5.8.9"), "perl-5.8.9";
+        is $app->resolve_installation_name("perl-5.14.0"), "perl-5.14.0";
+    };
+
+    it "returns `perl-\$shortname` if that happens to be a proper installation name.", sub {
+        is $app->resolve_installation_name("5.14.0"), "perl-5.14.0";
+        is $app->resolve_installation_name("shiny"), "perl-shiny";
+    };
+
+    it "returns undef if no proper installation can be found", sub {
+        is $app->resolve_installation_name("nihao"), undef;
+    };
+};
+
+runtests unless caller;

Added: branches/upstream/perlbrew/current/t/command-exec.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/perlbrew/current/t/command-exec.t?rev=77383&op=file
==============================================================================
--- branches/upstream/perlbrew/current/t/command-exec.t (added)
+++ branches/upstream/perlbrew/current/t/command-exec.t Mon Jul 11 18:06:35 2011
@@ -1,0 +1,72 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib qw(lib);
+use Test::More;
+use Path::Class;
+use IO::All;
+use File::Temp qw( tempdir );
+
+my $tmpd = tempdir( CLEANUP => 1 );
+$ENV{PERLBREW_ROOT} = $tmpd;
+my $root = dir($tmpd);
+require App::perlbrew;
+
+my @perls = qw( yak needs shave );
+my %exe = (
+    # this enables "perlbrew exec perl -e '...'"
+    perl => {
+        # interpolate $^X to specify current perl and avoid infinite recursion
+        content => qq[#!/bin/sh\nPERLBREW_TEST_PERL="\$0" exec $^X "\$@";\n],
+        # printing $^X is not helpful because these exe's are shell scripts that call the same perl
+        args    => [ qw( exec perl -e ), 'open FH, ">>", shift and print FH "=$ENV{PERLBREW_TEST_PERL}\n" and close FH' ],
+        output  => join('', sort map { "=$root/perls/$_/bin/perl\n" } @perls),
+    },
+    # also test an exe that isn't "perl" (like a script installed by a module)
+    brewed_app => {
+        content => qq[#!/bin/sh\necho \$0 >> \$1\n],
+        args    => [ qw( exec brewed_app ) ],
+        output  => join('', sort map { "$root/perls/$_/bin/brewed_app\n" } @perls),
+    },
+    # test something outside the $perl/bin/ to ensure that the environment is setup correctly
+    # NOTE: this script may need to change if the usage of these perlbrew vars changes
+    test_env => {
+        content => '', # don't create a file for this one
+        args    => [ qw( exec sh -c ), 'echo "$PERLBREW_PERL--$PERLBREW_PATH" >> $1', '-' ],
+        output  => join('', sort map { "$_--$root/bin:$root/perls/$_/bin\n" } @perls),
+    },
+);
+
+# build a fake root with some fake perls (most of this was modified from stuff found in t/installation.t)
+foreach my $name ( @perls ) {
+    my $bin = $root->subdir("perls", $name, "bin");
+    App::perlbrew::mkpath($bin) for @perls;
+
+    while ( my ($script, $data) = each %exe ) {
+      next unless $data->{content};
+      my $path = $bin->file($script);
+      io($path)->print( $data->{content} );
+      chmod 0755, $path;
+    }
+}
+
+# exec each script
+while ( my ($script, $data) = each %exe ) {
+  # we need a file to which the subprocesses can append
+  my $file = $root->file("test-exec-output.$script");
+
+  my $app = App::perlbrew->new(@{ $data->{args} }, $file->stringify);
+  $app->run;
+
+  # $file should have output in it
+  if ( -e $file ) {
+    # get output from all execs (ensure same order as above)
+    my $output = do { open(my $fh, '<', $file); join '', sort <$fh>; };
+    is $output, $data->{output}, 'correct exec output';
+  }
+  else {
+    ok 0, 'output file does not exist';
+  }
+}
+
+done_testing;




More information about the Pkg-perl-cvs-commits mailing list