Changeset 53 for trunk/perl

Show
Ignore:
Timestamp:
09/02/09 00:50:37 (5 years ago)
Author:
jesus
Message:

fix the perl IO issues

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • trunk/perl/lib/Cornea.pm

    r52 r53  
    5050    } 
    5151    else { 
    52       print STDERR "Failed put to " . $n->fqdn . "\n" if $main::DEBUG; 
     52      print STDERR "Failed put to " . $n->fqdn . "\n$data\n" if $main::DEBUG; 
    5353      $N->remove($n); 
    5454    } 
  • trunk/perl/lib/Cornea/ApacheStore.pm

    r52 r53  
    110110    $self->mkpath($path); 
    111111    my $file = IO::File->new(">$path") || die "cannot open $path"; 
    112     my $buffer
    113     while($r->read($buffer, (1024*128)) > 0) { 
    114       if($file->write($buffer) != length($buffer)) { 
    115         die "short write on $path" 
     112    my ($rlen, $wlen, $buffer)
     113    while(($rlen = $r->read($buffer, (1024*128))) > 0) { 
     114      if(($wlen = $file->syswrite($buffer, $rlen)) != $rlen) { 
     115        die "short write ($wlen != $rlen) on $path\n"; 
    116116      } 
    117117    } 
     
    120120  }; 
    121121  if($@) { 
     122    my $error = $@; 
     123    print STDERR "$@"; 
    122124    unlink($path) if $path; 
    123     print STDERR $@; 
    124     return $self->xml($r, 500, "<error>$@</error>"); 
     125    return $self->xml($r, 500, "<error>$error</error>"); 
    125126  } 
    126127  return $self->xml($r, 200, "<success />"); 
  • trunk/perl/lib/Cornea/StorageNode.pm

    r52 r53  
    102102    $curl->setopt(CURLOPT_WRITEHEADER, undef); 
    103103    my $retcode = $curl->perform(); 
    104     return 1 if($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 200); 
    105     return (0, $response_data); 
     104    my $code = $curl->getinfo(CURLINFO_HTTP_CODE); 
     105    return 1 if($retcode == 0 && $code == 200); 
     106    return (0, "$code: $response_data"); 
    106107  } 
    107108  else { 
     
    109110    my $url = $self->api_url('store', @_); 
    110111    my $curl = new WWW::Curl::Easy; 
    111     $source->sysseek(0,2)
     112    $source->seek(0,2) || die "seek failed\n"
    112113    my $len = $source->tell(); 
    113     $source->sysseek(0,0)
     114    $source->seek(0,0) || die "seek failed\n"
    114115    $curl->setopt(CURLOPT_URL, $url); 
    115116    $curl->setopt(CURLOPT_READFUNCTION, 
    116                   sub { my $buf; $source->sysread($buf, $_[0]); return $buf } ); 
     117                  sub { my $buf; $source->read($buf, $_[0]); return $buf; } ); 
    117118    $curl->setopt(CURLOPT_INFILESIZE, $len); 
    118119    $curl->setopt(CURLOPT_UPLOAD, 1); 
     
    120121    $curl->setopt(CURLOPT_FILE, \$response_data); 
    121122    $curl->setopt(CURLOPT_WRITEFUNCTION, \&_curl_help_write); 
    122     $curl->setopt(CURLOPT_FAILONERROR, 1); 
    123123   
    124124    my $retcode = $curl->perform(); 
    125     return 1 if($retcode == 0 && $curl->getinfo(CURLINFO_HTTP_CODE) == 200); 
    126     return (0, $response_data); 
     125    my $code = $curl->getinfo(CURLINFO_HTTP_CODE); 
     126    return 1 if($retcode == 0 && $code == 200); 
     127    return (0, "$code: $response_data"); 
    127128  } 
    128129} 
     
    135136  $curl->setopt(CURLOPT_URL, $url); 
    136137  $curl->setopt(CURLOPT_CUSTOMREQUEST, "DELETE"); 
    137   $curl->setopt(CURLOPT_FAILONERROR, 1); 
    138138 
    139139  my $retcode = $curl->perform();