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 /><br /><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 v$map_version_id</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    = "200px";
 116                 if ( $subscript and $multicol > 1 ) { $multicol++; }
 117                 my @locations = (
 118                     '__title' =>
 119 "<b>Map:</b> $map_url&nbsp;&nbsp;&nbsp;<span class=\"tinytype\">Loc. ID "
 120                       . $loc->location_id()
 121                       . "</span>",
 122                     '__tableattrs' => "width=\"$width\"",
 123                     '__multicol'   => $multicol,
 124                     'Chromosome'   => $loc->lg_name(),
 125                     'Position    ' => sprintf( '%.2f cM', $loc->position() ),
 126                     'Confidence'   => $loc->confidence(),
 127                     'Protocol'     => $protocol
 128                 );
 129                 if ($subscript) {
 130                     push( @locations, ( 'Subscript' => $subscript ) );
 131                 }
 132                 $locations_html .= '<td width = "25%">';
 133                 $locations_html .=
 134                   CXGN::Page::FormattingHelpers::info_table_html(@locations);
 135                 $locations_html .= '</td>';
 136                 $locations_html .= '<td align="center">';
 137                 ####$map_factory = CXGN::Cview::MapFactory->new($dbh);
 138 ####### my $map=$map_factory->create({map_version_id=>$map_version_id});
 139 ####### my $map_version_id=$map->get_id();
 140
 141                 my $hilite_name = $marker_name;
 142                 if ($subscript) {
 143                     $hilite_name .= $subscript;
 144                 }
 145                 my $chromosome = CXGN::Cview::ChrMarkerImage->new(
 146                      "", 150, 150, $dbh, $lg_name, $map, $hilite_name,
 147                      $c->get_conf("basepath"),  $c->get_conf('tempfiles_subdir')."/cview",
 148                  );
 149                 my ( $image_path, $image_url ) =
 150                   $chromosome->get_image_filename();
 151                 my $chr_link =
 152 qq|<img src="$image_url" usemap="#map$count" border="0" alt="" />|;
 153                 $chr_link .= $chromosome->get_image_map("map$count");
 154                 $chr_link .= '<br />' . $map_name;
 155                 $count++;
 156                 $locations_html .= '<br />';
 157                 $locations_html .= $chr_link;
 158                 $locations_html .= '</td></tr></table>';
 159
 160
 161 #if we have a pcr experiment that was used to map this marker to this location, make a section for this experiment's data
 162                 if ( $pcr
 163                      and !grep { $_ == $pcr->pcr_experiment_id() }
 164                      @displayed_pcr )
 165                   {
 166                     $locations_html .=
 167                       '<table width="100%" cellspacing="0" cellpadding="0" border="0"><tr>';
 168                     my $pcr_bands    = $pcr->pcr_bands_hash_of_strings();
 169
 170                     my %pcr_bands_by_name = ();
 171                     my $sth = $dbh->prepare("SELECT organism.species || ' ' ||  stock.name FROM public.stock JOIN public.organism USING(organism_id) WHERE stock_id=?");
 172
 173                     foreach my $p (keys %$pcr_bands) {
 174
 175                       $sth->execute($p);
 176                       $pcr_bands_by_name{($sth->fetchrow_array)} = $pcr_bands->{$p};
 177                     }
 178
 179
 180                     my $digest_bands = $pcr->pcr_digest_bands_hash_of_strings();
 181
 182                     my %pcr_digest_bands_by_name = ();
 183                     foreach my $p (keys %$digest_bands) {
 184                       $sth->execute($p);
 185                       $pcr_digest_bands_by_name{($sth->fetchrow_array)} = $digest_bands->{$p};
 186                     }
 187
 188
 189                     my $pcr_bands_html =
 190                       CXGN::Page::FormattingHelpers::info_table_html(
 191                                                                      __border => 0,
 192                                                                      __sub    => 1,
 193
 194                                                                      %pcr_bands_by_name,
 195                                                                     );
 196                     my $digest_bands_html =
 197                       CXGN::Page::FormattingHelpers::info_table_html(
 198                                                                      __border => 0,
 199                                                                      __sub    => 1,
 200                                                                      %pcr_digest_bands_by_name,
 201                                                                     );
 202                     my $mg = '';
 203                     if ( $pcr->mg_conc() ) {
 204                       $mg = $pcr->mg_conc() . 'mM';
 205                     }
 206                     my $temp = '';
 207                     if ( $pcr->temp() ) {
 208                         $temp = $pcr->temp() . '&deg;C';
 209                     }
 210                     $locations_html .= '<td>';
 211                     my $fwd = $pcr->fwd_primer()
 212                       || '<span class="ghosted">Unknown</span>';
 213                     my $rev = $pcr->rev_primer()
 214                       || '<span class="ghosted">Unknown</span>';
 215                     my $enz = $pcr->enzyme() || 'unknown enzyme';
 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 .=
 267                       CXGN::Page::FormattingHelpers::info_table_html(
 268                         '__title' =>
 269 "PCR data&nbsp;&nbsp;&nbsp;<span class=\"tinytype\">Exp. ID "
 270                           . $pcr->pcr_experiment_id()
 271                           . "</span>",
 272                         "Forward primer (5'-3')" =>
 273                           "<span class=\"sequence\">$fwd</span>",
 274                         "Reverse primer (5'-3')" =>
 275                           "<span class=\"sequence\">$rev</span>",
 276                         $dcaps_left                     => $dcaps_right,
 277                        'Accessions and product sizes'  => $pcr_bands_html,
 278                         $digest_title                   => $digest_bands_html,
 279                         'Approximate temperature'       => $temp,
 280                         'Mg<sup>+2</sup> concentration' => $mg,
 281                         '__multicol'                    => 3,
 282                         '__tableattrs'                  => "width=\"100%\"",
 283                       );
 284                     $locations_html .=
 285                       CXGN::Page::FormattingHelpers::info_table_html(
 286                         '__title' =>
 287 "Assay data&nbsp;&nbsp;<span class=\"tinytype\"></span>",
 288                        $three_prime       => $seq3,
 289                        $five_prime       => $seq5,
 290                        $aspe  => $aspe_primers,
 291                        $snp   => $snp_nuc,
 292                        $indel => $indel_seq,
 293                        '__multicol'    => 2,
 294                       '__tableattrs'   => "width=\"100%\"",
 295                       ) if $aspe || $indel;
 296                     $locations_html .= '</td></tr></table>';
 297                     push( @displayed_pcr, $pcr->pcr_experiment_id() );
 298                 }
 299             }
 300         }
 301     }
 302 }
 303
 304 </%perl>
 305
 306 <&| /page/info_section.mas, title=>'Mapped locations', collapsible=>1, collapsed=>0 &>
 307   <% $locations_html %>
 308 </&>