← Back to branch summary

~ubuntu-branches/ubuntu/maverick/libwww-perl/maverick

« back to all changes in this revision

Viewing changes to lib/LWP/UserAgent.pm

  • Committer: Bazaar Package Importer
  • Author(s): Nathan Handler
  • Date: 2009-07-09 17:44:48 UTC
  • mto: (12.1.1 sid) (1.4.1 upstream)
  • mto: This revision was merged to the branch mainline in revision 12.
  • Revision ID: james.westby@ubuntu.com-20090709174448-wtch3wg4qn4mw64u
Tags: upstream-5.829
Import upstream version 5.829

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/LWP/UserAgent.pm
5
5
 
6
6
require LWP::MemberMixin;
7
7
@ISA = qw(LWP::MemberMixin);
8
 
$VERSION = "5.827";
 
8
$VERSION = "5.829";
9
9
 
10
10
use HTTP::Request ();
11
11
use HTTP::Response ();
595
595
                       return unless $parser;
596
596
                       unless ($parser->parse($_[3])) {
597
597
                           my $h = $parser->header;
 
598
                           my $r = $_[0];
598
599
                           for my $f ($h->header_field_names) {
599
 
                               $response->init_header($f, [$h->header($f)]);
 
600
                               $r->init_header($f, [$h->header($f)]);
600
601
                           }
601
602
                           undef($parser);
602
603
                       }
823
824
 
824
825
    my $request = HTTP::Request->new('GET', $url);
825
826
 
826
 
    if (-e $file) {
827
 
        my($mtime) = (stat($file))[9];
828
 
        if($mtime) {
829
 
            $request->header('If-Modified-Since' =>
830
 
                             HTTP::Date::time2str($mtime));
831
 
        }
 
827
    # If the file exists, add a cache-related header
 
828
    if ( -e $file ) {
 
829
        my ($mtime) = ( stat($file) )[9];
 
830
        if ($mtime) {
 
831
            $request->header( 'If-Modified-Since' => HTTP::Date::time2str($mtime) );
 
832
        }
832
833
    }
833
834
    my $tmpfile = "$file-$$";
834
835
 
835
836
    my $response = $self->request($request, $tmpfile);
836
 
    if ($response->is_success) {
837
 
 
838
 
        my $file_length = (stat($tmpfile))[7];
839
 
        my($content_length) = $response->header('Content-length');
840
 
 
841
 
        if (defined $content_length and $file_length < $content_length) {
842
 
            unlink($tmpfile);
843
 
            die "Transfer truncated: " .
844
 
                "only $file_length out of $content_length bytes received\n";
845
 
        }
846
 
        elsif (defined $content_length and $file_length > $content_length) {
847
 
            unlink($tmpfile);
848
 
            die "Content-length mismatch: " .
849
 
                "expected $content_length bytes, got $file_length\n";
850
 
        }
851
 
        else {
852
 
            # OK
853
 
            if (-e $file) {
854
 
                # Some dosish systems fail to rename if the target exists
855
 
                chmod 0777, $file;
856
 
                unlink $file;
857
 
            }
858
 
            rename($tmpfile, $file) or
859
 
                die "Cannot rename '$tmpfile' to '$file': $!\n";
860
 
 
861
 
            if (my $lm = $response->last_modified) {
862
 
                # make sure the file has the same last modification time
863
 
                utime $lm, $lm, $file;
864
 
            }
865
 
        }
 
837
 
 
838
    # Only fetching a fresh copy of the would be considered success.
 
839
    # If the file was not modified, "304" would returned, which 
 
840
    # is considered by HTTP::Status to be a "redirect", /not/ "success"
 
841
    if ( $response->is_success ) {
 
842
        my $file_length = ( stat($tmpfile) )[7];
 
843
        my ($content_length) = $response->header('Content-length');
 
844
 
 
845
        if ( defined $content_length and $file_length < $content_length ) {
 
846
            unlink($tmpfile);
 
847
            die "Transfer truncated: " . "only $file_length out of $content_length bytes received\n";
 
848
        }
 
849
        elsif ( defined $content_length and $file_length > $content_length ) {
 
850
            unlink($tmpfile);
 
851
            die "Content-length mismatch: " . "expected $content_length bytes, got $file_length\n";
 
852
        }
 
853
        # The file was the expected length. 
 
854
        else {
 
855
            # Replace the stale file with a fresh copy
 
856
            if ( -e $file ) {
 
857
                # Some dosish systems fail to rename if the target exists
 
858
                chmod 0777, $file;
 
859
                unlink $file;
 
860
            }
 
861
            rename( $tmpfile, $file )
 
862
                or die "Cannot rename '$tmpfile' to '$file': $!\n";
 
863
 
 
864
            # make sure the file has the same last modification time
 
865
            if ( my $lm = $response->last_modified ) {
 
866
                utime $lm, $lm, $file;
 
867
            }
 
868
        }
866
869
    }
 
870
    # The local copy is fresh enough, so just delete the temp file  
867
871
    else {
868
872
        unlink($tmpfile);
869
873
    }