root/Encode-DoubleEncodedUTF8/trunk/inc/Module/Install/Fetch.pm

Revision 2162 (checked in by miyagawa, 13 years ago)

import

Line 
1 #line 1
2 package Module::Install::Fetch;
3
4 use strict;
5 use Module::Install::Base;
6
7 use vars qw{$VERSION $ISCORE @ISA};
8 BEGIN {
9         $VERSION = '0.64';
10         $ISCORE  = 1;
11         @ISA     = qw{Module::Install::Base};
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;
Note: See TracBrowser for help on using the browser.