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;