Permalink
Browse files

handle iterators more properly - added feature_count support

svn path=/bioperl-corba-client/trunk/; revision=54
  • Loading branch information...
1 parent a9627b6 commit 37807879f0ea323f73ce053217b430639f745582 @hyphaltip hyphaltip committed Feb 26, 2002
Showing with 57 additions and 81 deletions.
  1. +30 −16 Bio/CorbaClient/Seq.pm
  2. +7 −5 Bio/CorbaClient/SeqDB.pm
  3. +20 −60 Bio/CorbaClient/SeqFeature.pm
View
@@ -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;
}
View
@@ -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;
@@ -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;

0 comments on commit 3780787

Please sign in to comment.