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.68 by root, Fri Dec 31 19:22:18 2010 UTC vs.
Revision 1.78 by root, Sat Jan 1 19:32:41 2011 UTC

… …
122 122
123If the server sends a header multiple times, then their contents will be 123If the server sends a header multiple times, then their contents will be
124joined together with a comma (C<,>), as per the HTTP spec. 124joined together with a comma (C<,>), as per the HTTP spec.
125 125
126If an internal error occurs, such as not being able to resolve a hostname, 126If an internal error occurs, such as not being able to resolve a hostname,
127then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<59x> 127then C<$data> will be C<undef>, C<< $headers->{Status} >> will be
128(usually C<599>) and the C<Reason> pseudo-header will contain an error 128C<590>-C<599> and the C<Reason> pseudo-header will contain an error
129message. 129message. Currently the following status codes are used:
130
131=over 4
132
133=item 595 - errors during connection etsbalishment, proxy handshake.
134
135=item 596 - errors during TLS negotiation, request sending and header processing.
136
137=item 597 - errors during body receiving or processing.
138
139=item 598 - user aborted request via C<on_header> or C<on_body>.
140
141=item 599 - other, usually nonretryable, errors (garbled URL etc.).
142
143=back
130 144
131A typical callback might look like this: 145A typical callback might look like this:
132 146
133 sub { 147 sub {
134 my ($body, $hdr) = @_; 148 my ($body, $hdr) = @_;
… …
152 166
153=item headers => hashref 167=item headers => hashref
154 168
155The request headers to use. Currently, C<http_request> may provide its own 169The request headers to use. Currently, C<http_request> may provide its own
156C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and 170C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and
157will provide defaults for C<TE:>, C<Referer:> and C<User-Agent:> (this can 171will provide defaults at least for C<TE:>, C<Referer:> and C<User-Agent:>
158be suppressed by using C<undef> for these headers in which case they won't 172(this can be suppressed by using C<undef> for these headers in which case
159be sent at all). 173they won't be sent at all).
160 174
161=item timeout => $seconds 175=item timeout => $seconds
162 176
163The time-out to use for various stages - each connect attempt will reset 177The time-out to use for various stages - each connect attempt will reset
164the timeout, as will read or write activity, i.e. this is not an overall 178the timeout, as will read or write activity, i.e. this is not an overall
… …
183 197
184Passing this parameter enables (simplified) cookie-processing, loosely 198Passing this parameter enables (simplified) cookie-processing, loosely
185based on the original netscape specification. 199based on the original netscape specification.
186 200
187The C<$hash_ref> must be an (initially empty) hash reference which will 201The C<$hash_ref> must be an (initially empty) hash reference which will
188get updated automatically. It is possible to save the cookie_jar to 202get updated automatically. It is possible to save the cookie jar to
189persistent storage with something like JSON or Storable, but this is not 203persistent storage with something like JSON or Storable, but this is not
190recommended, as expiry times are currently being ignored. 204recommended, as session-only cookies might survive longer than expected.
191 205
192Note that this cookie implementation is not of very high quality, nor 206Note that this cookie implementation is not meant to be complete. If
193meant to be complete. If you want complete cookie management you have to 207you want complete cookie management you have to do that on your
194do that on your own. C<cookie_jar> is meant as a quick fix to get some 208own. C<cookie_jar> is meant as a quick fix to get some cookie-using sites
195cookie-using sites working. Cookies are a privacy disaster, do not use 209working. Cookies are a privacy disaster, do not use them unless required
196them unless required to. 210to.
211
212When cookie processing is enabled, the C<Cookie:> and C<Set-Cookie:>
213headers will be set and handled by this module, otherwise they will be
214left untouched.
197 215
198=item tls_ctx => $scheme | $tls_ctx 216=item tls_ctx => $scheme | $tls_ctx
199 217
200Specifies the AnyEvent::TLS context to be used for https connections. This 218Specifies the AnyEvent::TLS context to be used for https connections. This
201parameter follows the same rules as the C<tls_ctx> parameter to 219parameter follows the same rules as the C<tls_ctx> parameter to
… …
360 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 378 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
361 379
362 _slot_schedule $_[0]; 380 _slot_schedule $_[0];
363} 381}
364 382
383# extract cookies from jar
384sub cookie_jar_extract($$$$) {
385 my ($jar, $uscheme, $uhost, $upath) = @_;
386
387 %$jar = () if $jar->{version} != 1;
388
389 my @cookies;
390
391 while (my ($chost, $paths) = each %$jar) {
392 next unless ref $paths;
393
394 if ($chost =~ /^\./) {
395 next unless $chost eq substr $uhost, -length $chost;
396 } elsif ($chost =~ /\./) {
397 next unless $chost eq $uhost;
398 } else {
399 next;
400 }
401
402 while (my ($cpath, $cookies) = each %$paths) {
403 next unless $cpath eq substr $upath, 0, length $cpath;
404
405 while (my ($cookie, $kv) = each %$cookies) {
406 next if $uscheme ne "https" && exists $kv->{secure};
407
408 if (exists $kv->{expires}) {
409 if (AE::now > parse_date ($kv->{expires})) {
410 delete $cookies->{$cookie};
411 next;
412 }
413 }
414
415 my $value = $kv->{value};
416
417 if ($value =~ /[=;,[:space:]]/) {
418 $value =~ s/([\\"])/\\$1/g;
419 $value = "\"$value\"";
420 }
421
422 push @cookies, "$cookie=$value";
423 }
424 }
425 }
426
427 \@cookies
428}
429
430# parse set_cookie header into jar
431sub cookie_jar_set_cookie($$$) {
432 my ($jar, $set_cookie, $uhost) = @_;
433
434 for ($set_cookie) {
435 # parse NAME=VALUE
436 my @kv;
437
438 while (
439 m{
440 \G\s*
441 (?:
442 expires \s*=\s* ([A-Z][a-z][a-z],\ [^,;]+)
443 | ([^=;,[:space:]]+) \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) )
444 )
445 }gcxsi
446 ) {
447 my $name = $2;
448 my $value = $4;
449
450 unless (defined $name) {
451 # expires
452 $name = "expires";
453 $value = $1;
454 } elsif (!defined $value) {
455 # quoted
456 $value = $3;
457 $value =~ s/\\(.)/$1/gs;
458 }
459
460 push @kv, lc $name, $value;
461
462 last unless /\G\s*;/gc;
463 }
464
465 last unless @kv;
466
467 my $name = shift @kv;
468 my %kv = (value => shift @kv, @kv);
469
470 $kv{expires} ||= format_date (AE::now + $kv{"max-age"})
471 if exists $kv{"max-age"};
472
473 my $cdom;
474 my $cpath = (delete $kv{path}) || "/";
475
476 if (exists $kv{domain}) {
477 $cdom = delete $kv{domain};
478
479 $cdom =~ s/^\.?/./; # make sure it starts with a "."
480
481 next if $cdom =~ /\.$/;
482
483 # this is not rfc-like and not netscape-like. go figure.
484 my $ndots = $cdom =~ y/.//;
485 next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
486 } else {
487 $cdom = $uhost;
488 }
489
490 # store it
491 $jar->{version} = 1;
492 $jar->{$cdom}{$cpath}{$name} = \%kv;
493
494 redo if /\G\s*,/gc;
495 }
496}
497
365# continue to parse $_ for headers and place them into the arg 498# continue to parse $_ for headers and place them into the arg
366sub parse_hdr() { 499sub parse_hdr() {
367 my %hdr; 500 my %hdr;
368 501
369 # things seen, not parsed: 502 # things seen, not parsed:
… …
444 577
445 $upath =~ s%^/?%/%; 578 $upath =~ s%^/?%/%;
446 579
447 # cookie processing 580 # cookie processing
448 if (my $jar = $arg{cookie_jar}) { 581 if (my $jar = $arg{cookie_jar}) {
449 %$jar = () if $jar->{version} != 1; 582 my $cookies = cookie_jar_extract $jar, $uscheme, $uhost, $upath;
450 583
451 my @cookie;
452
453 while (my ($chost, $v) = each %$jar) {
454 if ($chost =~ /^\./) {
455 next unless $chost eq substr $uhost, -length $chost;
456 } elsif ($chost =~ /\./) {
457 next unless $chost eq $uhost;
458 } else {
459 next;
460 }
461
462 while (my ($cpath, $v) = each %$v) {
463 next unless $cpath eq substr $upath, 0, length $cpath;
464
465 while (my ($k, $v) = each %$v) {
466 next if $uscheme ne "https" && exists $v->{secure};
467 my $value = $v->{value};
468 $value =~ s/([\\"])/\\$1/g;
469 push @cookie, "$k=\"$value\"";
470 }
471 }
472 }
473
474 $hdr{cookie} = join "; ", @cookie 584 $hdr{cookie} = join "; ", @$cookies
475 if @cookie; 585 if @$cookies;
476 } 586 }
477 587
478 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path 588 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path
479 589
480 if ($proxy) { 590 if ($proxy) {
… …
504 _get_slot $uhost, sub { 614 _get_slot $uhost, sub {
505 $state{slot_guard} = shift; 615 $state{slot_guard} = shift;
506 616
507 return unless $state{connect_guard}; 617 return unless $state{connect_guard};
508 618
619 my $ae_error = 595; # connecting
620
509 my $connect_cb = sub { 621 my $connect_cb = sub {
510 $state{fh} = shift 622 $state{fh} = shift
511 or do { 623 or do {
512 my $err = "$!"; 624 my $err = "$!";
513 %state = (); 625 %state = ();
514 return $cb->(undef, { @pseudo, Status => 599, Reason => $err }); 626 return $cb->(undef, { @pseudo, Status => $ae_error, Reason => $err });
515 }; 627 };
516
517 pop; # free memory, save a tree
518 628
519 return unless delete $state{connect_guard}; 629 return unless delete $state{connect_guard};
520 630
521 # get handle 631 # get handle
522 $state{handle} = new AnyEvent::Handle 632 $state{handle} = new AnyEvent::Handle
… …
525 tls_ctx => $arg{tls_ctx}, 635 tls_ctx => $arg{tls_ctx},
526 # these need to be reconfigured on keepalive handles 636 # these need to be reconfigured on keepalive handles
527 timeout => $timeout, 637 timeout => $timeout,
528 on_error => sub { 638 on_error => sub {
529 %state = (); 639 %state = ();
530 $cb->(undef, { @pseudo, Status => 599, Reason => $_[2] }); 640 $cb->(undef, { @pseudo, Status => $ae_error, Reason => $_[2] });
531 }, 641 },
532 on_eof => sub { 642 on_eof => sub {
533 %state = (); 643 %state = ();
534 $cb->(undef, { @pseudo, Status => 599, Reason => "Unexpected end-of-file" }); 644 $cb->(undef, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" });
535 }, 645 },
536 ; 646 ;
537 647
538 # limit the number of persistent connections 648 # limit the number of persistent connections
539 # keepalive not yet supported 649 # keepalive not yet supported
… …
547 657
548 $state{handle}->starttls ("connect") if $rscheme eq "https"; 658 $state{handle}->starttls ("connect") if $rscheme eq "https";
549 659
550 # handle actual, non-tunneled, request 660 # handle actual, non-tunneled, request
551 my $handle_actual_request = sub { 661 my $handle_actual_request = sub {
662 $ae_error = 596; # request phase
663
552 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 664 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
553 665
554 # send request 666 # send request
555 $state{handle}->push_write ( 667 $state{handle}->push_write (
556 "$method $rpath HTTP/1.1\015\012" 668 "$method $rpath HTTP/1.1\015\012"
… …
567 # status line and headers 679 # status line and headers
568 $state{read_response} = sub { 680 $state{read_response} = sub {
569 for ("$_[1]") { 681 for ("$_[1]") {
570 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 682 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
571 683
572 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/igxc 684 /^HTTP\/0*([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/gxci
573 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid server response" })); 685 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid server response" }));
574 686
575 # 100 Continue handling 687 # 100 Continue handling
576 # should not happen as we don't send expect: 100-continue, 688 # should not happen as we don't send expect: 100-continue,
577 # but we handle it just in case. 689 # but we handle it just in case.
… …
612 724
613 if ($recurse) { 725 if ($recurse) {
614 my $status = $hdr{Status}; 726 my $status = $hdr{Status};
615 727
616 # industry standard is to redirect POST as GET for 728 # industry standard is to redirect POST as GET for
617 # 301, 302 and 303, in contrast to http/1.0 and 1.1. 729 # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1.
618 # also, the UA should ask the user for 301 and 307 and POST, 730 # also, the UA should ask the user for 301 and 307 and POST,
619 # industry standard seems to be to simply follow. 731 # industry standard seems to be to simply follow.
620 # we go with the industry standard. 732 # we go with the industry standard.
621 if ($status == 301 or $status == 302 or $status == 303) { 733 if ($status == 301 or $status == 302 or $status == 303) {
622 # HTTP/1.1 is unclear on how to mutate the method 734 # HTTP/1.1 is unclear on how to mutate the method
… …
626 $redirect = 1; 738 $redirect = 1;
627 } 739 }
628 } 740 }
629 741
630 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive]) 742 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive])
631 my $keepalive = pop; 743 my $may_keep_alive = $_[3];
632 744
633 $state{handle}->destroy if $state{handle}; 745 $state{handle}->destroy if $state{handle};
634 %state = (); 746 %state = ();
635 747
636 if (defined $_[1]) { 748 if (defined $_[1]) {
… …
638 $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2]; 750 $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2];
639 } 751 }
640 752
641 # set-cookie processing 753 # set-cookie processing
642 if ($arg{cookie_jar}) { 754 if ($arg{cookie_jar}) {
643 for ($hdr{"set-cookie"}) { 755 cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}, $uhost;
644 # parse NAME=VALUE
645 my @kv;
646
647 while (/\G\s* ([^=;,[:space:]]+) \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) )/gcxs) {
648 my $name = $1;
649 my $value = $3;
650
651 unless ($value) {
652 $value = $2;
653 $value =~ s/\\(.)/$1/gs;
654 }
655
656 push @kv, $name => $value;
657
658 last unless /\G\s*;/gc;
659 }
660
661 last unless @kv;
662
663 my $name = shift @kv;
664 my %kv = (value => shift @kv, @kv);
665
666 my $cdom;
667 my $cpath = (delete $kv{path}) || "/";
668
669 if (exists $kv{domain}) {
670 $cdom = delete $kv{domain};
671
672 $cdom =~ s/^\.?/./; # make sure it starts with a "."
673
674 next if $cdom =~ /\.$/;
675
676 # this is not rfc-like and not netscape-like. go figure.
677 my $ndots = $cdom =~ y/.//;
678 next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
679 } else {
680 $cdom = $uhost;
681 }
682
683 # store it
684 $arg{cookie_jar}{version} = 1;
685 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
686
687 redo if /\G\s*,/gc;
688 }
689 } 756 }
690 757
691 if ($redirect && exists $hdr{location}) { 758 if ($redirect && exists $hdr{location}) {
692 # we ignore any errors, as it is very common to receive 759 # we ignore any errors, as it is very common to receive
693 # Content-Length != 0 but no actual body 760 # Content-Length != 0 but no actual body
… …
700 $cb); 767 $cb);
701 } else { 768 } else {
702 $cb->($_[0], \%hdr); 769 $cb->($_[0], \%hdr);
703 } 770 }
704 }; 771 };
772
773 $ae_error = 597; # body phase
705 774
706 my $len = $hdr{"content-length"}; 775 my $len = $hdr{"content-length"};
707 776
708 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 777 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
709 $finish->(undef, 598 => "Request cancelled by on_header"); 778 $finish->(undef, 598 => "Request cancelled by on_header");
… …
731 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) { 800 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
732 my $cl = 0; 801 my $cl = 0;
733 my $body = undef; 802 my $body = undef;
734 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 803 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
735 804
736 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
737
738 my $read_chunk; $read_chunk = sub { 805 my $read_chunk; $read_chunk = sub {
739 $_[1] =~ /^([0-9a-fA-F]+)/ 806 $_[1] =~ /^([0-9a-fA-F]+)/
740 or $finish->(undef, 599 => "Garbled chunked transfer encoding"); 807 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
741 808
742 my $len = hex $1; 809 my $len = hex $1;
743 810
744 if ($len) { 811 if ($len) {
745 $cl += $len; 812 $cl += $len;
… …
748 $on_body->($_[1], \%hdr) 815 $on_body->($_[1], \%hdr)
749 or return $finish->(undef, 598 => "Request cancelled by on_body"); 816 or return $finish->(undef, 598 => "Request cancelled by on_body");
750 817
751 $_[0]->push_read (line => sub { 818 $_[0]->push_read (line => sub {
752 length $_[1] 819 length $_[1]
753 and return $finish->(undef, 599 => "Garbled chunked transfer encoding"); 820 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
754 $_[0]->push_read (line => $read_chunk); 821 $_[0]->push_read (line => $read_chunk);
755 }); 822 });
756 }); 823 });
757 } else { 824 } else {
758 $hdr{"content-length"} ||= $cl; 825 $hdr{"content-length"} ||= $cl;
… …
761 if (length $_[1]) { 828 if (length $_[1]) {
762 for ("$_[1]") { 829 for ("$_[1]") {
763 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 830 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
764 831
765 my $hdr = parse_hdr 832 my $hdr = parse_hdr
766 or return $finish->(undef, 599 => "Garbled response trailers"); 833 or return $finish->(undef, $ae_error => "Garbled response trailers");
767 834
768 %hdr = (%hdr, %$hdr); 835 %hdr = (%hdr, %$hdr);
769 } 836 }
770 } 837 }
771 838
… …
775 }; 842 };
776 843
777 $_[0]->push_read (line => $read_chunk); 844 $_[0]->push_read (line => $read_chunk);
778 845
779 } elsif ($arg{on_body}) { 846 } elsif ($arg{on_body}) {
780 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
781
782 if ($len) { 847 if ($len) {
783 $_[0]->on_read (sub { 848 $_[0]->on_read (sub {
784 $len -= length $_[0]{rbuf}; 849 $len -= length $_[0]{rbuf};
785 850
786 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 851 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
… …
800 } 865 }
801 } else { 866 } else {
802 $_[0]->on_eof (undef); 867 $_[0]->on_eof (undef);
803 868
804 if ($len) { 869 if ($len) {
805 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
806 $_[0]->on_read (sub { 870 $_[0]->on_read (sub {
807 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1) 871 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1)
808 if $len <= length $_[0]{rbuf}; 872 if $len <= length $_[0]{rbuf};
809 }); 873 });
810 } else { 874 } else {
811 $_[0]->on_error (sub { 875 $_[0]->on_error (sub {
812 ($! == Errno::EPIPE || !$!) 876 ($! == Errno::EPIPE || !$!)
813 ? $finish->(delete $_[0]{rbuf}) 877 ? $finish->(delete $_[0]{rbuf})
814 : $finish->(undef, 599 => $_[2]); 878 : $finish->(undef, $ae_error => $_[2]);
815 }); 879 });
816 $_[0]->on_read (sub { }); 880 $_[0]->on_read (sub { });
817 } 881 }
818 } 882 }
819 } 883 }
… …
899Takes a POSIX timestamp (seconds since the epoch) and formats it as a HTTP 963Takes a POSIX timestamp (seconds since the epoch) and formats it as a HTTP
900Date (RFC 2616). 964Date (RFC 2616).
901 965
902=item $timestamp = AnyEvent::HTTP::parse_date $date 966=item $timestamp = AnyEvent::HTTP::parse_date $date
903 967
904Takes a HTTP Date (RFC 2616) and returns the corresponding POSIX 968Takes a HTTP Date (RFC 2616) or a Cookie date (netscape cookie spec) and
905timestamp, or C<undef> if the date cannot be parsed. 969returns the corresponding POSIX timestamp, or C<undef> if the date cannot
970be parsed.
906 971
907=item $AnyEvent::HTTP::MAX_RECURSE 972=item $AnyEvent::HTTP::MAX_RECURSE
908 973
909The default value for the C<recurse> request parameter (default: C<10>). 974The default value for the C<recurse> request parameter (default: C<10>).
910 975
… …
949sub parse_date($) { 1014sub parse_date($) {
950 my ($date) = @_; 1015 my ($date) = @_;
951 1016
952 my ($d, $m, $y, $H, $M, $S); 1017 my ($d, $m, $y, $H, $M, $S);
953 1018
954 if ($date =~ /^[A-Z][a-z][a-z], ([0-9][0-9]) ([A-Z][a-z][a-z]) ([0-9][0-9][0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) { 1019 if ($date =~ /^[A-Z][a-z][a-z], ([0-9][0-9])[\- ]([A-Z][a-z][a-z])[\- ]([0-9][0-9][0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) {
955 # RFC 822/1123, required by RFC 2616 1020 # RFC 822/1123, required by RFC 2616 (with " ")
1021 # cookie dates (with "-")
1022
956 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3, $4, $5, $6); 1023 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3, $4, $5, $6);
957 1024
958 } elsif ($date =~ /^[A-Z][a-z]+, ([0-9][0-9])-([A-Z][a-z][a-z])-([0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) { 1025 } elsif ($date =~ /^[A-Z][a-z]+, ([0-9][0-9])-([A-Z][a-z][a-z])-([0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) {
959 # RFC 850 1026 # RFC 850
960 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3 < 69 ? $3 + 2000 : $3 + 1900, $4, $5, $6); 1027 ($d, $m, $y, $H, $M, $S) = ($1, $2, $3 < 69 ? $3 + 2000 : $3 + 1900, $4, $5, $6);

Diff Legend

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