package Bio::Graphics::Browser2::PluginSet;
# API for using plugins
# $Id$
use strict;
use Bio::Graphics::Browser2;
use Bio::Graphics::Browser2::Util 'shellwords';
use CGI 'param';
use constant DEBUG=>0;
sub new {
my $package = shift;
my $config = shift;
my @search_path = @_;
my %plugin_list = ();
warn "initializing plugins with $config..." if DEBUG;
my @plugins = shellwords($config->plugins);
# only one authorization plugin allowed, from globals
if (my $auth = $config->auth_plugin) {
unshift @plugins,$auth; # first one
}
warn "PLUGINS = @plugins" if DEBUG;
PLUGIN:
for my $plugin (@plugins) {
my $class = "Bio\:\:Graphics\:\:Browser2\:\:Plugin\:\:$plugin";
for my $search_path (@search_path) {
my $plugin_with_path = "$search_path/$plugin.pm";
if (eval {require $plugin_with_path}) {
warn "plugin $plugin loaded successfully" if DEBUG;
my $obj = eval{$class->new};
unless ($obj) {
warn "$plugin: $@";
next PLUGIN;
}
warn "plugin name = ",$obj->name," base = $plugin" if DEBUG;
$plugin_list{$plugin} = $obj;
next PLUGIN;
} else {
warn $@ if $@ and $@ !~ /^Can\'t locate/;
}
}
warn $@ if !$plugin_list{$plugin} && $@ =~ /^Can\'t locate/;
}
my $self = bless {
config => $config,
plugins => \%plugin_list
},ref $package || $package;
return $self;
}
sub config { shift->{config} }
sub plugins {
my $self = shift;
return wantarray ? values %{$self->{plugins}} : $self->{plugins};
}
sub plugin {
my $self = shift;
my $plugin_base = shift;
$self->plugins->{$plugin_base};
}
sub language {
my $self = shift;
my $d = $self->{language};
$self->{language} = shift if @_;
$d;
}
sub auth_plugin {
my $self = shift;
my @a = grep {$_->type eq 'authenticator'} values %{$self->{plugins}};
return unless @a;
return $a[0];
}
sub configure {
my $self = shift;
my $render = shift;
my $database = $render->db;
my $page_settings = $render->state;
my $language = $render->language;
my $session = $render->session;
my $search = $render->get_search_object;
my $conf = $self->config;
my $plugins = $self->plugins;
my $conf_dir = $conf->globals->config_base;
$self->language($language);
for my $name (keys %$plugins) {
eval {
my $p = $plugins->{$name};
$p->renderer($render);
$p->database($database);
$p->browser_config($conf);
$p->config_path($conf_dir);
$p->language($language);
$p->page_settings($page_settings);
$p->db_search($search);
$p->init(); # other initialization
# retrieve persistent configuration
my $config = $session->plugin_settings($p->name);
unless (%$config) {
my $defaults = $p->config_defaults;
%$config = %{$defaults} if $defaults;
}
# and tell the plugin about it
$p->configuration($config);
# if there are any CGI parameters from the
# plugin's configuration screen, set it here
if (my @params = grep {/^$name\./} param()) {
$p->reconfigure unless param('plugin_action') eq $language->tr('Cancel');
# turn the plugin on
my $setting_name = 'plugin:'.$p->name;
$p->page_settings->{features}{$setting_name}{visible} = 1;
}
if ($p->type eq 'authenticator') {
my $source = $self->config;
$source->set_authenticator($p);
$source->set_username($render->session->username);
}
};
warn "$name: $@" if $@;
}
$self->set_filters(); # allow filter plugins to adjust the data source
}
sub destroy {
my $self = shift;
my $plugins = $self->plugins;
for my $name (keys %$plugins) {
eval {
my $p = $plugins->{$name};
$p->renderer(undef);
};
}
}
sub set_filters {
my $self = shift;
my $source = $self->config;
my @labels = grep {!/^_/} $source->labels;
for my $p ($self->plugins) {
next unless $p->type eq 'filter';
for my $l (@labels) {
$self->{'.ok'}{$l} ||= $source->setting($l,'key'); # remember this!
$self->{'.of'}{$l} ||= $source->setting($l,'filter'); # remember this!
if (my ($filter,$new_key) = $p->filter($l,$self->{'.ok'}{$l})) {
$source->set($l, filter => $filter);
$source->set($l, key => $new_key);
}
else {
$source->set($l, key => $self->{'.ok'}{$l}) if exists $self->{'.ok'}{$l};
$source->set($l, filter => $self->{'.of'}{$l}) if exists $self->{'.of'}{$l};
}
}
}
}
sub annotate {
my $self = shift;
my $segment = shift;
my $feature_files = shift || {};
my $fast_mapper = shift; # fast mapper filters out features that are outside cur segment
my $slow_mapper = shift; # slow mapper doesn't
my $max_segment = shift; # ignored
my $whole_segment = shift;
my $region_segment = shift;
my @plugins = $self->plugins;
for my $p (@plugins) {
next unless $p->type eq 'annotator';
my $name = "plugin:".$p->id;
next unless $p->page_settings && $p->page_settings->{features}{$name}{visible};
warn "Plugin $name is visible, so running it on segment $segment" if DEBUG;
if ($segment->length > $max_segment) {
$feature_files->{$name} = Bio::Graphics::FeatureFile->new(); # empty
} else {
my $features = $p->annotate($segment,$fast_mapper) or next;
$features->name($name);
$feature_files->{$name} = $features;
}
}
}
sub set_segments {
my $self = shift;
my $segments = shift;
my $plugins = $self->plugins;
for my $k ( values %$plugins ) {
$k->segments($segments);
}
}
sub _retrieve_plugin_config {
my $plugin = shift;
my $name = $plugin->name;
my %settings = cookie("${name}_config");
return $plugin->config_defaults unless %settings;
foreach (keys %settings) {
# need better serialization than this...
if ($settings{$_} =~ /$;/) {
my @settings = split $;,$settings{$_};
pop @settings unless defined $settings[-1];
$settings{$_} = \@settings;
}
}
\%settings;
}
sub menu_labels {
my $self = shift;
my $plugins = $self->plugins;
my $config = $self->config;
my $lang = $self->language;
my %verbs = (dumper => $lang->tr('Dump'),
finder => $lang->tr('Find'),
highlighter => $lang->tr('Highlight'),
annotator => $lang->tr('Annotate'),
filter => $lang->tr('Filter'),
);
my %labels = ();
# Adjust plugin menu labels
for ( keys %{$plugins} ) {
# plugin-defined verb
if ( $plugins->{$_}->verb ) {
$labels{$_} = $lang->tr($plugins->{$_}->verb) ||
ucfirst $plugins->{$_}->verb;
}
# default verb
else {
$labels{$_} = $verbs{$plugins->{$_}->type} ||
ucfirst $plugins->{$_}->type;
}
my $name = $plugins->{$_}->name;
$labels{$_} .= " $name";
$labels{$_} =~ s/^\s+//;
}
return \%labels;
}
1;
__END__
=head1 NAME
Bio::Graphics::Browser2::PluginSet -- A set of plugins
=head1 SYNOPSIS
None. Used internally by gbrowse & gbrowse_img.
=head1 METHODS
=over 4
=item $plugin_set = Bio::Graphics::Browser2::PluginSet->new($config,$page_settings,@search_path)
Initialize plugins according to the configuration, page settings and
the plugin search path. Returns an object.
=item $plugin_set->configure($database)
Configure the plugins given the database.
=item $plugin_set->annotate($segment,$feature_files,$rel2abs)
Run plugin annotations on the $segment, adding the resulting feature
files to the hash ref in $feature_files ({track_name=>$feature_list}).
The $rel2abs argument holds a coordinate mapper callback, but is
currently unused.
=back
=head1 SEE ALSO
L<Bio::Graphics::Browser2>
=head1 AUTHOR
Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
Copyright (c) 2005 Cold Spring Harbor Laboratory
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut