File Coverage

blib/lib/Bio/Polloc/TypingIO/cfg.pm

Criterion	Covered	Total	%
statement	43	48	89.5
branch	8	14	57.1
condition			n/a
subroutine	10	11	90.9
pod	3	3	100.0
total	64	76	84.2

=head1 NAME

Bio::Polloc::TypingIO::cfg - Implementation of Bio::Polloc::TypingIO for .cfg files

=head1 DESCRIPTION

Reads .cfg files (a.k.a. .bme files) and produces a L<Bio::Polloc::TypingIO>
object.

=head1 AUTHOR - Luis M. Rodriguez-R

Email lmrodriguezr at gmail dot com

=head1 IMPLEMENTS OR EXTENDS

=over

=item *

L<Bio::Polloc::TypingIO>

=back

=cut

package Bio::Polloc::TypingIO::cfg;
use base qw(Bio::Polloc::TypingIO);
use strict;
use Bio::Polloc::Polloc::Config;
use Bio::Polloc::TypingI;
our $VERSION = 1.0503; # [a-version] from Bio::Polloc::Polloc::Version


=head1 APPENDIX

Methods provided by the package

=cut

=head2 new

Generic initialization method.

=head3 Arguments

=over

=item *

Any parameter accepted by L<Bio::Polloc::TypingIO>.

=item *

Any parameter accepted by L<Bio::Polloc::Polloc::Config>.

=back

=cut

sub new {
   my($caller,@args) = @_;
   my $self = $caller->SUPER::new(@args);
   $self->_initialize(@args);
   return $self;
}

=head2 read

Configures and parses the file.

=cut

sub read {
   my($self,@args) = @_;
   $self->_cfg->_register_handle_function(
   		-obj=>$self,
		-fun=>"_parse_eval",
		-token=>".typing.eval");
   $self->_cfg->parse(@args);
}

=head2 value

Sets/gets a stored value.

=head3 Arguments

=over

=item -key

The key.

=item -value

The value (if any).

=item alert

If true, alerts if the key is not set.

=back

=head3 Returns

The value (mix).

=cut

sub value {
   my($self,@args) = @_;
   my($key,$value,$alert) = $self->_rearrange([qw(KEY VALUE ALERT)], @args);
   $self->_cfg->_save(-key=>$key, -value=>$value, -space=>"rule") if $value;

   # Search first in the Typing space
   $value = $self->_cfg->value(-key=>$key, -space=>"typing", -noalert=>1);
   return $value if defined $value;
   # Search in the root space otherwise
   return $self->_cfg->value(-key=>$key, -space=>".", -noalert=>!$alert);
}

=head1 INTERNAL METHODS

Methods intended to be used only within the scope of Bio::Polloc::*

=head2 _cfg

Sets/gets the L<Bio::Polloc::Polloc::Config> main object.

=head3 Throws

L<Bio::Polloc::Polloc::Error> if the object is not of the proper class.

=cut

sub _cfg {
   my($self,$value) = @_;
   $self->{'_cfg_obj'} = $value if $value;
   return unless $self->{'_cfg_obj'};
   $self->{'_cfg_obj'}->isa('Bio::Polloc::Polloc::Config') or
   	$self->throw("Unexpected type of cfg object", $self->{'_cfg_obj'});
   return $self->{'_cfg_obj'};
}

=head2 _parse_eval

=cut

sub _parse_eval {
   my($self, $body,$defaults) = @_;
   $self->throw("Trying to define Bio::Polloc::TypingI object, but no type given")
   	unless defined $body;
   $body =~ s/^\s*(.*)\s*$/$1/;
   $body =~ s/^'\s*(.*)\s*'$/$1/;
   $body =~ m/^[a-z]+(::[a-z]+)*$/i
   	or $self->throw("Bad format for the body of .typing.eval, ".
			"expecting the type of typing", $body,
			'Bio::Polloc::Polloc::ParsingException');
   # Read arguments
   my %args = ();
   for my $k ($self->_cfg->all_keys('.typing')){
   	(my $name = $k) =~ s/^\.typing\.//;
	$name =~ s/^(?!-)/-/;
	$args{$name} = $self->value($k);
   }
   $args{'-type'} = $body;
   $self->typing(Bio::Polloc::TypingI->new(%args));
}

=head2 _parse_cfg

=cut

sub _parse_cfg {
   my($self,@args) = @_;
   $self->_cfg( Bio::Polloc::Polloc::Config->new(-noparse=>1, @args) );
   $self->_cfg->spaces(".typing");
   $self->read(@args);
}

=head2 _initialize

=cut

sub _initialize {
   my($self,@args) = @_;
   $self->_parse_cfg(@args);
}


1;