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