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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3