Module/Install/Fetch.pm

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

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

use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
        $VERSION = '0.76';
        $ISCORE  = 1;
        @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	34	#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	dpavlin	52	$VERSION = '0.76';
10	dpavlin	34	$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;