Module/Install/Fetch.pm

#line 1
package Module::Install::Fetch;

use strict;
use Module::Install::Base;

use vars qw{$VERSION @ISA};
BEGIN {
        $VERSION = '0.61';
        @ISA     = qw{Module::Install::Base};
}

sub get_file {
    my ($self, %args) = @_;
    my ($scheme, $host, $path, $file) = 
        $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;

    if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
        $args{url} = $args{ftp_url}
            or (warn("LWP support unavailable!\n"), return);
        ($scheme, $host, $path, $file) = 
            $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
    }

    $|++;
    print "Fetching '$file' from $host... ";

    unless (eval { require Socket; Socket::inet_aton($host) }) {
        warn "'$host' resolve failed!\n";
        return;
    }

    return unless $scheme eq 'ftp' or $scheme eq 'http';

    require Cwd;
    my $dir = Cwd::getcwd();
    chdir $args{local_dir} or return if exists $args{local_dir};

    if (eval { require LWP::Simple; 1 }) {
        LWP::Simple::mirror($args{url}, $file);
    }
    elsif (eval { require Net::FTP; 1 }) { eval {
        # use Net::FTP to get past firewall
        my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
        $ftp->login("anonymous", 'anonymous@example.com');
        $ftp->cwd($path);
        $ftp->binary;
        $ftp->get($file) or (warn("$!\n"), return);
        $ftp->quit;
    } }
    elsif (my $ftp = $self->can_run('ftp')) { eval {
        # no Net::FTP, fallback to ftp.exe
        require FileHandle;
        my $fh = FileHandle->new;

        local $SIG{CHLD} = 'IGNORE';
        unless ($fh->open("|$ftp -n")) {
            warn "Couldn't open ftp: $!\n";
            chdir $dir; return;
        }

        my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
        foreach (@dialog) { $fh->print("$_\n") }
        $fh->close;
    } }
    else {
        warn "No working 'ftp' program available!\n";
        chdir $dir; return;
    }

    unless (-f $file) {
        warn "Fetching failed: $@\n";
        chdir $dir; return;
    }

    return if exists $args{size} and -s $file != $args{size};
    system($args{run}) if exists $args{run};
    unlink($file) if $args{remove};

    print(((!exists $args{check_for} or -e $args{check_for})
        ? "done!" : "failed! ($!)"), "\n");
    chdir $dir; return !$?;
}

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