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