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

Annotation of /FigKernelPackages/SAPserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 : parrello 1.7 #
3 :     # This is a SAS Component.
4 : parrello 1.1 #
5 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
6 :     # for Interpretations of Genomes. All Rights Reserved.
7 :     #
8 :     # This file is part of the SEED Toolkit.
9 :     #
10 :     # The SEED Toolkit is free software. You can redistribute
11 :     # it and/or modify it under the terms of the SEED Toolkit
12 :     # Public License.
13 :     #
14 :     # You should have received a copy of the SEED Toolkit Public License
15 :     # along with this program; if not write to the University of Chicago
16 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
17 :     # Genomes at veronika@thefig.info or download a copy from
18 :     # http://www.theseed.org/LICENSE.TXT.
19 :     #
20 :    
21 :     package SAPserver;
22 :    
23 :     use strict;
24 :     use YAML;
25 :    
26 :     =head1 Sapling Server Helper Object
27 :    
28 : parrello 1.5 =head2 Description
29 : parrello 1.1
30 :     This module is used to call the sapling server, which is a general-purpose
31 :     server for extracting data from the Sapling database. Each Sapling server
32 :     function correspond to a method of this object.
33 :    
34 : parrello 1.2 This package deliberately uses no internal SEED packages or scripts, only common
35 :     PERL modules.
36 :    
37 : parrello 1.1 The fields in this object are as follows.
38 :    
39 :     =over 4
40 :    
41 :     =item server_url
42 :    
43 : parrello 1.8 The URL used to request data from the sapling server. If C<localhost> is
44 :     specified, then the L<SAP> module will be called directly.
45 : parrello 1.1
46 :     =item ua
47 :    
48 :     The user agent for communication with the server.
49 :    
50 : parrello 1.5 =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 : parrello 1.1 =back
57 :    
58 :     =cut
59 :    
60 :     =head3 new
61 :    
62 :     my $ss = SAPserver->new(%options);
63 :    
64 :     Construct a new SAPserver object. The following options are supported.
65 :    
66 :     =over 4
67 :    
68 :     =item url
69 :    
70 :     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.
72 :    
73 : parrello 1.5 =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 : parrello 1.1 =back
80 :    
81 :     =cut
82 :    
83 :     sub new {
84 :     # Get the parameters.
85 :     my ($class, %options) = @_;
86 :     # Get the options.
87 : parrello 1.6 my $url = $options{url} || "http://servers.nmpdr.org/sapling/server.cgi";
88 : parrello 1.5 my $singleton = $options{singleton} || 0;
89 : parrello 1.8 # Create the fields of the object. Note that if we're in localhost mode,
90 :     # the user agent is actually a SAP object.
91 : parrello 1.1 my $server_url = $url;
92 : parrello 1.8 my $ua;
93 :     if ($server_url ne 'localhost') {
94 :     require LWP::UserAgent;
95 :     $ua = LWP::UserAgent->new();
96 :     } else {
97 :     require SAP;
98 :     $ua = SAP->new();
99 :     }
100 : parrello 1.1 # Create the SAPserver object.
101 :     my $retVal = {
102 :     server_url => $server_url,
103 :     ua => $ua,
104 : parrello 1.5 singleton => $singleton,
105 : parrello 1.1 };
106 :     # Bless and return it.
107 :     bless $retVal, $class;
108 :     return $retVal;
109 :     }
110 :    
111 :     =head2 Public Methods
112 :    
113 : parrello 1.5 All L<SAP/Primary Methods> are also methods of this object.
114 :    
115 : parrello 1.1 =head3 AUTOLOAD
116 :    
117 :     my $result = $ss->method(%args);
118 :    
119 :     Call a function on the server. Any method call on this object (other than
120 :     the constructor) is translated into a request against the server. This
121 :     enables us to add new server functions without requiring an update to this
122 :     module. The parameters are specified as a hash, and the result is a scalar
123 : parrello 1.2 or object reference. If an error occurred, we will throw an exception.
124 : parrello 1.1
125 :     =cut
126 :    
127 :     # This variable will contain the method name.
128 :     our $AUTOLOAD;
129 :    
130 :     sub AUTOLOAD {
131 : parrello 1.5 # Get the parameters. We do some fancy dancing to allow the user to pass
132 :     # in a hash or a hash reference.
133 :     my $self = shift @_;
134 :     my $args = $_[0];
135 :     if (defined $args && ref $args ne 'HASH') {
136 :     my %args = @_;
137 :     $args = \%args;
138 :     }
139 : parrello 1.1 # Declare the return variable.
140 :     my $retVal;
141 :     # Get the method name.
142 :     my $function = $AUTOLOAD;
143 : parrello 1.3 # Strip off the stuff before the method name.
144 : parrello 1.1 $function =~ s/.+:://;
145 :     # Get our user agent.
146 :     my $ua = $self->{ua};
147 : parrello 1.8 # Determine the type.
148 :     if (ref $ua eq 'LWP::UserAgent') {
149 :     # Here we're going to a server. Compute the argument document.
150 :     my $argString = YAML::Dump($args);
151 :     # Request the function from the server.
152 :     my $response = $ua->post($self->{server_url},
153 :     [function => $function, args => $argString,
154 :     source => __PACKAGE__ ]);
155 :     # Get the response content.
156 :     my $content = $response->content;
157 :     if (! $response->is_success) {
158 :     die "Server error " . $response->status_line . "\n$content";
159 :     } else {
160 :     $retVal = YAML::Load($content);
161 :     # Figure out what we got back.
162 :     my $returnType = ref $retVal;
163 :     if ($returnType) {
164 :     if ($returnType eq 'ErrorDocument') {
165 :     # Here an error occurred, so we throw an exception using the
166 :     # error message.
167 :     die $retVal->{message};
168 :     }
169 :     }
170 :     }
171 : parrello 1.1 } else {
172 : parrello 1.8 # Here we're calling a local method.
173 :     $retVal = eval("\$ua->$function(\$args)");
174 :     # Check for an error.
175 :     if ($@) {
176 :     die "Package error: $@";
177 : parrello 1.1 }
178 :     }
179 : parrello 1.8 # We have our result. Adjust for singleton mode.
180 :     if ($self->{singleton} && ref $retVal eq 'HASH' && scalar(keys %$retVal) <= 1) {
181 :     # Here we're in singleton mode and we got a single result,
182 :     # so we dereference a bit to make it easier for the user
183 :     # to access it.
184 :     ($retVal) = values %$retVal;
185 :     }
186 : parrello 1.1 # Return the result.
187 :     return $retVal;
188 :     }
189 :    
190 :     =head3 DESTROY
191 :    
192 :     $ss->DESTROY();
193 :    
194 :     This method has no function. It's purpose is to keep the destructor from
195 :     being caught by the autoload processing.
196 :    
197 :     =cut
198 :    
199 :     sub DESTROY { }
200 :    
201 :    
202 : parrello 1.2 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3