view release on metacpan or  search on metacpan

lib/Slaughter/Transport/http.pm  view on Meta::CPAN

    #
    # Module loading succeeded; we're available.
    #
    return 1;
}



=head2 error

Return the last error from the transport.

This is only set in L</isAvailable>.

=cut

sub error
{
    my ($self) = (@_);
    return ( $self->{ 'error' } );
}



=head2 fetchContents

Fetch the contents of a remote URL, using HTTP basic-auth if we should

=cut

sub fetchContents
{
    my ( $self, %args ) = (@_);

    #
    #  The file to fetch, and the prefix from which to load it.
    #
    my $pref = $args{ 'prefix' };
    my $url  = $args{ 'file' };

    #
    #  Is this fully-qualified?
    #
    if ( $url !~ /^http/i )
    {
        $url = "$self->{'prefix'}/$pref/$url";

        $self->{ 'verbose' } &&
          print "\tExpanded to: $url  \n";
    }


    my $ua;

    if ( $LWP::UserAgent::VERSION < 6.00 )
    {
        $ua = LWP::UserAgent->new();
    }
    else
    {
        $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 1 } );
    }

    #
    # Use a proxy, if we should.
    #
    $ua->env_proxy();

    #
    #  Make a request, do it in this fashion so we can use Basic-Auth if we need to.
    #
    my $req = HTTP::Request->new( GET => $url );
    if ( $self->{ 'username' } && $self->{ 'password' } )
    {
        $req->authorization_basic( $self->{ 'username' },
                                   $self->{ 'password' } );
    }

    #
    #  Send the request
    #
    my $response = $ua->request($req);
    if ( $response->is_success() )
    {
        $self->{ 'verbose' } &&
          print "\tOK\n";
        return ( $response->decoded_content() );
    }

    #
    #  Failed?
    #
    $self->{ 'verbose' } &&
      print "\tFailed to fetch: $url - " . $response->status_line . "\n";

    #
    #  Return undef, but hide this from perlcritic.
    #
    my $res = undef;
    return ($res);
}


1;


=head1 AUTHOR

Steve Kemp <steve@steve.org.uk>

=cut

=head1 LICENSE

Copyright (c) 2010-2015 by Steve Kemp.  All rights reserved.

This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.
The LICENSE file contains the full text of the license.