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

Annotation of /FigWebServices/cluster_xmlrpc.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : olson 1.2 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : olson 1.1 use Frontier::RPC2;
19 :     use Cluster;
20 :    
21 :     use FIG;
22 :    
23 :     use strict;
24 :    
25 :     $| = 1; # Perl magic to use unbuffered output on standard output
26 :    
27 :     my $xml_rpc_server = Frontier::RPC2->new;
28 :    
29 :     my $fig = new FIG;
30 :    
31 :     #
32 :     # Create a list of the methods to be served
33 :     #
34 :    
35 :     my $methods = {
36 :     get_work => \&get_work,
37 :     work_done => \&work_done,
38 :     work_aborted => \&work_aborted,
39 :     };
40 :    
41 :     process_cgi_call($methods);
42 :    
43 :     exit 0;
44 :    
45 :     sub get_work
46 :     {
47 :     my($table, $worker) = @_;
48 :    
49 :     my $jobmgr = new Cluster::DBJobMgr($fig, $table);
50 :    
51 :     return $jobmgr->get_work($worker);
52 :     }
53 :    
54 :    
55 :     sub work_done
56 :     {
57 :     my($table, $work, $output) = @_;
58 :    
59 :     my $jobmgr = new Cluster::DBJobMgr($fig, $table);
60 :    
61 :     return $jobmgr->work_done($work, $output);
62 :     }
63 :    
64 :     sub work_aborted
65 :     {
66 :     my($table, $work) = @_;
67 :    
68 :     my $jobmgr = new Cluster::DBJobMgr($fig, $table);
69 :    
70 :     return $jobmgr->work_aborted($work);
71 :     }
72 :    
73 :    
74 :     #==========================================================================
75 :     # CGI Support
76 :     #==========================================================================
77 :     # Simple CGI support for Frontier::RPC2. You can copy this into your CGI
78 :     # scripts verbatim, or you can package it into a library.
79 :     # (Based on xmlrpc_cgi.c by Eric Kidd <http://xmlrpc-c.sourceforge.net/>.)
80 :    
81 :     # Process a CGI call.
82 :     sub process_cgi_call ($) {
83 :     my ($methods) = @_;
84 :    
85 :     # Get our CGI request information.
86 :     my $method = $ENV{'REQUEST_METHOD'};
87 :     my $type = $ENV{'CONTENT_TYPE'};
88 :     my $length = $ENV{'CONTENT_LENGTH'};
89 :    
90 :     # Perform some sanity checks.
91 :     http_error(405, "Method Not Allowed") unless $method eq "POST";
92 :     http_error(400, "Bad Request") unless $type eq "text/xml";
93 :     http_error(411, "Length Required") unless $length > 0;
94 :    
95 :     # Fetch our body.
96 :     my $body;
97 :     my $count = read STDIN, $body, $length;
98 :     http_error(400, "Bad Request") unless $count == $length;
99 :    
100 :     # Serve our request.
101 :     my $coder = Frontier::RPC2->new;
102 :     send_xml($coder->serve($body, $methods));
103 :     }
104 :    
105 :     # Send an HTTP error and exit.
106 :     sub http_error ($$) {
107 :     my ($code, $message) = @_;
108 :     print <<"EOD";
109 :     Status: $code $message
110 :     Content-type: text/html
111 :    
112 :     <title>$code $message</title>
113 :     <h1>$code $message</h1>
114 :     <p>Unexpected error processing XML-RPC request.</p>
115 :     EOD
116 :     exit 0;
117 :     }
118 :    
119 :     # Send an XML document (but don't exit).
120 :     sub send_xml ($) {
121 :     my ($xml_string) = @_;
122 :     my $length = length($xml_string);
123 :     print <<"EOD";
124 :     Status: 200 OK
125 :     Content-type: text/xml
126 :     Content-length: $length
127 :    
128 :     EOD
129 :     # We want precise control over whitespace here.
130 :     print $xml_string;
131 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3