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

View of /FigKernelPackages/ServerThing.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.8 - (download) (as text) (annotate)
Wed Sep 30 15:34:28 2009 UTC (10 years, 6 months ago) by parrello
Branch: MAIN
Changes since 1.7: +82 -1 lines
Moved DocUtils so that it is only included if needed.

#!/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 three
parameters: the name of the server package (e.g. C<SAP> for B<SAP.pm>),
the first command-line parameter, and the URL prefix to use for the documentation.
The command-line parameter (if defined) will be used as the tracing key, and is
used to indicate that the script is being invoked from the command line rather
than over the web.


sub RunServer {
    # Get the parameters.
    my ($serverName, $key, $docURL) = @_;
    # Get the CGI parameters.
    my $cgi;
    if (! defined $key) {
        # No tracing key, so presume we're a web service. Check for Fast CGI.
        if ($ENV{REQUEST_METHOD} eq '') {
            # Here we're doing Fast CGI. In this case, the tracing key is the
            # server name.
            # Loop through the fast CGI requests.
            require CGI::Fast;
            while ($cgi = new CGI::Fast()) {
                RunRequest($cgi, $serverName, $docURL);
        } else {
            # Here we have a normal web service (non-Fast).
            my $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. Note we turn off
                # CGI parameter tracing.
                ETracing($cgi, 'noParms');
            } else {
                # Set up tracing using the specified key.
            # Run this request.
            RunRequest($cgi, $serverName, $docURL);
    } 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.
        # Run this request.
        RunRequest($cgi, $serverName, $docURL);

=head3 RunRequest

    ServerThing::RunRequest($cgi, $serverName, $docURL);

Run a request from the specified server using the incoming CGI parameter
object for the parameters.

=over 4

=item cgi

CGI query object containing the parameters from the web service request.

=item serverName

Name of the server to be used for running the request.

=item docURL

URL to be used for a documentation request.



sub RunRequest {
    # Get the parameters.
    my ($cgi, $serverName, $docURL) = @_;
    Trace("Running $serverName server request.") if T(3);
    # Is this a documentation request?
    my $module = $cgi->param('pod');
    if ($module) {
        # Here we have a documentation request. In this case, we produce POD HTML.
        # Start the output page.
        print CGI::header();
        print CGI::start_html(-title => 'Documentation Page',
                              -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
        # Protect from errors.
        eval {
            # We'll format the HTML text in here.
            require DocUtils;
            my $html = DocUtils::ShowPod($module, $docURL);
            # Output the POD HTML.
            print $html;
        # Process any error.
        if ($@) {
            print CGI::blockquote({ class => 'error' }, $@);
        # Close off the page.
        print CGI::end_html();
    } else {
        # Here we have a function request. 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 loading 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.



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;

=head3 RunTool

    ServerThing::RunTool($name => $cmd);

Run a command-line tool. A non-zero return value from the tool will cause
a fatal error, and the tool's error log will be traced.

=over 4

=item name

Name to give to the tool in the error output.

=item cmd

Command to use for running the tool. This should be the complete command line.
The command should not contain any fancy piping, though it may redirect the
standard input and output. The command will be modified by this method to
redirect the error output to a temporary file.



sub RunTool {
    # Get the parameters.
    my ($name, $cmd) = @_;
    # Compute the log file name.
    my $errorLog = "$FIG_Config::temp/errors$$.log";
    # Execute the command.
    Trace("Executing command: $cmd") if T(3);
    my $res = system("$cmd 2> $errorLog");
    Trace("Return from $name tool is $res.") if T(3);
    # Check the result code.
    if ($res != 0) {
        # We have an error. If tracing is on, trace it.
        if (T(1)) {
            TraceErrorLog($name, $errorLog);
        # Delete the error log.
        unlink $errorLog;
        # Confess the error.
        Confess("500 $name command failed with error code $res.");
    } else {
        # Everything worked. Trace the error log if necessary.
        if (T(3) && -s $errorLog) {
            TraceErrorLog($name, $errorLog);
        # Delete the error log if there is one.
        unlink $errorLog;

=head3 TraceErrorLog

    ServerThing::TraceErrorLog($name, $errorLog);

Trace the specified error log file. This is a very dinky routine that
performs a task required by L</RunTool> in multiple places.

=over 4

=item name

Name of the tool relevant to the log file.

=item errorLog

Name of the log file.



sub TraceErrorLog {
    my ($name, $errorLog) = @_;
    my $errorData = Tracer::GetFile($errorLog);
    Trace("$name error log:\n$errorData");


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3