[Bio] / FigKernelPackages / ACHserver.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/ACHserver.pm

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

revision 1.5, Tue Jun 30 19:02:29 2009 UTC revision 1.16, Thu Dec 17 20:48:21 2009 UTC
# Line 1  Line 1 
1    
2  package ACHserver;  package ACHserver;
3    
 #  
 # This is a SAS Component  
 #  
   
 use LWP::UserAgent;  
 use Data::Dumper;  
 use YAML;  
   
4  use strict;  use strict;
5        use base qw(ClientThing);
6    
7  #  =head1 Annotation Clearinghouse Server Helper Object
 # This is a SAS Component  
 #  
8    
9    =head2 Description
10    
11  sub new  This module is used to call the Annotation Clearinghouse Server, which is a
12  {  special-purpose server for assertion data from the Sapling database. Each
13      my($class, $server_url) = @_;  Annotation Clearinghouse Server function corresponds to a method of this object.
14    
15      $server_url = "http://servers.nmpdr.org/ach/server.cgi" unless $server_url;  This package deliberately uses no internal SEED packages or scripts, only common
16    PERL modules.
17    
18  #    $server_url = "http://bio-macpro-2.mcs.anl.gov/~disz/FIG/ach_server.cgi" unless $server_url;  The fields in this object are as follows.
     #$server_url = "http://bio-macpro-1.mcs.anl.gov/ross-proj/FIG/co_occurs_server.cgi" unless $server_url;  
19    
20      my $self = {  =over 4
         server_url => $server_url,  
         ua => LWP::UserAgent->new(),  
     };  
     return bless $self, $class;  
 }  
21    
22  sub equiv_precise {  =item server_url
         my ($self, @args) = @_;  
         return $self->run_query("equiv_precise", @args);  
 }  
 sub equiv_sequence {  
         my ($self, @args) = @_;  
         return $self->run_query("equiv_sequence", @args);  
 }  
23    
24    The URL used to request data from the subsystem server.
25    
26  sub run_query  =item ua
 {  
     my($self, $function, @args ) = @_;  
   
             my $arg_string = Dump(@args);  
             my $form = [function => $function,  
                         args => "$arg_string"];  
   
             my $res = $self->{ua}->post($self->{server_url}, $form);  
             if ($res->is_success)  
             {  
                 return Load($res->content);  
             }  
             else  
             {  
                 die "error on post " . $res->content;  
             }  
 }  
27    
28  sub run_query_bad  The user agent for communication with the server.
 {  
     my($self, $function, @args ) = @_;  
   
             my $arg_string = Dump(@args);  
             my $form = [function => $function,  
                         args => "$arg_string"];  
   
             my $res = $self->{ua}->post($self->{server_url}, $form);  
             if ($res->is_success)  
             {  
 print Dumper $res;  
                 my $rc;  
                 eval {  
                     $rc = Load($res->content);  
                 };  
                 if ($@)  
                 {  
                     die "Bad YAML parse $@ on input\n" .  $res->content;  
                 }  
             }  
             else  
             {  
                 die "error on post " . $res->status_line . " " . $res->content;  
             }  
 }  
29    
30    =item singleton
31    
32  1;  Indicates whether or not results are to be returned in singleton mode. In
33    singleton mode, if the return document is a hash reference with only one
34    entry, the entry value is returned rather than the hash.
35    
36    =back
37    
38    =cut
39    
40    =head3 new
41    
42        my $ss = ACHserver->new(%options);
43    
44    Construct a new server object. The
45    following options are supported.
46    
47    =over 4
48    
49    =item url
50    
51    URL for the server. This option is required.
52    
53    =item singleton (optional)
54    
55    If TRUE, results from methods will be returned in singleton mode. In singleton
56    mode, if a single result comes back, it will come back as a scalar rather than
57    as a hash value accessible via an incoming ID.
58    
59    =back
60    
61    =cut
62    
63    sub new {
64        # Get the parameters.
65        my ($class, %options) = @_;
66        # Compute the URL.
67        $options{url} = "http://servers.nmpdr.org/ach/server.cgi" if ! $options{url};
68        # Construct the subclass.
69        return $class->SUPER::new(ACH => %options);
70    }
71    
72    1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3