[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.2, Mon May 24 15:55:52 2004 UTC
# Line 6  Line 6 
6  # This is originally intended for the support of the Python interface.  # This is originally intended for the support of the Python interface.
7  #  #
8    
9  package main;  my @util_funcs = qw(
10            enqueue_similarities
11            plug_url
12            min
13            max
14            between
15            translate
16            reverse_comp
17            rev_comp
18            verify_dir
19            run
20            read_fasta_record
21            display_id_and_seq
22            display_seq
23            abbrev
24            ftype
25            by_fig_id
26            close_enough
27            extract_by_who
28            read_block
29            blastit
30            epoch_to_readable
31            auto_assign
32            roles_of_function
33            close_enough_locs
34            extract_seq
35            limit_labels
36            taxonomic_groups
37            taxonomic_groups_and_children
38    );
39    
40    my(%util_funcs);
41    
42    grep({$util_funcs{$_}++} @util_funcs);
43    
44    use strict;
45    
46    no strict 'refs';
47    
48  use FIG;  use FIG;
49    
50    
51  require XMLRPC::Transport::HTTP;  require XMLRPC::Transport::HTTP;
52  require XMLRPC::Lite;  require XMLRPC::Lite;
53  use IO::Select;  use IO::Select;
# Line 19  Line 57 
57                                                    ReuseAddr => 1);                                                    ReuseAddr => 1);
58  my $fig = new FIG;  my $fig = new FIG;
59    
60  @d = ();  my @d = ();
61  for my $name (keys(%FIG::))  
62    sub wrap_util
63  {  {
64      next if $name !~ /^[a-zA-Z]/;      my($name) = @_;
     next if $name eq "new";  
65    
66      my $glob = $FIG::{$name};      my $sub = sub {
67            shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
68            print "Args: ", map { "<$_>\n" } @_ , "\n";
69            print "name $name\n";
70            my @ret = eval " &FIG::$name(\@_);";
71            print "Ret: @ret\n";
72            return map { ref($_) ? $_ : XMLRPC::Data->type("string", $_) } @ret;
73    
74      next unless defined(&$glob);      };
 #    print "$name $glob\n";  
75    
76      my $methName = $name;      return $sub;
77  #    my $methName = "XMLPKG::$name";  }
78      *$methName = sub {  
79    sub wrap_method
80    {
81        my($name, $fig) = @_;
82        my $sub = sub {
83          shift if UNIVERSAL::isa($_[0] => __PACKAGE__);          shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
84          print "Args: ", map { "<$_>\n" } @_ , "\n";          print "Args: ", map { "<$_>\n" } @_ , "\n";
85          print "name $name\n";          print "name $name\n";
# Line 42  Line 89 
89    
90      };      };
91    
92        return $sub;
93    }
94    
95    for my $name (keys(%FIG::))
96    {
97        next if $name !~ /^[a-zA-Z]/;
98        next if $name eq "new";
99    
100        my $glob = $FIG::{$name};
101    
102        next unless defined(&$glob);
103    
104        my $methName = $name;
105    
106        if ($util_funcs{$name})
107        {
108            *$methName = wrap_util($name);
109        }
110        else
111        {
112            *$methName = wrap_method($name, $fig);
113        }
114    
115      push(@d, $methName);      push(@d, $methName);
116  }  }
117  $server->dispatch_to(@d);  $server->dispatch_to(@d);
# Line 52  Line 122 
122    
123  # $server->handle;  # $server->handle;
124    
125  $s = $server->new();  my $s = $server->new();
126  $sel = IO::Select->new();  my $sel = IO::Select->new();
127  $sel->add($s->{_daemon});  $sel->add($s->{_daemon});
128  my $stdin = \*STDIN;  my $stdin = \*STDIN;
129  $sel->add($stdin);  $sel->add($stdin);
130  while (1)  while (1)
131  {  {
132      @ready = $sel->can_read();      my @ready = $sel->can_read();
133      for my $fh (@ready)      for my $fh (@ready)
134      {      {
135          if ($fh == $s->{_daemon})          if ($fh == $s->{_daemon})
# Line 74  Line 144 
144          }          }
145          elsif ($fh == $stdin)          elsif ($fh == $stdin)
146          {          {
147                my $buf;
148              my $n = sysread($stdin, $buf, 1);              my $n = sysread($stdin, $buf, 1);
149              if ($n == 0)              if ($n == 0)
150              {              {

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3