mason/markers/polymorphisms.mas

   1
   2 <%doc>
   3
   4 =head1 NAME
   5
   6 /markers/polymorphisms.mas - a Mason component displaying information about map polymorphisms of marker product lengths
   7
   8 =head1 DESCRIPTION
   9
  10 parameters
  11
  12 =over 5
  13
  14 =item *
  15
  16 $marker - a CXGN::Marker object.
  17
  18
  19 =back
  20
  21 =head1 AUTHOR
  22
  23 Lukas Mueller <lam87@cornell.edu>
  24
  25 =cut
  26
  27 </%doc>
  28
  29 <%args>
  30 $marker
  31 </%args>
  32
  33 <%perl>
  34   my $polymorphisms_html='';
  35 my $dbh = $marker->{dbh};
  36
  37 my $displayed_experiments = $marker->current_mapping_experiments;
  38 my @displayed_pcr = map ( $_->{pcr_experiment} , @$displayed_experiments);
  39 my @displayed_ids;
  40 foreach my $ex (@displayed_pcr) {
  41   push  @displayed_ids, $ex->pcr_experiment_id if $ex;
  42 }
  43
  44 my $experiments=$marker->experiments();
  45 if($experiments and @{$experiments}) {
  46   for my $experiment(@{$experiments}) {
  47     my $pcr=$experiment->{pcr_experiment};
  48     my $rflp=$experiment->{rflp_experiment};
  49     if($pcr and !grep {$_==$pcr->pcr_experiment_id()} @displayed_ids) {
  50       my $pcr_bands=$pcr->pcr_bands_hash_of_strings();
  51       my $digest_bands=$pcr->pcr_digest_bands_hash_of_strings();
  52       my $pcr_bands_html='';
  53       my $digest_bands_html='';
  54       for my $stock_id(keys(%{$pcr_bands})) {
  55         #my $accession_name=CXGN::Accession->new($dbh,$accession_id)->verbose_name();
  56         my $sth = $dbh->prepare("SELECT organism.species || ' ' ||  stock.name FROM public.stock JOIN public.organism USING(organism_id) WHERE stock_id=?");
  57         $sth->execute($stock_id);
  58         my ($stock_name) = $sth->fetchrow_array();
  59         $pcr_bands_html.="<b>$stock_name:</b> $pcr_bands->{$stock_id}<br />";
  60       }
  61       for my $stock_id(keys(%{$digest_bands})) {
  62         my $sth = $dbh->prepare("SELECT organism.species || ' ' ||  stock.name FROM public.stock JOIN public.organism USING(organism_id) WHERE stock_id=?");
  63         $sth->execute($stock_id);
  64         my ($stock_name) = $sth->fetchrow_array();
  65 #       my $accession_name=CXGN::Accession->new($dbh,$accession_id)->verbose_name();
  66         $digest_bands_html.="<b>$stock_name:</b> $digest_bands->{$stock_id}<br />";
  67       }
  68       my $mg='';
  69       if($pcr->mg_conc()) {
  70         $mg=$pcr->mg_conc().'mM';
  71       }
  72       my $temp='';
  73       if($pcr->temp()) {
  74         $temp=$pcr->temp().'&deg;C';
  75       }
  76       $polymorphisms_html.='<tr><td width="100%">';
  77       my $fwd=$pcr->fwd_primer();
  78       my $rev=$pcr->rev_primer();
  79       if($fwd) {
  80         $fwd='<span class="sequence">'.$fwd.'</span>';
  81       }
  82       else {
  83         $fwd='<span class="ghosted">Unknown</span>';
  84       }
  85       if($rev) {
  86         $rev='<span class="sequence">'.$rev.'</span>';
  87       }
  88       else {
  89         $rev='<span class="ghosted">Unknown</span>';
  90       }
  91       my $enz=$pcr->enzyme()||'unknown enzyme';
  92       my $additional_enzymes= $pcr->additional_enzymes;
  93       $temp||='<span class="ghosted">Unknown</span>';
  94       $mg||='<span class="ghosted">Unknown</span>';
  95       my $digest_title="Digested band sizes (using $enz)";
  96       unless($digest_bands_html) {
  97         $digest_title='&nbsp;';
  98         $digest_bands_html='&nbsp;';
  99       }
 100       $polymorphisms_html.=CXGN::Page::FormattingHelpers::info_table_html
 101         (
 102          '__title'=>"PCR data&nbsp;&nbsp;&nbsp;<span class=\"tinytype\">Exp. ID ".$pcr->pcr_experiment_id."</span>",
 103          "Forward primer (5'-3')"=>"<span class=\"sequence\">$fwd</span>",
 104          "Reverse primer (5'-3')"=>"<span class=\"sequence\">$rev</span>",
 105          'Accessions and product sizes'=>$pcr_bands_html,
 106          $digest_title=>$digest_bands_html,
 107          'Enzymes'               => $additional_enzymes,
 108          'Approximate temperature'=>$temp,
 109          'Mg<sup>+2</sup> concentration'=>$mg,
 110          '__multicol'=>3,
 111          '__tableattrs'=>"width=\"100%\"",
 112         );
 113       $polymorphisms_html.='</td></tr>';
 114     }
 115   }
 116 }
 117 if($polymorphisms_html) {
 118  print  info_section_html(title=>'Other PCR data',contents=>'<table width="100%" cellspacing="0" cellpadding="0" border="0">'.$polymorphisms_html.'</table>');
 119 }
 120 else {
 121   return '';
 122 }
 123
 124 </%perl>