[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.1 - (view) (download) (as text)

1 : olson 1.1 #
2 :     # XMLRPC server to provide network access to FIG routines.
3 :     #
4 :     # We create a single FIG instance to use for all calls.
5 :     #
6 :     # This is originally intended for the support of the Python interface.
7 :     #
8 :    
9 :     package main;
10 :    
11 :     use FIG;
12 :    
13 :     require XMLRPC::Transport::HTTP;
14 :     require XMLRPC::Lite;
15 :     use IO::Select;
16 :     use IO::Handle;
17 :    
18 :     my $server = XMLRPC::Transport::HTTP::Daemon->new(LocalAddr =>"127.0.0.1",
19 :     ReuseAddr => 1);
20 :     my $fig = new FIG;
21 :    
22 :     @d = ();
23 :     for my $name (keys(%FIG::))
24 :     {
25 :     next if $name !~ /^[a-zA-Z]/;
26 :     next if $name eq "new";
27 :    
28 :     my $glob = $FIG::{$name};
29 :    
30 :     next unless defined(&$glob);
31 :     # print "$name $glob\n";
32 :    
33 :     my $methName = $name;
34 :     # my $methName = "XMLPKG::$name";
35 :     *$methName = sub {
36 :     shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
37 :     print "Args: ", map { "<$_>\n" } @_ , "\n";
38 :     print "name $name\n";
39 :     my @ret = $fig->$name(@_);
40 :     print "Ret: @ret\n";
41 :     return map { ref($_) ? $_ : XMLRPC::Data->type("string", $_) } @ret;
42 :    
43 :     };
44 :    
45 :     push(@d, $methName);
46 :     }
47 :     $server->dispatch_to(@d);
48 :     #$server->dispatch_to('XMLPKG');
49 :    
50 :     print $server->url, "\n";
51 :     STDOUT->autoflush();
52 :    
53 :     # $server->handle;
54 :    
55 :     $s = $server->new();
56 :     $sel = IO::Select->new();
57 :     $sel->add($s->{_daemon});
58 :     my $stdin = \*STDIN;
59 :     $sel->add($stdin);
60 :     while (1)
61 :     {
62 :     @ready = $sel->can_read();
63 :     for my $fh (@ready)
64 :     {
65 :     if ($fh == $s->{_daemon})
66 :     {
67 :     my $c = $s->accept;
68 :     while (my $r = $c->get_request)
69 :     {
70 :     $s->request($r);
71 :     $s->SOAP::Transport::HTTP::Server::handle;
72 :     $c->send_response($s->response);
73 :     }
74 :     }
75 :     elsif ($fh == $stdin)
76 :     {
77 :     my $n = sysread($stdin, $buf, 1);
78 :     if ($n == 0)
79 :     {
80 :     print "Exiting due to closed stdin\n";
81 :     $sel->remove($stdin);
82 :     #exit;
83 :     }
84 :     }
85 :     }
86 :     }
87 :    
88 :    
89 :    
90 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3