|
Packit |
c9e8cb |
#line 1
|
|
Packit |
c9e8cb |
package Module::Install::Fetch;
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
use strict;
|
|
Packit |
c9e8cb |
use Module::Install::Base;
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
use vars qw{$VERSION $ISCORE @ISA};
|
|
Packit |
c9e8cb |
BEGIN {
|
|
Packit |
c9e8cb |
$VERSION = '0.67';
|
|
Packit |
c9e8cb |
$ISCORE = 1;
|
|
Packit |
c9e8cb |
@ISA = qw{Module::Install::Base};
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
sub get_file {
|
|
Packit |
c9e8cb |
my ($self, %args) = @_;
|
|
Packit |
c9e8cb |
my ($scheme, $host, $path, $file) =
|
|
Packit |
c9e8cb |
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
|
|
Packit |
c9e8cb |
$args{url} = $args{ftp_url}
|
|
Packit |
c9e8cb |
or (warn("LWP support unavailable!\n"), return);
|
|
Packit |
c9e8cb |
($scheme, $host, $path, $file) =
|
|
Packit |
c9e8cb |
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
$|++;
|
|
Packit |
c9e8cb |
print "Fetching '$file' from $host... ";
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
unless (eval { require Socket; Socket::inet_aton($host) }) {
|
|
Packit |
c9e8cb |
warn "'$host' resolve failed!\n";
|
|
Packit |
c9e8cb |
return;
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
return unless $scheme eq 'ftp' or $scheme eq 'http';
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
require Cwd;
|
|
Packit |
c9e8cb |
my $dir = Cwd::getcwd();
|
|
Packit |
c9e8cb |
chdir $args{local_dir} or return if exists $args{local_dir};
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
if (eval { require LWP::Simple; 1 }) {
|
|
Packit |
c9e8cb |
LWP::Simple::mirror($args{url}, $file);
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
elsif (eval { require Net::FTP; 1 }) { eval {
|
|
Packit |
c9e8cb |
# use Net::FTP to get past firewall
|
|
Packit |
c9e8cb |
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
|
|
Packit |
c9e8cb |
$ftp->login("anonymous", 'anonymous@example.com');
|
|
Packit |
c9e8cb |
$ftp->cwd($path);
|
|
Packit |
c9e8cb |
$ftp->binary;
|
|
Packit |
c9e8cb |
$ftp->get($file) or (warn("$!\n"), return);
|
|
Packit |
c9e8cb |
$ftp->quit;
|
|
Packit |
c9e8cb |
} }
|
|
Packit |
c9e8cb |
elsif (my $ftp = $self->can_run('ftp')) { eval {
|
|
Packit |
c9e8cb |
# no Net::FTP, fallback to ftp.exe
|
|
Packit |
c9e8cb |
require FileHandle;
|
|
Packit |
c9e8cb |
my $fh = FileHandle->new;
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
local $SIG{CHLD} = 'IGNORE';
|
|
Packit |
c9e8cb |
unless ($fh->open("|$ftp -n")) {
|
|
Packit |
c9e8cb |
warn "Couldn't open ftp: $!\n";
|
|
Packit |
c9e8cb |
chdir $dir; return;
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
my @dialog = split(/\n/, <<"END_FTP");
|
|
Packit |
c9e8cb |
open $host
|
|
Packit |
c9e8cb |
user anonymous anonymous\@example.com
|
|
Packit |
c9e8cb |
cd $path
|
|
Packit |
c9e8cb |
binary
|
|
Packit |
c9e8cb |
get $file $file
|
|
Packit |
c9e8cb |
quit
|
|
Packit |
c9e8cb |
END_FTP
|
|
Packit |
c9e8cb |
foreach (@dialog) { $fh->print("$_\n") }
|
|
Packit |
c9e8cb |
$fh->close;
|
|
Packit |
c9e8cb |
} }
|
|
Packit |
c9e8cb |
else {
|
|
Packit |
c9e8cb |
warn "No working 'ftp' program available!\n";
|
|
Packit |
c9e8cb |
chdir $dir; return;
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
unless (-f $file) {
|
|
Packit |
c9e8cb |
warn "Fetching failed: $@\n";
|
|
Packit |
c9e8cb |
chdir $dir; return;
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
return if exists $args{size} and -s $file != $args{size};
|
|
Packit |
c9e8cb |
system($args{run}) if exists $args{run};
|
|
Packit |
c9e8cb |
unlink($file) if $args{remove};
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
print(((!exists $args{check_for} or -e $args{check_for})
|
|
Packit |
c9e8cb |
? "done!" : "failed! ($!)"), "\n");
|
|
Packit |
c9e8cb |
chdir $dir; return !$?;
|
|
Packit |
c9e8cb |
}
|
|
Packit |
c9e8cb |
|
|
Packit |
c9e8cb |
1;
|