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

View of /FigKernelPackages/ServerThing.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (download) (as text) (annotate)
Mon Aug 3 21:31:42 2009 UTC (10 years, 7 months ago) by parrello
Branch: MAIN
Changes since 1.2: +11 -1 lines
Updated to Sapling Server for Berkeley.

#!/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.

=cut

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();
        # Check for a source parameter. This gets used as the tracing key.
        $key = $cgi->param('source');
        if (! $key) {
            # No source parameter, so do normal setup.
            ETracing($cgi);
        } else {
            # Set up tracing using the specified key.
            ETracing($key);
            # Trace the CGI parameters.
            Tracer::TraceParms($cgi);
        }
    } 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.
        ETracing($key);
        # Trace the CGI parameters.
        Tracer::TraceParms($cgi);
    }
    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);
    # Insure the function name is valid.
    Die("Invalid function name.")
        if $function =~ /\W/;
    # 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/plain');
    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.

=back

=cut

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;
}


1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3