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

Diff of /FigKernelScripts/fig_xmlrpc_server.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Tue May 4 16:35:22 2004 UTC revision 1.5, Mon Dec 5 18:56:37 2005 UTC
# Line 1  Line 1 
1  #  #
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    #
19  # XMLRPC server to provide network access to FIG routines.  # XMLRPC server to provide network access to FIG routines.
20  #  #
21  # We create a single FIG instance to use for all calls.  # We create a single FIG instance to use for all calls.
# Line 6  Line 23 
23  # This is originally intended for the support of the Python interface.  # This is originally intended for the support of the Python interface.
24  #  #
25    
26  package main;  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    
65  use FIG;  use FIG;
66    
67    
68  require XMLRPC::Transport::HTTP;  require XMLRPC::Transport::HTTP;
69  require XMLRPC::Lite;  require XMLRPC::Lite;
70  use IO::Select;  use IO::Select;
# Line 19  Line 74 
74                                                    ReuseAddr => 1);                                                    ReuseAddr => 1);
75  my $fig = new FIG;  my $fig = new FIG;
76    
77  @d = ();  my @d = ();
78  for my $name (keys(%FIG::))  
79    sub wrap_util
80  {  {
81      next if $name !~ /^[a-zA-Z]/;      my($name) = @_;
     next if $name eq "new";  
82    
83      my $glob = $FIG::{$name};      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      next unless defined(&$glob);      };
 #    print "$name $glob\n";  
92    
93      my $methName = $name;      return $sub;
94  #    my $methName = "XMLPKG::$name";  }
95      *$methName = sub {  
96    sub wrap_method
97    {
98        my($name, $fig) = @_;
99        my $sub = sub {
100          shift if UNIVERSAL::isa($_[0] => __PACKAGE__);          shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
101          print "Args: ", map { "<$_>\n" } @_ , "\n";          print "Args: ", map { "<$_>\n" } @_ , "\n";
102          print "name $name\n";          print "name $name\n";
# Line 42  Line 106 
106    
107      };      };
108    
109        return $sub;
110    }
111    
112    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        if ($util_funcs{$name})
124        {
125            *$methName = wrap_util($name);
126        }
127        else
128        {
129            *$methName = wrap_method($name, $fig);
130        }
131    
132      push(@d, $methName);      push(@d, $methName);
133  }  }
134    
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  $server->dispatch_to(@d);  $server->dispatch_to(@d);
160  #$server->dispatch_to('XMLPKG');  #$server->dispatch_to('XMLPKG');
161    
# Line 52  Line 164 
164    
165  # $server->handle;  # $server->handle;
166    
167  $s = $server->new();  my $s = $server->new();
168  $sel = IO::Select->new();  my $sel = IO::Select->new();
169  $sel->add($s->{_daemon});  $sel->add($s->{_daemon});
170  my $stdin = \*STDIN;  my $stdin = \*STDIN;
171  $sel->add($stdin);  $sel->add($stdin);
172  while (1)  while (1)
173  {  {
174      @ready = $sel->can_read();      my @ready = $sel->can_read();
175      for my $fh (@ready)      for my $fh (@ready)
176      {      {
177          if ($fh == $s->{_daemon})          if ($fh == $s->{_daemon})
# Line 74  Line 186 
186          }          }
187          elsif ($fh == $stdin)          elsif ($fh == $stdin)
188          {          {
189                my $buf;
190              my $n = sysread($stdin, $buf, 1);              my $n = sysread($stdin, $buf, 1);
191              if ($n == 0)              if ($n == 0)
192              {              {
193                  print "Exiting due to closed stdin\n";                  print "Exiting due to closed stdin\n";
194                  $sel->remove($stdin);                  $sel->remove($stdin);
195                  #exit;                  exit;
196              }              }
197          }          }
198      }      }

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3