view release on metacpan or  search on metacpan

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

    ### fetch the uri to cwd() ###
    my $where = $ff->fetch() or die $ff->error;

    ### fetch the uri to /tmp ###
    my $where = $ff->fetch( to => '/tmp' );

    ### parsed bits from the uri ###
    $ff->uri;
    $ff->scheme;
    $ff->host;
    $ff->path;
    $ff->file;

=head1 DESCRIPTION

File::Fetch is a generic file fetching mechanism.

It allows you to fetch any file pointed to by a C<ftp>, C<http>,
C<file>, or C<rsync> uri by a number of different means.

See the C<HOW IT WORKS> section further down for details.

=head1 ACCESSORS

A C<File::Fetch> object has the following accessors

=over 4

=item $ff->uri

The uri you passed to the constructor

=item $ff->scheme

The scheme from the uri (like 'file', 'http', etc)

=item $ff->host

The hostname in the uri.  Will be empty if host was originally
'localhost' for a 'file://' url.

=item $ff->vol

On operating systems with the concept of a volume the second element
of a file:// is considered to the be volume specification for the file.
Thus on Win32 this routine returns the volume, on other operating
systems this returns nothing.

On Windows this value may be empty if the uri is to a network share, in
which case the 'share' property will be defined. Additionally, volume
specifications that use '|' as ':' will be converted on read to use ':'.

On VMS, which has a volume concept, this field will be empty because VMS
file specifications are converted to absolute UNIX format and the volume
information is transparently included.

=item $ff->share

On systems with the concept of a network share (currently only Windows) returns
the sharename from a file://// url.  On other operating systems returns empty.

=item $ff->path

The path from the uri, will be at least a single '/'.

=item $ff->file

The name of the remote file. For the local file name, the
result of $ff->output_file will be used.

=item $ff->file_default

The name of the default local file, that $ff->output_file falls back to if
it would otherwise return no filename. For example when fetching a URI like
http://www.abc.net.au/ the contents retrieved may be from a remote file called
'index.html'. The default value of this attribute is literally 'file_default'.

=cut


##########################
### Object & Accessors ###
##########################

{
    ### template for autogenerated accessors ###
    my $Tmpl = {
        scheme          => { default => 'http' },
        host            => { default => 'localhost' },
        path            => { default => '/' },
        file            => { required => 1 },
        uri             => { required => 1 },
        vol             => { default => '' }, # windows for file:// uris
        share           => { default => '' }, # windows for file:// uris
        file_default    => { default => 'file_default' },
        _error_msg      => { no_override => 1 },
        _error_msg_long => { no_override => 1 },
    };

    for my $method ( keys %$Tmpl ) {
        no strict 'refs';
        *$method = sub {
                        my $self = shift;
                        $self->{$method} = $_[0] if @_;
                        return $self->{$method};
                    }
    }

    sub _create {
        my $class = shift;
        my %hash  = @_;

        my $args = check( $Tmpl, \%hash ) or return;

        bless $args, $class;

        if( lc($args->scheme) ne 'file' and not $args->host ) {
            return $class->_error(loc(
                "Hostname required when fetching from '%1'",$args->scheme));
        }

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

# }

=head1 METHODS

=head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' );

Parses the uri and creates a corresponding File::Fetch::Item object,
that is ready to be C<fetch>ed and returns it.

Returns false on failure.

=cut

sub new {
    my $class = shift;
    my %hash  = @_;

    my ($uri, $file_default);
    my $tmpl = {
        uri          => { required => 1, store => \$uri },
        file_default => { required => 0, store => \$file_default },
    };

    check( $tmpl, \%hash ) or return;

    ### parse the uri to usable parts ###
    my $href    = $class->_parse_uri( $uri ) or return;

    $href->{file_default} = $file_default if $file_default;

    ### make it into a FFI object ###
    my $ff      = $class->_create( %$href ) or return;


    ### return the object ###
    return $ff;
}

### parses an uri to a hash structure:
###
### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' )
###
### becomes:
###
### $href = {
###     scheme  => 'ftp',
###     host    => 'ftp.cpan.org',
###     path    => '/pub/mirror',
###     file    => 'index.html'
### };
###
### In the case of file:// urls there maybe be additional fields
###
### For systems with volume specifications such as Win32 there will be
### a volume specifier provided in the 'vol' field.
###
###   'vol' => 'volumename'
###
### For windows file shares there may be a 'share' key specified
###
###   'share' => 'sharename'
###
### Note that the rules of what a file:// url means vary by the operating system
### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious
### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and
### not '/foo/bar.txt'
###
### Similarly if the host interpreting the url is VMS then
### file:///disk$user/my/notes/note12345.txt' means
### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as
### if it is unix where it means /disk$user/my/notes/note12345.txt'.
### Except for some cases in the File::Spec methods, Perl on VMS will generally
### handle UNIX format file specifications.
###
### This means it is impossible to serve certain file:// urls on certain systems.
###
### Thus are the problems with a protocol-less specification. :-(
###

sub _parse_uri {
    my $self = shift;
    my $uri  = shift or return;

    my $href = { uri => $uri };

    ### find the scheme ###
    $uri            =~ s|^(\w+)://||;
    $href->{scheme} = $1;

    ### See rfc 1738 section 3.10
    ### http://www.faqs.org/rfcs/rfc1738.html
    ### And wikipedia for more on windows file:// urls
    ### http://en.wikipedia.org/wiki/File://
    if( $href->{scheme} eq 'file' ) {

        my @parts = split '/',$uri;

        ### file://hostname/...
        ### file://hostname/...
        ### normalize file://localhost with file:///
        $href->{host} = $parts[0] || '';

        ### index in @parts where the path components begin;
        my $index = 1;

        ### file:////hostname/sharename/blah.txt
        if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) {

            $href->{host}   = $parts[2] || '';  # avoid warnings
            $href->{share}  = $parts[3] || '';  # avoid warnings

            $index          = 4         # index after the share

        ### file:///D|/blah.txt
        ### file:///D:/blah.txt
        } elsif (HAS_VOL) {

            ### this code comes from dmq's patch, but:
            ### XXX if volume is empty, wouldn't that be an error? --kane
            ### if so, our file://localhost test needs to be fixed as wel
            $href->{vol}    = $parts[1] || '';

            ### correct D| style colume descriptors
            $href->{vol}    =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN;

            $index          = 2;        # index after the volume
        }

        ### rebuild the path from the leftover parts;
        $href->{path} = join '/', '', splice( @parts, $index, $#parts );

    } else {
        ### using anything but qw() in hash slices may produce warnings
        ### in older perls :-(
        @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
    }

    ### split the path into file + dir ###
    {   my @parts = File::Spec::Unix->splitpath( delete $href->{path} );
        $href->{path} = $parts[1];
        $href->{file} = $parts[2];
    }

    ### host will be empty if the target was 'localhost' and the
    ### scheme was 'file'
    $href->{host} = '' if   ($href->{host}      eq 'localhost') and
                            ($href->{scheme}    eq 'file');

    return $href;
}

=head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] )

Fetches the file you requested and returns the full path to the file.

By default it writes to C<cwd()>, but you can override that by specifying
the C<to> argument:

    ### file fetch to /tmp, full path to the file in $where
    $where = $ff->fetch( to => '/tmp' );

    ### file slurped into $scalar, full path to the file in $where
    ### file is downloaded to a temp directory and cleaned up at exit time
    $where = $ff->fetch( to => \$scalar );

Returns the full path to the downloaded file on success, and false