1#line 1 2package Module::Install::Fetch; 3 4use strict; 5use Module::Install::Base; 6 7use vars qw{$VERSION $ISCORE @ISA}; 8BEGIN { 9 $VERSION = '0.71'; 10 $ISCORE = 1; 11 @ISA = qw{Module::Install::Base}; 12} 13 14sub get_file { 15 my ($self, %args) = @_; 16 my ($scheme, $host, $path, $file) = 17 $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; 18 19 if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { 20 $args{url} = $args{ftp_url} 21 or (warn("LWP support unavailable!\n"), return); 22 ($scheme, $host, $path, $file) = 23 $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; 24 } 25 26 $|++; 27 print "Fetching '$file' from $host... "; 28 29 unless (eval { require Socket; Socket::inet_aton($host) }) { 30 warn "'$host' resolve failed!\n"; 31 return; 32 } 33 34 return unless $scheme eq 'ftp' or $scheme eq 'http'; 35 36 require Cwd; 37 my $dir = Cwd::getcwd(); 38 chdir $args{local_dir} or return if exists $args{local_dir}; 39 40 if (eval { require LWP::Simple; 1 }) { 41 LWP::Simple::mirror($args{url}, $file); 42 } 43 elsif (eval { require Net::FTP; 1 }) { eval { 44 # use Net::FTP to get past firewall 45 my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); 46 $ftp->login("anonymous", 'anonymous@example.com'); 47 $ftp->cwd($path); 48 $ftp->binary; 49 $ftp->get($file) or (warn("$!\n"), return); 50 $ftp->quit; 51 } } 52 elsif (my $ftp = $self->can_run('ftp')) { eval { 53 # no Net::FTP, fallback to ftp.exe 54 require FileHandle; 55 my $fh = FileHandle->new; 56 57 local $SIG{CHLD} = 'IGNORE'; 58 unless ($fh->open("|$ftp -n")) { 59 warn "Couldn't open ftp: $!\n"; 60 chdir $dir; return; 61 } 62 63 my @dialog = split(/\n/, <<"END_FTP"); 64open $host 65user anonymous anonymous\@example.com 66cd $path 67binary 68get $file $file 69quit 70END_FTP 71 foreach (@dialog) { $fh->print("$_\n") } 72 $fh->close; 73 } } 74 else { 75 warn "No working 'ftp' program available!\n"; 76 chdir $dir; return; 77 } 78 79 unless (-f $file) { 80 warn "Fetching failed: $@\n"; 81 chdir $dir; return; 82 } 83 84 return if exists $args{size} and -s $file != $args{size}; 85 system($args{run}) if exists $args{run}; 86 unlink($file) if $args{remove}; 87 88 print(((!exists $args{check_for} or -e $args{check_for}) 89 ? "done!" : "failed! ($!)"), "\n"); 90 chdir $dir; return !$?; 91} 92 931; 94