view release on metacpan or  search on metacpan

lib/Bio/Graphics/Browser2/Action.pm  view on Meta::CPAN

sub is_authentication_event {
    my $class = shift;
    my $action = CGI::param('action');
    my %ok = map {$_=>1} qw(gbrowse_login authorize_login plugin_authenticate plugin_login get_translation_tables reconfigure_plugin);
    return $ok{$action};
}

sub handle_legacy_calls {
    my $self  = shift;
    my $q     = shift;
    my $render = $self->render;

    # redirect to galaxy form submission
    if ($q->param('galaxy')) {
	return (302,undef,$render->galaxy_link($render->state));
    }

    # redirect to the imagelink
    if (my $format = $q->param('make_image')) {
	return (302,undef,$render->image_link($render->state,$format));
    }

    if ($q->param('clear_dsn') || $q->param('reset_dsn')) {
	return (302,undef,"?action=reset_dsn");
    }

    return;
}

sub ACTION_render_panels {
    my $self   = shift;
    my $q      = shift;
    my $render = $self->render;
    my $seg    = eval {$render->region->seg};
    return (204,'text/plain',undef) unless $seg;
    my $source = $render->data_source;
    $render->init_plugins();

    # no state changing occurs after this
    $self->session->unlock;

    my $html   = $render->render_panels($seg,{overview   => $source->show_section('overview'),
					      regionview => $source->show_section('region'),
					      detailview => $source->show_section('detail')});
    return (200,'text/html',$html);
}

# each ACTION_* method corresponds to a "action=*" parameter on the CGI stack
sub ACTION_navigate {
    my $self   = shift;
    my $q      = shift;

    my $render   = $self->render;
    my $source   = $self->data_source;
    my $settings = $self->settings;

    my $action = $q->param('navigate') or croak "for the navigate action, a CGI argument named \"navigate\" must be present";

    my $view_start = $q->param('view_start');
    my $view_stop  = $q->param('view_stop');
    unless (!defined $view_start or $view_start eq 'NaN' or $view_stop eq 'NaN') {
	$render->state->{view_start} = ($view_start && $view_start >= 0)? $view_start : $render->state->{view_start},
	$render->state->{view_stop}  = ($view_stop  && $view_stop  >= 0)? $view_stop  : $render->state->{view_stop},
    }

    my $updated = $render->asynchronous_update_coordinates($action);

    $render->init_database() if $updated;

    my ( $track_keys, $display_details, $details_msg )
	= $render->background_track_render();

    my $overview_scale_return_object
	= $render->asynchronous_update_overview_scale_bar() if $source->show_section('overview');

    my $region_scale_return_object
	= $render->asynchronous_update_region_scale_bar()
            if ( $settings->{region_size} && $source->show_section('region'));

    my $detail_scale_return_object
	= $render->asynchronous_update_detail_scale_bar() if $source->show_section('detail');

    my $segment_info_object = $render->segment_info_object();

    warn "navigate() returning track keys = ",join ' ',%$track_keys if DEBUG;

    my $return_object = {
	segment            => $settings->{name},
	segment_info       => $segment_info_object,
	track_keys         => $track_keys,
	display_details    => $display_details,
	details_msg        => $details_msg,
	overview_scale_bar => $overview_scale_return_object,
	region_scale_bar   => $region_scale_return_object,
	detail_scale_bar   => $detail_scale_return_object,
    };
    $self->session->flush;
    return (200,'application/json',$return_object);
}

sub ACTION_update_sections {
    my $self    = shift;
    my $q       = shift;

    my $render = $self->render;
    my @section_names = $q->multi_param('section_names');
    my $keyword = $q->param('keyword');
    my $offset = $q->param('offset');

    # no state changing occurs here
    $self->session->unlock;
    
    my @args = (\@section_names);
    my $section_html = $render->asynchronous_update_sections(\@section_names, $keyword, $offset);
    my $return_object = { section_html => $section_html, };

    return ( 200, 'application/json', $return_object );
}

sub ACTION_configure_track {
    my $self = shift;