clean
[sgn.git] / lib / SGN / Controller / Cview.pm
blob0f9fb163b032fdbe5e1e49fdb9d8a7e50d576812
2 use Modern::Perl;
4 package SGN::Controller::Cview;
6 use Moose;
7 use namespace::autoclean;
9 BEGIN { extends "Catalyst::Controller" }
10 with 'Catalyst::Component::ApplicationAttribute';
12 use Cache::File;
13 use File::Spec;
14 use HTML::Entities;
15 use URI::Escape;
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;
24 has 'cview_default_map_id' => (
25 is => 'rw',
26 isa => 'Str',
27 required => 1,
30 sub auto :Args(0) {
31 my ($self, $c) = @_;
33 # push some useful stuff on the stash
35 $c->stash->{dbh} = $c->dbc->dbh();
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");
47 $c->log->debug("BASEPATH: ".($c->stash->{basepath})) if $c->debug;
49 return 1;
52 # for backwards compatibility
53 sub alt_index :Path("/cview/index.pl") :Args(0) {
54 my ($self, $c) = @_;
55 $c->forward("index");
58 sub index :Path("/cview") :Args(0) {
59 my ($self, $c) = @_;
61 $c->stash->{template} = '/cview/index.mas';
63 my $map_factory = CXGN::Cview::MapFactory->new($c->dbc->dbh, $c);
64 my @maps = $map_factory->get_system_maps();
66 my %map_by_species;
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();
74 my $map_is_private = $self->data_is_private($c, $c->dbc->dbh(), $map);
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";
82 $c->stash->{map_by_species} = \%map_by_species;
83 $c->forward("View::Mason");
86 sub map :Path("/cview/map.pl") :Args(0) {
87 my ($self, $c) = @_;
89 my @params = qw | map_id map_version_id size hilite physical force map_items |;
91 foreach my $param (@params) {
92 $c->stash->{$param} = $c->req->param($param) || '';
95 my %marker_info;
97 # set up a cache for the map statistics, using Cache::File
99 my $cache_file_dir = File::Spec->catfile($c->stash->{basepath},
100 $c->stash->{tempdir}, "cache_file");
102 tie %marker_info, 'Cache::File', { cache_root => $cache_file_dir };
104 # report some unusual conditions to the user.
106 my $message = "";
108 # if the map_id was supplied, convert immediately to map_version_id
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});
113 # get the map data using the CXGN::Map API.
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} });
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;
124 my $private = $self->data_is_private($c, $c->stash->{dbh}, $map);
126 $c->stash->{long_name} = $map->get_long_name();
127 $c->stash->{short_name} = $map->get_short_name();
130 my @hilite_markers = split /\s+|\,\s*/, $c->{stash}->{hilite};
132 $c->stash->{hilite_markers} = \@hilite_markers;
134 # calculate the size of the image based on the size parameter
136 my $image_height = 160;
137 my $size = $c->stash->{size} || 0;
139 if ($size < 0 ) { $size = 0; }
140 if ($size > 10) { $size = 10; }
142 $c->stash->{size} = $size || 0;
144 $image_height = $image_height + $image_height * $size /2;
145 my $image_width = 820;
147 # create an appropriate overview diagram - physical or generic
148 # (the generic will also provide an appropriate overview for the fish map).
150 my $map_overview = CXGN::Cview::MapOverviews::Generic ->
151 new($map,
153 force => $c->stash->{force},
154 basepath => $c->stash->{basepath},
155 tempfiles_subdir => $c->stash->{tempdir},
156 dbh => $c->stash->{dbh},
159 $map_overview->set_image_height($image_height);
160 $map_overview->set_image_width($image_width);
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)
165 my @map_items = split /\n/, $c->stash->{map_items};
167 $map_overview->get_map()->set_map_items(@map_items);
168 foreach my $hm (@hilite_markers) {
169 $map_overview -> hilite_marker($hm);
172 # generate the marker list for use in the URL links
174 my $hilite_encoded = URI::Escape::uri_escape(join (" ", @hilite_markers));
176 # render the map and get the imagemap
178 $map_overview -> render_map();
180 $c->stash->{overview_image} = $map_overview->get_image_html();
182 # get the markers that could not be hilited
184 my @markers_not_found = $map_overview -> get_markers_not_found();
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>";
191 $message .= "<br />\n";
194 # get chromosome stats and cache them
196 my @chr_names = $map->get_chromosome_names();
197 my $hash_key = '';
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]);
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();
209 my $chr_info = '';
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";
218 push @chr_stats, [ $chr_link, $marker_link, $marker_info{$c->stash->{map_version_id}."-".$i} ];
221 ## my @chromosome_stats = map { $marker_info{$c->stash->{map_version_id}."-".$_}} $map->get_chromosome_names();
223 $c->stash->{message} = $message;
224 $c->stash->{abstract} = $map->get_abstract();
225 $c->stash->{can_overlay} = $map->can_overlay();
227 $c->stash->{marker_stats} = $marker_info{$c->stash->{map_version_id}};
229 $c->stash->{chromosome_stats} = \@chr_stats;
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();
236 $c->stash->{template} = "/cview/map/index.mas";
237 $c->forward("View::Mason");
241 sub data_is_private {
242 my $self = shift;
243 my $c = shift;
244 my $dbh = shift;
245 my $map = shift;
247 my $pop_name = $map->get_short_name() || $map->get_long_name();
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();
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();
267 if ($is_public ||
268 $user_type && $user_type eq 'curator' ||
269 $login_id && $owner_id && $login_id == $owner_id ) {
270 return undef;
272 else {
273 if ($pop_id) {
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> |;
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> |;
288 return $private;
289 } else {
290 return undef; }
296 sub chromosome :Path("/cview/view_chromosome.pl") :Args(0) {
297 my ($self, $c) = @_;
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 |;
301 foreach my $param (@params) {
302 $c->stash->{$param}= $c->req->param($param);
305 $c->stash->{template} = '/cview/chr/index.mas';
306 $c->forward("View::Mason");
310 sub maps :Path("/cview/view_maps.pl") :Args(0) {
311 my ($self, $c) = @_;
313 $c->stash->{template} = '/cview/map/comparison.mas';
314 $c->stash->{dbh} = $c->dbc->dbh();
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);
320 $c->forward("View::Mason");
323 sub map_submission :Path('/cview/help/map_submission') :Args(0) {
324 my ($self, $c) = @_;
325 $c->stash->{template}='/cview/help/map_submission.mas';