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

Diff of /FigKernelPackages/SAPserver.pm

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

revision 1.8, Tue Sep 8 21:31:32 2009 UTC revision 1.9, Tue Nov 3 21:20:07 2009 UTC
# Line 1  Line 1 
 #!/usr/bin/perl -w  
1  #  #
2  #       This is a SAS Component.  #       This is a SAS Component.
3  #  #
# Line 21  Line 20 
20  package SAPserver;  package SAPserver;
21    
22      use strict;      use strict;
23      use YAML;      use base qw(ClientThing);
24    
25  =head1 Sapling Server Helper Object  =head1 Sapling Server Helper Object
26    
# Line 29  Line 28 
28    
29  This module is used to call the sapling server, which is a general-purpose  This module is used to call the sapling server, which is a general-purpose
30  server for extracting data from the Sapling database. Each Sapling server  server for extracting data from the Sapling database. Each Sapling server
31  function correspond to a method of this object.  function corresponds to a method of this object. In other words, all
32    L<SAP/Primary Methods> are also methods here.
 This package deliberately uses no internal SEED packages or scripts, only common  
 PERL modules.  
   
 The fields in this object are as follows.  
   
 =over 4  
   
 =item server_url  
   
 The URL used to request data from the sapling server. If C<localhost> is  
 specified, then the L<SAP> module will be called directly.  
   
 =item ua  
   
 The user agent for communication with the server.  
   
 =item singleton  
   
 Indicates whether or not results are to be returned in singleton mode. In  
 singleton mode, if the return document is a hash reference with only one  
 entry, the entry value is returned rather than the hash.  
   
 =back  
33    
34  =cut  =cut
35    
# Line 83  Line 59 
59  sub new {  sub new {
60      # Get the parameters.      # Get the parameters.
61      my ($class, %options) = @_;      my ($class, %options) = @_;
62      # Get the options.      # Compute the URL.
63      my $url = $options{url} || "http://servers.nmpdr.org/sapling/server.cgi";      $options{url} = 'http://servers.nmpdr.org/sapling/server.cgi' if ! defined $options{url};
64      my $singleton = $options{singleton} || 0;      # Construct the subclass.
65      # Create the fields of the object. Note that if we're in localhost mode,      return $class->SUPER::new(SAP => %options);
     # the user agent is actually a SAP object.  
     my $server_url = $url;  
     my $ua;  
     if ($server_url ne 'localhost') {  
         require LWP::UserAgent;  
         $ua = LWP::UserAgent->new();  
     } else {  
         require SAP;  
         $ua = SAP->new();  
66      }      }
     # Create the SAPserver object.  
     my $retVal = {  
                     server_url => $server_url,  
                     ua => $ua,  
                     singleton => $singleton,  
                  };  
     # Bless and return it.  
     bless $retVal, $class;  
     return $retVal;  
 }  
   
 =head2 Public Methods  
   
 All L<SAP/Primary Methods> are also methods of this object.  
   
 =head3 AUTOLOAD  
   
     my $result = $ss->method(%args);  
   
 Call a function on the server. Any method call on this object (other than  
 the constructor) is translated into a request against the server. This  
 enables us to add new server functions without requiring an update to this  
 module. The parameters are specified as a hash, and the result is a scalar  
 or object reference. If an error occurred, we will throw an exception.  
   
 =cut  
   
 # This variable will contain the method name.  
 our $AUTOLOAD;  
   
 sub AUTOLOAD {  
     # Get the parameters. We do some fancy dancing to allow the user to pass  
     # in a hash or a hash reference.  
     my $self = shift @_;  
     my $args = $_[0];  
     if (defined $args && ref $args ne 'HASH') {  
         my %args = @_;  
         $args = \%args;  
     }  
     # Declare the return variable.  
     my $retVal;  
     # Get the method name.  
     my $function = $AUTOLOAD;  
     # Strip off the stuff before the method name.  
     $function =~ s/.+:://;  
     # Get our user agent.  
     my $ua = $self->{ua};  
     # Determine the type.  
     if (ref $ua eq 'LWP::UserAgent') {  
         # Here we're going to a server. Compute the argument document.  
         my $argString = YAML::Dump($args);  
         # Request the function from the server.  
         my $response = $ua->post($self->{server_url},  
                                  [function => $function, args => $argString,  
                                   source => __PACKAGE__ ]);  
         # Get the response content.  
         my $content = $response->content;  
         if (! $response->is_success) {  
             die "Server error " . $response->status_line . "\n$content";  
         } else {  
             $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};  
                 }  
             }  
         }  
     } else {  
         # Here we're calling a local method.  
         $retVal = eval("\$ua->$function(\$args)");  
         # Check for an error.  
         if ($@) {  
             die "Package error: $@";  
         }  
     }  
     # We have our result. Adjust for singleton mode.  
     if ($self->{singleton} && ref $retVal eq 'HASH' && scalar(keys %$retVal) <= 1) {  
         # Here we're in singleton mode and we got a single result,  
         # so we dereference a bit to make it easier for the user  
         # to access it.  
         ($retVal) = values %$retVal;  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 DESTROY  
   
     $ss->DESTROY();  
   
 This method has no function. It's purpose is to keep the destructor from  
 being caught by the autoload processing.  
   
 =cut  
   
 sub DESTROY { }  
67    
68    
69  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3