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

Annotation of /FigKernelPackages/SAPserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     #
4 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
5 :     # for Interpretations of Genomes. All Rights Reserved.
6 :     #
7 :     # This file is part of the SEED Toolkit.
8 :     #
9 :     # The SEED Toolkit is free software. You can redistribute
10 :     # it and/or modify it under the terms of the SEED Toolkit
11 :     # Public License.
12 :     #
13 :     # You should have received a copy of the SEED Toolkit Public License
14 :     # along with this program; if not write to the University of Chicago
15 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
16 :     # Genomes at veronika@thefig.info or download a copy from
17 :     # http://www.theseed.org/LICENSE.TXT.
18 :     #
19 :    
20 :     package SAPserver;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :     use LWP::UserAgent;
25 :     use YAML;
26 :    
27 :     =head1 Sapling Server Helper Object
28 :    
29 :     =head2 Introduction
30 :    
31 :     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
33 :     function correspond to a method of this object.
34 :    
35 :     The fields in this object are as follows.
36 :    
37 :     =over 4
38 :    
39 :     =item server_url
40 :    
41 :     The URL used to request data from the sapling server.
42 :    
43 :     =item ua
44 :    
45 :     The user agent for communication with the server.
46 :    
47 :     =back
48 :    
49 :     =cut
50 :    
51 :     =head3 new
52 :    
53 :     my $ss = SAPserver->new(%options);
54 :    
55 :     Construct a new SAPserver object. The following options are supported.
56 :    
57 :     =over 4
58 :    
59 :     =item url
60 :    
61 :     URL for the sapling server. This option may be used to redirect requests to a
62 :     test version of the server, or to an older server script.
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/sap/server.cgi";
73 :     # Create the fields of the object.
74 :     my $server_url = $url;
75 :     my $ua = LWP::UserAgent->new();
76 :     # Create the SAPserver object.
77 :     my $retVal = {
78 :     server_url => $server_url,
79 :     ua => $ua,
80 :     };
81 :     # Bless and return it.
82 :     bless $retVal, $class;
83 :     return $retVal;
84 :     }
85 :    
86 :     =head2 Public Methods
87 :    
88 :     =head3 AUTOLOAD
89 :    
90 :     my $result = $ss->method(%args);
91 :    
92 :     Call a function on the server. Any method call on this object (other than
93 :     the constructor) is translated into a request against the server. This
94 :     enables us to add new server functions without requiring an update to this
95 :     module. The parameters are specified as a hash, and the result is a scalar
96 :     or object reference. If an error occurred, we will confess.
97 :    
98 :     =cut
99 :    
100 :     # This variable will contain the method name.
101 :     our $AUTOLOAD;
102 :    
103 :     sub AUTOLOAD {
104 :     # Get the parameters.
105 :     my ($self, %args) = @_;
106 :     # Declare the return variable.
107 :     my $retVal;
108 :     # Get the method name.
109 :     my $function = $AUTOLOAD;
110 :     $function =~ s/.+:://;
111 :     # Compute the argument document.
112 :     my $argString = YAML::Dump(\%args);
113 :     # Get our user agent.
114 :     my $ua = $self->{ua};
115 :     # Request the function from the server.
116 :     my $response = $ua->post($self->{server_url},
117 :     [function => $function, args => $argString]);
118 :     # Get the response content.
119 :     my $content = $response->content;
120 :     if (! $response->is_success) {
121 :     Confess("Server error " . $response->status_line . "\n$content");
122 :     } else {
123 :     Trace("YAML document is\n$content.") if T(3);
124 :     $retVal = YAML::Load($content);
125 :     # Figure out what we got back.
126 :     Trace("Checking for an error document.") if T(3);
127 :     my $returnType = ref $retVal;
128 :     if ($returnType && $returnType eq 'ErrorDocument') {
129 :     Confess($retVal->{message});
130 :     }
131 :     }
132 :     # Return the result.
133 :     return $retVal;
134 :     }
135 :    
136 :     =head3 DESTROY
137 :    
138 :     $ss->DESTROY();
139 :    
140 :     This method has no function. It's purpose is to keep the destructor from
141 :     being caught by the autoload processing.
142 :    
143 :     =cut
144 :    
145 :     sub DESTROY { }
146 :    
147 :    
148 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3