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

Annotation of /FigKernelPackages/ACHserver.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3