[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