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	dpavlin	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;