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::Map;
  23
  24 has 'cview_default_map_id' => (
  25     is       => 'rw',
  26     isa      => 'Str',
  27     required => 1,
  28 );
  29
  30 sub auto :Args(0) {
  31     my ($self, $c) = @_;
  32
  33     # push some useful stuff on the stash
  34     #
  35     $c->stash->{dbh} = $c->dbc->dbh();
  36
  37     $c->stash->{map_url} = '/cview/map.pl';
  38     $c->stash->{chr_url} = '/cview/view_chromosome.pl';
  39     $c->stash->{marker_search_url} = '/search/markers/markersearch.pl';
  40     $c->stash->{comp_maps_url} = '/cview/view_maps.pl';
  41     $c->stash->{default_map_id} = $self->cview_default_map_id;
  42     $c->stash->{referer} = $c->req->referer();
  43     $c->stash->{tempdir} = $c->get_conf("tempfiles_subdir")."/cview";
  44     $c->stash->{basepath} = $c->get_conf("basepath");
  45     $c->stash->{cview_db_backend} = $c->get_conf("cview_db_backend");
  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, $c->config);
  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
  74         my $map_is_private = $self->data_is_private($c, $c->dbc->dbh(), $map);
  75
  76         unless ($map_is_private) {
  77             push @{$map_by_species{$species} },
  78             qq{<a href="}.$c->stash->{map_url}.qq{?map_version_id=$id">}.encode_entities($short_name).'</a>: '.encode_entities($long_name)."\n";
  79         }
  80     }
  81
  82     $c->stash->{map_by_species} = \%map_by_species;
  83     $c->forward("View::Mason");
  84 }
  85
  86 sub map :Path("/cview/map.pl") :Args(0) {
  87     my ($self, $c) = @_;
  88
  89     my @params = qw | map_id map_version_id size hilite physical force map_items |;
  90
  91     foreach my $param (@params) {
  92         $c->stash->{$param} = $c->req->param($param) || '';
  93     }
  94
  95     my %marker_info;
  96
  97     # set up a cache for the map statistics, using Cache::File
  98     #
  99     my $cache_file_dir = File::Spec->catfile($c->stash->{basepath},
 100                                              $c->stash->{tempdir}, "cache_file");
 101
 102     tie %marker_info, 'Cache::File', { cache_root => $cache_file_dir };
 103
 104     # report some unusual conditions to the user.
 105     #
 106     my $message = "";
 107
 108     # if the map_id was supplied, convert immediately to map_version_id
 109     #
 110     if ($c->stash->{map_id} && !$c->stash->{map_version_id}) {
 111         $c->stash->{map_version_id} = CXGN::Cview::Map::Tools::find_current_version($c->stash->{dbh}, $c->stash->{map_id});
 112     }
 113     # get the map data using the CXGN::Map API.
 114     #
 115     my $map_factory = CXGN::Cview::MapFactory->new($c->stash->{dbh});
 116     my $map = $map_factory ->create({ map_version_id => $c->stash->{map_version_id} });
 117
 118     if (!$map) {
 119         $c->stash->{template} = '/cview/map/missing.mas';
 120         $c->stash->{title} = "The map you are trying to view does not exist!";
 121         return;
 122     }
 123
 124     my $private = $self->data_is_private($c, $c->stash->{dbh}, $map);
 125
 126     $c->stash->{long_name} = $map->get_long_name();
 127     $c->stash->{short_name} = $map->get_short_name();
 128
 129
 130     my @hilite_markers = split /\s+|\,\s*/, $c->{stash}->{hilite};
 131
 132     $c->stash->{hilite_markers} = \@hilite_markers;
 133
 134     # calculate the size of the image based on the size parameter
 135     #
 136     my $image_height = 160;
 137     my $size = $c->stash->{size} || 0;
 138
 139     if ($size < 0 ) { $size = 0;  }
 140     if ($size > 10) { $size = 10; }
 141
 142     $c->stash->{size} = $size || 0;
 143
 144     $image_height = $image_height + $image_height * $size /2;
 145     my $image_width = 820;
 146
 147     # create an appropriate overview diagram - physical or generic
 148     # (the generic will also provide an appropriate overview for the fish map).
 149     #
 150     my $map_overview = CXGN::Cview::MapOverviews::Generic ->
 151       new($map,
 152           {
 153            force            => $c->stash->{force},
 154            basepath         => $c->stash->{basepath},
 155            tempfiles_subdir => $c->stash->{tempdir},
 156            dbh              => $c->stash->{dbh},
 157           });
 158
 159     $map_overview->set_image_height($image_height);
 160     $map_overview->set_image_width($image_width);
 161
 162     # deal with marker names to be highlighted on the overview diagram
 163     # (the ones to be requested to be hilited using the hilite feature)
 164     #
 165     my @map_items = split /\n/, $c->stash->{map_items};
 166
 167     $map_overview->get_map()->set_map_items(@map_items);
 168     foreach my $hm (@hilite_markers) {
 169       $map_overview -> hilite_marker($hm);
 170     }
 171
 172     # generate the marker list for use in the URL links
 173     #
 174     my $hilite_encoded = URI::Escape::uri_escape(join (" ", @hilite_markers));
 175
 176     # render the map and get the imagemap
 177     #
 178     $map_overview -> render_map();
 179
 180     $c->stash->{overview_image} = $map_overview->get_image_html();
 181
 182     # get the markers that could not be hilited
 183     #
 184     my @markers_not_found = $map_overview -> get_markers_not_found();
 185
 186     if (@markers_not_found) {
 187       $message .= "The following markers requested for hiliting were not found on this map (click to search on other maps):<br />";
 188       foreach my $m (@markers_not_found) {
 189         $message .= "&nbsp;&nbsp;<a href=\"/search/markers/markersearch.pl?searchtype=exactly&amp;name=$m\">$m</a>";
 190       }
 191       $message .= "<br />\n";
 192     }
 193
 194     # get chromosome stats and cache them
 195     #
 196     my @chr_names = $map->get_chromosome_names();
 197     my $hash_key = '';
 198
 199     for (my $i=0; $i<@chr_names; $i++) {
 200         $hash_key = $c->stash->{map_version_id}."-".$i;
 201         if (!exists($marker_info{$hash_key}) || $c->stash->{force}) {
 202             $marker_info{$hash_key} = $map->get_marker_count($chr_names[$i]);
 203         }
 204     }
 205
 206     if (!exists($marker_info{$c->stash->{map_version_id}}) || $c->stash->{force}) {
 207         $marker_info{$c->stash->{map_version_id}} = $map->get_map_stats();
 208     }
 209     my $chr_info = '';
 210
 211     my @chr_stats = ();
 212     for (my $i=0; $i<@chr_names; $i++) {
 213         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."\">
 214 <b>Chromosome $chr_names[$i]</b></a>";
 215         my $marker_link = join '',
 216            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";
 217
 218         push @chr_stats, [ $chr_link, $marker_link, $marker_info{$c->stash->{map_version_id}."-".$i} ];
 219     }
 220
 221 ##    my @chromosome_stats = map { $marker_info{$c->stash->{map_version_id}."-".$_}}  $map->get_chromosome_names();
 222
 223     $c->stash->{message} = $message;
 224     $c->stash->{abstract} = $map->get_abstract();
 225     $c->stash->{can_overlay} = $map->can_overlay();
 226
 227     $c->stash->{marker_stats} = $marker_info{$c->stash->{map_version_id}};
 228
 229     $c->stash->{chromosome_stats} = \@chr_stats;
 230
 231     $c->stash->{parent1_stock_id} = $map->get_parent1_stock_id();
 232     $c->stash->{parent1_stock_name} = $map->get_parent1_stock_name();
 233     $c->stash->{parent2_stock_id} = $map->get_parent2_stock_id();
 234     $c->stash->{parent2_stock_name} = $map->get_parent2_stock_name();
 235
 236     $c->stash->{template} = "/cview/map/index.mas";
 237     $c->forward("View::Mason");
 238 }
 239
 240
 241 sub data_is_private {
 242     my $self = shift;
 243     my $c = shift;
 244     my $dbh = shift;
 245     my $map = shift;
 246
 247     my $pop_name = $map->get_short_name() || $map->get_long_name();
 248
 249     my ($is_public, $owner_id);
 250     my $pop_id;
 251     if ($pop_name) {
 252         my $pop = CXGN::Phenome::Population->new_with_name($dbh, $pop_name);
 253         if ($pop) {
 254             $pop_id = $pop->get_population_id();
 255             $is_public = $pop->get_privacy_status();
 256             $owner_id  = $pop->get_sp_person_id();
 257         }
 258    }
 259
 260     my ($login_id, $user_type);
 261     if ($c->user()) {
 262         #my ($login_id, $user_type) = CXGN::Login->new($dbh)->has_session();
 263         $user_type = $c->user()->get_object->get_user_type();
 264         $login_id = $c->user()->get_object->get_sp_person_id();
 265     }
 266
 267     if ($is_public ||
 268         $user_type && $user_type eq 'curator' ||
 269         $login_id  && $owner_id && $login_id == $owner_id )  {
 270         return undef;
 271     }
 272     else {
 273         if ($pop_id) {
 274
 275            my $submitter = CXGN::People::Person->new($dbh, $owner_id);
 276            no warnings 'uninitialized';
 277            my $submitter_name = $submitter->get_first_name()." ".$submitter->get_last_name();
 278            my $submitter_link = qq |<a href="/solpeople/personal-info.pl?sp_person_id=$owner_id">$submitter_name</a> |;
 279
 280            my $private = qq | <p>This genetic map is not public yet.
 281                       If you would like to know more about this data,
 282                       please contact the owner of the data: <b>$submitter_link</b>
 283                       or email to SGN:
 284                       <a href=mailto:sgn-feedback\@sgn.cornell.edu>
 285                       sgn-feedback\@sgn.cornell.edu</a>.
 286                     </p> |;
 287
 288          return $private;
 289  } else {
 290 return undef; }
 291     }
 292
 293 }
 294
 295
 296 sub chromosome :Path("/cview/view_chromosome.pl") :Args(0) {
 297     my ($self, $c) = @_;
 298
 299     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 |;
 300
 301     foreach my $param (@params) {
 302         $c->stash->{$param}= $c->req->param($param);
 303     }
 304
 305     $c->stash->{template} = '/cview/chr/index.mas';
 306     $c->forward("View::Mason");
 307 }
 308
 309
 310 sub maps :Path("/cview/view_maps.pl") :Args(0) {
 311     my ($self, $c) = @_;
 312
 313     $c->stash->{template} = '/cview/map/comparison.mas';
 314     $c->stash->{dbh} = $c->dbc->dbh();
 315
 316     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 |;
 317     foreach my $param (@params) {
 318         $c->stash->{$param} = $c->req->param($param);
 319     }
 320     $c->forward("View::Mason");
 321 }
 322
 323 sub map_submission :Path('/cview/help/map_submission') :Args(0) {
 324     my ($self, $c) = @_;
 325     $c->stash->{template}='/cview/help/map_submission.mas';
 326 }
 327
 328
 329
 330 1;