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

View of /FigKernelPackages/FIG_CGI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (download) (as text) (annotate)
Mon Dec 5 19:06:30 2005 UTC (14 years, 2 months ago) by olson
Branch: MAIN
CVS Tags: caBIG-05Apr06-00, caBIG-13Feb06-00
Changes since 1.2: +17 -0 lines
Added license words.

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#


#
# FIG CGI script utility module.
#

package FIG_CGI;


use strict;
use FIG;
use FIG_Config;
use CGI;
use Data::Dumper;
use SproutFIG;

use Tracer;

=head3 init

C<< my($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0, debug_load => 0, print_params => 0); >>

Initialize a FIG and CGI object for use in the CGI script. Depending on the 
CGI parameters passed in, the FIG object will be either an actual FIG object
(when we are in SEED mode), or a SFXlate object (when we are in Sprout mode).

=over4
=item debug_save

Set this flag to true if the script should save its parameters to a
file. (Default filename is the name of the script minus the .cgi
suffix, placed in /.tmp).

=item debug_load

Set this flag to true if the script should load its parameters from a
file as saved with debug_save.

=item print_params

Set this flag to true if the script should print its CGI parameters
before exiting.

=back

=cut

sub init
{
    my(%args) = @_;

    my $cgi = new CGI;
    my $fig = init_fig($cgi);

    my $script_name = determine_script_name();
    my $file = "/tmp/${script_name}_parms";

    # warn "fig_cgi init $file\n";

    my $printed_params;
    if ($args{print_params})
    {
	do_print_params($cgi);
	$printed_params++;
    }

    if ($args{debug_save})
    {
	do_print_params($cgi) unless $printed_params;
	print "Wrote params to $file<p>\n";
	$cgi = do_debug_save($cgi, $file);
    }
    elsif ($args{debug_load})
    {
	$cgi = do_debug_load($cgi, $file);
    }

    my $user = $cgi->param('user');


    return($fig, $cgi, $user);
}

sub init_tracing
{
    my($cgi) = @_;
    my $traceData = $cgi->param('trace');
    if ($traceData) {
	TSetup($traceData, "QUEUE");
	$traceData = 1;
    } else {
	TSetup(0, "NONE");
	$traceData = 0;
    }
}

sub init_fig
{
    my($cgi) = @_;

    my $fig;
    if ($cgi->param('SPROUT'))
    {
	$fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
    }
    else
    {
	$fig = new FIG;
    }
    return $fig;
}

sub do_print_params
{
    my($cgi) = @_;
	
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params) {
	print "$_\t:",join(",",$cgi->param($_)),":\n";
    }
    print "</pre>\n";
}

sub do_debug_load
{
    my($cgi, $file) = @_;
    my $VAR1;
    if (-f $file)
    {
	eval(&FIG::file_read($file));
	$cgi = $VAR1;
    }
    else
    {
	print $cgi->header;
	print "Attempting debug load, but file $file does not exist\n";
	die "Attempting debug load, but file $file does not exist\n";
    }

    return $cgi;
}

sub do_debug_save
{
    my($cgi, $file) = @_;

    if (open(TMP,">$file")) {
	print TMP &Dumper($cgi);
	close(TMP);
	# warn "Loaded cgi from $file\n";
    }
    else
    {
	print $cgi->header;
	print "Attempting debug load, but file $file does not exist\n";
	warn "Attempting debug load, but file $file does not exist\n";
    }
    exit;
}

sub determine_script_name
{
    my $path = $ENV{SCRIPT_NAME};
    my $name;
    
    if ($path eq '')
    {
	#
	# We're probably being invoked from the command line.
	#

	$path = $0;
    }

    if ($path =~ m,/([^/]+)$,)
    {
	$name = $1;
    }
    else
    {
	$name = $path;
	$name =~ s,/,_,g;
    }
    $name =~ s/\.cgi$//;
    return $name;
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3