Blame inc/Module/Install/Fetch.pm

Packit c9e8cb
#line 1
Packit c9e8cb
package Module::Install::Fetch;
Packit c9e8cb
Packit c9e8cb
use strict;
Packit c9e8cb
use Module::Install::Base;
Packit c9e8cb
Packit c9e8cb
use vars qw{$VERSION $ISCORE @ISA};
Packit c9e8cb
BEGIN {
Packit c9e8cb
	$VERSION = '0.67';
Packit c9e8cb
	$ISCORE  = 1;
Packit c9e8cb
	@ISA     = qw{Module::Install::Base};
Packit c9e8cb
}
Packit c9e8cb
Packit c9e8cb
sub get_file {
Packit c9e8cb
    my ($self, %args) = @_;
Packit c9e8cb
    my ($scheme, $host, $path, $file) = 
Packit c9e8cb
        $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
Packit c9e8cb
Packit c9e8cb
    if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
Packit c9e8cb
        $args{url} = $args{ftp_url}
Packit c9e8cb
            or (warn("LWP support unavailable!\n"), return);
Packit c9e8cb
        ($scheme, $host, $path, $file) = 
Packit c9e8cb
            $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
Packit c9e8cb
    }
Packit c9e8cb
Packit c9e8cb
    $|++;
Packit c9e8cb
    print "Fetching '$file' from $host... ";
Packit c9e8cb
Packit c9e8cb
    unless (eval { require Socket; Socket::inet_aton($host) }) {
Packit c9e8cb
        warn "'$host' resolve failed!\n";
Packit c9e8cb
        return;
Packit c9e8cb
    }
Packit c9e8cb
Packit c9e8cb
    return unless $scheme eq 'ftp' or $scheme eq 'http';
Packit c9e8cb
Packit c9e8cb
    require Cwd;
Packit c9e8cb
    my $dir = Cwd::getcwd();
Packit c9e8cb
    chdir $args{local_dir} or return if exists $args{local_dir};
Packit c9e8cb
Packit c9e8cb
    if (eval { require LWP::Simple; 1 }) {
Packit c9e8cb
        LWP::Simple::mirror($args{url}, $file);
Packit c9e8cb
    }
Packit c9e8cb
    elsif (eval { require Net::FTP; 1 }) { eval {
Packit c9e8cb
        # use Net::FTP to get past firewall
Packit c9e8cb
        my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
Packit c9e8cb
        $ftp->login("anonymous", 'anonymous@example.com');
Packit c9e8cb
        $ftp->cwd($path);
Packit c9e8cb
        $ftp->binary;
Packit c9e8cb
        $ftp->get($file) or (warn("$!\n"), return);
Packit c9e8cb
        $ftp->quit;
Packit c9e8cb
    } }
Packit c9e8cb
    elsif (my $ftp = $self->can_run('ftp')) { eval {
Packit c9e8cb
        # no Net::FTP, fallback to ftp.exe
Packit c9e8cb
        require FileHandle;
Packit c9e8cb
        my $fh = FileHandle->new;
Packit c9e8cb
Packit c9e8cb
        local $SIG{CHLD} = 'IGNORE';
Packit c9e8cb
        unless ($fh->open("|$ftp -n")) {
Packit c9e8cb
            warn "Couldn't open ftp: $!\n";
Packit c9e8cb
            chdir $dir; return;
Packit c9e8cb
        }
Packit c9e8cb
Packit c9e8cb
        my @dialog = split(/\n/, <<"END_FTP");
Packit c9e8cb
open $host
Packit c9e8cb
user anonymous anonymous\@example.com
Packit c9e8cb
cd $path
Packit c9e8cb
binary
Packit c9e8cb
get $file $file
Packit c9e8cb
quit
Packit c9e8cb
END_FTP
Packit c9e8cb
        foreach (@dialog) { $fh->print("$_\n") }
Packit c9e8cb
        $fh->close;
Packit c9e8cb
    } }
Packit c9e8cb
    else {
Packit c9e8cb
        warn "No working 'ftp' program available!\n";
Packit c9e8cb
        chdir $dir; return;
Packit c9e8cb
    }
Packit c9e8cb
Packit c9e8cb
    unless (-f $file) {
Packit c9e8cb
        warn "Fetching failed: $@\n";
Packit c9e8cb
        chdir $dir; return;
Packit c9e8cb
    }
Packit c9e8cb
Packit c9e8cb
    return if exists $args{size} and -s $file != $args{size};
Packit c9e8cb
    system($args{run}) if exists $args{run};
Packit c9e8cb
    unlink($file) if $args{remove};
Packit c9e8cb
Packit c9e8cb
    print(((!exists $args{check_for} or -e $args{check_for})
Packit c9e8cb
        ? "done!" : "failed! ($!)"), "\n");
Packit c9e8cb
    chdir $dir; return !$?;
Packit c9e8cb
}
Packit c9e8cb
Packit c9e8cb
1;