1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
package Bio::Graphics::Browser2::Plugin::FilterTest;
# $Id: FilterTest.pm,v 1.3 2009-05-22 21:37:09 lstein Exp $
# Filter plugin to filter features from the ORFs track
use strict;
use vars qw($VERSION @ISA);
use constant DEBUG => 0;
use Bio::Graphics::Browser2::Plugin;
use CGI qw(:standard *pre);
$VERSION = '0.O1';
@ISA = qw(Bio::Graphics::Browser2::Plugin);
my @FILTERS = (
[
'Only ORFs on Watson strand', q{ $_[0]->name =~ /w$/i}
],
[
'Only ORFs on Crick strand', q{ $_[0]->name =~ /c$/i}
],
[
'ORF length < ', q{ $_[0]->length < $value }
],
[
'ORF length >= ', q{ $_[0]->length >= $value }
],
);
my %LABELS = map { $_ => $FILTERS[$_][0] } ( 0 .. $#FILTERS );
sub new
{
my $class = shift;
bless { original_key => undef }, $class;
}
sub name
{
'Genes';
}
sub type
{
'filter';
}
sub description
{
my $key = shift ()->name;
p("This Filter plugin filters the features from the ORFS track ($key)")
. p("This plugin was written by Marc Logghe.");
}
sub filter {
my $self = shift;
my $track = shift; # track label
my $key = shift;
my $config = $self->configuration;
my $source = $self->browser_config;
return unless $source;
return unless $track eq $self->name;
return unless $config->{filter_on} eq 'yes';
my $value = $config->{filter_value};
# pass closure to browser object for filtering
my $filter = eval "sub { $FILTERS[$config->{filter}][1] }";
warn $@ if $@;
return $filter,"$key (filter incorrect)" if $@; # error occurred
my $new_key = $FILTERS[ $config->{filter} ][1] =~ m/\$value/
? "$key ($FILTERS[$config->{filter}][0] $value)"
: "$key ($FILTERS[$config->{filter}][0])" ;
return $filter,$new_key;
}
sub config_defaults
{
my $self = shift;
return {
filter_on => 'no',
filter => 0,
filter_value => 150
};
}
sub reconfigure
{
my $self = shift;
my $current_config = $self->configuration;
my $objtype = $self->objtype();
foreach my $p ( param() )
{
my ($c) = ( $p =~ /$objtype\.(\S+)/ ) or next;
$current_config->{$c} = param($p);
}
}
sub configure_form
{
my $self = shift;
my $current_config = $self->configuration;
my $objtype = $self->objtype();
my @choices = TR(
{ -class => 'searchtitle' },
th(
{ -align => 'RIGHT', -width => '25%' },
'Filter on',
td(
radio_group(
-name => "$objtype.filter_on",
-values => [qw(yes no)],
-default => $current_config->{'filter_on'},
-override => 1
)
)
)
);
push @choices,
TR(
{ -class => 'searchtitle' },
th(
{ -align => 'RIGHT', -width => '25%' },
'Filter',
td(
popup_menu(
-name => "$objtype.filter",
-values => [ 0 .. $#FILTERS ],
-labels => \%LABELS,
-default => $current_config->{'filter'}
),
textfield(
-name => "$objtype.filter_value",
-default => $current_config->{filter_value}
)
)
)
);
my $html = table(@choices);
$html;
}
sub objtype
{
( split ( /::/, ref(shift) ) )[-1];
}
1;
|
