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.835";
|
---|
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 = LWP::UserAgent->new; # 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 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>
|
---|