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.4 by root, Wed Jun 4 11:59:22 2008 UTC vs.
Revision 1.8 by root, Wed Jun 4 12:32:30 2008 UTC

… …
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
57=item http_get $url, $body, key => value..., $cb->($data, $headers) 62=item http_post $url, $body, key => value..., $cb->($data, $headers)
58 63
59Executes 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
60http_request function for details on additional parameters. 65http_request function for details on additional parameters.
61 66
62=item http_request $method => $url, key => value..., $cb->($data, $headers) 67=item http_request $method => $url, key => value..., $cb->($data, $headers)
63 68
64Executes 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
… …
66 71
67The callback will be called with the response data as first argument 72The callback will be called with the response data as first argument
68(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
69response headers as second argument. 74response headers as second argument.
70 75
71All 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
72headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and 77headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and
73C<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
74name. 79name.
75 80
76If 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,
77then 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>
78and the C<Reason> pseudo-header will contain an error message. 83and the C<Reason> pseudo-header will contain an error message.
79 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
80Additional parameters are key-value pairs, and are fully optional. They 97Additional parameters are key-value pairs, and are fully optional. They
81include: 98include:
82 99
83=over 4 100=over 4
84 101
… …
121 138
122 my %hdr; 139 my %hdr;
123 140
124 $method = uc $method; 141 $method = uc $method;
125 142
126 if (my $hdr = delete $arg{headers}) { 143 if (my $hdr = $arg{headers}) {
127 while (my ($k, $v) = each %$hdr) { 144 while (my ($k, $v) = each %$hdr) {
128 $hdr{lc $k} = $v; 145 $hdr{lc $k} = $v;
129 } 146 }
130 } 147 }
131 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
132 my $proxy = $arg{proxy} || $PROXY; 154 my $proxy = $arg{proxy} || $PROXY;
133 my $timeout = $arg{timeout} || $TIMEOUT; 155 my $timeout = $arg{timeout} || $TIMEOUT;
134 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
135 156
136 $hdr{"user-agent"} ||= $USERAGENT; 157 $hdr{"user-agent"} ||= $USERAGENT;
137 158
138 my ($host, $port, $path, $scheme); 159 my ($host, $port, $path, $scheme);
139 160
… …
144 ($scheme, my $authority, $path, my $query, my $fragment) = 165 ($scheme, my $authority, $path, my $query, my $fragment) =
145 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 166 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
146 167
147 $port = $scheme eq "http" ? 80 168 $port = $scheme eq "http" ? 80
148 : $scheme eq "https" ? 443 169 : $scheme eq "https" ? 443
149 : croak "$url: only http and https URLs supported"; 170 : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" });
150 171
151 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 172 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
152 or croak "$authority: unparsable URL"; 173 or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" });
153 174
154 $host = $1; 175 $host = $1;
155 $port = $2 if defined $2; 176 $port = $2 if defined $2;
156 177
157 $host =~ s/^\[(.*)\]$/$1/; 178 $host =~ s/^\[(.*)\]$/$1/;
… …
164 185
165 $scheme = lc $scheme; 186 $scheme = lc $scheme;
166 187
167 my %state; 188 my %state;
168 189
169 $state{body} = delete $arg{body};
170
171 $hdr{"content-length"} = length $state{body}; 190 $hdr{"content-length"} = length $arg{body};
172 191
173 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { 192 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
174 $state{fh} = shift 193 $state{fh} = shift
175 or return $cb->(undef, { Status => 599, Reason => "$!" }); 194 or return $cb->(undef, { Status => 599, Reason => "$!" });
176 195
… …
205 # send request 224 # send request
206 $state{handle}->push_write ( 225 $state{handle}->push_write (
207 "$method $path HTTP/1.0\015\012" 226 "$method $path HTTP/1.0\015\012"
208 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) 227 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
209 . "\015\012" 228 . "\015\012"
210 . (delete $state{body}) 229 . (delete $arg{body})
211 ); 230 );
212 231
213 %hdr = (); # reduce memory usage, save a kitten 232 %hdr = (); # reduce memory usage, save a kitten
214 233
215 # status line 234 # status line
… …
241 } 260 }
242 261
243 substr $_, 0, 1, "" 262 substr $_, 0, 1, ""
244 for values %hdr; 263 for values %hdr;
245 264
246 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") {
247 %state = (); 274 %state = ();
248 $cb->(undef, \%hdr); 275 $finish->(undef, \%hdr);
249 } else { 276 } else {
250 if (exists $hdr{"content-length"}) { 277 if (exists $hdr{"content-length"}) {
251 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { 278 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
252 # could cache persistent connection now 279 # could cache persistent connection now
253 if ($hdr{connection} =~ /\bkeep-alive\b/i) { 280 if ($hdr{connection} =~ /\bkeep-alive\b/i) {
254 # but we don't, due to misdesigns, this is annoyingly complex 281 # but we don't, due to misdesigns, this is annoyingly complex
255 }; 282 };
256 283
257 %state = (); 284 %state = ();
258 $cb->($_[1], \%hdr); 285 $finish->($_[1], \%hdr);
259 }); 286 });
260 } else { 287 } else {
261 # 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,
262 # no way to detect winged data. 289 # no way to detect winged data.
263 $_[0]->on_error (sub { 290 $_[0]->on_error (sub {
264 %state = (); 291 %state = ();
265 $cb->($_[0]{rbuf}, \%hdr); 292 $finish->($_[0]{rbuf}, \%hdr);
266 }); 293 });
267 $_[0]->on_eof (undef); 294 $_[0]->on_eof (undef);
268 $_[0]->on_read (sub { }); 295 $_[0]->on_read (sub { });
269 } 296 }
270 } 297 }

Diff Legend

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