[Bps-public-commit] Shipwright branch, master, updated. 6d98616da03125428d9444ae8504fd17d36790b0

[sunnavy at bestpractical.com]

The branch, master has been updated
       via  6d98616da03125428d9444ae8504fd17d36790b0 (commit)
      from  524927ca66b5a86fda3319172aaf001f05cf6ca8 (commit)

Summary of changes:
 lib/Shipwright/Source/Base.pm |   29 +++++++++++++++++++++++++++++
 lib/Shipwright/Source/CPAN.pm |    3 ++-
 lib/Shipwright/Source/FTP.pm  |   16 +---------------
 lib/Shipwright/Source/HTTP.pm |   16 +---------------
 4 files changed, 33 insertions(+), 31 deletions(-)

- Log -----------------------------------------------------------------
commit 6d98616da03125428d9444ae8504fd17d36790b0
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Thu Aug 6 13:27:02 2009 +0800

    test if we downloaded the file already, if so, no need to redownload. current the test is the just the file size, maybe we need a more strict test, e.g. check the modified time

diff --git a/lib/Shipwright/Source/Base.pm b/lib/Shipwright/Source/Base.pm
index 433b85e..7c9535a 100644
--- a/lib/Shipwright/Source/Base.pm
+++ b/lib/Shipwright/Source/Base.pm
@@ -662,6 +662,35 @@ sub is_compressed {
     return;
 }
 
+sub _lwp_get {
+    my $self   = shift;
+    my $source = shift;
+    require LWP::UserAgent;
+    my $ua = LWP::UserAgent->new;
+    $ua->timeout(1200);
+
+    if ( -e $self->source ) {
+        my $size = ( stat $self->source )[7];
+        my $res  = $ua->head($source);
+        if (   $res->is_success
+            && $res->header('content-length') == $size )
+        {
+            return 1;
+        }
+    }
+
+    my $response = $ua->get($source);
+
+    if ( $response->is_success ) {
+        open my $fh, '>', $self->source
+          or confess "can't open file " . $self->source . ": $!";
+        print $fh $response->content;
+    }
+    else {
+        croak "failed to get $source: " . $response->status_line;
+    }
+}
+
 1;
 
 __END__
diff --git a/lib/Shipwright/Source/CPAN.pm b/lib/Shipwright/Source/CPAN.pm
index 9e741fb..68272b8 100644
--- a/lib/Shipwright/Source/CPAN.pm
+++ b/lib/Shipwright/Source/CPAN.pm
@@ -58,7 +58,8 @@ sub new {
 
         # be careful, if you use minicpan, then the source won't be copied to
         # $CPAN::Config->{keep_source_where}
-        $CPAN::Config->{keep_source_where} = catdir( $cpan_dir, 'sources' );
+        $CPAN::Config->{keep_source_where} =
+          catdir( $self->download_directory, 'cpan' );
         $CPAN::Config->{prefs_dir}         = catdir( $cpan_dir, 'prefs' );
         $CPAN::Config->{prerequisites_policy} = 'follow';
         unless ( $CPAN::Config->{urllist} && @{ $CPAN::Config->{urllist} } ) {
diff --git a/lib/Shipwright/Source/FTP.pm b/lib/Shipwright/Source/FTP.pm
index 084224c..a294915 100644
--- a/lib/Shipwright/Source/FTP.pm
+++ b/lib/Shipwright/Source/FTP.pm
@@ -39,21 +39,7 @@ sub _run {
         my $src_dir = $self->download_directory;
         mkdir $src_dir unless -e $src_dir;
         $self->source( catfile( $src_dir, $file ) );
-
-        require LWP::UserAgent;
-        my $ua = LWP::UserAgent->new;
-        $ua->timeout(1200);
-
-        my $response = $ua->get($source);
-
-        if ( $response->is_success ) {
-            open my $fh, '>', $self->source
-              or confess "can't open file " . $self->source . ": $!";
-            print $fh $response->content;
-        }
-        else {
-            croak "failed to get $source: " . $response->status_line;
-        }
+        $self->_lwp_get($source);
     }
     else {
         croak "invalid source: $source";
diff --git a/lib/Shipwright/Source/HTTP.pm b/lib/Shipwright/Source/HTTP.pm
index feb28e9..93ba5b6 100644
--- a/lib/Shipwright/Source/HTTP.pm
+++ b/lib/Shipwright/Source/HTTP.pm
@@ -39,21 +39,7 @@ sub _run {
         my $src_dir = $self->download_directory;
         mkdir $src_dir unless -e $src_dir;
         $self->source( catfile( $src_dir, $file ) );
-
-        require LWP::UserAgent;
-        my $ua = LWP::UserAgent->new;
-        $ua->timeout(1200);
-
-        my $response = $ua->get($source);
-
-        if ( $response->is_success ) {
-            open my $fh, '>', $self->source
-              or confess "can't open file " . $self->source . ": $!";
-            print $fh $response->content;
-        }
-        else {
-            croak "failed to get $source: " . $response->status_line;
-        }
+        $self->_lwp_get($source);
     }
     else {
         croak "invalid source: $source";

-----------------------------------------------------------------------