From 4202a3510959a4bea78582f703c6fe24d91c1c0d Mon Sep 17 00:00:00 2001 From: cjfields Date: Thu, 18 Dec 2008 05:33:11 +0000 Subject: [PATCH] [bug 2714] * patches to update Bio::DB::HIV and related (Mark Jensen) svn path=/bioperl-live/trunk/; revision=15206 --- Bio/DB/HIV/HIVQueryHelper.pm | 17 ++---------- Bio/DB/HIV/lanl-schema.xml | 40 +++++++++++++++++++++++++++ Bio/DB/Query/HIVQuery.pm | 60 ++++++++++++++++++++++++++++------------- t/RemoteDB/HIV/HIVQueryHelper.t | 4 +-- 4 files changed, 85 insertions(+), 36 deletions(-) diff --git a/Bio/DB/HIV/HIVQueryHelper.pm b/Bio/DB/HIV/HIVQueryHelper.pm index c17183e16..dee068e73 100755 --- a/Bio/DB/HIV/HIVQueryHelper.pm +++ b/Bio/DB/HIV/HIVQueryHelper.pm @@ -503,23 +503,10 @@ sub ftbl { sub loadHIVSchema { my $fn = shift; - # look in @INC for file - my $dir; - # finding myself - foreach my $d (@INC) { - my $p = Bio::Root::IO->catfile($d, $fn); - my $b = Bio::Root::IO->catfile($d, qw(Bio DB HIV), $fn); - if (-e $p) { - $dir = $p - } elsif (-e $b) { - $dir = $b; - } - last if $dir; - } - Bio::Root::Root->throw("loadHIVSchema: schema file not found") unless $dir; + Bio::Root::Root->throw("loadHIVSchema: schema file not found") unless -e $fn; my $q = XML::Simple->new(ContentKey=>'name',NormalizeSpace=>2,ForceArray=>1); my %ret; - my $ref = $q->XMLin($dir); + my $ref = $q->XMLin($fn); my @sf = keys %{$$ref{sfield}}; foreach (@sf) { my $h = $$ref{sfield}{$_}; diff --git a/Bio/DB/HIV/lanl-schema.xml b/Bio/DB/HIV/lanl-schema.xml index 32e01491e..3ef292865 100755 --- a/Bio/DB/HIV/lanl-schema.xml +++ b/Bio/DB/HIV/lanl-schema.xml @@ -432,6 +432,46 @@ LANL HIV DB as of 10/27/08 cd8_count cd8_count + COMMAND.genomic_regiongenegenomic_region + genomic_region + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + SEQ_SAMple.SSAM_Clone_name_numberSSAM_Clone_name_number Clone_name_number clone_name diff --git a/Bio/DB/Query/HIVQuery.pm b/Bio/DB/Query/HIVQuery.pm index 9c96a3411..725d90f73 100755 --- a/Bio/DB/Query/HIVQuery.pm +++ b/Bio/DB/Query/HIVQuery.pm @@ -244,15 +244,19 @@ sub new { # catch this at the top if (defined $schema_file) { - my ($p) = $self->_schema_file( [grep {$_} map { - my $p = Bio::Root::IO->catfile($_, $schema_file); - $p if -e $p - } (@INC,"")]->[0]); - $self->throw(-class=>"Bio::Root::NoSuchThing", - -text=>"Schema file \"".$self->_schema_file."\" cannot be found", - -value=>$self->_schema_file) unless -e $self->_schema_file; - $self->_schema_file($schema_file); - + if (-e $schema_file) { + $self->_schema_file($schema_file); + } + else { # look around + my ($p) = $self->_schema_file( [grep {$_} map { + my $p = Bio::Root::IO->catfile($_, $schema_file); + $p if -e $p + } (@INC,"")]->[0]); + $self->throw(-class=>"Bio::Root::NoSuchThing", + -text=>"Schema file \"".$self->_schema_file."\" cannot be found", + -value=>$self->_schema_file) unless -e $self->_schema_file; + $self->_schema_file($schema_file); + } } else { $self->_schema_file($SCHEMA_FILE); } @@ -1179,7 +1183,7 @@ sub _do_lanl_request { my $search_form_re = qr{]*action=".*/search.comp"}; my $seqs_found_re = qr{Displaying$tags_re*(?:\s*[0-9-]*\s*)*$tags_re*of$tags_re*\s*([0-9]+)$tags_re*sequences found}; my $no_seqs_found_re = qr{Sorry.*no sequences found}; - my $too_many_re = qr{too many records :$tags_re*([0-9]+)}; + my $too_many_re = qr{too many records: $tags_re*([0-9]+)}; foreach my $q (@queries) { @query = @$q; @@ -1191,6 +1195,11 @@ sub _do_lanl_request { ); # do work... + + # pull out commands, designated by the COMMAND pseudo-table... + my @commands = map { $query[$_] =~ s/^COMMAND\.// ? @query[$_..$_+1] : () } (0..$#query-1); + @query = map { $query[$_] =~ /^COMMAND/ ? () : @query[2*$_..2*$_+1] } (0..($#query-1)/2); + # set control parameters explicitly made in query foreach my $cp (keys %qctrl) { @@ -1227,16 +1236,29 @@ sub _do_lanl_request { $interfGet->content =~ /$search_form_re/ or do {$response=$interfGet, die "Interface request failed";}; - $searchGet = $ua->post($self->_search_uri, [@query, @search_pms, id=>$self->_session_id]); + $searchGet = $ua->post($self->_search_uri, [@query, @commands, @search_pms, id=>$self->_session_id]); $searchGet->is_success or do {$response=$searchGet, die "Search failed";}; - - if ($searchGet->content =~ /$no_seqs_found_re/) { - $response=$searchGet; - die "No sequences found"; - } - else { - ($numseqs) = ($searchGet->content =~ /$seqs_found_re/); - $numseqs ? $count += $numseqs : die("Unparsed failure"); + for ($searchGet->content) { + /$no_seqs_found_re/ && do { + $response=$searchGet; + die "No sequences found"; + last; + }; + /$too_many_re/ && do { + $response=$searchGet; + die "Too many records ($1): must be <10000"; + last; + }; + /$seqs_found_re/ && do { + $numseqs = $1; + $count += $numseqs; + last; + }; + # else... + do { + $response=$searchGet->content; + die "Search failed (response not parsed)"; + }; } $response = $ua->post($self->_search_uri, [@download_pms, id=>$self->_session_id]); $response->is_success or die "Query failed"; diff --git a/t/RemoteDB/HIV/HIVQueryHelper.t b/t/RemoteDB/HIV/HIVQueryHelper.t index 8245f6344..5ce477d22 100755 --- a/t/RemoteDB/HIV/HIVQueryHelper.t +++ b/t/RemoteDB/HIV/HIVQueryHelper.t @@ -15,7 +15,7 @@ BEGIN { # lanl-schema.xml characteristics as of $Date: 2008-12-11 08:05:24 -0500 (Thu, 11 Dec 2008) $ -my ($naliases, $nfields, $ntables) = (173, 85, 13); +my ($naliases, $nfields, $ntables) = (175, 86, 14); my ($Q, $r, $q); # object tests isa_ok(new HIVSchema(), "HIVSchema"); @@ -25,7 +25,7 @@ isa_ok($q = new Q(), "Q"); #HIVSchema tests my $tobj; -ok( $tobj = new HIVSchema("lanl-schema.xml"), "schema load"); +ok( $tobj = new HIVSchema(Bio::Root::IO->catfile(qw(Bio DB HIV lanl-schema.xml))), "schema load"); # methods can_ok( $tobj, qw ( -- 2.11.4.GIT