inc/Module/Install/Fetch.pm

   1 #line 1
   2 package Module::Install::Fetch;
   3
   4 use strict;
   5 use Module::Install::Base ();
   6
   7 use vars qw{$VERSION @ISA $ISCORE};
   8 BEGIN {
   9         $VERSION = '1.00';
  10         @ISA     = 'Module::Install::Base';
  11         $ISCORE  = 1;
  12 }
  13
  14 sub 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");
  64 open $host
  65 user anonymous anonymous\@example.com
  66 cd $path
  67 binary
  68 get $file $file
  69 quit
  70 END_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
  93 1;