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.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,
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
… …
114The 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
115this module might offer more options). 127this module might offer more options).
116 128
117=back 129=back
118 130
119=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 ;
120 150
121=cut 151=cut
122 152
123sub http_request($$$;@) { 153sub http_request($$$;@) {
124 my $cb = pop; 154 my $cb = pop;
… …
126 156
127 my %hdr; 157 my %hdr;
128 158
129 $method = uc $method; 159 $method = uc $method;
130 160
131 if (my $hdr = delete $arg{headers}) { 161 if (my $hdr = $arg{headers}) {
132 while (my ($k, $v) = each %$hdr) { 162 while (my ($k, $v) = each %$hdr) {
133 $hdr{lc $k} = $v; 163 $hdr{lc $k} = $v;
134 } 164 }
135 } 165 }
136 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
137 my $proxy = $arg{proxy} || $PROXY; 172 my $proxy = $arg{proxy} || $PROXY;
138 my $timeout = $arg{timeout} || $TIMEOUT; 173 my $timeout = $arg{timeout} || $TIMEOUT;
139 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
140 174
141 $hdr{"user-agent"} ||= $USERAGENT; 175 $hdr{"user-agent"} ||= $USERAGENT;
142 176
143 my ($host, $port, $path, $scheme); 177 my ($host, $port, $path, $scheme);
144 178
… …
149 ($scheme, my $authority, $path, my $query, my $fragment) = 183 ($scheme, my $authority, $path, my $query, my $fragment) =
150 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 184 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
151 185
152 $port = $scheme eq "http" ? 80 186 $port = $scheme eq "http" ? 80
153 : $scheme eq "https" ? 443 187 : $scheme eq "https" ? 443
154 : croak "$url: only http and https URLs supported"; 188 : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" });
155 189
156 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 190 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
157 or croak "$authority: unparsable URL"; 191 or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" });
158 192
159 $host = $1; 193 $host = $1;
160 $port = $2 if defined $2; 194 $port = $2 if defined $2;
161 195
162 $host =~ s/^\[(.*)\]$/$1/; 196 $host =~ s/^\[(.*)\]$/$1/;
… …
169 203
170 $scheme = lc $scheme; 204 $scheme = lc $scheme;
171 205
172 my %state; 206 my %state;
173 207
174 $state{body} = delete $arg{body};
175
176 $hdr{"content-length"} = length $state{body}; 208 $hdr{"content-length"} = length $arg{body};
177 209
178 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { 210 $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
179 $state{fh} = shift 211 $state{fh} = shift
180 or return $cb->(undef, { Status => 599, Reason => "$!" }); 212 or return $cb->(undef, { Status => 599, Reason => "$!" });
181 213
… …
210 # send request 242 # send request
211 $state{handle}->push_write ( 243 $state{handle}->push_write (
212 "$method $path HTTP/1.0\015\012" 244 "$method $path HTTP/1.0\015\012"
213 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) 245 . (join "", map "$_: $hdr{$_}\015\012", keys %hdr)
214 . "\015\012" 246 . "\015\012"
215 . (delete $state{body}) 247 . (delete $arg{body})
216 ); 248 );
217 249
218 %hdr = (); # reduce memory usage, save a kitten 250 %hdr = (); # reduce memory usage, save a kitten
219 251
220 # status line 252 # status line
… …
246 } 278 }
247 279
248 substr $_, 0, 1, "" 280 substr $_, 0, 1, ""
249 for values %hdr; 281 for values %hdr;
250 282
251 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") {
252 %state = (); 292 %state = ();
253 $cb->(undef, \%hdr); 293 $finish->(undef, \%hdr);
254 } else { 294 } else {
255 if (exists $hdr{"content-length"}) { 295 if (exists $hdr{"content-length"}) {
256 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { 296 $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub {
257 # could cache persistent connection now 297 # could cache persistent connection now
258 if ($hdr{connection} =~ /\bkeep-alive\b/i) { 298 if ($hdr{connection} =~ /\bkeep-alive\b/i) {
259 # but we don't, due to misdesigns, this is annoyingly complex 299 # but we don't, due to misdesigns, this is annoyingly complex
260 }; 300 };
261 301
262 %state = (); 302 %state = ();
263 $cb->($_[1], \%hdr); 303 $finish->($_[1], \%hdr);
264 }); 304 });
265 } else { 305 } else {
266 # 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,
267 # no way to detect winged data. 307 # no way to detect winged data.
268 $_[0]->on_error (sub { 308 $_[0]->on_error (sub {
269 %state = (); 309 %state = ();
270 $cb->($_[0]{rbuf}, \%hdr); 310 $finish->($_[0]{rbuf}, \%hdr);
271 }); 311 });
272 $_[0]->on_eof (undef); 312 $_[0]->on_eof (undef);
273 $_[0]->on_read (sub { }); 313 $_[0]->on_read (sub { });
274 } 314 }
275 } 315 }
… …
295sub http_post($$$;@) { 335sub http_post($$$;@) {
296 unshift @_, "POST", "body"; 336 unshift @_, "POST", "body";
297 &http_request 337 &http_request
298} 338}
299 339
340=back
341
300=head2 GLOBAL FUNCTIONS AND VARIABLES 342=head2 GLOBAL FUNCTIONS AND VARIABLES
301 343
302=over 4 344=over 4
303 345
304=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