inc/Module/Install/Fetch.pm

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