| 1 |
package LWP::Simple; |
|---|
| 2 |
|
|---|
| 3 |
use strict; |
|---|
| 4 |
use vars qw($ua %loop_check $FULL_LWP @EXPORT @EXPORT_OK $VERSION); |
|---|
| 5 |
|
|---|
| 6 |
require Exporter; |
|---|
| 7 |
|
|---|
| 8 |
@EXPORT = qw(get head getprint getstore mirror); |
|---|
| 9 |
@EXPORT_OK = qw($ua); |
|---|
| 10 |
|
|---|
| 11 |
# I really hate this. I was a bad idea to do it in the first place. |
|---|
| 12 |
# Wonder how to get rid of it??? (It even makes LWP::Simple 7% slower |
|---|
| 13 |
# for trivial tests) |
|---|
| 14 |
use HTTP::Status; |
|---|
| 15 |
push(@EXPORT, @HTTP::Status::EXPORT); |
|---|
| 16 |
|
|---|
| 17 |
$VERSION = "5.827"; |
|---|
| 18 |
|
|---|
| 19 |
sub import |
|---|
| 20 |
{ |
|---|
| 21 |
my $pkg = shift; |
|---|
| 22 |
my $callpkg = caller; |
|---|
| 23 |
Exporter::export($pkg, $callpkg, @_); |
|---|
| 24 |
} |
|---|
| 25 |
|
|---|
| 26 |
use LWP::UserAgent (); |
|---|
| 27 |
use HTTP::Status (); |
|---|
| 28 |
use HTTP::Date (); |
|---|
| 29 |
$ua = new LWP::UserAgent; # we create a global UserAgent object |
|---|
| 30 |
$ua->agent("LWP::Simple/$VERSION "); |
|---|
| 31 |
$ua->env_proxy; |
|---|
| 32 |
|
|---|
| 33 |
|
|---|
| 34 |
sub get ($) |
|---|
| 35 |
{ |
|---|
| 36 |
my $response = $ua->get(shift); |
|---|
| 37 |
return $response->decoded_content if $response->is_success; |
|---|
| 38 |
return undef; |
|---|
| 39 |
} |
|---|
| 40 |
|
|---|
| 41 |
|
|---|
| 42 |
sub head ($) |
|---|
| 43 |
{ |
|---|
| 44 |
my($url) = @_; |
|---|
| 45 |
my $request = HTTP::Request->new(HEAD => $url); |
|---|
| 46 |
my $response = $ua->request($request); |
|---|
| 47 |
|
|---|
| 48 |
if ($response->is_success) { |
|---|
| 49 |
return $response unless wantarray; |
|---|
| 50 |
return (scalar $response->header('Content-Type'), |
|---|
| 51 |
scalar $response->header('Content-Length'), |
|---|
| 52 |
HTTP::Date::str2time($response->header('Last-Modified')), |
|---|
| 53 |
HTTP::Date::str2time($response->header('Expires')), |
|---|
| 54 |
scalar $response->header('Server'), |
|---|
| 55 |
); |
|---|
| 56 |
} |
|---|
| 57 |
return; |
|---|
| 58 |
} |
|---|
| 59 |
|
|---|
| 60 |
|
|---|
| 61 |
sub getprint ($) |
|---|
| 62 |
{ |
|---|
| 63 |
my($url) = @_; |
|---|
| 64 |
my $request = HTTP::Request->new(GET => $url); |
|---|
| 65 |
local($\) = ""; # ensure standard $OUTPUT_RECORD_SEPARATOR |
|---|
| 66 |
my $callback = sub { print $_[0] }; |
|---|
| 67 |
if ($^O eq "MacOS") { |
|---|
| 68 |
$callback = sub { $_[0] =~ s/\015?\012/\n/g; print $_[0] } |
|---|
| 69 |
} |
|---|
| 70 |
my $response = $ua->request($request, $callback); |
|---|
| 71 |
unless ($response->is_success) { |
|---|
| 72 |
print STDERR $response->status_line, " <URL:$url>\n"; |
|---|
| 73 |
} |
|---|
| 74 |
$response->code; |
|---|
| 75 |
} |
|---|
| 76 |
|
|---|
| 77 |
|
|---|
| 78 |
sub getstore ($$) |
|---|
| 79 |
{ |
|---|
| 80 |
my($url, $file) = @_; |
|---|
| 81 |
my $request = HTTP::Request->new(GET => $url); |
|---|
| 82 |
my $response = $ua->request($request, $file); |
|---|
| 83 |
|
|---|
| 84 |
$response->code; |
|---|
| 85 |
} |
|---|
| 86 |
|
|---|
| 87 |
|
|---|
| 88 |
sub mirror ($$) |
|---|
| 89 |
{ |
|---|
| 90 |
my($url, $file) = @_; |
|---|
| 91 |
my $response = $ua->mirror($url, $file); |
|---|
| 92 |
$response->code; |
|---|
| 93 |
} |
|---|
| 94 |
|
|---|
| 95 |
|
|---|
| 96 |
1; |
|---|
| 97 |
|
|---|
| 98 |
__END__ |
|---|
| 99 |
|
|---|
| 100 |
=head1 NAME |
|---|
| 101 |
|
|---|
| 102 |
LWP::Simple - simple procedural interface to LWP |
|---|
| 103 |
|
|---|
| 104 |
=head1 SYNOPSIS |
|---|
| 105 |
|
|---|
| 106 |
perl -MLWP::Simple -e 'getprint "http://www.sn.no"' |
|---|
| 107 |
|
|---|
| 108 |
use LWP::Simple; |
|---|
| 109 |
$content = get("http://www.sn.no/"); |
|---|
| 110 |
die "Couldn't get it!" unless defined $content; |
|---|
| 111 |
|
|---|
| 112 |
if (mirror("http://www.sn.no/", "foo") == RC_NOT_MODIFIED) { |
|---|
| 113 |
... |
|---|
| 114 |
} |
|---|
| 115 |
|
|---|
| 116 |
if (is_success(getprint("http://www.sn.no/"))) { |
|---|
| 117 |
... |
|---|
| 118 |
} |
|---|
| 119 |
|
|---|
| 120 |
=head1 DESCRIPTION |
|---|
| 121 |
|
|---|
| 122 |
This module is meant for people who want a simplified view of the |
|---|
| 123 |
libwww-perl library. It should also be suitable for one-liners. If |
|---|
| 124 |
you need more control or access to the header fields in the requests |
|---|
| 125 |
sent and responses received, then you should use the full object-oriented |
|---|
| 126 |
interface provided by the C<LWP::UserAgent> module. |
|---|
| 127 |
|
|---|
| 128 |
The following functions are provided (and exported) by this module: |
|---|
| 129 |
|
|---|
| 130 |
=over 3 |
|---|
| 131 |
|
|---|
| 132 |
=item get($url) |
|---|
| 133 |
|
|---|
| 134 |
The get() function will fetch the document identified by the given URL |
|---|
| 135 |
and return it. It returns C<undef> if it fails. The $url argument can |
|---|
| 136 |
be either a simple string or a reference to a URI object. |
|---|
| 137 |
|
|---|
| 138 |
You will not be able to examine the response code or response headers |
|---|
| 139 |
(like 'Content-Type') when you are accessing the web using this |
|---|
| 140 |
function. If you need that information you should use the full OO |
|---|
| 141 |
interface (see L<LWP::UserAgent>). |
|---|
| 142 |
|
|---|
| 143 |
=item head($url) |
|---|
| 144 |
|
|---|
| 145 |
Get document headers. Returns the following 5 values if successful: |
|---|
| 146 |
($content_type, $document_length, $modified_time, $expires, $server) |
|---|
| 147 |
|
|---|
| 148 |
Returns an empty list if it fails. In scalar context returns TRUE if |
|---|
| 149 |
successful. |
|---|
| 150 |
|
|---|
| 151 |
=item getprint($url) |
|---|
| 152 |
|
|---|
| 153 |
Get and print a document identified by a URL. The document is printed |
|---|
| 154 |
to the selected default filehandle for output (normally STDOUT) as |
|---|
| 155 |
data is received from the network. If the request fails, then the |
|---|
| 156 |
status code and message are printed on STDERR. The return value is |
|---|
| 157 |
the HTTP response code. |
|---|
| 158 |
|
|---|
| 159 |
=item getstore($url, $file) |
|---|
| 160 |
|
|---|
| 161 |
Gets a document identified by a URL and stores it in the file. The |
|---|
| 162 |
return value is the HTTP response code. |
|---|
| 163 |
|
|---|
| 164 |
=item mirror($url, $file) |
|---|
| 165 |
|
|---|
| 166 |
Get and store a document identified by a URL, using |
|---|
| 167 |
I<If-modified-since>, and checking the I<Content-Length>. Returns |
|---|
| 168 |
the HTTP response code. |
|---|
| 169 |
|
|---|
| 170 |
=back |
|---|
| 171 |
|
|---|
| 172 |
This module also exports the HTTP::Status constants and procedures. |
|---|
| 173 |
You can use them when you check the response code from getprint(), |
|---|
| 174 |
getstore() or mirror(). The constants are: |
|---|
| 175 |
|
|---|
| 176 |
RC_CONTINUE |
|---|
| 177 |
RC_SWITCHING_PROTOCOLS |
|---|
| 178 |
RC_OK |
|---|
| 179 |
RC_CREATED |
|---|
| 180 |
RC_ACCEPTED |
|---|
| 181 |
RC_NON_AUTHORITATIVE_INFORMATION |
|---|
| 182 |
RC_NO_CONTENT |
|---|
| 183 |
RC_RESET_CONTENT |
|---|
| 184 |
RC_PARTIAL_CONTENT |
|---|
| 185 |
RC_MULTIPLE_CHOICES |
|---|
| 186 |
RC_MOVED_PERMANENTLY |
|---|
| 187 |
RC_MOVED_TEMPORARILY |
|---|
| 188 |
RC_SEE_OTHER |
|---|
| 189 |
RC_NOT_MODIFIED |
|---|
| 190 |
RC_USE_PROXY |
|---|
| 191 |
RC_BAD_REQUEST |
|---|
| 192 |
RC_UNAUTHORIZED |
|---|
| 193 |
RC_PAYMENT_REQUIRED |
|---|
| 194 |
RC_FORBIDDEN |
|---|
| 195 |
RC_NOT_FOUND |
|---|
| 196 |
RC_METHOD_NOT_ALLOWED |
|---|
| 197 |
RC_NOT_ACCEPTABLE |
|---|
| 198 |
RC_PROXY_AUTHENTICATION_REQUIRED |
|---|
| 199 |
RC_REQUEST_TIMEOUT |
|---|
| 200 |
RC_CONFLICT |
|---|
| 201 |
RC_GONE |
|---|
| 202 |
RC_LENGTH_REQUIRED |
|---|
| 203 |
RC_PRECONDITION_FAILED |
|---|
| 204 |
RC_REQUEST_ENTITY_TOO_LARGE |
|---|
| 205 |
RC_REQUEST_URI_TOO_LARGE |
|---|
| 206 |
RC_UNSUPPORTED_MEDIA_TYPE |
|---|
| 207 |
RC_INTERNAL_SERVER_ERROR |
|---|
| 208 |
RC_NOT_IMPLEMENTED |
|---|
| 209 |
RC_BAD_GATEWAY |
|---|
| 210 |
RC_SERVICE_UNAVAILABLE |
|---|
| 211 |
RC_GATEWAY_TIMEOUT |
|---|
| 212 |
RC_HTTP_VERSION_NOT_SUPPORTED |
|---|
| 213 |
|
|---|
| 214 |
The HTTP::Status classification functions are: |
|---|
| 215 |
|
|---|
| 216 |
=over 3 |
|---|
| 217 |
|
|---|
| 218 |
=item is_success($rc) |
|---|
| 219 |
|
|---|
| 220 |
True if response code indicated a successful request. |
|---|
| 221 |
|
|---|
| 222 |
=item is_error($rc) |
|---|
| 223 |
|
|---|
| 224 |
True if response code indicated that an error occurred. |
|---|
| 225 |
|
|---|
| 226 |
=back |
|---|
| 227 |
|
|---|
| 228 |
The module will also export the LWP::UserAgent object as C<$ua> if you |
|---|
| 229 |
ask for it explicitly. |
|---|
| 230 |
|
|---|
| 231 |
The user agent created by this module will identify itself as |
|---|
| 232 |
"LWP::Simple/#.##" |
|---|
| 233 |
and will initialize its proxy defaults from the environment (by |
|---|
| 234 |
calling $ua->env_proxy). |
|---|
| 235 |
|
|---|
| 236 |
=head1 CAVEAT |
|---|
| 237 |
|
|---|
| 238 |
Note that if you are using both LWP::Simple and the very popular CGI.pm |
|---|
| 239 |
module, you may be importing a C<head> function from each module, |
|---|
| 240 |
producing a warning like "Prototype mismatch: sub main::head ($) vs |
|---|
| 241 |
none". Get around this problem by just not importing LWP::Simple's |
|---|
| 242 |
C<head> function, like so: |
|---|
| 243 |
|
|---|
| 244 |
use LWP::Simple qw(!head); |
|---|
| 245 |
use CGI qw(:standard); # then only CGI.pm defines a head() |
|---|
| 246 |
|
|---|
| 247 |
Then if you do need LWP::Simple's C<head> function, you can just call |
|---|
| 248 |
it as C<LWP::Simple::head($url)>. |
|---|
| 249 |
|
|---|
| 250 |
=head1 SEE ALSO |
|---|
| 251 |
|
|---|
| 252 |
L<LWP>, L<lwpcook>, L<LWP::UserAgent>, L<HTTP::Status>, L<lwp-request>, |
|---|
| 253 |
L<lwp-mirror> |
|---|