1# $Id$ 2# 3# BioPerl module for Bio::DB::SoapEUtilities::DocSumAdaptor 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::DocSumAdaptor - Handle for Entrez SOAP DocSums 18 19=head1 SYNOPSIS 20 21 my $fac = Bio::DB::SoapEUtilities->new(); 22 # run a query, returning a DocSumAdaptor 23 my $docs = $fac->esummary( -db => 'taxonomy', 24 -id => 527031 )->run(-auto_adapt=>1); 25 # iterate over docsums 26 while (my $d = $docs->next_docsum) { 27 @available_items = $docsum->item_names; 28 # any available item can be called as an accessor 29 # from the docsum object...watch your case... 30 $sci_name = $d->ScientificName; 31 $taxid = $d->TaxId; 32 } 33 34=head1 DESCRIPTION 35 36This adaptor provides an iterator (C<next_docsum()>) and other 37convenience functions for parsing NCBI Entrez EUtility C<esummary> 38SOAP results. 39 40=head1 FEEDBACK 41 42=head2 Mailing Lists 43 44User feedback is an integral part of the evolution of this and other 45Bioperl modules. Send your comments and suggestions preferably to 46the Bioperl mailing list. Your participation is much appreciated. 47 48 bioperl-l@bioperl.org - General discussion 49http://bioperl.org/wiki/Mailing_lists - About the mailing lists 50 51=head2 Support 52 53Please direct usage questions or support issues to the mailing list: 54 55L<bioperl-l@bioperl.org> 56 57rather than to the module maintainer directly. Many experienced and 58reponsive experts will be able look at the problem and quickly 59address it. Please include a thorough description of the problem 60with code and data examples if at all possible. 61 62=head2 Reporting Bugs 63 64Report bugs to the Bioperl bug tracking system to help us keep track 65of the bugs and their resolution. Bug reports can be submitted via 66the web: 67 68 http://redmine.open-bio.org/projects/bioperl/ 69 70=head1 AUTHOR - Mark A. Jensen 71 72Email maj -at- fortinbras -dot- us 73 74=head1 APPENDIX 75 76The rest of the documentation details each of the object methods. 77Internal methods are usually preceded with a _ 78 79=cut 80 81# Let the code begin... 82 83 84package Bio::DB::SoapEUtilities::DocSumAdaptor; 85use strict; 86 87# Object preamble - inherits from Bio::Root::Root 88 89use Bio::Root::Root; 90 91use base qw(Bio::Root::Root ); 92 93=head2 new 94 95 Title : new 96 Usage : my $obj = new Bio::DB::SoapEUtilities::DocSumAdaptor(); 97 Function: Builds a new Bio::DB::SoapEUtilities::DocSumAdaptor object 98 Returns : an instance of Bio::DB::SoapEUtilities::DocSumAdaptor 99 Args : 100 101=cut 102 103sub new { 104 my ($class,@args) = @_; 105 my $self = $class->SUPER::new(@args); 106 my ($result) = $self->_rearrange([qw(RESULT)], @args); 107 $self->throw("DocSumAdaptor requires a SoapEUtilities::Result argument") 108 unless $result; 109 $self->throw("DocSumAdaptor only works with elink results") unless 110 $result->util eq 'esummary'; 111 $self->{'_result'} = $result; 112 $self->{'_idx'} = 1; 113 return $self; 114} 115 116sub result { shift->{'_result'} } 117 118=head2 next_docsum() 119 120 Title : next_docsum 121 Usage : 122 Function: return the next DocSum from the attached Result 123 Returns : 124 Args : 125 126=cut 127 128sub next_docsum { 129 my $self = shift; 130 my $stem = "//Body/".$self->result->result_type."/[".$self->{'_idx'}."]"; 131 my $som = $self->result->som; 132 return unless $som->valueof($stem); 133 my ($ret, %params); 134 my $get = sub { $som->valueof("$stem/".shift) }; 135 136 $params{'-id'} = $get->('Id'); 137 138 my $names = []; 139 for (my $i = 1; my $data = $som->dataof("$stem/[$i]"); $i++) { 140 if ( $data->value and $data->value !~ /^\s*$/) { 141 my $name = $data->attr->{'Name'}; 142 next unless $name; 143 my $content = $som->valueof("$stem/[$i]/ItemContent"); 144 unless (defined $content) { 145 next unless $som->dataof("$stem/[$i]/Item"); 146 my $h = {}; 147 _traverse_items("$stem/[$i]", $som, $h); 148 $content = $h; 149 } 150 push @$names, $name; 151 $params{$name} = $content; 152 } 153 } 154 $params{'_item_names'} = $names; 155 my $class = ref($self)."::docsum"; 156 $ret = $class->new(%params); 157 ($self->{'_idx'})++; 158 return $ret; 159} 160 161sub next_obj { shift->next_docsum(@_) } 162 163sub rewind { shift->{'_idx'} = 1; }; 164 165sub _traverse_items { 166 my ($stem, $som, $h) = @_; 167 for (my $i = 1; my $data = $som->dataof($stem."/[$i]"); $i++) { 168 my $name = $data->attr->{'Name'}; 169 next unless $name; 170 if ($name =~ /Type$/) { 171 # clip out this node 172 _traverse_items("$stem/[$i]", $som, $h); 173 } 174 else { 175 my $content = $som->valueof("$stem/[$i]/ItemContent"); 176 if ($content) { 177 $$h{$name} = $content; 178 } 179 else { 180 $$h{$name} = {}; 181 _traverse_items("$stem/[$i]", $som, $$h{$name}); 182 } 183 } 184 } 185 return; 186} 187 1881; 189 190#### 191package Bio::DB::SoapEUtilities::DocSumAdaptor::docsum; 192use strict; 193use warnings; 194 195use base qw(Bio::Root::Root); 196 197sub new { 198 my ($class, @args) = @_; 199 my $self = $class->SUPER::new(@args); 200 my %args = @args; 201 $self->_set_from_args( \%args, 202 -methods => [map { /^-?(.*)/ } keys %args], 203 -create => 1, 204 -code => 205 'my $self = shift; 206 my $d = shift; 207 my $k = \'_\'.$method; 208 $self->{$k} = $d if $d; 209 return (ref($self->{$k}) eq \'ARRAY\' ? 210 @{$self->{$k}} : $self->{$k});' 211 212 ); 213 return $self; 214} 215 216=head2 item_names() 217 218 Title : item_names 219 Usage : @accs = $docsum->item_names 220 Function: Return a list of items accessible from the 221 object 222 Returns : array of scalar strings 223 Args : none 224 225=cut 226 227sub item_names { my $a = shift->{'__item_names'} ; return @$a if $a } 228 2291; 230