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

Diff of /FigKernelPackages/ClientThing.pm

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

revision 1.1, Thu Oct 29 18:26:59 2009 UTC revision 1.2, Tue Nov 3 21:20:07 2009 UTC
# Line 25  Line 25 
25    
26      use strict;      use strict;
27      use YAML;      use YAML;
28        use ErrorMessage;
29      no warnings qw(once);      no warnings qw(once);
30    
31  =head1 Base Class for Server Helper Objects  =head1 Base Class for Server Helper Objects
# Line 56  Line 57 
57  singleton mode, if the return document is a hash reference with only one  singleton mode, if the return document is a hash reference with only one
58  entry, the entry value is returned rather than the hash.  entry, the entry value is returned rather than the hash.
59    
60    =item methodHash
61    
62    Reference to a hash keyed by the names of the server's permissible methods.
63    
64  =back  =back
65    
66  =head2 Creating a Server Client Package  =head2 Creating a Server Client Package
# Line 70  Line 75 
75      sub new {      sub new {
76          my ($class, %options) = @_;          my ($class, %options) = @_;
77          $options{url} = 'http://servers.nmpdr.org/sapling/server.cgi' if ! defined $options{url};          $options{url} = 'http://servers.nmpdr.org/sapling/server.cgi' if ! defined $options{url};
78          return ClientThing::new($class, 'SAP', $options);          return $class->SUPER::new('SAP', %options);
79      }      }
80    
81      1;      1;
# Line 88  Line 93 
93  this capability will need to be specified explicitly in the subclass rather than  this capability will need to be specified explicitly in the subclass rather than
94  relying on the AUTOLOAD.  relying on the AUTOLOAD.
95    
96    NOTE: This facility was intended to provide flow control for calls to the
97    B<query> method in the Sapling Server, but it has never actually been
98    implemented.
99    
100  =cut  =cut
101    
102  # Number of bytes to transfer in a data chunk.  # Number of bytes to transfer in a data chunk.
# Line 147  Line 156 
156                      ua => $ua,                      ua => $ua,
157                      singleton => $singleton,                      singleton => $singleton,
158                   };                   };
159      # Bless and return it.      # Bless it.
160      bless $retVal, $class;      bless $retVal, $class;
161        # Get the list of permitted methods from the server.
162        my $methodList = $retVal->_call_method(methods => []);
163        # Convert it to a hash and store it in this object.
164        $retVal->{methodHash} = { map { $_ => 1 } @$methodList };
165        # Return the object.
166      return $retVal;      return $retVal;
167  }  }
168    
# Line 202  Line 216 
216      my $function = $AUTOLOAD;      my $function = $AUTOLOAD;
217      # Strip off the stuff before the method name.      # Strip off the stuff before the method name.
218      $function =~ s/.+:://;      $function =~ s/.+:://;
219        # Validate the method name.
220        if (! $self->{methodHash}{$function}) {
221            die "Method \"$function\" not supported.";
222        } else {
223      # Call the method.      # Call the method.
224      $retVal = $self->_call_method($function, $args);      $retVal = $self->_call_method($function, $args);
225      # We have our result. Adjust for singleton mode.      # We have our result. Adjust for singleton mode.
# Line 211  Line 229 
229          # to access it.          # to access it.
230          ($retVal) = values %$retVal;          ($retVal) = values %$retVal;
231      }      }
232        }
233      # Return the result.      # Return the result.
234      return $retVal;      return $retVal;
235  }  }
# Line 271  Line 290 
290          my $content = $self->_send_request(function => $method, args => $argString,          my $content = $self->_send_request(function => $method, args => $argString,
291                                             source => __PACKAGE__);                                             source => __PACKAGE__);
292          $retVal = YAML::Load($content);          $retVal = YAML::Load($content);
         # Figure out what we got back.  
         my $returnType = ref $retVal;  
         if ($returnType) {  
             if ($returnType eq 'ErrorDocument') {  
                 # Here an error occurred, so we throw an exception using the  
                 # error message.  
                 die $retVal->{message};  
             }  
         }  
293      } else {      } else {
294          # Here we're calling a local method.          # Here we're calling a local method.
295          $retVal = eval("\$ua->$method(\$args)");          $retVal = eval("\$ua->$method(\$args)");
# Line 465  Line 475 
475      my $retVal = $response->content;      my $retVal = $response->content;
476      # Fail if there was an error.      # Fail if there was an error.
477      if (! $response->is_success) {      if (! $response->is_success) {
478          die "Server error " . $response->status_line . "\n$retVal";          die ErrorMessage->new($retVal, $response->status_line);
479      }      }
480      # Return the result.      # Return the result.
481      return $retVal;      return $retVal;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3