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

View of /FigKernelPackages/ServerThing.pm

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.6 - (download) (as text) (annotate)
Thu Aug 27 19:44:45 2009 UTC (10 years, 7 months ago) by parrello
Branch: MAIN
Changes since 1.5: +60 -15 lines
Converted to handle Fast CGI requests.

#!/usr/bin/perl -w

package ServerThing;

    use strict;
    use Tracer;
    use YAML;
    use ERDB;
    use TestUtils;
    use DocUtils;
    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 => "$FIG_Config::cgi_url/Html/css/ERDB.css" });
        # Protect from errors.
        eval {
            # We'll format the HTML text in here.
            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;


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3