[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