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

View of /FigWebServices/pchs.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (annotate)
Wed Feb 20 19:08:28 2008 UTC (11 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, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, 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, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, 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, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.3: +48 -12 lines
put the other batch coupling code in.

#!/usr/bin/perl
use strict;
use DBI;
use CGI;

#
# PCH server code.
# Keep this free of FIG references - it is intended to be run from mod_perl where
# we likely don't have a full SEED environment.
#

our $fig = "/disks/space0/vol/dserv/SimServer/FIGdisk";
#our $fig = "/Volumes/raid2/FIGdisk.anno_v5";
our $dbms            = "mysql";
our $db              = "sim_server";
our $dbuser          = "sim_server";
our $dbpass          = "";
our $dbport          = 3306;
our $dbsock = "/var/lib/mysql/mysql.sock";

#
# bio* setup
#

#$fig = "/vol/seed-anno-mirror";
#$db = "fig_anno_v5";
#$dbuser = "seed";
#$dbhost = "biosql.mcs.anl.gov";
#undef $dbsock;

our $data = "$fig/FIG/Data";

my $dbh;

#$dbh = DBI->connect("DBI:mysql:dbname=$db;host=$dbhost;port=$dbport", $dbuser, $dbpass);
$dbh = DBI->connect("DBI:mysql:dbname=$db;mysql_socket=$dbsock", $dbuser, $dbpass);

$dbh or die "Could not open database: " . DBI->errstr;

my $cgi = new CGI;

my $func = $cgi->param('function');

if ($func eq 'coupled_to')
{
    my $id = $cgi->param('id1');
    $id or myerror($cgi, "500 missing id", "coupled_to missing id1 argument");
    do_coupled_to($cgi, $dbh, $id);
}
elsif ($func eq 'coupled_to_batch')
{
    my @id = $cgi->param('id1');
    @id or myerror($cgi, "500 missing id", "coupled_to missing id1 argument");
    do_coupled_to_batch($cgi, $dbh, \@id);
}
elsif ($func eq 'coupling_evidence')
{
    my $id1 = $cgi->param('id1');
    my $id2 = $cgi->param('id2');
    $id1 ne '' or myerror($cgi, "500 missing id1", "coupling_evidence missing id1 argument");
    $id2 ne '' or myerror($cgi, "500 missing id2", "coupling_evidence missing id2 argument");
    do_coupling_evidence($cgi, $dbh, $id1, $id2);
}
elsif ($func eq 'coupling_and_evidence')
{
    my $id = $cgi->param('id1');
    $id ne '' or myerror($cgi, "500 missing id", "coupling_and_evidence missing id1 argument");
    do_coupling_and_evidence($cgi, $dbh, $id);
}
elsif ($func eq 'coupling_and_evidence_batch')
{
    my @id_list = $cgi->param('id1');
    @id_list > 0 or myerror($cgi, "500 missing id", "coupling_and_evidence missing id1 argument");
    do_coupling_and_evidence_batch($cgi, $dbh, \@id_list);
}
elsif ($func eq 'in_pch_pin_with_and_evidence')
{
    my $id = $cgi->param('id1');
    $id ne '' or myerror($cgi, "500 missing id", "in_pch_pin_with_and_evidence missing id1 argument");
    do_in_pch_pin_with_and_evidence($cgi, $dbh, $id);
}
else
{
    myerror($cgi, "500 invalid function", "missing or invalid function");
}
exit;

sub do_coupled_to
{
    my($cgi, $dbh, $id) = @_;

    my $sth = $dbh->prepare(qq(SELECT peg2, score
			       FROM fc_pegs
			       WHERE peg1 = ?));
    $sth->execute($id);

    print $cgi->header('text/plain');
    
    while (my $row = $sth->fetchrow_arrayref())
    {
	#print STDERR join("\t", @$row), "\n";
	print join("\t", @$row), "\n";
    }
}

sub do_coupled_to_batch
{
    my($cgi, $dbh, $id_list) = @_;

    return unless @$id_list;
    my $cond = join(", ", map { "'$_'" } @$id_list);
    my $sth = $dbh->prepare(qq(SELECT peg1, peg2, score
			       FROM fc_pegs
			       WHERE peg1 in ($cond)));
    $sth->execute();

    print $cgi->header('text/plain');
    
    while (my $row = $sth->fetchrow_arrayref())
    {
	print join("\t", @$row), "\n";
    }
}

sub do_coupling_evidence
{
    my($cgi, $dbh, $id1, $id2) = @_;

    my $sth = $dbh->prepare(qq(SELECT peg3, peg4, rep
			       FROM pchs
			       WHERE peg1 = ? AND peg2 = ?));
    $sth->execute($id1, $id2);

    print $cgi->header('text/plain');
    
    while (my $row = $sth->fetchrow_arrayref())
    {
	#print STDERR join("\t", @$row), "\n";
	print join("\t", @$row), "\n";
    }
}

sub do_coupling_and_evidence
{
    my($cgi, $dbh, $id) = @_;

    my $sth = $dbh->prepare(qq(SELECT peg2, score
			       FROM fc_pegs
			       WHERE peg1 = ?));
    my $ev_sth = $dbh->prepare(qq(SELECT peg3, peg4
				  FROM pchs
				  WHERE peg1 = ? AND peg2 = ?));
    $sth->execute($id);

    print $cgi->header('text/plain');
    
    while (my($peg2, $score) = $sth->fetchrow_array())
    {
	#print STDERR "$score\t$peg2\n";
	print "$score\t$peg2";
	$ev_sth->execute($id, $peg2);
	
	while (my $res = $ev_sth->fetchrow_arrayref())
	{
	    print "\t" . join("\t", @$res);
	}
	print "\n";
    }
}

sub do_coupling_and_evidence_batch
{
    my($cgi, $dbh, $id_list) = @_;

    my $cond = join(", ", map { "'$_'" } @$id_list);
    my $sth = $dbh->prepare(qq(SELECT peg1, peg2, score
			       FROM fc_pegs
			       WHERE peg1 in ($cond)));
    my $ev_sth = $dbh->prepare(qq(SELECT peg3, peg4
				  FROM pchs
				  WHERE peg1 = ? AND peg2 = ?));
    $sth->execute();

    print $cgi->header('text/plain');
    
    while (my($peg1, $peg2, $score) = $sth->fetchrow_array())
    {
	#print STDERR "$score\t$peg2\n";
	print "$peg1\t$score\t$peg2";
	$ev_sth->execute($peg1, $peg2);
	
	while (my $res = $ev_sth->fetchrow_arrayref())
	{
	    print "\t" . join("\t", @$res);
	}
	print "\n";
    }
}

sub do_in_pch_pin_with_and_evidence
{
    my($cgi, $dbh, $id) = @_;
    my $sth = $dbh->prepare(qq(SELECT peg3, max(rep)
					  FROM pchs
					  WHERE peg1 = ?
					  GROUP BY peg3));
    $sth->execute($id);
    print $cgi->header('text/plain');
    while (my $r = $sth->fetchrow_arrayref())
    {
	print "$r->[0]\t$r->[1]\n";
    }

}

sub myerror
{
    my($cgi, $stat, $msg) = @_;
    print $cgi->header(-status =>  $stat);
    
    print "$msg\n";
    exit;
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3