LWP::Simple.pm

Gisle Aas (aas@oslonett.no)
Wed, 14 Jun 1995 11:24:16 +0200


This is a multipart MIME message.

--===_0_Wed_Jun_14_11:22:14_MET_DST_1995
Content-Type: text/plain; charset=us-ascii

I suggest that we move all convenience methods out of the UserAgent class and 
collect them in a different module that exports a procedural interface.  This 
also makes the UserAgent cleaner, as we add more convenience methods.

I also makes it easy to say things like:

   perl -e "use LWP::Simple; getprint 'http://localhost/"

which I think is great.

I have included Simple.pm.  I have also implemented a "head" function that 
returns key values from the head response.

Regards,
Gisle



--===_0_Wed_Jun_14_11:22:14_MET_DST_1995
Content-Type: text/plain; charset=us-ascii
Content-Description: Simple.pm

#
# $Id: UserAgent.pm,v 1.2 1995/06/14 08:18:25 aas Exp $
#

package LWP::Simple;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(get head getprint getstore mirror);


require LWP::UserAgent;
$ua = new LWP::UserAgent;  # we create a global UserAgent object

use LWP::Date qw(str2time);
use Carp;


=head1 get($url)

Get a document.  Returns the document is successful.  Returns 'undef' if it
fails.

=cut


sub get {
    my($url) = @_;
    LWP::Debug::trace('()');

    my $request = new LWP::Request('GET', $url);
    my $response = $ua->request($request);

    return $response->content if $response->isSuccess;
    return undef;
}

=head1 head($url)

Get document headers. Returns the following values if successful:
($content_type, $document_length, $modified_time, $expires, $server)

Returns 'undef' if it fails.

=cut
sub head {
    my($url) = @_;
    LWP::Debug::trace('()');

    my $request = new LWP::Request('HEAD', $url);
    my $response = $ua->request($request);

    if ($response->isSuccess) {
	return ($response->header('Content-Type'),
	        $response->header('Content-Length'),
                str2time($response->header('Last-Modified')),
                str2time($response->header('Expires')),#XXX: Verify header name
        	$response->header('Server'),
               );
    } else {
        return undef;
    }
}

=head1 getprint($url)

Get and print a document identified by a URL. The document is printet
on STDOUT. The error message is printed on STDERR if it fails. The
return value is a reference to the LWP::Response object.

=cut

sub getprint {
    my($url) = @_;
    LWP::Debug::trace('()');

    my $request = new LWP::Request('GET', $url);
    my $response = $ua->request($request);

    if ($response->isSuccess) {
        print $response->content;
    } else {
        print STDERR $response->errorAsHTML;
    }
    $response;
}

=head1 getstore($url, $file)

Get and store a document identified by a URL. The return value is a
reference to the LWP::Response object. You should check this for
success.

=cut

sub getstore {
    my($url, $file) = @_;
    croak("getAndStore needs two arguments") unless @_ == 2;

    LWP::Debug::trace('()');

    my $request = new LWP::Request('GET', $url);
    my $response = $ua->request($request, $file);

    $response;
}

=head1 mirror($url, $file)

Get and store a document identified by a URL,
using If-modified-since, and checking of the content-length.
Returns response.

=cut

sub mirror {
    my($url, $file) = @_;
    croak("mirror needs two arguments") unless @_ == 2;

    LWP::Debug::trace('()');

    my $request = new LWP::Request('GET', $url);

    my($ST_SIZE, $ST_MTIME) = (7, 9);
    if (-e $file) {
	my($mtime) = (stat($file))[$ST_MTIME];
	if($mtime) {
	    $request->header('If-Modified-Since',
			     &LWP::Date::time2str($mtime));
	}
    }
    my $tmpfile = "$file-$$";

    my $response = $ua->request($request, $tmpfile);
    if ($response->isSuccess) {
	
	my $file_length = (stat($tmpfile))[$ST_MTIME];
	my($content_length) = $response->header('Content-length');
    
	if (defined $content_length and $file_length < $content_length) {
	    unlink($tmpfile);
	    die "Transfer truncated: " .
		"only $file_length out of $content_length bytes received\n";
	}
	elsif (defined $content_length and $file_length > $content_length) {
	    unlink($tmpfile);
	    die "Content-length mismatch: " .
		"expected $content_length bytes, got $file_length\n";
	}
	else {
	    # OK
	    rename($tmpfile, $file) or die
		"Cannot rename '$tmpfile' to '$file': $!\n";
	}
    }
    return $response;
}

--===_0_Wed_Jun_14_11:22:14_MET_DST_1995--