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.103 by root, Thu Feb 24 12:13:11 2011 UTC vs.
Revision 1.112 by root, Wed Nov 14 22:22:24 2012 UTC

… …
46use AnyEvent::Util (); 46use AnyEvent::Util ();
47use AnyEvent::Handle (); 47use AnyEvent::Handle ();
48 48
49use base Exporter::; 49use base Exporter::;
50 50
51our $VERSION = '2.1'; 51our $VERSION = '2.15';
52 52
53our @EXPORT = qw(http_get http_post http_head http_request); 53our @EXPORT = qw(http_get http_post http_head http_request);
54 54
55our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 55our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
56our $MAX_RECURSE = 10; 56our $MAX_RECURSE = 10;
… …
154 154
155=over 4 155=over 4
156 156
157=item recurse => $count (default: $MAX_RECURSE) 157=item recurse => $count (default: $MAX_RECURSE)
158 158
159Whether to recurse requests or not, e.g. on redirects, authentication 159Whether to recurse requests or not, e.g. on redirects, authentication and
160retries and so on, and how often to do so. 160other retries and so on, and how often to do so.
161 161
162=item headers => hashref 162=item headers => hashref
163 163
164The request headers to use. Currently, C<http_request> may provide its own 164The request headers to use. Currently, C<http_request> may provide its own
165C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and 165C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and
… …
168they won't be sent at all). 168they won't be sent at all).
169 169
170You really should provide your own C<User-Agent:> header value that is 170You really should provide your own C<User-Agent:> header value that is
171appropriate for your program - I wouldn't be surprised if the default 171appropriate for your program - I wouldn't be surprised if the default
172AnyEvent string gets blocked by webservers sooner or later. 172AnyEvent string gets blocked by webservers sooner or later.
173
174Also, make sure that your headers names and values do not contain any
175embedded newlines.
173 176
174=item timeout => $seconds 177=item timeout => $seconds
175 178
176The time-out to use for various stages - each connect attempt will reset 179The time-out to use for various stages - each connect attempt will reset
177the timeout, as will read or write activity, i.e. this is not an overall 180the timeout, as will read or write activity, i.e. this is not an overall
… …
381 384
382Example: do a HTTP HEAD request on https://www.google.com/, use a 385Example: do a HTTP HEAD request on https://www.google.com/, use a
383timeout of 30 seconds. 386timeout of 30 seconds.
384 387
385 http_request 388 http_request
386 GET => "https://www.google.com", 389 HEAD => "https://www.google.com",
387 headers => { "user-agent" => "MySearchClient 1.0" }, 390 headers => { "user-agent" => "MySearchClient 1.0" },
388 timeout => 30, 391 timeout => 30,
389 sub { 392 sub {
390 my ($body, $hdr) = @_; 393 my ($body, $hdr) = @_;
391 use Data::Dumper; 394 use Data::Dumper;
… …
778 my $persistent = exists $arg{persistent} ? !!$arg{persistent} : $idempotent; 781 my $persistent = exists $arg{persistent} ? !!$arg{persistent} : $idempotent;
779 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : !$proxy; 782 my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : !$proxy;
780 my $was_persistent; # true if this is actually a recycled connection 783 my $was_persistent; # true if this is actually a recycled connection
781 784
782 # the key to use in the keepalive cache 785 # the key to use in the keepalive cache
783 my $ka_key = "$uhost\x00$arg{sessionid}"; 786 my $ka_key = "$uscheme\x00$uhost\x00$uport\x00$arg{sessionid}";
784 787
785 $hdr{connection} = ($persistent ? $keepalive ? "keep-alive " : "" : "close ") . "Te"; #1.1 788 $hdr{connection} = ($persistent ? $keepalive ? "keep-alive " : "" : "close ") . "Te"; #1.1
786 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1 789 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
787 790
788 my %state = (connect_guard => 1); 791 my %state = (connect_guard => 1);
… …
959 my $body = ""; 962 my $body = "";
960 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 963 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
961 964
962 $state{read_chunk} = sub { 965 $state{read_chunk} = sub {
963 $_[1] =~ /^([0-9a-fA-F]+)/ 966 $_[1] =~ /^([0-9a-fA-F]+)/
964 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 967 or return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
965 968
966 my $len = hex $1; 969 my $len = hex $1;
967 970
968 if ($len) { 971 if ($len) {
969 $cl += $len; 972 $cl += $len;
… …
1047 _destroy_state %state; 1050 _destroy_state %state;
1048 1051
1049 %state = (); 1052 %state = ();
1050 $state{recurse} = 1053 $state{recurse} =
1051 http_request ( 1054 http_request (
1052 $method => $url, 1055 $method => $url,
1053 %arg, 1056 %arg,
1057 recurse => $recurse - 1,
1054 keepalive => 0, 1058 keepalive => 0,
1055 sub { 1059 sub {
1056 %state = (); 1060 %state = ();
1057 &$cb 1061 &$cb
1058 } 1062 }
… …
1135 if ($persistent && $KA_CACHE{$ka_key}) { 1139 if ($persistent && $KA_CACHE{$ka_key}) {
1136 $was_persistent = 1; 1140 $was_persistent = 1;
1137 1141
1138 $state{handle} = ka_fetch $ka_key; 1142 $state{handle} = ka_fetch $ka_key;
1139 $state{handle}->destroyed 1143 $state{handle}->destroyed
1140 and die "got a destructed habndle. pah\n";#d# 1144 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
1141 $prepare_handle->(); 1145 $prepare_handle->();
1142 $state{handle}->destroyed 1146 $state{handle}->destroyed
1143 and die "got a destructed habndle. pa2\n";#d# 1147 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
1144 $handle_actual_request->(); 1148 $handle_actual_request->();
1145 $state{handle}->destroyed
1146 and die "got a destructed habndle. pa3\n";#d#
1147 1149
1148 } else { 1150 } else {
1149 my $tcp_connect = $arg{tcp_connect} 1151 my $tcp_connect = $arg{tcp_connect}
1150 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; 1152 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
1151 1153
… …
1252 1254
1253The default value for the C<recurse> request parameter (default: C<10>). 1255The default value for the C<recurse> request parameter (default: C<10>).
1254 1256
1255=item $AnyEvent::HTTP::TIMEOUT 1257=item $AnyEvent::HTTP::TIMEOUT
1256 1258
1257The default timeout for conenction operations (default: C<300>). 1259The default timeout for connection operations (default: C<300>).
1258 1260
1259=item $AnyEvent::HTTP::USERAGENT 1261=item $AnyEvent::HTTP::USERAGENT
1260 1262
1261The default value for the C<User-Agent> header (the default is 1263The default value for the C<User-Agent> header (the default is
1262C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 1264C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
… …
1327 # other formats fail in the loop below 1329 # other formats fail in the loop below
1328 1330
1329 for (0..11) { 1331 for (0..11) {
1330 if ($m eq $month[$_]) { 1332 if ($m eq $month[$_]) {
1331 require Time::Local; 1333 require Time::Local;
1332 return Time::Local::timegm ($S, $M, $H, $d, $_, $y); 1334 return eval { Time::Local::timegm ($S, $M, $H, $d, $_, $y) };
1333 } 1335 }
1334 } 1336 }
1335 1337
1336 undef 1338 undef
1337} 1339}
… …
1383 1385
1384 warn stat $fh; 1386 warn stat $fh;
1385 warn -s _; 1387 warn -s _;
1386 if (stat $fh and -s _) { 1388 if (stat $fh and -s _) {
1387 $ofs = -s _; 1389 $ofs = -s _;
1388 warn "-s is ", $ofs;#d# 1390 warn "-s is ", $ofs;
1389 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9]; 1391 $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
1390 $hdr{"range"} = "bytes=$ofs-"; 1392 $hdr{"range"} = "bytes=$ofs-";
1391 } 1393 }
1392 1394
1393 http_get $url, 1395 http_get $url,

Diff Legend

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