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

Annotation of /FigWebServices/bbhs.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (view) (download)

1 : olson 1.1 use strict;
2 :     use DBI qw(:sql_types);
3 :     use CGI;
4 : olson 1.2 my $cgi = new CGI;
5 : olson 1.1
6 :     #
7 :     # BBH server code.
8 :     # Keep this free of FIG references - it is intended to be run from mod_perl where
9 :     # we likely don't have a full SEED environment.
10 :     #
11 :    
12 :     our $fig = "/disks/dserv/SimServer/FIGdisk";
13 :     #our $fig = "/Volumes/raid2/FIGdisk.anno_v5";
14 :     our $dbms = "mysql";
15 :     our $db = "sim_server";
16 :     our $dbuser = "root";
17 :     our $dbpass = "";
18 :     our $dbport = 3306;
19 :     our $dbsock = "/tmp/mysql.sock";
20 :     our $dbhost;
21 :    
22 :     #
23 :     # bio* setup
24 :     #
25 : parrello 1.4 if ($ENV{HTTP_HOST} =~ /bio/) {
26 :     $fig = "/vol/seed-anno-mirror";
27 :     $db = "fig_anno_v5";
28 :     $dbuser = "seed";
29 :     $dbhost = "biosql.mcs.anl.gov";
30 :     undef $dbsock;
31 :     }
32 : olson 1.1
33 :     our $data = "$fig/FIG/Data";
34 :    
35 :     my $dbh;
36 :    
37 :     if ($dbhost ne '')
38 :     {
39 :     $dbh = DBI->connect("DBI:mysql:dbname=$db;host=$dbhost;port=$dbport", $dbuser, $dbpass);
40 :     }
41 :     else
42 :     {
43 :     $dbh = DBI->connect("DBI:mysql:dbname=$db;mysql_socket=$dbsock", $dbuser, $dbpass);
44 :     }
45 :    
46 :     $dbh or die "Could not open database: " . DBI->errstr;
47 :    
48 :    
49 :    
50 :     my $cutoff = $cgi->param('cutoff');
51 :     if ($cutoff eq '')
52 :     {
53 :     $cutoff = 1.0e-10 + 0;
54 :     }
55 :    
56 : parrello 1.3
57 :     my $id = $cgi->param('id');
58 :    
59 :     $id or myerror($cgi, "500 missing id", "bbhs missing id argument");
60 :    
61 :     # Find out if we're doing a single PEG or a bunch. We're doing a bunch if
62 :     # there's a wild card in the PEG id.
63 :     my ($filter, $flds, $idx);
64 :     if ($id =~ /%/) {
65 :     # Here we have a bunch.
66 :     $filter = "peg1 LIKE ?";
67 :     $flds = "peg1, peg2, psc, nsc";
68 :     $idx = 1;
69 :     } else {
70 :     $filter = "peg1 = ?";
71 :     $flds = "peg2, psc, nsc";
72 :     $idx = 0;
73 :     }
74 :    
75 :     # See if we want to filter on target genomes.
76 :     my $targets = $cgi->param('targets');
77 :     my @targets = ();
78 :     if ($targets) {
79 :     @targets = map { "fig|$_" } split /,/, $targets;
80 :     }
81 :    
82 : olson 1.1 #
83 :     # Need "0+?" to force a numeric comparison, since psc is
84 :     # a varchar field.
85 :     #
86 : parrello 1.3 my $sth = $dbh->prepare("SELECT $flds FROM bbh WHERE $filter AND (psc + 0) < ? ORDER BY psc + 0, nsc DESC");
87 : olson 1.1
88 :     $sth->bind_param(1, $id);
89 :     $sth->bind_param(2, $cutoff, SQL_REAL);
90 :     $sth->execute;
91 :    
92 : olson 1.2 print $cgi->header('text/plain');
93 : olson 1.1
94 :     while (my $row = $sth->fetchrow_arrayref())
95 :     {
96 : parrello 1.3 # We need to see here if it's necessary to filter to target genomes. We get no index help
97 :     # on this, so we do it here instead of in the query.
98 :     my $ok = 1;
99 :     if ($targets) {
100 :     my $peg2 = $row->[$idx];
101 :     $ok = scalar(grep { substr($peg2, 0, length($_)) eq $_ } @targets);
102 :     }
103 :     if ($ok) {
104 :     print join("\t", @$row), "\n";
105 :     }
106 : olson 1.1 }
107 :    
108 :     sub do_coupling_evidence
109 :     {
110 :     my($cgi, $dbh, $id1, $id2) = @_;
111 :    
112 :     my $sth = $dbh->prepare(qq(SELECT peg3, peg4, rep
113 :     FROM pchs
114 :     WHERE peg1 = ? AND peg2 = ?));
115 :     $sth->execute($id1, $id2);
116 :    
117 :     print $cgi->header('text/plain');
118 :    
119 :     while (my $row = $sth->fetchrow_arrayref())
120 :     {
121 :     print join("\t", @$row), "\n";
122 :     }
123 :     }
124 :    
125 :     sub do_coupling_and_evidence
126 :     {
127 :     my($cgi, $dbh, $id) = @_;
128 :    
129 :     my $sth = $dbh->prepare(qq(SELECT peg2, score
130 :     FROM fc_pegs
131 :     WHERE peg1 = ?));
132 :     my $ev_sth = $dbh->prepare(qq(SELECT peg3, peg4
133 :     FROM pchs
134 :     WHERE peg1 = ? AND peg2 = ?));
135 :     $sth->execute($id);
136 :    
137 :     print $cgi->header('text/plain');
138 :    
139 :     while (my($peg2, $score) = $sth->fetchrow_array())
140 :     {
141 :     print "$score\t$peg2";
142 :     $ev_sth->execute($id, $peg2);
143 :    
144 :     while (my $res = $ev_sth->fetchrow_arrayref())
145 :     {
146 :     print "\t" . join("\t", @$res);
147 :     }
148 :     print "\n";
149 :     }
150 :     }
151 :    
152 :     sub myerror
153 :     {
154 :     my($cgi, $stat, $msg) = @_;
155 :     print $cgi->header(-status => $stat);
156 :    
157 :     print "$msg\n";
158 :     exit;
159 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3