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                 my $map_name = $map->get_short_name();
  94                 if ($map_version_id) {
  95                     $map_id = $map->get_id();
  96
  97                     if (    $map_id
  98                         and $map_name
  99                         and defined($lg_name)
 100                         and defined($position) )
 101                     {
 102                         $map_url =
 103 "<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>";
 104                     }
 105                 }
 106                 else {
 107                     $map_url =
 108                       '<span class="ghosted">Map data not available</span>';
 109                 }
 110                 my $multicol = 1;
 111                 my $width    = "200px";
 112                 if ( $subscript and $multicol > 1 ) { $multicol++; }
 113                 my @locations = (
 114                     '__title' =>
 115 "<b>Map:</b> $map_url&nbsp;&nbsp;&nbsp;<span class=\"tinytype\">Loc. ID "
 116                       . $loc->location_id()
 117                       . "</span>",
 118                     '__tableattrs' => "width=\"$width\"",
 119                     '__multicol'   => $multicol,
 120                     'Chromosome'   => $loc->lg_name(),
 121                     'Position    ' => sprintf( '%.2f cM', $loc->position() ),
 122                     'Confidence'   => $loc->confidence(),
 123                     'Protocol'     => $protocol
 124                 );
 125                 if ($subscript) {
 126                     push( @locations, ( 'Subscript' => $subscript ) );
 127                 }
 128                 $locations_html .= '<td width = "25%">';
 129                 $locations_html .=
 130                   CXGN::Page::FormattingHelpers::info_table_html(@locations);
 131                 $locations_html .= '</td>';
 132                 $locations_html .= '<td align="center">';
 133                 ####$map_factory = CXGN::Cview::MapFactory->new($dbh);
 134 ####### my $map=$map_factory->create({map_version_id=>$map_version_id});
 135 ####### my $map_version_id=$map->get_id();
 136
 137                 my $hilite_name = $marker_name;
 138                 if ($subscript) {
 139                     $hilite_name .= $subscript;
 140                 }
 141                 my $chromosome = CXGN::Cview::ChrMarkerImage->new(
 142                      "", 150, 150, $dbh, $lg_name, $map, $hilite_name,
 143                      $c->get_conf("basepath"),  $c->get_conf('tempfiles_subdir')."/cview",
 144                  );
 145                 my ( $image_path, $image_url ) =
 146                   $chromosome->get_image_filename();
 147                 my $chr_link =
 148 qq|<img src="$image_url" usemap="#map$count" border="0" alt="" />|;
 149                 $chr_link .= $chromosome->get_image_map("map$count");
 150                 $chr_link .= '<br />' . $map_name;
 151                 $count++;
 152                 $locations_html .= '<br />';
 153                 $locations_html .= $chr_link;
 154                 $locations_html .= '</td></tr></table>';
 155
 156 #if we have a pcr experiment that was used to map this marker to this location, make a section for this experiment's data
 157                 if ( $pcr
 158                     and !grep { $_ == $pcr->pcr_experiment_id() }
 159                     @displayed_pcr )
 160                 {
 161                     $locations_html .=
 162 '<table width="100%" cellspacing="0" cellpadding="0" border="0"><tr>';
 163                     my $pcr_bands    = $pcr->pcr_bands_hash_of_strings();
 164                     my $digest_bands = $pcr->pcr_digest_bands_hash_of_strings();
 165                     my $pcr_bands_html =
 166                       CXGN::Page::FormattingHelpers::info_table_html(
 167                         __border => 0,
 168                         __sub    => 1,
 169                         map {
 170                             my $accession_name =
 171                               CXGN::Accession->new( $dbh, $_ )->verbose_name;
 172                             $accession_name => $pcr_bands->{$_}
 173                           } keys %$pcr_bands,
 174                       );
 175                     my $digest_bands_html =
 176                       CXGN::Page::FormattingHelpers::info_table_html(
 177                         __border => 0,
 178                         __sub    => 1,
 179                         map {
 180                             my $accession_name =
 181                               CXGN::Accession->new( $dbh, $_ )->verbose_name();
 182                             $accession_name => $digest_bands->{$_};
 183                           } keys %$digest_bands,
 184                       );
 185                     my $mg = '';
 186                     if ( $pcr->mg_conc() ) {
 187                         $mg = $pcr->mg_conc() . 'mM';
 188                     }
 189                     my $temp = '';
 190                     if ( $pcr->temp() ) {
 191                         $temp = $pcr->temp() . '&deg;C';
 192                     }
 193                     $locations_html .= '<td>';
 194                     my $fwd = $pcr->fwd_primer()
 195                       || '<span class="ghosted">Unknown</span>';
 196                     my $rev = $pcr->rev_primer()
 197                       || '<span class="ghosted">Unknown</span>';
 198                     my $enz = $pcr->enzyme() || 'unknown enzyme';
 199                     my $dcaps = $pcr->dcaps_primer();
 200                     $temp ||= '<span class="ghosted">Unknown</span>';
 201                     $mg   ||= '<span class="ghosted">Unknown</span>';
 202                     my $digest_title = "Digested band sizes (using $enz)";
 203
 204                     unless ($digest_bands_html) {
 205                         $digest_title      = '&nbsp;';
 206                         $digest_bands_html = '&nbsp;';
 207                     }
 208
 209                     ### TODO ###
 210                     my ( $dcaps_left, $dcaps_right );
 211
 212                     if ($dcaps) {
 213                         $dcaps_left  = "dCAPS primer (5'-3')";
 214                         $dcaps_right = "<span class=\"sequence\">$dcaps</span>";
 215                     }
 216
 217                     $locations_html .=
 218                       CXGN::Page::FormattingHelpers::info_table_html(
 219                         '__title' =>
 220 "PCR data&nbsp;&nbsp;&nbsp;<span class=\"tinytype\">Exp. ID "
 221                           . $pcr->pcr_experiment_id()
 222                           . "</span>",
 223                         "Forward primer (5'-3')" =>
 224                           "<span class=\"sequence\">$fwd</span>",
 225                         "Reverse primer (5'-3')" =>
 226                           "<span class=\"sequence\">$rev</span>",
 227                         $dcaps_left                     => $dcaps_right,
 228                         'Accessions and product sizes'  => $pcr_bands_html,
 229                         $digest_title                   => $digest_bands_html,
 230                         'Approximate temperature'       => $temp,
 231                         'Mg<sup>+2</sup> concentration' => $mg,
 232                         '__multicol'                    => 3,
 233                         '__tableattrs'                  => "width=\"100%\"",
 234                       );
 235                     $locations_html .= '</td></tr></table>';
 236                     push( @displayed_pcr, $pcr->pcr_experiment_id() );
 237                 }
 238             }
 239         }
 240     }
 241 }
 242
 243 ###print blue_section_html('Mapped locations',$locations_html);
 244 </%perl>
 245
 246 <&| /page/info_section.mas, title=>'Mapped locations', collapsible=>1, collapsed=>0 &>
 247   <% $locations_html %>
 248 </&>