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