view release on metacpan or  search on metacpan

exec/readin_tcoffee.pl  view on Meta::CPAN

              'overall' => $overall_score,
              'column'  => [],
              'row'     => {},
              'otu'     => {}
};


for my $taxon_score (@otu_avg_scores) {
    my ($taxon, $score) = $taxon_score =~ /(\S+)\s+:\s+(\d+)/;
    $scores->{'row'}{$taxon} = $score;
}

my $metadata = {
                 'tcoffee_version' => $version,
                 'tcoffee_rundate' => $date,
                 'alignment_score' => $overall_score,
                 'row_scores'      => $scores->{'row'}
                };

## Get rid of the header
$tcoff =~ s/^.+:\s+\d+\n//s;

## Loop through the interleaved "blocks"
while ($tcoff =~ s/^(.*?\n)\n\n//s) {
    my $block = $1;
#        print Dumper $block;

    $block =~ s/Cons\s+([-\d]+)\s*$//i;
#    $scores->{'column'} .= $1;
    push(@{ $scores->{'column'} }, split(//, $1));

    while( $block =~ s/^(\S+)\s+(\S+)\n// ) {
        my $taxon = $1;
        my $seq = $2;
        $seq =~ s/[A-Z]/\?/g;
        push(@{ $scores->{'otu'}{$taxon} }, split(//, $seq));
    }
}

## Construct a NEXUS CharactersBlock object
my $charblock = new Bio::NEXUS::CharactersBlock();

$charblock->set_title('tcoffee');
#$charblock->add_link();
$charblock->set_format( { 'datatype' => 'standard', 'gap' => '-', 'missing' => '?' } );

my $otuset;
for my $taxon (keys %{ $scores->{'otu'} }) {
    push @$otuset, Bio::NEXUS::TaxUnit->new($taxon, $scores->{'otu'}{$taxon});
}
$charblock->get_otuset()->set_otus($otuset);

$charblock->set_taxlabels(keys %{ $scores->{'row'} });
$charblock->write();


## Subroutines ##

sub slurp {
    my ($filename) = @_;
    my $file_contents = do{ local(@ARGV, $/) = $filename; <>};
    return $file_contents;
}