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

Annotation of /FigKernelPackages/SAPserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (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 LWP::UserAgent;
24 :     use YAML;
25 :    
26 :     =head1 Sapling Server Helper Object
27 :    
28 :     =head2 Introduction
29 :    
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 :     The URL used to request data from the sapling server.
44 :    
45 :     =item ua
46 :    
47 :     The user agent for communication with the server.
48 :    
49 :     =back
50 :    
51 :     =cut
52 :    
53 :     =head3 new
54 :    
55 :     my $ss = SAPserver->new(%options);
56 :    
57 :     Construct a new SAPserver object. The following options are supported.
58 :    
59 :     =over 4
60 :    
61 :     =item url
62 :    
63 :     URL for the sapling server. This option may be used to redirect requests to a
64 :     test version of the server, or to an older server script.
65 :    
66 :     =back
67 :    
68 :     =cut
69 :    
70 :     sub new {
71 :     # Get the parameters.
72 :     my ($class, %options) = @_;
73 :     # Get the options.
74 :     my $url = $options{url} || "http://servers.nmpdr.org/sap/server.cgi";
75 :     # Create the fields of the object.
76 :     my $server_url = $url;
77 :     my $ua = LWP::UserAgent->new();
78 :     # Create the SAPserver object.
79 :     my $retVal = {
80 :     server_url => $server_url,
81 :     ua => $ua,
82 :     };
83 :     # Bless and return it.
84 :     bless $retVal, $class;
85 :     return $retVal;
86 :     }
87 :    
88 :     =head2 Public Methods
89 :    
90 :     =head3 AUTOLOAD
91 :    
92 :     my $result = $ss->method(%args);
93 :    
94 :     Call a function on the server. Any method call on this object (other than
95 :     the constructor) is translated into a request against the server. This
96 :     enables us to add new server functions without requiring an update to this
97 :     module. The parameters are specified as a hash, and the result is a scalar
98 : parrello 1.2 or object reference. If an error occurred, we will throw an exception.
99 : parrello 1.1
100 :     =cut
101 :    
102 :     # This variable will contain the method name.
103 :     our $AUTOLOAD;
104 :    
105 :     sub AUTOLOAD {
106 :     # Get the parameters.
107 :     my ($self, %args) = @_;
108 :     # Declare the return variable.
109 :     my $retVal;
110 :     # Get the method name.
111 :     my $function = $AUTOLOAD;
112 : parrello 1.3 # Strip off the stuff before the method name.
113 : parrello 1.1 $function =~ s/.+:://;
114 :     # Compute the argument document.
115 :     my $argString = YAML::Dump(\%args);
116 :     # Get our user agent.
117 :     my $ua = $self->{ua};
118 :     # Request the function from the server.
119 :     my $response = $ua->post($self->{server_url},
120 :     [function => $function, args => $argString]);
121 :     # Get the response content.
122 :     my $content = $response->content;
123 :     if (! $response->is_success) {
124 : parrello 1.2 die "Server error " . $response->status_line . "\n$content";
125 : parrello 1.1 } else {
126 :     $retVal = YAML::Load($content);
127 :     # Figure out what we got back.
128 :     my $returnType = ref $retVal;
129 :     if ($returnType && $returnType eq 'ErrorDocument') {
130 : parrello 1.2 die $retVal->{message};
131 : parrello 1.1 }
132 :     }
133 :     # Return the result.
134 :     return $retVal;
135 :     }
136 :    
137 :     =head3 DESTROY
138 :    
139 :     $ss->DESTROY();
140 :    
141 :     This method has no function. It's purpose is to keep the destructor from
142 :     being caught by the autoload processing.
143 :    
144 :     =cut
145 :    
146 :     sub DESTROY { }
147 :    
148 :    
149 : parrello 1.2 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3