root/trunk/inc/LWP/Simple.pm

Revision 95, 6.2 kB (checked in by clinton, 5 years ago)

Add LWP to the inc bundle, tid10737 tid10892

Line 
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>
Note: See TracBrowser for help on using the browser.