[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.7, Wed Aug 5 19:45:46 2009 UTC revision 1.8, Tue Sep 8 21:31:32 2009 UTC
# Line 21  Line 21 
21  package SAPserver;  package SAPserver;
22    
23      use strict;      use strict;
     use LWP::UserAgent;  
24      use YAML;      use YAML;
25    
26  =head1 Sapling Server Helper Object  =head1 Sapling Server Helper Object
# Line 41  Line 40 
40    
41  =item server_url  =item server_url
42    
43  The URL used to request data from the sapling server.  The URL used to request data from the sapling server. If C<localhost> is
44    specified, then the L<SAP> module will be called directly.
45    
46  =item ua  =item ua
47    
# Line 86  Line 86 
86      # Get the options.      # Get the options.
87      my $url = $options{url} || "http://servers.nmpdr.org/sapling/server.cgi";      my $url = $options{url} || "http://servers.nmpdr.org/sapling/server.cgi";
88      my $singleton = $options{singleton} || 0;      my $singleton = $options{singleton} || 0;
89      # Create the fields of the object.      # Create the fields of the object. Note that if we're in localhost mode,
90        # the user agent is actually a SAP object.
91      my $server_url = $url;      my $server_url = $url;
92      my $ua = LWP::UserAgent->new();      my $ua;
93        if ($server_url ne 'localhost') {
94            require LWP::UserAgent;
95            $ua = LWP::UserAgent->new();
96        } else {
97            require SAP;
98            $ua = SAP->new();
99        }
100      # Create the SAPserver object.      # Create the SAPserver object.
101      my $retVal = {      my $retVal = {
102                      server_url => $server_url,                      server_url => $server_url,
# Line 134  Line 142 
142      my $function = $AUTOLOAD;      my $function = $AUTOLOAD;
143      # Strip off the stuff before the method name.      # Strip off the stuff before the method name.
144      $function =~ s/.+:://;      $function =~ s/.+:://;
     # Compute the argument document.  
     my $argString = YAML::Dump($args);  
145      # Get our user agent.      # Get our user agent.
146      my $ua = $self->{ua};      my $ua = $self->{ua};
147        # Determine the type.
148        if (ref $ua eq 'LWP::UserAgent') {
149            # Here we're going to a server. Compute the argument document.
150            my $argString = YAML::Dump($args);
151      # Request the function from the server.      # Request the function from the server.
152      my $response = $ua->post($self->{server_url},      my $response = $ua->post($self->{server_url},
153                               [function => $function, args => $argString,                               [function => $function, args => $argString,
# Line 155  Line 165 
165                  # Here an error occurred, so we throw an exception using the                  # Here an error occurred, so we throw an exception using the
166                  # error message.                  # error message.
167                  die $retVal->{message};                  die $retVal->{message};
168              } elsif ($self->{singleton} && $returnType eq 'HASH' &&                  }
169                       scalar(keys %$retVal) <= 1) {              }
170            }
171        } else {
172            # Here we're calling a local method.
173            $retVal = eval("\$ua->$function(\$args)");
174            # Check for an error.
175            if ($@) {
176                die "Package error: $@";
177            }
178        }
179        # We have our result. Adjust for singleton mode.
180        if ($self->{singleton} && ref $retVal eq 'HASH' && scalar(keys %$retVal) <= 1) {
181                  # Here we're in singleton mode and we got a single result,                  # Here we're in singleton mode and we got a single result,
182                  # so we dereference a bit to make it easier for the user                  # so we dereference a bit to make it easier for the user
183                  # to access it.                  # to access it.
184                  ($retVal) = values %$retVal;                  ($retVal) = values %$retVal;
185              }              }
         }  
     }  
186      # Return the result.      # Return the result.
187      return $retVal;      return $retVal;
188  }  }

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3