File Coverage

blib/lib/Bio/DB/HIV.pm
Criterion Covered Total %
statement 96 248 38.7
branch 31 126 24.6
condition 0 21 0.0
subroutine 17 25 68.0
pod 10 10 100.0
total 154 430 35.8


line stmt bran cond sub pod time code
1             # $Id: HIV.pm 232 2008-12-11 14:51:51Z maj $
2             #
3             # BioPerl module for Bio::DB::HIV
4             #
5             # Please direct questions and support issues to
6             #
7             # Cared for by Mark A. Jensen
8             #
9             # Copyright Mark A. Jensen
10             #
11             # You may distribute this module under the same terms as perl itself
12              
13             # POD documentation - main docs before the code
14              
15             =head1 NAME
16              
17             Bio::DB::HIV - Database object interface to the Los Alamos HIV Sequence Database
18              
19             =head1 SYNOPSIS
20              
21             $db = new Bio::DB::HIV;
22              
23             $seq = $db->get_Seq_by_id('94284'); # LANL sequence id
24             $seq = $db->get_Seq_by_acc('EF432710'); # GenBank accession
25              
26             $q = new Bio::DB::Query::HIVQuery( " (C D)[subtype] SI[phenotype] (symptomatic AIDS)[patient_health] " );
27              
28             $seqio = $db->get_Stream_by_query($q);
29             $seq = $seqio->next_seq();
30             ($seq->annotation->get_Annotations('Virus'))[0]->{subtype} # returns 'D'
31             ($seq->annotation->get_Annotations('Patient'))[0]->{patient_health} # returns 'AIDS'
32             ($seq->annotation->get_Annotations('accession'))[0]->{value} # returns 'K03454'
33              
34             =head1 DESCRIPTION
35              
36             Bio::DB::HIV, along with L, provides an
37             interface for obtaining annotated HIV and SIV sequences from the Los
38             Alamos National Laboratory (LANL) HIV Sequence Database (
39             L
40             ). Unannotated sequences can be retrieved directly from the database
41             object, using either LANL ids or GenBank accessions. Annotations are
42             obtained via a query object, and are attached to the correct C
43             objects when the query is handled by C
44             or C.
45              
46             =head1 FEEDBACK
47              
48             =head2 Mailing Lists
49              
50             User feedback is an integral part of the evolution of this and other
51             Bioperl modules. Send your comments and suggestions preferably to
52             the Bioperl mailing list. Your participation is much appreciated.
53              
54             bioperl-l@bioperl.org - General discussion
55             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
56              
57             =head2 Support
58              
59             Please direct usage questions or support issues to the mailing list:
60              
61             I
62              
63             rather than to the module maintainer directly. Many experienced and
64             reponsive experts will be able look at the problem and quickly
65             address it. Please include a thorough description of the problem
66             with code and data examples if at all possible.
67              
68             =head2 Reporting Bugs
69              
70             Report bugs to the Bioperl bug tracking system to help us keep track
71             of the bugs and their resolution. Bug reports can be submitted via
72             the web:
73              
74             https://github.com/bioperl/bioperl-live/issues
75              
76             =head1 AUTHOR - Mark A. Jensen
77              
78             Email maj@fortinbras.us
79              
80             =head1 CONTRIBUTORS
81              
82             Mark A. Jensen
83              
84             =head1 APPENDIX
85              
86             The rest of the documentation details each of the object methods.
87             Internal methods are usually preceded with a _
88              
89             =cut
90              
91             # Let the code begin...
92              
93              
94             package Bio::DB::HIV;
95 2     2   1545 use strict;
  2         2  
  2         48  
96 2     2   6 use warnings;
  2         3  
  2         77  
97 2     2   7 use vars qw( $LANL_BASE $LANL_MAP_DB $LANL_MAKE_SEARCH_IF $LANL_SEARCH );
  2         2  
  2         90  
98              
99             # Object preamble - inherits from Bio::DB::WebDBSeqI
100              
101 2     2   439 use Bio::Root::Root;
  2         3  
  2         41  
102 2     2   446 use HTTP::Request::Common;
  2         1524  
  2         102  
103 2     2   691 use Bio::DB::HIV::HIVAnnotProcessor;
  2         4  
  2         43  
104              
105 2     2   7 use base qw(Bio::DB::WebDBSeqI);
  2         2  
  2         780  
106              
107              
108             BEGIN {
109             # base change of 01/14/09
110 2     2   4 $LANL_BASE = "http://www.hiv.lanl.gov/components/sequence/HIV/asearch";
111 2         3 $LANL_MAP_DB = "map_db.comp";
112 2         2 $LANL_MAKE_SEARCH_IF = "make_search_if.comp";
113 2         2 $LANL_SEARCH = "search.comp";
114 2         21 @Bio::ResponseProblem::Exception::ISA = qw( Bio::Root::Exception );
115 2         17 @Bio::HIVSorry::Exception::ISA = qw ( Bio::Root::Exception );
116 2         4085 @Bio::WebError::Exception::ISA = qw( Bio::Root::Exception );
117             }
118              
119             =head1 Constructor
120              
121             =head2 new
122              
123             Title : new
124             Usage : my $obj = new Bio::DB::HIV();
125             Function: Builds a new Bio::DB::HIV object
126             Returns : an instance of Bio::DB::HIV
127             Args :
128              
129             =cut
130              
131             sub new {
132 1     1 1 125 my($class,@args) = @_;
133              
134 1         8 my $self = $class->SUPER::new(@args);
135 1         5 my ($lanl_base, $lanl_map_db, $lanl_make_search_if, $lanl_search) =
136             $self->_rearrange([qw(
137             LANL_BASE
138             LANL_MAP_DB
139             LANL_MAKE_SEARCH_IF
140             LANL_SEARCH
141             )], @args);
142              
143 1 50       9 $lanl_base && $self->lanl_base($lanl_base);
144 1 50       2 $lanl_map_db && $self->map_db($lanl_map_db);
145 1 50       3 $lanl_make_search_if && $self->make_search_if($lanl_make_search_if);
146 1 50       2 $lanl_search && $self->search_($lanl_search);
147             # defaults
148 1 50       4 $self->lanl_base || $self->lanl_base($LANL_BASE);
149 1 50       2 $self->map_db || $self->map_db($LANL_MAP_DB);
150 1 50       3 $self->make_search_if || $self->make_search_if($LANL_MAKE_SEARCH_IF);
151 1 50       3 $self->search_ || $self->search_($LANL_SEARCH);
152 1 50       6 $self->url_base_address || $self->url_base_address($self->lanl_base);
153              
154 1         3 $self->request_format("fasta");
155              
156 1         2 return $self;
157             }
158              
159             =head1 WebDBSeqI compliance
160              
161             =head2 get_request
162              
163             Title : get_request
164             Usage : my $url = $self->get_request
165             Function: returns a HTTP::Request object
166             Returns :
167             Args : %qualifiers = a hash of qualifiers with keys in
168             (-ids, -format, -mode, -query)
169             Note : Several layers of requests are performed to get to the sequence;
170             see Bio::DB::Query::HIVQuery.
171              
172             =cut
173              
174             sub get_request {
175 3     3 1 50 my $self = shift;
176 3         7 my %quals = @_;
177 3         2 my ($resp);
178 3         3 my (@ids, $mode, @interface, @query_parms, $query);
179              
180             # html parsing regexps
181 3         6 my $tags_re = qr{(?:\s*<[^>]+>\s*)};
182 3         39 my $session_id_re = qr{
183 3         4 my $search_form_re = qr{]*action=".*/search.comp"};
184 3         52 my $seqs_found_re = qr{Displaying$tags_re*(?:\s*[0-9-]*\s*)*$tags_re*of$tags_re*\s*([0-9]+)$tags_re*sequences found};
185 3         5 my $no_seqs_found_re = qr{Sorry.*no sequences found};
186 3         21 my $too_many_re = qr{too many records: $tags_re*([0-9]+)};
187             # find something like:
188             # tables without join:
SequenceAccessions
189 3         4 my $tbl_no_join_re = qr{tables without join}i;
190             # my $sorry_bud_re = qr{};
191              
192             # handle "qualifiers"
193 3         8 foreach (keys %quals) {
194 7 100       15 m/mode/ && do {
195 3         4 $mode = $quals{$_};
196 3         4 next;
197             };
198 4 100       8 m/uids/ && do {
199             $self->throw(-class=>"Bio::Root::BadParameter",
200             -text=>"Arrayref required for qualifier \"$_\"",
201 2 50       6 -value=>$quals{$_}) unless ref($quals{$_}) eq 'ARRAY';
202 2         2 @ids = @{$quals{$_}};
  2         4  
203 2         3 next;
204             };
205 2 100       6 m/query/ && do {
206             $self->throw(-class=>"Bio::Root::BadParameter",
207             -text=>"Bio::DB::Query::HIVQuery required for qualifier \"$_\"",
208 1 50       14 -value=>$quals{$_}) unless $quals{$_}->isa("Bio::DB::Query::HIVQuery");
209 0         0 $query = $quals{$_};
210 0         0 next;
211             };
212 1         1 do {
213 1         2 1; #else stub
214             };
215             }
216             # what kind of request?
217 2         4 for my $m ($mode) {
218 2 50       4 ($m =~ m/single/) && do {
219 0         0 @interface = (
220             'sequenceentry' => 'se_sequence',
221             'sequenceentry' => 'se_id',
222             'action' => 'Search Interface'
223             );
224 0         0 @query_parms = map { ('sequenceentry.se_id' => $_ ) } @ids;
  0         0  
225 0         0 push @query_parms, (
226             'sequenceentry.se_sequence'=>'Any',
227             'order' => 'sequenceentry.se_id',
228             'sort_dir' => 'ASC',
229             'action' => 'Search'
230             );
231             };
232 2 50       10 ($mode =~ m/acc/) && do {
233 0         0 @interface = (
234             'sequenceentry' => 'se_sequence',
235             'sequenceentry' => 'se_id',
236             'sequenceaccessions' => 'sa_genbankaccession',
237             'sequenceaccessions' => 'sa_se_id',
238             'action' => 'Search Interface'
239             );
240 0         0 @query_parms = map {('sequenceaccessions.sa_genbankaccession' => $_)} @ids;
  0         0  
241 0         0 push @query_parms, (
242             'sequenceentry.se_sequence' => 'Any',
243             'order' => 'sequenceaccessions.sa_genbankaccession',
244             'sort_dir' => 'ASC',
245             'action' => 'Search'
246             );
247             };
248 2 100       4 ($mode =~ m/gi/) && do {
249 1         3 $self->_sorry("-mode=>gi");
250             };
251 1 50       4 ($mode =~ m/version/) && do {
252 1         4 $self->_sorry("-mode=>version");
253             };
254 0 0       0 ($mode =~ m/query/) && do {
255             $self->throw(-class=>"Bio::Root::BadParameter",
256             -text=>"Query ".($query->{'_RUN_LEVEL'} ? "has been run only at run level ".$query->{'_RUN_LEVEL'} : "has not been run").", run at level 2 with _do_query(2)",
257 0 0       0 -value=>$query->{'_RUN_LEVEL'}) unless $query->{'_RUN_LEVEL'} == 2;
    0          
258 0         0 @interface = (
259             'sequenceentry' => 'se_sequence',
260             'sequenceentry' => 'se_id',
261             'action' => 'Search Interface'
262             );
263 0         0 @query_parms = ("sequenceentry.se_id" =>sprintf("'%s'",join("\t", $query->ids)));
264             # @query_parms = map { ( "sequenceentry.se_id" => $_ ) } $query->ids;
265 0         0 push @query_parms, (
266             'sequenceentry.se_sequence' => 'Any',
267             'order' => 'sequenceentry.se_id',
268             'sort_dir' => 'ASC',
269             'action' => 'Search'
270             );
271             };
272 0         0 do {
273 0         0 1; # else stub
274             };
275             }
276             # web work
277 0         0 eval { # capture web errors; throw below...
278             # negotiate a session with lanl db
279 0 0       0 if (!$self->_session_id) {
280 0         0 $resp = $self->ua->get($self->_map_db_uri);
281 0 0       0 $resp->is_success || die "Connect failed";
282             # get the session id
283 0 0       0 if (!$self->_session_id) {
284 0         0 ($self->{'_session_id'}) = ($resp->content =~ /$session_id_re/);
285 0 0       0 $self->_session_id || die "Session not established";
286             }
287             }
288              
289             # establish correct "interface" for this session id
290 0         0 $resp = $self->ua->post($self->_make_search_if_uri, [@interface, id=>$self->_session_id]);
291 0 0       0 $resp->is_success || die "Interface request failed (1)";
292 0         0 $self->_response($resp);
293 0 0       0 $resp->content =~ /$search_form_re/ || die "Interface request failed (2)";
294              
295             # interface successful, do the "pre-search"
296 0         0 $resp = $self->ua()->post($self->_search_uri, [(@query_parms, 'id' => $self->_session_id)] );
297 0 0       0 unless ($resp->is_success) {
298 0         0 die "Search post failed";
299             }
300 0         0 $self->_response($resp);
301             # check for error conditions
302 0         0 for ($resp->content) {
303 0 0       0 /$no_seqs_found_re/ && do {
304 0         0 die "No sequences found";
305 0         0 last;
306             };
307 0 0       0 /$too_many_re/ && do {
308 0         0 die "Too many records ($1): must be <10000";
309 0         0 last;
310             };
311 0 0       0 /$tbl_no_join_re/ && do {
312 0         0 die "Some required tables went unjoined to query";
313 0         0 last;
314             };
315 0 0       0 /$seqs_found_re/ && do {
316 0         0 last;
317             };
318 0         0 do {
319 0         0 die "Unparsed failure";
320 0         0 last;
321             };
322             }
323              
324             };
325 0 0       0 $self->throw(-class=>'Bio::WebError::Exception',
326             -text=>$@,
327             -value=>$resp->content) if $@;
328              
329             # "pre-search" successful, return request
330             ### check this post update
331 0         0 return POST $self->_search_uri,
332             ['action Download.x' => 1,
333             'action Download.y'=>1,
334             'id'=>$self->_session_id
335             ];
336              
337              
338             }
339              
340             =head2 postprocess_data
341              
342             Title : postprocess_data
343             Usage : $self->postprocess_data ( 'type' => 'string',
344             'location' => \$datastr);
345             Function: process downloaded data before loading into a Bio::SeqIO
346             Returns : void
347             Args : hash with two keys - 'type' can be 'string' or 'file'
348             - 'location' either file location or string
349             reference containing data
350              
351             =cut
352              
353             sub postprocess_data {
354             # parse tab-separated value content from LANL db
355 0     0 1 0 my ( $self, %args) = @_;
356 0         0 my ($type, $loc) = ($args{type}, $args{location});
357 0         0 my (@data, @cols, %rec, $idkey, @flines);
358 0 0 0     0 $self->throw(-class=>'Bio::Root::BadParameter',
359             -text=>"Argument hash requires values for keys \"type\" and \"location\"",
360             -value=>\%args) unless ($type && $loc);
361 0         0 for ($type) {
362 0 0       0 m/string/ && do {
363 0         0 @data = split(/\n|\r/, ${$loc});
  0         0  
364 0         0 last;
365             };
366 0 0       0 m/file/ && do {
367 0         0 local $/ = undef;
368 0 0       0 open my $F, '<', $loc or
369             $self->throw(
370             -class => 'Bio::Root::FileOpenException',
371             -text => "Error opening tempfile '$loc' for reading",
372             -value => $!
373             );
374 0         0 @data = split( /\n|\r/, <$F>);
375 0         0 close $F;
376 0         0 last;
377             };
378 0         0 do {
379 0         0 1; # else stub
380             };
381             }
382 0 0       0 $self->throw(-class=>'Bio::Root::BadParameter',
383             -text=>'No data found in repsonse',
384             -value=>%args) unless (@data);
385 0         0 my $l;
386 0   0     0 do {
387 0         0 $l = shift @data;
388             } while ( defined $l && $l !~ /Number/ ); # number-returned line
389 0         0 @cols = split( /\t/, shift @data);
390              
391             # if Accession column is present, get_Stream_by_acc was called
392             # otherwise, return lanl ids
393 0 0       0 ($idkey) = grep /SE.id/i, @cols unless ($idkey) = grep /Accession/i, @cols;
394 0 0       0 $self->throw(-class=>"Bio::ResponseProblem::Exception",
395             -text=>"Trouble with column headers in LANL response",
396             -value=>join(' ',@cols)) unless $idkey;
397              
398 0         0 foreach (@data) {
399 0         0 chop;
400 0         0 @rec{@cols} = split /\t/;
401 0         0 push @flines, ">$rec{$idkey}\n".$rec{'Sequence'}."\n";
402             }
403 0         0 for ($type) {
404 0 0       0 m/string/ && do {
405 0         0 ${$loc} = join("", @flines);
  0         0  
406 0         0 last;
407             };
408 0 0       0 m/file/ && do {
409 0 0       0 open my $F, '>', $loc or $self->throw(-class=>'Bio::Root::FileOpenException',
410             -text=>"Error opening tempfile '$loc' for writing",
411             -value=>$!);
412 0         0 print $F join("", @flines);
413 0         0 close $F;
414 0         0 last;
415             };
416 0         0 do {
417 0         0 1; #else stub
418             };
419             }
420 0         0 return;
421             }
422              
423             =head1 WebDBSeqI overrides
424              
425             =head2 get_seq_stream
426              
427             Title : get_seq_stream
428             Usage : my $seqio = $self->get_seq_stream(%qualifiers)
429             Function: builds a url and queries a web db
430             Returns : a Bio::SeqIO stream capable of producing sequence
431             Args : %qualifiers = a hash qualifiers that the implementing class
432             will process to make a url suitable for web querying
433             Note : Some tightening up of the baseclass version
434              
435             =cut
436              
437             sub get_seq_stream {
438 1     1 1 3 my ($self, %qualifiers) = @_;
439 1         2 my ($rformat, $ioformat) = $self->request_format();
440              
441 1         5 my ($key) = grep /format$/, keys %qualifiers;
442 1 50       4 $qualifiers{'-format'} = ($key ? $qualifiers{$key} : $rformat);
443 1         5 ($rformat, $ioformat) = $self->request_format($qualifiers{'format'});
444              
445             # web work is here/maj
446 1         5 my $request = $self->get_request(%qualifiers);
447              
448             # authorization is here/maj
449 0 0       0 $request->proxy_authorization_basic($self->authentication)
450             if ( $self->authentication);
451 0         0 $self->debug("request is ". $request->as_string(). "\n");
452              
453             # workaround for MSWin systems (no forking available/maj)
454 0 0 0     0 $self->retrieval_type('io_string') if $self->retrieval_type =~ /pipeline/ && $^O =~ /^MSWin/;
455              
456 0 0       0 if ($self->retrieval_type =~ /pipeline/) {
457             # Try to create a stream using POSIX fork-and-pipe facility.
458             # this is a *big* win when fetching thousands of sequences from
459             # a web database because we can return the first entry while
460             # transmission is still in progress.
461             # Also, no need to keep sequence in memory or in a temporary file.
462             # If this fails (Windows, MacOS 9), we fall back to non-pipelined access.
463              
464             # fork and pipe: _stream_request()=>
465 0         0 my ($result,$stream) = $self->_open_pipe();
466              
467 0 0       0 if (defined $result) {
468 0         0 $DB::fork_TTY = File::Spec->devnull; # prevents complaints from debugge
469 0 0       0 if (!$result) { # in child process
470 0         0 $self->_stream_request($request,$stream);
471 0         0 POSIX::_exit(0); #prevent END blocks from executing in this forked child
472             }
473             else {
474 0         0 return Bio::SeqIO->new('-verbose' => $self->verbose,
475             '-format' => $ioformat,
476             '-fh' => $stream);
477             }
478             }
479             else {
480 0         0 $self->retrieval_type('io_string');
481             }
482             }
483              
484 0 0       0 if ($self->retrieval_type =~ /temp/i) {
485 0         0 my $dir = $self->io->tempdir( CLEANUP => 1);
486 0         0 my ( $fh, $tmpfile) = $self->io()->tempfile( DIR => $dir );
487 0         0 close $fh;
488 0         0 my $resp = $self->_request($request, $tmpfile);
489 0 0 0     0 if( ! -e $tmpfile || -z $tmpfile || ! $resp->is_success() ) {
      0        
490 0         0 $self->throw("WebDBSeqI Error - check query sequences!\n");
491             }
492 0         0 $self->postprocess_data('type' => 'file','location' => $tmpfile);
493             # this may get reset when requesting batch mode
494 0         0 ($rformat,$ioformat) = $self->request_format();
495 0 0       0 if( $self->verbose > 0 ) {
496 0 0       0 open my $ERR, '<', $tmpfile or $self->throw("Could not read file '$tmpfile': $!");
497 0         0 while(<$ERR>) { $self->debug($_);}
  0         0  
498 0         0 close $ERR;
499             }
500              
501 0         0 return Bio::SeqIO->new('-verbose' => $self->verbose,
502             '-format' => $ioformat,
503             '-file' => $tmpfile);
504             }
505              
506 0 0       0 if ($self->retrieval_type =~ /io_string/i ) {
507 0         0 my $resp = $self->_request($request);
508 0         0 my $content = $resp->content_ref;
509 0         0 $self->debug( "content is $$content\n");
510 0 0 0     0 if (!$resp->is_success() || length($$content) == 0) {
511 0         0 $self->throw("WebDBSeqI Error - check query sequences!\n");
512             }
513 0         0 ($rformat,$ioformat) = $self->request_format();
514 0         0 $self->postprocess_data('type'=> 'string',
515             'location' => $content);
516 0         0 $self->debug( "str is $$content\n");
517 0         0 return Bio::SeqIO->new('-verbose' => $self->verbose,
518             '-format' => $ioformat,
519             '-fh' => new IO::String($$content));
520             }
521              
522             # if we got here, we don't know how to handle the retrieval type
523 0         0 $self->throw("retrieval type " .
524             $self->retrieval_type .
525             " unsupported\n");
526             }
527              
528             =head2 get_Stream_by_acc
529              
530             Title : get_Stream_by_acc
531             Usage : $seq = $db->get_Stream_by_acc([$acc1, $acc2]);
532             Function: Gets a series of Seq objects by GenBank accession numbers
533             Returns : a Bio::SeqIO stream object
534             Args : an arrayref of accession numbers for
535             the desired sequence entries
536             Note : For LANL DB, alternative to LANL seqids
537              
538             =cut
539              
540             sub get_Stream_by_acc {
541 0     0 1 0 my ($self, $ids ) = @_;
542 0         0 return $self->get_seq_stream('-uids' => [$ids], '-mode' => 'acc');
543             }
544              
545             =head2 get_Stream_by_query
546              
547             Title : get_Stream_by_query
548             Usage : $stream = $db->get_Stream_by_query($query);
549             Function: Gets a series of Seq objects by way of a query string or oject
550             Returns : a Bio::SeqIO stream object
551             Args : $query : Currently, only a Bio::DB::Query::HIVQuery object.
552             It's a good idea to create the query object first and interrogate
553             it for the entry count before you fetch a potentially large stream.
554              
555             =cut
556              
557             sub get_Stream_by_query {
558 1     1 1 20 my ($self, $query ) = @_;
559 1         5 my $stream = $self->get_seq_stream('-query' => $query, '-mode'=>'query');
560 0         0 return new Bio::DB::HIV::HIVAnnotProcessor( -hiv_query=>$query, -source_stream=>$stream );
561             }
562              
563             sub _request {
564 0     0   0 my ($self, $request,$tmpfile) = @_;
565 0         0 my ($resp);
566              
567 0 0 0     0 if( defined $tmpfile && $tmpfile ne '' ) {
568 0         0 $resp = $self->ua->request($request, $tmpfile);
569             } else {
570 0         0 $resp = $self->ua->request($request);
571             }
572              
573 0 0       0 if( $resp->is_error ) {
574 0         0 $self->throw("WebDBSeqI Request Error:\n".$resp->as_string);
575             }
576 0         0 return $resp;
577             }
578              
579             =head1 Internals
580              
581             =head2 lanl_base
582              
583             Title : lanl_base
584             Usage : $obj->lanl_base($newval)
585             Function: get/set the base url of the LANL HIV database
586             Example :
587             Returns : value of lanl_base (a scalar)
588             Args : on set, new value (a scalar or undef, optional)
589              
590             =cut
591              
592             sub lanl_base{
593 4     4 1 4 my $self = shift;
594              
595 4 100       9 return $self->{'lanl_base'} = shift if @_;
596 3         10 return $self->{'lanl_base'};
597             }
598              
599             =head2 map_db
600              
601             Title : map_db
602             Usage : $obj->map_db($newval)
603             Function: get/set the cgi filename for map_db ("Database Map")
604             Example :
605             Returns : value of map_db (a scalar)
606             Args : on set, new value (a scalar or undef, optional)
607              
608             =cut
609              
610             sub map_db{
611 3     3 1 4 my $self = shift;
612              
613 3 100       51 return $self->{'map_db'} = shift if @_;
614 2         8 return $self->{'map_db'};
615             }
616              
617             =head2 make_search_if
618              
619             Title : make_search_if
620             Usage : $obj->make_search_if($newval)
621             Function: get/set the cgi filename for make_search_if ("Make Search Interface")
622             Example :
623             Returns : value of make_search_if (a scalar)
624             Args : on set, new value (a scalar or undef, optional)
625              
626             =cut
627              
628             sub make_search_if{
629 3     3 1 5 my $self = shift;
630              
631 3 100       8 return $self->{'make_search_if'} = shift if @_;
632 2         6 return $self->{'make_search_if'};
633             }
634              
635             =head2 search_
636              
637             Title : search_
638             Usage : $obj->search_($newval)
639             Function: get/set the cgi filename for the search query page
640             ("Search Database")
641             Example :
642             Returns : value of search_ (a scalar)
643             Args : on set, new value (a scalar or undef, optional)
644              
645             =cut
646              
647             sub search_{
648 3     3 1 2 my $self = shift;
649              
650 3 100       8 return $self->{'search_'} = shift if @_;
651 2         7 return $self->{'search_'};
652             }
653              
654             =head2 _map_db_uri
655              
656             Title : _map_db_uri
657             Usage :
658             Function: return the full map_db uri ("Database Map")
659             Example :
660             Returns : scalar string
661             Args : none
662              
663             =cut
664              
665             sub _map_db_uri{
666 0     0   0 my $self = shift;
667 0         0 return $self->url_base_address."/".$self->map_db;
668             }
669              
670              
671             =head2 _make_search_if_uri
672              
673             Title : _make_search_if_uri
674             Usage :
675             Function: return the full make_search_if uri ("Make Search Interface")
676             Example :
677             Returns : scalar string
678             Args : none
679              
680             =cut
681              
682             sub _make_search_if_uri{
683 0     0   0 my $self = shift;
684 0         0 return $self->url_base_address."/".$self->make_search_if;
685             }
686              
687             =head2 _search_uri
688              
689             Title : _search_uri
690             Usage :
691             Function: return the full search cgi uri ("Search Database")
692             Example :
693             Returns : scalar string
694             Args : none
695              
696             =cut
697              
698             sub _search_uri{
699 0     0   0 my $self = shift;
700 0         0 return $self->url_base_address."/".$self->search_;
701             }
702              
703             =head2 _session_id
704              
705             Title : _session_id
706             Usage : $obj->_session_id($newval)
707             Function: Contains HIV db session id (initialized in _do_lanl_request)
708             Example :
709             Returns : value of _session_id (a scalar)
710             Args : on set, new value (a scalar or undef, optional)
711              
712             =cut
713              
714             sub _session_id{
715 0     0   0 my $self = shift;
716              
717 0 0       0 return $self->{'_session_id'} = shift if @_;
718 0         0 return $self->{'_session_id'};
719             }
720              
721             =head2 _response
722              
723             Title : _response
724             Usage : $obj->_response($newval)
725             Function: hold the response to search post
726             Example :
727             Returns : value of _response (a scalar)
728             Args : on set, new value (a scalar or undef, optional)
729              
730             =cut
731              
732             sub _response{
733 0     0   0 my $self = shift;
734              
735 0 0       0 return $self->{'_response'} = shift if @_;
736 0         0 return $self->{'_response'};
737             }
738              
739             =head2 Dude, sorry
740              
741             Title : _sorry
742             Usage : $hiv->_sorry
743             Function: Throws an exception for unsupported option or parameter
744             Example :
745             Returns :
746             Args : scalar string
747              
748             =cut
749              
750             sub _sorry{
751 2     2   2 my $self = shift;
752 2         3 my $parm = shift;
753 2         14 $self->throw(-class=>"Bio::HIVSorry::Exception",
754             -text=>"Sorry, option/parameter \"$parm\" not (yet) supported. See manpage to complain.",
755             -value=>$parm);
756 0           return;
757             }
758              
759              
760             1;