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.6 by root, Wed Jun 4 12:05:45 2008 UTC vs.
Revision 1.9 by root, Wed Jun 4 13:51:53 2008 UTC

… …
59Executes an HTTP-HEAD request. See the http_request function for details on 59Executes an HTTP-HEAD request. See the http_request function for details on
60additional parameters. 60additional parameters.
61 61
62=item http_post $url, $body, key => value..., $cb->($data, $headers) 62=item http_post $url, $body, key => value..., $cb->($data, $headers)
63 63
64Executes an HTTP-POST request with a requets body of C<$bod>. See the 64Executes an HTTP-POST request with a request body of C<$bod>. See the
65http_request function for details on additional parameters. 65http_request function for details on additional parameters.
66 66
67=item http_request $method => $url, key => value..., $cb->($data, $headers) 67=item http_request $method => $url, key => value..., $cb->($data, $headers)
68 68
69Executes 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
… …
71 71
72The callback will be called with the response data as first argument 72The callback will be called with the response data as first argument
73(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
74response headers as second argument. 74response headers as second argument.
75 75
76All 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
77headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and 77headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and
78C<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
79name. 79name.
80 80
81If 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,
… …
126The request body, usually empty. Will be-sent as-is (future versions of 126The request body, usually empty. Will be-sent as-is (future versions of
127this module might offer more options). 127this module might offer more options).
128 128
129=back 129=back
130 130
131=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 ;
132 150
133=cut 151=cut
134 152
135sub http_request($$$;@) { 153sub http_request($$$;@) {
136 my $cb = pop; 154 my $cb = pop;
… …
138 156
139 my %hdr; 157 my %hdr;
140 158
141 $method = uc $method; 159 $method = uc $method;
142 160
143 if (my $hdr = delete $arg{headers}) { 161 if (my $hdr = $arg{headers}) {
144 while (my ($k, $v) = each %$hdr) { 162 while (my ($k, $v) = each %$hdr) {
145 $hdr{lc $k} = $v; 163 $hdr{lc $k} = $v;
146 } 164 }
147 } 165 }
148 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;
171
149 my $proxy = $arg{proxy} || $PROXY; 172 my $proxy = $arg{proxy} || $PROXY;
150 my $timeout = $arg{timeout} || $TIMEOUT; 173 my $timeout = $arg{timeout} || $TIMEOUT;
151 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
152 174
153 $hdr{"user-agent"} ||= $USERAGENT; 175 $hdr{"user-agent"} ||= $USERAGENT;
154 176
155 my ($host, $port, $path, $scheme); 177 my ($host, $port, $path, $scheme);
156 178
… …
161 ($scheme, my $authority, $path, my $query, my $fragment) = 183 ($scheme, my $authority, $path, my $query, my $fragment) =
162 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 184 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
163 185
164 $port = $scheme eq "http" ? 80 186 $port = $scheme eq "http" ? 80
165 : $scheme eq "https" ? 443 187 : $scheme eq "https" ? 443
166 : croak "$url: only http and https URLs supported"; 188 : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" });
167 189
168 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 190 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
169 or croak "$authority: unparsable URL"; 191 or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" });
170 192
171 $host = $1; 193 $host = $1;
172 $port = $2 if defined $2; 194 $port = $2 if defined $2;
173 195
174 $host =~ s/^\[(.*)\]$/$1/; 196 $host =~ s/^\[(.*)\]$/$1/;
… …
181 203
182 $scheme = lc $scheme; 204 $scheme = lc $scheme;
183 205
184 my %state; 206 my %state;
185 207
186 $state{body} = delete $arg{body};
187
188 $hdr{"content-length"} = length $state{body}; 208 $hdr{"content-length"} = length $arg{body};
189 209
190 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { 210 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
191 $state{fh} = shift 211 $state{fh} = shift
192 or return $cb->(undef, { Status => 599, Reason => "$!" }); 212 or return $cb->(undef, { Status => 599, Reason => "$!" });
193 213
… …
222 # send request 242 # send request
223 $state{handle}->push_write ( 243 $state{handle}->push_write (
224 "$method $path HTTP/1.0\015\012" 244 "$method $path HTTP/1.0\015\012"
225 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) 245 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
226 . "\015\012" 246 . "\015\012"
227 . (delete $state{body}) 247 . (delete $arg{body})
228 ); 248 );
229 249
230 %hdr = (); # reduce memory usage, save a kitten 250 %hdr = (); # reduce memory usage, save a kitten
231 251
232 # status line 252 # status line
… …
258 } 278 }
259 279
260 substr $_, 0, 1, "" 280 substr $_, 0, 1, ""
261 for values %hdr; 281 for values %hdr;
262 282
263 if ($method eq "HEAD") { 283 my $finish = sub {
284 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
285 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
286 } else {
287 $cb->($_[0], $_[1]);
288 }
289 };
290
291 if ($hdr{Status} =~ /^(?:1..|204|304)$/ or $method eq "HEAD") {
264 %state = (); 292 %state = ();
265 $cb->(undef, \%hdr); 293 $finish->(undef, \%hdr);
266 } else { 294 } else {
267 if (exists $hdr{"content-length"}) { 295 if (exists $hdr{"content-length"}) {
268 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { 296 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
269 # could cache persistent connection now 297 # could cache persistent connection now
270 if ($hdr{connection} =~ /\bkeep-alive\b/i) { 298 if ($hdr{connection} =~ /\bkeep-alive\b/i) {
271 # but we don't, due to misdesigns, this is annoyingly complex 299 # but we don't, due to misdesigns, this is annoyingly complex
272 }; 300 };
273 301
274 %state = (); 302 %state = ();
275 $cb->($_[1], \%hdr); 303 $finish->($_[1], \%hdr);
276 }); 304 });
277 } else { 305 } else {
278 # 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,
279 # no way to detect winged data. 307 # no way to detect winged data.
280 $_[0]->on_error (sub { 308 $_[0]->on_error (sub {
281 %state = (); 309 %state = ();
282 $cb->($_[0]{rbuf}, \%hdr); 310 $finish->($_[0]{rbuf}, \%hdr);
283 }); 311 });
284 $_[0]->on_eof (undef); 312 $_[0]->on_eof (undef);
285 $_[0]->on_read (sub { }); 313 $_[0]->on_read (sub { });
286 } 314 }
287 } 315 }
… …
307sub http_post($$$;@) { 335sub http_post($$$;@) {
308 unshift @_, "POST", "body"; 336 unshift @_, "POST", "body";
309 &http_request 337 &http_request
310} 338}
311 339
340=back
341
312=head2 GLOBAL FUNCTIONS AND VARIABLES 342=head2 GLOBAL FUNCTIONS AND VARIABLES
313 343
314=over 4 344=over 4
315 345
316=item AnyEvent::HTTP::set_proxy "proxy-url" 346=item AnyEvent::HTTP::set_proxy "proxy-url"

Diff Legend

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