t/SeqIO/nexml.t

   1 #-*-perl-*-
   2 # $Id$
   3
   4 use strict;
   5
   6 use Bio::Root::Test;
   7 test_begin(-tests => 126,
   8             -requires_modules => [qw(Bio::Phylo)]);
   9 use_ok( 'Bio::PrimarySeq' );
  10 use_ok('Bio::SeqIO::nexml'); # checks that your module is there and loads ok
  11 diag("WARNING: NeXML parsing for NeXML v0.9 is currently very experimental support");
  12 SKIP: {
  13     skip("NeXML parsing for NeXML v0.9 is currently very experimental support", 124);
  14
  15 #Read Data
  16 ok( my $SeqStream = Bio::SeqIO->new(
  17                     -file => test_input_file('nexml', 'characters.nexml.xml'),
  18                     -format => 'nexml'),'stream ok');
  19
  20 #checking first sequence object
  21 ok( my $seq_obj = $SeqStream->next_seq(), 'seq obj' );
  22 isa_ok($seq_obj, 'Bio::Seq');
  23 is( $seq_obj->alphabet, 'dna', "alphabet" );
  24 TODO: {
  25     local $TODO = 'primary/display_id broken with NeXML 0.9';
  26     is( $seq_obj->primary_id, 'DNA sequences.seq_1', "primary_id");
  27     is( $seq_obj->display_id, 'DNA sequences.seq_1', "display_id");
  28 }
  29 is( $seq_obj->seq, 'ACGCTCGCATCGCATC', "sequence");
  30 #check taxa
  31 my %expected_taxa = ('Homo sapiens' => 1,
  32                      'Pan paniscus' => 1,
  33                      'Pan troglodytes' => 1,
  34                      'Gorilla gorilla' => 1,
  35                      'Pongo pygmaeus' => 1);
  36 my $feat = ($seq_obj->get_SeqFeatures())[0];
  37 is( ($feat->get_tag_values('taxa_id'))[0], 'taxa1', 'taxa id');
  38 is( ($feat->get_tag_values('taxa_label'))[0], 'Primary taxa block', 'taxa label');
  39 is( ($feat->get_tag_values('my_taxon'))[0], 'Homo sapiens', "taxon ok" );
  40 my @taxa = $feat->get_tag_values('taxon');
  41 is( @taxa, 5, 'number of taxa');
  42 foreach my $taxon (@taxa) {
  43     ok( $expected_taxa{$taxon}, 'taxon ok')
  44 }
  45
  46 #checking second sequence object
  47 ok( $seq_obj = $SeqStream->next_seq() );
  48 is( $seq_obj->alphabet, 'dna', "alphabet" );
  49 TODO: {
  50     local $TODO = 'primary/display_id broken with NeXML 0.9';
  51     is( $seq_obj->primary_id, 'DNA sequences.seq_2', "primary_id");
  52     is( $seq_obj->display_id, 'DNA sequences.seq_2', "display_id");
  53 }
  54 is( $seq_obj->seq, 'ACGCTCGCATCGCATC', "sequence");
  55 $SeqStream->next_seq();
  56 $SeqStream->next_seq();
  57
  58 #checking fifth sequence object
  59 ok( $seq_obj = $SeqStream->next_seq() );
  60 is( $seq_obj->alphabet, 'rna', "alphabet" );
  61 TODO: {
  62     local $TODO = 'primary/display_id broken with NeXML 0.9';
  63     is( $seq_obj->primary_id, 'RNA sequences.seq_2', "primary_id");
  64     is( $seq_obj->display_id, 'RNA sequences.seq_2', "display_id defaults to primary");
  65 }
  66 is( $seq_obj->seq, 'ACGCUCGCAUCGCAUC', "sequence");
  67
  68 #Write Data
  69 diag('Begin tests for writing seq files');
  70 my $outdata = test_output_file();
  71 ok( my $outSeqStream = Bio::SeqIO->new(-file => ">$outdata",
  72                                        -format => 'nexml'), 'out stream ok');
  73 ok $outSeqStream->write_seq($seq_obj), 'write nexml seq';
  74 close($outdata);
  75
  76 diag("write_seq support for NeXML 0.9 NYI");
  77
  78 #Read in the out file to test roundtrip
  79 my $inSeqStream = Bio::SeqIO->new(-file => $outdata, -format => 'nexml');
  80
  81 #checking fifth sequence object
  82 ok( my $seq_obj2 = $inSeqStream->next_seq() );
  83 is( $seq_obj2->alphabet, 'rna', "alphabet" );
  84 is( $seq_obj2->primary_id, 'RNA sequences.seq_2', "primary_id");
  85 is( $seq_obj2->display_id, 'RNA sequences.seq_2', "display_id defaults to primary");
  86 is( $seq_obj2->seq, 'ACGCUCGCAUCGCAUC', "sequence");
  87
  88 #check taxa
  89 my $feat1 = ($seq_obj2->get_SeqFeatures())[0];
  90 is( ($feat1->get_tag_values('taxa_id'))[0], 'taxa1', 'taxa id');
  91 is( ($feat1->get_tag_values('taxa_label'))[0], 'Primary taxa block', 'taxa label');
  92 is( ($feat1->get_tag_values('my_taxon'))[0], 'Pan paniscus', "taxon ok" );
  93 my @taxa2 = $feat1->get_tag_values('taxon');
  94 is( @taxa2, 5, 'number of taxa');
  95 foreach my $taxon (@taxa2) {
  96     ok( $expected_taxa{$taxon}, 'taxon ok')
  97 }
  98
  99 }