Merge branch 'release/0.66'

trcjr · Aug 2, 2013 · 44ae015 · 44ae015
2 parents 711e8ee + e1fc3e9
commit 44ae015
Show file tree

Hide file tree

Showing 8 changed files with 28 additions and 69 deletions.
diff --git a/Changes b/Changes
@@ -1,3 +1,6 @@
+0.66: # 2013-08-03T00:22:29+0200
+- fix a bug the made download failed with curl program.
+
 0.65: # 2013-08-01T07:19:03+0200
 - exec command: error hadndling improvements. Thanks to @vsespb.
 - install command: add "--clang" option. Thanks to @salva

diff --git a/lib/App/perlbrew.pm b/lib/App/perlbrew.pm
@@ -2,7 +2,7 @@ package App::perlbrew;
 use strict;
 use warnings;
 use 5.008;
-our $VERSION = "0.65";
+our $VERSION = "0.66";
 use Config;
 
 BEGIN {
@@ -111,16 +111,16 @@ sub files_are_the_same {
     my %commands = (
         curl => {
             test     => '--version >/dev/null 2>&1',
-            get      => 'curl --silent --location --fail',
-            download => 'curl --silent --location --fail -o {output} {url}'
+            get      => '--silent --location --fail -o - {url}',
+            download => '--silent --location --fail -o {output} {url}'
         },
         wget => {
             test     => '--version >/dev/null 2>&1',
             get      => '--quiet -O - {url}',
             download => '--quiet -O {output} {url}',
         },
         fetch => {
-            fetch    => '--version >/dev/null 2>&1',
+            test     => '--version >/dev/null 2>&1',
             get      => '-o - {url}',
             download => '{url}'
         }
@@ -155,7 +155,7 @@ sub files_are_the_same {
     }
 
     sub http_download {
-        my ($url, $header, $path) = @_;
+        my ($url, $path) = @_;
 
         if (-e $path) {
             die "ERROR: The download target < $path > already exists.\n";
@@ -165,10 +165,9 @@ sub files_are_the_same {
 
         my $status = system($download_command);
         unless ($status == 0) {
-            die "ERROR: Failed to execute the command\n\n\t$download_command\n\nReason:\n\n\t$?";
+            return "ERROR: Failed to execute the command\n\n\t$download_command\n\nReason:\n\n\t$?";
         }
-
-        return 1;
+        return 0;
     }
 
     sub http_get {
@@ -475,37 +474,6 @@ sub find_similar_commands {
     return @commands;
 }
 
-sub download {
-    my ($self, $url, $path, $on_error) = @_;
-
-    my $mirror = $self->config->{mirror};
-    my $header = $mirror ? { 'Cookie' => "cpan=$mirror->{url}" } : undef;
-
-    open my $BALL, ">", $path or die "Failed to open $path for writing.\n";
-
-    http_get(
-        $url,
-        $header,
-        sub {
-            my ($body) = @_;
-
-            unless ($body) {
-                if (ref($on_error) eq 'CODE') {
-                    $on_error->($url);
-                }
-                else {
-                    die "ERROR: Failed to download $url.\n"
-                }
-            }
-
-
-            print $BALL $body;
-        }
-    );
-
-    close $BALL;
-}
-
 sub run_command {
     my ( $self, $x, @args ) = @_;
     my $command = $x;
@@ -907,7 +875,8 @@ sub do_install_url {
     }
     else {
         print "Fetching $dist as $dist_tarball_path\n";
-        $self->download($dist_tarball_url, $dist_tarball_path);
+        my $error = http_download($dist_tarball_url, $dist_tarball_path);
+        die "ERROR: Failed to download $dist_tarball_url\n" if $error;
     }
 
     my $dist_extracted_path = $self->do_extract_tarball($dist_tarball_path);
@@ -955,13 +924,11 @@ sub do_install_blead {
     my $dist_tarball_path = joinpath($self->root, "dists", $dist_tarball);
     print "Fetching $dist_git_describe as $dist_tarball_path\n";
 
-    $self->download(
-        "http://perl5.git.perl.org/perl.git/snapshot/$dist_tarball", $dist_tarball_path,
-        sub {
-            die "\nERROR: Failed to download perl-blead tarball.\n\n";
-        }
-    );
+    my $error = http_download("http://perl5.git.perl.org/perl.git/snapshot/$dist_tarball", $dist_tarball_path);
 
+    if ($error) {
+        die "\nERROR: Failed to download perl-blead tarball.\n\n";
+    }
 
     # Returns the wrong extracted dir for blead
     $self->do_extract_tarball($dist_tarball_path);
@@ -1013,7 +980,7 @@ sub do_install_release {
     }
     else {
         print "Fetching perl $dist_version as $dist_tarball_path\n" unless $self->{quiet};
-        $self->download( $dist_tarball_url, $dist_tarball_path );
+        $self->run_command_download($dist);
     }
 
     my $dist_extracted_path = $self->do_extract_tarball($dist_tarball_path);
@@ -1188,7 +1155,10 @@ sub run_command_download {
     }
     else {
         print "Download $dist_tarball_url to $dist_tarball_path\n" unless $self->{quiet};
-        $self->download( $dist_tarball_url, $dist_tarball_path );
+        my $error = http_download($dist_tarball_url, $dist_tarball_path);
+        if ($error) {
+            die "ERROR: Failed to download $dist_tarball_url\n";
+        }
     }
 }
 

diff --git a/perlbrew b/perlbrew
diff --git a/t/08.error_install.t b/t/08.error_install.t
@@ -18,14 +18,7 @@ App::perlbrew::mkpath( dir($ENV{PERLBREW_ROOT})->subdir("build") );
 App::perlbrew::mkpath( dir($ENV{PERLBREW_ROOT})->subdir("dists") );
 
 no warnings 'redefine';
-sub App::perlbrew::http_get {
-    my ($url, $header, $cb) = @_;
-    if (ref($header) eq 'CODE') {
-        $cb = $header;
-        $header = undef;
-    }
-    $cb ? $cb->(undef) : undef
-}
+sub App::perlbrew::http_download { return "ERROR" }
 
 throws_ok(
     sub {

diff --git a/t/08.error_install_blead.t b/t/08.error_install_blead.t
@@ -14,10 +14,7 @@ use Path::Class;
 use App::perlbrew;
 {
     no warnings 'redefine';
-    sub App::perlbrew::http_get {
-        my ($url, undef, $cb) = @_;
-        $cb->("");
-    }
+    sub App::perlbrew::http_download { return "ERROR" }
 }
 
 throws_ok(

diff --git a/t/command-info.t b/t/command-info.t
@@ -29,7 +29,7 @@ Current perl:
   Name: perl-5.8.9
   Path: \Q$perl_path\E
   Config: config_args_value
-  Compiled at: ... \\d{1,2} \\d{4} \\d{1,2}:\\d{2}:\\d{2}
+  Compiled at: ...\\s+\\d{1,2}\\s+\\d{4}\\s+\\d{1,2}:\\d{2}:\\d{2}
 
 perlbrew:
   version: \Q$App::perlbrew::VERSION\E

diff --git a/t/http.t b/t/http.t
@@ -39,7 +39,7 @@ describe "App::perlbrew::http_get function" => sub {
 };
 
 describe "App::perlbrew::http_download function, downloading the perlbrew-installer." => sub {
-    my ($dir, $output);
+    my ($dir, $output, $download_error);
 
     before all => sub {
         $dir = tempdir( CLEANUP => 1 );
@@ -55,11 +55,7 @@ Therefore we cannot proceed the test.
 REASON
         }
 
-        App::perlbrew::http_download(
-            "http://install.perlbrew.pl",
-            undef,
-            $output,
-        );
+        my $download_error = App::perlbrew::http_download("http://install.perlbrew.pl", $output);
     };
 
     it "downloads to the wanted path" => sub {

diff --git a/t/installation2.t b/t/installation2.t
@@ -21,7 +21,7 @@ describe "App::perlbrew" => sub {
             my $app = App::perlbrew->new;
 
             my @expectations;
-            push @expectations, App::perlbrew->expects("http_get")->returns("Not going to GET it!");
+            push @expectations, App::perlbrew->expects("http_download")->returns(0);
             push @expectations, $app->expects("do_extract_tarball")->returns("");
             push @expectations, $app->expects("do_install_this")->returns("");