"Fossies" - the Fresh Open Source Software Archive

Member "libwww-perl-6.43/lib/LWP/Simple.pm" (26 Nov 2019, 6550 Bytes) of package /linux/www/libwww-perl-6.43.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Simple.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 6.42_vs_6.43.

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