mason/markers/locations.mas

   1 <%doc>
   2
   3 =head1 NAME
   4
   5 /markers/locations.mas - a Mason component displaying information about map locations of markers
   6
   7 =head1 DESCRIPTION
   8
   9 parameters
  10
  11 =over 5
  12
  13 =item *
  14
  15 $marker - a CXGN::Marker object.
  16
  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 use CXGN::Cview::MapFactory;
  34 use CXGN::Cview::ChrMarkerImage;
  35
  36 my $locations_html = '';
  37 my $marker_name    = $marker->get_name();
  38 my @displayed_locs;
  39 my @displayed_pcr;
  40
  41 #if we have some experiments, and they are an arrayref, and there is at least one location in them
  42 my $experiments = $marker->current_mapping_experiments() || [];
  43
  44 if (    $experiments
  45     and @{$experiments}
  46     and grep { $_->{location} } @{$experiments} )
  47 {
  48     my $count = 1;
  49     for my $experiment ( @{$experiments} ) {
  50
  51 #make sure we have a location before we go about showing location data--some experiments do not have locations
  52         if ( my $loc = $experiment->{location} ) {
  53
  54 #make sure we haven't displayed a location entry with the same location ID already
  55             unless ( grep { $_ == $loc->location_id() } @displayed_locs ) {
  56                 push( @displayed_locs, $loc->location_id() );
  57                 if ( $count > 1 ) {
  58                     $locations_html .= '<br />';
  59                 }
  60                 $locations_html .=
  61 '<table width="100%" cellspacing="0" cellpadding="0" border="0"><tr>';
  62
  63                 #make a section detailing the location
  64                 my $protocol = '';
  65                 my $pcr      = $experiment->{pcr_experiment};
  66                 my $rflp     = $experiment->{rflp_experiment};
  67                 $protocol = $experiment->{protocol};
  68                 unless ($protocol) {
  69                     if ($pcr) {
  70                         $protocol = 'PCR';
  71                     }
  72                     elsif ($rflp) {
  73                         $protocol = 'RFLP';
  74                     }
  75                     else {
  76                         $protocol = '<span class="ghosted">Unknown</span>';
  77                     }
  78                 }
  79
  80                 #make a link to the map this marker can be found on
  81                 my $map_version_id = $loc->map_version_id();
  82                 my $lg_name        = $loc->lg_name();
  83                 my $position       = $loc->position();
  84                 my $subscript      = $loc->subscript();
  85                 $subscript ||= '';
  86                 my $map_url = '';
  87                 my $map_id  = '';
  88
  89                 my $dbh         = $marker->{dbh};
  90                 my $map_factory = CXGN::Cview::MapFactory->new($dbh);
  91                 my $map =
  92                   $map_factory->create( { map_version_id => $map_version_id } );
  93                 if (!$map) {
  94                   print "map_version_id = $map_version_id could not be instantiated\n";
  95                   next;
  96                 }
  97                 my $map_name = $map->get_short_name();
  98                 if ($map_version_id) {
  99                     $map_id = $map->get_id();
 100
 101                     if (    $map_id
 102                         and $map_name
 103                         and defined($lg_name)
 104                         and defined($position) )
 105                     {
 106                         $map_url =
 107 "<a href=\"/cview/view_chromosome.pl?map_version_id=$map_version_id&amp;chr_nr=$lg_name&amp;cM=$position&amp;hilite=$marker_name$subscript&amp;zoom=1\">$map_name</a>";
 108                     }
 109                 }
 110                 else {
 111                     $map_url =
 112                       '<span class="ghosted">Map data not available</span>';
 113                 }
 114                 my $multicol = 1;
 115                 my $width    = "300px";
 116                 if ( $subscript and $multicol > 1 ) { $multicol++; }
 117                 my @locations = (
 118                     '__title' =>
 119 "<b>Map:</b> $map_url&nbsp;&nbsp;&nbsp;",
 120                     '__tableattrs' => "width=\"$width\"",
 121                     '__multicol'   => $multicol,
 122                     'Map version'  => $map_version_id." (location: ".$loc->location_id().")",
 123                     'Chromosome'   => $loc->lg_name(),
 124                     'Position    ' => sprintf( '%.2f', $loc->position() )." ".$map->get_units(),
 125                     'Confidence'   => $loc->confidence(),
 126                     'Protocol'     => $protocol
 127                 );
 128                 if ($subscript) {
 129                     push( @locations, ( 'Subscript' => $subscript ) );
 130                 }
 131                 $locations_html .= '<td width = "25%">';
 132                 $locations_html .=
 133                   CXGN::Page::FormattingHelpers::info_table_html(@locations);
 134                 $locations_html .= '</td>';
 135                 $locations_html .= '<td align="center">';
 136                 ####$map_factory = CXGN::Cview::MapFactory->new($dbh);
 137 ####### my $map=$map_factory->create({map_version_id=>$map_version_id});
 138 ####### my $map_version_id=$map->get_id();
 139
 140                 my $hilite_name = $marker_name;
 141                 if ($subscript) {
 142                     $hilite_name .= $subscript;
 143                 }
 144                 my $chromosome = CXGN::Cview::ChrMarkerImage->new(
 145                      "", 240, 150, $dbh, $lg_name, $map, $hilite_name,
 146                      $c->get_conf("basepath"),  $c->get_conf('tempfiles_subdir')."/cview",
 147                  );
 148                 my ( $image_path, $image_url ) =
 149                   $chromosome->get_image_filename();
 150                 my $chr_link =
 151 qq|<img src="$image_url" usemap="#map$count" border="0" alt="" />|;
 152                 $chr_link .= $chromosome->get_image_map("map$count");
 153                 $chr_link .= '<br />' . $map_name;
 154                 $count++;
 155                 $locations_html .= '<br />';
 156                 $locations_html .= $chr_link;
 157                 $locations_html .= '</td></tr></table>';
 158
 159
 160 #if we have a pcr experiment that was used to map this marker to this location, make a section for this experiment's data
 161                 if ( $pcr
 162                      and !grep { $_ == $pcr->pcr_experiment_id() }
 163                      @displayed_pcr )
 164                   {
 165                     $locations_html .=
 166                       '<table width="100%" cellspacing="0" cellpadding="0" border="0"><tr>';
 167                     my $pcr_bands    = $pcr->pcr_bands_hash_of_strings();
 168
 169                     my %pcr_bands_by_name = ();
 170                     my $sth = $dbh->prepare("SELECT organism.species || ' ' ||  stock.name FROM public.stock JOIN public.organism USING(organism_id) WHERE stock_id=?");
 171
 172                     foreach my $p (keys %$pcr_bands) {
 173
 174                       $sth->execute($p);
 175                       $pcr_bands_by_name{($sth->fetchrow_array)} = $pcr_bands->{$p};
 176                     }
 177
 178
 179                     my $digest_bands = $pcr->pcr_digest_bands_hash_of_strings();
 180
 181                     my %pcr_digest_bands_by_name = ();
 182                     foreach my $p (keys %$digest_bands) {
 183                       $sth->execute($p);
 184                       $pcr_digest_bands_by_name{($sth->fetchrow_array)} = $digest_bands->{$p};
 185                     }
 186
 187
 188                     my $pcr_bands_html =
 189                       CXGN::Page::FormattingHelpers::info_table_html(
 190                                                                      __border => 0,
 191                                                                      __sub    => 1,
 192
 193                                                                      %pcr_bands_by_name,
 194                                                                     );
 195                     my $digest_bands_html =
 196                       CXGN::Page::FormattingHelpers::info_table_html(
 197                                                                      __border => 0,
 198                                                                      __sub    => 1,
 199                                                                      %pcr_digest_bands_by_name,
 200                                                                     );
 201                     my $mg = '';
 202                     if ( $pcr->mg_conc() ) {
 203                       $mg = $pcr->mg_conc() . 'mM';
 204                     }
 205                     my $temp = '';
 206                     if ( $pcr->temp() ) {
 207                         $temp = $pcr->temp() . '&deg;C';
 208                     }
 209                     $locations_html .= '<td>';
 210                     my $fwd = $pcr->fwd_primer()
 211                       || '<span class="ghosted">Unknown</span>';
 212                     my $rev = $pcr->rev_primer()
 213                       || '<span class="ghosted">Unknown</span>';
 214                     my $enz = $pcr->enzyme()  || 'unknown enzyme' ;
 215                     my $additional_enzymes = $pcr->additional_enzymes();
 216                     my $dcaps = $pcr->dcaps_primer();
 217                     $temp ||= '<span class="ghosted">Unknown</span>';
 218                     $mg   ||= '<span class="ghosted">Unknown</span>';
 219                     my $digest_title = "Digested band sizes (using $enz)";
 220
 221                     unless ($digest_bands_html) {
 222                         $digest_title      = '&nbsp;';
 223                         $digest_bands_html = '&nbsp;';
 224                     }
 225
 226                     ### TODO ###
 227                     my ( $dcaps_left, $dcaps_right );
 228
 229                     if ($dcaps) {
 230                       $dcaps_left  = "dCAPS primer (5'-3')";
 231                       $dcaps_right = "<span class=\"sequence\">$dcaps</span>";
 232                     }
 233                     ###########
 234                     my $pcr_seq = $pcr->get_sequences;
 235
 236                     my ($aspe, $aspe_primers);
 237                     $aspe_primers = join ('<BR>' ,  @{ $pcr_seq->{ASPE_primer} }  ) if  $pcr_seq->{ASPE_primer}  ;
 238                     if ($aspe_primers) {
 239                       $aspe = "ASPE primers (5'-3')";
 240                       $aspe_primers = "<span class=\"snp\">$aspe_primers</span>"
 241                     }
 242                     my ($snp, $snp_nuc);
 243                     $snp_nuc = join ('<BR>' ,  @{ $pcr_seq->{SNP} }  ) if  $pcr_seq->{SNP}  ;
 244                     if ($snp_nuc) {
 245                       $snp = "SNP nucleotide";
 246                       $snp_nuc = "<span class=\"snp\">$snp_nuc</span>"
 247                     }
 248                     my ($three_prime, $seq3);
 249                     $seq3 = join ('<BR>' ,  @{ $pcr_seq->{three_prime_flanking_region} }  ) if  $pcr_seq->{three_prime_flanking_region}  ;
 250                     if ($seq3) {
 251                       $three_prime = "3' flanking region";
 252                       $seq3 = "<span class=\"assay\">$seq3</span>"
 253                     }
 254                     my ($five_prime, $seq5);
 255                     $seq5 = join ('<BR>' ,  @{ $pcr_seq->{five_prime_flanking_region} }  ) if  $pcr_seq->{five_prime_flanking_region}  ;
 256                     if ($seq5) {
 257                       $five_prime = "5' flanking region";
 258                       $seq5 = "<span class=\"assay\">$seq5</span>"
 259                     }
 260                     my ($indel, $indel_seq);
 261                     $indel_seq = join ('<BR>' ,  @{ $pcr_seq->{indel} }  ) if  $pcr_seq->{indel}  ;
 262                     if ($indel_seq) {
 263                       $indel = "Indel";
 264                       $indel_seq = "<span class=\"indel\">$indel_seq</span>"
 265                     }
 266                     $locations_html .= '<br />';
 267                     $locations_html .=
 268                       CXGN::Page::FormattingHelpers::info_table_html(
 269                         '__title' =>
 270 "PCR data&nbsp;&nbsp;&nbsp;<span class=\"tinytype\">Exp. ID "
 271                           . $pcr->pcr_experiment_id()
 272                           . "</span>",
 273                         "Forward primer (5'-3')" =>
 274                           "<span class=\"sequence\">$fwd</span>",
 275                         "Reverse primer (5'-3')" =>
 276                           "<span class=\"sequence\">$rev</span>",
 277                         $dcaps_left                     => $dcaps_right,
 278                        'Accessions and product sizes'  => $pcr_bands_html,
 279                         $digest_title                   => $digest_bands_html,
 280                         'Enzymes'                       => $additional_enzymes,
 281                         'Approximate temperature'       => $temp,
 282                         'Mg<sup>+2</sup> concentration' => $mg,
 283                         '__multicol'                    => 3,
 284                         '__tableattrs'                  => "width=\"100%\"",
 285                       ) if ($protocol ne 'SNP');
 286                     my ($snpdb_format, $snpdb);
 287                     if ($snp_nuc) {
 288                       $snpdb = "SNPdb format";
 289                       my @fives = @{ $pcr_seq->{five_prime_flanking_region} } ;
 290                       my @threes = @{ $pcr_seq->{three_prime_flanking_region} } ;
 291                       my @snps  =  @{ $pcr_seq->{SNP} };
 292                       for my $i ( 0 .. (scalar( @snps ) -1 ) ) {
 293                         my $snp_string =  $snps[$i] ;
 294                         my $formatted = "[" . substr($snp_string, 0, 1) . "/" . substr($snp_string, -1) ."]";
 295                         my $five_p = $fives[$i];
 296                         my $three_p = $threes[$i];
 297                         $snpdb_format .= $five_p . $formatted ."<BR />" .  $three_p . "<BR />";
 298                       }
 299                     }
 300                     $locations_html .=
 301                       CXGN::Page::FormattingHelpers::info_table_html(
 302                         '__title' =>
 303 "Assay data&nbsp;&nbsp;<span class=\"tinytype\"></span>",
 304                        $five_prime       => $seq5,
 305                        $three_prime       => $seq3,
 306                        $snpdb => $snpdb_format,
 307                        $aspe  => $aspe_primers,
 308                        $snp   => $snp_nuc,
 309                        $indel => $indel_seq,
 310                        '__multicol'    => 2,
 311                       '__tableattrs'   => "width=\"100%\"",
 312                       ) if $aspe || $indel || ($protocol eq "SNP");
 313                     $locations_html .= '</td></tr></table>';
 314                     push( @displayed_pcr, $pcr->pcr_experiment_id() )
 315                   }
 316             }
 317         }
 318     }
 319 }
 320
 321 </%perl>
 322
 323 <&| /page/info_section.mas, title=>'Mapped locations', collapsible=>1, collapsed=>0 &>
 324   <% $locations_html %>
 325 </&>