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

View of /FigKernelPackages/ServerThing.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.1 - (download) (as text) (annotate)
Tue Jun 16 16:37:23 2009 UTC (10 years, 9 months ago) by parrello
Branch: MAIN
New Sapling server support.

#!/usr/bin/perl -w

package ServerThing;

    use strict;
    use Tracer;
    use YAML;
    use ERDB;
    use TestUtils;
    use Time::HiRes;
    use ErrorDocument;
    use CGI;

=head1 General Server Helper

This package provides a method-- I<RunServer>-- that can be called from a CGI
script to perform the duties of a FIG server. RunServer is called with two
parameters: the name of the server package (e.g. C<SAP> for B<Sap.pm>) and
the first command-line parameter. This last is only used when the server
script is being invoked from the debugging console.


sub RunServer {
    # Get the parameters.
    my ($serverName, $key) = @_;
    # Get the CGI parameters.
    my $cgi;
    if (! $key) {
        # No tracing key, so presume we're a web service.
        $cgi = CGI->new();
    } else {
        # We're being invoked from the command line. Use the tracing
        # key to find the parm file and create the CGI object from that.
        my $ih = Open(undef, "<$FIG_Config::temp/$key.parms");
        $cgi = CGI->new($ih);
        # Set up tracing using the specified key.
        # Trace the CGI parameters.
    Trace("Running $serverName server request.") if T(3);
    # Get the function name.
    my $function = $cgi->param('function') || "";
    Trace("Server function is $function.") if T(3);
    # The parameter structure will go in here.
    my $args;
    # Start the timer.
    my $start = time();
    # The output document goes in here.
    my $document;
    # The sapling database goes in here.
    my $sapling;
    # Protect from errors.
    eval {
        # Parse the arguments.
        $args = YAML::Load($cgi->param('args'));
    # Check to make sure we got everything.
    if ($@) {
        $document = ErrorDocument->new('<initialization>', $@);
    } elsif (! $function) {
        $document = ErrorDocument->new('<missing>', "No function specified.");
    } else {
        # We're okay, so load the server function object.
        Trace("Requiring $serverName") if T(3);
        eval {
            require "$serverName.pm";
        # If we have an error, create an error document.
        if ($@) {
            $document = ErrorDocument->new($function, $@);
            Trace("Error loadin server module: $@") if T(2);
        } else {
            # Having successfully loaded the server code, we create the object.
            my $serverThing = eval("$serverName" . '->new()');
            # If we have an error, create an error document.
            if ($@) {
                $document = ErrorDocument->new($function, $@);
                Trace("Error creating server function object: $@") if T(2);
            } else {
                # No error, so execute the server method.
                Trace("Executing $function.") if T(2);
                $document = eval("\$serverThing->$function(\$args)");
                # If we have an error, create an error document.
                if ($@) {
                    $document = ErrorDocument->new($function, $@);
                    Trace("Error encountered by service: $@") if T(2);
    # Stop the timer.
    my $duration = int(time() - $start + 0.5);
    Trace("Function executed in $duration seconds.") if T(2);
    # Output the YAML.
    print $cgi->header(-type => 'text/yaml');
    print YAML::Dump($document);

=head2 Utility Methods

The methods in this section are utilities of general use to the various
server modules.

=head3 GetIdList

    my $ids = ServerThing::GetIdList($name => $args);

Get a named list of IDs from an argument structure. If the IDs are
missing, or are not a list, an error will occur.

=over 4

=item name

Name of the argument structure member that should contain the ID list.

=item args

Argument structure from which the ID list is to be extracted.

=item RETURN

Returns a reference to a list of IDs taken from the argument structure.



sub GetIdList {
    # Get the parameters.
    my ($name, $args) = @_;
    # Try to get the IDs from the argument structure.
    my $retVal = $args->{$name};
    # Throw an error if no member was found.
    Confess("No '$name' parameter found.") if ! defined $retVal;
    # Get the parameter type. We was a list reference. If it's a scalar, we'll
    # convert it to a singleton list. If it's anything else, it's an error.
    my $type = ref $retVal;
    if (! $type) {
        $retVal = [$retVal];
    } elsif ($type ne 'ARRAY') {
        Confess("The '$name' parameter must be a list.");
    # Return the result.
    return $retVal;


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3