mason/markers/overgo.mas

   1
   2
   3
   4 <%doc>
   5
   6 =head1 NAME
   7
   8 /markers/overgo.mas - a Mason component displaying information about associated overgo data
   9
  10 =head1 DESCRIPTION
  11
  12 parameters
  13
  14 =over 5
  15
  16 =item *
  17
  18 $marker - a CXGN::Marker object.
  19
  20 =back
  21
  22 =head1 AUTHOR
  23
  24 Lukas Mueller <lam87@cornell.edu>
  25
  26 =cut
  27
  28 </%doc>
  29
  30 <%args>
  31 $marker
  32 </%args>
  33
  34 <& /util/import_javascript.mas, classes=> [ "CXGN.Page.FormattingHelpers" ] &>
  35
  36 <%perl>
  37
  38 use CXGN::Page::FormattingHelpers qw | html_break_string html_optional_show info_section_html |;
  39
  40 my $marker_id = $marker->marker_id();
  41 my $marker_name = $marker->get_name();
  42 my $dbh = $marker->{dbh};
  43 my $phys_html;
  44
  45 #some page locations that may change
  46 my $bac_page = '/maps/physical/clone_info.pl?id=';
  47 my $overgo_plate_page = '/maps/physical/list_overgo_plate_probes.pl?plate_no=';
  48 my $plausible_definition_page = '/maps/physical/overgo_process_explained.pl#plausible';
  49
  50 # New! Improved! Now uses SGN-managed $dbh rather than physical_tools
  51
  52 #get the physical info, if any
  53 my ($overgo_version) = $dbh->selectrow_array("SELECT overgo_version FROM physical.overgo_version WHERE current=1;");
  54 my $physical_stm = q{  SELECT  pm.overgo_probe_id,
  55                        op.plate_number,
  56                        pm.overgo_plate_row,
  57                        pm.overgo_plate_col,
  58                        b.bac_id,
  59                        b.cornell_clone_name,
  60                        oap.plausible,
  61                        pm.overgo_seq_A,
  62                        pm.overgo_seq_B,
  63                        pm.overgo_seq_AB,
  64                        pm.marker_seq
  65                        FROM physical.probe_markers AS pm
  66                        LEFT JOIN physical.overgo_plates AS op
  67                        ON pm.overgo_plate_id=op.plate_id
  68                        LEFT JOIN physical.overgo_associations AS oa
  69                        ON (pm.overgo_probe_id=oa.overgo_probe_id AND oa.overgo_version=?)
  70                        LEFT JOIN physical.oa_plausibility AS oap
  71                        ON (oap.overgo_assoc_id=oa.overgo_assoc_id)
  72                        LEFT JOIN physical.bacs AS b
  73                        ON oa.bac_id=b.bac_id
  74                        WHERE pm.marker_id=?
  75                     };
  76 my $physical_sth = $dbh->prepare($physical_stm);
  77 $physical_sth->execute($overgo_version, $marker_id);
  78
  79 #go over the results from the query above and load the results into memory,
  80 #getting rid of duplicates and suchlike chaff, avoiding duplicates mostly
  81 #by storing things as keys in a hash instead of in a simple array
  82
  83 my %overgos;  #hash by platelocation => a hash of sequence info
  84 my %plausible_BAC_matches;
  85 my %other_BAC_matches;
  86 while (my ($probeid, $platenum, $row, $col, $bacid, $bacname, $plausible, $seqA, $seqB, $seqAB, $markerseq) = $physical_sth->fetchrow_array) {
  87
  88   ### sock away the info on this overgo probe (location and sequences)
  89
  90   $overgos{$probeid}{loc} = {plate=>$platenum,coords=>$row.$col};
  91
  92   if($seqA || $seqB || $seqAB || $markerseq) {
  93     $overgos{$probeid}{seqs} =
  94       {seqA=>$seqA,seqB=>$seqB,seqAB=>$seqAB,markerseq=>$markerseq};
  95   }
  96
  97   #if we have BACs associated with it, remember them
  98   if ($bacid) {
  99     my $baclink = qq|<a href="$bac_page$bacid">$bacname</a>|;
 100     #store these as hash keys to prevent duplicates
 101     if ($plausible) {
 102       $overgos{$probeid}{plausible}{$baclink}=1;
 103     } else {
 104       $overgos{$probeid}{unplausible}{$baclink}=1;
 105     }
 106   }
 107 }
 108
 109 #if we found some overgo stuff, output it
 110 if (%overgos) {
 111   #go over the overgos we found and output info in HTML for each of them
 112   my @overgoinfo; #array of html overgo info nuggets
 113   while(my ($probeid,$thisprobe) = each %overgos) {
 114     my $overgo_html;
 115     $overgo_html .= qq|$marker_name was used as an overgo probe on <a href="$overgo_plate_page$thisprobe->{loc}{plate}&amp;highlightwell=$thisprobe->{loc}{coords}">plate $thisprobe->{loc}{plate}</a> [well $thisprobe->{loc}{coords}]<br />|;
 116
 117     #output the plausible BACs
 118     $overgo_html .= qq{<p><b><a href="$plausible_definition_page">Plausible</a> BAC Matches:</b>&nbsp;&nbsp;&nbsp;}
 119       .($thisprobe->{plausible} ? join(",&nbsp;&nbsp;\n", keys %{$thisprobe->{plausible}}) : 'None')
 120         ."</p>\n";
 121
 122     #output the nonplausible BACs
 123     if ($thisprobe->{unplausible}) {
 124       $overgo_html .= html_optional_show("np$probeid",'<i>Non-Plausible</i> BAC matches',
 125                                          join (",&nbsp;&nbsp;\n",
 126                                                keys %{$thisprobe->{unplausible}})
 127                                         );
 128     }
 129
 130     #output the sequences for this overgo probe
 131     my @seqs = (
 132         'A sequence'  => $thisprobe->{seqs}{seqA},
 133         'B sequence'  => $thisprobe->{seqs}{seqB},
 134         'AB sequence' => $thisprobe->{seqs}{seqAB},
 135         'Marker sequence' => $thisprobe->{seqs}{markerseq},
 136     );
 137
 138     $_ = '<span class="sequence">'.html_break_string( $_ ).'</span>' for @seqs[1,3,5,7];
 139     my $seqhtml = info_table_html( @seqs, __border => 0 );
 140
 141     $overgo_html .= html_optional_show( "seq$probeid",'Overgo Sequences', $seqhtml );
 142     push @overgoinfo, $overgo_html;
 143   }
 144
 145   #now join together the over info units, putting <hr>s between them
 146   $phys_html .= join "<hr />\n", @overgoinfo;
 147
 148   #       my @loclist = map  {my ($plateno,$row,$col) = split (/:/,$_);
 149   #                            qq|<a href="$overgo_plate_page$plateno&highlightwell=$row$col">plate $plateno</a> [well $row$col]|;
 150   #                           } (keys %overgos);
 151   #loclist is now a list of link strings made of the plate
 152           #locations that were stored above as keys of %overgos
 153
 154 #         $phys_html .= "<p>$marker_name was used as a probe on ";
 155 #         $phys_html .= list_to_string(@loclist);
 156 #         $phys_html .= " of the Overgo Physical mapping process.</p>\n";
 157
 158
 159 }
 160
 161 # End of ugly code.
 162 #############################################
 163
 164 if ($phys_html) {
 165   print  info_section_html(title=>'Overgo hybridization and physical mapping', contents=>$phys_html);
 166 }
 167
 168 </%perl>