cgi-bin/search/markers/ssr_list.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use CXGN::Page;
   5 use CXGN::DB::Connection;
   6
   7 # Set defaults.
   8 my $contig_page='/search/unigene.pl?type=legacy&';
   9 my $est_page='/search/est.pl?request_type=automatic&amp;request_from=1&amp;request_id=';
  10 my $ssr_page='/search/markers/markerinfo.pl?marker_id=';
  11
  12 # Initialization.
  13 our $page = CXGN::Page->new( "SSR Markers", "Robert Ahrens");
  14 my $dbh = CXGN::DB::Connection->new();
  15
  16 # Get the unigene BLAST match count.
  17 my $unigene_sth = $dbh->prepare("SELECT DISTINCT ssr_id, unigene_id FROM ssr_primer_unigene_matches");
  18 my @unigene_matches;
  19 $unigene_sth->execute;
  20 while (my ($ssr_id, $unigene_id) = $unigene_sth->fetchrow_array) {
  21     $unigene_matches[$ssr_id] ++;
  22 }
  23 $unigene_sth->finish;
  24
  25 # Read the marker values from the database.
  26 my @ssr_list;
  27 my $ssr_sth = $dbh->prepare("SELECT s.ssr_id, s.marker_id, s.ssr_name, et.trace_name, s.start_primer, s.end_primer, s.pcr_product_ln, s.ann_high, s.ann_low FROM ssr AS s LEFT JOIN seqread AS et ON s.est_read_id=et.read_id");
  28 my $repeats_sth = $dbh->prepare("SELECT repeat_motif, reapeat_nr FROM ssr_repeats WHERE ssr_id=?");
  29 my $locs_sth = $dbh->prepare("SELECT loc_id FROM marker_locations WHERE marker_id=?");
  30 $ssr_sth->execute;
  31 while (my ($ssr_id, $marker_id, $ssr_name, $est_trace, $start_primer, $end_primer, $pcr_length, $ann_high, $ann_low) = $ssr_sth->fetchrow_array) {
  32     $ann_high ||= "n/a";
  33     $ann_low ||= "n/a";
  34     $marker_id || &local_abort("No marker_id detected for $ssr_name.\n");
  35     $ssr_id || &local_abort("No ssr_id detected for $ssr_name.\n");
  36     # Get the repeat motifs.
  37     my @repeat_motifs=();
  38     my @repeat_numbers=();
  39     $repeats_sth->execute($ssr_id);
  40     while (my ($motif, $r_nr) = $repeats_sth->fetchrow_array) {
  41         push @repeat_motifs, $motif;
  42         push @repeat_numbers, $r_nr;
  43     }
  44     # Get map locations.
  45     $locs_sth->execute($marker_id);
  46     my ($mapped) = $locs_sth->fetchrow_array;
  47     # Add the row of the table.
  48
  49     unless (defined($ssr_page)) {$ssr_page='';}
  50     unless (defined($marker_id)) {$marker_id='';}
  51     unless (defined($ssr_name)) {$ssr_name='';}
  52     unless (defined($est_trace)) {$est_trace='';}
  53     unless (defined($est_page)) {$est_page='';}
  54     unless (defined($ssr_id)) {$ssr_id='';}
  55     unless (defined($start_primer)) {$start_primer='';}
  56     unless (defined($end_primer)) {$end_primer='';}
  57     unless (defined($pcr_length)) {$pcr_length='';}
  58     unless (defined($ann_low)) {$ann_low='';}
  59     unless (defined($ann_high)) {$ann_high='';}
  60     unless (defined($mapped)) {$mapped='';}
  61
  62     push @ssr_list, "<tr><td><a href='$ssr_page$marker_id'>" . $ssr_name .
  63         "</a></td><td align='center'>" . ($est_trace ? "<a href='$est_page$est_trace'>$est_trace</a>" : "unknown") . "</td>" .
  64             "<td>" . ($unigene_matches[$ssr_id] ? "<a href='$ssr_page$ssr_id'>$unigene_matches[$ssr_id]</a>" : "0") . "</td>" .
  65                 "<td>" . join("<br />", @repeat_motifs) .
  66                     "</td><td align='center'>" . join("<br />", @repeat_numbers) .
  67                         "</td><td><b>fwd (5'->3'):</b> " . ($start_primer || "unknown") . "<br /><b>rev (5'->3'):</b> " . ($end_primer || "unknown") .
  68                             "</td><td align='center'>" . ($pcr_length || "unknown") .
  69                                 "</td><td>low: " . $ann_low . "<br />high: " . $ann_high .
  70                                     "</td><td align='center'>" . ($mapped ? "mapped" : "not mapped") . "</td></tr>\n";
  71
  72 }
  73 $locs_sth->finish;
  74 $repeats_sth->finish;
  75
  76 # Print the page.
  77 $page->header( "SSR Markers" );
  78
  79 print "<table summary=\"\" border=\"2\" width=\"710\" align=\"center\">\n";
  80 print "<tr>\n<td width=\"60\"><b>SSR name</b></td>\n";
  81 print "<td width=\"60\" align=\"center\"><b>EST trace</b></td>\n";
  82 print "<td width=\"100\" align=\"center\"><b>Unigene BLAST matches</b></td>\n";
  83 print "<td width=\"120\" align=\"center\"><b>Repeat motifs</b></td>\n";
  84 print "<td width=\"35\" align=\"center\"><b>Repeat number</b></td>\n";
  85 print "<td width=\"50\" align=\"center\"><b>PCR primers</b></td>\n";
  86 print "<td width=\"35\" align=\"center\"><b>PCR product length</b></td>\n";
  87 print "<td width=\"50\" align=\"center\"><b>Annealing temperature</b></td>\n";
  88 print "<td width=\"50\" align=\"center\"><b>Mapped</b></td>\n</tr>\n";
  89
  90 print @ssr_list;
  91
  92 print "</table>\n";
  93 $page->footer;
  94
  95
  96 ######################################################################
  97 #
  98 #  Subroutines for this program.
  99 #
 100 ######################################################################
 101
 102
 103 sub local_abort {
 104
 105     my ($errstrn) = @_;
 106     if (not $errstrn) {
 107         $errstrn = "Error reading SSR data";
 108     }
 109     $page->header( "Error reading SSR data." ,"Error reading SSR data." );
 110     if ($errstrn) {
 111         print "$errstrn\n";
 112     } else {
 113         print "<I>There has been an error generating data.<br />Please email Robert Ahrens at <a href='mailto:ra97\@cornell.edu'>ra97\@cornell.edu</a> to let him know you are experiencing difficulties.</I>";
 114     }
 115     $page->footer();
 116     exit;
 117
 118 }
 119
 120
 121
 122