File Coverage

blib/lib/Bio/NEXUS/UnknownBlock.pm

Criterion	Covered	Total	%
statement	36	53	67.9
branch	3	10	30.0
condition	0	2	0.0
subroutine	9	11	81.8
pod	1	1	100.0
total	49	77	63.6

######################################################
# UnknownBlock.pm
######################################################
# Author: Peter Yang, Thomas Hladish
# $Id: UnknownBlock.pm,v 1.27 2007/09/24 04:52:14 rvos Exp $

#################### START POD DOCUMENTATION ##################

=head1 NAME

Bio::NEXUS::UnknownBlock - Represents a simple  object for storing information unrecognized blocks by the Bio::NEXUS module.

=head1 SYNOPSIS

$block_object = new Bio::NEXUS::UnknownBlock($block_type, $block, $verbose);

=head1 DESCRIPTION

Provides a simple way of storing information about a block that is not currently recognized by the NEXUS package. This is useful for remembering custom blocks.

=head1 FEEDBACK

All feedback (bugs, feature enhancements, etc.) are all greatly appreciated. There are no mailing lists at this time for the Bio::NEXUS::TaxaBlock module, so send all relevant contributions to Dr. Weigang Qiu ([e-mail]).

=head1 AUTHORS

 Peter Yang ([e-mail])
 Thomas Hladish (tjhladish at yahoo)

=head1 VERSION

$Revision: 1.27 $

=head1 METHODS

=cut

package Bio::NEXUS::UnknownBlock;

use strict;
#use Carp; # XXX this is not used, might as well not import it!
#use Data::Dumper; # XXX this is not used, might as well not import it!
use Bio::NEXUS::Functions;
use Bio::NEXUS::Block;
use Bio::NEXUS::Util::Exceptions;
use Bio::NEXUS::Util::Logger;
use vars qw(@ISA $VERSION $AUTOLOAD);
use Bio::NEXUS; $VERSION = $Bio::NEXUS::VERSION;
@ISA = qw(Bio::NEXUS::Block);

my $logger = Bio::NEXUS::Util::Logger->new();

=head2 new

 Title   : new
 Usage   : block_object = new Bio::NEXUS::UnknownBlock($block_type, $commands, $verbose);
 Function: Creates a new Bio::NEXUS::UnknownBlock object and automatically reads the file
 Returns : Bio::NEXUS::UnknownBlock object
 Args    : type (string), the commands/comments to parse (array ref), and a verbose flag (0 or 1; optional)

=cut

sub new {
    my ( $class, $type, $commands, $verbose ) = @_;
    unless ($type) { ( $type = lc $class ) =~ s/Bio::NEXUS::(.+)Block/$1/i; }
    my $self = { type => $type, };
    bless $self, $class;
    $self->_parse_block( $commands, $verbose );
    return $self;
}

=begin comment

 Title   : _parse_block
 Usage   : $block->_parse_block(\@commands, $verbose_flag);
 Function: Simple block parser that stores commands literally
 Returns : none
 Args    : array ref of commands, as parsed by Bio::NEXUS::read; and an optional verbose flag

=end comment

=cut

sub _parse_block {
    my ( $self, $commands, $verbose ) = @_;
    my $type = $self->get_type();
    $logger->info("Analyzing $type block now.");

CMD:
    for my $command (@$commands) {
        next CMD if $command =~ /^\s*(?:begin|end)/i;
        push @{ $self->{'block'} }, $command;
    }

	$logger->info("Analysis of $type block complete.");
    return;
}

=begin comment

 Name    : _write
 Usage   : $block->_write();
 Function: Writes NEXUS block from stored data
 Returns : none
 Args    : none

=end comment

=cut

sub _write {
    my $self = shift;
    my $fh = shift || \*STDOUT;
    print $fh "BEGIN ", uc $self->get_type(), ";\n";
    my $commands = $self->{'block'};
    for my $cmd (@$commands) {
        next if lc $cmd eq 'begin';
        print $fh "$cmd\n";
    }
    print $fh "END;\n";
}

sub AUTOLOAD {
    return if $AUTOLOAD =~ /DESTROY$/;
    my $package_name = __PACKAGE__ . '::';

    # The following methods are deprecated and are temporarily supported
    # via a warning and a redirection
    my %synonym_for = (

#        "${package_name}parse"      => "${package_name}_parse_tree",  # example
    );

    if ( defined $synonym_for{$AUTOLOAD} ) {
        $logger->warn( "$AUTOLOAD() is deprecated; use $synonym_for{$AUTOLOAD}() instead" );
        goto &{ $synonym_for{$AUTOLOAD} };
    }
    else {
        Bio::NEXUS::Util::Exceptions::UnknownMethod->throw(
        	'error' => "ERROR: Unknown method $AUTOLOAD called"
        );
    }
}

1;