local-lib5/lib/perl5/LWP/Simple.pm

   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>