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.8 by root, Wed Jun 4 12:32:30 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
… …
96Use the given http proxy for all requests. If not specified, then the 118Use the given http proxy for all requests. If not specified, then the
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.
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).
101 128
102=back 129=back
103 130
104=back 131=back
105 132
… …
109 my $cb = pop; 136 my $cb = pop;
110 my ($method, $url, %arg) = @_; 137 my ($method, $url, %arg) = @_;
111 138
112 my %hdr; 139 my %hdr;
113 140
141 $method = uc $method;
142
114 if (my $hdr = delete $arg{headers}) { 143 if (my $hdr = $arg{headers}) {
115 while (my ($k, $v) = each %$hdr) { 144 while (my ($k, $v) = each %$hdr) {
116 $hdr{lc $k} = $v; 145 $hdr{lc $k} = $v;
117 } 146 }
118 } 147 }
148
149 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
150
151 return $cb->(undef, { Status => 599, Reason => "recursion limit reached" })
152 if $recurse < 0;
119 153
120 my $proxy = $arg{proxy} || $PROXY; 154 my $proxy = $arg{proxy} || $PROXY;
121 my $timeout = $arg{timeout} || $TIMEOUT; 155 my $timeout = $arg{timeout} || $TIMEOUT;
122 156
123 $hdr{"user-agent"} ||= $USERAGENT; 157 $hdr{"user-agent"} ||= $USERAGENT;
… …
131 ($scheme, my $authority, $path, my $query, my $fragment) = 165 ($scheme, my $authority, $path, my $query, my $fragment) =
132 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 166 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
133 167
134 $port = $scheme eq "http" ? 80 168 $port = $scheme eq "http" ? 80
135 : $scheme eq "https" ? 443 169 : $scheme eq "https" ? 443
136 : croak "$url: only http and https URLs supported"; 170 : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" });
137 171
138 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 172 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
139 or croak "$authority: unparsable URL"; 173 or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" });
140 174
141 $host = $1; 175 $host = $1;
142 $port = $2 if defined $2; 176 $port = $2 if defined $2;
143 177
144 $host =~ s/^\[(.*)\]$/$1/; 178 $host =~ s/^\[(.*)\]$/$1/;
… …
151 185
152 $scheme = lc $scheme; 186 $scheme = lc $scheme;
153 187
154 my %state; 188 my %state;
155 189
156 my $body = "";
157 $state{body} = $body;
158
159 $hdr{"content-length"} = length $body; 190 $hdr{"content-length"} = length $arg{body};
160 191
161 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { 192 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
162 $state{fh} = shift 193 $state{fh} = shift
163 or return $cb->(undef, { Status => 599, Reason => "$!" }); 194 or return $cb->(undef, { Status => 599, Reason => "$!" });
164 195
… …
190 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" }); 221 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" });
191 }); 222 });
192 223
193 # send request 224 # send request
194 $state{handle}->push_write ( 225 $state{handle}->push_write (
195 "\U$method\E $path HTTP/1.0\015\012" 226 "$method $path HTTP/1.0\015\012"
196 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) 227 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
197 . "\015\012" 228 . "\015\012"
198 . (delete $state{body}) 229 . (delete $arg{body})
199 ); 230 );
200 231
201 %hdr = (); # reduce memory usage, save a kitten 232 %hdr = (); # reduce memory usage, save a kitten
202 233
203 # status line 234 # status line
… …
229 } 260 }
230 261
231 substr $_, 0, 1, "" 262 substr $_, 0, 1, ""
232 for values %hdr; 263 for values %hdr;
233 264
234 if (exists $hdr{"content-length"}) { 265 my $finish = sub {
235 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { 266 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
236 # could cache persistent connection now 267 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
237 if ($hdr{connection} =~ /\bkeep-alive\b/i) { 268 } else {
238 # but we don't, due to misdesigns, this is annoyingly complex 269 $cb->($_[0], $_[1]);
239 }; 270 }
271 };
240 272
273 if ($hdr{Status} =~ /^(?:1..|204|304)$/ or $method eq "HEAD") {
241 %state = (); 274 %state = ();
242 $cb->($_[1], \%hdr); 275 $finish->(undef, \%hdr);
243 });
244 } else { 276 } else {
277 if (exists $hdr{"content-length"}) {
278 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
279 # could cache persistent connection now
280 if ($hdr{connection} =~ /\bkeep-alive\b/i) {
281 # but we don't, due to misdesigns, this is annoyingly complex
282 };
283
284 %state = ();
285 $finish->($_[1], \%hdr);
286 });
287 } else {
245 # too bad, need to read until we get an error or EOF, 288 # too bad, need to read until we get an error or EOF,
246 # no way to detect winged data. 289 # no way to detect winged data.
247 $_[0]->on_error (sub { 290 $_[0]->on_error (sub {
248 %state = (); 291 %state = ();
249 $cb->($_[0]{rbuf}, \%hdr); 292 $finish->($_[0]{rbuf}, \%hdr);
250 }); 293 });
251 $_[0]->on_eof (undef); 294 $_[0]->on_eof (undef);
252 $_[0]->on_read (sub { }); 295 $_[0]->on_read (sub { });
296 }
253 } 297 }
254 }); 298 });
255 }); 299 });
256 }, sub { 300 }, sub {
257 $timeout 301 $timeout
… …
263sub http_get($$;@) { 307sub http_get($$;@) {
264 unshift @_, "GET"; 308 unshift @_, "GET";
265 &http_request 309 &http_request
266} 310}
267 311
312sub http_head($$;@) {
313 unshift @_, "HEAD";
314 &http_request
315}
316
317sub http_post($$$;@) {
318 unshift @_, "POST", "body";
319 &http_request
320}
321
268=head2 GLOBAL FUNCTIONS AND VARIABLES 322=head2 GLOBAL FUNCTIONS AND VARIABLES
269 323
270=over 4 324=over 4
271 325
272=item AnyEvent::HTTP::set_proxy "proxy-url" 326=item AnyEvent::HTTP::set_proxy "proxy-url"
273 327
274Sets the default proxy server to use. The proxy-url must begin with a 328Sets the default proxy server to use. The proxy-url must begin with a
275string of the form C<http://host:port> (optionally C<https:...>). 329string of the form C<http://host:port> (optionally C<https:...>).
276 330
277=item $AnyEvent::HTTP::MAX_REDIRECTS 331=item $AnyEvent::HTTP::MAX_RECURSE
278 332
279The default value for the C<max_redirects> request parameter 333The default value for the C<recurse> request parameter (default: C<10>).
280(default: C<10>).
281 334
282=item $AnyEvent::HTTP::USERAGENT 335=item $AnyEvent::HTTP::USERAGENT
283 336
284The default value for the C<User-Agent> header (the default is 337The 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)>). 338C<Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
286 339
287=item $AnyEvent::HTTP::MAX_PERSISTENT 340=item $AnyEvent::HTTP::MAX_PERSISTENT
288 341
289The maximum number of persistent connections to keep open (default: 8). 342The maximum number of persistent connections to keep open (default: 8).
290 343
344Not implemented currently.
345
291=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT 346=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT
292 347
293The maximum time to cache a persistent connection, in seconds (default: 2). 348The maximum time to cache a persistent connection, in seconds (default: 2).
349
350Not implemented currently.
294 351
295=back 352=back
296 353
297=cut 354=cut
298 355

Diff Legend

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