[Bps-public-commit] r10792 - in Shipwright: .

sunnavy at bestpractical.com sunnavy at bestpractical.com
Sun Feb 10 09:31:45 EST 2008


Author: sunnavy
Date: Sun Feb 10 09:31:44 2008
New Revision: 10792

Modified:
   Shipwright/Makefile.PL
   Shipwright/lib/Shipwright/Source/FTP.pm
   Shipwright/lib/Shipwright/Source/HTTP.pm

Log:
use LWP to replace wget

Modified: Shipwright/Makefile.PL
==============================================================================
--- Shipwright/Makefile.PL	(original)
+++ Shipwright/Makefile.PL	Sun Feb 10 09:31:44 2008
@@ -17,6 +17,7 @@
 requires 'Hash::Merge' => 0;
 requires 'IPC::Run3' => 0;
 requires 'Log::Log4perl' => 0;
+requires 'LWP::UserAgent' => 0;
 requires 'Module::CoreList' => 0;
 requires 'UNIVERSAL::require' => 0;
 requires 'version' => 0;

Modified: Shipwright/lib/Shipwright/Source/FTP.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/FTP.pm	(original)
+++ Shipwright/lib/Shipwright/Source/FTP.pm	Sun Feb 10 09:31:44 2008
@@ -15,27 +15,42 @@
 sub run {
     my $self = shift;
     $self->log->info( "prepare to run source: " . $self->source );
-    $self->SUPER::run();
-    my $compressed =
-      Shipwright::Source::Compressed->new( %$self, _no_update_url => 1 );
-    $compressed->run();
+    if ( $self->_run ) {
+        my $compressed =
+          Shipwright::Source::Compressed->new( %$self, _no_update_url => 1 );
+        $compressed->run();
+    }
 }
 
 =head2 _cmd
 
 =cut
 
-sub _cmd {
+sub _run {
     my $self   = shift;
     my $source = $self->source;
     my $file;
     if ( $source =~ m{.*/(.+\.(tar\.gz|tgz|tar\.bz2))$} ) {
         $file = $1;
-        $self->_update_url( $self->just_name( $file ), $source );
+        $self->_update_url( $self->just_name($file), $source );
         my $src_dir = $self->download_directory;
         mkdir $src_dir unless -e $src_dir;
         $self->source( File::Spec->catfile( $src_dir, $file ) );
-        return [ 'wget', $source, '-O', $self->source ];
+
+        require LWP::UserAgent;
+        my $ua = LWP::UserAgent->new;
+        $ua->timeout(10);
+
+        my $response = $ua->get($source);
+
+        if ( $response->is_success ) {
+            open my $fh, '>', $self->source
+              or die "can't open file " . $self->source . ": $!";
+            print $fh $response->content;
+        }
+        else {
+            croak "failed to get $source: " . $response->status_line;
+        }
     }
     else {
         croak "invalid source: $source";

Modified: Shipwright/lib/Shipwright/Source/HTTP.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/HTTP.pm	(original)
+++ Shipwright/lib/Shipwright/Source/HTTP.pm	Sun Feb 10 09:31:44 2008
@@ -17,32 +17,48 @@
 
     $self->log->info( "prepare to run source: " . $self->source );
 
-    $self->SUPER::run();
-    my $compressed =
-      Shipwright::Source::Compressed->new( %$self, _no_update_url => 1 );
-    $compressed->run();
+    if ( $self->_run ) {
+        my $compressed =
+          Shipwright::Source::Compressed->new( %$self, _no_update_url => 1 );
+        $compressed->run();
+    }
 }
 
-=head2 _cmd
+=head2 _run
 
 =cut
 
-sub _cmd {
+sub _run {
     my $self   = shift;
     my $source = $self->source;
     my $file;
     if ( $source =~ m{.*/(.+\.(tar\.gz|tgz|tar\.bz2))$} ) {
         $file = $1;
-        $self->update_url( $self->just_name( $file ), $source );
+        $self->_update_url( $self->just_name($file), $source );
 
         my $src_dir = $self->download_directory;
         mkdir $src_dir unless -e $src_dir;
         $self->source( File::Spec->catfile( $src_dir, $file ) );
-        return [ 'wget', $source, '-O', $self->source ];
+
+        require LWP::UserAgent;
+        my $ua = LWP::UserAgent->new;
+        $ua->timeout(10);
+
+        my $response = $ua->get($source);
+
+        if ( $response->is_success ) {
+            open my $fh, '>', $self->source
+              or die "can't open file " . $self->source . ": $!";
+            print $fh $response->content;
+        }
+        else {
+            croak "failed to get $source: " . $response->status_line;
+        }
     }
     else {
         croak "invalid source: $source";
     }
+    return 1;
 }
 
 1;



More information about the Bps-public-commit mailing list