File: Fetch.pm

package info (click to toggle)
libpadre-plugin-pdl-perl 0.05-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd, wheezy
  • size: 204 kB
  • ctags: 135
  • sloc: perl: 1,604; makefile: 9
file content (93 lines) | stat: -rw-r--r-- 2,455 bytes parent folder | download | duplicates (316)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
#line 1
package Module::Install::Fetch;

use strict;
use Module::Install::Base ();

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

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;