handle iterators more properly - added feature_count support

svn path=/bioperl-corba-client/trunk/; revision=54
bioperl · Feb 26, 2002 · 3780787 · 3780787
1 parent a9627b6
commit 3780787
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 81 deletions.
diff --git a/Bio/CorbaClient/Seq.pm b/Bio/CorbaClient/Seq.pm
@@ -47,7 +47,7 @@ or the web:
 =head1 AUTHOR - Ewan Birney, Jason Stajich
 
 Email birney@ebi.ac.uk
-      jason@chg.mc.duke.edu
+      jason@bioperl.org
 
 Describe contact details here
 
@@ -59,13 +59,16 @@ methods. Internal methods are usually preceded with a _
 =cut
 
 package Bio::CorbaClient::Seq;
-use vars qw(@ISA);
+use vars qw(@ISA $NumFeaturesToFetch);
 use strict;
 
 use Bio::CorbaClient::PrimarySeq;
 use Bio::CorbaClient::SeqFeature;
 use Bio::SeqI;
 
+BEGIN { 
+    $NumFeaturesToFetch = 1000;
+}
 
 @ISA = qw(Bio::CorbaClient::PrimarySeq Bio::SeqI);
 
@@ -82,10 +85,9 @@ use Bio::SeqI;
 
 sub top_SeqFeatures {
     my ($self ) = @_;
-
     my $coll   = $self->corbaref->get_seq_features();
     my ($iter,$reflist);
-    ($reflist,$iter) = $coll->get_annotations(1000,$iter);
+    ($reflist,$iter) = $coll->get_annotations($NumFeaturesToFetch,$iter);
     my @features;
 
     foreach my $ref ( @{$reflist} ) {
@@ -94,11 +96,9 @@ sub top_SeqFeatures {
 
     my $ref;
     my $ret = 1;
-    while( $ret ) {
-        ($ret,$ref) = $iter->next();
-        if( $ret == 0 ) {
-           last;
-	 }
+    while( defined $iter && $ret ) {
+	($ret,$ref) = $iter->next();
+	last unless ( $ret );
 	push @features, new Bio::CorbaClient::SeqFeature('-corbaref'=>$ref);
     }
     return @features;
@@ -108,8 +108,7 @@ sub top_SeqFeatures {
 
  Title   : all_SeqFeatures
  Usage   : $seq->all_SeqFeatures
- Function:
- Example :
+ Function: Returns list of features associated with the sequence
  Returns : array of all features (descending into each sub feature)
  Args    : 
 
@@ -151,11 +150,26 @@ sub primary_seq {
 sub feature_count {
     my ($self) = @_;
     my $count = 0;
-    my $vector = $self->corbaref->SeqFeatures(1);
-    my $iter = $vector->iterator;
-    while( $iter->has_more ) {
-	$count++;
-    }
+    my $coll   = $self->corbaref->get_seq_features();
+    my $wholeseqloc = { 
+	'seq_location' => {
+	    'start' => {
+		'position'  => 1,
+		'extension' => 0,
+		'fuzzy'     => 0,
+	    },
+	    'end'   => {
+		'position'  => $self->length,
+		'extension' => 0,
+		'fuzzy'     => 0,
+	    },
+	    'strand' => 1,
+	},
+	'region_operator'   => '0',
+	'sub_seq_locations' => [],
+	'id'                => '',
+    };
+    my $count = $coll->num_features_on_region($wholeseqloc);    
     return $count;
 }
 

diff --git a/Bio/CorbaClient/SeqDB.pm b/Bio/CorbaClient/SeqDB.pm
@@ -1,4 +1,4 @@
-
+# $Id$
 #
 # BioPerl module for Bio::CorbaClient::SeqDB
 #
@@ -12,7 +12,7 @@
 
 =head1 NAME
 
-Bio::CorbaClient::SeqDB - DESCRIPTION of Object
+Bio::CorbaClient::SeqDB - Bioperl Sequence Database wrapper around BioCORBA object.
 
 =head1 SYNOPSIS
 
@@ -63,14 +63,14 @@ use vars qw(@ISA);
 use strict;
 use Bio::CorbaClient::Seq;
 use Bio::DB::SeqI;
+use Bio::CorbaClient::Base;
 
-# Object preamble - inherits from Bio::Root::RootI
+# implements the Bio::DB::SeqI interface
 
-use Bio::CorbaClient::Base;
 @ISA = qw(Bio::CorbaClient::Base Bio::DB::SeqI);
 
 
-# new() can be inherited from Bio::Root::RootI
+# new() inherited from Bio::CorbaClient::Base
 
 =head2 get_Seq_by_id
 
@@ -203,3 +203,5 @@ sub get_Seq_by_primary_id {
 
    return $self->get_Seq_by_acc($id);
 }
+
+1;
diff --git a/Bio/CorbaClient/SeqFeature.pm b/Bio/CorbaClient/SeqFeature.pm
@@ -83,14 +83,8 @@ $NumQualsToFetch = 50;
 
 sub sub_SeqFeature {
     my $self = shift;
-    my @array;
-    my $vector = $self->corbaref->sub_SeqFeatures(1);
-    my $iter = $vector->iterator();
-    while( $iter->has_more ) {
-	push @array, new Bio::CorbaClient::SeqFeature('-corbref' => 
-						      $iter->next);
-    }
-    return @array;
+    # not Sub SeqFeatures supported
+    return ();
 }
 
 =head2 primary_tag
@@ -182,19 +176,27 @@ sub _fetch_qualifiers {
    my ($annlist,$iter);
    ($annlist,$iter) = $self->corbaref->get_annotations->get_annotations($NumQualsToFetch, $iter);    
    foreach my $ann ( @$annlist ) {
-      push(@{$self->{'_annlist'}},$ann);
-    }
+       push(@{$self->{'_annlist'}},$ann);
+   }
+
+   # iterate through the rest
+   my $ref;
+   my $ret = 1;
+   while( defined $iter && $ret ) {
+       ($ret,$ref) = $iter->next();
+       last unless ( $ret );
+       push(@{$self->{'_annlist'}},$ref)
+   }
    return @{$self->{'_annlist'}};
 }
 
 =head2 each_tag_value
 
  Title   : each_tag_value
- Usage   :
- Function:
- Example :
- Returns : 
- Args    :
+ Usage   : my @val = $self->each_tag_value($tag);
+ Function: returns the list of values associated with a tag
+ Returns : List of strings
+ Args    : tag string  
 
 
 =cut
@@ -258,14 +260,14 @@ sub create_Bioperl_location_from_BSANE_location {
     my $type = 'Bio::Location::Simple';
     my @args;
 
-    # WHAT ABOUT STRAND and EXTENSION
 
     foreach my $pl ( qw(start end) ) {
 	my $p = $bsaneloc->{'seq_location'}->{$pl};
 	push @args, 
-	( "-$pl" => $p->{'position'},
+	( "-$pl"      => $p->{'position'},
 	  "-$pl\_ext" => $p->{'extension'},# if this is zero no worries
 	  "-$pl\_fuz" => $p->{'fuzzy'},	   # if this is 1 or 'EXACT' no worries
+	  "-strand"   => $p->{'strand'},
 	  );
 	if( $p->{'fuzzy'} > 1 || $p->{'extension'} > 0 ) {
 	    $type = 'Bio::Location::Fuzzy';
@@ -351,49 +353,7 @@ sub length {
 sub strand {
    my ($self) = @_;
    return $self->location->strand();
-    #print STDERR "Client $location from biocorba... with ",$location->start," ",$location->end,"]\n";
-}
-
-sub _create_location_from_biocorba_loc {
-    my ($locationhash) = @_;
-    my ($startp, $startext, 
-	$startfuzzy) = ( $locationhash->{'start'}->{'position'},
-			 $locationhash->{'start'}->{'extension'},
-			 $locationhash->{'start'}->{'fuzzy'},
-			 );
-    my ($endp, $endext, 
-	$endfuzzy) = ( $locationhash->{'end'}->{'position'},
-		       $locationhash->{'end'}->{'extension'},
-		       $locationhash->{'end'}->{'fuzzy'},
-		       );
-    my $type = 'Bio::Location::Simple';
-    if( $startfuzzy != 1 || $endfuzzy != 1 ) {
-	$type = 'Bio::Location::Fuzzy';
-    }
-
-    return $type->new('-start' => &_get_point_string($startp,
-						     $startext,
-						     $startfuzzy),
-		      '-end'   =>  &_get_point_string($endp,
-							   $endext,
-						      $endfuzzy),
-		      '-strand' => $locationhash->{'strand'} );
-}
-
-sub _get_point_string {
-    my ($start,$ext,$fuzzy) = @_;
-
-    if( $fuzzy == 2 ) {
-	return sprintf("%s.%s", $start, $start+$ext);
-    } elsif( $fuzzy == 3 ) {
-	return sprintf("%s^%s", $start, $start+$ext);
-    } elsif( $fuzzy == 4 ) {
-	return sprintf("<%s",$start);
-    } elsif( $fuzzy == 5 ) {
-	return sprintf("%s>",$start);
-    } else { 
-	return $start;
-    }
+   #print STDERR "Client $location from biocorba... with ",$location->start," ",$location->end,"]\n";
 }
 
 1;