[Bio] / FigWebServices / subsystem_server.cgi Repository:
ViewVC logotype

View of /FigWebServices/subsystem_server.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (download) (annotate)
Mon May 18 17:01:10 2009 UTC (10 years, 8 months ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, myrast_rel40, mgrast_dev_05262011, mgrast_dev_04082011, rast_rel_2010_0928, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_06072011, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, rast_rel_2011_0119, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, mgrast_dev_04012011, rast_rel_2009_07_09, rast_rel_2010_0827, myrast_33, rast_rel_2011_0928, mgrast_dev_04052011, mgrast_dev_02222011, mgrast_dev_10262011
Changes since 1.7: +6 -2 lines
make durable in the face of missing FCGI

use strict;
use FIG;
my $have_fcgi;
eval {
    require CGI::Fast;
    $have_fcgi = 1;
};
use CGI;
use Subsystem;
use YAML;

my $fig = new FIG;

#
# If no CGI vars, assume we are invoked as a fastcgi service.
#
if ($have_fcgi && $ENV{REQUEST_METHOD} eq '')
{
    #
    # Make mysql autoreconnect.
    #
    if ($FIG_Config::dbms eq 'mysql')
    {
	my $dbh = $fig->db_handle()->{_dbh};
	$dbh->{mysql_auto_reconnect} = 1;
    }

    while (my $cgi = new CGI::Fast())
    {
	eval {
	    &process_request($cgi);
	};
	if ($@)
	{
	    if (ref($@) ne 'ARRAY')
	    {
		warn "code died, returning error\n";
		print $cgi->header(-status => '500 error in body of cgi processing');
		print $@;
	    }
	}
    }
    print STDERR "Clean shutdown\n";
}
else
{
    my $cgi = new CGI();
    print $cgi->header();
    &process_request($cgi);
}

exit;

sub process_request
{
    my($cgi) = @_;
    
    my $function = $cgi->param('function');
    $function or myerror($cgi, "500 missing argument", "subsystem server missing function argument");
    
    
    if ($function eq "is_in_subsystem") {
	print $cgi->header();
	my $ids = &YAML::Load($cgi->param('args'));
        $ids or myerror($cgi, "500 missing id", "subsystem server missing id argument");
	my $result = [];
        foreach my $fid (@$ids) {
	    my @hits = grep { $_ =~ /^fig/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
	    my @subsystems = $fig->subsystems_for_peg($fid);
	    my $function = $fig->function_of($fid);
	    for my $pair (@subsystems) {
		my @h = @hits;
		# The subsystem tuple contains a subsystem name and a role.
		my ($subsysName, $role) = @{$pair};
		push (@$result, [$fid, \@h, $function, $role, $subsysName]);
	    }
	}
	print &YAML::Dump($result);
	
    } elsif ($function eq "is_in_subsystem_with") {
	print $cgi->header();
	my $ids = &YAML::Load($cgi->param('args'));
        $ids or myerror($cgi, "500 missing id", "subsystem server missing id argument");
	my $result = [];
        foreach my $fid (@$ids) {
	    my $function = $fig->function_of($fid);
	    my @subsystems = $fig->subsystems_for_peg($fid);
	    my $genome = $fig->genome_of($fid);
	    for my $pair (@subsystems) {
		my $cells = [];
		# The subsystem tuple contains a subsystem name and a role.
		my ($subsysName, $role) = @{$pair};
		my $sub = Subsystem->new($subsysName, $fig);
		my $idx = $sub->get_genome_index($genome);
		my $row = $sub->get_row($idx);
		my $variant = $sub->get_variant_code();
		my $col = 0;
		foreach my $cell (@$row) {
		    my $role = $sub->get_role($col++);
		    foreach my $peg (@$cell) {
			push (@$cells, [$peg, scalar($fig->function_of($peg)), $role]);
			
		    }
		}
		push (@$result, [$subsysName, $variant, $fid, $fid, $cells]);
	    }
	}
	print &YAML::Dump($result);
	
    } elsif  ($function eq "all_subsystems") {
	print $cgi->header();
#	print &YAML::Dump($fig->all_subsystems_with_roles());
	my @names = $fig->all_usable_subsystems();
	my $result = [];
	foreach my $subsysName (@names) {
                         my $sub = Subsystem->new($subsysName, $fig);
			 my @roles = $sub->get_roles();
	
			#print "$subsysName\t", join("\t", @roles), "\n";
	 		 #print &YAML::Dump([$subsysName, \@roles]);
	 		 push (@$result, [$subsysName, \@roles]);
	}
	print &YAML::Dump($result);
		
    } elsif ($function eq "subsystem_spreadsheet") {
	print $cgi->header();
	my $names = &YAML::Load($cgi->param('args'));
        $names or myerror($cgi, "500 missing id", "subsystem server missing id argument");
	my $result = [];
	foreach my $subsysName (@$names) {
	    my $cells = [];
	    my $sub = Subsystem->new($subsysName, $fig);
	    my $variant = $sub->get_variant_code();
	    my @genomes = $fig->subsystem_genomes();
	    foreach my $genome (@genomes) {
		my $idx = $sub->get_genome_index($genome);
		my $row = $sub->get_row($idx);
		foreach my $cell (@$row) {
		    foreach my $peg (@$cell) {
			push (@$cells, [$peg,scalar($fig->function_of($peg))]); 
		    }
		}
	    }
	    push (@$result, [$subsysName, $variant, $cells]);
	}
	print &YAML::Dump($result);
	
    } else {
	myerror($cgi, "500 bad function argument $function", "usage:subsystem_server function=[is-in-subsystem | is-in-subsystem-with | all-subsystems | subsystem-spreadsheet");
    }
}    


sub myerror
{
    my($cgi, $stat, $msg) = @_;
    print $cgi->header(-status =>  $stat);
    
    print "$msg\n";
    die ['cgi error returned'];
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3