File Coverage

blib/lib/Bio/PhyloRole.pm

Criterion	Covered	Total	%
statement	50	61	81.9
branch	12	16	75.0
condition	7	20	35.0
subroutine	13	14	92.8
pod	6	6	100.0
total	88	117	75.2

package Bio::PhyloRole;
use strict;
use warnings;
use base 'Bio::Phylo::Identifiable';
use Data::Dumper;
use Bio::Phylo::Util::CONSTANT '/looks_like/';
use Bio::Phylo::Identifiable;              # for storing unique IDs inside an instance
use Bio::Phylo::Util::Exceptions 'throw';  # defines exception classes and throws
use Bio::Phylo::Util::Logger;    # for logging, like log4perl/log4j

=head1 NAME

Bio::PhyloRole - Extra behaviours for the base class

=head1 SYNOPSIS

 # Actually, you would almost never use this module directly. This is
 # the base class for other modules.
 use Bio::Phylo;

 # sets global verbosity to 'error'
 Bio::Phylo->VERBOSE( -level => Bio::Phylo::Util::Logger::ERROR );

 # sets verbosity for forest ojects to 'debug'
 Bio::Phylo->VERBOSE(
 	-level => Bio::Phylo::Util::Logger::DEBUG,
 	-class => 'Bio::Phylo::Forest'
 );

 # prints version, including SVN revision number
 print Bio::Phylo->VERSION;

 # prints suggested citation
 print Bio::Phylo->CITATION;

=head1 DESCRIPTION

This is the base class for the Bio::Phylo package for phylogenetic analysis using
object-oriented perl5. In this file, methods are defined that are performed by other
objects in the Bio::Phylo release that inherit from this base class (which you normally
wouldn't use directly).

For general information on how to use Bio::Phylo, consult the manual
(L<Bio::Phylo::Manual>).

If you come here because you are trying to debug a problem you run into in
using Bio::Phylo, you may be interested in the "exceptions" system as discussed
in L<Bio::Phylo::Util::Exceptions>. In addition, you may find the logging system
in L<Bio::Phylo::Util::Logger> of use to localize problems.

=head1 METHODS

=head2 ACCESSORS

=over

=item get_nexus_name()

Gets invocant's name, modified to be safely used in nexus files. This means that:

=item names with spaces in them that aren't 'single quoted' have their spaces replaced
with underscores

=item names with any of the following characters in them are single quoted:
 -^*(){}[]+=;:"\<>/,

=item names with single quotes inside them (i.e. not around them) are "double quoted"

 Type    : Accessor
 Title   : get_nexus_name
 Usage   : my $name = $obj->get_nexus_name;
 Function: Returns the object's name.
 Returns : A string
 Args    : (Optional) if provided a true value, the returned name may be the null
           string, in cases where no name for the object has been set. The default
           value (i.e. if no argument was provided) is to return an autogenerated
           name for any anonymous object.

=cut

    sub get_nexus_name {
        my ($self,$no_internal) = @_;
        my $name = $no_internal ? $self->get_name : $self->get_internal_name;
        if ( $name ) {
			if ( $name =~ /\s/ && $name !~ /^'.+'$/ ) {
				$name =~ s/\s/_/g;
			}
			if (   $name =~ /(?:\-|\^|\*|\(|\)|{|}|\[|\]|\+|=|;|:|"|\\|<|>|\/|,)/
				&& $name !~ /^'.+'$/ )
			{
				$name = "'${name}'";
			}
			if ( $name =~ /'/ && $name !~ /^".+"$/ && $name !~ /^'.+'$/ ) {
				$name = "\"${name}\"";
			}
        }
        return $name;
    }

=item get_internal_name()

Gets invocant's 'fallback' name (possibly autogenerated).

 Type    : Accessor
 Title   : get_internal_name
 Usage   : my $name = $obj->get_internal_name;
 Function: Returns the object's name (if none was set, the name
           is a combination of the $obj's class and its UID).
 Returns : A string
 Args    : None

=cut

    sub get_internal_name {
        my $self = shift;
        if ( my $name = $self->get_name ) {
            return $name;
        }
        else {
            my $internal_name = ref $self;
            $internal_name =~ s/.*:://;
            $internal_name .= $self->get_id;
            return $internal_name;
        }
    }

=back

=head2 PACKAGE METHODS

=over

=item get()

Attempts to execute argument string as method on invocant.

 Type    : Accessor
 Title   : get
 Usage   : my $treename = $tree->get('get_name');
 Function: Alternative syntax for safely accessing
           any of the object data; useful for
           interpolating runtime $vars.
 Returns : (context dependent)
 Args    : a SCALAR variable, e.g. $var = 'get_name';

=cut

    sub get {
        my ( $self, $var ) = @_;
        if ( $self->can($var) ) {
            return $self->$var;
        }
        else {
            my $ref = ref $self;
            throw 'UnknownMethod' => "sorry, a '$ref' can't '$var'";
        }
    }

=item to_string()

Serializes object to general purpose string

 Type    : Serializer
 Title   : to_string()
 Usage   : print $obj->to_string();
 Function: Serializes object to general purpose string
 Returns : String
 Args    : None
 Comments: This is YAML

=cut

    sub to_string {
        my $self          = shift;
        my $class         = ref $self;
        my $id            = $self->get_id;
        my $internal_name = $self->get_internal_name;
        my $name          = $self->get_name  || '';
        my $score         = $self->get_score || '';
        my $desc          = $self->get_desc  || '';
        my $gen           = Dumper($self->get_generic) || '';
        return <<"SERIALIZED_OBJECT";
class: $class
id: $id
internal_name: $internal_name
name: $name
score: $score
desc: $desc
generic: $gen
SERIALIZED_OBJECT
    }

=item VERBOSE()

Getter and setter for the verbosity level. Refer to L<Bio::Phylo::Util::Logger> for more
info on available verbosity levels.

 Type    : Accessor
 Title   : VERBOSE()
 Usage   : Bio::Phylo->VERBOSE( -level => $level )
 Function: Sets/gets verbose level
 Returns : Verbose level
 Args    : -level => $level
 Comments:

=cut

    # Verbosity is mostly handled by the logger, actually. This method
    # is just here for backward compatibility (and ease of use).
    # TODO have a facility to turn log levels (warn/error/fatal) into
    # throws
    sub VERBOSE {
        my $class = shift;
        if (@_) {
            my %opt = looks_like_hash @_;
            Bio::Phylo::Util::Logger::VERBOSE(%opt);

        }
        return $Bio::Phylo::Util::Logger::VERBOSE;
    }

=item CITATION()

Returns suggested citation.

 Type    : Accessor
 Title   : CITATION
 Usage   : $phylo->CITATION;
 Function: Returns suggested citation.
 Returns : Returns suggested citation.
 Args    : None
 Comments:

=cut

    sub CITATION {
        return <<'CITATION';
Rutger A Vos, Jason Caravas, Klaas Hartmann, Mark A Jensen and Chase Miller, 2011.
Bio::Phylo - phyloinformatic analysis using Perl. BMC Bioinformatics 12:63.
doi:10.1186/1471-2105-12-63
CITATION
    }

=back

=head1 SEE ALSO

There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo>
for any user or developer questions and discussions.

Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>

=head1 CITATION

If you use Bio::Phylo in published research, please cite it:

B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
I<BMC Bioinformatics> B<12>:63.
L<http://dx.doi.org/10.1186/1471-2105-12-63>

=cut

1;