[Bio] / FigWebServices / kernel_xmlrpc.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/kernel_xmlrpc.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.4 - (view) (download)

1 : mkubal 1.1 use Frontier::RPC2;
2 :    
3 :     use FIG;
4 :    
5 :     use strict;
6 :    
7 :    
8 :     package FrontierXMLRPCWrapper;
9 :    
10 :     #
11 :     # We'll make a class to hold the fig instance and the
12 :     # XMLRPC server instance; this will make it easier to invoke the
13 :     # wrapping functions (since each one will need these values).
14 :     #
15 :    
16 :    
17 :     #
18 :     # Constructor.
19 :     #
20 :     sub new
21 :     {
22 :     my($class, $fig, $xmlrpc) = @_;
23 :    
24 :     my $self = {
25 :     fig => $fig,
26 :     xmlrpc => $xmlrpc,
27 :     };
28 :    
29 :     return bless $self, $class;
30 :     }
31 :    
32 :    
33 :     #
34 :     # Return a value properly coerced to a string for passing
35 :     # as an XMLRPC return. Use the string() method on the
36 :     # xmlrpc instance variable.
37 :     #
38 :     sub coerce_to_string
39 :     {
40 :     my($self, $value) = @_;
41 :    
42 :     return $self->{xmlrpc}->string($value);
43 :     }
44 :    
45 :     #
46 :     # Wrap a FIG method that returns a scalar.
47 :     #
48 :    
49 :     sub wrap_scalar_return
50 :     {
51 :     my($self, $func) = @_;
52 :    
53 :     #
54 :     # We return a new anonymous subroutine that invokes the
55 :     # routine thru the $fig instance saved in our instance variables.
56 :     #
57 :    
58 :     return sub {
59 :     my $ret;
60 :    
61 :     $ret = $self->{fig}->$func(@_);
62 :    
63 :     #
64 :     # Coerce to string if we need to.
65 :     #
66 :    
67 :     if (!ref($ret))
68 :     {
69 :     $ret = $self->coerce_to_string($ret);
70 :     }
71 :    
72 :     return $ret;
73 :     }
74 :     }
75 :    
76 :     #
77 :     # Wrap a FIG method that returns a list. The list needs to be
78 :     # converted into a list reference instead of a plain list.
79 :     #
80 :    
81 :     sub wrap_array_return
82 :     {
83 :     my($self, $func) = @_;
84 :    
85 :     #
86 :     # We return a new anonymous subroutine that invokes the
87 :     # routine thru the $fig instance saved in our instance variables.
88 :     #
89 :    
90 :     return sub {
91 :     my $ret;
92 :     my @func_ret;
93 :    
94 :     $ret = [];
95 :    
96 :     #
97 :     # Invoke the function.
98 :     #
99 :     @func_ret = $self->{fig}->$func(@_);
100 :    
101 :     #
102 :     # For each value returned, if it isn't a reference (to a list, for instance),
103 :     # coerce it to a string.
104 :     #
105 :     # Push each value to the list we're creating.
106 :     #
107 :     for $_ (@func_ret)
108 :     {
109 :     if (ref($_))
110 :     {
111 :     push(@$ret, $_);
112 :     }
113 :     else
114 :     {
115 :     push(@$ret, $self->coerce_to_string($_));
116 :     }
117 :     }
118 :     return $ret;
119 :     }
120 :     }
121 :    
122 :     #
123 :     # back in the main package, finished with class definition.
124 :     #
125 :    
126 :     package main;
127 :    
128 :     $| = 1; # Perl magic to use unbuffered output on standard output
129 :    
130 :     my $xml_rpc_server = Frontier::RPC2->new;
131 :    
132 :     my $fig = new FIG;
133 :    
134 :     #
135 :     # Create a wrapper-helper object.
136 :     #
137 :    
138 :     my $wrapper = new FrontierXMLRPCWrapper($fig, $xml_rpc_server);
139 :    
140 :     #
141 :     # Create a list of the methods to be served
142 :     #
143 :    
144 :     my $methods = {
145 :     'abbrev' => $wrapper->wrap_scalar_return("abbrev"),
146 :     'add_chromosomal_clusters' => $wrapper->wrap_scalar_return("add_chromosomal_clusters"),
147 :     'add_genome' => $wrapper->wrap_scalar_return("add_genome"),
148 :     'add_pch_pins' => $wrapper->wrap_scalar_return("add_pch_pins"),
149 :     'all_compounds' => $wrapper->wrap_array_return("all_compounds"),
150 : olson 1.3 'all_constructs' => $wrapper->wrap_array_return("all_constructs"),
151 : mkubal 1.1 'all_exchangable_subsystems' => $wrapper->wrap_array_return("all_exchangable_subsystems"),
152 :     'all_features' => $wrapper->wrap_array_return("all_features"),
153 :     'all_maps' => $wrapper->wrap_array_return("all_maps"),
154 :     'all_protein_families' => $wrapper->wrap_array_return("all_protein_families"),
155 :     'all_reactions' => $wrapper->wrap_array_return("all_reactions"),
156 :     'all_roles' => $wrapper->wrap_array_return("all_roles"),
157 :     'all_sets' => $wrapper->wrap_array_return("all_sets"),
158 : olson 1.2 'all_subsystems' => $wrapper->wrap_array_return("all_subsystems"),
159 : mkubal 1.1 'assign_function' => $wrapper->wrap_scalar_return("assign_function"),
160 :     'assign_functionF' => $wrapper->wrap_scalar_return("assign_functionF"),
161 :     'assignments_made' => $wrapper->wrap_array_return("assignments_made"),
162 :     'auto_assign' => $wrapper->wrap_scalar_return("auto_assign"),
163 :     'auto_assignF' => $wrapper->wrap_scalar_return("auto_assignF"),
164 :     'auto_assignG' => $wrapper->wrap_scalar_return("auto_assignG"),
165 :     'between' => $wrapper->wrap_scalar_return("between"),
166 :     'blast' => $wrapper->wrap_array_return("blast"),
167 :     'blastit' => $wrapper->wrap_array_return("blastit"),
168 :     'boundaries_of' => $wrapper->wrap_scalar_return("boundaries_of"),
169 :     'build_tree_of_complete' => $wrapper->wrap_array_return("build_tree_of_complete"),
170 :     'by_alias' => $wrapper->wrap_scalar_return("by_alias"),
171 :     'by_fig_id' => $wrapper->wrap_scalar_return("by_fig_id"),
172 :     'cas' => $wrapper->wrap_scalar_return("cas"),
173 :     'cas_to_cid' => $wrapper->wrap_scalar_return("cas_to_cid"),
174 :     'catalyzed_by' => $wrapper->wrap_array_return("catalyzed_by"),
175 :     'catalyzes' => $wrapper->wrap_array_return("catalyzes"),
176 :     'cgi_url' => $wrapper->wrap_scalar_return("cgi_url"),
177 :     'clean_tmp' => $wrapper->wrap_scalar_return("clean_tmp"),
178 :     'close_genes' => $wrapper->wrap_array_return("close_genes"),
179 :     'comp2react' => $wrapper->wrap_scalar_return("comp2react"),
180 :     'contig_ln' => $wrapper->wrap_scalar_return("contig_ln"),
181 :     'coupling_and_evidence' => $wrapper->wrap_array_return("coupling_and_evidence"),
182 :     'crude_estimate_of_distance' => $wrapper->wrap_scalar_return("crude_estimate_of_distance"),
183 :     'delete_genomes' => $wrapper->wrap_scalar_return("delete_genomes"),
184 :     'displayable_reaction' => $wrapper->wrap_scalar_return("displayable_reaction"),
185 :     'dna_seq' => $wrapper->wrap_scalar_return("dna_seq"),
186 :     'dsims' => $wrapper->wrap_array_return("dsims"),
187 :     'ec_to_maps' => $wrapper->wrap_array_return("ec_to_maps"),
188 :     'ec_name' => $wrapper->wrap_scalar_return("ec_name"),
189 :     'expand_ec' => $wrapper->wrap_scalar_return("expand_ec"),
190 :     'epoch_to_readable' => $wrapper->wrap_scalar_return("epoch_to_readable"),
191 :     'export_chromosomal_clusters' => $wrapper->wrap_scalar_return("export_chromosomal_clusters"),
192 :     'export_pch_pins' => $wrapper->wrap_scalar_return("export_pch_pins"),
193 :     'export_set' => $wrapper->wrap_scalar_return("export_set"),
194 :     'exportable_subsystem' => $wrapper->wrap_scalar_return("exportable_subsystem"),
195 :     'extract_seq' => $wrapper->wrap_scalar_return("extract_seq"),
196 :     'family_function' => $wrapper->wrap_scalar_return("family_function"),
197 :     'fast_coupling' => $wrapper->wrap_array_return("fast_coupling"),
198 :     'feature_aliases' => $wrapper->wrap_array_return("feature_aliases"),
199 :     'feature_annotations' => $wrapper->wrap_array_return("feature_annotations"),
200 :     'feature_location' => $wrapper->wrap_scalar_return("feature_location"),
201 :     'file2N' => $wrapper->wrap_scalar_return("file_2N"),
202 :     'ftype' => $wrapper->wrap_scalar_return("ftype"),
203 :     'function_of' => $wrapper->wrap_scalar_return("function_of"),
204 :     'genes_in_region' => $wrapper->wrap_array_return("genes_in_region"),
205 :     'genome_of' => $wrapper->wrap_scalar_return("genome_of"),
206 :     'genomes' => $wrapper->wrap_array_return("genomes"),
207 :     'genome_counts' => $wrapper->wrap_scalar_return("genome_counts"),
208 :     'genome_version' => $wrapper->wrap_scalar_return("genome_version"),
209 :     'genus_species' => $wrapper->wrap_scalar_return("genus_species"),
210 :     'get_translation' => $wrapper->wrap_scalar_return("get_translation"),
211 :     'get_translations' => $wrapper->wrap_array_return("get_translations"),
212 :     'hypo' => $wrapper->wrap_scalar_return("hypo"),
213 :     'ids_in_family' => $wrapper->wrap_array_return("ids_in_family"),
214 :     'ids_in_set' => $wrapper->wrap_array_return("ids_in_set"),
215 :     'in_cluster_with' => $wrapper->wrap_array_return("in_cluster_with"),
216 :     'in_family' => $wrapper->wrap_scalar_return("in_family"),
217 :     'in_pch_pin_with' => $wrapper->wrap_array_return("in_pch_pin_with"),
218 :     'in_sets' => $wrapper->wrap_array_return("in_sets"),
219 :     'is_archaeal' => $wrapper->wrap_scalar_return("is_archaeal"),
220 :     'is_bacterial' => $wrapper->wrap_scalar_return("is_bacterial"),
221 :     'is_eukaryotic' => $wrapper->wrap_scalar_return("is_eukaryotic"),
222 :     'is_prokaryotic' => $wrapper->wrap_scalar_return("is_prokaryotic"),
223 :     'is_exchangable_subsytem' => $wrapper->wrap_scalar_return("is_exchangable_subsystem"),
224 :     'is_real_feature' => $wrapper->wrap_scalar_return("is_real_feature"),
225 :     'largest_clusters' => $wrapper->wrap_array_return("largest_clusters"),
226 :     'load_all' => $wrapper->wrap_scalar_return("load_all"),
227 :     'map_to_ecs' => $wrapper->wrap_array_return("map_to_ecs"),
228 :     'map_name' => $wrapper->wrap_scalar_return("map_name"),
229 :     'mapped_prot_ids' => $wrapper->wrap_array_return("mapped_prot_ids"),
230 :     'maps_to_id' => $wrapper->wrap_array_return("maps_to_id"),
231 :     'max' => $wrapper->wrap_scalar_return("max"),
232 :     'merged_related_annotations' => $wrapper->wrap_scalar_return("merged_related_annotations"),
233 :     'min' => $wrapper->wrap_scalar_return("min"),
234 :     'names_of_compound' => $wrapper->wrap_array_return("names_of_compund"),
235 :     'neighborhood_of_role' => $wrapper->wrap_scalar_return("neighborhood_of_role"),
236 :     'org_of' => $wrapper->wrap_scalar_return("org_of"),
237 :     'pegs_of' => $wrapper->wrap_array_return("pegs_of"),
238 :     'possibly_truncated' => $wrapper->wrap_scalar_return("possibly_truncated"),
239 :     'reaction2comp' => $wrapper->wrap_scalar_return("reaction2comp"),
240 :     'related_by_func_sim' => $wrapper->wrap_array_return("related_by_func_sim"),
241 :     'reversible' => $wrapper->wrap_scalar_return("reversible"),
242 :     'rnas_of' => $wrapper->wrap_array_return("rnas_of"),
243 :     'roles_of_function' => $wrapper->wrap_array_return("roles_of_function"),
244 :     'search_index' => $wrapper->wrap_array_return("search_index"),
245 :     'seqs_with_role' => $wrapper->wrap_array_return("seqs_with_role"),
246 :     'seqs_with_roles_in_genome' => $wrapper->wrap_scalar_return("seqs_with_roles_in_genomes"),
247 :     'sims' => $wrapper->wrap_array_return("sims"),
248 :     'sort_fids_by_taxonomy' => $wrapper->wrap_array_return("sort_fids_by_taxonomy"),
249 :     'sort_genomes_by_taxonomy' => $wrapper->wrap_array_return("sort_genomes_by_taxonomy"),
250 : olson 1.2 'subsystem_info' => $wrapper->wrap_array_return("subsystem_info"),
251 : mkubal 1.4 'subsystems_for_peg' => $wrapper->wrap_array_return("subsystems_for_peg"),
252 : mkubal 1.1 'sz_family' => $wrapper->wrap_scalar_return("sz_family"),
253 :     'taxonomic_groups_of_complete' => $wrapper->wrap_array_return("taxonomic_groups_of_complete"),
254 :     'taxonomy_of' => $wrapper->wrap_scalar_return("taxonomy_of"),
255 :     'translatable' => $wrapper->wrap_scalar_return("translatable"),
256 :     'translate_function' => $wrapper->wrap_scalar_return("translate_function"),
257 :     'translated_function_of' => $wrapper->wrap_scalar_return("translated_function_of"),
258 :     'translation_length' => $wrapper->wrap_scalar_return("translation_length"),
259 :     'unique_functions' => $wrapper->wrap_array_return("unique_functions"),
260 :     'verify_directory' => $wrapper->wrap_scalar_return("verify_directory"),
261 :    
262 :     };
263 :    
264 :     process_cgi_call($methods);
265 :    
266 :     #==========================================================================
267 :     # CGI Support
268 :     #==========================================================================
269 :     # Simple CGI support for Frontier::RPC2. You can copy this into your CGI
270 :     # scripts verbatim, or you can package it into a library.
271 :     # (Based on xmlrpc_cgi.c by Eric Kidd <http://xmlrpc-c.sourceforge.net/>.)
272 :    
273 :     # Process a CGI call.
274 :     sub process_cgi_call ($) {
275 :     my ($methods) = @_;
276 :    
277 :     # Get our CGI request information.
278 :     my $method = $ENV{'REQUEST_METHOD'};
279 :     my $type = $ENV{'CONTENT_TYPE'};
280 :     my $length = $ENV{'CONTENT_LENGTH'};
281 :    
282 :     # Perform some sanity checks.
283 :     http_error(405, "Method Not Allowed") unless $method eq "POST";
284 :     http_error(400, "Bad Request") unless $type eq "text/xml";
285 :     http_error(411, "Length Required") unless $length > 0;
286 :    
287 :     # Fetch our body.
288 :     my $body;
289 :     my $count = read STDIN, $body, $length;
290 :     http_error(400, "Bad Request") unless $count == $length;
291 :    
292 :     # Serve our request.
293 :     my $coder = Frontier::RPC2->new;
294 :     send_xml($coder->serve($body, $methods));
295 :     }
296 :    
297 :     # Send an HTTP error and exit.
298 :     sub http_error ($$) {
299 :     my ($code, $message) = @_;
300 :     print <<"EOD";
301 :     Status: $code $message
302 :     Content-type: text/html
303 :    
304 :     <title>$code $message</title>
305 :     <h1>$code $message</h1>
306 :     <p>Unexpected error processing XML-RPC request.</p>
307 :     EOD
308 :     exit 0;
309 :     }
310 :    
311 :     # Send an XML document (but don't exit).
312 :     sub send_xml ($) {
313 :     my ($xml_string) = @_;
314 :     my $length = length($xml_string);
315 :     print <<"EOD";
316 :     Status: 200 OK
317 :     Content-type: text/xml
318 :     Content-length: $length
319 :    
320 :     EOD
321 :     # We want precise control over whitespace here.
322 :     print $xml_string;
323 :     }
MCS Webmaster
 ViewVC Help
Powered by ViewVC 1.0.3