package Bio::PhyloRole;
use strict;
use base 'Bio::Phylo::Identifiable';
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    : None

=cut

    sub get_nexus_name {
        my $self = shift;
        my $name = $self->get_internal_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;
        return <<"SERIALIZED_OBJECT";
class: $class
id: $id
internal_name: $internal_name
name: $name
score: $score
desc: $desc
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;
