[Bio] / FigKernelPackages / ACHserver.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/ACHserver.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8, Thu Nov 5 20:55:26 2009 UTC revision 1.11, Wed Nov 25 21:22:22 2009 UTC
# Line 81  Line 81 
81      if ($server_url ne 'localhost') {      if ($server_url ne 'localhost') {
82          require LWP::UserAgent;          require LWP::UserAgent;
83          $ua = LWP::UserAgent->new();          $ua = LWP::UserAgent->new();
84            $ua->timeout(20 * 60);
85      } else {      } else {
86          require "ACH.pm";          require "ACH.pm";
87          $ua = ACH->new();          $ua = ACH->new();
# Line 266  Line 267 
267      my $ua = $self->{ua};      my $ua = $self->{ua};
268      # Request the function from the server. Note that the hash is actually passed      # Request the function from the server. Note that the hash is actually passed
269      # as a list reference.      # as a list reference.
270      my $response = $ua->post($self->{server_url}, [ %parms ]);  
271      # Get the response content.      #
272        # retries is the set of retry wait times in seconds we should use. when
273        # we run out the call will fail.
274        #
275    
276        my @retries = (1, 2, 5, 10, 20, 60, 60, 60, 60, 60, 60);
277        my %codes_to_retry =  map { $_ => 1 } qw(110 408 502 503 504 200) ;
278        my $response;
279        while (1)
280        {
281            $response = $ua->post($self->{server_url}, [ %parms ]);
282            if ($response->is_success)
283            {
284      my $retVal = $response->content;      my $retVal = $response->content;
     # Fail if there was an error.  
     if (! $response->is_success) {  
         die ErrorMessage->new($retVal, $response->status_line);  
     }  
     # Return the result.  
285      return $retVal;      return $retVal;
286  }  }
287    
288            #
289            # If this is not one of the error codes we retry for, or if we
290            # are out of retries, fail immediately
291            #
292            my $code = $response->code;
293            if (!$codes_to_retry{$code} || @retries == 0)
294            {
295                if ($ENV{SAS_DEBUG}) {
296                    confess $response->content;
297                } else {
298                    confess $response->status_line;
299                }
300            }
301    
302            #
303            # otherwise, sleep & loop.
304            #
305            my $retry_time = shift(@retries);
306            print STDERR "Request failed with code=$code, sleeping $retry_time and retrying\n";
307            sleep($retry_time);
308    
309        }
310    
311        #
312        # Should never get here.
313        #
314    }
315    
316    
317  1;  1;

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.11

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3