[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.7, Tue Nov 3 21:20:07 2009 UTC revision 1.12, Wed Nov 25 21:58:39 2009 UTC
# Line 7  Line 7 
7      use strict;      use strict;
8      use LWP::UserAgent;      use LWP::UserAgent;
9      use YAML;      use YAML;
10        use Carp;
11      use ErrorMessage;      use ErrorMessage;
12      no warnings qw(once);      no warnings qw(once);
13    
# Line 72  Line 73 
73      # Turn off YAML compression, which causes problems with our hash keys.      # Turn off YAML compression, which causes problems with our hash keys.
74      $YAML::CompressSeries = 0;      $YAML::CompressSeries = 0;
75      # Get the options.      # Get the options.
76      my $url = $options{url};      my $url = $options{url} || "http://servers.nmpdr.org/ach/server.cgi";
77      my $singleton = $options{singleton} || 0;      my $singleton = $options{singleton} || 0;
78      # Create the fields of the object. Note that if we're in localhost mode,      # Create the fields of the object. Note that if we're in localhost mode,
79      # the user agent is actually a SAP object.      # the user agent is actually a SAP object.
# Line 81  Line 82 
82      if ($server_url ne 'localhost') {      if ($server_url ne 'localhost') {
83          require LWP::UserAgent;          require LWP::UserAgent;
84          $ua = LWP::UserAgent->new();          $ua = LWP::UserAgent->new();
85            $ua->timeout(20 * 60);
86      } else {      } else {
87          require "ACH.pm";          require "ACH.pm";
88          $ua = ACH->new();          $ua = ACH->new();
# Line 266  Line 268 
268      my $ua = $self->{ua};      my $ua = $self->{ua};
269      # 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
270      # as a list reference.      # as a list reference.
271      my $response = $ua->post($self->{server_url}, [ %parms ]);  
272      # Get the response content.      #
273        # retries is the set of retry wait times in seconds we should use. when
274        # we run out the call will fail.
275        #
276    
277        my @retries = (1, 2, 5, 10, 20, 60, 60, 60, 60, 60, 60);
278        my %codes_to_retry =  map { $_ => 1 } qw(110 408 502 503 504 200) ;
279        my $response;
280        while (1)
281        {
282            $response = $ua->post($self->{server_url}, [ %parms ]);
283            if ($response->is_success)
284            {
285      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.  
286      return $retVal;      return $retVal;
287  }  }
288    
289            #
290            # If this is not one of the error codes we retry for, or if we
291            # are out of retries, fail immediately
292            #
293            my $code = $response->code;
294            if (!$codes_to_retry{$code} || @retries == 0)
295            {
296                if ($ENV{SAS_DEBUG}) {
297                    confess $response->content;
298                } else {
299                    confess $response->status_line;
300                }
301            }
302    
303            #
304            # otherwise, sleep & loop.
305            #
306            my $retry_time = shift(@retries);
307            print STDERR "Request failed with code=$code, sleeping $retry_time and retrying\n";
308            sleep($retry_time);
309    
310        }
311    
312        #
313        # Should never get here.
314        #
315    }
316    
317    
318  1;  1;

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.12

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3