1#! /usr/bin/perl -w 2 3use strict; 4use Data::Dumper; 5use Bio::NEXUS; 6 7my ($infile, $outfile) = @ARGV; 8if (!$outfile) {$outfile = "test.nex";} 9print "$infile\n"; 10 11my $nexus = new Bio::NEXUS($infile, 1); 12#print $nexus->get_block('trees')->get_tree->get_rootnode->printall();exit; 13#$nexus->write($outfile, 1);exit; 14 15if (! $nexus->get_block("span")) { 16 my $spanblock = new Bio::NEXUS::SpanBlock("span"); 17 $spanblock->set_title("\"metadata for this family\""); 18 $spanblock->add_link('taxa', $nexus->get_name()); 19 $spanblock->set_command('spandex', {version=>'0.1'}); 20 my $taxa = $nexus->get_name(); 21 my @taxlabels = @{$nexus->get_block('taxa')->get_taxlabels()}; 22 my @data; 23 foreach my $label (@taxlabels) { 24 $label =~ /^(.+)_(.+)$/; 25 push @data, [$label, $1, $2],; 26 } 27 $spanblock->{add} = { 28 taxa => { 29 attributes => ['pfam_id'], 30 source => 'pfam', 31 data => [[$taxa, '000000']], 32 }, 33 taxlabels => { 34 attributes => ['species', 'accession'], 35 source => 'GENBANK', 36 data => \@data, 37 }, 38 }; 39 $spanblock->{method} = { 40 alignment => { 41 program => 'clustalw', 42 }, 43 phylogeny => { 44 program => 'MrBayes', 45 version => '2', 46 }, 47 }; 48 $nexus->add_block($spanblock); 49} 50 51$nexus->write($outfile, 1); 52