view release on metacpan or  search on metacpan

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

        ### DO NOT quote things for IPC::Run, it breaks stuff.
        push @$cmd, $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
        #    ? $self->uri
        #    : QUOTE. $self->uri .QUOTE;


        ### shell out ###
        my $captured;
        unless(run( command => $cmd,
                    buffer  => \$captured,
                    verbose => $DEBUG )
        ) {
            return $self->_error(loc("Command failed: %1", $captured || ''));
        }

        ### print to local file ###
        ### XXX on a 404 with a special error page, $captured will actually
        ### hold the contents of that page, and make it *appear* like the
        ### request was a success, when really it wasn't :(
        ### there doesn't seem to be an option for lynx to change the exit
        ### code based on a 4XX status or so.
        ### the closest we can come is using --error_file and parsing that,
        ### which is very unreliable ;(
        $local->print( $captured );
        $local->close or return;

        return $to;

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

### use /bin/ncftp to fetch files
sub _ncftp_fetch {
    my $self = shift;
    my %hash = @_;

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

    ### we can only set passive mode in interactive sessions, so bail out
    ### if $FTP_PASSIVE is set
    return if $FTP_PASSIVE;

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

        my $cmd = [
            $ncftp,
            '-V',                   # do not be verbose
            '-p', $FROM_EMAIL,      # email as password
            $self->host,            # hostname
            dirname($to),           # local dir for the file
                                    # remote path to the file
            ### DO NOT quote things for IPC::Run, it breaks stuff.
            $IPC::Cmd::USE_IPC_RUN
                        ? File::Spec::Unix->catdir( $self->path, $self->file )
                        : QUOTE. File::Spec::Unix->catdir(
                                        $self->path, $self->file ) .QUOTE

        ];

        ### shell out ###
        my $captured;
        unless(run( command => $cmd,
                    buffer  => \$captured,
                    verbose => $DEBUG )
        ) {
            return $self->_error(loc("Command failed: %1", $captured || ''));
        }

        return $to;

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

### use /bin/curl to fetch files
sub _curl_fetch {
    my $self = shift;
    my %hash = @_;

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

    if (my $curl = can_run('curl')) {

        ### these long opts are self explanatory - I like that -jmb
	    my $cmd = [ $curl, '-q' ];

	    push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT;

	    push(@$cmd, '--silent') unless $DEBUG;

        ### curl does the right thing with passive, regardless ###
    	if ($self->scheme eq 'ftp') {
    		push(@$cmd, '--user', "anonymous:$FROM_EMAIL");
    	}

        ### curl doesn't follow 302 (temporarily moved) etc automatically
        ### so we add --location to enable that.
        push @$cmd, '--fail', '--location', '--output', $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.

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

### error handling the way Archive::Extract does it
sub _error {
    my $self    = shift;
    my $error   = shift;

    $self->_error_msg( $error );
    $self->_error_msg_long( Carp::longmess($error) );

    if( $WARN ) {
        carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
    }

    return;
}

sub error {
    my $self = shift;
    return shift() ? $self->_error_msg_long : $self->_error_msg;
}


1;

=pod

=head1 HOW IT WORKS

File::Fetch is able to fetch a variety of uris, by using several
external programs and modules.

Below is a mapping of what utilities will be used in what order
for what schemes, if available:

    file    => LWP, lftp, file
    http    => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
    ftp     => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
    rsync   => rsync

If you'd like to disable the use of one or more of these utilities
and/or modules, see the C<$BLACKLIST> variable further down.

If a utility or module isn't available, it will be marked in a cache
(see the C<$METHOD_FAIL> variable further down), so it will not be
tried again. The C<fetch> method will only fail when all options are
exhausted, and it was not able to retrieve the file.

The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD
may also have it from C<pkgsrc>. We only check for C<fetch> on those
three platforms.

C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
retrieving C<http> schemed urls. It doesn't follow redirects for instance.

A special note about fetching files from an ftp uri:

By default, all ftp connections are done in passive mode. To change
that, see the C<$FTP_PASSIVE> variable further down.

Furthermore, ftp uris only support anonymous connections, so no
named user/password pair can be passed along.

C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable
further down.

=head1 GLOBAL VARIABLES

The behaviour of File::Fetch can be altered by changing the following
global variables:

=head2 $File::Fetch::FROM_EMAIL

This is the email address that will be sent as your anonymous ftp
password.

Default is C<File-Fetch@example.com>.

=head2 $File::Fetch::USER_AGENT

This is the useragent as C<LWP> will report it.

Default is C<File::Fetch/$VERSION>.

=head2 $File::Fetch::FTP_PASSIVE

This variable controls whether the environment variable C<FTP_PASSIVE>
and any passive switches to commandline tools will be set to true.

Default value is 1.

Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch
files, since passive mode can only be set interactively for this binary

=head2 $File::Fetch::TIMEOUT

When set, controls the network timeout (counted in seconds).

Default value is 0.

=head2 $File::Fetch::WARN

This variable controls whether errors encountered internally by
C<File::Fetch> should be C<carp>'d or not.

Set to false to silence warnings. Inspect the output of the C<error()>
method manually to see what went wrong.

Defaults to C<true>.

=head2 $File::Fetch::DEBUG

This enables debugging output when calling commandline utilities to
fetch files.
This also enables C<Carp::longmess> errors, instead of the regular
C<carp> errors.

Good for tracking down why things don't work with your particular
setup.

Default is 0.

=head2 $File::Fetch::BLACKLIST

This is an array ref holding blacklisted modules/utilities for fetching
files with.

To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could
set $File::Fetch::BLACKLIST to:

    $File::Fetch::BLACKLIST = [qw|lwp netftp|]

The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable.

See the note on C<MAPPING> below.