GBrowse
view release on metacpan or search on metacpan
lib/Bio/Graphics/Browser2/Render.pm view on Meta::CPAN
#
# AUTHENTICATION
#
##################################################################3
sub force_authentication {
my $self = shift;
# asynchronous event -- only allow the ones needed for authentication
if (Bio::Graphics::Browser2::Action->is_authentication_event) {
$self->run_asynchronous_event;
$self->session->unlock;
return;
}
if (param('action')) {
print CGI::header(-status => '403 Forbidden');
return;
}
# render main page
$self->init();
$self->render_header();
my $confirm = param('confirm') || param('openid_confirm');
my $action;
if ($self->data_source->auth_plugin) {
$action = "GBox.showTooltip(event,'url:?action=plugin_login',true)";
} else {
$action = $self->login_manager->login_script();
}
$action .= ";login_blackout(true,'')";
my $output = $self->render_html_start('GBrowse Login Required',
$self->get_post_load_functions,
($confirm ? '' : $action));
$output .= div({-id=>'source_form'},$self->source_form());
if ($confirm) {
$output .= $self->login_manager->render_confirm;
} else {
$output .= $self->render_login_required($action);
}
$output .= "<hr>";
$output .= $self->render_bottom();
print $output;
}
##################################################################3
#
# STATE CODE HERE
#
##################################################################3
sub set_default_state {
my $self = shift;
my $state = $self->state;
$self->default_state if !$state->{tracks} # always set in one form or another
or param('reset');
}
sub update_state {
my $self = shift;
warn "[$$] update_state()" if DEBUG;
return if param('gbgff'); # don't let gbgff requests update our coordinates!!!
# return if url() =~ /gbrowse_img/; # don't let gbrowse_img requests update our coordinates either!!
$self->_update_state;
}
sub _update_state {
my $self = shift;
my $state = $self->state;
$self->update_state_from_cgi;
warn "[$$] CGI updated" if DEBUG;
if (my $seg = $self->segment) {
# A reset won't have a segment, so we need to test for that before we use
# one in whole_segment().
my $whole_segment = $self->whole_segment;
$state->{seg_min} = $whole_segment->start;
$state->{seg_max} = $whole_segment->end;
$state->{ref} ||= $seg->seq_id;
$state->{view_start} ||= $seg->start; # The user has selected the area that they want to see. Therefore, this
$state->{view_stop} ||= $seg->end; # will be the view_start and view_stop, rather than just start and stop.
# asynchronous_update_coordinates will multiply this by the correct factor
# to find the size of the segment to load
$state->{start} ||= $seg->start; # Set regular start and stop as well, just to be safe
$state->{stop} ||= $seg->end; #
# Automatically open the tracks with found features in them
$self->auto_open();
}
$self->cleanup_dangling_uploads($state);
warn "[$$] update_state() done" if DEBUG;
}
sub default_state {
my $self = shift;
my $state = $self->state;
my $data_source = $self->data_source;
%$state = ();
@$state{'name','ref','start','stop','flip','version'} = ('','','','','',100);
$state->{width} = $self->setting('default width');
$state->{source} = $data_source->name;
$state->{cache} = $data_source->cache_time>0;
$state->{region_size} = $self->setting('region segment');
$state->{'max segment'}= $self->setting('max segment');
$state->{v} = VERSION;
$state->{stp} = 1;
$state->{ins} = 1;
$state->{head} = 1;
$state->{show_tooltips}= 1;
$state->{ks} = 'between';
$state->{grid} = 1;
$state->{sk} = $self->setting("default varying") ? "unsorted" : "sorted";
# if no name is specified but there is a "initial landmark" defined in the
# config file, then we default to that.
$state->{name} ||= $self->setting('initial landmark')
lib/Bio/Graphics/Browser2/Render.pm view on Meta::CPAN
my $usertracks = $self->user_tracks;
my %tracks = map {$_=>1} $usertracks->tracks();
for my $k (keys %name_to_id) {
unless (exists $tracks{$k}) {
delete $state->{uploads}{$_} foreach keys %{$name_to_id{$k}};
}
}
}
sub add_track_to_state {
my $self = shift;
my $label = shift;
my $state = $self->state;
warn '[',Bio::Graphics::Browser2::Session->time,'] ',"[$$] add_track_to_state($label)" if DEBUG;
return unless length $label; # refuse to add empty tracks!
# don't add invalid track
my %potential_tracks = map {$_=>1} $self->potential_tracks;
warn "invalid track $label" if DEBUG && !$potential_tracks{$label};
return unless $potential_tracks{$label};
# my %current = map {$_=> 1} @{$state->{tracks}};
# unshift @{$state->{tracks}},$label unless $current{$label}; # on top (better)
# experimental -- force track to go to top
@{$state->{tracks}} = grep {$_ ne $label} @{$state->{tracks}};
unshift @{$state->{tracks}},$label;
warn "[$$]ADD TRACK TO STATE WAS: ",
join ' ',grep {$state->{features}{$_}{visible}} sort keys %{$state->{features}},"\n" if DEBUG;
if ($state->{features}{$label}) {
$state->{features}{$label}{visible}=1;
}
else{
$state->{features}{$label}{visible} = {visible=>1,options=>0,limit=>0};
}
warn "[$$] ADD TRACK TO STATE NOW: ",
join ' ',grep {$state->{features}{$_}{visible}} sort keys %{$state->{features}},"\n" if DEBUG;
}
sub remove_track_from_state {
my $self = shift;
my $label = shift;
warn '[',Bio::Graphics::Browser2::Session->time,'] ',"[$$] remove_track_from_state($label)" if DEBUG;
delete $self->state->{features}{$label};
}
sub track_visible {
my $self = shift;
my $label = shift;
return $self->state->{features}{$label}{visible};
}
sub update_state_from_cgi {
my $self = shift;
my $state = $self->state;
warn "state = $state" if DEBUG;
$self->update_options($state);
$self->update_coordinates($state);
$self->update_region($state);
if (param('revert')) {
$self->default_tracks($state);
}
else {
$self->remove_invalid_tracks($state);
$self->update_tracks($state);
}
$self->update_section_visibility($state);
$self->update_galaxy_url($state);
}
sub create_subtrack_manager {
my $self = shift;
my $label = shift;
my $source = shift || $self->data_source;
my $state = shift || $self->state;
my ($dimensions,$rows,$aliases)
= Bio::Graphics::Browser2::SubtrackTable->infer_settings_from_source($source,$label)
or return;
my $key = $source->setting($label => 'key');
my $selected = $state->{subtracks}{$label};
my $comment = $source->setting($label => 'brief comment');
my $stt = Bio::Graphics::Browser2::SubtrackTable->new(-columns=>$dimensions,
-rows =>$rows,
-label => $label,
-key => $key||$label,
-aliases => $aliases,
-comment => $comment);
$stt->set_selected($selected) if $selected;
eval {$stt->overlap(($state->{features}{$label}{options}||0)==4)}; # options == 4 means "overlap", for legacy reasons
return $stt;
}
# Handle returns from the track configuration form
sub reconfigure_track {
my $self = shift;
my $q = shift; # CGI object
my $label = shift;
my $state = $self->state();
my $source = $self->data_source;
$state->{features}{$label}{options} = $q->param('format_option');
my $dynamic = $self->translate('DYNAMIC_VALUE');
my $mode = $q->param('mode') || 'details';
my $length = ($q->param('segment_length')||0);
my $semantic_low = ($q->param('apply_semantic_low')||0);
lib/Bio/Graphics/Browser2/Render.pm view on Meta::CPAN
$semconf->{$r->[0] . ':' . ($low-1)} = $conf unless $r->[0] >= $low-1;
$semconf->{$hi . ':' . $r->[1] } = $conf unless $hi >= $r->[1];
$overlap++;
}
if ($r->[0] > $low && $r->[1] < $hi) { # case D
$overlap++;
# delete
}
if ($r->[1] >= $low && $r->[0] <= $low) { # case A
$r->[1] = $low-1;
$semconf->{"$r->[0]:$r->[1]"} = $conf
unless $r->[0] >= $r->[1];
$overlap++;
}
if ($r->[1] >= $hi && $r->[0] <= $hi) { # case B
$r->[0] = $hi;
$semconf->{"$r->[0]:$r->[1]"} = $conf
unless $r->[0] >= $r->[1];
$overlap++;
}
unless ($overlap) {
$semconf->{$key} = $conf;
}
}
}
sub find_override_bounds {
my $self = shift;
my ($semconf,$length) = @_;
my @ranges = sort {$a->[0]<=>$b->[0]}
map { my @a = split ':';
\@a
} keys %$semconf;
my ($low,$hi);
for my $r (@ranges) {
next unless @$r == 2;
if ($length >= $r->[0] && $length < $r->[1]) {
return @$r;
}
$low = $r->[1]+1 if $r->[1] < $length;
$hi = $r->[0]-1 if $r->[0] > $length;
}
return ($low,$hi);
}
sub find_override_region {
my $self = shift;
my ($semconf,$length) = @_;
my @ranges = keys %$semconf;
for my $r (@ranges) {
my ($low,$hi) = split ':',$r;
return $r if $length >= $low && (!defined $hi || $length < $hi);
}
return;
}
sub update_options {
my $self = shift;
my $state = shift || $self->state;
my $data_source = shift || $self->data_source;
# return unless param('width'); # not submitted
$state->{width} ||= $self->setting('default width'); # working around a bug during development
$state->{grid} = 1 unless exists $state->{grid}; # to upgrade from older settings
$state->{flip} = 0; # obnoxious for this to persist
$state->{version} ||= param('version') || '';
do {$state->{$_} = param($_) if defined param($_) }
foreach qw(name source plugin stp ins head ks sk version
grid flip width region_size show_tooltips cache
);
if (my @features = shellwords(multi_param('h_feat'))) {
$state->{h_feat} = {};
for my $hilight (@features) {
last if $hilight eq '_clear_';
my ($featname,$color) = split '@',$hilight;
$state->{h_feat}{lc $featname} = $color || 'yellow';
}
}
if (my @regions = shellwords(multi_param('h_region'))) {
$state->{h_region} = [];
foreach (@regions) {
last if $_ eq '_clear_';
$_ = "$state->{ref}:$_" unless /^[^:]+:-?\d/; # add reference if not there
push @{$state->{h_region}},$_;
}
}
# Process the magic "q" parameter, which overrides everything else.
if (my @q = multi_param('q')) {
delete $state->{$_} foreach qw(name ref h_feat h_region);
$state->{q} = [map {split /[+-]/} @q];
}
else {
$state->{name} ||= '';
$state->{name} =~ s/^\s+//; # strip leading
$state->{name} =~ s/\s+$//; # and trailing whitespace
}
$self->session->modified;
}
sub update_tracks {
my $self = shift;
my $state = shift;
if (my @add = multi_param('add')) {
my @style = multi_param('style');
$self->handle_quickie(\@add,\@style);
}
# selected tracks can be set by the 'l', 'label' or 't' parameter
# the preferred parameter is 'l', because it implements correct
# semantics for the label separator
if (my @l = multi_param('l')) {
$self->set_tracks($self->split_labels_correctly(@l));
}
elsif (@l = multi_param('label')) {
$self->set_tracks($self->split_labels(@l));
} #... the 't' parameter
elsif (my @t = multi_param('t')) {
$self->set_tracks($self->split_labels(@t));
} #... the 'ds' (data source) or the 'ts' (track source) parameter
elsif ((my @ds = shellwords multi_param('ds')) || (my @ts = shellwords multi_param('ts'))) {
my @main_l = @ds ? $self->data_source->data_source_to_label(@ds) : $self->data_source->track_source_to_label(@ts);
if (!@ds && @ts) {
my %ds = ();
foreach my $label (@main_l) {
my @tracks = grep {!/^#/} shellwords $self->setting($label=>'track source');
my @datasr = grep {!/^#/} shellwords $self->setting($label=>'data source');
for (my $i = 0; $i <@tracks; $i++) {
map{$ds{$datasr[$i]}++ if $_ == $tracks[$i] && $datasr[$i]} (@ts);
}
}
@ds = keys %ds;
}
foreach my $label (@main_l) {
my @subs = grep {!/^#/} shellwords $self->setting($label=>'select');
shift @subs;
my @matched;
foreach my $s (@subs) {
map {push(@matched,$`) if ($s=~/\D(\d+)\;*$/i && $1 == $_)} @ds;
map {s/\s*//} @matched; #**
}
$label.="/".join("+",@matched) if @matched;
}
$self->set_tracks(@main_l);
}
if (my @selected = $self->split_labels_correctly(multi_param('enable'))) {
$self->add_track_to_state($_) foreach @selected;
}
if (my @selected = $self->split_labels_correctly(multi_param('disable'))) {
$self->remove_track_from_state($_) foreach @selected;
}
}
# update coordinates logic
# 1. A fresh session will have a null {ref,start,stop} state, a previous session will have {ref,start,stop,seg_min,seg_max} defined
# 2. If param('ref'),param('start') and param('stop') are defined, or if param('q') is defined, then we
# reset {ref,start,stop}
# 3. Otherwise, if {ref,start,stop} are defined, then
# 2a. interrogate param('span'). If span != (stop-start+1) then user has changed the zoom popup menu and we do a zoom.
# 2b. interrogate /left|right|zoom|nav|regionview|overview/, which define the various zoom and scroll buttons.
# If any of them exist, then we do the appropriate coordinate adjustment
# 3. If we did NOT change the coordinates, then we look for param('name') and use that to set the coordinates
# using a database search.
# 4. set {name} to "ref:start..stop"
sub update_coordinates {
my $self = shift;
my $state = shift || $self->state;
delete $self->{region}; # clear cached region
my $position_updated;
if (param('ref')) {
$state->{ref} = param('ref');
$state->{view_start} = param('start') if defined param('start') && param('start') =~ /^[\d-]+/;
$state->{view_stop} = param('stop') if defined param('stop') && param('stop') =~ /^[\d-]+/;
$state->{view_stop} = param('end') if defined param('end') && param('end') =~ /^[\d-]+/;
$position_updated++;
}
# quench uninit variable warning
my $current_span = length($state->{view_stop}||'') ? ($state->{view_stop} - $state->{view_start} + 1)
: 0;
my $new_span = param('span');
if ($new_span && $current_span != $new_span) {
$self->zoom_to_span($state,$new_span);
$position_updated++;
}
elsif (my ($scroll_data) = grep {/^(?:left|right) \S+/} param()) {
$self->scroll($state,$scroll_data);
$position_updated++;
}
elsif (my ($zoom_data) = grep {/^zoom (?:out|in) \S+/} param()) {
$self->zoom($state,$zoom_data);
$position_updated++;
}
elsif (my $position_data = param('overview.x')) {
$self->position_from_overview($state,$position_data);
$position_updated++;
}
elsif ($position_data = param('regionview.x')) {
$self->position_from_regionview($state,$position_data);
$position_updated++;
}
if ($position_updated) { # clip and update param
if (defined $state->{seg_min} && $state->{view_start} < $state->{seg_min}) {
my $delta = $state->{seg_min} - $state->{view_start};
$state->{view_start} += $delta;
$state->{view_stop} += $delta;
}
if (defined $state->{seg_max} && $state->{view_stop} > $state->{seg_max}) {
my $delta = $state->{view_stop} - $state->{seg_max};
$state->{view_start} -= $delta;
$state->{view_stop} -= $delta;
}
# Take details multiplier into account
$self->update_state_from_details_mult;
# update our "name" state and the CGI parameter
$state->{name} = $self->region_string;
param(name => $state->{name});
warn "name = $state->{name}" if DEBUG;
lib/Bio/Graphics/Browser2/Render.pm view on Meta::CPAN
$position_updated++;
}
if ($action =~ /reload segment/) {
$position_updated++;
}
if ( $action =~ /flip (\S+)/ ) {
if ( $action =~ /name/) {
$self->move_to_name($state, $action);
$position_updated++;
}
if ( $1 eq 'true' ) {
$state->{'flip'} = 1;
}
else {
$state->{'flip'} = 0;
}
}
if ($position_updated) { # clip and update param
if (defined $whole_segment_start && $state->{view_start} < $whole_segment_start) {
my $delta = $whole_segment_start - $state->{view_start};
$state->{view_start} += $delta;
$state->{view_stop} += $delta;
}
if (defined $whole_segment_stop && $state->{view_stop} > $whole_segment_stop) {
my $delta = $state->{view_stop} - $whole_segment_stop;
$state->{view_start} -= $delta;
$state->{view_stop} -= $delta;
if ($state->{view_start} < 0) {
# Segment requested is larger than the whole segment
$state->{view_start} = $whole_segment_start;
$state->{view_stop} = $whole_segment_stop;
}
}
# Take details multiplier into account
$self->update_state_from_details_mult;
unless (defined $state->{ref}) {
warn "Reverting coordinates to last known good region (user probably hit 'back' button).";
if ($state->{backup_region}) { # last known working region
@{$state}{'ref','start','stop','view_start','view_stop'} = @{$state->{backup_region}};
} else {
$state->{name} = param('name') || param('q') || url_param('name') || url_param('q'); # get the region somehow!!
if (my $seg = $self->segment) {
$state->{ref} = $seg->seq_id;
$state->{start} = $seg->start;
$state->{stop} = $seg->stop;
}
}
}
# update our "name" state and the CGI parameter
$state->{name} = $self->region_string;
}
$position_updated;
}
sub update_state_from_details_mult {
my $self = shift;
my $state = $self->state;
my $view_start = $state->{view_start} || 0;
my $view_stop = $state->{view_stop} || 0;
my $details_mult = $self->details_mult;
my $length = $view_stop - $view_start;
my $length_to_load = int($length * $details_mult);
my $start_to_load = int($view_start - $length * ($details_mult - 1) / 2);
if (defined $state->{seg_min} && $start_to_load < $state->{seg_min}) {
$start_to_load = $state->{seg_min};
}
my $stop_to_load = $start_to_load + $length_to_load;
if (defined $state->{seg_max} && $stop_to_load > $state->{seg_max}) {
my $delta = $stop_to_load - $state->{seg_max};
$start_to_load -= $delta;
$stop_to_load -= $delta;
}
$state->{start} = $start_to_load;
$state->{stop} = $stop_to_load;
}
sub region_string {
my $self = shift;
my $state = $self->state;
my $source = $self->data_source;
my $divider = $source->unit_divider || 1;
$state->{view_start} ||= 0;
$state->{view_stop} ||= 0;
return "$state->{ref}:".
$source->commas($state->{view_start}/$divider).
'..'.
$source->commas($state->{view_stop}/$divider);
}
sub zoom_to_span {
my $self = shift;
my ($state,$new_span) = @_;
my ($span) = $new_span =~ /([\d+.-]+)/;
sub move_to_name {
my $self = shift;
my ( $state, $new_name ) = @_;
if ( $new_name =~ /:(.*):([\d+.-]+)\.\.([\d+.-]+)/ ) {
my $new_chr = $1;
my $new_start = $2;
my $new_stop = $3;
$state->{ref} = $new_chr;
$state->{view_start} = $new_start;
$state->{view_stop} = $new_stop;
lib/Bio/Graphics/Browser2/Render.pm view on Meta::CPAN
$range = 1 if $range < 1;
my $newstart = $center - $range;
my $newstop = $center + $range - 1;
if ($newstart==$state->{view_start} && $newstop==$state->{view_stop}) {
if ($zoom_distance < 0) {$newstart--;$newstop++};
if ($zoom_distance > 0) {$newstart++;$newstop--};
}
if ($newstop-$newstart <=2) {$newstop++} # don't go down to 2 bp level!
$state->{view_start} = $newstart;
$state->{view_stop} = $newstop;
}
sub position_from_overview {
my $self = shift;
my $state = shift;
my $position_data = shift;
return unless defined $state->{seg_max} && defined $state->{seg_min};
my $segment_length = $state->{seg_max} - $state->{seg_min} + 1;
return unless $segment_length > 0;
my @overview_tracks = grep {$state->{features}{$_}{visible}}
$self->data_source->overview_tracks;
my ($padl,$padr) = $self->overview_pad(\@overview_tracks);
my $overview_width = $state->{width} * $self->overview_ratio;
my $click_position = $state->{seg_min} + $segment_length * ($position_data-$padl)/$overview_width;
my $span = $state->{stop} - $state->{start} + 1;
$state->{start} = int($click_position - $span/2);
$state->{stop} = $state->{start} + $span - 1;
}
sub position_from_regionview {
my $self = shift;
my $state = shift;
my $position_data = shift;
return unless defined $state->{seg_max} && defined $state->{seg_min};
return unless $state->{region_size};
my @regionview_tracks = grep {$state->{features}{$_}{visible}}
$self->data_source->regionview_tracks;
my ($padl,$padr) = $self->overview_pad(\@regionview_tracks) or return;
my $regionview_width = ($state->{width} * $self->overview_ratio);
my $click_position = $state->{region_size} * ($position_data-$padl)/$regionview_width;
my $span = $state->{stop} - $state->{start} + 1;
my ($regionview_start, $regionview_end) = $self->regionview_bounds();
$state->{start} = int($click_position - $span/2 + $regionview_start);
$state->{stop} = $state->{start} + $span - 1;
}
sub update_region {
my $self = shift;
my $state = shift || $self->state;
if ($self->setting('region segment')) {
$state->{region_size} = param('region_size')
if defined param('region_size');
$state->{region_size} = $self->setting('region segment')
unless defined $state->{region_size};
}
else {
delete $state->{region_size};
}
}
sub update_section_visibility {
my $self = shift;
my $state = shift;
for my $div (grep {/^div_visible_/} CGI::cookie()) {
my ($section) = $div =~ /^div_visible_(\w+)/ or next;
my $visibility = CGI::cookie($div);
$state->{section_visible}{$section} = $visibility;
}
}
sub update_galaxy_url {
my $self = shift;
my $state = shift;
if (my $url = param('GALAXY_URL')) {
warn "[$$] setting galaxy" if DEBUG;
$state->{GALAXY_URL} = $url;
} elsif (param('clear_galaxy')) {
warn "clearing galaxy" if DEBUG;
delete $state->{GALAXY_URL};
}
}
##################################################################3
#
# SHARED RENDERING CODE HERE
#
##################################################################3
# overview_ratio and overview_pad moved to RenderPanels.pm
sub set_language {
my $self = shift;
my $data_source = $self->data_source;
my $lang = Bio::Graphics::Browser2::I18n->new($data_source->globals->language_path);
my $default_language = $data_source->setting('language') || 'POSIX';
my $accept = CGI::http('Accept-language') || '';
my @languages = $accept =~ /([a-z]{2}-?[a-z]*)/ig;
push @languages,$default_language if $default_language;
return unless @languages;
$lang->language(@languages);
$self->language($lang);
Bio::Graphics::Browser2::Util->set_language($lang);
}
sub language {
my $self = shift;
my $d = $self->{lang};
$self->{lang} = shift if @_;
$d;
}
# Returns the language code, but only if we have a translate table for it.
sub language_code {
my $self = shift;
my $lang = $self->language;
my $table= $lang->tr_table($lang->language);
return unless %$table;
return $lang->language;
}
##### language stuff
sub label2key {
my $self = shift;
my $label = shift;
my $source = $self->data_source;
my $key;
( run in 1.691 second using v1.01-cache-2.11-cpan-5a3173703d6 )