lib/SGN/Controller/Marker.pm

   1 =head1 NAME
   2
   3 SGN::Controller::Marker - controller for marker-related stuff
   4
   5 =cut
   6
   7 package SGN::Controller::Marker;
   8 use Moose;
   9 use namespace::autoclean;
  10 use CXGN::Marker::Search;
  11 use CXGN::Marker::SearchMatView;
  12 use strict;
  13
  14 BEGIN { extends 'Catalyst::Controller' }
  15
  16 use File::Spec::Functions;
  17
  18
  19 =head1 PUBLIC ACTIONS
  20
  21 =head2 view_rflp_image
  22
  23 Public path: /marker/<marker_id>/rflp_image/view
  24
  25 =cut
  26
  27 sub view_rflp_image: Chained('get_marker') PathPart('rflp_image/view') :Args(0) {
  28   my ( $self, $c, ) = @_;
  29
  30   my $image_size = $c->req->query_parameters->{size};
  31
  32   my $image_location = $self->rflp_image_link( $c, $c->stash->{marker} )
  33       or $c->throw_404( "RFLP image not found for SGN-M".$c->stash->{marker}->marker_id );
  34
  35   $c->stash(
  36       template => '/markers/view_rflp.mas',
  37
  38       image_location => $image_location,
  39       image_size     => $image_size
  40      );
  41 }
  42
  43
  44 =head2 marker_details
  45
  46 Public path: /marker/SGN-M23545/details
  47
  48 Show the HTML detail page for this marker.
  49
  50 =cut
  51
  52 sub marker_details: Chained('get_marker') PathPart('details') :Args(0) {
  53   my ( $self, $c ) = @_;
  54
  55   $c->stash(
  56       template  => '/markers/index.mas',
  57       dbh       => $c->dbc->dbh,
  58      );
  59 }
  60
  61 =head2 get_marker
  62
  63 Public path: /marker/SGN-M23545
  64
  65 Chaining base for fetching the marker indicated by the given marker
  66 id.  The marker ID is an SGN-M identifier.
  67
  68 =cut
  69
  70 sub get_marker: Chained('/') PathPart('marker') :CaptureArgs(1) {
  71     my ( $self, $c, $marker ) = @_;
  72
  73     if ($marker =~/^SGN-M(\d+)*/i) {
  74         my ($marker_id) = $marker =~ /^SGN-M(\d+)$/i;
  75         $c->stash->{marker} = CXGN::Marker->new( $c->dbc->dbh, $marker_id);
  76         $c->stash->{marker_id} = $marker_id;
  77     } else {
  78         $c->throw_404('No marker found with that ID');
  79     }
  80 }
  81
  82 =head2 view_by_name
  83
  84 Public Path: /marker/view_by_name/$name
  85
  86 Path Params:
  87     name = marker unique name
  88
  89 Search for the marker that matches the provided marker name.
  90 If 1 match is found, display the marker detail page.  Display an
  91 error message if no matches are found.
  92
  93 =cut
  94
  95 sub view_marker_by_name :Path('/marker/view_by_name') CaptureArgs(1) {
  96     my ($self, $c, $marker_query) = @_;
  97     $self->search_marker($c, $marker_query);
  98 }
  99
 100
 101 ############ helper methods ########
 102
 103 # Returns the stuff that goes in the 'href' attribute of the 'a' tag for
 104 # an RFLP image, or undef if there is no image.
 105
 106 # =cut
 107
 108 sub rflp_image_link {
 109     my ( $class, $c, $marker ) = @_;
 110     my $marker_name = uc $marker->name_that_marker();
 111     my ( $dir ) = $marker_name =~ /^(CD|CT|PC|PG|TG|PCD2)/
 112         or return;
 113
 114     my $source = catfile( $c->get_conf('image_path'), 'rflp', $dir, "$marker_name.jpg" );
 115
 116     return unless -f $source;
 117
 118     return catfile( $c->get_conf('static_datasets_url'), 'images','rflp', $dir, "$marker_name.jpg" );
 119 }
 120
 121
 122 sub search_marker : Private {
 123     my ( $self, $c, $marker_query ) = @_;
 124     my $bcs_schema = $c->dbic_schema('Bio::Chado::Schema');
 125     my $dbh = $c->dbc->dbh();
 126
 127     # Get mapped markers
 128     my $msearch = CXGN::Marker::Search->new($dbh);
 129     $msearch->name_like($marker_query);
 130     $msearch->perform_search();
 131     my @mapped_marker_ids = $msearch->fetch_id_list();
 132     my @filtered_mapped_marker_ids = _uniq(@mapped_marker_ids);
 133     my $mapped_count = scalar @filtered_mapped_marker_ids;
 134
 135     # Get genotyped markers using matview
 136     my $mvsearch = CXGN::Marker::SearchMatView->new(bcs_schema => $bcs_schema);
 137     my $genotyped_marker_results = $mvsearch->query({
 138         name => $marker_query
 139     });
 140     my $genotyped_variants = $genotyped_marker_results->{'variants'};
 141     my $genotyped_count = scalar keys(%$genotyped_variants);
 142
 143
 144     # NO MATCH FOUND
 145     if ( ($mapped_count == 0) && ($genotyped_count == 0) ) {
 146         $c->stash->{template} = "generic_message.mas";
 147         $c->stash->{message} = "<strong>No Matching Marker Found</strong> ($marker_query)<br />You can view and search for markers from the <a href='/search/variants'>Marker Search Page</a>";
 148     }
 149
 150     # MULTIPLE MATCHES FOUND
 151     elsif ( ($mapped_count > 1) || ($genotyped_count > 1) || ($mapped_count == 1 && $genotyped_count == 1) ) {
 152         my $list = "<table style=\"border-spacing: 10px; border-collapse: separate;\">";
 153
 154         # Display mapped markers
 155         if ( $mapped_count > 0 ) {
 156             $list .= "<tr><td colspan='2'><strong>Mapped Markers:</strong></td></tr>";
 157             foreach my $marker_id (@filtered_mapped_marker_ids) {
 158                 my $marker = CXGN::Marker->new($dbh, $marker_id);
 159                 my $marker_name = $marker->name_that_marker();
 160
 161                 # Get map name from marker experiments
 162                 my $experiments = $marker->current_mapping_experiments();
 163                 my $map_name = "";
 164                 if ($experiments && @{$experiments} && grep { $_->{location} } @{$experiments} ) {
 165                     for my $experiment ( @{$experiments} ) {
 166                         if ( my $loc = $experiment->{location} ) {
 167                             my $map_version_id = $loc->map_version_id();
 168                             if ($map_version_id) {
 169                                 my $map_factory = CXGN::Cview::MapFactory->new($dbh);
 170                                 my $map = $map_factory->create({ map_version_id => $map_version_id } );
 171                                 $map_name = $map->get_short_name();
 172                             }
 173                         }
 174                     }
 175                 }
 176
 177                 my $url = "/search/markers/markerinfo.pl?marker_id=$marker_id";
 178                 $list .= "<tr><td><a href='$url'>$marker_name</a></td><td>$map_name</td></tr>";
 179             }
 180         }
 181
 182         # Display genotyped markers
 183         if ( $genotyped_count > 0 ) {
 184             $list .= "<tr><td colspan='2'><strong>Genotyped Markers:</strong></td></tr>";
 185             foreach my $variant_name (keys %$genotyped_variants) {
 186                 my $markers = $genotyped_variants->{$variant_name};
 187                 foreach my $marker (@$markers) {
 188                     my $url = "/variant/$variant_name/details";
 189                     $list .= "<tr><td><a href='$url'>" . $marker->{'marker_name'} . "</a></td>";
 190                     $list .= "<td>" . $marker->{'species_name'} . " (" . $marker->{'nd_protocol_name'} . ")</td></tr>";
 191                 }
 192             }
 193         }
 194
 195         $list .= "</table>";
 196         $c->stash->{template} = "generic_message.mas";
 197         $c->stash->{message} = "<strong>Markers Results</strong><br />" . $list;
 198     }
 199
 200     # 1 MATCH FOUND - FORWARD TO VIEW MARKER
 201     else {
 202         if ($mapped_count > 0) {
 203             my $marker_id = $filtered_mapped_marker_ids[0];
 204             $c->res->redirect('/search/markers/markerinfo.pl?marker_id=' . $marker_id, 301);
 205         }
 206         elsif ($genotyped_count > 0) {
 207             my $variant_name = (keys %$genotyped_variants)[0];
 208             $c->res->redirect('/variant/' . $variant_name . '/details', 301);
 209         }
 210         else {
 211             $c->stash->{template} = "generic_message.mas";
 212             $c->stash->{message} = "<strong>No Matching Marker Found</strong> ($marker_query)<br />You can view and search for markers from the <a href='/search/variants'>Marker Search Page</a>";
 213         }
 214     }
 215 }
 216
 217 sub _uniq : Private {
 218     my %seen;
 219     grep !$seen{$_}++, @_;
 220 }
 221
 222
 223 1;