cgi-bin/search/unigene-all-blast-matches.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use CXGN::Page;
   4 use CXGN::DB::Connection;
   5 use CXGN::Tools::Identifiers qw/link_identifier/;
   6
   7 our ($blastq, $blast_hitq);
   8
   9 our $page = CXGN::Page->new( "SGN Unigene - Show All Stored BLAST Hits", "Koni");
  10 my ($unigene_id, $unigene_length, $target_id) = $page->get_arguments("unigene_id","l", "t");
  11
  12 my $dbh = CXGN::DB::Connection->new();
  13
  14 if ($target_id =~ /^\d+$/) {
  15   $blastq = $dbh->prepare("SELECT blast_annotation_id, blast_targets.blast_target_id,
  16                                 blast_program, db_name, n_hits, hits_stored
  17                            FROM blast_annotations
  18                                 LEFT JOIN blast_targets USING (blast_target_id)
  19                            WHERE apply_id=? AND blast_targets.blast_target_id=? AND apply_type=15");
  20 } else {
  21   $blastq = $dbh->prepare("SELECT blast_annotation_id, blast_targets.blast_target_id,
  22                                 blast_program, db_name, n_hits, hits_stored
  23                            FROM blast_annotations
  24                                 LEFT JOIN blast_targets USING (blast_target_id)
  25                            WHERE apply_id=? AND apply_type=15");
  26 }
  27
  28 $blast_hitq = $dbh->prepare("SELECT blast_hits.target_db_id, evalue, score,
  29                                     identity_percentage, apply_start, apply_end, defline
  30                              FROM blast_hits
  31                                   LEFT JOIN blast_defline USING (defline_id)
  32                              WHERE blast_annotation_id=?
  33                              ORDER BY score DESC");
  34
  35 #&local_init;
  36
  37
  38
  39 if ($unigene_id eq "") {
  40   empty_search();
  41 }
  42
  43 unless ($unigene_length > 0){
  44   empty_search();
  45 }
  46
  47 if (int($unigene_id) ne $unigene_id) {
  48   invalid_search($unigene_id);
  49 }
  50
  51   my $blast_content = "";
  52
  53 if ($target_id =~ /^\d+$/){
  54
  55   $blastq->execute($unigene_id, $target_id);
  56 } else {
  57   warn "XXX querying with ONLY unigene_id";
  58   $blastq->execute($unigene_id);
  59 }
  60
  61   while(my ($blast_annotation_id, $blast_target_id, $blast_program,
  62             $target_dbname, $n_hits, $hits_stored) = $blastq->fetchrow_array()) {
  63     $blast_content .= qq(<tr><td align="left"><b>$target_dbname [$blast_program]</b></td><td align="right" colspan="5"> Showing best $hits_stored hits recorded </td></tr>);
  64
  65     $blast_hitq->execute($blast_annotation_id);
  66     while(my ($match_id,$evalue,$score,$identity,$start,$end,
  67               $defline) = $blast_hitq->fetchrow_array()) {
  68
  69       $match_id = link_identifier($match_id) || $match_id;
  70
  71       if (length($defline)>120) {
  72         $defline = substr($defline, 0, 117) . "...";
  73       }
  74       my $alignment_length = abs($end - $start) + 1;
  75
  76       my $span_percent = sprintf "%3.1f%%",
  77         ($alignment_length/$unigene_length)*100.0;
  78       my $frame;
  79       # This assumes BLAST start/end coordinates are adjusted to start with
  80       # index 0 for the first base, as per C and perl style string addressing
  81       # Normally, BLAST addressing indexing the first base as 1.
  82       if ($start < $end) {
  83         $frame = ($start % 3) + 1;
  84       } else {
  85         $frame = -((($unigene_length - $start - 1) % 3) + 1);
  86       }
  87
  88       $blast_content .= <<EOF;
  89       <tr><td><b>Match:</b> $match_id</td>
  90           <td><b>score:</b> $score</td>
  91           <td><b>e-value:</b> $evalue</td>
  92           <td><b>Identity:</b> $identity%</td>
  93           <td><b>Span:</b> ${alignment_length}bp ($span_percent)</td>
  94           <td><b>Frame:</b> $frame</td>
  95       </tr>
  96       <tr><td colspan="6">$defline</td></tr>
  97 EOF
  98     }
  99     $blast_content .= qq(<tr><td colspan="6"><br /></td></tr>);
 100     if ($hits_stored < $n_hits) {
 101       my $t_hits = $n_hits - $hits_stored;
 102       $blast_content .= qq(<tr><td colspan="6" align="center"><font color="gray">$t_hits lower scoring hits censored --  only $hits_stored best hits are stored.</font></td></tr>);
 103     }
 104   }
 105
 106
 107   if ($blast_content eq "") {
 108     $blast_content = qq(<tr><td><font color="gray">No BLAST annotations were found</td></tr>);
 109   } else {
 110     $blast_content = qq(<tr><td><table cellspacing="0" border="0" width="100%" align="center">) . $blast_content ."</table></td></tr>";
 111   }
 112
 113
 114
 115 $page->header();
 116
 117 print <<EOF;
 118 <table cellpadding="0" cellspacing="0" border="0" width="100%" align="center">
 119 <tr><td align="center"><b>All Stored BLAST annotations for SGN-U$unigene_id</b></td></tr>
 120 $blast_content
 121 <tr><td><br /></td></tr>
 122 </table>
 123
 124 EOF
 125
 126 $page->footer();
 127
 128 sub empty_search {
 129
 130   $page->header();
 131
 132   print <<EOF;
 133   <br />
 134   <b>Not enough unigene search criteria specified</b>
 135
 136 EOF
 137
 138   $page->footer();
 139
 140   exit 0;
 141 }
 142
 143 sub invalid_search {
 144   my ($unigene_id) = @_;
 145
 146   $page->header();
 147
 148   print <<EOF;
 149   <br />
 150   <b>The specified unigene identifer ($unigene_id) does not result in a valid search.</b>
 151
 152 EOF
 153
 154   $page->footer();
 155   exit 0;
 156
 157 }
 158
 159
 160 sub local_init {
 161
 162
 163 }