Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of github.com:bioperl/bioperl-live

  • Loading branch information...
commit e0e6cf811b47946e4622f294ed7419f40b304491 2 parents 7344785 + fe79811
@bosborne bosborne authored
Showing with 1,675 additions and 14,551 deletions.
  1. +1 −0  .travis.yml
  2. +41 −41 Bio/Biblio.pm
  3. +6 −12 Bio/DB/Ace.pm
  4. +105 −111 Bio/DB/Biblio/biofetch.pm
  5. +182 −187 Bio/DB/Biblio/soap.pm
  6. +12 −12 Bio/DB/GenBank.pm
  7. +0 −372 Bio/DB/GenericWebAgent.pm
  8. +1 −1  Bio/DB/IndexedBase.pm
  9. +25 −25 Bio/DB/NCBIHelper.pm
  10. +24 −17 Bio/DB/SeqFeature/Store/berkeleydb.pm
  11. +2 −1  Bio/DB/SeqVersion/gi.pm
  12. +41 −41 Bio/DB/WebDBSeqI.pm
  13. +0 −533 Bio/FeatureIO.pm
  14. +0 −245 Bio/FeatureIO/bed.pm
  15. +0 −996 Bio/FeatureIO/gff.pm
  16. +0 −85 Bio/FeatureIO/gtf.pm
  17. +0 −217 Bio/FeatureIO/interpro.pm
  18. +0 −269 Bio/FeatureIO/ptt.pm
  19. +0 −186 Bio/FeatureIO/vecscreen_simple.pm
  20. +218 −225 Bio/Perl.pm
  21. +9 −9 Bio/Root/Test.pm
  22. +0 −354 Bio/SearchIO/Writer/BSMLResultWriter.pm
  23. +0 −315 Bio/SearchIO/XML/BlastHandler.pm
  24. +0 −312 Bio/SearchIO/XML/PsiBlastHandler.pm
  25. +0 −474 Bio/SearchIO/blastxml.pm
  26. +4 −4 Bio/SearchIO/hmmer2.pm
  27. +0 −1,381 Bio/SeqFeature/Annotated.pm
  28. +2 −1  Bio/SeqIO.pm
  29. +1 −1  Bio/SeqIO/chadoxml.pm
  30. +78 −35 Bio/SeqIO/fasta.pm
  31. +574 −590 Bio/SeqUtils.pm
  32. +4 −1 Bio/Tools/Geneid.pm
  33. +4 −2 Bio/Tools/GuessSeqFormat.pm
  34. +0 −3  Build.PL
  35. +24 −4 Changes
  36. +5 −2 examples/biblio/biblio-eutils-example.pl
  37. +2 −2 examples/db/getGenBank.pl
  38. +0 −106 scripts/Bio-DB-EUtilities/bp_einfo.pl
  39. +0 −1,065 scripts/Bio-DB-EUtilities/bp_genbank_ref_extractor.pl
  40. +6 −5 scripts/utilities/bp_download_query_genbank.pl
  41. +0 −70 scripts/utilities/bp_search2BSML.pl
  42. +1 −1  t/AlignIO/phylip.t
  43. +6 −6 t/Annotation/Annotation.t
  44. +1 −1  t/Assembly/ContigSpectrum.t
  45. +20 −20 t/RemoteDB/GenBank.t
  46. +7 −8 t/RemoteDB/GenPept.t
  47. +1 −1  t/RemoteDB/SwissProt.t
  48. +49 −40 t/RemoteDB/Taxonomy.t
  49. +0 −531 t/SearchIO/blastxml.t
  50. +24 −1 t/SearchIO/hmmer.t
  51. +0 −106 t/SeqFeature/Annotated.t
  52. +0 −363 t/SeqFeature/FeatureIO.t
  53. +15 −15 t/SeqIO/genbank.t
  54. +0 −1  t/data/1.bed
  55. +0 −7 t/data/directives.gff3
  56. +0 −610 t/data/ecoli_domains.rps.xml
  57. +74 −0 t/data/hmmpfam_HSPdashline.txt
  58. +106 −0 t/data/hmmpfam_multiresult.out
  59. +0 −11 t/data/hybrid1.gff3
  60. +0 −17 t/data/knownGene.gff3
  61. +0 −660 t/data/mus.bls.xml
  62. +0 −1,219 t/data/newblast.xml
  63. +0 −383 t/data/plague_yeast.bls.xml
  64. +0 −1,826 t/data/psiblast.xml
  65. +0 −370 t/data/test.ptt
  66. +0 −42 t/data/vecscreen_simple.test_output
View
1  .travis.yml
@@ -36,3 +36,4 @@ notifications:
branches:
only:
- master
+ - v1
View
82 Bio/Biblio.pm
@@ -198,8 +198,8 @@ with an underscore _.
package Bio::Biblio;
use strict;
-
-use base qw(Bio::Root::Root Bio::DB::BiblioI);
+use warnings;
+use parent qw(Bio::Root::Root Bio::DB::BiblioI);
# -----------------------------------------------------------------------------
@@ -259,20 +259,20 @@ sub new {
# we want to call SUPER to create and bless an object
if ($class =~ /Bio::DB::Biblio::(\S+)/) {
- my ($self) = $class->SUPER::new (@args);
+ my ($self) = $class->SUPER::new (@args);
- # now the $self is an empty object - we will populate it from
- # the $caller - if $caller is an object
+ # now the $self is an empty object - we will populate it from
+ # the $caller - if $caller is an object
- if (ref ($caller)) {
- %{ $self } = %{ $caller };
- }
+ if (ref ($caller)) {
+ %{ $self } = %{ $caller };
+ }
- # and finally add values from '@args' into the newly created
- # object (the values will overwrite the values copied above)
+ # and finally add values from '@args' into the newly created
+ # object (the values will overwrite the values copied above)
- $self->_initialize (@args);
- return $self;
+ $self->_initialize (@args);
+ return $self;
# this is called only the first time when somebody calls: 'new
# Bio::Biblio (...)', and it actually loads a 'real-work-doing'
@@ -280,20 +280,20 @@ sub new {
# module has its own new() method)
} else {
- my %param = @args;
- @param { map { lc $_ } keys %param } = values %param; # lowercase keys
- my $access =
- $param {'-access'} ||
- $class->_guess_access ( $param {'-location'} ) ||
- 'soap';
- $access = "\L$access"; # normalize capitalization to lower case
-
- # load module with the real implementation - as defined in $access
- return unless (&_load_access_module ($access));
-
- # this will call this same method new() - but rather its the
- # upper (object) branche
- return "Bio::DB::Biblio::$access"->new (@args);
+ my %param = @args;
+ @param { map { lc $_ } keys %param } = values %param; # lowercase keys
+ my $access =
+ $param {'-access'} ||
+ $class->_guess_access ( $param {'-location'} ) ||
+ 'soap';
+ $access = "\L$access"; # normalize capitalization to lower case
+
+ # load module with the real implementation - as defined in $access
+ return unless (&_load_access_module ($access));
+
+ # this will call this same method new() - but rather its the
+ # upper (object) branche
+ return "Bio::DB::Biblio::$access"->new (@args);
}
}
@@ -316,27 +316,27 @@ It prints an error on STDERR if it fails to find and load the module
=cut
sub _load_access_module {
- my ($access) = @_;
- my ($module, $load, $m);
+ my ($access) = @_;
+ my ($module, $load, $m);
- $module = "_<Bio/DB/Biblio/$access.pm";
- $load = "Bio/DB/Biblio/$access.pm";
+ $module = "_<Bio/DB/Biblio/$access.pm";
+ $load = "Bio/DB/Biblio/$access.pm";
- return 1 if $main::{$module};
- eval {
- require $load;
- };
+ return 1 if $main::{$module};
+ eval {
+ require $load;
+ };
- if ( $@ ) {
- Bio::Root::Root->throw (<<END);
+ if ( $@ ) {
+ Bio::Root::Root->throw (<<END);
$load: $access cannot be found or loaded
Exception $@
For more information about the Biblio system please see the Bio::Biblio docs.
END
;
- return;
- }
- return 1;
+ return;
+ }
+ return 1;
}
# -----------------------------------------------------------------------------
@@ -361,8 +361,8 @@ CORBA).
# services
sub _guess_access {
-# my ($class, $location) = @_;
- return 'soap';
+# my ($class, $location) = @_;
+ return 'soap';
}
=head2 VERSION and Revision
View
18 Bio/DB/Ace.pm
@@ -2,7 +2,7 @@
#
# BioPerl module for Bio::DB::Ace
#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Ewan Birney <birney@ebi.ac.uk>
#
@@ -20,7 +20,7 @@ Bio::DB::Ace - Database object interface to ACeDB servers
$db = Bio::DB::Ace->new( -server => 'myace.server.com', port => '120000');
- $seq = $db->get_Seq_by_id('MUSIGHBA1'); # Unique ID
+ $seq = $db->get_Seq_by_id('J00522'); # Unique ID
# or ...
@@ -62,15 +62,15 @@ Your participation is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-=head2 Support
+=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
@@ -208,9 +208,3 @@ sub _aceobj {
}
1;
-
-
-
-
-
-
View
216 Bio/DB/Biblio/biofetch.pm
@@ -1,7 +1,7 @@
#
# BioPerl module Bio::DB::Biblio::biofetch.pm
#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
# For copyright and disclaimer see below.
@@ -10,7 +10,7 @@
=head1 NAME
-Bio::DB::Biblio::biofetch - A BioFetch-based access to a bibliographic
+Bio::DB::Biblio::biofetch - A BioFetch-based access to a bibliographic
citation retrieval
=head1 SYNOPSIS
@@ -24,7 +24,7 @@ I<Bio::Biblio> module:
my $ids = ['20063307', '98276153'];
my $refio = $biblio->get_all($ids);
- while ($ref = $refio->next_bibref) {
+ while ($ref = $refio->next_bibref) {
print $ref->identifier, "\n";
}
@@ -44,15 +44,15 @@ the Bioperl mailing list. Your participation is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-=head2 Support
+=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
@@ -103,32 +103,27 @@ with an underscore _.
package Bio::DB::Biblio::biofetch;
-use vars qw(%HOSTS %FORMATMAP $DEFAULTFORMAT $DEFAULTRETRIEVAL_TYPE
- $DEFAULT_SERVICE $DEFAULT_NAMESPACE);
use strict;
+use warnings;
use Bio::Biblio::IO;
-use base qw(Bio::DB::DBFetch Bio::Biblio);
-
-BEGIN {
-
- # you can add your own here theoretically.
- %HOSTS = (
- 'dbfetch' => {
- baseurl => 'http://%s/Tools/dbfetch/dbfetch?db=medline&style=raw',
- hosts => {
- 'ebi' => 'www.ebi.ac.uk'
- }
- }
- );
- %FORMATMAP = ( 'default' => 'medlinexml'
- );
- $DEFAULTFORMAT = 'medlinexml';
-
- $DEFAULT_SERVICE = 'http://www.ebi.ac.uk/Tools/dbfetch/dbfetch';
- $DEFAULTRETRIEVAL_TYPE = 'tempfile';
-}
+use parent qw(Bio::DB::DBFetch Bio::Biblio);
+
+# you can add your own here theoretically.
+our %HOSTS = (
+ 'dbfetch' => {
+ baseurl => 'http://%s/Tools/dbfetch/dbfetch?db=medline&style=raw',
+ hosts => {
+ 'ebi' => 'www.ebi.ac.uk'
+ }
+ }
+ );
+our %FORMATMAP = ( 'default' => 'medlinexml' );
+
+our $DEFAULT_SERVICE = 'http://www.ebi.ac.uk/Tools/dbfetch/dbfetch';
+our $DEFAULTRETRIEVAL_TYPE = 'tempfile';
+
sub new {
my ($class, @args ) = @_;
@@ -139,8 +134,8 @@ sub new {
$self->hosts(\%HOSTS);
$self->formatmap(\%FORMATMAP);
- $self->retrieval_type($DEFAULTRETRIEVAL_TYPE);
- $self->{'_default_format'} = $DEFAULTFORMAT;
+ $self->retrieval_type($DEFAULTRETRIEVAL_TYPE);
+ $self->{'_default_format'} = $FORMATMAP{'default'};
return $self;
}
@@ -167,8 +162,8 @@ sub get_by_id {
Title : get_all
Usage : $seq = $db->get_all($ref);
- Function: Retrieves reference objects from the server 'en masse',
- rather than one at a time. For large numbers of sequences,
+ Function: Retrieves reference objects from the server 'en masse',
+ rather than one at a time. For large numbers of sequences,
this is far superior than get_by_id().
Example :
Returns : a stream of Bio::Biblio::Medline objects
@@ -188,63 +183,62 @@ sub get_all {
Usage : my $seqio = $self->get_seq_stream(%qualifiers)
Function: builds a url and queries a web db
Returns : a Bio::SeqIO stream capable of producing sequence
- Args : %qualifiers = a hash qualifiers that the implementing class
- will process to make a url suitable for web querying
+ Args : %qualifiers = a hash qualifiers that the implementing class
+ will process to make a url suitable for web querying
=cut
sub get_seq_stream {
- my ($self, %qualifiers) = @_;
- my ($rformat, $ioformat) = $self->request_format();
- my $seen = 0;
- foreach my $key ( keys %qualifiers ) {
- if( $key =~ /format/i ) {
- $rformat = $qualifiers{$key};
- $seen = 1;
- }
- }
- $qualifiers{'-format'} = $rformat if( !$seen);
- ($rformat, $ioformat) = $self->request_format($rformat);
-
- my $request = $self->get_request(%qualifiers);
- my ($stream,$resp);
- if ( $self->retrieval_type =~ /temp/i ) {
- my $dir = $self->io()->tempdir( CLEANUP => 1);
- my ( $fh, $tmpfile) = $self->io()->tempfile( DIR => $dir );
- close $fh;
- my ($resp) = $self->_request($request, $tmpfile);
- if( ! -e $tmpfile || -z $tmpfile || ! $resp->is_success() ) {
- $self->throw("WebDBSeqI Error - check query sequences!\n");
- }
- $self->postprocess_data('type' => 'file',
- 'location' => $tmpfile);
- # this may get reset when requesting batch mode
- ($rformat,$ioformat) = $self->request_format();
- if ( $self->verbose > 0 ) {
- open(my $ERR, "<", $tmpfile);
- while(<$ERR>) { $self->debug($_);}
- }
- $stream = Bio::Biblio::IO->new('-format' => $ioformat,
- '-file' => $tmpfile);
- } elsif ( $self->retrieval_type =~ /io_string/i ) {
- my ($resp) = $self->_request($request);
- my $content = $resp->content_ref;
- $self->debug( "content is $$content\n");
- if( ! $resp->is_success() || length(${$resp->content_ref()}) == 0 ) {
- $self->throw("WebDBSeqI Error - check query sequences!\n");
- }
- ($rformat,$ioformat) = $self->request_format();
- $self->postprocess_data('type'=> 'string',
- 'location' => $content);
- $stream = Bio::Biblio::IO->new('-format' => $ioformat,
- # '-data' => "<tag>". $$content. "</tag>");
- '-data' => $$content
- );
- } else {
- $self->throw("retrieval type " . $self->retrieval_type .
- " unsupported\n");
- }
- return $stream;
+ my ($self, %qualifiers) = @_;
+ my ($rformat, $ioformat) = $self->request_format();
+ my $seen = 0;
+ foreach my $key ( keys %qualifiers ) {
+ if( $key =~ /format/i ) {
+ $rformat = $qualifiers{$key};
+ $seen = 1;
+ }
+ }
+ $qualifiers{'-format'} = $rformat if( !$seen);
+ ($rformat, $ioformat) = $self->request_format($rformat);
+
+ my $request = $self->get_request(%qualifiers);
+ my ($stream,$resp);
+ if ( $self->retrieval_type =~ /temp/i ) {
+ my $dir = $self->io()->tempdir( CLEANUP => 1);
+ my ( $fh, $tmpfile) = $self->io()->tempfile( DIR => $dir );
+ close $fh;
+ my ($resp) = $self->_request($request, $tmpfile);
+ if( ! -e $tmpfile || -z $tmpfile || ! $resp->is_success() ) {
+ $self->throw("WebDBSeqI Error - check query sequences!\n");
+ }
+ $self->postprocess_data('type' => 'file',
+ 'location' => $tmpfile);
+ # this may get reset when requesting batch mode
+ ($rformat,$ioformat) = $self->request_format();
+ if ( $self->verbose > 0 ) {
+ open(my $ERR, "<", $tmpfile);
+ while(<$ERR>) { $self->debug($_);}
+ }
+ $stream = Bio::Biblio::IO->new('-format' => $ioformat,
+ '-file' => $tmpfile);
+ } elsif ( $self->retrieval_type =~ /io_string/i ) {
+ my ($resp) = $self->_request($request);
+ my $content = $resp->content_ref;
+ $self->debug( "content is $$content\n");
+ if( ! $resp->is_success() || length(${$resp->content_ref()}) == 0 ) {
+ $self->throw("WebDBSeqI Error - check query sequences!\n");
+ }
+ ($rformat,$ioformat) = $self->request_format();
+ $self->postprocess_data('type'=> 'string',
+ 'location' => $content);
+ $stream = Bio::Biblio::IO->new('-format' => $ioformat,
+# '-data' => "<tag>". $$content. "</tag>");
+ '-data' => $$content
+ );
+ } else {
+ $self->throw("retrieval type " . $self->retrieval_type . " unsupported\n");
+ }
+ return $stream;
}
@@ -252,11 +246,11 @@ sub get_seq_stream {
Title : postprocess_data
Usage : $self->postprocess_data ( 'type' => 'string',
- 'location' => \$datastr);
+ 'location' => \$datastr);
Function: process downloaded data before loading into a Bio::SeqIO
Returns : void
Args : hash with two keys - 'type' can be 'string' or 'file'
- - 'location' either file location or string
+ - 'location' either file location or string
reference containing data
=cut
@@ -264,29 +258,29 @@ sub get_seq_stream {
# the default method, works for genbank/genpept, other classes should
# override it with their own method.
-sub postprocess_data {
- my ($self, %args) = @_;
- my ($data, $TMP);
- my $type = uc $args{'type'};
- my $location = $args{'location'};
- if( !defined $type || $type eq '' || !defined $location) {
- return;
- } elsif( $type eq 'STRING' ) {
- $data = $$location;
- } elsif ( $type eq 'FILE' ) {
- open($TMP, "<", $location) or $self->throw("could not open file $location");
- my @in = <$TMP>;
- $data = join("", @in);
- }
-
- if( $type eq 'FILE' ) {
- open($TMP, ">", $location) or $self->throw("could overwrite file $location");
- print $TMP $data;
- } elsif ( $type eq 'STRING' ) {
- ${$args{'location'}} = $data;
- }
-
- $self->debug("format is ". $self->request_format(). " data is $data\n");
+sub postprocess_data {
+ my ($self, %args) = @_;
+ my ($data, $TMP);
+ my $type = uc $args{'type'};
+ my $location = $args{'location'};
+ if( !defined $type || $type eq '' || !defined $location) {
+ return;
+ } elsif( $type eq 'STRING' ) {
+ $data = $$location;
+ } elsif ( $type eq 'FILE' ) {
+ open($TMP, "<", $location) or $self->throw("could not open file $location");
+ my @in = <$TMP>;
+ $data = join("", @in);
+ }
+
+ if( $type eq 'FILE' ) {
+ open($TMP, ">", $location) or $self->throw("could overwrite file $location");
+ print $TMP $data;
+ } elsif ( $type eq 'STRING' ) {
+ ${$args{'location'}} = $data;
+ }
+
+ $self->debug("format is ". $self->request_format(). " data is $data\n");
}
=head2 VERSION and Revision
View
369 Bio/DB/Biblio/soap.pm
@@ -1,7 +1,7 @@
#
# BioPerl module Bio::DB::Biblio::soap.pm
#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Martin Senger <senger@ebi.ac.uk>
# For copyright and disclaimer see below.
@@ -38,15 +38,15 @@ the Bioperl mailing list. Your participation is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-=head2 Support
+=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
@@ -108,31 +108,26 @@ with an underscore _.
package Bio::DB::Biblio::soap;
-use vars qw($DEFAULT_SERVICE $DEFAULT_NAMESPACE);
use strict;
+use warnings;
+use parent qw(Bio::Biblio);
use SOAP::Lite
on_fault => sub {
- my $soap = shift;
- my $res = shift;
- my $msg =
- ref $res ? "--- SOAP FAULT ---\n" . $res->faultcode . " " . $res->faultstring
- : "--- TRANSPORT ERROR ---\n" . $soap->transport->status . "\n$res\n";
+ my $soap = shift;
+ my $res = shift;
+ my $msg =
+ ref $res ? "--- SOAP FAULT ---\n" . $res->faultcode . " " . $res->faultstring
+ : "--- TRANSPORT ERROR ---\n" . $soap->transport->status . "\n$res\n";
Bio::DB::Biblio::soap->throw ( -text => $msg );
}
;
-use base qw(Bio::Biblio);
+# where to go...
+our $DEFAULT_SERVICE = 'http://www.ebi.ac.uk/openbqs/services/MedlineSRS';
-BEGIN {
- # where to go...
- $DEFAULT_SERVICE = 'http://www.ebi.ac.uk/openbqs/services/MedlineSRS';
-
- # ...and what to find there
-
- ## TODO: This namespace is no longer valid (check for deprecation or update)
- $DEFAULT_NAMESPACE = 'http://industry.ebi.ac.uk/openBQS';
-}
+## TODO: This namespace is no longer valid (check for deprecation or update)
+our $DEFAULT_NAMESPACE = 'http://industry.ebi.ac.uk/openBQS';
# -----------------------------------------------------------------------------
@@ -151,7 +146,7 @@ BEGIN {
## TODO: This namespace is no longer valid (check for deprecation
## or update)
-
+
Default is 'http://industry.ebi.ac.uk/openBQS'.
-destroy_on_exit => '0'
@@ -193,10 +188,10 @@ BEGIN {
to specify also a location/URL of a HTTP proxy server
(if your site requires one).
- Additionally, the main module Bio::Biblio recognises
- also:
- -access => '...'
- -location => '...'
+ Additionally, the main module Bio::Biblio recognises
+ also:
+ -access => '...'
+ -location => '...'
It populates calling object with the given arguments, and then - for
some attributes and only if they are not yet populated - it assigns
@@ -216,7 +211,7 @@ Bio::Biblio::new method, not this one.
sub _initialize {
my ($self, @args) = @_;
-
+
# make a hashtable from @args
my %param = @args;
@param { map { lc $_ } keys %param } = values %param; # lowercase keys
@@ -225,8 +220,8 @@ sub _initialize {
# there) - changing '-key' into '_key'
my $new_key;
foreach my $key (keys %param) {
- ($new_key = $key) =~ s/^-/_/;
- $self->{ $new_key } = $param { $key };
+ ($new_key = $key) =~ s/^-/_/;
+ $self->{ $new_key } = $param { $key };
}
# finally add default values for those keys who have default value
@@ -235,17 +230,17 @@ sub _initialize {
$self->{'_namespace'} = $DEFAULT_NAMESPACE unless $self->{'_namespace'};
$self->{'_destroy_on_exit'} = 1 unless defined $self->{'_destroy_on_exit'};
unless ($self->{'_soap'}) {
- if (defined $self->{'_httpproxy'}) {
- $self->{'_soap'} = SOAP::Lite
- -> uri ($self->{'_namespace'})
- -> proxy ($self->{'_location'},
- proxy => ['http' => $self->{'_httpproxy'}]);
- } else {
- $self->{'_soap'} = SOAP::Lite
- -> uri ($self->{'_namespace'})
- -> proxy ($self->{'_location'});
- }
-# $self->{'_soap'}->soapversion (1.2);
+ if (defined $self->{'_httpproxy'}) {
+ $self->{'_soap'} = SOAP::Lite
+ -> uri ($self->{'_namespace'})
+ -> proxy ($self->{'_location'},
+ proxy => ['http' => $self->{'_httpproxy'}]);
+ } else {
+ $self->{'_soap'} = SOAP::Lite
+ -> uri ($self->{'_namespace'})
+ -> proxy ($self->{'_location'});
+ }
+# $self->{'_soap'}->soapversion (1.2);
}
}
@@ -266,7 +261,7 @@ sub DESTROY {
# ignore all errors here
eval {
- $soap->destroy (SOAP::Data->type (string => $collection_id));
+ $soap->destroy (SOAP::Data->type (string => $collection_id));
}
}
@@ -289,7 +284,7 @@ or to obtain a collection ID indirectly from a query method:
\tBio::Biblio->new->find ('keyword')->$strip_method;
END_OF_MSG
}
-
+
#
# some methods do not work with older SOAP::Lite version; here we
#return message explaining it
@@ -330,7 +325,7 @@ Method '$method' expects vocabulary name as parameter.
END_OF_MSG
}
-#
+#
# return a copy of a given array, with all its elements replaced
# with the SOAP-Data objects defining elements type as 'string'
#
@@ -339,7 +334,7 @@ sub _as_strings {
my (@result) = map { SOAP::Data->new (type => 'string', value => $_) } @$ref_input_array;
return \@result;
}
-
+
# ---------------------------------------------------------------------
#
# Here are the methods implementing Bio::DB::BiblioI interface
@@ -348,198 +343,198 @@ sub _as_strings {
# ---------------------------------------------------------------------
sub get_collection_id {
- my ($self) = @_;
- $self->{'_collection_id'};
+ my ($self) = @_;
+ $self->{'_collection_id'};
}
sub get_count {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- if ($collection_id) {
- $soap->getBibRefCountOfCollection (SOAP::Data->type (string => $collection_id))->result;
- } else {
- $soap->getBibRefCount->result;
- }
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ if ($collection_id) {
+ $soap->getBibRefCountOfCollection (SOAP::Data->type (string => $collection_id))->result;
+ } else {
+ $soap->getBibRefCount->result;
+ }
}
# try: 12368254 (it's a Bioperl article)
sub get_by_id {
- my ($self, $citation_id) = @_;
- $self->throw ("Citation ID is expected as a parameter of method 'get_by_id'.")
- unless $citation_id;
- my $soap = $self->{'_soap'};
- $soap->getById (SOAP::Data->type (string => $citation_id))->result;
+ my ($self, $citation_id) = @_;
+ $self->throw ("Citation ID is expected as a parameter of method 'get_by_id'.")
+ unless $citation_id;
+ my $soap = $self->{'_soap'};
+ $soap->getById (SOAP::Data->type (string => $citation_id))->result;
}
sub find {
- my ($self, $keywords, $attrs) = @_;
- my (@keywords, @attrs);
-
- # $keywords can be a comma-delimited scalar or a reference to an array
- if ($keywords) {
- my $ref = ref $keywords;
- @keywords = split (/,/, $keywords) unless $ref;
- @keywords = @$keywords if $ref =~ /ARRAY/;
- }
- $self->throw ("No keywords given in 'find' method.\n")
- unless (@keywords);
-
- # ...and the same with $attrs
- if ($attrs) {
- my $ref = ref $attrs;
- @attrs = split (/,/, $attrs) unless $ref;
- @attrs = @$attrs if $ref =~ /ARRAY/;
- }
-
- my $soap = $self->{'_soap'};
- my $collection_id = $self->{'_collection_id'};
- my $new_id;
- if ($collection_id) {
- if (@attrs) {
- $new_id = $soap->reFindInAttrs (SOAP::Data->name ('arg0')->type (string => $collection_id),
- SOAP::Data->name ('arg1')->value (&_as_strings (\@keywords)),
- SOAP::Data->name ('arg2')->value (&_as_strings (\@attrs)))
- ->result;
- } else {
- $new_id = $soap->reFind (SOAP::Data->name ('arg0')->type (string => $collection_id),
- SOAP::Data->name ('arg1')->value (&_as_strings (\@keywords)))
- ->result;
- }
- } else {
- if (@attrs) {
- $new_id = $soap->findInAttrs (SOAP::Data->name ('arg0')->value (&_as_strings (\@keywords)),
- SOAP::Data->name ('arg1')->value (&_as_strings (\@attrs)))
- ->result;
- } else {
- $new_id = $soap->find (SOAP::Data->name ('arg0')->value (&_as_strings (\@keywords)))
- ->result;
- }
- }
-
- # clone itself but change the collection ID to a new one
- return $self->new (-collection_id => $new_id,
- -parent_collection_id => $collection_id);
+ my ($self, $keywords, $attrs) = @_;
+ my (@keywords, @attrs);
+
+ # $keywords can be a comma-delimited scalar or a reference to an array
+ if ($keywords) {
+ my $ref = ref $keywords;
+ @keywords = split (/,/, $keywords) unless $ref;
+ @keywords = @$keywords if $ref =~ /ARRAY/;
+ }
+ $self->throw ("No keywords given in 'find' method.\n")
+ unless (@keywords);
+
+ # ...and the same with $attrs
+ if ($attrs) {
+ my $ref = ref $attrs;
+ @attrs = split (/,/, $attrs) unless $ref;
+ @attrs = @$attrs if $ref =~ /ARRAY/;
+ }
+
+ my $soap = $self->{'_soap'};
+ my $collection_id = $self->{'_collection_id'};
+ my $new_id;
+ if ($collection_id) {
+ if (@attrs) {
+ $new_id = $soap->reFindInAttrs (SOAP::Data->name ('arg0')->type (string => $collection_id),
+ SOAP::Data->name ('arg1')->value (&_as_strings (\@keywords)),
+ SOAP::Data->name ('arg2')->value (&_as_strings (\@attrs)))
+ ->result;
+ } else {
+ $new_id = $soap->reFind (SOAP::Data->name ('arg0')->type (string => $collection_id),
+ SOAP::Data->name ('arg1')->value (&_as_strings (\@keywords)))
+ ->result;
+ }
+ } else {
+ if (@attrs) {
+ $new_id = $soap->findInAttrs (SOAP::Data->name ('arg0')->value (&_as_strings (\@keywords)),
+ SOAP::Data->name ('arg1')->value (&_as_strings (\@attrs)))
+ ->result;
+ } else {
+ $new_id = $soap->find (SOAP::Data->name ('arg0')->value (&_as_strings (\@keywords)))
+ ->result;
+ }
+ }
+
+ # clone itself but change the collection ID to a new one
+ return $self->new (-collection_id => $new_id,
+ -parent_collection_id => $collection_id);
}
sub get_all_ids {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
- $soap->getAllIDs (SOAP::Data->type (string => $collection_id))->result;
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+ $soap->getAllIDs (SOAP::Data->type (string => $collection_id))->result;
}
sub get_all {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
- $soap->getAllBibRefs (SOAP::Data->type (string => $collection_id))->result;
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+ $soap->getAllBibRefs (SOAP::Data->type (string => $collection_id))->result;
}
sub has_next {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
- $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION lt '0.52';
- $soap->hasNext (SOAP::Data->type (string => $collection_id))->result;
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+ $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION lt '0.52';
+ $soap->hasNext (SOAP::Data->type (string => $collection_id))->result;
}
sub get_next {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
- $soap->getNext (SOAP::Data->type (string => $collection_id))->result;
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+ $soap->getNext (SOAP::Data->type (string => $collection_id))->result;
}
sub get_more {
- my ($self, $how_many) = @_;
- my $soap = $self->{'_soap'};
- my $collection_id = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
-
- unless (defined ($how_many) and $how_many =~ /^\d+$/) {
- $self->warn ("Method 'get_more' expects a numeric argument. Changing to 1.\n");
- $how_many = 1;
- }
- unless ($how_many > 0) {
- $self->warn ("Method 'get_more' expects a positive argument. Changing to 1.\n");
- $how_many = 1;
- }
-
- my $ra = $soap->getMore (SOAP::Data->type (string => $collection_id),
- SOAP::Data->type (int => $how_many))->result;
- $self->{'_collection_id'} = shift @{ $ra };
- $ra;
+ my ($self, $how_many) = @_;
+ my $soap = $self->{'_soap'};
+ my $collection_id = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+
+ unless (defined ($how_many) and $how_many =~ /^\d+$/) {
+ $self->warn ("Method 'get_more' expects a numeric argument. Changing to 1.\n");
+ $how_many = 1;
+ }
+ unless ($how_many > 0) {
+ $self->warn ("Method 'get_more' expects a positive argument. Changing to 1.\n");
+ $how_many = 1;
+ }
+
+ my $ra = $soap->getMore (SOAP::Data->type (string => $collection_id),
+ SOAP::Data->type (int => $how_many))->result;
+ $self->{'_collection_id'} = shift @{ $ra };
+ $ra;
}
sub reset_retrieval {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
- $self->{'_collection_id'} = $soap->resetRetrieval (SOAP::Data->type (string => $collection_id))->result;
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+ $self->{'_collection_id'} = $soap->resetRetrieval (SOAP::Data->type (string => $collection_id))->result;
}
sub exists {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
- $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION lt '0.52';
- $soap->exists (SOAP::Data->type (string => $collection_id))->result;
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+ $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION lt '0.52';
+ $soap->exists (SOAP::Data->type (string => $collection_id))->result;
}
sub destroy {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- my ($collection_id) = $self->{'_collection_id'};
- $self->throw ($self->_no_id_msg) unless $collection_id;
- $soap->destroy (SOAP::Data->type (string => $collection_id));
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ my ($collection_id) = $self->{'_collection_id'};
+ $self->throw ($self->_no_id_msg) unless $collection_id;
+ $soap->destroy (SOAP::Data->type (string => $collection_id));
}
sub get_vocabulary_names {
- my ($self) = @_;
- my $soap = $self->{'_soap'};
- $soap->getAllVocabularyNames->result;
+ my ($self) = @_;
+ my $soap = $self->{'_soap'};
+ $soap->getAllVocabularyNames->result;
}
sub contains {
- my ($self, $vocabulary_name, $value) = @_;
- my $soap = $self->{'_soap'};
- $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION lt '0.52';
- $self->throw ($self->_two_params_msg)
- unless defined $vocabulary_name and defined $value;
- $soap->contains (SOAP::Data->type (string => $vocabulary_name),
- SOAP::Data->type (string => $value))->result;
+ my ($self, $vocabulary_name, $value) = @_;
+ my $soap = $self->{'_soap'};
+ $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION lt '0.52';
+ $self->throw ($self->_two_params_msg)
+ unless defined $vocabulary_name and defined $value;
+ $soap->contains (SOAP::Data->type (string => $vocabulary_name),
+ SOAP::Data->type (string => $value))->result;
}
sub get_entry_description {
- my ($self, $vocabulary_name, $value) = @_;
- my $soap = $self->{'_soap'};
- $self->throw ($self->_two_params_msg)
- unless defined $vocabulary_name and defined $value;
- $soap->getEntryDescription (SOAP::Data->type (string => $vocabulary_name),
- SOAP::Data->type (string => $value))->result;
+ my ($self, $vocabulary_name, $value) = @_;
+ my $soap = $self->{'_soap'};
+ $self->throw ($self->_two_params_msg)
+ unless defined $vocabulary_name and defined $value;
+ $soap->getEntryDescription (SOAP::Data->type (string => $vocabulary_name),
+ SOAP::Data->type (string => $value))->result;
}
sub get_all_values {
- my ($self, $vocabulary_name) = @_;
- my $soap = $self->{'_soap'};
- $self->throw ($self->_missing_name_msg)
- unless defined $vocabulary_name;
- $soap->getAllValues (SOAP::Data->type (string => $vocabulary_name))->result;
+ my ($self, $vocabulary_name) = @_;
+ my $soap = $self->{'_soap'};
+ $self->throw ($self->_missing_name_msg)
+ unless defined $vocabulary_name;
+ $soap->getAllValues (SOAP::Data->type (string => $vocabulary_name))->result;
}
sub get_all_entries {
- my ($self, $vocabulary_name) = @_;
- my $soap = $self->{'_soap'};
- $self->throw ($self->_missing_name_msg)
- unless defined $vocabulary_name;
- $soap->getAllEntries (SOAP::Data->type (string => $vocabulary_name))->result;
+ my ($self, $vocabulary_name) = @_;
+ my $soap = $self->{'_soap'};
+ $self->throw ($self->_missing_name_msg)
+ unless defined $vocabulary_name;
+ $soap->getAllEntries (SOAP::Data->type (string => $vocabulary_name))->result;
}
=head2 VERSION and Revision
View
24 Bio/DB/GenBank.pm
@@ -1,7 +1,7 @@
#
# BioPerl module for Bio::DB::GenBank
#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Aaron Mackey <amackey@virginia.edu>
#
@@ -10,7 +10,7 @@
# You may distribute this module under the same terms as perl itself
#
# POD documentation - main docs before the code
-#
+#
# Added LWP support - Jason Stajich 2000-11-6
# completely reworked by Jason Stajich 2000-12-8
# to use WebDBSeqI
@@ -32,7 +32,7 @@ Bio::DB::GenBank - Database object interface to GenBank
use Bio::DB::GenBank;
$gb = Bio::DB::GenBank->new();
- $seq = $gb->get_Seq_by_id('MUSIGHBA1'); # Unique ID
+ $seq = $gb->get_Seq_by_id('J00522'); # Unique ID, *not always the LOCUS ID*
# or ...
@@ -56,11 +56,11 @@ Bio::DB::GenBank - Database object interface to GenBank
# also don't want features, just sequence so let's save bandwith
# and request Fasta sequence
- $gb = Bio::DB::GenBank->new(-retrievaltype => 'tempfile' ,
+ $gb = Bio::DB::GenBank->new(-retrievaltype => 'tempfile' ,
-format => 'Fasta');
my $seqio = $gb->get_Stream_by_acc(['AC013798', 'AC021953'] );
while( my $clone = $seqio->next_seq ) {
- print "cloneid is ", $clone->display_id, " ",
+ print "cloneid is ", $clone->display_id, " ",
$clone->accession_number, "\n";
}
# note that get_Stream_by_version is not implemented
@@ -130,15 +130,15 @@ of the Bioperl mailing lists. Your participation is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-=head2 Support
+=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
@@ -169,7 +169,7 @@ use strict;
use vars qw(%PARAMSTRING $DEFAULTFORMAT $DEFAULTMODE);
use base qw(Bio::DB::NCBIHelper);
-BEGIN {
+BEGIN {
$DEFAULTMODE = 'single';
$DEFAULTFORMAT = 'gbwithparts';
%PARAMSTRING = (
@@ -191,7 +191,7 @@ BEGIN {
'usehistory' => 'n',
'tool' => 'bioperl',
'retmode' => 'text'},
- 'webenv' => {
+ 'webenv' => {
'query_key' => 'querykey',
'WebEnv' => 'cookie',
'db' => 'nucleotide',
@@ -352,7 +352,7 @@ instead.
Title : get_request
Usage : my $url = $self->get_request
Function: HTTP::Request
- Returns :
+ Returns :
Args : %qualifiers = a hash of qualifiers (ids, format, etc)
=cut
View
372 Bio/DB/GenericWebAgent.pm
@@ -1,372 +0,0 @@
-#
-# BioPerl module for Bio::DB::GenericWebAgent
-#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
-#
-# Cared for by Chris Fields <cjfields at bioperl dot org>
-#
-# Copyright Chris Fields
-#
-# You may distribute this module under the same terms as perl itself
-#
-# POD documentation - main docs before the code
-#
-# Interfaces with new GenericWebAgent interface
-
-=head1 NAME
-
-Bio::DB::GenericWebAgent - helper base class for parameter-based remote server
-access and response retrieval.
-
-=head1 SYNOPSIS
-
- # DO NOT USE DIRECTLY
-
- See Bio::DB::EUtilities for an example implementation
-
-=head1 DESCRIPTION
-
-WARNING: Please do B<NOT> spam the web servers with multiple requests.
-
-Bio::DB::GenericWebAgent is a generic wrapper around a web agent
-(LWP::UserAgent), an object which can retain, format, and build parameters for
-the user agent (Bio::ParameterBaseI), and a BioPerl class parser that processes
-response content received by the user agent. The Bio::ParameterBaseI object
-should be state-aware, e.g. know when changes occur to parameters, so that
-identical requests are not repeatedly sent to the server (this base class takes
-this into consideration).
-
-=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 one
-of the Bioperl mailing lists. Your participation
-is much appreciated.
-
- bioperl-l@lists.open-bio.org - General discussion
- http://www.bioperl.org/wiki/Mailing_lists - About the mailing lists
-
-=head2 Support
-
-Please direct usage questions or support issues to the mailing list:
-
-I<bioperl-l@bioperl.org>
-
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
-with code and data examples if at all possible.
-
-=head2 Reporting Bugs
-
-Report bugs to the Bioperl bug tracking system to
-help us keep track the bugs and their resolution.
-Bug reports can be submitted via the web.
-
- https://redmine.open-bio.org/projects/bioperl/
-
-=head1 AUTHOR
-
-Email cjfields at bioperl dot org
-
-=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::DB::GenericWebAgent;
-use strict;
-use warnings;
-use base qw(Bio::Root::Root);
-use LWP::UserAgent;
-
-my $LAST_INVOCATION_TIME = 0;
-
-my $TIME_HIRES = 0;
-
-BEGIN {
- eval {
- use Time::HiRes;
- };
- unless ($@) {
- $TIME_HIRES = 1;
- }
-}
-
-=head2 new
-
- Title : new
- Usage : Bio::DB::GenericWebAgent->new(@args);
- Function: Create new Bio::DB::GenericWebAgent instance.
- Returns :
- Args : None specific to this base class. Inheriting classes will
- likely set specific parameters in their constructor;
- Bio::DB::GenericWebAgent is primarily a test bed.
-
-=cut
-
-sub new {
- my ($class, @args) = @_;
- my $self = $class->SUPER::new(@args);
- $self->ua(LWP::UserAgent->new(env_proxy => 1,
- agent => ref($self)));
- $self->delay($self->delay_policy);
- return $self;
-}
-
-=head1 GenericWebAgent methods
-
-=head2 parameter_base
-
- Title : parameter_base
- Usage : $dbi->parameter_base($pobj);
- Function: Get/Set Bio::ParameterBaseI.
- Returns : Bio::ParameterBaseI object
- Args : Bio::ParameterBaseI object
-
-=cut
-
-# this will likely be overridden in subclasses
-
-sub parameter_base {
- my ($self, $pobj) = @_;
- if ($pobj) {
- $self->throw('Not a Bio::ParameterBaseI')
- if !$pobj->isa('Bio::ParameterBaseI');
- $self->{'_parameter_base'} = $pobj;
- }
- return $self->{'_parameter_base'};
-}
-
-=head2 ua
-
- Title : ua
- Usage : $dbi->ua;
- Function: Get/Set LWP::UserAgent.
- Returns : LWP::UserAgent
- Args : LWP::UserAgent
-
-=cut
-
-sub ua {
- my ($self, $ua) = @_;
- if( defined $ua && $ua->isa("LWP::UserAgent") ) {
- $self->{'_ua'} = $ua;
- }
- return $self->{'_ua'};
-}
-
-=head2 get_Response
-
- Title : get_Response
- Usage : $agent->get_Response;
- Function: Get the HTTP::Response object by passing it an HTTP::Request (generated from
- Bio::ParameterBaseI implementation).
- Returns : HTTP::Response object or data if callback is used
- Args : (optional)
-
- -cache_response - flag to cache HTTP::Response object;
- Default is 1 (TRUE, caching ON)
-
- These are passed on to LWP::UserAgent::request() if stipulated
-
- -cb - use a LWP::UserAgent-compliant callback
- -file - dumps the response to a file (handy for large responses)
- Note: can't use file and callback at the same time
- -read_size_hint - bytes of content to read in at a time to pass to callback
- Note : Caching and parameter checking are set
-
-=cut
-
-# TODO deal with small state-related bug with file
-
-sub get_Response {
- my ($self, @args) = @_;
- my ($cache, $file, $cb, $size) = $self->_rearrange([qw(CACHE_RESPONSE FILE CB READ_SIZE_HINT)],@args);
- $self->throw("Can't have both callback and file") if $file && $cb;
- # make -file accept more perl-like write-append type data.
- $file =~ s{^>}{} if $file;
- my @opts = grep {defined $_} ($file || $cb, $size);
- $cache = (defined $cache && $cache == 0) ? 0 : 1;
- my $pobj = $self->parameter_base;
- if ($pobj->parameters_changed ||
- !$cache ||
- !$self->{_response_cache} ||
- !$self->{_response_cache}->content) {
- my $ua = $self->ua;
- $self->_sleep; # institute delay policy
- $self->throw('No parameter object set; cannot form a suitable remote request') unless $pobj;
- my $request = $pobj->to_request;
- if ($self->authentication) {
- $request->proxy_authorization_basic($self->authentication)
- }
- $self->debug("Request is: \n",$request->as_string);
- # I'm relying on the useragent to throw the proper errors here
- my $response = $ua->request($request, @opts);
- if ($response->is_error) {
- $self->throw("Response Error\n".$response->message);
- }
- return $self->{_response_cache} = $response;
- } else {
- $self->debug("Returning cached HTTP::Response object\n");
- if ($file) {
- $self->_dump_request_content($file);
- # size isn't passed here, as the content is completely retrieved above
- } elsif ($cb) {
- $cb && ref($cb) eq 'CODE' && $cb->($self->{_response_cache}->content);
- }
- return $self->{_response_cache};
- }
-}
-
-=head2 get_Parser
-
- Title : get_Parser
- Usage : $agent->get_Parser;
- Function: Return HTTP::Response content (file, fh, object) attached to defined parser
- Returns : None
- Args : None
- Note : Abstract method; defined by implementation
-
-=cut
-
-sub get_Parser {
- shift->throw_not_implemented;
-}
-
-=head2 delay
-
- Title : delay
- Usage : $secs = $self->delay($secs)
- Function: get/set number of seconds to delay between fetches
- Returns : number of seconds to delay
- Args : new value
-
-NOTE: the default is to use the value specified by delay_policy().
-This can be overridden by calling this method.
-
-=cut
-
-sub delay {
- my $self = shift;
- return $self->{'_delay'} = shift if @_;
- return $self->{'_delay'};
-}
-
-=head2 delay_policy
-
- Title : delay_policy
- Usage : $secs = $self->delay_policy
- Function: return number of seconds to delay between calls to remote db
- Returns : number of seconds to delay
- Args : none
-
-NOTE: The default delay policy is 3s. Override in subclasses to
-implement delays. The timer has only second resolution, so the delay
-will actually be +/- 1s.
-
-=cut
-
-sub delay_policy {
- my $self = shift;
- return 3;
-}
-
-=head2 _sleep
-
- Title : _sleep
- Usage : $self->_sleep
- Function: sleep for a number of seconds indicated by the delay policy
- Returns : none
- Args : none
-
-NOTE: This method keeps track of the last time it was called and only
-imposes a sleep if it was called more recently than the delay_policy()
-allows.
-
-=cut
-
-sub _sleep {
- my $self = shift;
- my $last_invocation = $LAST_INVOCATION_TIME;
- if (time - $LAST_INVOCATION_TIME < $self->delay) {
- my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
- $self->debug("sleeping for $delay seconds\n");
- if ($TIME_HIRES) {
- # allows precise sleep timeout (builtin only allows integer seconds)
- Time::HiRes::sleep($delay);
- } else {
- # allows precise sleep timeout (builtin only allows integer seconds)
-
- # I hate this hack , but needed if we support 5.6.1 and
- # don't want additional Time::HiRes prereq
- select undef, undef, undef, $delay;
- }
- }
- $LAST_INVOCATION_TIME = time;
-}
-
-=head1 LWP::UserAgent related methods
-
-=head2 proxy
-
- Title : proxy
- Usage : $httpproxy = $db->proxy('http') or
- $db->proxy(['http','ftp'], 'http://myproxy' )
- Function: Get/Set a proxy for use of proxy
- Returns : a string indicating the proxy
- Args : $protocol : an array ref of the protocol(s) to set/get
- $proxyurl : url of the proxy to use for the specified protocol
- $username : username (if proxy requires authentication)
- $password : password (if proxy requires authentication)
-
-=cut
-
-sub proxy {
- my ($self,$protocol,$proxy,$username,$password) = @_;
- return if ( !defined $protocol || !defined $proxy );
- $self->authentication($username, $password)
- if ($username && $password);
- return $self->ua->proxy($protocol,$proxy);
-}
-
-=head2 authentication
-
- Title : authentication
- Usage : $db->authentication($user,$pass)
- Function: Get/Set authentication credentials
- Returns : Array of user/pass
- Args : Array or user/pass
-
-=cut
-
-sub authentication{
- my ($self,$u,$p) = @_;
- if( defined $u && defined $p ) {
- $self->{'_authentication'} = [ $u,$p];
- }
- $self->{'_authentication'} && return @{$self->{'_authentication'}};
-}
-
-# private method to dump any cached request data content into a passed filename
-
-sub _dump_request_content {
- my ($self, $file) = @_;
- return unless defined $self->{_response_cache};
- $self->throw("Must pass file name") unless $file;
- require Bio::Root::IO;
- my $out = Bio::Root::IO->new(-file => ">$file");
- $out->_print($self->{_response_cache}->content);
- $out->flush();
- $out->close;
-}
-
-1;
View
2  Bio/DB/IndexedBase.pm
@@ -527,7 +527,7 @@ sub index_name {
Title : path
Usage : my $path = $db->path($path);
- Function: When a simple file or a directory of files is indexed, this returns
+ Function: When a single file or a directory of files is indexed, this returns
the file directory. When indexing an arbitrary list of files, the
return value is the path of the current working directory.
Returns : String
View
50 Bio/DB/NCBIHelper.pm
@@ -1,7 +1,7 @@
#
# BioPerl module for Bio::DB::NCBIHelper
#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Jason Stajich
#
@@ -10,8 +10,8 @@
# You may distribute this module under the same terms as perl itself
#
# POD documentation - main docs before the code
-#
-# Interfaces with new WebDBSeqI interface
+#
+# Interfaces with new WebDBSeqI interface
=head1 NAME
@@ -23,7 +23,7 @@ NCBI databases.
# Do not use this module directly.
# get a Bio::DB::NCBIHelper object somehow
- my $seqio = $db->get_Stream_by_acc(['MUSIGHBA1']);
+ my $seqio = $db->get_Stream_by_acc(['J00522']);
foreach my $seq ( $seqio->next_seq ) {
# process seq
}
@@ -51,15 +51,15 @@ is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-=head2 Support
+=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
@@ -173,14 +173,14 @@ sub default_format {
Title : get_request
Usage : my $url = $self->get_request
Function: HTTP::Request
- Returns :
+ Returns :
Args : %qualifiers = a hash of qualifiers (ids, format, etc)
=cut
sub get_request {
my ($self, @qualifiers) = @_;
- my ($mode, $uids, $format, $query, $seq_start, $seq_stop, $strand, $complexity) =
+ my ($mode, $uids, $format, $query, $seq_start, $seq_stop, $strand, $complexity) =
$self->_rearrange([qw(MODE UIDS FORMAT QUERY SEQ_START SEQ_STOP STRAND COMPLEXITY)],
@qualifiers);
$mode = lc $mode;
@@ -188,7 +188,7 @@ sub get_request {
if( !defined $mode || $mode eq '' ) { $mode = 'single'; }
my %params = $self->get_params($mode);
if( ! %params ) {
- $self->throw("must specify a valid retrieval mode 'single' or 'batch' not '$mode'")
+ $self->throw("must specify a valid retrieval mode 'single' or 'batch' not '$mode'")
}
my $url = URI->new($HOSTBASE . $CGILOCATION{$mode}[1]);
unless( $mode eq 'webenv' || defined $uids || defined $query) {
@@ -258,10 +258,10 @@ NOTE: deprecated API. Use get_Stream_by_id() instead.
=cut
-*get_Stream_by_batch = sub {
+*get_Stream_by_batch = sub {
my $self = shift;
$self->deprecated('get_Stream_by_batch() is deprecated; use get_Stream_by_id() instead');
- $self->get_Stream_by_id(@_)
+ $self->get_Stream_by_id(@_)
};
=head2 get_Stream_by_query
@@ -296,7 +296,7 @@ sub get_Stream_by_query {
Function: process downloaded data before loading into a Bio::SeqIO
Returns : void
Args : hash with two keys - 'type' can be 'string' or 'file'
- - 'location' either file location or string
+ - 'location' either file location or string
reference containing data
=cut
@@ -324,9 +324,9 @@ sub postprocess_data {
=cut
sub request_format {
- my ($self, $value) = @_;
+ my ($self, $value) = @_;
if( defined $value ) {
- $value = lc $value;
+ $value = lc $value;
if( defined $FORMATMAP{$value} ) {
$self->{'_format'} = [ $value, $FORMATMAP{$value}];
} else {
@@ -362,7 +362,7 @@ sub redirect_refseq {
Title : complexity
Usage : $db->complexity(3)
- Function: get/set complexity value
+ Function: get/set complexity value
Returns : value from 0-4 indicating level of complexity
Args : value from 0-4 (optional); if unset server assumes 1
Throws : if arg is not an integer or falls outside of noted range above
@@ -392,7 +392,7 @@ sub complexity {
Title : strand
Usage : $db->strand(1)
- Function: get/set strand value
+ Function: get/set strand value
Returns : strand value if set
Args : value of 1 (plus) or 2 (minus); if unset server assumes 1
Throws : if arg is not an integer or is not 1 or 2
@@ -408,7 +408,7 @@ sub strand {
$str !~ /^\d+$/ || $str < 1 || $str > 2;
$self->{'_strand'} = $str;
}
- return $self->{'_strand'};
+ return $self->{'_strand'};
}
=head2 seq_start
@@ -429,7 +429,7 @@ sub seq_start {
$start !~ /^\d+$/;
$self->{'_seq_start'} = $start;
}
- return $self->{'_seq_start'};
+ return $self->{'_seq_start'};
}
=head2 seq_stop
@@ -450,7 +450,7 @@ sub seq_stop {
$stop !~ /^\d+$/;
$self->{'_seq_stop'} = $stop;
}
- return $self->{'_seq_stop'};
+ return $self->{'_seq_stop'};
}
=head2 Bio::DB::WebDBSeqI methods
@@ -483,8 +483,8 @@ sub get_Stream_by_acc {
=head2 _check_id
Title : _check_id
- Usage :
- Function:
+ Usage :
+ Function:
Returns : A Bio::DB::RefSeq reference or throws
Args : $id(s), $string
@@ -495,11 +495,11 @@ sub _check_id {
# NT contigs can not be retrieved
$self->throw("NT_ contigs are whole chromosome files which are not part of regular".
- "database distributions. Go to ftp://ftp.ncbi.nih.gov/genomes/.")
+ "database distributions. Go to ftp://ftp.ncbi.nih.gov/genomes/.")
if $ids =~ /NT_/;
# Asking for a RefSeq from EMBL/GenBank
-
+
if ($self->redirect_refseq) {
if ($ids =~ /N._/) {
$self->warn("[$ids] is not a normal sequence database but a RefSeq entry.".
View
41 Bio/DB/SeqFeature/Store/berkeleydb.pm
@@ -26,19 +26,19 @@ Bio::DB::SeqFeature::Store::berkeleydb -- Storage and retrieval of sequence anno
# Create a database from the feature files located in /home/fly4.3 and store
# the database index in the same directory:
- $db = Bio::DB::SeqFeature::Store->new( -adaptor => 'berkeleydb',
- -dir => '/home/fly4.3');
+ my $db = Bio::DB::SeqFeature::Store->new( -adaptor => 'berkeleydb',
+ -dir => '/home/fly4.3');
# Create a database that will monitor the files in /home/fly4.3, but store
# the indexes in /var/databases/fly4.3
- $db = Bio::DB::SeqFeature::Store->new( -adaptor => 'berkeleydb',
- -dsn => '/var/databases/fly4.3',
- -dir => '/home/fly4.3');
+ $db = Bio::DB::SeqFeature::Store->new( -adaptor => 'berkeleydb',
+ -dir => '/home/fly4.3',
+ -dsn => '/var/databases/fly4.3');
# Create a feature database from scratch
- $db = Bio::DB::SeqFeature::Store->new( -adaptor => 'berkeleydb',
- -dsn => '/var/databases/fly4.3',
- -create => 1);
+ $db = Bio::DB::SeqFeature::Store->new( -adaptor => 'berkeleydb',
+ -dsn => '/var/databases/fly4.3',
+ -create => 1);
# get a feature from somewhere
my $feature = Bio::SeqFeature::Generic->new(...);
@@ -347,8 +347,8 @@ sub auto_reindex {
if ($result && %$result) {
$self->flag_autoindexing(1);
$self->lock('exclusive');
- $self->reindex_wigfiles($result->{wig},$autodir) if $result->{wig};
- $self->reindex_ffffiles($result->{fff},$autodir) if $result->{fff};
+ $self->reindex_wigfiles($result->{wig},$autodir) if $result->{wig};
+ $self->reindex_ffffiles($result->{fff},$autodir) if $result->{fff};
$self->reindex_gfffiles($result->{gff},$autodir) if $result->{gff};
$self->dna_db(Bio::DB::Fasta::Subdir->new($autodir));
$self->unlock;
@@ -1523,19 +1523,26 @@ sub next_seq {
return $store->fetch($id);
}
+
package Bio::DB::Fasta::Subdir;
use base 'Bio::DB::Fasta';
-# alter calling arguments so that the fasta file is placed in a subdirectory
+# alter calling arguments so that the index file is placed in a subdirectory
# named "indexes"
-sub index_name {
- my $self = shift;
- my ($path,$isdir) = @_;
- return $self->SUPER::index_name($path,$isdir)
- unless $isdir;
- return File::Spec->catfile($path,'indexes','fasta.index');
+sub new {
+ my ($class, $path, %opts) = @_;
+ if (-d $path) {
+ $opts{-index_name} = File::Spec->catfile($path,'indexes','fasta.index');
+ }
+ return Bio::DB::Fasta->new($path, %opts);
+}
+
+
+sub _calculate_offsets {
+ my ($self, @args) = @_;
+ return $self->SUPER::_calculate_offsets(@args);
}
View
3  Bio/DB/SeqVersion/gi.pm
@@ -102,6 +102,7 @@ methods. Internal methods are usually preceded with a _
package Bio::DB::SeqVersion::gi;
use strict;
+use Encode;
use HTML::TableExtract;
use base qw(Bio::DB::SeqVersion);
@@ -278,7 +279,7 @@ sub _process_data {
my $te = HTML::TableExtract->new(
headers => ['Gi', 'Version', 'Update Date'] ,
depth => 0);
- $te->parse($html);
+ $te->parse(decode_utf8($html));
my $table = $te->first_table_found;
$self->throw("No table found") unless defined $table;
my $t = [$table->rows];
View
82 Bio/DB/WebDBSeqI.pm
@@ -1,7 +1,7 @@
#
# BioPerl module for Bio::DB::WebDBSeqI
#
-# Please direct questions and support issues to <bioperl-l@bioperl.org>
+# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Jason Stajich <jason@bioperl.org>
#
@@ -10,7 +10,7 @@
# You may distribute this module under the same terms as perl itself
#
# POD documentation - main docs before the code
-#
+#
=head1 NAME
@@ -47,15 +47,15 @@ is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
-=head2 Support
+=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
-rather than to the module maintainer directly. Many experienced and
-reponsive experts will be able look at the problem and quickly
-address it. Please include a thorough description of the problem
+rather than to the module maintainer directly. Many experienced and
+reponsive experts will be able look at the problem and quickly
+address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
@@ -123,17 +123,17 @@ sub new {
$ret_type && $self->retrieval_type($ret_type);
$delay = $self->delay_policy unless defined $delay;
$self->delay($delay);
-
+
# insure we always have a default format set for retrieval
# even though this will be immedietly overwritten by most sub classes
- $format = $self->default_format unless ( defined $format &&
+ $format = $self->default_format unless ( defined $format &&
$format ne '' );
$self->request_format($format);
my $ua = new LWP::UserAgent(env_proxy => 1);
$ua->agent(ref($self) ."/$MODVERSION");
- $self->ua($ua);
+ $self->ua($ua);
$self->{'_authentication'} = [];
return $self;
}
@@ -257,7 +257,7 @@ sub get_Seq_by_version {
Title : get_request
Usage : my $url = $self->get_request
Function: returns a HTTP::Request object
- Returns :
+ Returns :
Args : %qualifiers = a hash of qualifiers (ids, format, etc)
=cut
@@ -292,7 +292,7 @@ sub get_Stream_by_id {
*get_Stream_by_batch = sub {
my $self = shift;
$self->deprecated('get_Stream_by_batch() is deprecated; use get_Stream_by_id() instead');
- $self->get_Stream_by_id(@_)
+ $self->get_Stream_by_id(@_)
};
@@ -345,7 +345,7 @@ sub get_Stream_by_gi {
sub get_Stream_by_version {
my ($self, $ids ) = @_;
-# $self->throw("Implementing class should define this method!");
+# $self->throw("Implementing class should define this method!");
return $self->get_seq_stream('-uids' => $ids, '-mode' => 'version'); # how it should work
}
@@ -356,7 +356,7 @@ sub get_Stream_by_version {
Function: Gets a series of Seq objects by way of a query string or oject
Returns : a Bio::SeqIO stream object
Args : $query : A string that uses the appropriate query language
- for the database or a Bio::DB::QueryI object. It is suggested
+ for the database or a Bio::DB::QueryI object. It is suggested
that you create the Bio::DB::Query object first and interrogate
it for the entry count before you fetch a potentially large stream.
@@ -415,11 +415,11 @@ sub request_format {
=head2 get_seq_stream
Title : get_seq_stream
- Usage : my $seqio = $self->get_seq_sream(%qualifiers)
+ Usage : my $seqio = $self->get_seq_stream(%qualifiers)
Function: builds a url and queries a web db
Returns : a Bio::SeqIO stream capable of producing sequence
- Args : %qualifiers = a hash qualifiers that the implementing class
- will process to make a url suitable for web querying
+ Args : %qualifiers = a hash qualifiers that the implementing class
+ will process to make a url suitable for web querying
=cut
@@ -453,7 +453,7 @@ sub get_seq_stream {
if ($self->retrieval_type =~ /pipeline/) {
# Try to create a stream using POSIX fork-and-pipe facility.
# this is a *big* win when fetching thousands of sequences from
- # a web database because we can return the first entry while
+ # a web database because we can return the first entry while
# transmission is still in progress.
# Also, no need to keep sequence in memory or in a temporary file.
# If this fails (Windows, MacOS 9), we fall back to non-pipelined access.
@@ -482,12 +482,12 @@ sub get_seq_stream {
my $dir = $self->io->tempdir( CLEANUP => 1);
my ( $fh, $tmpfile) = $self->io()->tempfile( DIR => $dir );
close $fh;
- my $resp = $self->_request($request, $tmpfile);
+ my $resp = $self->_request($request, $tmpfile);
if( ! -e $tmpfile || -z $tmpfile || ! $resp->is_success() ) {
$self->throw("WebDBSeqI Error - check query sequences!\n");
}
$self->postprocess_data('type' => 'file',
- 'location' => $tmpfile);
+ 'location' => $tmpfile);
# this may get reset when requesting batch mode
($rformat,$ioformat) = $self->request_format();
if( $self->verbose > 0 ) {
@@ -505,7 +505,7 @@ sub get_seq_stream {
my $content = $resp->content_ref;
$self->debug( "content is $$content\n");
if (!$resp->is_success() || length($$content) == 0) {
- $self->throw("WebDBSeqI Error - check query sequences!\n");
+ $self->throw("WebDBSeqI Error - check query sequences!\n");
}
($rformat,$ioformat) = $self->request_format();
$self->postprocess_data('type'=> 'string',
@@ -517,18 +517,18 @@ sub get_seq_stream {
}
# if we got here, we don't know how to handle the retrieval type
- $self->throw("retrieval type " . $self->retrieval_type .
+ $self->throw("retrieval type " . $self->retrieval_type .
" unsupported\n");
}
=head2 url_base_address
Title : url_base_address
- Usage : my $address = $self->url_base_address or
+ Usage : my $address = $self->url_base_address or
$self->url_base_address($address)
Function: Get/Set the base URL for the Web Database
- Returns : Base URL for the Web Database
- Args : $address - URL for the WebDatabase
+ Returns : Base URL for the Web Database
+ Args : $address - URL for the WebDatabase
=cut
@@ -543,7 +543,7 @@ sub url_base_address {
=head2 proxy
Title : proxy
- Usage : $httpproxy = $db->proxy('http') or
+ Usage : $httpproxy = $db->proxy('http') or
$db->proxy(['http','ftp'], 'http://myproxy' )
Function: Get/Set a proxy for use of proxy
Returns : a string indicating the proxy
@@ -556,9 +556,9 @@ sub url_base_address {
sub proxy {
my ($self,$protocol,$proxy,$username,$password) = @_;
- return if ( !defined $self->ua || !defined $protocol
+ return if ( !defined $self->ua || !defined $protocol
|| !defined $proxy );
- $self->authentication($username, $password)
+ $self->authentication($username, $password)
if ($username && $password);
return $self->ua->proxy($protocol,$proxy);
}
@@ -568,7 +568,7 @@ sub proxy {
Title : authentication
Usage : $db->authentication($user,$pass)
Function: Get/Set authentication credentials
- Returns : Array of user/pass
+ Returns : Array of user/pass
Args : Array or user/pass
@@ -621,8 +621,8 @@ sub retrieval_type {
if( defined $value ) {
$value = lc $value;
if( ! $RETRIEVAL_TYPES{$value} ) {
- $self->warn("invalid retrieval type $value must be one of (" .
- join(",", keys %RETRIEVAL_TYPES), ")");
+ $self->warn("invalid retrieval type $value must be one of (" .
+ join(",", keys %RETRIEVAL_TYPES), ")");
$value = $DEFAULT_RETRIEVAL_TYPE;
}
$self->{'_retrieval_type'} = $value;
@@ -633,11 +633,11 @@ sub retrieval_type {
=head2 url_params
Title : url_params
- Usage : my $params = $self->url_params or
+ Usage : my $params = $self->url_params or
$self->url_params($params)
Function: Get/Set the URL parameters for the Web Database
Returns : url parameters for Web Database
- Args : $params - parameters to be appended to the URL for the WebDatabase
+ Args : $params - parameters to be appended to the URL for the WebDatabase
=cut
@@ -645,13 +645,13 @@ sub url_params {
my ($self, $value) = @_;
if( defined $value ) {
$self->{'_urlparams'} = $value;
- }
+ }
}
=head2 ua
Title : ua
- Usage : my $ua = $self->ua or
+ Usage : my $ua = $self->ua or
$self->ua($ua)
Function: Get/Set a LWP::UserAgent for use
Returns : reference to LWP::UserAgent Object
@@ -675,7 +675,7 @@ sub ua {