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.5 by root, Wed Jun 4 12:03:47 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,
82then 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>
83and the C<Reason> pseudo-header will contain an error message. 83and the C<Reason> pseudo-header will contain an error message.
84 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
85Additional parameters are key-value pairs, and are fully optional. They 97Additional parameters are key-value pairs, and are fully optional. They
86include: 98include:
87 99
88=over 4 100=over 4
89 101
… …
126 138
127 my %hdr; 139 my %hdr;
128 140
129 $method = uc $method; 141 $method = uc $method;
130 142
131 if (my $hdr = delete $arg{headers}) { 143 if (my $hdr = $arg{headers}) {
132 while (my ($k, $v) = each %$hdr) { 144 while (my ($k, $v) = each %$hdr) {
133 $hdr{lc $k} = $v; 145 $hdr{lc $k} = $v;
134 } 146 }
135 } 147 }
136 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
137 my $proxy = $arg{proxy} || $PROXY; 154 my $proxy = $arg{proxy} || $PROXY;
138 my $timeout = $arg{timeout} || $TIMEOUT; 155 my $timeout = $arg{timeout} || $TIMEOUT;
139 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
140 156
141 $hdr{"user-agent"} ||= $USERAGENT; 157 $hdr{"user-agent"} ||= $USERAGENT;
142 158
143 my ($host, $port, $path, $scheme); 159 my ($host, $port, $path, $scheme);
144 160
… …
149 ($scheme, my $authority, $path, my $query, my $fragment) = 165 ($scheme, my $authority, $path, my $query, my $fragment) =
150 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 166 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
151 167
152 $port = $scheme eq "http" ? 80 168 $port = $scheme eq "http" ? 80
153 : $scheme eq "https" ? 443 169 : $scheme eq "https" ? 443
154 : croak "$url: only http and https URLs supported"; 170 : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" });
155 171
156 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 172 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
157 or croak "$authority: unparsable URL"; 173 or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" });
158 174
159 $host = $1; 175 $host = $1;
160 $port = $2 if defined $2; 176 $port = $2 if defined $2;
161 177
162 $host =~ s/^\[(.*)\]$/$1/; 178 $host =~ s/^\[(.*)\]$/$1/;
… …
169 185
170 $scheme = lc $scheme; 186 $scheme = lc $scheme;
171 187
172 my %state; 188 my %state;
173 189
174 $state{body} = delete $arg{body};
175
176 $hdr{"content-length"} = length $state{body}; 190 $hdr{"content-length"} = length $arg{body};
177 191
178 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { 192 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
179 $state{fh} = shift 193 $state{fh} = shift
180 or return $cb->(undef, { Status => 599, Reason => "$!" }); 194 or return $cb->(undef, { Status => 599, Reason => "$!" });
181 195
… …
210 # send request 224 # send request
211 $state{handle}->push_write ( 225 $state{handle}->push_write (
212 "$method $path HTTP/1.0\015\012" 226 "$method $path HTTP/1.0\015\012"
213 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) 227 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
214 . "\015\012" 228 . "\015\012"
215 . (delete $state{body}) 229 . (delete $arg{body})
216 ); 230 );
217 231
218 %hdr = (); # reduce memory usage, save a kitten 232 %hdr = (); # reduce memory usage, save a kitten
219 233
220 # status line 234 # status line
… …
246 } 260 }
247 261
248 substr $_, 0, 1, "" 262 substr $_, 0, 1, ""
249 for values %hdr; 263 for values %hdr;
250 264
251 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") {
252 %state = (); 274 %state = ();
253 $cb->(undef, \%hdr); 275 $finish->(undef, \%hdr);
254 } else { 276 } else {
255 if (exists $hdr{"content-length"}) { 277 if (exists $hdr{"content-length"}) {
256 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { 278 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
257 # could cache persistent connection now 279 # could cache persistent connection now
258 if ($hdr{connection} =~ /\bkeep-alive\b/i) { 280 if ($hdr{connection} =~ /\bkeep-alive\b/i) {
259 # but we don't, due to misdesigns, this is annoyingly complex 281 # but we don't, due to misdesigns, this is annoyingly complex
260 }; 282 };
261 283
262 %state = (); 284 %state = ();
263 $cb->($_[1], \%hdr); 285 $finish->($_[1], \%hdr);
264 }); 286 });
265 } else { 287 } else {
266 # 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,
267 # no way to detect winged data. 289 # no way to detect winged data.
268 $_[0]->on_error (sub { 290 $_[0]->on_error (sub {
269 %state = (); 291 %state = ();
270 $cb->($_[0]{rbuf}, \%hdr); 292 $finish->($_[0]{rbuf}, \%hdr);
271 }); 293 });
272 $_[0]->on_eof (undef); 294 $_[0]->on_eof (undef);
273 $_[0]->on_read (sub { }); 295 $_[0]->on_read (sub { });
274 } 296 }
275 } 297 }

Diff Legend

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