ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-HTTP/HTTP.pm
(Generate patch)

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.2 by root, Wed Jun 4 11:37:41 2008 UTC vs.
Revision 1.9 by root, Wed Jun 4 13:51:53 2008 UTC

… …
34our $VERSION = '1.0'; 34our $VERSION = '1.0';
35 35
36our @EXPORT = qw(http_get http_request); 36our @EXPORT = qw(http_get http_request);
37 37
38our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 38our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
39our $MAX_REDIRECTS = 10; 39our $MAX_RECURSE = 10;
40our $MAX_PERSISTENT = 8; 40our $MAX_PERSISTENT = 8;
41our $PERSISTENT_TIMEOUT = 2; 41our $PERSISTENT_TIMEOUT = 2;
42our $TIMEOUT = 300; 42our $TIMEOUT = 300;
43 43
44# changing these is evil 44# changing these is evil
… …
52=item http_get $url, key => value..., $cb->($data, $headers) 52=item http_get $url, key => value..., $cb->($data, $headers)
53 53
54Executes an HTTP-GET request. See the http_request function for details on 54Executes an HTTP-GET request. See the http_request function for details on
55additional parameters. 55additional parameters.
56 56
57=item http_head $url, key => value..., $cb->($data, $headers)
58
59Executes an HTTP-HEAD request. See the http_request function for details on
60additional parameters.
61
62=item http_post $url, $body, key => value..., $cb->($data, $headers)
63
64Executes an HTTP-POST request with a request body of C<$bod>. See the
65http_request function for details on additional parameters.
66
57=item http_request $method => $url, key => value..., $cb->($data, $headers) 67=item http_request $method => $url, key => value..., $cb->($data, $headers)
58 68
59Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL 69Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL
60must be an absolute http or https URL. 70must be an absolute http or https URL.
61 71
62The callback will be called with the response data as first argument 72The callback will be called with the response data as first argument
63(or C<undef> if it wasn't available due to errors), and a hash-ref with 73(or C<undef> if it wasn't available due to errors), and a hash-ref with
64response headers as second argument. 74response headers as second argument.
65 75
66All the headers in that has are lowercased. In addition to the response 76All the headers in that hash are lowercased. In addition to the response
67headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and 77headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and
68C<Reason> contain the three parts of the HTTP Status-Line of the same 78C<Reason> contain the three parts of the HTTP Status-Line of the same
69name. 79name.
70 80
71If an internal error occurs, such as not being able to resolve a hostname, 81If an internal error occurs, such as not being able to resolve a hostname,
72then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599> 82then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599>
73and the C<Reason> pseudo-header will contain an error message. 83and the C<Reason> pseudo-header will contain an error message.
74 84
85A typical callback might look like this:
86
87 sub {
88 my ($body, $hdr) = @_;
89
90 if ($hdr->{Status} =~ /^2/) {
91 ... everything should be ok
92 } else {
93 print "error, $hdr->{Status} $hdr->{Reason}\n";
94 }
95 }
96
75Additional parameters are key-value pairs, and are fully optional. They 97Additional parameters are key-value pairs, and are fully optional. They
76include: 98include:
77 99
78=over 4 100=over 4
79 101
80=item recurse => $boolean (default: true) 102=item recurse => $count (default: $MAX_RECURSE)
81 103
82Whether to recurse requests or not, e.g. on redirects, authentication 104Whether to recurse requests or not, e.g. on redirects, authentication
83retries and so on. 105retries and so on, and how often to do so.
84 106
85=item headers => hashref 107=item headers => hashref
86 108
87The request headers to use. 109The request headers to use.
88 110
… …
97default proxy (as specified by C<$ENV{http_proxy}>) is used. 119default proxy (as specified by C<$ENV{http_proxy}>) is used.
98 120
99C<$scheme> must be either missing or C<http> for HTTP, or C<https> for 121C<$scheme> must be either missing or C<http> for HTTP, or C<https> for
100HTTPS. 122HTTPS.
101 123
124=item body => $string
125
126The request body, usually empty. Will be-sent as-is (future versions of
127this module might offer more options).
128
102=back 129=back
103 130
104=back 131Example: make a simple HTTP GET request for http://www.nethype.de/
132
133 http_request GET => "http://www.nethype.de/", sub {
134 my ($body, $hdr) = @_;
135 print "$body\n";
136 };
137
138Example: make a HTTP HEAD request on https://www.google.com/, use a
139timeout of 30 seconds.
140
141 http_request
142 GET => "https://www.google.com",
143 timeout => 30,
144 sub {
145 my ($body, $hdr) = @_;
146 use Data::Dumper;
147 print Dumper $hdr;
148 }
149 ;
105 150
106=cut 151=cut
107 152
108sub http_request($$$;@) { 153sub http_request($$$;@) {
109 my $cb = pop; 154 my $cb = pop;
110 my ($method, $url, %arg) = @_; 155 my ($method, $url, %arg) = @_;
111 156
112 my %hdr; 157 my %hdr;
113 158
159 $method = uc $method;
160
114 if (my $hdr = delete $arg{headers}) { 161 if (my $hdr = $arg{headers}) {
115 while (my ($k, $v) = each %$hdr) { 162 while (my ($k, $v) = each %$hdr) {
116 $hdr{lc $k} = $v; 163 $hdr{lc $k} = $v;
117 } 164 }
118 } 165 }
166
167 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
168
169 return $cb->(undef, { Status => 599, Reason => "recursion limit reached" })
170 if $recurse < 0;
119 171
120 my $proxy = $arg{proxy} || $PROXY; 172 my $proxy = $arg{proxy} || $PROXY;
121 my $timeout = $arg{timeout} || $TIMEOUT; 173 my $timeout = $arg{timeout} || $TIMEOUT;
122 174
123 $hdr{"user-agent"} ||= $USERAGENT; 175 $hdr{"user-agent"} ||= $USERAGENT;
… …
131 ($scheme, my $authority, $path, my $query, my $fragment) = 183 ($scheme, my $authority, $path, my $query, my $fragment) =
132 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 184 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
133 185
134 $port = $scheme eq "http" ? 80 186 $port = $scheme eq "http" ? 80
135 : $scheme eq "https" ? 443 187 : $scheme eq "https" ? 443
136 : croak "$url: only http and https URLs supported"; 188 : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" });
137 189
138 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 190 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
139 or croak "$authority: unparsable URL"; 191 or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" });
140 192
141 $host = $1; 193 $host = $1;
142 $port = $2 if defined $2; 194 $port = $2 if defined $2;
143 195
144 $host =~ s/^\[(.*)\]$/$1/; 196 $host =~ s/^\[(.*)\]$/$1/;
… …
151 203
152 $scheme = lc $scheme; 204 $scheme = lc $scheme;
153 205
154 my %state; 206 my %state;
155 207
156 my $body = "";
157 $state{body} = $body;
158
159 $hdr{"content-length"} = length $body; 208 $hdr{"content-length"} = length $arg{body};
160 209
161 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { 210 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
162 $state{fh} = shift 211 $state{fh} = shift
163 or return $cb->(undef, { Status => 599, Reason => "$!" }); 212 or return $cb->(undef, { Status => 599, Reason => "$!" });
164 213
… …
190 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" }); 239 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" });
191 }); 240 });
192 241
193 # send request 242 # send request
194 $state{handle}->push_write ( 243 $state{handle}->push_write (
195 "\U$method\E $path HTTP/1.0\015\012" 244 "$method $path HTTP/1.0\015\012"
196 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) 245 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
197 . "\015\012" 246 . "\015\012"
198 . (delete $state{body}) 247 . (delete $arg{body})
199 ); 248 );
200 249
201 %hdr = (); # reduce memory usage, save a kitten 250 %hdr = (); # reduce memory usage, save a kitten
202 251
203 # status line 252 # status line
… …
229 } 278 }
230 279
231 substr $_, 0, 1, "" 280 substr $_, 0, 1, ""
232 for values %hdr; 281 for values %hdr;
233 282
234 if (exists $hdr{"content-length"}) { 283 my $finish = sub {
235 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { 284 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
236 # could cache persistent connection now 285 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
237 if ($hdr{connection} =~ /\bkeep-alive\b/i) { 286 } else {
238 # but we don't, due to misdesigns, this is annoyingly complex 287 $cb->($_[0], $_[1]);
239 }; 288 }
289 };
240 290
291 if ($hdr{Status} =~ /^(?:1..|204|304)$/ or $method eq "HEAD") {
241 %state = (); 292 %state = ();
242 $cb->($_[1], \%hdr); 293 $finish->(undef, \%hdr);
243 });
244 } else { 294 } else {
295 if (exists $hdr{"content-length"}) {
296 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
297 # could cache persistent connection now
298 if ($hdr{connection} =~ /\bkeep-alive\b/i) {
299 # but we don't, due to misdesigns, this is annoyingly complex
300 };
301
302 %state = ();
303 $finish->($_[1], \%hdr);
304 });
305 } else {
245 # too bad, need to read until we get an error or EOF, 306 # too bad, need to read until we get an error or EOF,
246 # no way to detect winged data. 307 # no way to detect winged data.
247 $_[0]->on_error (sub { 308 $_[0]->on_error (sub {
248 %state = (); 309 %state = ();
249 $cb->($_[0]{rbuf}, \%hdr); 310 $finish->($_[0]{rbuf}, \%hdr);
250 }); 311 });
251 $_[0]->on_eof (undef); 312 $_[0]->on_eof (undef);
252 $_[0]->on_read (sub { }); 313 $_[0]->on_read (sub { });
314 }
253 } 315 }
254 }); 316 });
255 }); 317 });
256 }, sub { 318 }, sub {
257 $timeout 319 $timeout
… …
263sub http_get($$;@) { 325sub http_get($$;@) {
264 unshift @_, "GET"; 326 unshift @_, "GET";
265 &http_request 327 &http_request
266} 328}
267 329
330sub http_head($$;@) {
331 unshift @_, "HEAD";
332 &http_request
333}
334
335sub http_post($$$;@) {
336 unshift @_, "POST", "body";
337 &http_request
338}
339
340=back
341
268=head2 GLOBAL FUNCTIONS AND VARIABLES 342=head2 GLOBAL FUNCTIONS AND VARIABLES
269 343
270=over 4 344=over 4
271 345
272=item AnyEvent::HTTP::set_proxy "proxy-url" 346=item AnyEvent::HTTP::set_proxy "proxy-url"
273 347
274Sets the default proxy server to use. The proxy-url must begin with a 348Sets the default proxy server to use. The proxy-url must begin with a
275string of the form C<http://host:port> (optionally C<https:...>). 349string of the form C<http://host:port> (optionally C<https:...>).
276 350
277=item $AnyEvent::HTTP::MAX_REDIRECTS 351=item $AnyEvent::HTTP::MAX_RECURSE
278 352
279The default value for the C<max_redirects> request parameter 353The default value for the C<recurse> request parameter (default: C<10>).
280(default: C<10>).
281 354
282=item $AnyEvent::HTTP::USERAGENT 355=item $AnyEvent::HTTP::USERAGENT
283 356
284The default value for the C<User-Agent> header (the default is 357The default value for the C<User-Agent> header (the default is
285C<Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 358C<Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
286 359
287=item $AnyEvent::HTTP::MAX_PERSISTENT 360=item $AnyEvent::HTTP::MAX_PERSISTENT
288 361
289The maximum number of persistent connections to keep open (default: 8). 362The maximum number of persistent connections to keep open (default: 8).
290 363
364Not implemented currently.
365
291=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT 366=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT
292 367
293The maximum time to cache a persistent connection, in seconds (default: 2). 368The maximum time to cache a persistent connection, in seconds (default: 2).
369
370Not implemented currently.
294 371
295=back 372=back
296 373
297=cut 374=cut
298 375

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines