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.8 by root, Wed Jun 4 12:32:30 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,
… …
138 138
139 my %hdr; 139 my %hdr;
140 140
141 $method = uc $method; 141 $method = uc $method;
142 142
143 if (my $hdr = delete $arg{headers}) { 143 if (my $hdr = $arg{headers}) {
144 while (my ($k, $v) = each %$hdr) { 144 while (my ($k, $v) = each %$hdr) {
145 $hdr{lc $k} = $v; 145 $hdr{lc $k} = $v;
146 } 146 }
147 } 147 }
148 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;
153
149 my $proxy = $arg{proxy} || $PROXY; 154 my $proxy = $arg{proxy} || $PROXY;
150 my $timeout = $arg{timeout} || $TIMEOUT; 155 my $timeout = $arg{timeout} || $TIMEOUT;
151 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
152 156
153 $hdr{"user-agent"} ||= $USERAGENT; 157 $hdr{"user-agent"} ||= $USERAGENT;
154 158
155 my ($host, $port, $path, $scheme); 159 my ($host, $port, $path, $scheme);
156 160
… …
161 ($scheme, my $authority, $path, my $query, my $fragment) = 165 ($scheme, my $authority, $path, my $query, my $fragment) =
162 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 166 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
163 167
164 $port = $scheme eq "http" ? 80 168 $port = $scheme eq "http" ? 80
165 : $scheme eq "https" ? 443 169 : $scheme eq "https" ? 443
166 : croak "$url: only http and https URLs supported"; 170 : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" });
167 171
168 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 172 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
169 or croak "$authority: unparsable URL"; 173 or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" });
170 174
171 $host = $1; 175 $host = $1;
172 $port = $2 if defined $2; 176 $port = $2 if defined $2;
173 177
174 $host =~ s/^\[(.*)\]$/$1/; 178 $host =~ s/^\[(.*)\]$/$1/;
… …
181 185
182 $scheme = lc $scheme; 186 $scheme = lc $scheme;
183 187
184 my %state; 188 my %state;
185 189
186 $state{body} = delete $arg{body};
187
188 $hdr{"content-length"} = length $state{body}; 190 $hdr{"content-length"} = length $arg{body};
189 191
190 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { 192 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
191 $state{fh} = shift 193 $state{fh} = shift
192 or return $cb->(undef, { Status => 599, Reason => "$!" }); 194 or return $cb->(undef, { Status => 599, Reason => "$!" });
193 195
… …
222 # send request 224 # send request
223 $state{handle}->push_write ( 225 $state{handle}->push_write (
224 "$method $path HTTP/1.0\015\012" 226 "$method $path HTTP/1.0\015\012"
225 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) 227 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
226 . "\015\012" 228 . "\015\012"
227 . (delete $state{body}) 229 . (delete $arg{body})
228 ); 230 );
229 231
230 %hdr = (); # reduce memory usage, save a kitten 232 %hdr = (); # reduce memory usage, save a kitten
231 233
232 # status line 234 # status line
… …
258 } 260 }
259 261
260 substr $_, 0, 1, "" 262 substr $_, 0, 1, ""
261 for values %hdr; 263 for values %hdr;
262 264
263 if ($method eq "HEAD") { 265 my $finish = sub {
266 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
267 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
268 } else {
269 $cb->($_[0], $_[1]);
270 }
271 };
272
273 if ($hdr{Status} =~ /^(?:1..|204|304)$/ or $method eq "HEAD") {
264 %state = (); 274 %state = ();
265 $cb->(undef, \%hdr); 275 $finish->(undef, \%hdr);
266 } else { 276 } else {
267 if (exists $hdr{"content-length"}) { 277 if (exists $hdr{"content-length"}) {
268 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { 278 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
269 # could cache persistent connection now 279 # could cache persistent connection now
270 if ($hdr{connection} =~ /\bkeep-alive\b/i) { 280 if ($hdr{connection} =~ /\bkeep-alive\b/i) {
271 # but we don't, due to misdesigns, this is annoyingly complex 281 # but we don't, due to misdesigns, this is annoyingly complex
272 }; 282 };
273 283
274 %state = (); 284 %state = ();
275 $cb->($_[1], \%hdr); 285 $finish->($_[1], \%hdr);
276 }); 286 });
277 } else { 287 } else {
278 # 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,
279 # no way to detect winged data. 289 # no way to detect winged data.
280 $_[0]->on_error (sub { 290 $_[0]->on_error (sub {
281 %state = (); 291 %state = ();
282 $cb->($_[0]{rbuf}, \%hdr); 292 $finish->($_[0]{rbuf}, \%hdr);
283 }); 293 });
284 $_[0]->on_eof (undef); 294 $_[0]->on_eof (undef);
285 $_[0]->on_read (sub { }); 295 $_[0]->on_read (sub { });
286 } 296 }
287 } 297 }

Diff Legend

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