[Bioperl-guts-l] [16327] bioperl-live/trunk: PhyloXML update: xsd1.1 and add_attribute()
miraceti at dev.open-bio.org
miraceti at dev.open-bio.org
Tue Nov 3 17:32:57 EST 2009
Revision: 16327
Author: miraceti
Date: 2009-11-03 17:32:56 -0500 (Tue, 03 Nov 2009)
Log Message:
-----------
PhyloXML update: xsd1.1 and add_attribute()
Modified Paths:
--------------
bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
bioperl-live/trunk/t/Tree/TreeIO/phyloxml.t
bioperl-live/trunk/t/data/phyloxml_examples.xml
Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
===================================================================
--- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2009-11-03 08:38:24 UTC (rev 16326)
+++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2009-11-03 22:32:56 UTC (rev 16327)
@@ -178,10 +178,99 @@
return $tree;
}
-=head2 add_phyloXML_annotation
+=head2 add_attribute
Title : add_phyloXML_annotation
+ Usage : my $node = $treeio->add_phyloXML_annotation(-obj=>$node, -attr=>"id_source = \"A\"")
+ Function: add attributes to an object
+ Returns : the node that we added annotations to
+ Args : -obj => object that will have the Annotation. (Bio::Tree::AnnotatableNode)
+ -attr => string in the form "A = B", where A is the attribute name and B is the attribute value
+
+=cut
+
+sub add_attribute
+{
+ my ($self, @args) = @_;
+ my ($obj, $attr) = $self->_rearrange([qw(OBJ ATTR)], @args);
+
+ if ($attr) {
+ $attr = '<dummy '.$attr.'/>';
+ }
+
+ my $oldreader = $self->{'_reader'}; # save reader
+ $self->{'_reader'} = XML::LibXML::Reader->new(
+ string => $attr,
+ no_blanks => 1
+ );
+ my $reader = $self->{'_reader'};
+ $self->{'_currentannotation'} = []; # holds annotationcollection
+ $self->{'_currenttext'} = '';
+ #$self->{'_id_link'} = {};
+
+ # pretend we saw a <clade> element
+ $self->{'_lastitem'}->{'dummy'}++;
+ push @{$self->{'_lastitem'}->{'current'}}, { 'dummy'=>{}}; # current holds current element and empty hash for its attributes
+
+ # push object to annotate
+ push @{$self->{'_currentitems'}}, $obj;
+
+ # read attributes of element
+ while ($reader->read)
+ {
+ #$self->processXMLNode;
+ $self->processAttribute($self->current_attr);
+ }
+
+ # if there is id_source add sequence to _id_link
+ if (exists $self->current_attr->{'id_source'}) {
+ my $idsrc = $self->current_attr->{'id_source'};
+ $self->{'_id_link'}->{$idsrc} = $obj;
+ }
+
+ # check idref
+ my $idref = '';
+ if (exists $self->current_attr->{'id_ref'}) {
+ $idref = $self->current_attr->{'id_ref'};
+ }
+
+ my $srcbyidref = '';
+ $srcbyidref = $self->{'_id_link'}->{$idref};
+
+ # exception when id_ref is defined but id_src is not, or vice versa.
+ if ($idref xor $srcbyidref) {
+ $self->throw("id_ref and id_src incompatible: $idref, $srcbyidref");
+ }
+
+ # if attribute exists then add Annotation::Collection with tag '_attr'
+ my $newac = $obj->annotation;
+ if ( scalar keys %{$self->current_attr} ) {
+ my $newattr = Bio::Annotation::Collection->new();
+ foreach my $tag (keys %{$self->current_attr}) {
+ my $sv = Bio::Annotation::SimpleValue->new(
+ -value => $self->current_attr->{$tag}
+ );
+ $newattr->add_Annotation($tag, $sv);
+ }
+ $newac->add_Annotation('_attr', $newattr);
+ }
+
+ # pop from temporary list
+ pop @{$self->{'_currentitems'}};
+ $self->{'_lastitem'}->{ $reader->name }-- if $reader->name;
+ pop @{$self->{'_lastitem'}->{'current'}};
+
+ $self->{'_reader'} = $oldreader; # restore reader
+ return $obj;
+
+}
+
+=ehead2 add_phyloXML_annotation
+
+ Title : add_phyloXML_annotation
Usage : my $node = $treeio->add_phyloXML_annotation(-obj=>$node, -xml=>$xmlstring)
+ my $tree = $treeio->add_phyloXML_annotation('-obj'=>$tree, '-xml'=>'<sequence_relation id_ref_0="A" id_ref_1="B" type="orthology"/>')
+
Function: add annotations to a node in the phyloXML format string
Returns : the node that we added annotations to
Args : -obj => object that will have the Annotation. (Bio::Tree::AnnotatableNode)
@@ -192,10 +281,12 @@
sub add_phyloXML_annotation
{
my ($self, @args) = @_;
- my ($obj, $xml_string, $attr) = $self->_rearrange([qw(OBJ XML ATTR)], @args);
+ my ($obj, $xml_string) = $self->_rearrange([qw(OBJ XML)], @args);
$xml_string = '<phyloxml>'.$xml_string.'</phyloxml>';
$self->debug( $xml_string );
+
+ my $oldreader = $self->{'_reader'}; # save reader
$self->{'_reader'} = XML::LibXML::Reader->new(
string => $xml_string,
no_blanks => 1
@@ -203,7 +294,7 @@
my $reader = $self->{'_reader'};
$self->{'_currentannotation'} = []; # holds annotationcollection
$self->{'_currenttext'} = '';
- $self->{'_id_link'} = {};
+ #$self->{'_id_link'} = {};
# pretend we saw a <clade> element
$self->{'_lastitem'}->{'clade'}++;
@@ -223,6 +314,7 @@
$self->{'_lastitem'}->{ $reader->name }-- if $reader->name;
pop @{$self->{'_lastitem'}->{'current'}};
+ $self->{'_reader'} = $oldreader; # restore reader
return $obj;
}
@@ -787,6 +879,8 @@
my @srcbyidref = ();
$srcbyidref[0] = $self->{'_id_link'}->{$id_ref_0};
$srcbyidref[1] = $self->{'_id_link'}->{$id_ref_1};
+
+ print %{$self->{'_id_link'}}, "\n";
# exception when id_ref is defined but id_src is not, or vice versa.
if ( ($id_ref_0 xor $srcbyidref[0])||($id_ref_1 xor $srcbyidref[1]) ) {
Modified: bioperl-live/trunk/t/Tree/TreeIO/phyloxml.t
===================================================================
--- bioperl-live/trunk/t/Tree/TreeIO/phyloxml.t 2009-11-03 08:38:24 UTC (rev 16326)
+++ bioperl-live/trunk/t/Tree/TreeIO/phyloxml.t 2009-11-03 22:32:56 UTC (rev 16327)
@@ -7,7 +7,7 @@
use lib '.';
use Bio::Root::Test;
- test_begin(-tests => 97,
+ test_begin(-tests => 98,
-requires_modules => [qw(XML::LibXML XML::LibXML::Reader)]);
use_ok('Bio::TreeIO');
@@ -68,10 +68,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -110,10 +110,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -148,10 +148,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -203,10 +203,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -265,10 +265,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -307,16 +307,35 @@
}
my ($z_seqname_text2) = $treeio->read_annotation('-obj'=>$z_seq, '-path'=>'name');
is ($z_seqname_text->value, $z_seqname_text2);
-
+ my ($y) = $leaves[1];
+ my $y_seq = $y->sequence->[0];
+ isa_ok ($y_seq, 'Bio::SeqI');
+
+ # add attribute id_source
+ $treeio->add_attribute(
+ '-obj' => $z_seq,
+ '-attr' => "id_source = \"A\""
+ );
+ $treeio->add_attribute(
+ '-obj' => $y_seq,
+ '-attr' => "id_source = \"B\""
+ );
+
+ # add sequence relation
+ $treeio->add_phyloXML_annotation(
+ '-obj'=>$tree,
+ '-xml'=>'<sequence_relation id_ref_0="A" id_ref_1="B" type="orthology"/>'
+ );
+
# write_tree
if ($verbose > 0) {
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -364,10 +383,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -410,10 +429,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -453,10 +472,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -507,10 +526,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
diag(`cat $FILE1`);
@@ -556,10 +575,10 @@
diag("\ntest write_tree");
}
my $FILE1 = test_output_file();
- my $treeio = Bio::TreeIO->new(-verbose => $verbose,
+ my $treeout = Bio::TreeIO->new(-verbose => $verbose,
-format => 'phyloxml',
-file => ">$FILE1");
- $treeio->write_tree($tree);
+ $treeout->write_tree($tree);
ok -s $FILE1;
if ($verbose > 0) {
@@ Diff output truncated at 10000 characters. @@
More information about the Bioperl-guts-l
mailing list