[Bioperl-guts-l] bioperl-live/Bio/Tools EUtilities.pm,1.3,1.4

Christopher John Fields cjfields at dev.open-bio.org
Thu Jun 28 14:04:38 EDT 2007


Update of /home/repository/bioperl/bioperl-live/Bio/Tools
In directory dev.open-bio.org:/tmp/cvs-serv4709

Modified Files:
	EUtilities.pm 
Log Message:
added a few new methods

Index: EUtilities.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Tools/EUtilities.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** EUtilities.pm	25 Jun 2007 19:06:41 -0000	1.3
--- EUtilities.pm	28 Jun 2007 18:04:36 -0000	1.4
***************
*** 287,292 ****
   Returns  : Boolean
   Args     : none
!  Note     : Permanently set in constructor.
! 
  =cut
  
--- 287,293 ----
   Returns  : Boolean
   Args     : none
!  Note     : Permanently set in constructor.  Still highly experimental.
!             Don't stare directly at happy fun ball...
!  
  =cut
  
***************
*** 314,318 ****
                          Id IdLinkSet ObjUrl Link LinkInfo)],
      'espell'    => [qw(Original Replaced)],
!     'esearch'   => [qw(Id)],
      );
  
--- 315,319 ----
                          Id IdLinkSet ObjUrl Link LinkInfo)],
      'espell'    => [qw(Original Replaced)],
!     'esearch'   => [qw(Id ErrorList WarningList)],
      );
  
***************
*** 332,336 ****
      if ($simple->{ERROR}) {
          my $error = $simple->{ERROR};
!         $self->throw("NCBI $eutil nonrecoverable error: ".$error) unless ref $error;
      }
      if ($simple->{InvalidIdList}) {
--- 333,337 ----
      if ($simple->{ERROR}) {
          my $error = $simple->{ERROR};
!         $self->throw("NCBI $eutil fatal error: ".$error) unless ref $error;
      }
      if ($simple->{InvalidIdList}) {
***************
*** 339,356 ****
      }    
      if ($simple->{ErrorList} || $simple->{WarningList}) {
!         my %errorlist = %{ $simple->{ErrorList} } if $simple->{ErrorList};
!         my %warninglist = %{ $simple->{WarningList} } if $simple->{WarningList};
          my ($err_warn);
!         for my $key (sort keys %errorlist) {
!             my $messages = join("\n",grep {!ref $_} @{$errorlist{$key}});
!             $err_warn .= "Error : $key = $messages";
          }    
!         for my $key (sort keys %warninglist) {
!             my $messages = join("\n",grep {!ref $_} @{$warninglist{$key}});
!             $err_warn .= "Warning : $key = $messages";
          }
          chomp($err_warn);
          $self->warn("NCBI $eutil Errors/Warnings:\n".$err_warn)
!         # don't return as some data may still be usefule
      }
      delete $self->{'_response'} unless $self->cache_response;
--- 340,359 ----
      }    
      if ($simple->{ErrorList} || $simple->{WarningList}) {
!         my @errorlist = @{ $simple->{ErrorList} } if $simple->{ErrorList};
!         my @warninglist = @{ $simple->{WarningList} } if $simple->{WarningList};
          my ($err_warn);
!         for my $error (@errorlist) {
!             my $messages = join("\n\t",map {"$_  [".$error->{$_}.']'}
!                                 grep {!ref $error->{$_}} keys %$error);
!             $err_warn .= "Error : $messages";
          }    
!         for my $warn (@warninglist) {
!             my $messages = join("\n\t",map {"$_  [".$warn->{$_}.']'}
!                                 grep {!ref $warn->{$_}} keys %$warn);
!             $err_warn .= "Warnings : $messages";
          }
          chomp($err_warn);
          $self->warn("NCBI $eutil Errors/Warnings:\n".$err_warn)
!         # don't return as some data may still be useful
      }
      delete $self->{'_response'} unless $self->cache_response;
***************
*** 418,422 ****
  =head1 Bio::Tools::EUtilities::HistoryI methods
  
! These are defined in the HistoryI interface
  
  =head2 history
--- 421,425 ----
  =head1 Bio::Tools::EUtilities::HistoryI methods
  
! These are defined in the HistoryI interface.
  
  =head2 history
***************
*** 1026,1038 ****
      }
      $self->parse_data unless $self->data_parsed;
!     unless (exists $self->{'_db'}) {
          my %temp;
          # make sure unique db is returned
          # do the linksets have a db? (URLs, db checks do not)
          
!         push @{$self->{'_db'}}, map {$_->get_dbto}
              grep { $_->get_dbto ? !$temp{$_->get_dbto}++: 0 } $self->get_LinkSets;
      }
!     return @{$self->{'_db'}};
  }
  
--- 1029,1064 ----
      }
      $self->parse_data unless $self->data_parsed;
!     unless (exists $self->{'_linked_db'}) {
          my %temp;
          # make sure unique db is returned
          # do the linksets have a db? (URLs, db checks do not)
          
!         push @{$self->{'_linked_db'}}, map {$_->get_dbto}
              grep { $_->get_dbto ? !$temp{$_->get_dbto}++: 0 } $self->get_LinkSets;
      }
!     return @{$self->{'_linked_db'}};
! }
! 
! =head2 get_linked_histories
! 
!  Title    : get_linked_histories
!  Usage    : my @hist = $eutil->get_linked_histories
!  Function : returns list of LinkSets that have a history
!  Returns  : array of LinkSets
!  Args     : none
! 
! =cut
! 
! sub get_linked_histories {
!     my $self = shift;
!     if ($self->is_lazy) {
!         $self->warn('get_linked_histories() not implemented when using lazy mode');
!         return ();
!     }
!     $self->parse_data unless $self->data_parsed;
!     unless (exists $self->{'_dbhist'}) {
!         push @{$self->{'_dbhist'}}, grep {$_->has_history} $self->get_LinkSets;
!     }
!     return @{$self->{'_dbhist'}};
  }
  
***************
*** 1136,1141 ****
      my $cb = $self->callback;
      if ($self->is_lazy) {
          return sub {
!             while (my $obj = $self->parse_chunk) {
                  if ($cb) {
                      ($cb->($obj)) ? return $obj : next;
--- 1162,1172 ----
      my $cb = $self->callback;
      if ($self->is_lazy) {
+         my $type = $self->eutil eq 'esummary' ? '_docsums' : '_linksets';
+         $self->{$type} = [];
          return sub {
!             if (!@{$self->{$type}}) {
!                 $self->parse_chunk; # fill the queue
!             }
!             while (my $obj = shift @{$self->{$type}}) {
                  if ($cb) {
                      ($cb->($obj)) ? return $obj : next;



More information about the Bioperl-guts-l mailing list