1# $Id$
2#
3# BioPerl module for Bio::DB::SoapEUtilities::Result
4#
5# Please direct questions and support issues to <bioperl-l@bioperl.org>
6#
7# Cared for by Mark A. Jensen <maj -at- fortinbras -dot- us>
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
17Bio::DB::SoapEUtilities::Result - Accessor object for SoapEUtilities results
18
19=head1 SYNOPSIS
20
21 $fac = Bio::DB::SoapEUtilities->new();
22 $result = $fac->esearch( -db => 'gene', -term => 'hedgehog')->run;
23 $count = $result->count; # case important; $result->Count could be arrayref
24 @ids = $result->ids;
25
26=head1 DESCRIPTION
27
28This module attempts to make Entrez Utilities SOAP responses as
29user-friendly and intuitive as possible. These responses can be
30complex structures with much useful data; but users will generally
31desire the values of some key fields. The L<Result> object provides
32access to all response values via systematically named accessor
33methods, and commonly used values as convenience methods. The 'raw'
34SOAP message (a L<SOAP::SOM> object as returned by L<SOAP::Lite>) is
35also provided.
36
37=over
38
39=item Convenience accessors
40
41If a list of record ids is returned by the call, C<ids()> will return these as
42an array reference:
43
44 @seq_ids = $result->ids;
45
46The total count of returned records is provided by C<count()>:
47
48 $num_recs = $result->count;
49
50If C<usehistory> was specified in the SOAP call, the NCBI-assigned web
51environment (that can be used in future calls) is available in
52C<webenv>, and the query key assigned to the result in C<query_key>:
53
54 $next_result = $fac->efetch( -WebEnv => $result->webenv,
55                              -QueryKey => $result->query_key );
56
57=item Walking the response
58
59This module uses C<AUTOLOAD> to provide accessor methods for all response data.
60Here is an example of a SOAP response as returned by a C<method()> call off the L<SOAP::SOM> object:
61
62    DB<5> x $result->som->method
63 0  HASH(0x2eac9a4)
64    'Count' => 148
65    'IdList' => HASH(0x4139578)
66      'Id' => 100136227
67    'QueryKey' => 1
68    'QueryTranslation' => 'sonic[All Fields] AND hedgehog[All Fields]'
69    'RetMax' => 20
70    'RetStart' => 0
71    'TranslationSet' => ''
72    'TranslationStack' => HASH(0x4237b4c)
73       'OP' => 'GROUP'
74       'TermSet' => HASH(0x42c43bc)
75          'Count' => 2157
76          'Explode' => 'Y'
77          'Field' => 'All Fields'
78          'Term' => 'hedgehog[All Fields]'
79    'WebEnv' => 'NCID_1_150423569_130.14.22.101_9001_1262703782'
80
81Some of the data values here (at the tips of the data structure) are
82actually arrays of values ( e.g., the tip C<IdList => Id> ), other
83tips are simple scalars. With this in mind, C<Result> accessor methods work as
84follows:
85
86Data values (at the tips of the response structure) are acquired by calling a method with the structure keys separated by underscores (if necessary):
87
88 $query_key = $result->QueryKey; # $query_key == 1
89 $ids = $result->IdList_Id;      # @$ids is an array of record ids
90
91Data I<sets> below a particular node in the response structure can
92also be obtained with similarly constructed method names. These
93'internal node accessors' return a hashref, containing all data leaves
94below the node, keyed by the accessor names:
95
96    $data_hash = $result->TranslationStack
97
98    DB<3> x $data_hash
99 0  HASH(0x43569d4)
100    'TranslationStack_OP' => ARRAY(0x42d9988)
101       0  'AND'
102       1  'GROUP'
103    'TranslationStack_TermSet_Count' => ARRAY(0x4369c64)
104       0  148
105       1  148
106       2  2157
107    'TranslationStack_TermSet_Explode' => ARRAY(0x4368998)
108       0  'Y'
109       1  'Y'
110    'TranslationStack_TermSet_Field' => ARRAY(0x4368260)
111       0  'All Fields'
112       1  'All Fields'
113    'TranslationStack_TermSet_Term' => ARRAY(0x436c97c)
114       0  'sonic[All Fields]'
115       1  'hedgehog[All Fields]'
116
117Similarly, the call C< $result->TranslationStack_TermSet > would
118return a similar hash containing the last 4 elements of the example
119hash above.
120
121Creating accessors is somewhat costly, especially for fetch responses
122which can be deep and complex (not unlike BioPerl
123developers). Portions of the response tree can be ignored by setting
124C<-prune_at_node> to a arrayref of nodes to skip. Nodes should be
125specified in L<SOAP::SOM> format, e.g.
126
127 ...::Result->new( -prune_at_nodes => ['//GBSeq_references'] );
128
129Accessor creation can be skipped altogether by passing C<-no_parse =>
1301> to the C<Result> constructor. This is recommended if a result is
131being passed to a
132L<Bio::DB::SoapEUtilities::FetchAdaptor>. The original SOAP
133message with all data is always available in C<$result->som>.
134
135=back
136
137=over
138
139Other methods
140
141=item accessors()
142
143An array of available data accessor names. This
144contains only the data "tips". The internal node accessors are
145autoloaded.
146
147=item ok()
148
149True if no SOAP fault.
150
151=item errstr()
152
153Returns the SOAP fault error string.
154
155=item som()
156
157The original C<SOAP::SOM> message.
158
159=item util()
160
161The EUtility associated with the result.
162
163=back
164
165=head1 FEEDBACK
166
167=head2 Mailing Lists
168
169User feedback is an integral part of the evolution of this and other
170Bioperl modules. Send your comments and suggestions preferably to
171the Bioperl mailing list.  Your participation is much appreciated.
172
173  bioperl-l@bioperl.org                  - General discussion
174http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
175
176=head2 Support
177
178Please direct usage questions or support issues to the mailing list:
179
180L<bioperl-l@bioperl.org>
181
182rather than to the module maintainer directly. Many experienced and
183reponsive experts will be able look at the problem and quickly
184address it. Please include a thorough description of the problem
185with code and data examples if at all possible.
186
187=head2 Reporting Bugs
188
189Report bugs to the Bioperl bug tracking system to help us keep track
190of the bugs and their resolution. Bug reports can be submitted via
191the web:
192
193  http://redmine.open-bio.org/projects/bioperl/
194
195=head1 AUTHOR - Mark A. Jensen
196
197Email maj -at- fortinbras -dot- us
198
199=head1 APPENDIX
200
201The rest of the documentation details each of the object methods.
202Internal methods are usually preceded with a _
203
204=cut
205
206# Let the code begin...
207
208package Bio::DB::SoapEUtilities::Result;
209use strict;
210use warnings;
211
212use Bio::Root::Root;
213
214use base qw(Bio::Root::Root );
215
216our $AUTOLOAD;
217our %ID_LIST_ELT = (
218    esearch => 'IdList_Id',
219    esummary => 'DocSum_Id',
220    elink => 'LinkSet_IdList_Id'
221    );
222
223# an object of accessors
224
225sub new {
226    my $class = shift;
227    my @args = @_;
228    my $self = $class->SUPER::new(@args);
229    my $eutil_obj = shift @args;
230    my ($alias_hash, $prune_at_nodes, $no_parse, $make_index) = $self->_rearrange( [qw( ALIAS_HASH PRUNE_AT_NODES NO_PARSE INDEX_ACCESSORS ) ], @args);
231    $self->throw("Result constructor requires Bio::DB::SoapEUtilities ".
232		 "argument")
233	unless ($eutil_obj and
234		ref($eutil_obj) eq 'Bio::DB::SoapEUtilities');
235
236    $alias_hash ||= {};
237    $$alias_hash{ 'ids' } = ($ID_LIST_ELT{$eutil_obj->_caller_util} || 'IdList_Id');
238    if ($prune_at_nodes) {
239	$prune_at_nodes = [$prune_at_nodes] unless ref $prune_at_nodes;
240    }
241
242    $self->{'_util'} = $eutil_obj->_caller_util;
243    my $som = $self->{'_som'} = $eutil_obj->last_result;
244
245    return unless ( $som and ref($som) eq 'SOAP::SOM' );
246    return $self unless $self->ok; # SOAP fault
247
248    $self->{'_result_type'} = $eutil_obj->_soap_facs($self->util)->_result_elt_name;
249    $self->{'_accessors'} = [];
250    $self->{'_WebEnv'} = $som->valueof("//WebEnv");
251    $self->{'_QueryKey'} = $som->valueof("//QueryKey");
252    $self->{'_fetch_type'} = $eutil_obj->_soap_facs($self->util)->_wsdl->db;
253    $self->{'_fetch_db'} = ($self->util eq 'efetch' ?
254			    $eutil_obj->_soap_facs($self->util)->db :
255			    undef);
256
257    return ($no_parse ? $self : $self->parse_methods($alias_hash,
258						     $prune_at_nodes));
259}
260
261=head2 parse_methods()
262
263 Title   : parse_methods
264 Usage   :
265 Function: parse out the accessor methods
266 Returns : self (Result object)
267 Args    : $alias_hash (hashref), $prune_at_nodes (scalar or arrayref)
268
269=cut
270
271sub parse_methods {
272    my $self = shift;
273    # parse message into accessors
274    my ($alias_hash, $prune_at_nodes) = @_;
275
276    my @methods = keys %{$self->som->method};
277    my %methods;
278    foreach my $m (@methods) {
279	_traverse_methods($m, '/', '', $self->som, \%methods, $self->{'_accessors'}, $prune_at_nodes);
280    }
281    # convenience aliases...
282    if ($alias_hash && ref($alias_hash) eq 'HASH') {
283	for (keys %$alias_hash) {
284	    if ($methods{ $$alias_hash{$_} }) { # avoid undef'd accessors
285		$methods{$_} = $methods{ $$alias_hash{$_} };
286		push @{$self->{_accessors}}, $_;
287	    }
288	}
289    }
290    # specials...
291    if ($methods{Count}) {
292	push @{$self->{'_accessors'}}, 'count';
293	for (ref $methods{Count}) {
294	    /^$/ && do {
295		$methods{count} = $methods{Count};
296		last;
297	    };
298	    /ARRAY/ && do {
299		$methods{count} = $methods{Count}->[0];
300		last;
301	    };
302	}
303    }
304    else { #work harder
305	my @toplev = keys %{$self->som->method};
306	my ($set) = grep /^.*?S(et|um)$/, @toplev;
307	if ($set) {
308	    $methods{count} = 0;
309	    # kludge out NCBI inconsistencies
310	    my $stem = ($set =~ /(?:DocSum|LinkSet)/ ? "//Body/".$self->result_type."/*" :
311			"//$set/*");
312	    foreach ($self->som->valueof($stem)) {
313		$methods{count}++;
314	    }
315	}
316	push @{$self->{'_accessors'}}, 'count';
317    }
318    $self->_set_from_args( \%methods,
319			   -methods => $self->{'_accessors'},
320			   -case_sensitive => 1,
321			   -create => 1 );
322    return $self;
323
324}
325
326=head2 util()
327
328 Title   : util
329 Usage   :
330 Function: Name of the utility producing this result object.
331 Returns : scalar string
332 Args    :
333
334=cut
335
336sub util { shift->{'_util'} }
337
338=head2 som()
339
340 Title   : som
341 Usage   :
342 Function: get the original SOAP::SOM object
343 Returns : a SOAP::SOM object
344 Args    : none
345
346=cut
347
348sub som { shift->{'_som'} }
349
350=head2 ok()
351
352 Title   : ok
353 Usage   :
354 Function:
355 Returns : true if no SOAP fault
356 Args    :
357
358=cut
359
360sub ok { !(shift->som->fault) }
361
362=head2 errstr()
363
364 Title   : errstr
365 Usage   :
366 Function:
367 Returns : fault string of SOAP object
368 Args    : none
369
370=cut
371
372sub errstr { shift->som->faultstring }
373
374=head2 accessors()
375
376 Title   : accessors
377 Usage   :
378 Function: get the list of created accessors for this
379           result
380 Returns : array of scalar strings
381 Args    : none
382 Note    : does not include valid AUTOLOADed accessors; see
383           DESCRIPTION
384
385=cut
386
387sub accessors { my $a = shift->{'_accessors'} ; @$a if $a }
388
389=head2 webenv()
390
391 Title   : webenv
392 Usage   :
393 Function: contains WebEnv key referencing this
394           result's session
395 Returns : scalar
396 Args    : none
397
398=cut
399
400sub webenv { shift->{'_WebEnv'} }
401
402=head2 query_key()()
403
404 Title   : query_key()
405 Usage   :
406 Function: contains the web query key assigned
407           to this result
408 Returns : scalar
409 Args    :
410
411=cut
412
413sub query_key { shift->{'_QueryKey'} }
414
415=head2 fetch_type()
416
417 Title   : fetch_type
418 Usage   :
419 Function: Get the efetch database name according to WSDL
420 Returns : scalar string (db name) or undef if N/A
421 Args    : none
422
423=cut
424
425sub fetch_type { shift->{'_fetch_type'} }
426
427sub fetch_db { shift->{'_fetch_db'} }
428
429sub result_type { shift->{'_result_type'} }
430
431sub _traverse_methods {
432    my ($m, $skey, $key, $som, $hash, $acc, $prune) = @_;
433    if ($prune) {
434	foreach (@$prune) {
435	    return if "$skey\/$m" =~ /^$_/;
436	}
437    }
438    my $val = $som->valueof("$skey\/$m");
439    for (ref $val) {
440	/^$/ && do {
441	    my @a = $som->valueof("$skey\/$m");
442	    my $M = $m;
443	    # camelcase it
444	    $M =~ s/([-_])([a-zA-Z0-9])/\u$2/g;
445	    my $k = ($key ? "$key\_" : "").$M;
446	    push @{$acc}, $k;
447	    if (@a == 1) {
448		$$hash{$k} = $a[0];
449	    }
450	    else {
451		$$hash{$k} = \@a;
452	    }
453	    return;
454	};
455	/HASH/ && do {
456	    foreach my $k (keys %$val) {
457	    my $M = $m;
458	    # camelcase it
459	    $M =~ s/([-_])([a-zA-Z0-9])/\u$2/g;
460	    _traverse_methods( $k, "$skey\/$m",
461			       ($key ? "$key\_" : "").$M,
462				   $som, $hash, $acc, $prune );
463	    }
464	    return;
465	};
466	do { #else, huh?
467	    Bio::Root::Root->throw("SOAP::SOM parse error : please contact the mailing list");
468	};
469    }
470}
471
472sub AUTOLOAD {
473    my $self = shift;
474    my $accessor = $AUTOLOAD;
475    $accessor =~ s/.*:://;
476    my @list = grep /^${accessor}_/, @{$self->{'_accessors'}};
477    unless (@list) {
478	$self->debug("Accessor '$accessor' not present in this result");
479	return;
480    }
481    my %ret;
482    foreach (@list) {
483	$ret{$_} = $self->$_;
484    }
485    return \%ret;
486}
487
4881;
489