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

View of /FigWebServices/subsystem_server_sapling.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (annotate)
Mon Jun 22 19:48:14 2009 UTC (10 years, 11 months ago) by disz
Branch: MAIN
Changes since 1.1: +4 -4 lines
Changed to pass identifiers back

use strict;
use Data::Dumper;
use FIG;
use CGI::Fast;
use CGI;
use Sapling;
use SaplingSubsys;
use YAML;
use ERDB;

my $fig = new FIG;
my $sapling = ERDB::GetDatabase('Sapling');


#
# If no CGI vars, assume we are invoked as a fastcgi service.
#
if ($ENV{REQUEST_METHOD} eq '')
{
    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 $@;
	    }
	}
    }
}
else
{
    my $cgi = new CGI();
    print $cgi->header();
    &process_request($cgi);
}

exit;

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

my $i = 0;
    my $result = [];
    my $function = $cgi->param('function');
    $function or myerror($cgi, "500 missing argument", "subsystem server missing function argument");
    
    
    if ($function eq "is_in_subsystem") {
	my $ids = &YAML::Load($cgi->param('args'));
        $ids or myerror($cgi, "500 missing id", "subsystem server missing id argument");
        foreach my $fid (@$ids) {
		my @resultRows = $sapling->GetAll("Subsystem Includes  Role IsRoleOf MachineRole Contains Feature", 
                                      'Feature(id) = ?', [$fid], 
                                      [qw(Subsystem(id) Role(id) Feature(id))]);
		push (@$result, \@resultRows);
	}
	print $cgi->header();
	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) {
		# if this is not a fig id, look up the fig id equivalent
		my @resultRows = $sapling->GetAll("Feature IsContainedIn MachineRole IsRoleFor MolecularMachine Implements Variant IsDescribedBy Subsystem AND MolecularMachine IsMachineOf MachineRole2 Contains Feature2 AND MachineRole2 HasRole Role", 
                                      'Feature(id) = ? ', 
                                      [$fid], [qw(Subsystem(id) 
                                      Variant(id) Feature(id) Feature2(id) Feature2(function) Role(id))]);
		push (@$result, \@resultRows);
	}
	print &YAML::Dump($result);
	
    } elsif  ($function eq "all_subsystems") {
	print $cgi->header();

	my @resultRows = $sapling->GetAll("Subsystem Includes Role", 
                                      'ORDER BY Subsystem(id)', [], [qw(Subsystem(id) Subsystem(curator) 
                                      Role(id))]);
	print &YAML::Dump(\@resultRows);

    } 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 @resultRows = $sapling->GetAll("Subsystem Describes Variant IsImplementedBy MolecularMachine IsMachineOf MachineRole Contains Feature AND MachineRole HasRole Role", 
                                      'Subsystem(id) = ? ORDER BY Feature(id)', 
                                      [$subsysName], [qw(Subsystem(id) Variant(id) 
                                      Feature(id) Feature(function) Role(id))]);
		push (@$result, \@resultRows);
	}
	print &YAML::Dump($result);
	
    } elsif ($function eq "metabolic_reconstruction") {

	#print $cgi->header();
	my %big;
	my $id_display = 1;
	my $result = [];

	my @id_roles = &YAML::Load($cgi->param('args'));
	#map {push(@{$big{$_}}, 1)} @id_roles;
	#map {push(@{$big{$_->[0]}}, 1)} @id_roles;
	map {push(@{$big{$_->[0]}}, $_->[1])} @id_roles;
	my @resultRows = $sapling->GetFlat("Subsystem", '', [], 'Subsystem(id)');
	foreach my $sub (@resultRows) {
		my %ss_roles;
		my $ss = SaplingSubsys->new($sub, $sapling);
		if ($ss) {
			foreach my $role ($ss->get_roles) {
				$ss_roles{$role} = $ss->get_abbr_for_role($role);
			}
		} else {
			die "bad subsys\n";
		}
		my @abbr = map{$ss_roles{$_}} grep { $big{$_}} keys %ss_roles;
		my $set =  join(" ",  @abbr);
		if (@abbr > 0) {
			my ($variant, $size) = get_max_subset($sub, $set);
			if ($variant) {
				foreach my $role ($ss->get_roles()) {
					if ($id_display) {
						foreach my $id (@{$big{$role}}) {
							push (@$result, [$variant, $role, $id]);
						}
					} else {
						push (@$result, [$variant, $role]);
					}
				}
			}
		}

#if ($i++ > 10) {
    #print &YAML::Dump($result);
	#exit;
#}
	
	}
    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 get_max_subset {
        my ($sub, $setA) = @_;
        my $max_size = 0;
        my $max_set;
        my $max_variant;
        my %set_hash;
        my $qh = $sapling->Get("Subsystem Describes Variant", 'Subsystem(id) = ? AND Variant(type) = ?', [$sub, 'normal']);
        while (my $resultRow = $qh->Fetch()) {
            my @variantRoleRule = $resultRow->Value('Variant(role-rule)');
            my $variantCode = $resultRow->Value('Variant(code)');
            my $variantId = $sub.":".$variantCode;
            foreach my $setB (@variantRoleRule) {
                        my $size = is_A_a_superset_of_B($setA, $setB);
                        if ($size  && $size > $max_size) {
                                $max_size = $size;
                                $max_set = $setB;
                                $max_variant = $variantId;
                        }
            }
        }
        #if ($max_size) {
                #print STDERR "Success $max_variant, $max_set\n";
        #}
        return($max_variant, $max_size);
}



sub is_A_a_superset_of_B {
        my ($a, $b) = @_;
        my @a = split(" ", $a);
        my @b = split(" ", $b);
        if (@b > @a) {
                return(0);
        }
        my %given;
        map { $given{$_} = 1} @a;
        map { if (! $given{$_}) {return 0}} split(" ", $b);
        my $l = scalar(@b);
        return scalar(@b);
}


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