Bio-Phylo

 view release on metacpan or  search on metacpan

lib/Bio/Phylo/Matrices/DatumRole.pm  view on Meta::CPAN

 Returns : A Bio::Phylo::Matrices::Datum object.
 Args    : A Bio::Seq (or similar) object

=cut

    sub new_from_bioperl {
        my ( $class, $seq, @args ) = @_;

        # want $seq type-check here? Allowable: is-a Bio::PrimarySeq,
        #  Bio::LocatableSeq /maj
        my $type = $seq->alphabet || $seq->_guess_alphabet || 'dna';
        my $self = $class->new( '-type' => $type, @args );

        # copy seq string
        my $seqstring = $seq->seq;
        if ( $seqstring and $seqstring =~ /\S/ ) {
            eval { $self->set_char($seqstring) };
            if (
                $@
                and looks_like_instance(
                    $@, 'Bio::Phylo::Util::Exceptions::InvalidData'

lib/Bio/Phylo/Matrices/MatrixRole.pm  view on Meta::CPAN

    sub new_from_bioperl {
        my ( $class, $aln, @args ) = @_;
        if ( looks_like_instance( $aln, 'Bio::Align::AlignI' ) ) {
            $aln->unmatch;
            $aln->map_chars( '\.', '-' );
            my @seqs = $aln->each_seq;
            my ( $type, $missing, $gap, $matchchar );
            if ( $seqs[0] ) {
                $type =
                     $seqs[0]->alphabet
                  || $seqs[0]->_guess_alphabet
                  || 'dna';
            }
            else {
                $type = 'dna';
            }
            my $self = $factory->create_matrix(
                '-type'            => $type,
                '-special_symbols' => {
                    '-missing'   => $aln->missing_char || '?',
                    '-matchchar' => $aln->match_char   || '.',

lib/Bio/Phylo/Parsers/Abstract.pm  view on Meta::CPAN

        return undef;
    }
}

# this constructor is called by the Bio::Phylo::IO::parse
# subroutine
sub _new {
    my $class = shift;    
    my %args  = looks_like_hash @_;
    
    # we need to guess the format
    if ( $class eq __PACKAGE__ ) {
        if ( my $format = _guess_format(_open_handle(%args)) ) {
            $class = 'Bio::Phylo::Parsers::' . ucfirst($format);
            return looks_like_class($class)->_new(%args);
        }
        else {
            throw 'BadArgs' => "No format specified and unable to guess!";
        }
    }    

    # factory is either user supplied or a private static
    my $fac = $args{'-factory'} || $factory;

    # values of these object fields will be accessed
    # by child classes through the appropriate protected
    # getters
    return bless {

lib/Bio/Phylo/Parsers/Abstract.pm  view on Meta::CPAN

sub _args     { shift->{'_args'} }
sub _encoding { shift->{'_encoding'} }
sub _flush    { shift->{'_flush'} }
sub _handlers {
    my ( $self, $type ) = @_;    
    if ( my $h = $self->{'_handlers'} ) {
        return defined $type ? $h->{$type} : $h;
    }
}

sub _guess_format {
    my $handle = shift;
    my $line = $handle->getline;
    my $format;
    if ( $line =~ /^#nexus/i ) {
        $format = 'nexus';
    }
    elsif ( $line =~ /^<[^>]*nexml/ ) {
        $format = 'nexml';
    }
    elsif ( $line =~ /^<[^>]*phyloxml/ ) {