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

Diff of /FigKernelPackages/SAPserver.pm

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

revision 1.1, Tue Jun 16 16:37:23 2009 UTC revision 1.9, Tue Nov 3 21:20:07 2009 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #
2    #       This is a SAS Component.
3  #  #
4  # Copyright (c) 2003-2006 University of Chicago and Fellowship  # Copyright (c) 2003-2006 University of Chicago and Fellowship
5  # for Interpretations of Genomes. All Rights Reserved.  # for Interpretations of Genomes. All Rights Reserved.
# Line 20  Line 20 
20  package SAPserver;  package SAPserver;
21    
22      use strict;      use strict;
23      use Tracer;      use base qw(ClientThing);
     use LWP::UserAgent;  
     use YAML;  
24    
25  =head1 Sapling Server Helper Object  =head1 Sapling Server Helper Object
26    
27  =head2 Introduction  =head2 Description
28    
29  This module is used to call the sapling server, which is a general-purpose  This module is used to call the sapling server, which is a general-purpose
30  server for extracting data from the Sapling database. Each Sapling server  server for extracting data from the Sapling database. Each Sapling server
31  function correspond to a method of this object.  function corresponds to a method of this object. In other words, all
32    L<SAP/Primary Methods> are also methods here.
 The fields in this object are as follows.  
   
 =over 4  
   
 =item server_url  
   
 The URL used to request data from the sapling server.  
   
 =item ua  
   
 The user agent for communication with the server.  
   
 =back  
33    
34  =cut  =cut
35    
# Line 61  Line 46 
46  URL for the sapling server. This option may be used to redirect requests to a  URL for the sapling server. This option may be used to redirect requests to a
47  test version of the server, or to an older server script.  test version of the server, or to an older server script.
48    
49    =item singleton
50    
51    If TRUE, results from methods will be returned in singleton mode. In singleton
52    mode, if a single result comes back, it will come back as a scalar rather than
53    as a hash value accessible via an incoming ID.
54    
55  =back  =back
56    
57  =cut  =cut
# Line 68  Line 59 
59  sub new {  sub new {
60      # Get the parameters.      # Get the parameters.
61      my ($class, %options) = @_;      my ($class, %options) = @_;
62      # Get the options.      # Compute the URL.
63      my $url = $options{url} || "http://servers.nmpdr.org/sap/server.cgi";      $options{url} = 'http://servers.nmpdr.org/sapling/server.cgi' if ! defined $options{url};
64      # Create the fields of the object.      # Construct the subclass.
65      my $server_url = $url;      return $class->SUPER::new(SAP => %options);
     my $ua = LWP::UserAgent->new();  
     # Create the SAPserver object.  
     my $retVal = {  
                     server_url => $server_url,  
                     ua => $ua,  
                  };  
     # Bless and return it.  
     bless $retVal, $class;  
     return $retVal;  
66  }  }
67    
 =head2 Public Methods  
   
 =head3 AUTOLOAD  
   
     my $result = $ss->method(%args);  
   
 Call a function on the server. Any method call on this object (other than  
 the constructor) is translated into a request against the server. This  
 enables us to add new server functions without requiring an update to this  
 module. The parameters are specified as a hash, and the result is a scalar  
 or object reference. If an error occurred, we will confess.  
   
 =cut  
   
 # This variable will contain the method name.  
 our $AUTOLOAD;  
   
 sub AUTOLOAD {  
     # Get the parameters.  
     my ($self, %args) = @_;  
     # Declare the return variable.  
     my $retVal;  
     # Get the method name.  
     my $function = $AUTOLOAD;  
     $function =~ s/.+:://;  
     # Compute the argument document.  
     my $argString = YAML::Dump(\%args);  
     # Get our user agent.  
     my $ua = $self->{ua};  
     # Request the function from the server.  
     my $response = $ua->post($self->{server_url},  
                              [function => $function, args => $argString]);  
     # Get the response content.  
     my $content = $response->content;  
     if (! $response->is_success) {  
         Confess("Server error " . $response->status_line . "\n$content");  
     } else {  
         Trace("YAML document is\n$content.") if T(3);  
         $retVal = YAML::Load($content);  
         # Figure out what we got back.  
         Trace("Checking for an error document.") if T(3);  
         my $returnType = ref $retVal;  
         if ($returnType && $returnType eq 'ErrorDocument') {  
             Confess($retVal->{message});  
         }  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 DESTROY  
   
     $ss->DESTROY();  
   
 This method has no function. It's purpose is to keep the destructor from  
 being caught by the autoload processing.  
   
 =cut  
   
 sub DESTROY { }  
   
68    
69  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3