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
5 package Module::Install::Fetch;
6 use Module::Install::Base; @ISA = qw(Module::Install::Base);
11 my ($self, %args) = @_;
12 my ($scheme, $host, $path, $file) =
13 $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
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;
23 print "Fetching '$file' from $host... ";
25 unless (eval { require Socket; Socket::inet_aton($host) }) {
26 warn "'$host' resolve failed!\n";
30 return unless $scheme eq 'ftp' or $scheme eq 'http';
33 my $dir = Cwd::getcwd();
34 chdir $args{local_dir} or return if exists $args{local_dir};
36 if (eval { require LWP::Simple; 1 }) {
37 LWP::Simple::mirror($args{url}, $file);
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');
45 $ftp->get($file) or (warn("$!\n"), return);
48 elsif (my $ftp = $self->can_run('ftp')) { eval {
49 # no Net::FTP, fallback to ftp.exe
51 my $fh = FileHandle->new;
53 local $SIG{CHLD} = 'IGNORE';
54 unless ($fh->open("|$ftp -n")) {
55 warn "Couldn't open ftp: $!\n";
59 my @dialog = split(/\n/, << ".");
61 user anonymous anonymous\@example.com
67 foreach (@dialog) { $fh->print("$_\n") }
71 warn "No working 'ftp' program available!\n";
76 warn "Fetching failed: $@\n";
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};
84 print(((!exists $args{check_for} or -e $args{check_for})
85 ? "done!" : "failed! ($!)"), "\n");
86 chdir $dir; return !$?;