[Bioperl-guts-l] [16599] bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/ SoapEUtilities.pm: working on autofetch
Mark Allen Jensen
maj at dev.open-bio.org
Tue Jan 5 14:01:42 EST 2010
Revision: 16599
Author: maj
Date: 2010-01-05 14:01:41 -0500 (Tue, 05 Jan 2010)
Log Message:
-----------
working on autofetch
Modified Paths:
--------------
bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/SoapEUtilities.pm
Modified: bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/SoapEUtilities.pm
===================================================================
--- bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/SoapEUtilities.pm 2010-01-05 19:01:03 UTC (rev 16598)
+++ bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/SoapEUtilities.pm 2010-01-05 19:01:41 UTC (rev 16599)
@@ -97,8 +97,9 @@
sub new {
my ($class, at args) = @_;
my $self = $class->SUPER::new(@args);
+ my ($db) = $self->_rearrange( [qw( DB )], @args );
+ $self->{db} = $db;
-
return $self;
}
@@ -122,13 +123,15 @@
$self->throw("run method requires named arguments") if @args % 2;
$self->throw("call run method like '\$fac->\$eutility->run(\@args)") unless
$self->_caller_util;
- my ($autofetch, $raw_xml) = $self->_rearrange( [qw( AUTOFETCH RAW_XML )],
+ my ($autofetch, $raw_xml) = $self->_rearrange( [qw( AUTOFETCH RAW_XML)],
@args );
my %args = @args;
delete $args{'-autofetch'};
delete $args{'-AUTOFETCH'};
delete $args{'-raw_xml'};
delete $args{'-RAW_XML'};
+ # add tool argument for NCBI records
+ $args{tool} = "SoapEUtilities(BioPerl)";
my $util = $self->_caller_util;
$self->set_parameters(%args) if %args;
$self->_soap_facs($util)->_client->outputxml($raw_xml);
@@ -155,8 +158,29 @@
$self->{'_WebEnv'} = $som->valueof("//WebEnv");
# success, parse it out
- if ($autofetch) {
+ if ($autofetch and $self->_caller_util ne 'efetch') {
# do an efetch with the same db and a returned list of ids...
+ # reentering here!
+ $DB::single =1;
+ my $result = Bio::Tools::Run::SoapEUtilities::Result->new($self);
+ my $ids = $result->ids;
+ if (!$result->count) {
+ $self->warn("Can't fetch; no records returned");
+ return $result;
+ }
+ if (!$result->ids) {
+ $self->warn("Can't fetch; no id list returned");
+ return $result;
+ }
+ if ( !$self->db ) {
+ my %h = $self->get_parameters;
+ $self->{db} = $h{db} || $h{DB};
+ }
+ my $fetched = $self->efetch( -db => $self->db,
+ -id => $ids )->run();
+ 1;
+
+
}
else {
return Bio::Tools::Run::SoapEUtilities::Result->new($self);
@@ -166,7 +190,6 @@
=head2 Useful Accessors
-
=head2 response_message()
Title : response_message
@@ -208,6 +231,20 @@
=cut
+
+
+=head2 db()
+
+ Title : db
+ Usage :
+ Function: the current NCBI database
+ Returns : scalar string
+ Args : none
+
+=cut
+
+sub db { shift->{'db'} }
+
sub errstr { shift->{'errstr'} }
More information about the Bioperl-guts-l
mailing list