[Bio] / FigKernelScripts / fig_xmlrpc_server.pl Repository:
ViewVC logotype

Annotation of /FigKernelScripts/fig_xmlrpc_server.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.1 #
2 : olson 1.5 # 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 :     #
19 : olson 1.1 # XMLRPC server to provide network access to FIG routines.
20 :     #
21 :     # We create a single FIG instance to use for all calls.
22 :     #
23 :     # This is originally intended for the support of the Python interface.
24 :     #
25 :    
26 : olson 1.2 my @util_funcs = qw(
27 :     enqueue_similarities
28 :     plug_url
29 :     min
30 :     max
31 :     between
32 :     translate
33 :     reverse_comp
34 :     rev_comp
35 :     verify_dir
36 :     run
37 :     read_fasta_record
38 :     display_id_and_seq
39 :     display_seq
40 :     abbrev
41 :     ftype
42 :     by_fig_id
43 :     close_enough
44 :     extract_by_who
45 :     read_block
46 :     blastit
47 :     epoch_to_readable
48 :     auto_assign
49 :     roles_of_function
50 :     close_enough_locs
51 :     extract_seq
52 :     limit_labels
53 :     taxonomic_groups
54 :     taxonomic_groups_and_children
55 :     );
56 :    
57 :     my(%util_funcs);
58 :    
59 :     grep({$util_funcs{$_}++} @util_funcs);
60 :    
61 :     use strict;
62 :    
63 :     no strict 'refs';
64 : olson 1.1
65 :     use FIG;
66 :    
67 : olson 1.2
68 : olson 1.1 require XMLRPC::Transport::HTTP;
69 :     require XMLRPC::Lite;
70 :     use IO::Select;
71 :     use IO::Handle;
72 :    
73 :     my $server = XMLRPC::Transport::HTTP::Daemon->new(LocalAddr =>"127.0.0.1",
74 :     ReuseAddr => 1);
75 :     my $fig = new FIG;
76 :    
77 : olson 1.2 my @d = ();
78 :    
79 :     sub wrap_util
80 :     {
81 :     my($name) = @_;
82 :    
83 :     my $sub = sub {
84 :     shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
85 :     print "Args: ", map { "<$_>\n" } @_ , "\n";
86 :     print "name $name\n";
87 :     my @ret = eval " &FIG::$name(\@_);";
88 :     print "Ret: @ret\n";
89 :     return map { ref($_) ? $_ : XMLRPC::Data->type("string", $_) } @ret;
90 :    
91 :     };
92 :    
93 :     return $sub;
94 :     }
95 :    
96 :     sub wrap_method
97 :     {
98 :     my($name, $fig) = @_;
99 :     my $sub = sub {
100 :     shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
101 :     print "Args: ", map { "<$_>\n" } @_ , "\n";
102 :     print "name $name\n";
103 :     my @ret = $fig->$name(@_);
104 :     print "Ret: @ret\n";
105 :     return map { ref($_) ? $_ : XMLRPC::Data->type("string", $_) } @ret;
106 :    
107 :     };
108 :    
109 :     return $sub;
110 :     }
111 :    
112 : olson 1.1 for my $name (keys(%FIG::))
113 :     {
114 :     next if $name !~ /^[a-zA-Z]/;
115 :     next if $name eq "new";
116 :    
117 :     my $glob = $FIG::{$name};
118 :    
119 :     next unless defined(&$glob);
120 :    
121 :     my $methName = $name;
122 :    
123 : olson 1.2 if ($util_funcs{$name})
124 :     {
125 :     *$methName = wrap_util($name);
126 :     }
127 :     else
128 :     {
129 :     *$methName = wrap_method($name, $fig);
130 :     }
131 : olson 1.1
132 :     push(@d, $methName);
133 :     }
134 : mkubal 1.4
135 :     sub genomes
136 :     {
137 :     my($dummy) = @_;
138 :    
139 :     my(@ret);
140 :    
141 :     @ret = $fig->genomes();
142 :    
143 :     return force_to_strings(@ret);
144 :     }
145 :    
146 :    
147 :     sub genus_species
148 :     {
149 :     my($dummy, $genome) = @_;
150 :    
151 :     my($ret);
152 :    
153 :     $ret = $fig->genus_species($genome);
154 :    
155 :     return force_to_string($ret);
156 :     }
157 :    
158 :    
159 : olson 1.1 $server->dispatch_to(@d);
160 :     #$server->dispatch_to('XMLPKG');
161 :    
162 :     print $server->url, "\n";
163 :     STDOUT->autoflush();
164 :    
165 :     # $server->handle;
166 :    
167 : olson 1.2 my $s = $server->new();
168 :     my $sel = IO::Select->new();
169 : olson 1.1 $sel->add($s->{_daemon});
170 :     my $stdin = \*STDIN;
171 :     $sel->add($stdin);
172 :     while (1)
173 :     {
174 : olson 1.2 my @ready = $sel->can_read();
175 : olson 1.1 for my $fh (@ready)
176 :     {
177 :     if ($fh == $s->{_daemon})
178 :     {
179 :     my $c = $s->accept;
180 :     while (my $r = $c->get_request)
181 :     {
182 :     $s->request($r);
183 :     $s->SOAP::Transport::HTTP::Server::handle;
184 :     $c->send_response($s->response);
185 :     }
186 :     }
187 :     elsif ($fh == $stdin)
188 :     {
189 : olson 1.2 my $buf;
190 : olson 1.1 my $n = sysread($stdin, $buf, 1);
191 :     if ($n == 0)
192 :     {
193 :     print "Exiting due to closed stdin\n";
194 :     $sel->remove($stdin);
195 : olson 1.3 exit;
196 : olson 1.1 }
197 :     }
198 :     }
199 :     }
200 :    
201 :    
202 :    
203 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3