From miraceti at dev.open-bio.org Mon Jun 2 16:05:55 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Mon, 2 Jun 2008 16:05:55 -0400 Subject: [Bioperl-guts-l] [14688] bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm: start_element/ end_element clade Message-ID: <200806022005.m52K5t9E027383@dev.open-bio.org> Revision: 14688 Author: miraceti Date: 2008-06-02 16:05:54 -0400 (Mon, 02 Jun 2008) Log Message: ----------- start_element/end_element clade Modified Paths: -------------- bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm Modified: bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm =================================================================== --- bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm 2008-05-29 14:17:43 UTC (rev 14687) +++ bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm 2008-06-02 20:05:54 UTC (rev 14688) @@ -95,9 +95,9 @@ =cut sub new { - my($class, at args) = @_; - + my ($class, at args) = @_; my $self = $class->SUPER::new(@args); + $self->debug("new NodePhyloXML\n"); my ($user_tag) = $self->_rearrange([qw(PhyloXML)], @args); $self->_tag($user_tag); return $self; @@ -148,26 +148,34 @@ =cut -sub _tag { - my ($self, $tags) = @_; - if (defined $tags && (ref($tags) =~ /HASH/i)) { - while( my ($tag,$val) = each %$tags ) { - if( ref($val) =~ /ARRAY/i ) { - for my $v ( @$val ) { - $self->add_tag_value($tag,$v); - } - } else { - $self->add_tag_value($tag,$val); - } - } - if (exists $tags->{'B'}) { - $self->bootstrap($tags->{'B'}); - } - } elsif (defined $tags and ! ref ($tags)) { - $self->debug( "here with $tags\n"); - # bootstrap by default - $self->bootstrap($tags); +sub _tag +{ + my ($self, $tags) = @_; + if (defined $tags && (ref($tags) =~ /HASH/i)) + { + while( my ($tag,$val) = each %$tags ) + { + if( ref($val) =~ /ARRAY/i ) + { + for my $v ( @$val ) + { + $self->add_tag_value($tag,$v); + } + } + else { + $self->add_tag_value($tag,$val); + } } + if (exists $tags->{'B'}) + { + $self->bootstrap($tags->{'B'}); + } + } + elsif (defined $tags and ! ref ($tags)) + { +# bootstrap by default + $self->bootstrap($tags); + } } 1; From miraceti at dev.open-bio.org Mon Jun 2 16:06:08 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Mon, 2 Jun 2008 16:06:08 -0400 Subject: [Bioperl-guts-l] [14689] bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm: start_element/end_element clade Message-ID: <200806022006.m52K68Iv027414@dev.open-bio.org> Revision: 14689 Author: miraceti Date: 2008-06-02 16:06:08 -0400 (Mon, 02 Jun 2008) Log Message: ----------- start_element/end_element clade Modified Paths: -------------- bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm Modified: bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm =================================================================== --- bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm 2008-06-02 20:05:54 UTC (rev 14688) +++ bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm 2008-06-02 20:06:08 UTC (rev 14689) @@ -98,7 +98,6 @@ $self->nodetype($nodetype); $self->{'_treelevel'} = 0; $self->debug("Creating obj PhyloXMLEventBuilder\n"); - $self->debug("nodetype: $nodetype\n"); return $self; } @@ -160,6 +159,7 @@ $self->{'_lastitem'} = {}; $self->{'_currentitems'} = []; $self->{'_currentnodes'} = []; + $self->debug("Starting Document\n"); return; } @@ -175,6 +175,7 @@ sub end_document { my ($self,$label) = @_; + $self->debug("Ending Document\n"); my $root = $self->nodetype->new( -id => $label, -verbose => $self->verbose); @@ -202,25 +203,26 @@ Function: Example : Returns : - Args : $data => hashref with key 'Name' + Args : $element => hashref with key 'Name' =cut sub start_element { - my ($self,$data) =@_; - $self->{'_lastitem'}->{$data->{'Name'}}++; + my ($self,$element) =@_; + $self->{'_lastitem'}->{$element->{'Name'}}++; - $self->debug("starting element: $data->{Name}\n"); - push @{$self->{'_lastitem'}->{'current'}},$data->{'Name'}; + $self->debug("starting element: $element->{Name}\n"); + push @{$self->{'_lastitem'}->{'current'}},$element->{'Name'}; my %data; - if( $data->{'Name'} eq 'clade' ) + if( $element->{'Name'} eq 'clade' ) { + elementAttribute($self, $element, \%data); push @{$self->{'_currentitems'}}, \%data; } - elsif ( $data->{'Name'} eq 'phylogeny' ) + elsif ( $element->{'Name'} eq 'phylogeny' ) { $self->{'_treelevel'}++; } @@ -249,9 +251,8 @@ { my $tnode; my $node = pop @{$self->{'_currentitems'}}; - $tnode = $self->nodetype->new( -verbose => $self->verbose, - %{$node}); + %{$node}); $self->debug( "new node will be ".$tnode->to_string."\n"); if ( !$node->{'-leaf'} && $levelct > 0) { $self->debug(join(',', map { $_->to_string } @@ -338,17 +339,39 @@ if ( $self->within_element('clade') ) { my $hash = pop @{$self->{'_currentitems'}}; - $self->debug("within_element 'clade': $hash\n"); if( $self->in_element('name') ) { - $hash->{'-name'} = $ch; - $self->debug("in_element 'name': ",$hash, %{$hash},"\n"); + $hash->{'-id'} = $ch->{'Data'}; # change name to id since Node.pm uses id } push @{$self->{'_currentitems'}}, $hash; } - $self->debug("chars: $ch\n"); - $self->debug('currentitems: ',@{$self->{'_currentitems'}}, "\n"); + elsif ( $self->within_element('phylogeny') ) + { + my $hash = pop @{$self->{'_currentitems'}}; + if( $self->in_element('name') ) + { + # name of the phylogeny + } + if( $self->in_element('description') ) + { + # description of the phylogeny + } + } } +sub elementAttribute +{ + my ( $self, $element, $data) = @_; + my $attr = $element->{'Attributes'}; + if( $element->{'Name'} eq 'clade' ) + { + if (exists $attr->{'{}distance'}) + { + $data->{'-branch_length'} = $attr->{'{}distance'}->{'Value'}; + } + } + return $data; +} + 1; From heikki at dev.open-bio.org Tue Jun 3 09:38:24 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Tue, 3 Jun 2008 09:38:24 -0400 Subject: [Bioperl-guts-l] [14690] bioperl-live/trunk/Bio/DB/SeqFeature/Store/FeatureFileLoader.pm: fixed POD errors Message-ID: <200806031338.m53DcOvI031424@dev.open-bio.org> Revision: 14690 Author: heikki Date: 2008-06-03 09:38:23 -0400 (Tue, 03 Jun 2008) Log Message: ----------- fixed POD errors Modified Paths: -------------- bioperl-live/trunk/Bio/DB/SeqFeature/Store/FeatureFileLoader.pm Modified: bioperl-live/trunk/Bio/DB/SeqFeature/Store/FeatureFileLoader.pm =================================================================== --- bioperl-live/trunk/Bio/DB/SeqFeature/Store/FeatureFileLoader.pm 2008-06-02 20:06:08 UTC (rev 14689) +++ bioperl-live/trunk/Bio/DB/SeqFeature/Store/FeatureFileLoader.pm 2008-06-03 13:38:23 UTC (rev 14690) @@ -228,7 +228,7 @@ # sub seq_chunk_size {} inherited # sub verbose {} inherited -=item default_seqfeature_class +=head2 default_seqfeature_class $class = $loader->default_seqfeature_class @@ -242,7 +242,7 @@ } -=item load_fh +=head2 load_fh $count = $loader->load_fh($filehandle) @@ -257,7 +257,7 @@ # sub load_fh { } inherited -=item start_load, finish_load +=head2 start_load, finish_load These methods are called at the start and end of a filehandle load. @@ -276,7 +276,7 @@ $self->SUPER::finish_load; } -=item load_line +=head2 load_line $loader->load_line($data); @@ -335,7 +335,7 @@ } -=item handle_meta +=head2 handle_meta $loader->handle_meta($meta_directive) @@ -347,7 +347,7 @@ # sub handle_meta { } inherited -=item handle_feature +=head2 handle_feature $loader->handle_feature($gff3_line) @@ -531,7 +531,7 @@ return $self->sfclass->new(@args); } -=item store_current_feature +=head2 store_current_feature $loader->store_current_feature() @@ -570,7 +570,7 @@ $self->store_current_feature(); } -=item build_object_tree +=head2 build_object_tree $loader->build_object_tree() @@ -586,7 +586,7 @@ croak "We shouldn't be building an object tree in the FeatureFileLoader"; } -=item build_object_tree_in_tables +=head2 build_object_tree_in_tables $loader->build_object_tree_in_tables() @@ -600,7 +600,7 @@ croak "We shouldn't be building an object tree in the FeatureFileLoader"; } -=item build_object_tree_in_features +=head2 build_object_tree_in_features $loader->build_object_tree_in_features() @@ -614,7 +614,7 @@ croak "We shouldn't be building an object tree in the FeatureFileLoader"; } -=item attach_children +=head2 attach_children $loader->attach_children($store,$load_data,$load_id,$feature) @@ -629,7 +629,7 @@ FeatureFileLoader!"; } -=item parse_attributes +=head2 parse_attributes @attributes = $loader->parse_attributes($attribute_line) @@ -656,7 +656,7 @@ return \%attributes; } -=item start_or_finish_sequence +=head2 start_or_finish_sequence $loader->start_or_finish_sequence('Chr9') @@ -669,7 +669,6 @@ __END__ -=back =head1 BUGS From heikki at dev.open-bio.org Tue Jun 3 09:39:59 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Tue, 3 Jun 2008 09:39:59 -0400 Subject: [Bioperl-guts-l] [14691] bioperl-live/trunk/t/largepseq.t: fix number of tests Message-ID: <200806031339.m53DdxFg031450@dev.open-bio.org> Revision: 14691 Author: heikki Date: 2008-06-03 09:39:58 -0400 (Tue, 03 Jun 2008) Log Message: ----------- fix number of tests Modified Paths: -------------- bioperl-live/trunk/t/largepseq.t Modified: bioperl-live/trunk/t/largepseq.t =================================================================== --- bioperl-live/trunk/t/largepseq.t 2008-06-03 13:38:23 UTC (rev 14690) +++ bioperl-live/trunk/t/largepseq.t 2008-06-03 13:39:58 UTC (rev 14691) @@ -7,7 +7,7 @@ use lib 't/lib'; use BioperlTest; - test_begin(-tests => 29); + test_begin(-tests => 30); use_ok('Bio::Seq::LargePrimarySeq'); use_ok('Bio::Seq::LargeSeq'); From heikki at dev.open-bio.org Tue Jun 3 09:54:01 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Tue, 3 Jun 2008 09:54:01 -0400 Subject: [Bioperl-guts-l] [14692] bioperl-live/trunk/t/DBCUTG.t: correct number of tests Message-ID: <200806031354.m53Ds1EJ031479@dev.open-bio.org> Revision: 14692 Author: heikki Date: 2008-06-03 09:54:00 -0400 (Tue, 03 Jun 2008) Log Message: ----------- correct number of tests Modified Paths: -------------- bioperl-live/trunk/t/DBCUTG.t Modified: bioperl-live/trunk/t/DBCUTG.t =================================================================== --- bioperl-live/trunk/t/DBCUTG.t 2008-06-03 13:39:58 UTC (rev 14691) +++ bioperl-live/trunk/t/DBCUTG.t 2008-06-03 13:54:00 UTC (rev 14692) @@ -51,7 +51,7 @@ # requiring Internet access, set env BIOPERLDEBUG to 1 to run SKIP: { - test_skip(-tests => 10, -requires_networking => 1); + test_skip(-tests => 14, -requires_networking => 1); ok my $tool = Bio::WebAgent->new(-verbose => $verbose); ok $tool->sleep; is $tool->delay(1), 1; From heikki at dev.open-bio.org Tue Jun 3 10:22:56 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Tue, 3 Jun 2008 10:22:56 -0400 Subject: [Bioperl-guts-l] [14693] bioperl-live/trunk/t/game.t: skip tests when XML:: Writer is not installed Message-ID: <200806031422.m53EMuC9031542@dev.open-bio.org> Revision: 14693 Author: heikki Date: 2008-06-03 10:22:56 -0400 (Tue, 03 Jun 2008) Log Message: ----------- skip tests when XML::Writer is not installed Modified Paths: -------------- bioperl-live/trunk/t/game.t Modified: bioperl-live/trunk/t/game.t =================================================================== --- bioperl-live/trunk/t/game.t 2008-06-03 13:54:00 UTC (rev 14692) +++ bioperl-live/trunk/t/game.t 2008-06-03 14:22:56 UTC (rev 14693) @@ -8,8 +8,7 @@ use BioperlTest; test_begin(-tests => 24, - -requires_module => 'XML::Parser::PerlSAX'); - + -requires_modules => [qw(XML::Parser::PerlSAX XML::Writer)]); use_ok('Bio::SeqIO'); } From heikki at dev.open-bio.org Tue Jun 3 10:45:41 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Tue, 3 Jun 2008 10:45:41 -0400 Subject: [Bioperl-guts-l] [14694] bioperl-live/trunk/t/RestrictionIO.t: skip tests that need networking using the same logic that all other modules use . Message-ID: <200806031445.m53EjfM6031608@dev.open-bio.org> Revision: 14694 Author: heikki Date: 2008-06-03 10:45:41 -0400 (Tue, 03 Jun 2008) Log Message: ----------- skip tests that need networking using the same logic that all other modules use. fix number of enzyme prototypes returned Modified Paths: -------------- bioperl-live/trunk/t/RestrictionIO.t Modified: bioperl-live/trunk/t/RestrictionIO.t =================================================================== --- bioperl-live/trunk/t/RestrictionIO.t 2008-06-03 14:22:56 UTC (rev 14693) +++ bioperl-live/trunk/t/RestrictionIO.t 2008-06-03 14:45:41 UTC (rev 14694) @@ -59,12 +59,13 @@ ok $out = Bio::Restriction::IO->new(-format=>'base'); SKIP: { - test_skip(-tests => 2, -requires_module => 'LWP::UserAgent'); + test_skip(-tests => 3, -requires_networking => 1); + #test_skip(-tests => 2, -requires_module => 'LWP::UserAgent'); ok $in = Bio::Restriction::IO->new(-format=>'prototype', -current => 1); ok my $coll = $in->read; - is $coll->each_enzyme, 306; + is $coll->each_enzyme, 307; } From heikki at dev.open-bio.org Tue Jun 3 15:59:00 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Tue, 3 Jun 2008 15:59:00 -0400 Subject: [Bioperl-guts-l] [14695] bioperl-live/trunk/t/EUtilities.t: use uniform notice string when skipping network tests Message-ID: <200806031959.m53Jx0tg031891@dev.open-bio.org> Revision: 14695 Author: heikki Date: 2008-06-03 15:59:00 -0400 (Tue, 03 Jun 2008) Log Message: ----------- use uniform notice string when skipping network tests Modified Paths: -------------- bioperl-live/trunk/t/EUtilities.t Modified: bioperl-live/trunk/t/EUtilities.t =================================================================== --- bioperl-live/trunk/t/EUtilities.t 2008-06-03 14:45:41 UTC (rev 14694) +++ bioperl-live/trunk/t/EUtilities.t 2008-06-03 19:59:00 UTC (rev 14695) @@ -70,7 +70,7 @@ }; if (!$DEBUG) { - plan skip_all => 'Must set BIOPERLDEBUG=1 for network tests'; + plan skip_all => 'Network tests have not been requested'; } elsif ($@) { plan skip_all => 'Requires LWP::UserAgent and XML::Simple; skipping...'; } else { @@ -862,4 +862,4 @@ like($response->content, qr(), 'EGQuery response'); } -1; \ No newline at end of file +1; From heikki at dev.open-bio.org Wed Jun 4 10:21:34 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Wed, 4 Jun 2008 10:21:34 -0400 Subject: [Bioperl-guts-l] [14696] bioperl-live/trunk/maintenance/pod.pl: point searches to bioperl-run assuming that it is at the same directory as bioperl-live Message-ID: <200806041421.m54ELYFS001436@dev.open-bio.org> Revision: 14696 Author: heikki Date: 2008-06-04 10:21:33 -0400 (Wed, 04 Jun 2008) Log Message: ----------- point searches to bioperl-run assuming that it is at the same directory as bioperl-live Modified Paths: -------------- bioperl-live/trunk/maintenance/pod.pl Modified: bioperl-live/trunk/maintenance/pod.pl =================================================================== --- bioperl-live/trunk/maintenance/pod.pl 2008-06-03 19:59:00 UTC (rev 14695) +++ bioperl-live/trunk/maintenance/pod.pl 2008-06-04 14:21:33 UTC (rev 14696) @@ -53,7 +53,7 @@ # ## Directories to check # -my @dirs = qw( ../Bio/ ../../run/Bio ../scripts ../../run/scripts . ); +my @dirs = qw( ../Bio/ ../../bioperl-run/Bio ../scripts ../../bioperl-run/scripts . ); # command line options my ($verbose, $blankline, $dir, $help) = (0, undef, undef, undef); From heikki at dev.open-bio.org Wed Jun 4 10:22:23 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Wed, 4 Jun 2008 10:22:23 -0400 Subject: [Bioperl-guts-l] [14697] bioperl-live/trunk/Bio: fix POD errors Message-ID: <200806041422.m54EMNg8001461@dev.open-bio.org> Revision: 14697 Author: heikki Date: 2008-06-04 10:22:22 -0400 (Wed, 04 Jun 2008) Log Message: ----------- fix POD errors Modified Paths: -------------- bioperl-live/trunk/Bio/ParameterBaseI.pm bioperl-live/trunk/Bio/SearchIO/Writer/HTMLResultWriter.pm bioperl-live/trunk/Bio/SeqFeature/Annotated.pm bioperl-live/trunk/Bio/SeqIO/Handler/GenericRichSeqHandler.pm Modified: bioperl-live/trunk/Bio/ParameterBaseI.pm =================================================================== --- bioperl-live/trunk/Bio/ParameterBaseI.pm 2008-06-04 14:21:33 UTC (rev 14696) +++ bioperl-live/trunk/Bio/ParameterBaseI.pm 2008-06-04 14:22:22 UTC (rev 14697) @@ -160,7 +160,7 @@ use base qw(Bio::Root::RootI); -=head2 +=head2 set_parameters Title : set_parameters Usage : $pobj->set_parameters(%params); @@ -174,7 +174,7 @@ shift->throw_not_implemented; } -=head2 +=head2 reset_parameters Title : reset_parameters Usage : resets values @@ -188,7 +188,7 @@ shift->throw_not_implemented; } -=head2 +=head2 parameters_changed Title : parameters_changed Usage : if ($pobj->parameters_changed) {...} @@ -202,7 +202,7 @@ shift->throw_not_implemented; } -=head2 +=head2 available_parameters Title : available_parameters Usage : @params = $pobj->available_parameters() @@ -217,7 +217,7 @@ shift->throw_not_implemented; } -=head2 +=head2 get_parameters Title : get_parameters Usage : %params = $pobj->get_parameters; Modified: bioperl-live/trunk/Bio/SearchIO/Writer/HTMLResultWriter.pm =================================================================== --- bioperl-live/trunk/Bio/SearchIO/Writer/HTMLResultWriter.pm 2008-06-04 14:21:33 UTC (rev 14696) +++ bioperl-live/trunk/Bio/SearchIO/Writer/HTMLResultWriter.pm 2008-06-04 14:22:22 UTC (rev 14697) @@ -52,7 +52,7 @@ =head1 DESCRIPTION This object implements the SearchWriterI interface which will produce -a set of HTML for a specific L. +a set of HTML for a specific L interface. See L for more info on the filter method. Modified: bioperl-live/trunk/Bio/SeqFeature/Annotated.pm =================================================================== --- bioperl-live/trunk/Bio/SeqFeature/Annotated.pm 2008-06-04 14:21:33 UTC (rev 14696) +++ bioperl-live/trunk/Bio/SeqFeature/Annotated.pm 2008-06-04 14:22:22 UTC (rev 14697) @@ -132,7 +132,7 @@ #location #primary_id -=head1 +=head1 PREAMBLE Okay, where to start... Modified: bioperl-live/trunk/Bio/SeqIO/Handler/GenericRichSeqHandler.pm =================================================================== --- bioperl-live/trunk/Bio/SeqIO/Handler/GenericRichSeqHandler.pm 2008-06-04 14:21:33 UTC (rev 14696) +++ bioperl-live/trunk/Bio/SeqIO/Handler/GenericRichSeqHandler.pm 2008-06-04 14:22:22 UTC (rev 14697) @@ -223,7 +223,7 @@ 'rc' => '' # rc = release candidate; file has no sequences ); -=head2 +=head2 new Title : new Usage : @@ -386,7 +386,7 @@ =head1 Methods unique to this implementation -=head2 +=head2 seqbuilder Title : seqbuilder Usage : @@ -404,7 +404,7 @@ return $self->{'_seqbuilder'}; } -=head2 +=head2 build_sequence Title : build_sequence Usage : @@ -429,7 +429,7 @@ return 0; } -=head2 +=head2 location_factory Title : location_factory Usage : @@ -454,7 +454,7 @@ return $self->{'_locfactory'}; } -=head2 +=head2 annotation_collection Title : annotation_collection Usage : From lstein at dev.open-bio.org Thu Jun 5 12:42:50 2008 From: lstein at dev.open-bio.org (Lincoln Stein) Date: Thu, 5 Jun 2008 12:42:50 -0400 Subject: [Bioperl-guts-l] [14698] bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm: fixed scale on xyplot so that scale values < 0 are rendered correctly Message-ID: <200806051642.m55Ggo7u005568@dev.open-bio.org> Revision: 14698 Author: lstein Date: 2008-06-05 12:42:49 -0400 (Thu, 05 Jun 2008) Log Message: ----------- fixed scale on xyplot so that scale values < 0 are rendered correctly Modified Paths: -------------- bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm Modified: bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm =================================================================== --- bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm 2008-06-04 14:22:22 UTC (rev 14697) +++ bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm 2008-06-05 16:42:49 UTC (rev 14698) @@ -347,12 +347,12 @@ my $fg = $self->scalecolor; my $font = $self->font('gdTinyFont'); - $gd->line($x1,$y1,$x1,$y_origin,$fg) if $side eq 'left' || $side eq 'both'; - $gd->line($x2,$y1,$x2,$y_origin,$fg) if $side eq 'right' || $side eq 'both'; + $gd->line($x1,$y1,$x1,$y2,$fg) if $side eq 'left' || $side eq 'both'; + $gd->line($x2,$y1,$x2,$y2,$fg) if $side eq 'right' || $side eq 'both'; $gd->line($x1,$y_origin,$x2,$y_origin,$fg); - my @points = ([$y1,$max],[($y1+$y2)/2,($min+$max)/2],[$y_origin,$min]); + my @points = ([$y1,$max],[($y1+$y2)/2,($min+$max)/2],[$y2,$min]); push @points,[$y_origin,0] if ($min < 0 && $max > 0); my $last_font_pos = -99999999999; From lstein at dev.open-bio.org Fri Jun 6 11:37:54 2008 From: lstein at dev.open-bio.org (Lincoln Stein) Date: Fri, 6 Jun 2008 11:37:54 -0400 Subject: [Bioperl-guts-l] [14699] bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm: fixed the positioning of the '0' coordinate on the scale so that it doesn' t clash with the midpoint coordinate Message-ID: <200806061537.m56Fbs1f008565@dev.open-bio.org> Revision: 14699 Author: lstein Date: 2008-06-06 11:37:53 -0400 (Fri, 06 Jun 2008) Log Message: ----------- fixed the positioning of the '0' coordinate on the scale so that it doesn't clash with the midpoint coordinate Modified Paths: -------------- bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm Modified: bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm =================================================================== --- bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm 2008-06-05 16:42:49 UTC (rev 14698) +++ bioperl-live/trunk/Bio/Graphics/Glyph/xyplot.pm 2008-06-06 15:37:53 UTC (rev 14699) @@ -209,8 +209,8 @@ $gd->line($x2,$part->{_y_position},$x2,$next->{_y_position},$fgcolor); } else { $gd->line($x2,$part->{_y_position},$x2,$bottom,$fgcolor); # to bottom - $gd->line($x2,$bottom,$x3,$bottom,$fgcolor); # to right - $gd->line($x3,$bottom,$x3,$next->{_y_position},$fgcolor); # up + $gd->line($x2,$bottom,$x3,$bottom,$fgcolor); # to right + $gd->line($x3,$bottom,$x3,$next->{_y_position},$fgcolor); # up } } @@ -229,16 +229,15 @@ my ($gd,$left,$top,$y_origin) = @_; my @parts = $self->parts; - my $fgcolor = $self->fgcolor; - my $bgcolor = $self->bgcolor; my $lw = $self->linewidth; - my $negative = $self->color('neg_color') || $bgcolor; + my $positive = $self->color('pos_color') || $self->bgcolor; + my $negative = $self->color('neg_color') || $positive; my $height = $self->height; my $partcolor = $self->code_option('part_color'); my $factory = $self->factory; - # draw each of the component lines of the histogram surface + # draw each of the boxes as a rectangle for (my $i = 0; $i < @parts; $i++) { my $part = $parts[$i]; @@ -249,19 +248,19 @@ # special check here for the part_color being defined so as not to introduce lots of # checking overhead when it isn't if ($partcolor) { - $color = $factory->translate_color($factory->option($part,'part_color',0,0)); - $negcolor = $color; + $color = $factory->translate_color($factory->option($part,'part_color',0,0)); + $negcolor = $color; } else { - $color = $bgcolor; - $negcolor = $negative; + $color = $positive; + $negcolor = $negative; } my ($x1,$y1,$x2,$y2) = $part->calculate_boundaries($left,$top); next unless defined $part->{_y_position}; if ($part->{_y_position} < $y_origin) { - $self->filled_box($gd,$x1,$part->{_y_position},$x2,$y_origin,$color,$fgcolor,$lw); + $self->filled_box($gd,$x1,$part->{_y_position},$x2,$y_origin,$color,$color,$lw); } else { - $self->filled_box($gd,$x1,$y_origin,$x2,$part->{_y_position},$negcolor,$fgcolor,$lw); + $self->filled_box($gd,$x1,$y_origin,$x2,$part->{_y_position},$negcolor,$negcolor,$lw); } } @@ -341,6 +340,7 @@ # this is wrong # $y2 -= $self->pad_bottom - 1; + my $crosses_origin = $min < 0 && $max > 0; my $side = $self->_determine_side(); @@ -352,12 +352,12 @@ $gd->line($x1,$y_origin,$x2,$y_origin,$fg); - my @points = ([$y1,$max],[($y1+$y2)/2,($min+$max)/2],[$y2,$min]); - push @points,[$y_origin,0] if ($min < 0 && $max > 0); + my @points = ([$y1,$max],[$y2,$min]); + push @points,$crosses_origin ? [$y_origin,0] : [($y1+$y2)/2,($min+$max)/2]; my $last_font_pos = -99999999999; - for (@points) { + for (sort {$a->[0]<=>$b->[0]} @points) { $gd->line($x1-3,$_->[0],$x1,$_->[0],$fg) if $side eq 'left' || $side eq 'both'; $gd->line($x2,$_->[0],$x2+3,$_->[0],$fg) if $side eq 'right' || $side eq 'both'; @@ -594,6 +594,9 @@ -graph_height Specify height of the graph Same as the "height" option. + -pos_color For boxes only, bgcolor for Same as bgcolor + points with positive scores + -neg_color For boxes only, bgcolor for Same as bgcolor points with negative scores From miraceti at dev.open-bio.org Fri Jun 6 18:00:03 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Fri, 6 Jun 2008 18:00:03 -0400 Subject: [Bioperl-guts-l] [14700] bioperl-live/trunk/Bio/TreeIO/phyloxml.pm: Change phyloxml to using libxml instead of SAX Message-ID: <200806062200.m56M03tX008930@dev.open-bio.org> Revision: 14700 Author: miraceti Date: 2008-06-06 18:00:03 -0400 (Fri, 06 Jun 2008) Log Message: ----------- Change phyloxml to using libxml instead of SAX Modified Paths: -------------- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm =================================================================== --- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-06-06 15:37:53 UTC (rev 14699) +++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-06-06 22:00:03 UTC (rev 14700) @@ -68,22 +68,48 @@ # Object preamble - inherits from Bio::Root::Root use Bio::Tree::NodePhyloXML; -use Bio::Event::EventGeneratorI; -use XML::SAX; -use Bio::TreeIO::PhyloXMLEventBuilder; - - +use XML::LibXML; +use XML::LibXML::Reader; use base qw(Bio::TreeIO); -sub _initialize { +sub _initialize +{ my($self, %args) = @_; + $args{-treetype} ||= 'Bio::Tree::Tree'; $args{-nodetype} ||= 'Bio::Tree::NodePhyloXML'; $self->SUPER::_initialize(%args); $self->debug("Creating obj phyloxml\n"); - $self->attach_EventHandler(Bio::TreeIO::PhyloXMLEventBuilder->new(-verbose => $self->verbose(), %args)); - $self->{'_parser'} = XML::SAX::ParserFactory->parser('Handler' => $self->{'_handler'}); + # phyloxml TreeIO does not use SAX, + # therefore no need to attach EventHandler + # instead we will define a reader that is a pull-parser of libXML + if ($self->{'_file'}) { + $self->{'_reader'} = XML::LibXML::Reader->new( + location => $self->{'_file'}, + ); + } + $self->debug("libxml version: ", XML::LibXML::LIBXML_VERSION(), "\n"); + $self->treetype($args{-treetype}); + $self->nodetype($args{-nodetype}); + $self->{'_treelevel'} = 0; + _init_func(); } +sub _init_func +{ + my ($self) = @_; + my %start_elements = ( + 'phylogeny' => \&start_phylogeny, + 'clade' => \&start_clade, + ); + $self->{'_start_element'} = \%start_elements; + my %end_elements = ( + 'phylogeny' => \&end_phylogeny, + 'clade' => \&end_clade, + ); + $self->{'_end_element'} = \%end_elements; +} + + =head2 next_tree Title : next_tree @@ -98,17 +124,79 @@ sub next_tree { my ($self) = @_; - local $/ = ";\n"; - return unless $_ = $self->_readline; + my $reader = $self->{'_reader'}; + my $tree; + while ($reader->read) + { + if ($reader->nodeType == XML_READER_TYPE_END_ELEMENT) + { + if ($reader->name eq 'phylogeny') + { + if($tree = $self->end_phylogeny()) { + last; + } + } + } + processNode($self); + } + return $tree; +} - $self->debug("entry is $_\n"); - $self->{'_parser'}->parse_string($_); +sub processNode +{ + my ($self) = @_; + my $reader = $self->{'_reader'}; + #$self->debug( $reader->depth, + # $reader->nodeType, + # $reader->name, + # $reader->isEmptyElement, + # $reader->value); + if ($reader->nodeType == XML_READER_TYPE_ELEMENT) + { + $self->{'_lastitem'}->{$reader->name}++; + push @{$self->{'_lastitem'}->{'current'}}, $reader->name; + $self->debug("starting element: ",$reader->name, "\n"); + if ($reader->name eq 'phylogeny') { + $self->start_phylogeny(); + } + elsif ($reader->name eq 'clade') { + $self->start_clade(); + } +# if (exists $self->{'_start_element'}->{$reader->name}) { +# $self->{'_start_element'}->{$reader->name}->(); +# } - my $chars = ''; - $self->_eventHandler->start_document; - my $tree = $self->_eventHandler->end_document($chars); - return $tree; +# several ways of reading attributes: +# read all attributes: +# if ($reader-> moveToFirstAttribute) { +# do {{ +# print "Attribute ",$reader-> name(), " => ", $reader->value,"\n"; +# }} while ($reader-> moveToNextAttribute); +# $reader-> moveToElement; +# } +# back at the element +# ... + +# read a specific attribute: +#print "----\n"; +#print "Attribute b: ",$reader-> getAttribute('b'),"\n"; + } + if ($reader->nodeType == XML_READER_TYPE_END_ELEMENT) + { + $self->debug("ending element: ",$reader->name, "\n"); + if ($reader->name eq 'phylogeny') { + $self->end_phylogeny(); + } + elsif ($reader->name eq 'clade') { + $self->end_clade(); + } + #if (exists $self->{'_end_element'}->{$reader->name}) { + # $self->{'_end_element'}->{$reader->name}->(); + #} + $self->{'_lastitem'}->{ $reader->name }--; + pop @{$self->{'_lastitem'}->{'current'}}; + } } =head2 write_tree @@ -127,5 +215,177 @@ sub _write_tree_Helper { } +=head2 treetype + Title : treetype + Usage : $obj->treetype($newval) + Function: + Returns : value of treetype + Args : newvalue (optional) + + +=cut + +sub treetype{ + my ($self,$value) = @_; + if( defined $value) { + $self->{'treetype'} = $value; + } + return $self->{'treetype'}; +} + +=head2 nodetype + + Title : nodetype + Usage : $obj->nodetype($newval) + Function: + Returns : value of nodetype + Args : newvalue (optional) + + +=cut + +sub nodetype{ + my ($self,$value) = @_; + if( defined $value) { + $self->{'nodetype'} = $value; + } + return $self->{'nodetype'}; +} + +=head2 start_phylogeny + + Title : start_phylogeny + Usage : $handler->start_phylogeny + Function: Begins a Tree event cycle + Returns : none + Args : none + +=cut + +sub start_phylogeny +{ + my ($self) = @_; + $self->{'_lastitem'} = {}; + $self->{'_currentitems'} = []; + $self->{'_currentnodes'} = []; + $self->debug("Starting phylogeny\n"); + $self->{'_treelevel'}++; + return; +} + +sub end_phylogeny +{ + my ($self) = @_; + $self->debug("Ending phylogeny: nodes in stack is", scalar @{$self->{'_currentnodes'}}, "\n"); + $self->{'_treelevel'}--; + + my $root = $self->nodetype->new( +# -id => $label, + -verbose => $self->verbose); +# aggregate the nodes into trees basically ad-hoc. + while ( @{$self->{'_currentnodes'}} ) { + my ($node) = ( shift @{$self->{'_currentnodes'}}); + $root->add_Descendent($node); + } + $self->debug("Root node is " . $root->to_string()."\n"); + if( $self->verbose > 0 ) { + foreach my $node ( $root->get_Descendents ) { + $self->debug("node is ". $node->to_string(). "\n"); + } + } + + my $tree = $self->treetype->new( + -verbose => $self->verbose, + -root => $root); + return $tree; +} + +sub start_clade +{ + my ($self) = @_; + my $reader = $self->{'_reader'}; + my %data = (); + $self->debug("starting clade: ", $reader->name, "\n"); + #take care of attribute + push @{$self->{'_currentitems'}}, \%data; +} + +sub end_clade +{ + my ($self) = @_; + my $reader = $self->{'_reader'}; + $self->debug("ending clade: ",$reader->name,"\n"); + + my $curcount = scalar @{$self->{'_currentnodes'}}; + my $level = $self->{'_treelevel'}; + my $levelct = $self->{'_nodect'}->[$self->{'_treelevel'}+1] || 0; + + my $tnode; + my $node = pop @{$self->{'_currentitems'}}; + $tnode = $self->nodetype->new( -verbose => $self->verbose, + %{$node}); + $self->debug( "new node will be ".$tnode->to_string."\n"); + if ( !$node->{'-leaf'} && $levelct > 0) { + $self->debug(join(',', map { $_->to_string } + @{$self->{'_currentnodes'}}). "\n"); + if( $levelct > $curcount) + { + $self->throw("something wrong with event construction treelevel ". + "$level is recorded as having $levelct nodes ". + "but current nodes at this level is $curcount\n"); + } + for ( splice( @{$self->{'_currentnodes'}}, - $levelct)) { + $self->debug("adding desc: " . $_->to_string . "\n"); + $tnode->add_Descendent($_); + } + $self->{'_nodect'}->[$self->{'_treelevel'}+1] = 0; + } + push @{$self->{'_currentnodes'}}, $tnode; + $self->debug("treelevel: ", $self->{'_treelevel'}, "\n"); + $self->debug("nodect: ", $self->{'_nodect'}, "\n"); + $self->{'_nodect'}->[$self->{'_treelevel'}]++; + $self->debug ("added node: nodes in stack is $curcount, treelevel: $level, nodect: $levelct\n"); + +} + +=head2 in_element + + Title : in_element + Usage : + Function: + Example : + Returns : + Args : + + +=cut + +sub in_element{ + my ($self,$e) = @_; + + return 0 if ! defined $self->{'_lastitem'} || + ! defined $self->{'_lastitem'}->{'current'}->[-1]; + return ($e eq $self->{'_lastitem'}->{'current'}->[-1]); + +} + +=head2 within_element + + Title : within_element + Usage : + Function: + Example : + Returns : + Args : + + +=cut + +sub within_element{ + my ($self,$e) = @_; + return $self->{'_lastitem'}->{$e}; +} + 1; + From miraceti at dev.open-bio.org Fri Jun 6 18:02:12 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Fri, 6 Jun 2008 18:02:12 -0400 Subject: [Bioperl-guts-l] [14701] bioperl-live/trunk/t: Change phyloxml to using libxml instead of SAX Message-ID: <200806062202.m56M2Ca0008965@dev.open-bio.org> Revision: 14701 Author: miraceti Date: 2008-06-06 18:02:11 -0400 (Fri, 06 Jun 2008) Log Message: ----------- Change phyloxml to using libxml instead of SAX Modified Paths: -------------- bioperl-live/trunk/t/phyloxml.t Added Paths: ----------- bioperl-live/trunk/t/data/phyloxml_examples.xml Added: bioperl-live/trunk/t/data/phyloxml_examples.xml =================================================================== --- bioperl-live/trunk/t/data/phyloxml_examples.xml (rev 0) +++ bioperl-live/trunk/t/data/phyloxml_examples.xml 2008-06-06 22:02:11 UTC (rev 14701) @@ -0,0 +1,414 @@ + + + + example from Prof. Joe Felsenstein's book "Inferring Phylogenies" + phyloXML allows to use either a "branch_length" attribute or element to indicate branch lengths. + + + + A + + + B + + + + C + + + + + example from Prof. Joe Felsenstein's book "Inferring Phylogenies" + phyloXML allows to use either a "branch_length" attribute or element to indicate branch lengths. + + + 0.06 + + A + 0.102 + + + B + 0.23 + + + + C + 0.4 + + + + + same example, with support of type "bootstrap" + + + AB + 89 + + A + + + B + + + + C + + + + + same example, with species and sequence + + + AB + + A + + E. coli + + + + alcohol dehydrogenase + 0.99 + + + + + B + + B. subtilis + + + + alcohol dehydrogenase + 0.91 + + + + + + C + + C. elegans + + + + alcohol dehydrogenase + 0.67 + + + + + + + same example, with gene duplication information and sequence relationships + + + 1 + + + + 1 + + + + Bacillus subtilis + + + adhB + AAB80874 + alcohol dehydrogenase + + + + + Bacillus subtilis + + + gbsB + CAB15083 + alcohol dehydrogenase + + + + + + Caenorhabditis elegans + + + ADHX + Q17335 + alcohol dehydrogenase + + + + + + + + + + similar example, with more detailed sequence data + + + + + 6645 + OCTVU + Octopus vulgaris + + + ADHX + P81431 + Alcohol dehydrogenase class-3 + TDATGKPIKCMAAIAWEAKKPLSIEEVEVAPPKSGEVRIKILHSGVCHTD + + + + + + + 44689 + DICDI + Dictyostelium discoideum + + + RT4I1 + Q54II4 + Reticulon-4-interacting protein 1 homolog, mitochondrial precursor + MKGILLNGYGESLDLLEYKTDLPVPKPIKSQVLIKIHSTSINPLDNVMRK + + + + + + + + 1488 + CLOAB + Clostridium acetobutylicum + + + ADHB + Q04945 + NADH-dependent butanol dehydrogenase B + MVDFEYSIPTRIFFGKDKINVLGRELKKYGSKVLIVYGGGSIKRNGIYDK + + + + + + + + network, node B is connected to TWO nodes: AB and C + + + AB + + A + + + B + + + + C + + + + + + same example, using property elements to indicate a "depth" value for marine organisms + + + AB + + A + 1200 + + + B + 2300 + + + + C + 200 + + + + + same example, using property elements to indicate a "depth" value for marine organisms by using id refs in + order to have property elements outside of the tree topology + + + AB + + A + + + B + + + + C + + + 1200 @@ Diff output truncated at 10000 characters. @@ From miraceti at dev.open-bio.org Fri Jun 6 18:06:08 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Fri, 6 Jun 2008 18:06:08 -0400 Subject: [Bioperl-guts-l] [14702] bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm: Change phyloxml to using libxml instead of SAX Message-ID: <200806062206.m56M68ix009076@dev.open-bio.org> Revision: 14702 Author: miraceti Date: 2008-06-06 18:06:08 -0400 (Fri, 06 Jun 2008) Log Message: ----------- Change phyloxml to using libxml instead of SAX Removed Paths: ------------- bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm Deleted: bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm =================================================================== --- bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm 2008-06-06 22:02:11 UTC (rev 14701) +++ bioperl-live/trunk/Bio/TreeIO/PhyloXMLEventBuilder.pm 2008-06-06 22:06:08 UTC (rev 14702) @@ -1,377 +0,0 @@ -# $Id: PhyloXMLEventBuilder.pm 11480 2007-06-14 14:16:21Z sendu $ -# -# BioPerl module for Bio::TreeIO::PhyloXMLEventBuilder -# -# Cared for by Mira Han -# -# Copyright Mira Han -# -# You may distribute this module under the same terms as perl itself - -# POD documentation - main docs before the code - -=head1 NAME - -Bio::TreeIO::PhyloXMLEventBuilder - Build Bio::Tree::Tree's and - Bio::Tree::Node's from Events - -=head1 SYNOPSIS - -# internal use only - -=head1 DESCRIPTION - -This object will take events and build a Bio::Tree::TreeI compliant -object makde up of Bio::Tree::NodeI objects. - -=head1 FEEDBACK - -=head2 Mailing Lists - -User feedback is an integral part of the evolution of this and other -Bioperl modules. Send your comments and suggestions preferably to -the Bioperl mailing list. Your participation is much appreciated. - - bioperl-l at bioperl.org - General discussion - http://bioperl.org/wiki/Mailing_lists - About the mailing lists - -=head2 Reporting Bugs - -Report bugs to the Bioperl bug tracking system to help us keep track -of the bugs and their resolution. Bug reports can be submitted via the -web: - - http://bugzilla.open-bio.org/ - -=head1 AUTHOR - Mira Han - -Email mirhan at indiana.edu - -=head1 APPENDIX - -The rest of the documentation details each of the object methods. -Internal methods are usually preceded with a _ - -=cut - - -# Let the code begin... - - -package Bio::TreeIO::PhyloXMLEventBuilder; -use strict; - -use Bio::Tree::Tree; -use Bio::Tree::Node; - -use base qw(Bio::Root::Root Bio::Event::EventHandlerI Bio::TreeIO::TreeEventBuilder); - -=head2 new - - Title : new - Usage : my $obj = Bio::TreeIO::PhyloXMLEventBuilder->new(); - Function: Builds a new Bio::TreeIO::PhyloXMLEventBuilder object - Returns : Bio::TreeIO::PhyloXMLEventBuilder - Args : - - -=cut - -sub new { - my($class, at args) = @_; - - my $self = $class->SUPER::new(@args); - my ($treetype, $nodetype) = $self->_rearrange([qw(TREETYPE - NODETYPE)], @args); - $treetype ||= 'Bio::Tree::Tree'; - $nodetype ||= 'Bio::Tree::NodePhyloXML'; - - eval { - $self->_load_module($treetype); - $self->_load_module($nodetype); - }; - - if( $@ ) { - $self->throw("Could not load module $treetype or $nodetype. \n$@\n") - } - $self->treetype($treetype); - $self->nodetype($nodetype); - $self->{'_treelevel'} = 0; - $self->debug("Creating obj PhyloXMLEventBuilder\n"); - return $self; -} - -=head2 treetype - - Title : treetype - Usage : $obj->treetype($newval) - Function: - Returns : value of treetype - Args : newvalue (optional) - - -=cut - -sub treetype{ - my ($self,$value) = @_; - if( defined $value) { - $self->{'treetype'} = $value; - } - return $self->{'treetype'}; -} - -=head2 nodetype - - Title : nodetype - Usage : $obj->nodetype($newval) - Function: - Returns : value of nodetype - Args : newvalue (optional) - - -=cut - -sub nodetype{ - my ($self,$value) = @_; - if( defined $value) { - $self->{'nodetype'} = $value; - } - return $self->{'nodetype'}; -} - - -=head2 SAX methods - -=cut - -=head2 start_document - - Title : start_document - Usage : $handler->start_document - Function: Begins a Tree event cycle - Returns : none - Args : none - -=cut - -sub start_document { - my ($self) = @_; - $self->{'_lastitem'} = {}; - $self->{'_currentitems'} = []; - $self->{'_currentnodes'} = []; - $self->debug("Starting Document\n"); - return; -} - -=head2 end_document - - Title : end_document - Usage : my @trees = $parser->end_document - Function: Finishes a Phylogeny cycle - Returns : An array Bio::Tree::TreeI - Args : none - -=cut - -sub end_document { - my ($self,$label) = @_; - $self->debug("Ending Document\n"); - my $root = $self->nodetype->new( - -id => $label, - -verbose => $self->verbose); -# aggregate the nodes into trees basically ad-hoc. - while ( @{$self->{'_currentnodes'}} ) { - my ($node) = ( shift @{$self->{'_currentnodes'}}); - $root->add_Descendent($node); - } - - $self->debug("Root node is " . $root->to_string()."\n"); - if( $self->verbose > 0 ) { - foreach my $node ( $root->get_Descendents ) { - $self->debug("node is ". $node->to_string(). "\n"); - } - } - my $tree = $self->treetype->new(-verbose => $self->verbose, - -root => $root); - return $tree; -} - -=head2 start_element - - Title : start_element - Usage : - Function: - Example : - Returns : - Args : $element => hashref with key 'Name' - -=cut - -sub start_element -{ - my ($self,$element) =@_; - $self->{'_lastitem'}->{$element->{'Name'}}++; - - $self->debug("starting element: $element->{Name}\n"); - push @{$self->{'_lastitem'}->{'current'}},$element->{'Name'}; - - my %data; - - if( $element->{'Name'} eq 'clade' ) - { - elementAttribute($self, $element, \%data); - push @{$self->{'_currentitems'}}, \%data; - } - elsif ( $element->{'Name'} eq 'phylogeny' ) - { - $self->{'_treelevel'}++; - } -} - -=head2 end_element - - Title : end_element - Usage : - Function: - Returns : none - Args : $data => hashref with key 'Name' - -=cut - -sub end_element{ - my ($self,$data) = @_; - - $self->debug("end of element: $data->{Name}\n"); -# this is the stack where we push/pop items from it - my $curcount = scalar @{$self->{'_currentnodes'}}; - my $level = $self->{'_treelevel'}; - my $levelct = $self->{'_nodect'}->[$self->{'_treelevel'}+1] || 0; - - if( $data->{'Name'} eq 'clade' ) - { - my $tnode; - my $node = pop @{$self->{'_currentitems'}}; - $tnode = $self->nodetype->new( -verbose => $self->verbose, - %{$node}); - $self->debug( "new node will be ".$tnode->to_string."\n"); - if ( !$node->{'-leaf'} && $levelct > 0) { - $self->debug(join(',', map { $_->to_string } - @{$self->{'_currentnodes'}}). "\n"); - $self->throw("something wrong with event construction treelevel ". - "$level is recorded as having $levelct nodes ". - "but current nodes at this level is $curcount\n") - if( $levelct > $curcount); - for ( splice( @{$self->{'_currentnodes'}}, - $levelct)) { - $self->debug("adding desc: " . $_->to_string . "\n"); - $tnode->add_Descendent($_); - } - $self->{'_nodect'}->[$self->{'_treelevel'}+1] = 0; - } - push @{$self->{'_currentnodes'}}, $tnode; - $self->{'_nodect'}->[$self->{'_treelevel'}]++; - - $self->debug ("added node: nodes in stack is $curcount, treelevel: $level, nodect: $levelct\n"); - - } - elsif( $data->{'Name'} eq 'phylogeny' ) - { - $self->debug("end of tree: nodes in stack is $curcount\n"); - $self->{'_treelevel'}--; - } - - $self->{'_lastitem'}->{ $data->{'Name'} }--; - - pop @{$self->{'_lastitem'}->{'current'}}; -} - - -=head2 in_element - - Title : in_element - Usage : - Function: - Example : - Returns : - Args : - - -=cut - -sub in_element{ - my ($self,$e) = @_; - - return 0 if ! defined $self->{'_lastitem'} || - ! defined $self->{'_lastitem'}->{'current'}->[-1]; - return ($e eq $self->{'_lastitem'}->{'current'}->[-1]); - -} - -=head2 within_element - - Title : within_element - Usage : - Function: - Example : - Returns : - Args : - - -=cut - -sub within_element{ - my ($self,$e) = @_; - return $self->{'_lastitem'}->{$e}; -} - -=head2 characters - - Title : characters - Usage : $handler->characters($text); - Function: Processes characters - Returns : none - Args : text string - - -=cut - -sub characters{ - my ($self,$ch) = @_; - if ( $self->within_element('clade') ) - { - my $hash = pop @{$self->{'_currentitems'}}; - if( $self->in_element('name') ) - { - $hash->{'-id'} = $ch->{'Data'}; # change name to id since Node.pm uses id - } - push @{$self->{'_currentitems'}}, $hash; - } - elsif ( $self->within_element('phylogeny') ) - { - my $hash = pop @{$self->{'_currentitems'}}; - if( $self->in_element('name') ) - { - # name of the phylogeny - } - if( $self->in_element('description') ) - { - # description of the phylogeny - } - } -} - - -sub elementAttribute -{ - my ( $self, $element, $data) = @_; - my $attr = $element->{'Attributes'}; - if( $element->{'Name'} eq 'clade' ) - { - if (exists $attr->{'{}distance'}) - { - $data->{'-branch_length'} = $attr->{'{}distance'}->{'Value'}; - } - } - return $data; -} - -1; From miraceti at dev.open-bio.org Fri Jun 6 18:10:13 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Fri, 6 Jun 2008 18:10:13 -0400 Subject: [Bioperl-guts-l] [14703] bioperl-live/trunk/t: Change phyloxml to using libxml instead of SAX Message-ID: <200806062210.m56MADQ5009107@dev.open-bio.org> Revision: 14703 Author: miraceti Date: 2008-06-06 18:10:13 -0400 (Fri, 06 Jun 2008) Log Message: ----------- Change phyloxml to using libxml instead of SAX Modified Paths: -------------- bioperl-live/trunk/t/phyloxml.t Removed Paths: ------------- bioperl-live/trunk/t/data/phyloxml_small.xml Deleted: bioperl-live/trunk/t/data/phyloxml_small.xml =================================================================== --- bioperl-live/trunk/t/data/phyloxml_small.xml 2008-06-06 22:06:08 UTC (rev 14702) +++ bioperl-live/trunk/t/data/phyloxml_small.xml 2008-06-06 22:10:13 UTC (rev 14703) @@ -1,24 +0,0 @@ - - - - - example from Prof. Joe Felsenstein's book "Inferring Phylogenies" - phyloXML allows to use either a "distance" attribute or element to indicate branch lengths. - - - - A - - - B - - - - C - - - - - Modified: bioperl-live/trunk/t/phyloxml.t =================================================================== --- bioperl-live/trunk/t/phyloxml.t 2008-06-06 22:06:08 UTC (rev 14702) +++ bioperl-live/trunk/t/phyloxml.t 2008-06-06 22:10:13 UTC (rev 14703) @@ -14,7 +14,7 @@ plan skip_all => "Reader not supported for libxml2 <= 2.6.20"; exit; } else { - test_begin(-tests => 18); + test_begin(-tests => 16); } use_ok('Bio::TreeIO'); @@ -25,16 +25,9 @@ ok my $treeio = Bio::TreeIO->new( -verbose => $verbose, -format => 'phyloxml', - -file => test_input_file('phyloxml_small.xml')); - -my $tree = $treeio->next_tree; -isa_ok($tree, 'Bio::Tree::TreeI'); - -ok my $treeio = Bio::TreeIO->new( - -verbose => $verbose, - -format => 'phyloxml', -file => test_input_file('phyloxml_examples.xml')); +my $tree; while ( $tree = $treeio->next_tree ) { isa_ok($tree, 'Bio::Tree::TreeI'); } From miraceti at dev.open-bio.org Mon Jun 9 00:09:25 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Mon, 9 Jun 2008 00:09:25 -0400 Subject: [Bioperl-guts-l] [14704] bioperl-live/trunk/Bio/Tree: phyloxml: next_tree and basic parsing of Message-ID: <200806090409.m5949PKr019542@dev.open-bio.org> Revision: 14704 Author: miraceti Date: 2008-06-09 00:09:24 -0400 (Mon, 09 Jun 2008) Log Message: ----------- phyloxml: next_tree and basic parsing of Modified Paths: -------------- bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm bioperl-live/trunk/Bio/TreeIO/phyloxml.pm Modified: bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm =================================================================== --- bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm 2008-06-06 22:10:13 UTC (rev 14703) +++ bioperl-live/trunk/Bio/Tree/NodePhyloXML.pm 2008-06-09 04:09:24 UTC (rev 14704) @@ -96,10 +96,28 @@ sub new { my ($class, at args) = @_; +# foreach (@args) { +# print "args: $_\n"; +# } my $self = $class->SUPER::new(@args); $self->debug("new NodePhyloXML\n"); - my ($user_tag) = $self->_rearrange([qw(PhyloXML)], @args); - $self->_tag($user_tag); + #my @newargs = $self->_rearrange([qw( + # DESCENDENTS + # BRANCH_LENGTH + # ID + # BOOTSTRAP + # DESC + # DESCRIPTION + # )], + # @args); + #foreach (@newargs) { + # print "args: $_\n"; + #} + + #my ($user_tag) = $self->_rearrange([qw(PhyloXML)], @args); + #my ($user_tag) = $self->_rearrange(@args); + #print "user_tag: ", %{$user_tag}, "\n"; + #$self->_tag($user_tag); return $self; } Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm =================================================================== --- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-06-06 22:10:13 UTC (rev 14703) +++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-06-09 04:09:24 UTC (rev 14704) @@ -79,18 +79,21 @@ $args{-nodetype} ||= 'Bio::Tree::NodePhyloXML'; $self->SUPER::_initialize(%args); $self->debug("Creating obj phyloxml\n"); + # phyloxml TreeIO does not use SAX, # therefore no need to attach EventHandler # instead we will define a reader that is a pull-parser of libXML if ($self->{'_file'}) { $self->{'_reader'} = XML::LibXML::Reader->new( location => $self->{'_file'}, + no_blanks => 1 ); } + $self->debug("libxml version: ", XML::LibXML::LIBXML_VERSION(), "\n"); $self->treetype($args{-treetype}); $self->nodetype($args{-nodetype}); - $self->{'_treelevel'} = 0; + #$self->{'_treelevel'} = 0; _init_func(); } @@ -98,13 +101,13 @@ { my ($self) = @_; my %start_elements = ( - 'phylogeny' => \&start_phylogeny, - 'clade' => \&start_clade, + 'phylogeny' => \&element_phylogeny, + 'clade' => \&element_clade, ); $self->{'_start_element'} = \%start_elements; my %end_elements = ( - 'phylogeny' => \&end_phylogeny, - 'clade' => \&end_clade, + 'phylogeny' => \&end_element_phylogeny, + 'clade' => \&end_element_clade, ); $self->{'_end_element'} = \%end_elements; } @@ -132,9 +135,8 @@ { if ($reader->name eq 'phylogeny') { - if($tree = $self->end_phylogeny()) { - last; - } + $tree = $self->end_element_phylogeny(); + last; } } processNode($self); @@ -142,55 +144,77 @@ return $tree; } + +=head2 write_tree + + Title : write_tree + Usage : $treeio->write_tree($tree); + Function: Write a tree out to data stream in phyloxml format + Returns : none + Args : Bio::Tree::TreeI object + +=cut + +sub write_tree{ +} + +sub _write_tree_Helper { +} + + + +=head2 processNode + + Title : processNode + Usage : + Function: + Returns : none + Args : + +=cut sub processNode { my ($self) = @_; my $reader = $self->{'_reader'}; - #$self->debug( $reader->depth, - # $reader->nodeType, - # $reader->name, - # $reader->isEmptyElement, - # $reader->value); if ($reader->nodeType == XML_READER_TYPE_ELEMENT) { + $self->debug("starting element: ",$reader->name, "\n"); $self->{'_lastitem'}->{$reader->name}++; push @{$self->{'_lastitem'}->{'current'}}, $reader->name; - $self->debug("starting element: ",$reader->name, "\n"); if ($reader->name eq 'phylogeny') { - $self->start_phylogeny(); + $self->element_phylogeny(); } elsif ($reader->name eq 'clade') { - $self->start_clade(); + $self->element_clade(); } # if (exists $self->{'_start_element'}->{$reader->name}) { # $self->{'_start_element'}->{$reader->name}->(); # } - -# several ways of reading attributes: -# read all attributes: -# if ($reader-> moveToFirstAttribute) { -# do {{ -# print "Attribute ",$reader-> name(), " => ", $reader->value,"\n"; -# }} while ($reader-> moveToNextAttribute); -# $reader-> moveToElement; -# } -# back at the element -# ... - -# read a specific attribute: -#print "----\n"; -#print "Attribute b: ",$reader-> getAttribute('b'),"\n"; } - if ($reader->nodeType == XML_READER_TYPE_END_ELEMENT) + elsif ($reader->nodeType == XML_READER_TYPE_TEXT) { + #$self->debug( $reader->depth, + # $reader->nodeType, + # $reader->name, + # $reader->isEmptyElement, + # $reader->value); + $self->debug($reader->value, "\n"); + $self->{'_currenttext'} = $reader->value; + } + elsif ($reader->nodeType == XML_READER_TYPE_END_ELEMENT) + { $self->debug("ending element: ",$reader->name, "\n"); + if ($reader->name eq 'phylogeny') { - $self->end_phylogeny(); + $self->end_element_phylogeny(); } elsif ($reader->name eq 'clade') { - $self->end_clade(); + $self->end_element_clade(); } + elsif ($reader->name eq 'name') { + $self->end_element_name(); + } #if (exists $self->{'_end_element'}->{$reader->name}) { # $self->{'_end_element'}->{$reader->name}->(); #} @@ -199,91 +223,72 @@ } } -=head2 write_tree - Title : write_tree - Usage : $treeio->write_tree($tree); - Function: Write a tree out to data stream in phyloxml format - Returns : none - Args : Bio::Tree::TreeI object +=head2 processAttribute -=cut + Title : processAttribute + Usage : + Function: + Example : + Returns : + Args : -sub write_tree{ -} -sub _write_tree_Helper { -} +=cut -=head2 treetype +sub processAttribute +{ + my ($self, $data) = @_; + my $reader = $self->{'_reader'}; - Title : treetype - Usage : $obj->treetype($newval) - Function: - Returns : value of treetype - Args : newvalue (optional) + # several ways of reading attributes: + # read all attributes: + if ($reader-> moveToFirstAttribute) { + do { + $data->{$reader->name()} = $reader->value; + } while ($reader-> moveToNextAttribute); + $reader-> moveToElement; + } + # back at the element + # ... - -=cut - -sub treetype{ - my ($self,$value) = @_; - if( defined $value) { - $self->{'treetype'} = $value; - } - return $self->{'treetype'}; + # read a specific attribute: + #print "Attribute b: ",$reader-> getAttribute('b'),"\n"; } -=head2 nodetype - Title : nodetype - Usage : $obj->nodetype($newval) - Function: - Returns : value of nodetype - Args : newvalue (optional) +=head2 element_phylogeny - -=cut - -sub nodetype{ - my ($self,$value) = @_; - if( defined $value) { - $self->{'nodetype'} = $value; - } - return $self->{'nodetype'}; -} - -=head2 start_phylogeny - - Title : start_phylogeny - Usage : $handler->start_phylogeny + Title : element_phylogeny + Usage : $handler->element_phylogeny Function: Begins a Tree event cycle Returns : none Args : none =cut -sub start_phylogeny +sub element_phylogeny { - my ($self) = @_; - $self->{'_lastitem'} = {}; - $self->{'_currentitems'} = []; - $self->{'_currentnodes'} = []; - $self->debug("Starting phylogeny\n"); - $self->{'_treelevel'}++; - return; + my ($self) = @_; + $self->{'_lastitem'} = {}; + $self->{'_currentitems'} = []; + $self->{'_currentnodes'} = []; + $self->{'_currenttext'} = ''; + $self->{'_levelcnt'} = []; + + $self->debug("Starting phylogeny\n"); + $self->{'_treeattr'} = {}; + $self->processAttribute($self->{'_treeattr'}); + return; } -sub end_phylogeny +sub end_element_phylogeny { my ($self) = @_; $self->debug("Ending phylogeny: nodes in stack is", scalar @{$self->{'_currentnodes'}}, "\n"); - $self->{'_treelevel'}--; - my $root = $self->nodetype->new( -# -id => $label, - -verbose => $self->verbose); -# aggregate the nodes into trees basically ad-hoc. + my $root = $self->nodetype->new( -verbose => $self->verbose ); + # aggregate the nodes into trees basically ad-hoc. while ( @{$self->{'_currentnodes'}} ) { my ($node) = ( shift @{$self->{'_currentnodes'}}); $root->add_Descendent($node); @@ -297,58 +302,135 @@ my $tree = $self->treetype->new( -verbose => $self->verbose, - -root => $root); + -root => $root, + %{$self->{'_treeattr'}}); return $tree; } -sub start_clade + +=head2 element_clade + + Title : element_clade + Usage : $->element_clade + Function: Begins a clade cycle + Returns : none + Args : none + +=cut + +sub element_clade { my ($self) = @_; my $reader = $self->{'_reader'}; my %data = (); - $self->debug("starting clade: ", $reader->name, "\n"); #take care of attribute - push @{$self->{'_currentitems'}}, \%data; + $self->processAttribute(\%data); + my $tnode = $self->nodetype->new( -verbose => $self->verbose, %data); + push @{$self->{'_currentitems'}}, $tnode; } -sub end_clade +sub end_element_clade { my ($self) = @_; my $reader = $self->{'_reader'}; - $self->debug("ending clade: ",$reader->name,"\n"); my $curcount = scalar @{$self->{'_currentnodes'}}; - my $level = $self->{'_treelevel'}; - my $levelct = $self->{'_nodect'}->[$self->{'_treelevel'}+1] || 0; + my $level = $reader->depth() - 2; + my $childcnt = $self->{'_levelcnt'}->[$level+1] || 0; + $self->debug ("adding node: nodes in stack is $curcount, treelevel: $level, childcnt: $childcnt\n"); - my $tnode; - my $node = pop @{$self->{'_currentitems'}}; - $tnode = $self->nodetype->new( -verbose => $self->verbose, - %{$node}); + my $tnode = pop @{$self->{'_currentitems'}}; $self->debug( "new node will be ".$tnode->to_string."\n"); - if ( !$node->{'-leaf'} && $levelct > 0) { - $self->debug(join(',', map { $_->to_string } - @{$self->{'_currentnodes'}}). "\n"); - if( $levelct > $curcount) + if ( $childcnt > 0) { + $self->debug(join(',', map { $_->to_string } @{$self->{'_currentnodes'}}). "\n"); + if( $childcnt > $curcount) { $self->throw("something wrong with event construction treelevel ". @@ Diff output truncated at 10000 characters. @@ From miraceti at dev.open-bio.org Mon Jun 9 00:09:58 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Mon, 9 Jun 2008 00:09:58 -0400 Subject: [Bioperl-guts-l] [14705] bioperl-live/trunk/t/phyloxml.t: phyloxml: next_tree and basic parsing of Message-ID: <200806090409.m5949wVT019573@dev.open-bio.org> Revision: 14705 Author: miraceti Date: 2008-06-09 00:09:58 -0400 (Mon, 09 Jun 2008) Log Message: ----------- phyloxml: next_tree and basic parsing of Modified Paths: -------------- bioperl-live/trunk/t/phyloxml.t Modified: bioperl-live/trunk/t/phyloxml.t =================================================================== --- bioperl-live/trunk/t/phyloxml.t 2008-06-09 04:09:24 UTC (rev 14704) +++ bioperl-live/trunk/t/phyloxml.t 2008-06-09 04:09:58 UTC (rev 14705) @@ -30,6 +30,9 @@ my $tree; while ( $tree = $treeio->next_tree ) { isa_ok($tree, 'Bio::Tree::TreeI'); + + my $out = Bio::TreeIO->new(-format => 'newick'); + $out->write_tree($tree); } TODO: { From miraceti at dev.open-bio.org Mon Jun 9 13:58:43 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Mon, 9 Jun 2008 13:58:43 -0400 Subject: [Bioperl-guts-l] [14706] bioperl-live/trunk/t/phyloxml.t: requires_modules XML::LibXML Message-ID: <200806091758.m59Hwh3g021293@dev.open-bio.org> Revision: 14706 Author: miraceti Date: 2008-06-09 13:58:42 -0400 (Mon, 09 Jun 2008) Log Message: ----------- requires_modules XML::LibXML Modified Paths: -------------- bioperl-live/trunk/t/phyloxml.t Modified: bioperl-live/trunk/t/phyloxml.t =================================================================== --- bioperl-live/trunk/t/phyloxml.t 2008-06-09 04:09:58 UTC (rev 14705) +++ bioperl-live/trunk/t/phyloxml.t 2008-06-09 17:58:42 UTC (rev 14706) @@ -1,23 +1,24 @@ # -*-Perl-*- Test Harness script for Bioperl -# $Id: phyloxml.t 14580 2008-03-01 17:01:30Z cjfields $ use strict; +use warnings; BEGIN { - use lib 't/lib'; + use lib 't/lib'; use BioperlTest; - use XML::LibXML; + + test_begin(-tests => 17, + -requires_modules => [qw(XML::LibXML)], + ); if (1000*$] < 5008) { plan skip_all => "Reader interface only supported in Perl >= 5.8"; exit; } elsif (XML::LibXML::LIBXML_VERSION() <= 20620) { plan skip_all => "Reader not supported for libxml2 <= 2.6.20"; exit; - } else { - test_begin(-tests => 16); } - use_ok('Bio::TreeIO'); + use_ok('Bio::TreeIO::phyloxml'); } my $verbose = test_debug(); @@ -28,13 +29,100 @@ -file => test_input_file('phyloxml_examples.xml')); my $tree; -while ( $tree = $treeio->next_tree ) { - isa_ok($tree, 'Bio::Tree::TreeI'); - my $out = Bio::TreeIO->new(-format => 'newick'); - $out->write_tree($tree); -} +# tree1: clade and attribute +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); +# tree2: branch_length +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree3: bootstrap +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree4: species and sequence +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree5: homolog relationship and sequence relationship +# +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree6: detailed sequence data +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree7: network +# @id_source & @id_ref +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree8: property elements +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree9: property outside tree topology using id refs +# @id_source @id_ref +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree10: detailed taxonomy and distribution +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree11: phylogeographic information +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree12: date information +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + +# tree13: alignment outside +# +$tree = $treeio->next_tree; +isa_ok($tree, 'Bio::Tree::TreeI'); +my $out = Bio::TreeIO->new(-format => 'newick'); +$out->write_tree($tree); + + TODO: { local $TODO = 'write_tree not implemented yet'; my $FILE1 = test_output_file(); From miraceti at dev.open-bio.org Mon Jun 9 14:02:23 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Mon, 9 Jun 2008 14:02:23 -0400 Subject: [Bioperl-guts-l] [14707] bioperl-live/trunk/t/phyloxml.t: requires_modules XML::LibXML Message-ID: <200806091802.m59I2NGk021328@dev.open-bio.org> Revision: 14707 Author: miraceti Date: 2008-06-09 14:02:23 -0400 (Mon, 09 Jun 2008) Log Message: ----------- requires_modules XML::LibXML Modified Paths: -------------- bioperl-live/trunk/t/phyloxml.t Modified: bioperl-live/trunk/t/phyloxml.t =================================================================== --- bioperl-live/trunk/t/phyloxml.t 2008-06-09 17:58:42 UTC (rev 14706) +++ bioperl-live/trunk/t/phyloxml.t 2008-06-09 18:02:23 UTC (rev 14707) @@ -41,21 +41,21 @@ # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree3: bootstrap # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree4: species and sequence # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree5: homolog relationship and sequence relationship @@ -63,63 +63,63 @@ # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree6: detailed sequence data # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree7: network # @id_source & @id_ref $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree8: property elements # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree9: property outside tree topology using id refs # @id_source @id_ref $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree10: detailed taxonomy and distribution # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree11: phylogeographic information # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree12: date information # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); # tree13: alignment outside # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); +$out = Bio::TreeIO->new(-format => 'newick'); $out->write_tree($tree); From heikki at dev.open-bio.org Mon Jun 9 20:08:18 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Mon, 9 Jun 2008 20:08:18 -0400 Subject: [Bioperl-guts-l] [14708] bioperl-live/trunk: fixing POD whitespaceissues Message-ID: <200806100008.m5A08IeS021669@dev.open-bio.org> Revision: 14708 Author: heikki Date: 2008-06-09 20:08:17 -0400 (Mon, 09 Jun 2008) Log Message: ----------- fixing POD whitespaceissues Modified Paths: -------------- bioperl-live/trunk/Bio/AlignIO/stockholm.pm bioperl-live/trunk/Bio/Annotation/Collection.pm bioperl-live/trunk/Bio/Annotation/Comment.pm bioperl-live/trunk/Bio/Annotation/DBLink.pm bioperl-live/trunk/Bio/Annotation/OntologyTerm.pm bioperl-live/trunk/Bio/Annotation/Reference.pm bioperl-live/trunk/Bio/Annotation/SimpleValue.pm bioperl-live/trunk/Bio/Annotation/StructuredValue.pm bioperl-live/trunk/Bio/Annotation/TagTree.pm bioperl-live/trunk/Bio/Annotation/Target.pm bioperl-live/trunk/Bio/Annotation/Tree.pm bioperl-live/trunk/Bio/AnnotationI.pm bioperl-live/trunk/Bio/Assembly/Contig.pm bioperl-live/trunk/Bio/Assembly/IO/tigr.pm bioperl-live/trunk/Bio/Assembly/IO.pm bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm bioperl-live/trunk/Bio/Cluster/SequenceFamily.pm bioperl-live/trunk/Bio/DB/EUtilParameters.pm bioperl-live/trunk/Bio/DB/EUtilities.pm bioperl-live/trunk/Bio/DB/GenericWebAgent.pm bioperl-live/trunk/Bio/DB/NCBIHelper.pm bioperl-live/trunk/Bio/Graph/IO/psi_xml.pm bioperl-live/trunk/Bio/Graphics/DrawTransmembrane.pm bioperl-live/trunk/Bio/HandlerBaseI.pm bioperl-live/trunk/Bio/Index/Stockholm.pm bioperl-live/trunk/Bio/Location/Atomic.pm bioperl-live/trunk/Bio/Matrix/Mlagan.pm bioperl-live/trunk/Bio/Microarray/Tools/MitoChipV2Parser.pm bioperl-live/trunk/Bio/Microarray/Tools/ReseqChip.pm bioperl-live/trunk/Bio/Ontology/Term.pm bioperl-live/trunk/Bio/Ontology/TermI.pm bioperl-live/trunk/Bio/ParameterBaseI.pm bioperl-live/trunk/Bio/PopGen/Statistics.pm bioperl-live/trunk/Bio/Restriction/IO/base.pm bioperl-live/trunk/Bio/Root/Exception.pm bioperl-live/trunk/Bio/Root/Root.pm bioperl-live/trunk/Bio/Search/HSP/ModelHSP.pm bioperl-live/trunk/Bio/Search/Result/BlastResult.pm bioperl-live/trunk/Bio/Search/Result/GenericResult.pm bioperl-live/trunk/Bio/SearchIO/blastxml.pm bioperl-live/trunk/Bio/SearchIO/erpin.pm bioperl-live/trunk/Bio/SearchIO/infernal.pm bioperl-live/trunk/Bio/SearchIO/rnamotif.pm bioperl-live/trunk/Bio/Seq/Meta/Array.pm bioperl-live/trunk/Bio/SeqFeatureI.pm bioperl-live/trunk/Bio/SeqIO/Handler/GenericRichSeqHandler.pm bioperl-live/trunk/Bio/SeqIO/kegg.pm bioperl-live/trunk/Bio/SeqIO/swiss.pm bioperl-live/trunk/Bio/SimpleAlign.pm bioperl-live/trunk/Bio/Tools/EUtilities/Cookie.pm bioperl-live/trunk/Bio/Tools/EUtilities/EUtilDataI.pm bioperl-live/trunk/Bio/Tools/EUtilities/History.pm bioperl-live/trunk/Bio/Tools/EUtilities/HistoryI.pm bioperl-live/trunk/Bio/Tools/EUtilities/Info/FieldInfo.pm bioperl-live/trunk/Bio/Tools/EUtilities/Info/LinkInfo.pm bioperl-live/trunk/Bio/Tools/EUtilities/Info.pm bioperl-live/trunk/Bio/Tools/EUtilities/Query.pm bioperl-live/trunk/Bio/Tools/EUtilities/Summary/Item.pm bioperl-live/trunk/Bio/Tools/EUtilities/Summary.pm bioperl-live/trunk/Bio/Tools/EUtilities.pm bioperl-live/trunk/Bio/Tools/Infernal.pm bioperl-live/trunk/Bio/Tools/Phylo/Gerp.pm bioperl-live/trunk/Bio/Tools/Protparam.pm bioperl-live/trunk/Bio/Tools/Run/StandAloneBlast.pm bioperl-live/trunk/Bio/Tools/Run/StandAloneNCBIBlast.pm bioperl-live/trunk/Bio/Tools/Run/StandAloneWUBlast.pm bioperl-live/trunk/Bio/Tools/Run/WrapperBase.pm bioperl-live/trunk/Bio/Tools/Spidey/Results.pm bioperl-live/trunk/Bio/Tools/TandemRepeatsFinder.pm bioperl-live/trunk/Bio/TreeIO.pm bioperl-live/trunk/scripts/Bio-DB-GFF/genbank2gff3.PLS Modified: bioperl-live/trunk/Bio/AlignIO/stockholm.pm =================================================================== --- bioperl-live/trunk/Bio/AlignIO/stockholm.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/AlignIO/stockholm.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -47,7 +47,7 @@ GF Lines (alignment feature/annotation): #=GF Placed above the alignment - + GC Lines (Alignment consensus) #=GC @@ -76,7 +76,7 @@ ID id DE description ---------------------------------------------------------------------- - + Tag Bio::Annotation TagName Parameters Class ---------------------------------------------------------------------- @@ -650,4 +650,4 @@ return $self->{'_line_length'}; } -1; \ No newline at end of file +1; Modified: bioperl-live/trunk/Bio/Annotation/Collection.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/Collection.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/Collection.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -394,7 +394,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned Modified: bioperl-live/trunk/Bio/Annotation/Comment.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/Comment.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/Comment.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -100,7 +100,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned Modified: bioperl-live/trunk/Bio/Annotation/DBLink.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/DBLink.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/DBLink.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -148,7 +148,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned Modified: bioperl-live/trunk/Bio/Annotation/OntologyTerm.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/OntologyTerm.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/OntologyTerm.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -169,7 +169,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned @@ -423,7 +423,7 @@ Args : Note : this is deprecated in favor of get_dbxrefs(), which works with strings or L instances - + =cut sub get_dblinks { Modified: bioperl-live/trunk/Bio/Annotation/Reference.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/Reference.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/Reference.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -136,7 +136,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned @@ -539,9 +539,9 @@ Function: Gives the DOI (Digital Object Identifier) from the International DOI Foundation (http://www.doi.org/), which can be used to resolve URL links for the full-text documents using: - + http://dx.doi.org/ - + Example : Returns : value of doi Args : newvalue (optional) Modified: bioperl-live/trunk/Bio/Annotation/SimpleValue.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/SimpleValue.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/SimpleValue.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -125,7 +125,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned Modified: bioperl-live/trunk/Bio/Annotation/StructuredValue.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/StructuredValue.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/StructuredValue.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -128,7 +128,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned Modified: bioperl-live/trunk/Bio/Annotation/TagTree.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/TagTree.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/TagTree.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -26,14 +26,14 @@ use Bio::Annotation::Collection; my $col = Bio::Annotation::Collection->new(); - + # data structure can be an array reference with a data structure # corresponding to that defined by Data::Stag: - + my $sv = Bio::Annotation::TagTree->new(-tagname => 'mytag1', -value => $data_structure); $col->add_Annotation($sv); - + # regular text passed is parsed based on the tagformat(). my $sv2 = Bio::Annotation::TagTree->new(-tagname => 'mytag2', -tagformat => 'xml', @@ -167,7 +167,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for the specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned @@ -304,7 +304,7 @@ (default is Data::Stag::StagImpl) Args : (optional) Data::Stag node implementation (optional)'copy' => flag to create a copy of the node - + =cut sub node{ @@ -327,7 +327,7 @@ Because Data::Stag uses blessed arrays and the core Bioperl class uses blessed hashes, TagTree uses an internal instance of a Data::Stag node for data storage. Therefore the following methods actually delegate to the Data:::Stag internal -instance. +instance. For consistency (since one could recursively check child nodes), methods retain the same names as Data::Stag. Also, no 'magic' (AUTOLOAD'ed) methods are @@ -372,11 +372,11 @@ Usage : Function: Get the top-level array of Data::Stag nodes or (if the top level is a terminal node) a scalar value. - + This is similar to StructuredValue's get_values() method, with the key difference being instead of array refs and scalars you get either Data::Stag nodes or the value for this particular node. - + For consistency (since one could recursively check nodes), we use the same method name as Data::Stag children(). Example : @@ -482,11 +482,11 @@ Function: add new child node to the current node. One can pass in a node, TagTree, or data structure; for instance, in the above, this would translate to (in XML): - + bar1 - + Returns : node Args : first arg = element name all other args are added as tag-value pairs Modified: bioperl-live/trunk/Bio/Annotation/Target.pm =================================================================== --- bioperl-live/trunk/Bio/Annotation/Target.pm 2008-06-09 18:02:23 UTC (rev 14707) +++ bioperl-live/trunk/Bio/Annotation/Target.pm 2008-06-10 00:08:17 UTC (rev 14708) @@ -116,7 +116,7 @@ Usage : my $str = $ann->display_text(); Function: returns a string. Unlike as_text(), this method returns a string formatted as would be expected for te specific implementation. - + One can pass a callback as an argument which allows custom text generation; the callback is passed the current instance and any text returned Modified: bioperl-live/trunk/Bio/Annotation/Tree.pm @@ Diff output truncated at 10000 characters. @@ From heikki at dev.open-bio.org Mon Jun 9 20:08:39 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Mon, 9 Jun 2008 20:08:39 -0400 Subject: [Bioperl-guts-l] [14709] bioperl-run/trunk/Bio/Tools/Run: fixing POD whitespace issues Message-ID: <200806100008.m5A08d9c021694@dev.open-bio.org> Revision: 14709 Author: heikki Date: 2008-06-09 20:08:39 -0400 (Mon, 09 Jun 2008) Log Message: ----------- fixing POD whitespace issues Modified Paths: -------------- bioperl-run/trunk/Bio/Tools/Run/Alignment/Clustalw.pm bioperl-run/trunk/Bio/Tools/Run/Alignment/Lagan.pm bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm bioperl-run/trunk/Bio/Tools/Run/Genemark.pm bioperl-run/trunk/Bio/Tools/Run/Infernal.pm bioperl-run/trunk/Bio/Tools/Run/Mdust.pm bioperl-run/trunk/Bio/Tools/Run/Phylo/Gumby.pm bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhastCons.pm bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhyloFit.pm bioperl-run/trunk/Bio/Tools/Run/Phylo/SLR.pm bioperl-run/trunk/Bio/Tools/Run/PiseJob.pm bioperl-run/trunk/Bio/Tools/Run/RNAMotif.pm bioperl-run/trunk/Bio/Tools/Run/TigrAssembler.pm bioperl-run/trunk/Bio/Tools/Run/tRNAscanSE.pm Modified: bioperl-run/trunk/Bio/Tools/Run/Alignment/Clustalw.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Alignment/Clustalw.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Alignment/Clustalw.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -36,10 +36,10 @@ # Get a tree of the sequences $tree = $factory->tree(\@seq_array); - + # Get both an alignment and a tree ($aln, $tree) = $factory->run(\@seq_array); - + # Do a footprinting analysis on the supplied sequences, getting back the # most conserved sub-alignments my @results = $factory->footprint(\@seq_array); Modified: bioperl-run/trunk/Bio/Tools/Run/Alignment/Lagan.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Alignment/Lagan.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Alignment/Lagan.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -221,7 +221,7 @@ $tree =~ s/ /_/g; $tree =~ s/"//g; $tree =~ s/,/ /g; - + # unfiddle the tree object foreach my $node ($tree_obj->get_nodes) { $node->id($orig_ids{$node->id}); @@ -252,7 +252,7 @@ Bio::Matrix::MLagan object OR filename of an mlagan substitution matrix file - + NB: due to a bug in mlagan 2.0, the -nucmatrixfile option does not work, so this Bioperl wrapper is unable to simply point mlagan to your desired matrix file (or to a temp file generated from your Modified: bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -18,14 +18,14 @@ =head1 SYNOPSIS #run - + my @params = ( trset => 'BL.erpin', region => [1, 10], # Set up search strategy this way... strategy => [ 'umask' => [1, 2], 'umask' => [1, 2, 3, 4], - 'umask' => [1, 2, 3, 4, 5, 6], + 'umask' => [1, 2, 3, 4, 5, 6], 'nomask', 'cutoff' => [0, 10, 15, 20] ] @@ -33,13 +33,13 @@ #strategy => '\xD0umask 4 \xD0add 5 -nomask -cutoff 0 10 15', pcw => 100 ); - + my $factory = Bio::Tools::Run::ERPIN->new(-program =>'erpin', @params); # Pass the factory a Bio::Seq object or a file name # Returns a Bio::SearchIO object - + #my $search = $factory->run("B_sub.fas"); my $search = $factory->run($seq); my @feat; Modified: bioperl-run/trunk/Bio/Tools/Run/Genemark.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Genemark.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Genemark.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -23,7 +23,6 @@ my $factory = Bio::Tools::Run::Genemark->new('-program' => 'gmhmmp', '-m' => 'model.icm'); - # Pass the factory Bio::Seq objects # returns a Bio::Tools::Genemark object Modified: bioperl-run/trunk/Bio/Tools/Run/Infernal.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Infernal.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Infernal.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -16,24 +16,24 @@ cmsearch, cmscore =head1 SYNOPSIS - + # parameters which are switches are set with any value that evals TRUE, # others are set to a specific value - + my @params = (hmmfb => 1, thresh => 20); - + my $factory = Bio::Tools::Run::Infernal->new(@params); - + # run cmalign|cmbuild|cmsearch|cmscore|cmemit directly as a wrapper method # this resets the program flag if previously set - + $factory->cmsearch(@seqs); # searches Bio::PrimarySeqI's based on set cov. model # saves output to outfile()/tempfile # only values which are allowed for a program are set, so one can use the same # wrapper for the following... - + $factory->cmalign(@seqs); # aligns Bio::PrimarySeqI's to a set cov. model # saves output to outfile()/tempfile $factory->cmscore(@seqs); # scores set cov. model against Bio::PrimarySeqI's, @@ -44,13 +44,13 @@ # set one if no file specified # run based on the setting of the program parameter - + my $factory = Bio::Tools::Run::Infernal->new(-program => 'cmsearch', @params); my $search = $factory->run($seq); - + # using cmsearch returns a Bio::SearchIO object - + while (my $result = $searchio->next_result){ while(my $hit = $result->next_hit){ while (my $hsp = $hit->next_hsp){ @@ -64,7 +64,7 @@ } } } - + =head1 DESCRIPTION Wrapper module for Sean Eddy's Infernal suite of programs. The current Modified: bioperl-run/trunk/Bio/Tools/Run/Mdust.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Mdust.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Mdust.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -23,15 +23,19 @@ =head1 DESCRIPTION -Perl wrapper for the nucleic acid complexity filtering program B as -available from TIGR via L. Takes a -Bio::SeqI or Bio::PrimarySeqI object of type DNA as input. +Perl wrapper for the nucleic acid complexity filtering program +B as available from TIGR via +L. Takes a Bio::SeqI or +Bio::PrimarySeqI object of type DNA as input. -If a Bio::Seq::RichSeqI is passed then the low-complexity regions will be added to the feature table of the target object as +If a Bio::Seq::RichSeqI is passed then the low-complexity regions will +be added to the feature table of the target object as Bio::SeqFeature::Generic items with primary tag = 'Excluded' . -Otherwise a new target object will be returned with low-complexity regions masked (by N's or other character as specified by maskchar()). +Otherwise a new target object will be returned with low-complexity +regions masked (by N's or other character as specified by maskchar()). -The mdust executable must be in a directory specified with either the PATH or MDUSTDIR environment variable. +The mdust executable must be in a directory specified with either the +PATH or MDUSTDIR environment variable. =head1 SEE ALSO @@ -327,8 +331,6 @@ Args : Either N (default), X or L (lower case) =cut - - sub maskchar { my ($self, $maskchar) = @_; Modified: bioperl-run/trunk/Bio/Tools/Run/Phylo/Gumby.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Phylo/Gumby.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Phylo/Gumby.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -39,7 +39,7 @@ # or using feature objects $factory->annots(@bio_seqfeature_objects); @results = $factory->run($alignfilename, $treefilename); - + # (mixtures of all the above are possible) # look at the results Modified: bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhastCons.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhastCons.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhastCons.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -31,7 +31,7 @@ # generate the species tree automatically using a Bio::DB::Taxonomy database $tdb = Bio::DB::Taxonomy->new(-source => 'entrez'); @features = $factory->run($aln_obj, $tdb); - + # @features is an array of Bio::SeqFeature::Annotated, one feature per # alignment sequence and prediction @@ -328,7 +328,7 @@ Bio::DB::Taxonomy object can be supplied, in which case the species tree will be generated by using the alignment sequence names as species names and looking for those in the supplied database. - + In all cases, the alignment sequence names must correspond to node ids in the species tree. Multi-word species names should be joined with underscores to form the sequence names, eg. Homo_sapiens Modified: bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhyloFit.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhyloFit.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Phylo/Phast/PhyloFit.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -235,7 +235,7 @@ Bio::DB::Taxonomy object can be supplied, in which case the species tree will be generated by using the alignment sequence names as species names and looking for those in the supplied database. - + In all cases, the alignment sequence names must correspond to node ids in the species tree. Multi-word species names should be joined with underscores to form the sequence names, eg. Homo_sapiens Modified: bioperl-run/trunk/Bio/Tools/Run/Phylo/SLR.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Phylo/SLR.pm 2008-06-10 00:08:17 UTC (rev 14708) +++ bioperl-run/trunk/Bio/Tools/Run/Phylo/SLR.pm 2008-06-10 00:08:39 UTC (rev 14709) @@ -308,6 +308,7 @@ selection). This may indicate that the alignment at that site is bad Note + The following events are flagged: Synonymous All codons at a site code for the same amino acid. @@ -315,7 +316,7 @@ @@ Diff output truncated at 10000 characters. @@ From heikki at dev.open-bio.org Mon Jun 9 20:42:00 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Mon, 9 Jun 2008 20:42:00 -0400 Subject: [Bioperl-guts-l] [14710] bioperl-live/trunk/Bio: POD fixes Message-ID: <200806100042.m5A0g0OV021740@dev.open-bio.org> Revision: 14710 Author: heikki Date: 2008-06-09 20:42:00 -0400 (Mon, 09 Jun 2008) Log Message: ----------- POD fixes Modified Paths: -------------- bioperl-live/trunk/Bio/AlignIO.pm bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm bioperl-live/trunk/Bio/Graph/IO/psi_xml.pm bioperl-live/trunk/Bio/Graphics/Glyph/arrow.pm bioperl-live/trunk/Bio/Graphics/Glyph/ex.pm bioperl-live/trunk/Bio/Graphics/Glyph/flag.pm bioperl-live/trunk/Bio/Graphics/Glyph/ruler_arrow.pm bioperl-live/trunk/Bio/Graphics/Glyph/three_letters.pm bioperl-live/trunk/Bio/Root/Root.pm bioperl-live/trunk/Bio/Tools/RestrictionEnzyme.pm bioperl-live/trunk/Bio/Tools/SeqPattern.pm bioperl-live/trunk/Bio/Tools/TargetP.pm bioperl-live/trunk/Bio/TreeIO/phyloxml.pm Modified: bioperl-live/trunk/Bio/AlignIO.pm =================================================================== --- bioperl-live/trunk/Bio/AlignIO.pm 2008-06-10 00:08:39 UTC (rev 14709) +++ bioperl-live/trunk/Bio/AlignIO.pm 2008-06-10 00:42:00 UTC (rev 14710) @@ -97,7 +97,7 @@ multiple alignments is not. The only current exception is format C which parses results of the BLAST C program and which may produce several alignment pairs. This set of alignment pairs can -be read using multiple calls to L. +be read using multiple calls to L. =head1 CONSTRUCTORS @@ -108,9 +108,9 @@ $seqIO = Bio::AlignIO->new(-format => $format); $seqIO = Bio::AlignIO->new(-fh => \*STDOUT, -format => $format); -The L class method constructs a new L object. +The L class method constructs a new L object. The returned object can be used to retrieve or print alignment -objects. L accepts the following parameters: +objects. L accepts the following parameters: =over 4 @@ -180,10 +180,10 @@ # read from STDIN or use @ARGV: $fh = Bio::AlignIO->newFh(-format => $format); -This constructor behaves like L, but returns a tied filehandle +This constructor behaves like L, but returns a tied filehandle rather than a L object. You can read sequences from this object using the familiar EE operator, and write to it using -L. The usual array and $_ semantics work. For example, you can +L. The usual array and $_ semantics work. For example, you can read all sequence objects into an array like this: @sequences = <$fh>; Modified: bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm =================================================================== --- bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm 2008-06-10 00:08:39 UTC (rev 14709) +++ bioperl-live/trunk/Bio/Assembly/Tools/ContigSpectrum.pm 2008-06-10 00:42:00 UTC (rev 14710) @@ -9,78 +9,10 @@ =head1 NAME - Bio::Assembly::Tools::ContigSpectrum +Bio::Assembly::Tools::ContigSpectrum =head1 SYNOPSIS - Bio::Assembly::Tools::ContigSpectrum is a module to create, manipulate and output - contig spectra, assembly-derived data used in metagenomics (community - genomics) for diversity estimation. - -=head1 DESCRIPTION - - The Bio::Assembly::Tools::ContigSpectrum Perl module enables to manually create - contig spectra, import them from assemblies, manipulate them, transform - between different types of contig spectra and output them. - -=head2 Background - - A contig spectrum is the count of the number of contigs of different size in - an assembly. For example, the contig spectrum [100 5 1 0 0 ...] means that - there were 100 singlets (1-contigs), 5 contigs of 2 sequences (2-contigs), 1 - contig of 3 sequences (3-contig) and no larger contigs. - - An assembly can be produced from a mixture of sequences from different - metagenomes. The contig obtained from this assembly is a mixed contig - spectrum. The contribution of each metagenome in this mixed contig spectrum - can be obtained by determining a dissolved contig spectrum. - - Finally, based on a mixed contig spectrum, a cross contig spectrum can be - determined. In a cross contig spectrum, only contigs containing sequences from - different metagenomes are kept; "pure" contigs are excluded. Additionally, the - total number of singletons (1-contigs) from each region that assembles with - any fragments from other regions is the number of 1-contigs in the cross - contig spectrum. - -=head2 Implemention - - The simplest representation of a contig spectrum is as a hash representation - where the key is the contig size (number of sequences making up the contig) - and the value the number of contigs of this size. - - In fact, it is useful to have more information associated with the contig - spectrum, hence the Bio::Assembly::Tools::ContigSpectrum module implements an object - containing a contig spectrum hash and additional information. The get/set - methods to access them are: - id contig spectrum ID - nof_seq number of sequences - nof_rep number of repetitions (assemblies) used - max_size size of (number of sequences in) the largest contig - nof_overlaps number of overlaps - min_overlap minimum overlap length for building a contig - min_identity minimum sequence identity over the overlap length - avg_overlap average overlap length - avg_identity average overlap identity - avg_seq_length average sequence length - eff_asm_params effective assembly parameters - spectrum hash representation of a contig spectrum - - Operations on the contig spectra: - to_string create a string representation of the spectrum - spectrum import a hash contig spectrum - assembly determine a contig spectrum from an assembly - dissolve calculate a dissolved contig spectrum (based on assembly) - cross produce a cross contig spectrum (based on assembly) - add add a contig spectrum to an existing one - average make an average of several contig spectra - - When using operations that rely on knowing "where" (from what metagenomes) a - sequence came from (i.e. when creating a dissolved or cross contig spectrum), - make sure that the sequences used for the assembly have a name header, e.g. - >metagenome1|seq1, > >metagenome2|seq1, ... - -=head2 Examples - # Simple contig spectrum creation my $csp1 = Bio::Assembly::Tools::ContigSpectrum->new( -id => 'csp1', @@ -142,6 +74,79 @@ -cross => $mixed_csp ); print "The cross contig spectrum is ".$cross_csp->to_string."\n"; + +=head1 DESCRIPTION + +The Bio::Assembly::Tools::ContigSpectrum Perl module enables to +manually create contig spectra, import them from assemblies, +manipulate them, transform between different types of contig spectra +and output them. + +Bio::Assembly::Tools::ContigSpectrum is a module to create, manipulate +and output contig spectra, assembly-derived data used in metagenomics +(community genomics) for diversity estimation. + +=head2 Background + +A contig spectrum is the count of the number of contigs of different +size in an assembly. For example, the contig spectrum [100 5 1 0 0 +...] means that there were 100 singlets (1-contigs), 5 contigs of 2 +sequences (2-contigs), 1 contig of 3 sequences (3-contig) and no +larger contigs. + +An assembly can be produced from a mixture of sequences from different +metagenomes. The contig obtained from this assembly is a mixed contig +spectrum. The contribution of each metagenome in this mixed contig +spectrum can be obtained by determining a dissolved contig spectrum. + +Finally, based on a mixed contig spectrum, a cross contig spectrum can +be determined. In a cross contig spectrum, only contigs containing +sequences from different metagenomes are kept; "pure" contigs are +excluded. Additionally, the total number of singletons (1-contigs) +from each region that assembles with any fragments from other regions +is the number of 1-contigs in the cross contig spectrum. + +=head2 Implemention + +The simplest representation of a contig spectrum is as a hash +representation where the key is the contig size (number of sequences +making up the contig) and the value the number of contigs of this +size. + +In fact, it is useful to have more information associated with the +contig spectrum, hence the Bio::Assembly::Tools::ContigSpectrum module +implements an object containing a contig spectrum hash and additional +information. The get/set methods to access them are: + + id contig spectrum ID + nof_seq number of sequences + nof_rep number of repetitions (assemblies) used + max_size size of (number of sequences in) the largest contig + nof_overlaps number of overlaps + min_overlap minimum overlap length for building a contig + min_identity minimum sequence identity over the overlap length + avg_overlap average overlap length + avg_identity average overlap identity + avg_seq_length average sequence length + eff_asm_params effective assembly parameters + spectrum hash representation of a contig spectrum + + Operations on the contig spectra: + + to_string create a string representation of the spectrum + spectrum import a hash contig spectrum + assembly determine a contig spectrum from an assembly + dissolve calculate a dissolved contig spectrum (based on assembly) + cross produce a cross contig spectrum (based on assembly) + add add a contig spectrum to an existing one + average make an average of several contig spectra + +When using operations that rely on knowing "where" (from what +metagenomes) a sequence came from (i.e. when creating a dissolved or +cross contig spectrum), make sure that the sequences used for the +assembly have a name header, e.g. >metagenome1|seq1, > +>metagenome2|seq1, ... + =head1 FEEDBACK =head2 Mailing Lists Modified: bioperl-live/trunk/Bio/Graph/IO/psi_xml.pm =================================================================== --- bioperl-live/trunk/Bio/Graph/IO/psi_xml.pm 2008-06-10 00:08:39 UTC (rev 14709) +++ bioperl-live/trunk/Bio/Graph/IO/psi_xml.pm 2008-06-10 00:42:00 UTC (rev 14710) @@ -53,7 +53,7 @@ =head1 METHODS The naming system is analagous to the SeqIO system, although usually -L will be called only once per file. +L will be called only once per file. =cut Modified: bioperl-live/trunk/Bio/Graphics/Glyph/arrow.pm =================================================================== --- bioperl-live/trunk/Bio/Graphics/Glyph/arrow.pm 2008-06-10 00:08:39 UTC (rev 14709) +++ bioperl-live/trunk/Bio/Graphics/Glyph/arrow.pm 2008-06-10 00:42:00 UTC (rev 14710) @@ -306,10 +306,7 @@ __END__ -=head1 NAME -Bio::Graphics::Glyph::arrow - The "arrow" glyph - =head1 SYNOPSIS See L and L. @@ Diff output truncated at 10000 characters. @@ From heikki at dev.open-bio.org Mon Jun 9 20:42:19 2008 From: heikki at dev.open-bio.org (Heikki Lehvaslaiho) Date: Mon, 9 Jun 2008 20:42:19 -0400 Subject: [Bioperl-guts-l] [14711] bioperl-run/trunk/Bio/Tools/Run: POD fixes Message-ID: <200806100042.m5A0gJrg021765@dev.open-bio.org> Revision: 14711 Author: heikki Date: 2008-06-09 20:42:18 -0400 (Mon, 09 Jun 2008) Log Message: ----------- POD fixes Modified Paths: -------------- bioperl-run/trunk/Bio/Tools/Run/AnalysisFactory/Pise.pm bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm bioperl-run/trunk/Bio/Tools/Run/Phylo/Njtree/Best.pm bioperl-run/trunk/Bio/Tools/Run/Simprot.pm Modified: bioperl-run/trunk/Bio/Tools/Run/AnalysisFactory/Pise.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/AnalysisFactory/Pise.pm 2008-06-10 00:42:00 UTC (rev 14710) +++ bioperl-run/trunk/Bio/Tools/Run/AnalysisFactory/Pise.pm 2008-06-10 00:42:18 UTC (rev 14711) @@ -204,7 +204,7 @@ return $self; } -=head2 program +=head2 program() Title : program() Usage : my $program = Bio::Tools::Run::AnalysisFactory::Pise->program( Modified: bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm 2008-06-10 00:42:00 UTC (rev 14710) +++ bioperl-run/trunk/Bio/Tools/Run/ERPIN.pm 2008-06-10 00:42:18 UTC (rev 14711) @@ -59,6 +59,8 @@ =head1 DESCRIPTION +=cut + =head1 FEEDBACK =head2 Mailing Lists Modified: bioperl-run/trunk/Bio/Tools/Run/Phylo/Njtree/Best.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Phylo/Njtree/Best.pm 2008-06-10 00:42:00 UTC (rev 14710) +++ bioperl-run/trunk/Bio/Tools/Run/Phylo/Njtree/Best.pm 2008-06-10 00:42:18 UTC (rev 14711) @@ -12,12 +12,8 @@ =head1 NAME -Bio::Tools::Run::Phylo::Njtree::Best - Wrapper aroud the Njtree -(Njtree/phyml) best program. Wrapper for the calculation of a -reconciled phylogenetic tree with inferred duplication tags from a -multiple sequence alignment and a species tree using NJTREE. +Bio::Tools::Run::Phylo::Njtree::Best - Wrapper around the Njtree (Njtree/phyml) best program. - =head1 SYNOPSIS use Bio::Tools::Run::Phylo::Njtree::Best; @@ -44,6 +40,10 @@ This is a wrapper around the best program of Njtree by Li Heng. See http://treesoft.sourceforge.net/njtree.shtml for more information. +Wrapper for the calculation of a reconciled phylogenetic tree with +inferred duplication tags from amultiple sequence alignment and a +species tree using NJTREE. + =head2 Helping the module find your executable You will need to enable NJTREEDIR to find the njtree program. This can be Modified: bioperl-run/trunk/Bio/Tools/Run/Simprot.pm =================================================================== --- bioperl-run/trunk/Bio/Tools/Run/Simprot.pm 2008-06-10 00:42:00 UTC (rev 14710) +++ bioperl-run/trunk/Bio/Tools/Run/Simprot.pm 2008-06-10 00:42:18 UTC (rev 14711) @@ -12,11 +12,8 @@ =head1 NAME -Bio::Tools::Run::Simprot - Wrapper around the Simprot program. Wrapper -for the calculation of a multiple sequence alignment from a -phylogenetic tree +Bio::Tools::Run::Simprot - Wrapper around the Simprot program. Wrapper for the calculation of a multiple sequence alignment from a phylogenetic tree - =head1 SYNOPSIS use Bio::Tools::Run::Simprot; From miraceti at dev.open-bio.org Tue Jun 10 01:04:28 2008 From: miraceti at dev.open-bio.org (miraceti at dev.open-bio.org) Date: Tue, 10 Jun 2008 01:04:28 -0400 Subject: [Bioperl-guts-l] [14712] bioperl-live/trunk: use function hash instead of if-else Message-ID: <200806100504.m5A54SUh022264@dev.open-bio.org> Revision: 14712 Author: miraceti Date: 2008-06-10 01:04:28 -0400 (Tue, 10 Jun 2008) Log Message: ----------- use function hash instead of if-else Modified Paths: -------------- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm bioperl-live/trunk/t/phyloxml.t Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm =================================================================== --- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-06-10 00:42:18 UTC (rev 14711) +++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-06-10 05:04:28 UTC (rev 14712) @@ -93,8 +93,7 @@ $self->debug("libxml version: ", XML::LibXML::LIBXML_VERSION(), "\n"); $self->treetype($args{-treetype}); $self->nodetype($args{-nodetype}); - #$self->{'_treelevel'} = 0; - _init_func(); + $self->_init_func(); } sub _init_func @@ -108,6 +107,7 @@ my %end_elements = ( 'phylogeny' => \&end_element_phylogeny, 'clade' => \&end_element_clade, + 'name' => \&end_element_name, ); $self->{'_end_element'} = \%end_elements; } @@ -183,23 +183,13 @@ $self->{'_lastitem'}->{$reader->name}++; push @{$self->{'_lastitem'}->{'current'}}, $reader->name; - if ($reader->name eq 'phylogeny') { - $self->element_phylogeny(); + if (exists $self->{'_start_element'}->{$reader->name}) { + my $method = $self->{'_start_element'}->{$reader->name}; + $self->$method(); } - elsif ($reader->name eq 'clade') { - $self->element_clade(); - } -# if (exists $self->{'_start_element'}->{$reader->name}) { -# $self->{'_start_element'}->{$reader->name}->(); -# } } elsif ($reader->nodeType == XML_READER_TYPE_TEXT) { - #$self->debug( $reader->depth, - # $reader->nodeType, - # $reader->name, - # $reader->isEmptyElement, - # $reader->value); $self->debug($reader->value, "\n"); $self->{'_currenttext'} = $reader->value; } @@ -207,18 +197,10 @@ { $self->debug("ending element: ",$reader->name, "\n"); - if ($reader->name eq 'phylogeny') { - $self->end_element_phylogeny(); + if (exists $self->{'_end_element'}->{$reader->name}) { + my $method = $self->{'_end_element'}->{$reader->name}; + $self->$method(); } - elsif ($reader->name eq 'clade') { - $self->end_element_clade(); - } - elsif ($reader->name eq 'name') { - $self->end_element_name(); - } - #if (exists $self->{'_end_element'}->{$reader->name}) { - # $self->{'_end_element'}->{$reader->name}->(); - #} $self->{'_lastitem'}->{ $reader->name }--; pop @{$self->{'_lastitem'}->{'current'}}; } @@ -234,7 +216,6 @@ Returns : Args : - =cut sub processAttribute @@ -288,18 +269,24 @@ my ($self) = @_; $self->debug("Ending phylogeny: nodes in stack is", scalar @{$self->{'_currentnodes'}}, "\n"); - my $root = $self->nodetype->new( -verbose => $self->verbose ); + my $root; + # if there is more than one node in _currentnodes # aggregate the nodes into trees basically ad-hoc. - while ( @{$self->{'_currentnodes'}} ) { - my ($node) = ( shift @{$self->{'_currentnodes'}}); - $root->add_Descendent($node); - } - $self->debug("Root node is " . $root->to_string()."\n"); - if( $self->verbose > 0 ) { - foreach my $node ( $root->get_Descendents ) { - $self->debug("node is ". $node->to_string(). "\n"); + if ( @{$self->{'_currentnodes'}} > 1) + { + $root = $self->nodetype->new( -verbose => $self->verbose, + -id => '' ); + while ( @{$self->{'_currentnodes'}} ) { + my ($node) = ( shift @{$self->{'_currentnodes'}}); + $root->add_Descendent($node); } } + # if there is only one node in _currentnodes + # that node is root. + elsif ( @{$self->{'_currentnodes'}} == 1) + { + $root = shift @{$self->{'_currentnodes'}}; + } my $tree = $self->treetype->new( -verbose => $self->verbose, @@ -326,7 +313,9 @@ my %data = (); #take care of attribute $self->processAttribute(\%data); - my $tnode = $self->nodetype->new( -verbose => $self->verbose, %data); + my $tnode = $self->nodetype->new( -verbose => $self->verbose, + -id => '', + %data); push @{$self->{'_currentitems'}}, $tnode; } Modified: bioperl-live/trunk/t/phyloxml.t =================================================================== --- bioperl-live/trunk/t/phyloxml.t 2008-06-10 00:42:18 UTC (rev 14711) +++ bioperl-live/trunk/t/phyloxml.t 2008-06-10 05:04:28 UTC (rev 14712) @@ -7,7 +7,7 @@ use lib 't/lib'; use BioperlTest; - test_begin(-tests => 17, + test_begin(-tests => 36, -requires_modules => [qw(XML::LibXML)], ); if (1000*$] < 5008) { @@ -34,93 +34,154 @@ # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -my $out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +my @nodes = $tree->get_nodes; +is(@nodes, 5); +my ($A) = $tree->find_node('A'); +ok($A); +is($A->branch_length, '0.102'); +is($A->ancestor->id, ''); +is($A->ancestor->branch_length, '0.06'); +my $leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree2: branch_length # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); + at nodes = $tree->get_nodes; +is(@nodes, 5); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree3: bootstrap # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree4: species and sequence # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree5: homolog relationship and sequence relationship # # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, ''); +undef $tree; # tree6: detailed sequence data # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, ''); +undef $tree; # tree7: network # @id_source & @id_ref $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree8: property elements # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree9: property outside tree topology using id refs # @id_source @id_ref $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree10: detailed taxonomy and distribution # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, ''); +undef $tree; # tree11: phylogeographic information # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '(((A,B),C),D)'); +undef $tree; # tree12: date information # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; # tree13: alignment outside # $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); -$out = Bio::TreeIO->new(-format => 'newick'); -$out->write_tree($tree); +$leaves_string = $tree->simplify_to_leaves_string(); +if ($verbose > 0) { + diag($leaves_string); +} +is($leaves_string, '((A,B),C)'); +undef $tree; TODO: { From bugzilla-daemon at portal.open-bio.org Tue Jun 10 16:06:35 2008 From: bugzilla-daemon at portal.open-bio.org (bugzilla-daemon at portal.open-bio.org) Date: Tue, 10 Jun 2008 16:06:35 -0400 Subject: [Bioperl-guts-l] [Bug 2512] New: Patches for obo parser to recognize new relationships Message-ID: http://bugzilla.open-bio.org/show_bug.cgi?id=2512 Summary: Patches for obo parser to recognize new relationships Product: BioPerl Version: main-trunk Platform: Macintosh OS/Version: Mac OS Status: NEW Severity: enhancement Priority: P2 Component: Unclassified AssignedTo: bioperl-guts-l at bioperl.org ReportedBy: siddhartha-basu at northwestern.edu Gene ontology consortium has recently introduced three new relationships in their obo file (http://www.geneontology.org/newsletter/archive/200802.shtml) that are not being captured by bioperl's obo parser engine(Bio::Ontology::OBOEngine). I am attaching four patches including one test case that should allow the parser