lib/SGN/Controller/Cview.pm

   1
   2 use Modern::Perl;
   3
   4 package SGN::Controller::Cview;
   5
   6 use Moose;
   7 use namespace::autoclean;
   8
   9 BEGIN { extends "Catalyst::Controller" }
  10 with 'Catalyst::Component::ApplicationAttribute';
  11
  12 use Cache::File;
  13 use File::Spec;
  14 use HTML::Entities;
  15 use URI::Escape;
  16
  17 use CXGN::Cview::MapFactory;
  18 use CXGN::Cview::Map::Tools;
  19 use CXGN::Cview::MapOverviews::Generic;
  20 use CXGN::Phenome::Population;
  21 use CXGN::People::Person;
  22 #use CXGN::Login;
  23 use CXGN::Map;
  24
  25 has 'cview_default_map_id' => (
  26     is       => 'rw',
  27     isa      => 'Str',
  28     required => 1,
  29 );
  30
  31 sub auto :Args(0) {
  32     my ($self, $c) = @_;
  33
  34     # push some useful stuff on the stash
  35     #
  36     $c->stash->{dbh} = $c->dbc->dbh();
  37
  38     $c->stash->{map_url} = '/cview/map.pl';
  39     $c->stash->{chr_url} = '/cview/view_chromosome.pl';
  40     $c->stash->{marker_search_url} = '/search/markers/markersearch.pl';
  41     $c->stash->{comp_maps_url} = '/cview/view_maps.pl';
  42     $c->stash->{default_map_id} = $self->cview_default_map_id;
  43     $c->stash->{referer} = $c->req->referer();
  44     $c->stash->{tempdir} = $c->get_conf("tempfiles_subdir")."/cview";
  45     $c->stash->{basepath} = $c->get_conf("basepath");
  46
  47     $c->log->debug("BASEPATH: ".($c->stash->{basepath})) if $c->debug;
  48
  49     return 1;
  50 }
  51
  52 # for backwards compatibility
  53 sub alt_index :Path("/cview/index.pl") :Args(0) {
  54     my ($self, $c) = @_;
  55     $c->forward("index");
  56 }
  57
  58 sub index :Path("/cview") :Args(0) {
  59     my ($self, $c) = @_;
  60
  61     $c->stash->{template} = '/cview/index.mas';
  62
  63     my $map_factory = CXGN::Cview::MapFactory->new($c->dbc->dbh);
  64     my @maps = $map_factory->get_system_maps();
  65
  66     my %map_by_species;
  67
  68     foreach my $map (@maps) {
  69         my $species = $map->get_common_name();
  70         my $short_name = $map->get_short_name();
  71         my $long_name = $map->get_long_name() || $short_name;
  72         my $id = $map->get_id();
  73         push @{$map_by_species{$species} },
  74              qq{<a href="}.$c->stash->{map_url}.qq{?map_version_id=$id">}.encode_entities($short_name).'</a>: '.encode_entities($long_name)."\n";
  75     }
  76     $c->stash->{map_by_species} = \%map_by_species;
  77     $c->forward("View::Mason");
  78 }
  79
  80 sub map :Path("/cview/map.pl") :Args(0) {
  81     my ($self, $c) = @_;
  82
  83     my @params = qw | map_id map_version_id size hilite physical force map_items |;
  84
  85     foreach my $param (@params) {
  86         $c->stash->{$param} = $c->req->param($param) || '';
  87     }
  88
  89     my %marker_info;
  90
  91     # set up a cache for the map statistics, using Cache::File
  92     #
  93     my $cache_file_dir = File::Spec->catfile($c->stash->{basepath},
  94                                              $c->stash->{tempdir}, "cache_file");
  95
  96     tie %marker_info, 'Cache::File', { cache_root => $cache_file_dir };
  97
  98     # report some unusual conditions to the user.
  99     #
 100     my $message = "";
 101
 102     # if the map_id was supplied, convert immediately to map_version_id
 103     #
 104     if ($c->stash->{map_id} && !$c->stash->{map_version_id}) {
 105         $c->stash->{map_version_id} = CXGN::Cview::Map::Tools::find_current_version($c->stash->{dbh}, $c->stash->{map_id});
 106     }
 107     # get the map data using the CXGN::Map API.
 108     #
 109     my $map_factory = CXGN::Cview::MapFactory->new($c->stash->{dbh});
 110     my $map = $map_factory ->create({ map_version_id => $c->stash->{map_version_id} });
 111
 112     if (!$map) {
 113         $c->stash->{template} = '/cview/map/missing.mas';
 114         $c->stash->{title} = "The map you are trying to view does not exist!";
 115         return;
 116     }
 117
 118     my $private = $self->data_is_private($c, $c->stash->{dbh}, $c->stash->{map_version_id});
 119
 120     $c->stash->{long_name} = $map->get_long_name();
 121     $c->stash->{short_name} = $map->get_short_name();
 122
 123
 124     my @hilite_markers = split /\s+|\,\s*/, $c->{stash}->{hilite};
 125
 126     $c->stash->{hilite_markers} = \@hilite_markers;
 127
 128     # calculate the size of the image based on the size parameter
 129     #
 130     my $image_height = 160;
 131     my $size = $c->stash->{size} || 0;
 132
 133     if ($size < 0 ) { $size = 0;  }
 134     if ($size > 10) { $size = 10; }
 135
 136     $c->stash->{size} = $size || 0;
 137
 138     $image_height = $image_height + $image_height * $size /2;
 139     my $image_width = 820;
 140
 141     # create an appropriate overview diagram - physical or generic
 142     # (the generic will also provide an appropriate overview for the fish map).
 143     #
 144     my $map_overview = CXGN::Cview::MapOverviews::Generic ->
 145       new($map,
 146           {
 147            force            => $c->stash->{force},
 148            basepath         => $c->stash->{basepath},
 149            tempfiles_subdir => $c->stash->{tempdir},
 150            dbh              => $c->stash->{dbh},
 151           });
 152
 153     $map_overview->set_image_height($image_height);
 154     $map_overview->set_image_width($image_width);
 155
 156     # deal with marker names to be highlighted on the overview diagram
 157     # (the ones to be requested to be hilited using the hilite feature)
 158     #
 159     my @map_items = split /\n/, $c->stash->{map_items};
 160
 161     $map_overview->get_map()->set_map_items(@map_items);
 162     foreach my $hm (@hilite_markers) {
 163       $map_overview -> hilite_marker($hm);
 164     }
 165
 166     # generate the marker list for use in the URL links
 167     #
 168     my $hilite_encoded = URI::Escape::uri_escape(join (" ", @hilite_markers));
 169
 170     # render the map and get the imagemap
 171     #
 172     $map_overview -> render_map();
 173
 174     $c->stash->{overview_image} = $map_overview->get_image_html();
 175
 176     # get the markers that could not be hilited
 177     #
 178     my @markers_not_found = $map_overview -> get_markers_not_found();
 179
 180     if (@markers_not_found) {
 181       $message .= "The following markers requested for hiliting were not found on this map (click to search on other maps):<br />";
 182       foreach my $m (@markers_not_found) {
 183         $message .= "&nbsp;&nbsp;<a href=\"/search/markers/markersearch.pl?searchtype=exactly&amp;name=$m\">$m</a>";
 184       }
 185       $message .= "<br />\n";
 186     }
 187
 188     # get chromosome stats and cache them
 189     #
 190     my @chr_names = $map->get_chromosome_names();
 191     my $hash_key = '';
 192
 193     for (my $i=0; $i<@chr_names; $i++) {
 194         $hash_key = $c->stash->{map_version_id}."-".$i;
 195         if (!exists($marker_info{$hash_key}) || $c->stash->{force}) {
 196             $marker_info{$hash_key} = $map->get_marker_count($chr_names[$i]);
 197         }
 198     }
 199
 200     if (!exists($marker_info{$c->stash->{map_version_id}}) || $c->stash->{force}) {
 201         $marker_info{$c->stash->{map_version_id}} = $map->get_map_stats();
 202     }
 203     my $chr_info = '';
 204
 205     my @chr_stats = ();
 206     for (my $i=0; $i<@chr_names; $i++) {
 207         my $chr_link .= "<a href=\"".$c->stash->{chr_url}."?map_version_id=".$c->stash->{map_version_id}."&amp;chr_nr=$chr_names[$i]&amp;hilite=".$hilite_encoded."\">
 208 <b>Chromosome $chr_names[$i]</b></a>";
 209         my $marker_link = join '',
 210            qq|<a href="/search/markers/markersearch.pl?w822_nametype=starts+with&w822_marker_name=&w822_mapped=on&w822_species=Any&w822_protos=Any&w822_colls=Any&w822_pos_start=&w822_pos_end=&w822_confs=Any&w822_submit=Search&w822_chromos=$chr_names[$i]&w822_maps=| . $c->stash->{map_id} . '">' . $marker_info{$c->stash->{map_version_id} . '-' . $i} . "</a>\n";
 211
 212         push @chr_stats, [ $chr_link, $marker_link, $marker_info{$c->stash->{map_version_id}."-".$i} ];
 213     }
 214
 215 ##    my @chromosome_stats = map { $marker_info{$c->stash->{map_version_id}."-".$_}}  $map->get_chromosome_names();
 216
 217     $c->stash->{message} = $message;
 218     $c->stash->{abstract} = $map->get_abstract();
 219     $c->stash->{can_overlay} = $map->can_overlay();
 220
 221     $c->stash->{marker_stats} = $marker_info{$c->stash->{map_version_id}};
 222
 223     $c->stash->{chromosome_stats} = \@chr_stats;
 224     $c->stash->{template} = "/cview/map/index.mas";
 225     $c->forward("View::Mason");
 226 }
 227
 228
 229 sub data_is_private {
 230     my $self = shift;
 231     my $c = shift;
 232     my $dbh = shift;
 233     my $map_version_id = shift;
 234
 235     if ($map_version_id!~/^\d+$/) { return ''; }
 236     my $genetic_map = CXGN::Map->new($dbh, { map_version_id=>$map_version_id});
 237     my $pop_id = $genetic_map->get_population_id();
 238     my $pop = CXGN::Phenome::Population->new($dbh, $pop_id);
 239     my $is_public = $pop->get_privacy_status();
 240
 241     my ($login_id, $user_type);
 242     if ($c->user()) {
 243         #my ($login_id, $user_type) = CXGN::Login->new($dbh)->has_session();
 244         $user_type = $c->user()->get_object->get_user_type();
 245         $login_id = $c->user()->get_object->get_sp_person_id();
 246     }
 247
 248     if ($is_public ||
 249         $user_type && $user_type eq 'curator' ||
 250         $login_id  && $login_id == $pop->get_sp_person_id()
 251         )  {
 252         return undef;
 253     }
 254     else {
 255
 256            my $owner_id = $pop->get_sp_person_id();
 257
 258
 259            my $submitter = CXGN::People::Person->new($dbh, $owner_id);
 260            no warnings 'uninitialized';
 261            my $submitter_name = $submitter->get_first_name()." ".$submitter->get_last_name();
 262            my $submitter_link = qq |<a href="/solpeople/personal-info.pl?sp_person_id=$owner_id">$submitter_name</a> |;
 263
 264            my $private = qq | <p>This genetic map is not public yet.
 265                       If you would like to know more about this data,
 266                       please contact the owner of the data: <b>$submitter_link</b>
 267                       or email to SGN:
 268                       <a href=mailto:sgn-feedback\@sgn.cornell.edu>
 269                       sgn-feedback\@sgn.cornell.edu</a>.
 270                     </p> |;
 271
 272          return $private;
 273     }
 274
 275 }
 276
 277
 278 sub chromosome :Path("/cview/view_chromosome.pl") :Args(0) {
 279     my ($self, $c) = @_;
 280
 281     my @params = qw | map_id map_version_id chr_nr cM zoom show_physical show_ruler show_IL comp_map_id comp_map_version_id comp_chr color_model map_chr_select size hilite cM_start cM_end confidence show_zoomed marker_type show_offsets force clicked |;
 282
 283     foreach my $param (@params) {
 284         $c->stash->{$param}= $c->req->param($param);
 285     }
 286
 287     $c->stash->{template} = '/cview/chr/index.mas';
 288     $c->forward("View::Mason");
 289 }
 290
 291
 292 sub maps :Path("/cview/view_maps.pl") :Args(0) {
 293     my ($self, $c) = @_;
 294
 295     $c->stash->{template} = '/cview/map/comparison.mas';
 296     $c->stash->{dbh} = $c->dbc->dbh();
 297
 298     my @params = qw | center_map center_map_version_id show_physical show_ruler show_IL left_map left_map_version_id right_map right_map_version_id color_model |;
 299     foreach my $param (@params) {
 300         $c->stash->{$param} = $c->req->param($param);
 301     }
 302     $c->forward("View::Mason");
 303 }
 304
 305
 306 1;