[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.1, Tue Jun 16 16:37:23 2009 UTC revision 1.6, Tue Aug 4 18:41:56 2009 UTC
# Line 17  Line 17 
17  # http://www.theseed.org/LICENSE.TXT.  # http://www.theseed.org/LICENSE.TXT.
18  #  #
19    
20    #
21    #       This is a SAS Component.
22    #
23    
24  package SAPserver;  package SAPserver;
25    
26      use strict;      use strict;
     use Tracer;  
27      use LWP::UserAgent;      use LWP::UserAgent;
28      use YAML;      use YAML;
29    
30  =head1 Sapling Server Helper Object  =head1 Sapling Server Helper Object
31    
32  =head2 Introduction  =head2 Description
33    
34  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
35  server for extracting data from the Sapling database. Each Sapling server  server for extracting data from the Sapling database. Each Sapling server
36  function correspond to a method of this object.  function correspond to a method of this object.
37    
38    This package deliberately uses no internal SEED packages or scripts, only common
39    PERL modules.
40    
41  The fields in this object are as follows.  The fields in this object are as follows.
42    
43  =over 4  =over 4
# Line 44  Line 50 
50    
51  The user agent for communication with the server.  The user agent for communication with the server.
52    
53    =item singleton
54    
55    Indicates whether or not results are to be returned in singleton mode. In
56    singleton mode, if the return document is a hash reference with only one
57    entry, the entry value is returned rather than the hash.
58    
59  =back  =back
60    
61  =cut  =cut
# Line 61  Line 73 
73  URL for the sapling server. This option may be used to redirect requests to a  URL for the sapling server. This option may be used to redirect requests to a
74  test version of the server, or to an older server script.  test version of the server, or to an older server script.
75    
76    =item singleton
77    
78    If TRUE, results from methods will be returned in singleton mode. In singleton
79    mode, if a single result comes back, it will come back as a scalar rather than
80    as a hash value accessible via an incoming ID.
81    
82  =back  =back
83    
84  =cut  =cut
# Line 69  Line 87 
87      # Get the parameters.      # Get the parameters.
88      my ($class, %options) = @_;      my ($class, %options) = @_;
89      # Get the options.      # Get the options.
90      my $url = $options{url} || "http://servers.nmpdr.org/sap/server.cgi";      my $url = $options{url} || "http://servers.nmpdr.org/sapling/server.cgi";
91        my $singleton = $options{singleton} || 0;
92      # Create the fields of the object.      # Create the fields of the object.
93      my $server_url = $url;      my $server_url = $url;
94      my $ua = LWP::UserAgent->new();      my $ua = LWP::UserAgent->new();
# Line 77  Line 96 
96      my $retVal = {      my $retVal = {
97                      server_url => $server_url,                      server_url => $server_url,
98                      ua => $ua,                      ua => $ua,
99                        singleton => $singleton,
100                   };                   };
101      # Bless and return it.      # Bless and return it.
102      bless $retVal, $class;      bless $retVal, $class;
# Line 85  Line 105 
105    
106  =head2 Public Methods  =head2 Public Methods
107    
108    All L<SAP/Primary Methods> are also methods of this object.
109    
110  =head3 AUTOLOAD  =head3 AUTOLOAD
111    
112      my $result = $ss->method(%args);      my $result = $ss->method(%args);
# Line 93  Line 115 
115  the constructor) is translated into a request against the server. This  the constructor) is translated into a request against the server. This
116  enables us to add new server functions without requiring an update to this  enables us to add new server functions without requiring an update to this
117  module. The parameters are specified as a hash, and the result is a scalar  module. The parameters are specified as a hash, and the result is a scalar
118  or object reference. If an error occurred, we will confess.  or object reference. If an error occurred, we will throw an exception.
119    
120  =cut  =cut
121    
# Line 101  Line 123 
123  our $AUTOLOAD;  our $AUTOLOAD;
124    
125  sub AUTOLOAD {  sub AUTOLOAD {
126      # Get the parameters.      # Get the parameters. We do some fancy dancing to allow the user to pass
127      my ($self, %args) = @_;      # in a hash or a hash reference.
128        my $self = shift @_;
129        my $args = $_[0];
130        if (defined $args && ref $args ne 'HASH') {
131            my %args = @_;
132            $args = \%args;
133        }
134      # Declare the return variable.      # Declare the return variable.
135      my $retVal;      my $retVal;
136      # Get the method name.      # Get the method name.
137      my $function = $AUTOLOAD;      my $function = $AUTOLOAD;
138        # Strip off the stuff before the method name.
139      $function =~ s/.+:://;      $function =~ s/.+:://;
140      # Compute the argument document.      # Compute the argument document.
141      my $argString = YAML::Dump(\%args);      my $argString = YAML::Dump($args);
142      # Get our user agent.      # Get our user agent.
143      my $ua = $self->{ua};      my $ua = $self->{ua};
144      # Request the function from the server.      # Request the function from the server.
145      my $response = $ua->post($self->{server_url},      my $response = $ua->post($self->{server_url},
146                               [function => $function, args => $argString]);                               [function => $function, args => $argString,
147                                  source => __PACKAGE__ ]);
148      # Get the response content.      # Get the response content.
149      my $content = $response->content;      my $content = $response->content;
150      if (! $response->is_success) {      if (! $response->is_success) {
151          Confess("Server error " . $response->status_line . "\n$content");          die "Server error " . $response->status_line . "\n$content";
152      } else {      } else {
         Trace("YAML document is\n$content.") if T(3);  
153          $retVal = YAML::Load($content);          $retVal = YAML::Load($content);
154          # Figure out what we got back.          # Figure out what we got back.
         Trace("Checking for an error document.") if T(3);  
155          my $returnType = ref $retVal;          my $returnType = ref $retVal;
156          if ($returnType && $returnType eq 'ErrorDocument') {          if ($returnType) {
157              Confess($retVal->{message});              if ($returnType eq 'ErrorDocument') {
158                    # Here an error occurred, so we throw an exception using the
159                    # error message.
160                    die $retVal->{message};
161                } elsif ($self->{singleton} && $returnType eq 'HASH' &&
162                         scalar(keys %$retVal) <= 1) {
163                    # Here we're in singleton mode and we got a single result,
164                    # so we dereference a bit to make it easier for the user
165                    # to access it.
166                    ($retVal) = values %$retVal;
167                }
168          }          }
169      }      }
170      # Return the result.      # Return the result.

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3