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

Diff of /FigWebServices/bbhs.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2, Thu Aug 31 19:48:30 2006 UTC revision 1.3, Wed Dec 6 01:30:39 2006 UTC
# Line 45  Line 45 
45  $dbh or die "Could not open database: " . DBI->errstr;  $dbh or die "Could not open database: " . DBI->errstr;
46    
47    
 my $id = $cgi->param('id');  
 $id or myerror($cgi, "500 missing id", "bbhs missing id argument");  
48    
49  my $cutoff = $cgi->param('cutoff');  my $cutoff = $cgi->param('cutoff');
50  if ($cutoff eq '')  if ($cutoff eq '')
# Line 54  Line 52 
52      $cutoff = 1.0e-10 + 0;      $cutoff = 1.0e-10 + 0;
53  }  }
54    
55    
56    my $id = $cgi->param('id');
57    
58    $id or myerror($cgi, "500 missing id", "bbhs missing id argument");
59    
60    # Find out if we're doing a single PEG or a bunch. We're doing a bunch if
61    # there's a wild card in the PEG id.
62    my ($filter, $flds, $idx);
63    if ($id =~ /%/) {
64        # Here we have a bunch.
65        $filter = "peg1 LIKE ?";
66        $flds = "peg1, peg2, psc, nsc";
67        $idx = 1;
68    } else {
69        $filter = "peg1 = ?";
70        $flds = "peg2, psc, nsc";
71        $idx = 0;
72    }
73    
74    # See if we want to filter on target genomes.
75    my $targets = $cgi->param('targets');
76    my @targets = ();
77    if ($targets) {
78        @targets = map { "fig|$_" } split /,/, $targets;
79    }
80    
81  #  #
82  # Need "0+?" to force a numeric comparison, since psc is  # Need "0+?" to force a numeric comparison, since psc is
83  # a varchar field.  # a varchar field.
84  #  #
85  my $sth = $dbh->prepare(qq(SELECT peg2, psc, nsc  my $sth = $dbh->prepare("SELECT $flds FROM bbh WHERE $filter AND (psc + 0) < ? ORDER BY psc + 0, nsc DESC");
                            FROM bbh  
                            WHERE peg1 = ? AND (psc + 0) < ?  
                            ORDER BY psc + 0, nsc DESC));  
86    
87  $sth->bind_param(1, $id);  $sth->bind_param(1, $id);
88  $sth->bind_param(2, $cutoff,  SQL_REAL);  $sth->bind_param(2, $cutoff,  SQL_REAL);
# Line 71  Line 92 
92    
93  while (my $row = $sth->fetchrow_arrayref())  while (my $row = $sth->fetchrow_arrayref())
94  {  {
95        # We need to see here if it's necessary to filter to target genomes. We get no index help
96        # on this, so we do it here instead of in the query.
97        my $ok = 1;
98        if ($targets) {
99            my $peg2 = $row->[$idx];
100            $ok = scalar(grep { substr($peg2, 0, length($_)) eq $_ } @targets);
101        }
102        if ($ok) {
103      print join("\t", @$row), "\n";      print join("\t", @$row), "\n";
104  }  }
105    }
106    
107  sub do_coupling_evidence  sub do_coupling_evidence
108  {  {

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3