mason/markers/cosii_polymorphisms.mas

   1
   2 <%doc>
   3
   4 =head1 NAME
   5
   6 /markers/cosii_polymorphisms.mas - a Mason component displaying information about associated cosii polymorphism data
   7
   8 =head1 DESCRIPTION
   9
  10 parameters
  11
  12 =over 5
  13
  14 =item *
  15
  16 $marker - a CXGN::Marker object.
  17
  18 =back
  19
  20 =head1 AUTHOR
  21
  22 Lukas Mueller <lam87@cornell.edu>
  23
  24 =cut
  25
  26 </%doc>
  27
  28 <%args>
  29 $marker
  30 </%args>
  31
  32 <%perl>
  33
  34   my $marker_name = $marker->get_name();
  35 my $dbh = $marker->{dbh};
  36
  37 unless($marker->is_in_collection('COSII')) {
  38   return'';
  39 }
  40 my $html='<span class="ghosted">No additional PCR data found.</span>';
  41
  42 #if we have some experiments, and they are an arrayref, and there is at least one location in them
  43 my $experiments=$marker->upa_experiments();
  44 if($experiments and @{$experiments}) {
  45
  46   #what we want here is just two or four primers: forward and reverse iUPA and/or forward and reverse eUPA primers for ALL of the experiments that will follow.
  47   #they all SHOULD share the same primers, so we only want to display them once, up on the top.
  48   #so here, we are going to walk through all of the experiments and grab the first forward and reverse iUPAs and eUPAs we see.
  49   #since this is not a bottleneck for speed in page loading, we are then going to continue on and do some data integrity checking as well with every page load.
  50 #we're going to check our assumption that all of these experiments will have the same primers.
  51 #we may later want to write a trigger in the database to check this instead.
  52 #we'll continue walking through all experiments and if any of them have non-matching primers, we'll notify the developers of this error.
  53 #whether the error turns out to be that our assumption was wrong, or that the data was wrong, will have to be determined by the developers.
  54   my $fwd_iupa='';
  55   my $rev_iupa='';
  56   my $fwd_eupa='';
  57   my $rev_eupa='';
  58   my $non_mapping_experiments=0;
  59   my $possible_error_email='';
  60   for my $marker_experiment(@{$experiments}) {
  61
  62     #keep track if we have any non mapping experiments to display, for use the next time we go through them
  63     unless($marker_experiment->{location}) {
  64       $non_mapping_experiments++;
  65     }
  66
  67     my $exp=$marker_experiment->{pcr_experiment};
  68
  69     #if it is an iUPA experiment, set or check iUPA primers
  70     if($exp->primer_type() eq 'iUPA') {
  71       if($exp->fwd_primer()) {
  72         if($fwd_iupa) {
  73           if($fwd_iupa ne $exp->fwd_primer()) {
  74             $possible_error_email.="Found unmatched fwd iUPA primers '$fwd_iupa' and '".$exp->fwd_primer()."' for '$marker_name'\n";
  75           }
  76         }
  77         else {
  78           $fwd_iupa=$exp->fwd_primer();
  79         }
  80       }
  81       if($exp->rev_primer()) {
  82         if($rev_iupa) {
  83           if($rev_iupa ne $exp->rev_primer()) {
  84             $possible_error_email.="Found unmatched rev iUPA primers '$rev_iupa' and '".$exp->rev_primer()."' for '$marker_name'\n";
  85           }
  86         }
  87         else {
  88           $rev_iupa=$exp->rev_primer();
  89         }
  90       }
  91     }
  92     #else if it is an eUPA experiment, set or check eUPA primers
  93     elsif($exp->primer_type eq 'eUPA') {
  94     if($exp->fwd_primer()) {
  95       if($fwd_eupa) {
  96         if($fwd_eupa ne $exp->fwd_primer()) {
  97           $possible_error_email.="Found unmatched fwd eUPA primers '$fwd_eupa' and '".$exp->fwd_primer()."' for '$marker_name'\n";
  98         }
  99       }
 100       else {
 101         $fwd_eupa=$exp->fwd_primer();
 102       }
 103     }
 104     if($exp->rev_primer()) {
 105       if($rev_eupa) {
 106         if($rev_eupa ne $exp->rev_primer()) {
 107           $possible_error_email.="Found unmatched rev eUPA primers '$rev_eupa' and '".$exp->rev_primer()."' for '$marker_name'\n";
 108         }
 109       }
 110       else {
 111         $rev_eupa=$exp->rev_primer();
 112       }
 113     }
 114   }
 115     #else we got data we don't know how to display yet
 116     else {
 117       CXGN::Apache::Error::notify('found a primer which could not be displayed',"Experiments of type '".$exp->primer_type()."' cannot yet be displayed.");
 118     }
 119   }
 120   if($possible_error_email) {
 121     CXGN::Apache::Error::notify('found unmatched primers for $marker_name',$possible_error_email);
 122   }
 123
 124   #now we're done looking for primers.
 125   #if we found any non-mapping experiments above, then it's time to display them.
 126   if($non_mapping_experiments) {
 127     my %display_hash;
 128     for my $marker_experiment(@{$experiments}) {
 129
 130       #experiments without locations are the ones we want to display here
 131       unless($marker_experiment->{location}) {
 132         my $exp=$marker_experiment->{pcr_experiment};
 133         my $bands_hash=$exp->pcr_bands_hash_of_strings();
 134         my($stock_id)=keys(%{$bands_hash});
 135         #my $accession=CXGN::Accession->new($dbh,$accession_id);
 136
 137         #my $key_string="<b>".$accession->organism_common_name()."</b> ".$accession->verbose_name();
 138
 139         my $sth = $dbh->prepare("SELECT species FROM stock join public.organism using(organism_id) WHERE stock_id=?");
 140         $sth->execute($stock_id);
 141         my ($key_string) = $sth->fetchrow_array();
 142
 143         if($exp->primer_type() eq 'iUPA') {
 144           $display_hash{$key_string}->{iUPA}->{bands}=$bands_hash->{$stock_id};
 145           $display_hash{$key_string}->{iUPA}->{temp}=$exp->temp();
 146           $display_hash{$key_string}->{iUPA}->{mg_conc}=$exp->mg_conc();
 147         }
 148         elsif($exp->primer_type() eq 'eUPA') {
 149           $display_hash{$key_string}->{eUPA}->{bands}=$bands_hash->{$stock_id};
 150           $display_hash{$key_string}->{eUPA}->{temp}=$exp->temp();
 151           $display_hash{$key_string}->{eUPA}->{mg_conc}=$exp->mg_conc();
 152         }
 153       }
 154     }
 155   $html="<table border=\"1\" cellpadding=\"2\" cellspacing=\"0\" width=\"720\">";
 156     $html.="<tr>";
 157     $html.="<td><b>Testing intronic and exonic universal primers for Asterid species</b></td>";
 158     $html.="<td colspan=\"3\">";
 159     if($fwd_iupa) {
 160     $html.="<b>Forward <a href=\"/markers/cosii_markers.pl\">Intronic UPA</a> (5'-3'):</b> <span class=\"sequence\">$fwd_iupa</span><br />";
 161   }
 162     else {
 163       $html.="&nbsp;<br /><br />";
 164   }
 165     if($rev_iupa) {
 166       $html.="<b>Reverse <a href=\"/markers/cosii_markers.pl\">Intronic UPA</a> (5'-3'):</b> <span class=\"sequence\">$rev_iupa</span><br />";
 167     }
 168     else {
 169     $html.="&nbsp;<br /><br />";
 170   }
 171     $html.="</td>";
 172     $html.="<td colspan=\"3\">";
 173     if($fwd_eupa)
 174       {
 175         $html.="<b>Forward <a href=\"/markers/cosii_markers.pl\">Exonic UPA</a> (5'-3'):</b> <span class=\"sequence\">$fwd_eupa</span><br />";
 176     }
 177     else {
 178       $html.="&nbsp;<br /><br />";
 179     }
 180     if($rev_eupa) {
 181       $html.="<b>Reverse <a href=\"/markers/cosii_markers.pl\">Exonic UPA</a> (5'-3'):</b> <span class=\"sequence\">$rev_eupa</span><br />";
 182     }
 183     else {
 184     $html.="&nbsp;<br /><br />";
 185   }
 186     $html.="</td>";
 187     $html.="</tr>";
 188     $html.="<tr><td><b>Accession</b></td><td><b>PCR size(s)</b></td><td><b>Anneal temp.</b></td><td><b>Mg<sup>+2</sup> conc. (mM)</b></td><td><b>PCR size(s)</b></td><td><b>Anneal temp.</b></td><td><b>Mg<sup>+2</sup> conc. (mM)</b></td></tr>";
 189     for my $accession_name(sort {$a cmp $b} keys(%display_hash)) {
 190       $display_hash{$accession_name}->{iUPA}->{bands}||='&nbsp;';
 191     $display_hash{$accession_name}->{iUPA}->{temp}||='&nbsp;';
 192       $display_hash{$accession_name}->{iUPA}->{mg_conc}||='&nbsp;';
 193       $display_hash{$accession_name}->{eUPA}->{bands}||='&nbsp;';
 194     $display_hash{$accession_name}->{eUPA}->{temp}||='&nbsp;';
 195       $display_hash{$accession_name}->{eUPA}->{mg_conc}||='&nbsp;';
 196       $html.="<tr>";
 197       $html.="<td>$accession_name</td>";
 198       $html.="<td>$display_hash{$accession_name}->{iUPA}->{bands}</td>";
 199     $html.="<td>$display_hash{$accession_name}->{iUPA}->{temp}</td>";
 200       $html.="<td>$display_hash{$accession_name}->{iUPA}->{mg_conc}</td>";
 201       $html.="<td>$display_hash{$accession_name}->{eUPA}->{bands}</td>";
 202       $html.="<td>$display_hash{$accession_name}->{eUPA}->{temp}</td>";
 203       $html.="<td>$display_hash{$accession_name}->{eUPA}->{mg_conc}</td>";
 204       $html.="</tr>";
 205     }
 206     $html.="</table>";
 207   }
 208 }
 209
 210 </%perl>
 211
 212 <&| /page/info_section.mas, title=>'Universal primers for Asterid species'&>
 213   <% $html %>
 214 </&>
 215