Changeset df1fbccc60b85dbc061660725dd65744cd97ee5d in xas


Ignore:
Timestamp:
10/28/14 16:26:52 (5 years ago)
Author:
Kevin L. Esteb <kevin@…>
Branches:
master
Children:
f0e0bf3ddd65ef79563e54f065ca6626deeeea1f
Parents:
8213d475cf38cd0be39f65822ab8b85033d43762
git-author:
Kevin L. Esteb <kevin@…> (10/28/14 16:26:52)
git-committer:
Kevin L. Esteb <kevin@…> (10/28/14 16:26:52)
Message:

Fixed a problem when reading the repsonse.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/lib/XAS/Lib/WS/Base.pm

    r8213d475cf38cd0be39f65822ab8b85033d43762 rdf1fbccc60b85dbc061660725dd65744cd97ee5d  
    5050    ); 
    5151 
    52     my $header_ref; 
    53     my $content_ref; 
     52    my @data; 
    5453    my $response = undef; 
    5554    my $header   = $request->headers->as_string("\n"); 
     
    6362    # I/O for the request 
    6463 
    65     $self->curl->setopt(CURLOPT_WRITEDATA,     \$content_ref); 
    66     $self->curl->setopt(CURLOPT_HEADERDATA,    \$header_ref); 
     64    $self->curl->setopt(CURLOPT_WRITEDATA,     \@data); 
    6765    $self->curl->setopt(CURLOPT_READFUNCTION,  \&_read_callback); 
    68     $self->curl->setopt(CURLOPT_WRITEFUNCTION, \&_chunk_callback); 
     66    $self->curl->setopt(CURLOPT_WRITEFUNCTION, \&_write_callback); 
    6967 
    7068    # other options depending on request type 
     
    106104    # perform the request and create the response 
    107105 
    108    if (($self->{retcode} = $self->curl->perform) == 0) { 
    109  
     106    if (($self->{retcode} = $self->curl->perform) == 0) { 
     107 
     108        my @temp; 
    110109        my $message; 
    111         my @headers = split("\r\n\r\n", $header_ref); 
    112  
    113         $response = HTTP::Response->parse($headers[-1]); 
    114         $response->content($content_ref); 
     110        my $content; 
     111 
     112        # there may have been multiple responses collected, we only 
     113        # want the last one. so search backwards until a HTTP header 
     114        # is found. 
     115 
     116        while (my $line = pop(@data)) { 
     117 
     118            push(@temp, $line); 
     119            last if ($line =~ /(^HTTP\/|^HTTPS\/)/); 
     120 
     121        } 
     122 
     123        $content = join('', reverse(@temp)); 
     124 
     125        # now let HTTP::Response figure it all out... 
     126 
     127        $response = HTTP::Response->parse($content); 
     128 
     129        # do some fixups 
    115130 
    116131        $message = $response->message; 
    117132        $response->message($message) if ($message =~ s/\r//g); 
     133        $response->request($request); 
    118134 
    119135    } else { 
     
    136152 
    137153sub _read_callback { 
    138     my ( $maxlength, $pointer ) = @_; 
    139  
    140     my $data = substr( $$pointer, 0, $maxlength ); 
     154    my ($maxlength, $pointer) = @_; 
     155 
     156    my $data = substr($$pointer, 0, $maxlength); 
    141157 
    142158    $$pointer = 
    143159      length($$pointer) > $maxlength 
    144       ? scalar substr( $$pointer, $maxlength ) 
     160      ? scalar substr($$pointer, $maxlength) 
    145161      : ''; 
    146162 
     
    149165} 
    150166 
    151 sub _chunk_callback { 
    152     my ( $data, $pointer ) = @_; 
    153  
    154     ${$pointer} .= $data; 
     167sub _write_callback { 
     168    my ($data, $pointer) = @_; 
     169 
     170    push(@{$pointer}, $data); 
    155171 
    156172    return length($data); 
Note: See TracChangeset for help on using the changeset viewer.