Bio-NeXMLIO

 view release on metacpan or  search on metacpan

lib/Bio/Nexml/Factory.pm  view on Meta::CPAN

    
    my ($self, $aln, $taxa, @args) = @_;
    
    #most of the code below ripped from Bio::Phylo::Matrices::Matrix::new_from_bioperl()
    if ( $aln->isa('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 $matrix = $fac->create_matrix( 
                '-type' => $type,
                '-special_symbols' => {
                    '-missing'   => $aln->missing_char || '?',
                    '-matchchar' => $aln->match_char   || '.',

lib/Bio/Nexml/Factory.pm  view on Meta::CPAN

 Title   : create_bphylo_seq
 Usage   : my $bphylo_seq = $factory->create_bphylo_seq($bperl_seq);
 Function: Converts a L<Bio::Seq> object into Bio::Phylo::Matrices::Matrix object
 Returns : a Bio::Phylo::Matrices::Matrix object
 Args    : Bio::Seq object

=cut

sub create_bphylo_seq {
    my ($self, $seq, $taxa, @args) = @_;
    my $type    = $seq->alphabet || $seq->_guess_alphabet || 'dna';
    $type = uc($type);
    
    my $dat = create_bphylo_datum($seq, $taxa, '-type' => $type);  
        
    # copy seq string
    my $seqstring = $seq->seq;
    if ( $seqstring and $seqstring =~ /\S/ ) {
        eval { $dat->set_char( $seqstring ) };
        if ( $@ and UNIVERSAL::isa($@,'Bio::Phylo::Util::Exceptions::InvalidData') ) {
            $self->throw("\n\nThe BioPerl sequence object contains invalid data ($seqstring)\n");

lib/Bio/Nexml/Factory.pm  view on Meta::CPAN

    my $class = 'Bio::Phylo::Matrices::Datum';
    my $feats;
    # want $seq type-check here? Allowable: is-a Bio::PrimarySeq, 
        #  Bio::LocatableSeq /maj
    if (@args % 2) { # odd
        $feats = shift @args;
        unless (ref($feats) eq 'ARRAY') {
        Bio::Root::Root->throw("Third argument must be array of SeqFeatures");
        }
    }
        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 UNIVERSAL::isa($@,'Bio::Phylo::Util::Exceptions::InvalidData') ) {
                $self->throw("\n\nThe BioPerl sequence object contains invalid data ($seqstring)\n");
            }
        }      
        



( run in 0.755 second using v1.01-cache-2.11-cpan-748bfb374f4 )