our $VERSION = 1.0502;
sub new {
my($caller,@args) = @_;
my $class = ref($caller) || $caller;
if($class !~ m/Bio::Polloc::Rule::(\S+)/){
my $bme = Bio::Polloc::Polloc::Root->new(@args);
my($type) = $bme->_rearrange([qw(TYPE)], @args);
if($type){
$type = Bio::Polloc::RuleI->_qualify_type($type);
$class = "Bio::Polloc::Rule::" . $type if $type;
}
}
if($class =~ m/Bio::Polloc::Rule::(\S+)/){
if(Bio::Polloc::RuleI->_load_module($class)){;
my $self = $class->SUPER::new(@args);
$self->debug("Got the RuleI class $class ($1)");
my($value,$context,$name,$id,$executable) =
$self->_rearrange([qw(VALUE CONTEXT NAME ID EXECUTABLE)], @args);
$self->value($value);
$self->context(@{$context});
$self->name($name);
$self->id($id);
$self->executable($executable);
$self->_initialize(@args);
return $self;
}
my $bme = Bio::Polloc::Polloc::Root->new(@args);
$bme->throw("Impossible to load the module", $class);
}
my $bme = Bio::Polloc::Polloc::Root->new(@args);
$bme->throw("Impossible to load the proper Bio::Polloc::RuleI class with ".
"[".join("; ",@args)."]", $class);
}
sub type {
my($self,$value) = @_;
if($value){
my $v = $self->_qualify_type($value);
$self->throw("Attempting to set an invalid type of rule",$value) unless $v;
$self->{'_type'} = $v;
}
return $self->{'_type'};
}
sub context {
my($self,@args) = @_;
if($#args>=0){
$self->{'_context'} = [$args[0]+0, $args[1]+0, $args[2]+0];
}
$self->{'_context'} ||= [0,0,0];
if($self->{'_context'}->[0] < 0) {$self->{'_context'}->[0] = -1;}
elsif($self->{'_context'}->[0] > 0) {$self->{'_context'}->[0] = 1;}
else {$self->{'_context'}->[0] = 0;}
$self->{'_context'}->[1]+=0;
return $self->{'_context'};
}
sub value {
my($self,$value) = @_;
if(defined $value){
my $v = $self->_qualify_value($value);
defined $v or $self->throw("Bad rule value", $value);
$self->{'_value'} = $v;
}
return $self->{'_value'};
}
sub executable {
my($self,$value) = @_;
$self->{'_executable'} = $value+0 if defined $value;
$self->{'_executable'} = $self->safe_value('executable')
unless defined $self->{'_executable'};
$self->{'_executable'} =
(defined $self->{'_executable'} && $self->{'_executable'} =~ m/^(t|1|y)/i) ? 1 :
(defined $self->{'_executable'} ? 0 : undef);
return $self->{'_executable'};
}
sub name {
my($self,$value) = @_;
$self->{'_name'} = $value if defined $value;
return $self->{'_name'};
}
sub id {
my($self,$value) = @_;
if($value){
$value =~ s/\./_/g;
$self->debug("Setting Locus ID '$value'");
$self->{'_id'} = $value;
}
return $self->{'_id'};
}
sub restart_index {
my $self = shift;
$self->{'_children_id'} = 1;
}
sub stringify {
my($self,@args) = @_;
my $out = ucfirst $self->type;
$out.= " '" . $self->name . "'" if defined $self->name;
$out.= " at [". join("..", @{$self->context}) . "]" if $self->context->[0];
$out.= ": ".$self->stringify_value if defined $self->value;
return $out;
}
sub stringify_value {
my($self,@args) = @_;
return "".$self->value(@args);
}
sub ruleset {
my($self,$value) = @_;
if(defined $value){
$self->throw("Unexpected type of value '".ref($value)."'",$value)
unless $value->isa('Bio::Polloc::RuleIO');
$self->{'_ruleset'} = $value;
}
return $self->{'_ruleset'};
}
sub execute { $_[0]->throw("execute", $_[0], "Bio::Polloc::Polloc::NotImplementedException") }
sub safe_value {
my ($self,@args) = @_;
my($param,$value) = $self->_rearrange([qw(PARAM VALUE)], @args);
$self->{'_safe_values'} ||= {};
return unless $param;
$param = lc $param;
if(defined $value){
$self->{'_safe_values'}->{$param} = $value;
}
return $self->{'_safe_values'}->{$param};
}
sub source {
my($self,$source) = @_;
$self->{'_source'} = $source if defined $source;
$self->{'_source'} ||= $self->type;
return $self->{'_source'};
}
sub _qualify_type {
my($self,$value) = @_;
return unless $value;
$value = lc $value;
$value = "pattern" if $value=~/^(patt(ern)?)$/;
$value = "profile" if $value=~/^(prof(ile)?)$/;
$value = "repeat" if $value=~/^(rep(eat)?)$/;
$value = "tandemrepeat" if $value=~/^(t(andem)?rep(eat)?)$/;
$value = "similarity" if $value=~/^((sequence)?sim(ilarity)?|homology|ident(ity)?)$/;
$value = "coding" if $value=~/^(cod|cds)$/;
$value = "boolean" if $value=~/^(oper(at(e|or|ion))?|bool(ean)?)$/;
$value = "composition" if $value=~/^(comp(osition)?|content)$/;
return $value;
}
sub _parameters { $_[0]->throw('_parameters', $_[0], 'Bio::Polloc::Polloc::NotImplementedException') }
sub _qualify_value { return shift->_qualify_value_default(@_) }
sub _qualify_value_default {
my($self,$value) = @_;
unless (defined $value){
$self->warn("Empty value");
return;
}
if(ref($value) =~ m/hash/i){
my @arr = %{$value};
$value = \@arr;
}
my @args = ref($value) =~ /array/i ? @{$value} : split /\s+/, $value;
return unless defined $args[0];
if($args[0] !~ /^-/){
$self->warn("Expecting parameters in the format -parameter value", @args);
return;
}
unless($#args%2){
$self->warn("Unexpected (odd) number of parameters", @args);
return;
}
my %vals = @args;
my $out = {};
for my $k ( @{$self->_parameters} ){
my $p = $self->_rearrange([$k], @args);
next unless defined $p;
$out->{"-".lc $k} = $p;
}
return $out;
}
sub _executable { $_[0]->throw("_executable", $_[0], "Bio::Polloc::Polloc::NotImplementedException") }
sub _initialize { $_[0]->throw("_initialize", $_[0], "Bio::Polloc::Polloc::NotImplementedException") }
sub _search_value {
my($self, $key) = @_;
return unless defined $key;
$key = lc $key;
return $self->{"_$key"}
if defined $self->{"_$key"};
return $self->value->{"-$key"}
if defined $self->value
and ref($self->value) =~ /hash/i
and defined $self->value->{"-$key"};
return $self->safe_value($key)
if defined $self->_qualify_value({"-$key"=>$self->safe_value($key)});
return;
}
sub _next_child_id {
my $self = shift;
return unless defined $self->id;
$self->{'_children_id'} ||= 1;
return $self->id . "." . $self->{'_children_id'}++;
}
1;