view release on metacpan or  search on metacpan

inc/inc_File-Fetch/File/Fetch.pm  view on Meta::CPAN

        ### set the output document, add the uri ###
        push @$cmd, '--output-document', $to, $self->uri;

        ### with IPC::Cmd > 0.41, this is fixed in teh library,
        ### and there's no need for special casing any more.
        ### DO NOT quote things for IPC::Run, it breaks stuff.
        # $IPC::Cmd::USE_IPC_RUN
        #    ? ($to, $self->uri)
        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);

        ### shell out ###
        my $captured;
        unless(run( command => $cmd,
                    buffer  => \$captured,
                    verbose => $DEBUG
        )) {
            ### wget creates the output document always, even if the fetch
            ### fails.. so unlink it in that case
            1 while unlink $to;

            return $self->_error(loc( "Command failed: %1", $captured || '' ));
        }

        return $to;

    } else {
        $METHOD_FAIL->{'wget'} = 1;
        return;
    }
}

### /bin/lftp fetch ###
sub _lftp_fetch {
    my $self = shift;
    my %hash = @_;

    my ($to);
    my $tmpl = {
        to  => { required => 1, store => \$to }
    };
    check( $tmpl, \%hash ) or return;

    ### see if we have a wget binary ###
    if( my $lftp = can_run('lftp') ) {

        ### no verboseness, thanks ###
        my $cmd = [ $lftp, '-f' ];

        my $fh = File::Temp->new;

        my $str;

        ### if a timeout is set, add it ###
        $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;

        ### run passive if specified ###
        $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;

        ### set the output document, add the uri ###
        ### quote the URI, because lftp supports certain shell
        ### expansions, most notably & for backgrounding.
        ### ' quote does nto work, must be "
        $str .= q[get ']. $self->uri .q[' -o ]. $to . $/;

        if( $DEBUG ) {
            my $pp_str = join ' ', split $/, $str;
            print "# lftp command: $pp_str\n";
        }

        ### write straight to the file.
        $fh->autoflush(1);
        print $fh $str;

        ### the command needs to be 1 string to be executed
        push @$cmd, $fh->filename;

        ### with IPC::Cmd > 0.41, this is fixed in teh library,
        ### and there's no need for special casing any more.
        ### DO NOT quote things for IPC::Run, it breaks stuff.
        # $IPC::Cmd::USE_IPC_RUN
        #    ? ($to, $self->uri)
        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);


        ### shell out ###
        my $captured;
        unless(run( command => $cmd,
                    buffer  => \$captured,
                    verbose => $DEBUG
        )) {
            ### wget creates the output document always, even if the fetch
            ### fails.. so unlink it in that case
            1 while unlink $to;

            return $self->_error(loc( "Command failed: %1", $captured || '' ));
        }

        return $to;

    } else {
        $METHOD_FAIL->{'lftp'} = 1;
        return;
    }
}



### /bin/ftp fetch ###
sub _ftp_fetch {
    my $self = shift;
    my %hash = @_;

    my ($to);
    my $tmpl = {
        to  => { required => 1, store => \$to }
    };
    check( $tmpl, \%hash ) or return;

    ### see if we have a ftp binary ###
    if( my $ftp = can_run('ftp') ) {