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

Diff of /FigKernelPackages/SSserver.pm

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

revision 1.9, Mon Aug 3 21:31:42 2009 UTC revision 1.10, Thu Aug 27 19:46:36 2009 UTC
# Line 1  Line 1 
   
1  package SSserver;  package SSserver;
2    
3  #  #
# Line 6  Line 5 
5  #  #
6    
7  use LWP::UserAgent;  use LWP::UserAgent;
 use Data::Dumper;  
8  use YAML;  use YAML;
9    
10  use strict;  use strict;
11    
12  sub new  =head1 Subsystem Server Helper Object
 {  
     my($class, $server_url) = @_;  
13    
14      $server_url = "http://servers.nmpdr.org/subsystem/server.cgi" unless $server_url;  =head2 Description
 #    $server_url = "http://bio-macpro-2.mcs.anl.gov/~disz/FIG/subsystem_server_sapling.cgi" unless $server_url;  
 #    $server_url = "http://bio-big.mcs.anl.gov/server/FIG/subsystem_server_sapling.cgi" unless $server_url;  
15    
16      #$server_url = "http://bio-macpro-1.mcs.anl.gov/ross-proj/FIG/co_occurs_server.cgi" unless $server_url;  This module is used to call the Subsystem Server, which is a special-purpose
17    server for manipulating subsystem data from the Sapling database. Each Subsystem
18    Server function corresponds to a method of this object.
19    
20      my $self = {  This package deliberately uses no internal SEED packages or scripts, only common
21          server_url => $server_url,  PERL modules.
         ua => LWP::UserAgent->new(),  
     };  
     $self->{ua}->timeout(30*60);  
     return bless $self, $class;  
 }  
22    
23  sub pegs_implementing_roles {  The fields in this object are as follows.
         my ($self, @args) = @_;  
         return $self->run_query("pegs_implementing_roles", @args);  
 }  
24    
25  sub is_in_subsystem {  =over 4
         my ($self, @args) = @_;  
         return $self->run_query("is_in_subsystem", @args);  
 }  
 sub is_in_subsystem_with {  
         my ($self, @args) = @_;  
         return $self->run_query("is_in_subsystem_with", @args);  
 }  
26    
27  sub all_subsystems {  =item server_url
         my ($self, @args) = @_;  
         return $self->run_query("all_subsystems", @args);  
 }  
28    
29  sub subsystem_spreadsheet {  The URL used to request data from the subsystem server.
         my ($self, @args) = @_;  
         return $self->run_query("subsystem_spreadsheet", @args);  
 }  
30    
31    =item ua
32    
33  sub metabolic_reconstruction {  The user agent for communication with the server.
         my ($self, @args) = @_;  
         return $self->run_query("metabolic_reconstruction", @args);  
 }  
34    
35  sub run_query  =item singleton
 {  
     my($self, $function, @args ) = @_;  
36    
37              my $arg_string = Dump(@args);  Indicates whether or not results are to be returned in singleton mode. In
38              my $form = [function => $function,  singleton mode, if the return document is a hash reference with only one
39                          args => "$arg_string"];  entry, the entry value is returned rather than the hash.
40    
41              my $res = $self->{ua}->post($self->{server_url}, $form);  =back
42              if ($res->is_success)  
43              {  =cut
44                  return Load($res->content);  
45              }  =head3 new
46              else  
47              {      my $ss = SSserver->new(%options);
48                  die "error on post " . $res->content;  
49              }  Construct a new SSserver object. The following options are supported.
50  }  
51    =over 4
52    
53    =item url
54    
55    URL for the subsystem server. This option may be used to redirect requests to a
56    test version of the server, or to an older server script.
57    
58    =item singleton
59    
60    If TRUE, results from methods will be returned in singleton mode. In singleton
61    mode, if a single result comes back, it will come back as a scalar rather than
62    as a hash value accessible via an incoming ID.
63    
64    =back
65    
66    =cut
67    
68    sub new {
69        # Get the parameters.
70        my ($class, %options) = @_;
71        # Get the options.
72        my $url = $options{url} || "http://servers.nmpdr.org/subsystem/server.cgi";
73        my $singleton = $options{singleton} || 0;
74        # Create the fields of the object.
75        my $server_url = $url;
76        my $ua = LWP::UserAgent->new();
77        # Create the SAPserver object.
78        my $retVal = {
79                        server_url => $server_url,
80                        ua => $ua,
81                        singleton => $singleton,
82                     };
83        # Bless and return it.
84        bless $retVal, $class;
85        return $retVal;
86    }
87    
88    =head2 Public Methods
89    
90    All L<SS/Primary Methods> are also methods of this object.
91    
92    =head3 AUTOLOAD
93    
94        my $result = $ss->method(%args);
95    
96    Call a function on the server. Any method call on this object (other than
97    the constructor) is translated into a request against the server. This
98    enables us to add new server functions without requiring an update to this
99    module. The parameters are specified as a hash, and the result is a scalar
100    or object reference. If an error occurred, we will throw an exception.
101    
102    =cut
103    
104    # This variable will contain the method name.
105    our $AUTOLOAD;
106    
107    sub AUTOLOAD {
108        # Get the parameters. We do some fancy dancing to allow the user to pass
109        # in a hash, a list, or a hash reference.
110        my $self = shift @_;
111        my $args = $_[0];
112        if (defined $args) {
113            if (scalar @_ gt 1) {
114                # Here we have multiple arguments. We check the first one for a
115                # leading hyphen.
116                if ($args =~ /^-/) {
117                    # This means we have hash-form parameters.
118                    my %args = @_;
119                    $args = \%args;
120                } else {
121                    # This means we have list-form parameters.
122                    my @args = @_;
123                    $args = \@args;
124                }
125            } else {
126                # Here we have a single argument. If it's a scalar, we convert it
127                # to a singleton list.
128                if (! ref $args) {
129                    $args = [$args];
130                }
131            }
132        }
133        # Declare the return variable.
134        my $retVal;
135        # Get the method name.
136        my $function = $AUTOLOAD;
137        # Strip off the stuff before the method name.
138        $function =~ s/.+:://;
139        # Compute the argument document.
140        my $argString = YAML::Dump($args);
141        # Get our user agent.
142        my $ua = $self->{ua};
143        # Request the function from the server.
144        my $response = $ua->post($self->{server_url},
145                                 [function => $function, args => $argString,
146                                  source => __PACKAGE__ ]);
147        # Get the response content.
148        my $content = $response->content;
149        if (! $response->is_success) {
150            die "Server error " . $response->status_line . "\n$content";
151        } else {
152            $retVal = YAML::Load($content);
153            # Figure out what we got back.
154            my $returnType = ref $retVal;
155            if ($returnType) {
156                if ($returnType eq 'ErrorDocument') {
157                    # Here an error occurred, so we throw an exception using the
158                    # error message.
159                    die $retVal->{message};
160                } elsif ($self->{singleton} && $returnType eq 'HASH' &&
161                         scalar(keys %$retVal) <= 1) {
162                    # Here we're in singleton mode and we got a single result,
163                    # so we dereference a bit to make it easier for the user
164                    # to access it.
165                    ($retVal) = values %$retVal;
166                }
167            }
168        }
169        # Return the result.
170        return $retVal;
171    }
172    
173    =head3 DESTROY
174    
175        $ss->DESTROY();
176    
177    This method has no function. It's purpose is to keep the destructor from
178    being caught by the autoload processing.
179    
180    =cut
181    
182    sub DESTROY { }
183    
184    
185  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3