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

View of /FigWebServices/bbhs.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (annotate)
Wed Dec 6 02:03:42 2006 UTC (12 years, 11 months ago) by parrello
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: +7 -6 lines
Changed so that the local datbase is opened if the current HTTP HOST is not a bio server. I'm not sure that's the correct approach.

use strict;
use DBI qw(:sql_types);
use CGI;
my $cgi = new CGI;

#
# BBH 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/dserv/SimServer/FIGdisk";
#our $fig = "/Volumes/raid2/FIGdisk.anno_v5";
our $dbms            = "mysql";
our $db              = "sim_server";
our $dbuser          = "root";
our $dbpass          = "";
our $dbport          = 3306;
our $dbsock = "/tmp/mysql.sock";
our $dbhost;

#
# bio* setup
#
if ($ENV{HTTP_HOST} =~ /bio/) {
    $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;

if ($dbhost ne '')
{
    $dbh = DBI->connect("DBI:mysql:dbname=$db;host=$dbhost;port=$dbport", $dbuser, $dbpass);
}
else
{
    $dbh = DBI->connect("DBI:mysql:dbname=$db;mysql_socket=$dbsock", $dbuser, $dbpass);
}

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



my $cutoff = $cgi->param('cutoff');
if ($cutoff eq '')
{
    $cutoff = 1.0e-10 + 0;
}


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

$id or myerror($cgi, "500 missing id", "bbhs missing id argument");

# Find out if we're doing a single PEG or a bunch. We're doing a bunch if
# there's a wild card in the PEG id.
my ($filter, $flds, $idx);
if ($id =~ /%/) {
    # Here we have a bunch.
    $filter = "peg1 LIKE ?";
    $flds = "peg1, peg2, psc, nsc";
    $idx = 1;
} else {
    $filter = "peg1 = ?";
    $flds = "peg2, psc, nsc";
    $idx = 0;
}

# See if we want to filter on target genomes.
my $targets = $cgi->param('targets');
my @targets = ();
if ($targets) {
    @targets = map { "fig|$_" } split /,/, $targets;
}

#
# Need "0+?" to force a numeric comparison, since psc is
# a varchar field.
#
my $sth = $dbh->prepare("SELECT $flds FROM bbh WHERE $filter AND (psc + 0) < ? ORDER BY psc + 0, nsc DESC");

$sth->bind_param(1, $id);
$sth->bind_param(2, $cutoff,  SQL_REAL);
$sth->execute;

print $cgi->header('text/plain');

while (my $row = $sth->fetchrow_arrayref())
{
    # We need to see here if it's necessary to filter to target genomes. We get no index help
    # on this, so we do it here instead of in the query.
    my $ok = 1;
    if ($targets) {
	my $peg2 = $row->[$idx];
	$ok = scalar(grep { substr($peg2, 0, length($_)) eq $_ } @targets);
    }
    if ($ok) {
	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 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 "$score\t$peg2";
	$ev_sth->execute($id, $peg2);
	
	while (my $res = $ev_sth->fetchrow_arrayref())
	{
	    print "\t" . join("\t", @$res);
	}
	print "\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