1package LWP::Simple; 2 3use strict; 4 5our $VERSION = '6.59'; 6 7require Exporter; 8 9our @EXPORT = qw(get head getprint getstore mirror); 10our @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) 15use HTTP::Status; 16push(@EXPORT, @HTTP::Status::EXPORT); 17 18sub import 19{ 20 my $pkg = shift; 21 my $callpkg = caller; 22 Exporter::export($pkg, $callpkg, @_); 23} 24 25use LWP::UserAgent (); 26use HTTP::Date (); 27 28our $ua = LWP::UserAgent->new; # we create a global UserAgent object 29$ua->agent("LWP::Simple/$VERSION "); 30$ua->env_proxy; 31 32sub get ($) 33{ 34 my $response = $ua->get(shift); 35 return $response->decoded_content if $response->is_success; 36 return undef; 37} 38 39 40sub 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 59sub 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 76sub 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 86sub mirror ($$) 87{ 88 my($url, $file) = @_; 89 my $response = $ua->mirror($url, $file); 90 $response->code; 91} 92 93 941; 95 96__END__ 97 98=pod 99 100=head1 NAME 101 102LWP::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 122This module is meant for people who want a simplified view of the 123libwww-perl library. It should also be suitable for one-liners. If 124you need more control or access to the header fields in the requests 125sent and responses received, then you should use the full object-oriented 126interface provided by the L<LWP::UserAgent> module. 127 128The module will also export the L<LWP::UserAgent> object as C<$ua> if you 129ask for it explicitly. 130 131The user agent created by this module will identify itself as 132C<LWP::Simple/#.##> 133and will initialize its proxy defaults from the environment (by 134calling C<< $ua->env_proxy >>). 135 136=head1 FUNCTIONS 137 138The following functions are provided (and exported) by this module: 139 140=head2 get 141 142 my $res = get($url); 143 144The get() function will fetch the document identified by the given URL 145and return it. It returns C<undef> if it fails. The C<$url> argument can 146be either a string or a reference to a L<URI> object. 147 148You 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 150function. If you need that information you should use the full OO 151interface (see L<LWP::UserAgent>). 152 153=head2 head 154 155 my $res = head($url); 156 157Get document headers. Returns the following 5 values if successful: 158($content_type, $document_length, $modified_time, $expires, $server) 159 160Returns an empty list if it fails. In scalar context returns TRUE if 161successful. 162 163=head2 getprint 164 165 my $code = getprint($url); 166 167Get and print a document identified by a URL. The document is printed 168to the selected default filehandle for output (normally STDOUT) as 169data is received from the network. If the request fails, then the 170status code and message are printed on STDERR. The return value is 171the HTTP response code. 172 173=head2 getstore 174 175 my $code = getstore($url, $file) 176 177Gets a document identified by a URL and stores it in the file. The 178return value is the HTTP response code. 179 180=head2 mirror 181 182 my $code = mirror($url, $file); 183 184Get and store a document identified by a URL, using 185I<If-modified-since>, and checking the I<Content-Length>. Returns 186the HTTP response code. 187 188=head1 STATUS CONSTANTS 189 190This module also exports the L<HTTP::Status> constants and procedures. 191You can use them when you check the response code from L<LWP::Simple/getprint>, 192L<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 234The L<HTTP::Status> classification functions are: 235 236=head2 is_success 237 238 my $bool = is_success($rc); 239 240True if response code indicated a successful request. 241 242=head2 is_error 243 244 my $bool = is_error($rc) 245 246True if response code indicated that an error occurred. 247 248=head1 CAVEAT 249 250Note that if you are using both LWP::Simple and the very popular L<CGI> 251module, you may be importing a C<head> function from each module, 252producing a warning like C<Prototype mismatch: sub main::head ($) vs none>. 253Get around this problem by just not importing LWP::Simple's 254C<head> function, like so: 255 256 use LWP::Simple qw(!head); 257 use CGI qw(:standard); # then only CGI.pm defines a head() 258 259Then if you do need LWP::Simple's C<head> function, you can just call 260it as C<LWP::Simple::head($url)>. 261 262=head1 SEE ALSO 263 264L<LWP>, L<lwpcook>, L<LWP::UserAgent>, L<HTTP::Status>, L<lwp-request>, 265L<lwp-mirror> 266 267=cut 268