use strict;
use Test::More;
use Bio::Phylo::Forest::Tree;
use Bio::Phylo::Util::Logger;
BEGIN {
    eval { require Bio::TreeIO };
    if ( $@ ) {
        plan 'skip_all' => 'Bio::TreeIO not found';
    }
    if ( not $ENV{'BIOPERL_LIVE_ROOT'} ) {
        plan 'skip_all' => 'env var BIOPERL_LIVE_ROOT not set';
    }
}
BEGIN { 
    use lib $ENV{'BIOPERL_LIVE_ROOT'} . '/t/lib';
    use Bio::Root::Test;    
    test_begin( '-tests' => 73 );	
    use_ok('Bio::TreeIO');
}
no warnings 'redefine';
sub test_input_file {
    my $file = shift;
    return $ENV{'BIOPERL_LIVE_ROOT'} . '/t/data/' . $file;
}

my $logger = Bio::Phylo::Util::Logger->new;
$logger->VERBOSE( '-level' => 0 );
my $verbose = test_debug();

ok my $treeio = Bio::TreeIO->new(
    '-verbose' => $verbose,
    '-format'  => 'newick',
	'-file'    => test_input_file('cysprot1b.newick')
);

my $tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
isa_ok($tree, 'Bio::Tree::TreeI');

my @nodes = $tree->get_nodes;
is(@nodes, 6);
my ($rat) = $tree->find_node('CATL_RAT');
ok($rat);
is($rat->branch_length, '0.12788');
# move the id to the bootstap
is($rat->ancestor->bootstrap($rat->ancestor->id), '95');
$rat->ancestor->id('');
# maybe this can be auto-detected, but then can't distinguish
# between internal node labels and bootstraps...
is($rat->ancestor->bootstrap, '95');
is($rat->ancestor->branch_length, '0.18794');
is($rat->ancestor->id, '');

if ($verbose) {
	foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
		print "node: ", $node->to_string(), "\n";
		my @ch = $node->each_Descendent();
		if( @ch ) {
			print "\tchildren are: \n";
			foreach my $node ( $node->each_Descendent() ) {
				print "\t\t ", $node->to_string(), "\n";
			}
		}
	}
}

my $FILE1 = test_output_file();
$treeio = Bio::TreeIO->new(
    '-verbose' => $verbose,
    '-format'  => 'newick',
	'-file'    => ">$FILE1"
);
$treeio->write_tree($tree);
undef $treeio;
ok( -s $FILE1 );
$treeio = Bio::TreeIO->new(
    '-verbose' => $verbose,
	'-format'  => 'newick',
	'-file'    => test_input_file('LOAD_Ccd1.dnd')
);
ok($treeio);
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
isa_ok($tree,'Bio::Tree::TreeI');

@nodes = $tree->get_nodes;
is(@nodes, 52);

if( $verbose ) { 
	foreach my $node ( @nodes ) {
		print "node: ", $node->to_string(), "\n";
		my @ch = $node->each_Descendent();
		if( @ch ) {
			print "\tchildren are: \n";
			foreach my $node ( $node->each_Descendent() ) {
				print "\t\t ", $node->to_string(), "\n";
			}
		}
	}
}

is($tree->total_branch_length, 7.12148);
my $FILE2 = test_output_file();
$treeio = Bio::TreeIO->new(
    '-verbose' => $verbose,
    '-format'  => 'newick', 
	'-file'    => ">$FILE2"
);
$treeio->write_tree($tree);
undef $treeio;
ok(-s $FILE2);
$treeio = Bio::TreeIO->new(
    '-verbose' => $verbose,
    '-format'  => 'newick',
    '-file'    => test_input_file('hs_fugu.newick')
);
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree());
@nodes = $tree->get_nodes();
is(@nodes, 5);
# no relable order for the bottom nodes because they have no branchlen
my @vals = qw(SINFRUP0000006110);
my $saw = 0;
foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
	foreach my $v ( @vals ) {
	   if( defined $node->id && 
	       $node->id eq $v ){ $saw = 1; last; }
	}
	last if $saw;
}
is($saw, 1, "Saw $vals[0] as expected");
if( $verbose ) {
	foreach my $node ( @nodes ) {
		print "\t", $node->id, "\n" if $node->id;
	}
}

$treeio = Bio::TreeIO->new(
    '-format' => 'newick', 
	'-fh'     => \*DATA
);
my $treeout = Bio::TreeIO->new( '-format'  => 'tabtree' );
my $treeout2 = Bio::TreeIO->new( '-format' => 'newick'  );

$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);

if( $verbose > 0  ) {
    $treeout->write_tree($tree);
    $treeout2->write_tree($tree);
}

$treeio = Bio::TreeIO->new(
    '-verbose' => $verbose,
    '-file'    => test_input_file('test.nhx')
);

SKIP: {
	test_skip( '-tests' => 2, '-requires_module' => 'SVG::Graph');
	my $FILE3 = test_output_file();
	my $treeout3 = Bio::TreeIO->new(
	    '-format' => 'svggraph',
		'-file'   => ">$FILE3"
	);
	ok($treeout3);
	eval {$treeout3->write_tree($tree);};
	ok (-s $FILE3);
}

ok($treeio);
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);

isa_ok($tree, 'Bio::Tree::TreeI');

@nodes = $tree->get_nodes;
is(@nodes, 13, "Total Nodes");

my $adhy = $tree->find_node('ADHY');
is($adhy->branch_length, 0.1);
is(($adhy->get_tag_values('S'))[0], 'nematode');
is(($adhy->get_tag_values('E'))[0], '1.1.1.1');

# try lintree parsing
$treeio = Bio::TreeIO->new(
    '-format' => 'lintree',
    '-file'   => test_input_file('crab.njb')
);

my (@leaves, $node);
while( $tree = $treeio->next_tree ) {
    $tree = Bio::Phylo::Forest::Tree->new_from_bioperl($tree);
	isa_ok($tree, 'Bio::Tree::TreeI');
	@nodes = $tree->get_nodes;
	@leaves = $tree->get_leaf_nodes;
	is(@leaves, 13);
	SKIP: {
	    skip "for some reason we get 24", 1 unless 0;
	    is(@nodes, 25);
	};
	($node) = $tree->find_node(-id => '18');
	ok($node);
	is($node->id, '18');
	is($node->branch_length, '0.030579');
	is($node->bootstrap, 998);
}

$treeio = Bio::TreeIO->new(
    '-format' => 'lintree',
    '-file'   => test_input_file('crab.nj')
);

$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);

isa_ok($tree, 'Bio::Tree::TreeI');

@nodes = $tree->get_nodes;
@leaves = $tree->get_leaf_nodes;
is(@leaves, 13);
SKIP: {
    skip "for some reason we get 24", 1 unless 0;
    is(@nodes, 25);
};
($node) = $tree->find_node('18');
is($node->id, '18');
is($node->branch_length, '0.028117');

($node) = $tree->find_node(-id => 'C-vittat');
is($node->id, 'C-vittat');
is($node->branch_length, '0.087619');
is($node->ancestor->id, '14');

$treeio = Bio::TreeIO->new(
    '-format' => 'lintree',
    '-file'   => test_input_file('crab.dat.cn')
);
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);

isa_ok($tree, 'Bio::Tree::TreeI');

@nodes = $tree->get_nodes;
@leaves = $tree->get_leaf_nodes;
is(@leaves, 13, "Leaf nodes");
SKIP: {
    skip "for some reason we get 24", 1 unless 0;
    is(@nodes, 25, "All nodes");
};
($node) = $tree->find_node('18');
is($node->id, '18');

is($node->branch_length, '0.029044');

($node) = $tree->find_node(-id => 'C-vittat');
is($node->id, 'C-vittat');
is($node->branch_length, '0.097855');
is($node->ancestor->id, '14');

SKIP: {
	test_skip(-tests => 8, -requires_module => 'IO::String');
	
	# test nexus tree parsing
    $treeio = Bio::TreeIO->new(
        '-format'  => 'nexus',
		'-verbose' => $verbose,
		'-file'    => test_input_file('urease.tre.nexus')
	);    
    $tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
    ok($tree);
    is($tree->id, 'PAUP_1');
    is($tree->get_leaf_nodes, 6);
    ($node) = $tree->find_node('-id' => 'Spombe');
    is($node->branch_length,0.221404);
    
	# test nexus MrBayes tree parsing
    $treeio = Bio::TreeIO->new(
        '-format' => 'nexus',
		'-file'   => test_input_file('adh.mb_tree.nexus')
	);    
    $tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
    ok($tree);
    is($tree->id, 'rep.1');
    is($tree->get_leaf_nodes, 54);
    ($node) = $tree->find_node(-id => 'd.madeirensis');
    is($node->branch_length,0.039223);
}

# bug #1854
# process no-newlined tree
$treeio = Bio::TreeIO->new(
    '-format'  => 'nexus',
    '-verbose' => $verbose,
    '-file'    => test_input_file('tree_nonewline.nexus')
);
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
ok($tree);
ok($tree->find_node('TRXHomo'));


# parse trees with scores
$treeio = Bio::TreeIO->new(
    '-format' => 'newick',
    '-file'   => test_input_file('puzzle.tre')
);
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
ok($tree);
is($tree->score, '-2673.059726');

# bug #2205
# process trees with node IDs containing spaces
$treeio = Bio::TreeIO->new(
    '-format'  => 'nexus',
    '-verbose' => $verbose,
    '-file'    => test_input_file('spaces.nex')
);
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum');
ok($tree);
for my $node ($tree->get_leaf_nodes) {
	is($node->id, shift @nodeids);		
}

# bug #2221
# process tree with names containing quoted commas
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
@nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum');
ok($tree);
for my $node ($tree->get_leaf_nodes) {
	is($node->id, shift @nodeids);		
}

# bug #2221
# process tree with names containing quoted commas on one line
$tree = Bio::Phylo::Forest::Tree->new_from_bioperl($treeio->next_tree);
@nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum');
ok($tree);
for my $node ($tree->get_leaf_nodes) {
	is($node->id, shift @nodeids);		
}

__DATA__
(((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);
