From a54838dcd09148688659f46097f4bb1e4877b9b9 Mon Sep 17 00:00:00 2001 From: cjfields Date: Mon, 15 Dec 2008 18:09:38 +0000 Subject: [PATCH] Updates: * simplify data dumping/printing (everything implements to_string, calls as needed) * round out the print_* methods (DocSums, LinkSets, LinkInfo, FieldInfo, GlobalQuery, all) svn path=/bioperl-live/trunk/; revision=15160 --- Bio/DB/EUtilities.pm | 116 ++++++++++-- Bio/Tools/EUtilities.pm | 286 ++++++++++++++++-------------- Bio/Tools/EUtilities/Cookie.pm | 2 +- Bio/Tools/EUtilities/EUtilDataI.pm | 46 ++++- Bio/Tools/EUtilities/EUtilParameters.pm | 16 +- Bio/Tools/EUtilities/History.pm | 26 ++- Bio/Tools/EUtilities/Info.pm | 28 ++- Bio/Tools/EUtilities/Info/FieldInfo.pm | 30 ++++ Bio/Tools/EUtilities/Info/LinkInfo.pm | 73 +++++++- Bio/Tools/EUtilities/Link.pm | 22 ++- Bio/Tools/EUtilities/Link/LinkSet.pm | 192 +++++++++++++++++--- Bio/Tools/EUtilities/Link/UrlLink.pm | 52 +++++- Bio/Tools/EUtilities/Query.pm | 44 ++++- Bio/Tools/EUtilities/Query/GlobalQuery.pm | 20 +++ Bio/Tools/EUtilities/Summary.pm | 26 +++ Bio/Tools/EUtilities/Summary/DocSum.pm | 40 +++-- Bio/Tools/EUtilities/Summary/Item.pm | 99 +++++++++-- 17 files changed, 883 insertions(+), 235 deletions(-) diff --git a/Bio/DB/EUtilities.pm b/Bio/DB/EUtilities.pm index 50c58112c..898eb9a65 100644 --- a/Bio/DB/EUtilities.pm +++ b/Bio/DB/EUtilities.pm @@ -368,6 +368,47 @@ sub datatype { return $self->get_Parser->datatype(@args); } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Implemented in plugins + +=cut + +sub to_string { + my ($self, @args) = @_; + return $self->get_Parser->to_string(@args); +} + +=head2 print_all + + Title : print_all + Usage : $info->print_all(); + $info->print_all(-fh => $fh, -cb => $coderef); + Function : prints (dumps) all data in parser. Unless a coderef is supplied, + this just dumps the parser-specific to_string method to either a + file/fh or STDOUT + Returns : none + Args : [optional] + -file : file to print to + -fh : filehandle to print to (cannot be used concurrently with file) + -cb : coderef to use in place of default print method. This is passed + in a LinkSet object + -wrap : number of columns to wrap default text output to (def = 80) + Notes : only applicable for einfo. If -file or -fh are not defined, + prints to STDOUT + +=cut + +sub print_all { + my ($self, @args) = @_; + return $self->get_Parser->print_all(@args); +} + =head1 Methods useful for multiple eutils =head2 get_ids @@ -693,6 +734,31 @@ sub get_GlobalQueries { return $self->get_Parser->get_GlobalQueries(@args); } +=head2 print_GlobalQueries + + Title : print_GlobalQueries + Usage : $docsum->print_GlobalQueries(); + $docsum->print_GlobalQueries(-fh => $fh, -cb => $coderef); + Function : prints item data for all global queries. The default printing + method is each item per DocSum is printed with relevant values if + present in a simple table using Text::Wrap. + Returns : none + Args : [optional] + -file : file to print to + -fh : filehandle to print to (cannot be used concurrently with file) + -cb : coderef to use in place of default print method. This is passed + in a GlobalQuery object; + -wrap : number of columns to wrap default text output to (def = 80) + Notes : only applicable for esummary. If -file or -fh are not defined, + prints to STDOUT + +=cut + +sub print_GlobalQueries { + my ($self, @args) = @_; + return $self->get_Parser->print_GlobalQueries(@args); +} + =head1 Summary-related methods =head2 next_DocSum @@ -731,7 +797,7 @@ sub get_DocSums { Title : print_DocSums Usage : $docsum->print_DocSums(); - $docsum->print_DocSums(-fh => $fh, -callback => $coderef); + $docsum->print_DocSums(-fh => $fh, -cb => $coderef); Function : prints item data for all docsums. The default printing method is each item per DocSum is printed with relevant values if present in a simple table using Text::Wrap. @@ -742,9 +808,6 @@ sub get_DocSums { -cb : coderef to use in place of default print method. This is passed in a DocSum object; -wrap : number of columns to wrap default text output to (def = 80) - -header : flag/callback for printing main eutil information. - If this is true, checked for a code reference for passing - self to, otherwise defaults to a preset code ref (def = 0) Notes : only applicable for esummary. If -file or -fh are not defined, prints to STDOUT @@ -911,7 +974,7 @@ sub get_LinkInfo { Title : print_FieldInfo Usage : $info->print_FieldInfo(); - $info->print_FieldInfo(-fh => $fh, -callback => $coderef); + $info->print_FieldInfo(-fh => $fh, -cb => $coderef); Function : prints field data for each FieldInfo object. The default method prints data from each FieldInfo in a simple table using Text::Wrap. Returns : none @@ -920,7 +983,6 @@ sub get_LinkInfo { -fh : filehandle to print to (cannot be used concurrently with file) -cb : coderef to use in place of default print method. -wrap : number of columns to wrap default text output to (def = 80) - -header : flag to print databases-specific header information (def = 0) Note : if -file or -fh are not defined, prints to STDOUT =cut @@ -930,22 +992,20 @@ sub print_FieldInfo { return $self->get_Parser->print_FieldInfo(@args); } -=head2 print_FieldInfo +=head2 print_LinkInfo - Title : print_FieldInfo - Usage : $info->print_FieldInfo(); - $info->print_FieldInfo(-fh => $fh, -callback => $coderef); - Function : prints field data for each FieldInfo object. The default method - prints data from each FieldInfo in a simple table using Text::Wrap. + Title : print_LinkInfo + Usage : $info->print_LinkInfo(); + $info->print_LinkInfo(-fh => $fh, -cb => $coderef); + Function : prints link data for each LinkInfo object. The default is generated + via LinkInfo::to_string Returns : none Args : [optional] -file : file to print to -fh : filehandle to print to (cannot be used concurrently with file) - -cb : coderef to use in place of default print method. + -cb : coderef to use in place of default print method. This is passed + in a LinkInfo object; -wrap : number of columns to wrap default text output to (def = 80) - -header : flag/callback for printing main eutil information. - If this is true, checked for a code reference for passing - self to, otherwise defaults to a preset code ref (def = 0) Notes : only applicable for einfo. If -file or -fh are not defined, prints to STDOUT @@ -993,6 +1053,30 @@ sub get_LinkSets { return $self->get_Parser->get_LinkSets(@args); } +=head2 print_LinkSets + + Title : print_LinkSets + Usage : $info->print_LinkSets(); + $info->print_LinkSets(-fh => $fh, -cb => $coderef); + Function : prints link data for each LinkSet object. The default is generated + via LinkSet::to_string + Returns : none + Args : [optional] + -file : file to print to + -fh : filehandle to print to (cannot be used concurrently with file) + -cb : coderef to use in place of default print method. This is passed + in a LinkSet object + -wrap : number of columns to wrap default text output to (def = 80) + Notes : only applicable for einfo. If -file or -fh are not defined, + prints to STDOUT + +=cut + +sub print_LinkSets { + my ($self, @args) = @_; + return $self->get_Parser->print_LinkSets(@args); +} + =head2 get_linked_databases Title : get_linked_databases diff --git a/Bio/Tools/EUtilities.pm b/Bio/Tools/EUtilities.pm index 202796b91..5d09f816b 100644 --- a/Bio/Tools/EUtilities.pm +++ b/Bio/Tools/EUtilities.pm @@ -433,6 +433,48 @@ sub parse_chunk { } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Implemented in plugins + +=cut + +sub to_string { + my $self = shift; + $self->parse_data if ($self->can('parse_data') && !$self->data_parsed); + return sprintf("%-20s:%s\n\n", 'EUtil', $self->eutil); +} + +=head2 print_all + + Title : print_all + Usage : $info->print_all(); + $info->print_all(-fh => $fh, -cb => $coderef); + Function : prints (dumps) all data in parser. Unless a coderef is supplied, + this just dumps the parser-specific to_string method to either a + file/fh or STDOUT + Returns : none + Args : [optional] + -file : file to print to + -fh : filehandle to print to (cannot be used concurrently with file) + -cb : coderef to use in place of default print method. This is + passed in the parser object + -wrap : number of columns to wrap default text output to (def = 80) + Notes : only applicable for einfo. If -file or -fh are not defined, + prints to STDOUT + +=cut + +sub print_all { + my ($self, @args) = @_; + $self->_print_handler(@args); +} + =head1 Bio::Tools::EUtilities::EUtilDataI methods =head2 eutil @@ -492,8 +534,10 @@ sub get_ids { push @ids, map {$_->get_ids } grep { $request->($_) } $self->get_LinkSets; } else { - push @ids, map {$_->get_ids } - grep {$_->get_dbto eq $request} $self->get_LinkSets; + push @ids, + map { @{$_->[0]} } + grep {grep { $_ eq $request } @{$_->[1]}} + map {[[$_->get_ids], [$_->get_databases]]} $self->get_LinkSets; } } else { $self->warn('Multiple database present, IDs will be globbed together') @@ -528,7 +572,6 @@ sub get_ids { Notes : egquery : first db in the query (you probably want get_databases) einfo : the queried database espell : the queried database - elink : from parameter_base->dbfrom or undef all others : from parameter_base->db or undef =cut @@ -556,8 +599,9 @@ sub get_db { database use the convenience method get_db/get_database egquery : list of all databases in the query - einfo : the queried database + einfo : the queried database, or the available databases espell : the queried database + elink : collected from each LinkSet all others : from parameter_base->db or undef =cut @@ -568,9 +612,16 @@ sub get_databases { my $eutil = $self->eutil; my @dbs; if ($eutil eq 'einfo' || $eutil eq 'espell') { - @dbs = $self->{'_dbname'} || $self->{'_database'}; + @dbs = $self->{'_dbname'} || + $self->{'_database'} || + $self->get_available_databases; } elsif ($eutil eq 'egquery') { @dbs = map {$_->get_database} ($self->get_GlobalQueries); + } elsif ($eutil eq 'elink') { + # only unique dbs + my %tmp; + @dbs = sort grep {!$tmp{$_}++} + map {($_->get_databases)} $self->get_LinkSets; } elsif ($self->parameter_base) { if ($self->parameter_base->eutil eq 'elink') { @dbs = $self->parameter_base->dbfrom; @@ -861,6 +912,31 @@ sub get_GlobalQueries { ref $self->{'_globalqueries'} ? return @{ $self->{'_globalqueries'} } : return (); } +=head2 print_GlobalQueries + + Title : print_GlobalQueries + Usage : $docsum->print_GlobalQueries(); + $docsum->print_GlobalQueries(-fh => $fh, -callback => $coderef); + Function : prints item data for all global queries. The default printing + method is each item per DocSum is printed with relevant values if + present in a simple table using Text::Wrap. + Returns : none + Args : [optional] + -file : file to print to + -fh : filehandle to print to (cannot be used concurrently with file) + -cb : coderef to use in place of default print method. This is passed + in a GlobalQuery object; + -wrap : number of columns to wrap default text output to (def = 80) + Notes : only applicable for esummary. If -file or -fh are not defined, + prints to STDOUT + +=cut + +sub print_GlobalQueries { + my ($self, @args) = @_; + $self->_print_handler(@args, -type => 'GlobalQuery'); +} + =head1 Summary-related methods =head2 next_DocSum @@ -909,20 +985,16 @@ sub get_DocSums { Title : print_DocSums Usage : $docsum->print_DocSums(); - $docsum->print_DocSums(-fh => $fh, -callback => $coderef); - Function : prints item data for all docsums. The default printing method is - each item per DocSum is printed with relevant values if present - in a simple table using Text::Wrap. + $docsum->print_DocSums(-fh => $fh, -cb => $coderef); + Function : prints item data for all docsums. The default data is generated + via DocSum::to_string Returns : none Args : [optional] -file : file to print to -fh : filehandle to print to (cannot be used concurrently with file) -cb : coderef to use in place of default print method. This is passed - in a DocSum object; + in a DocSum object -wrap : number of columns to wrap default text output to (def = 80) - -header : flag/callback for printing main eutil information. - If this is true, checked for a code reference for passing - self to, otherwise defaults to a preset code ref (def = 0) Notes : only applicable for esummary. If -file or -fh are not defined, prints to STDOUT @@ -1106,18 +1178,16 @@ sub get_LinkInfo { Title : print_FieldInfo Usage : $info->print_FieldInfo(); - $info->print_FieldInfo(-fh => $fh, -callback => $coderef); - Function : prints field data for each FieldInfo object. The default method - prints data from each FieldInfo in a simple table using Text::Wrap. + $info->print_FieldInfo(-fh => $fh, -cb => $coderef); + Function : prints link data for each FieldInfo object. The default is generated + via FieldInfo::to_string Returns : none Args : [optional] -file : file to print to -fh : filehandle to print to (cannot be used concurrently with file) - -cb : coderef to use in place of default print method. + -cb : coderef to use in place of default print method. This is + passed in a FieldInfo object -wrap : number of columns to wrap default text output to (def = 80) - -header : flag/callback for printing main eutil information. - If this is true, checked for a code reference for passing - self to, otherwise defaults to a preset code ref (def = 0) Notes : only applicable for einfo. If -file or -fh are not defined, prints to STDOUT @@ -1132,19 +1202,16 @@ sub print_FieldInfo { Title : print_LinkInfo Usage : $info->print_LinkInfo(); - $info->print_LinkInfo(-fh => $fh, -callback => $coderef); - Function : prints link data for each LinkInfo object. The default method - prints data from each LinkInfo in a simple table using Text::Wrap. + $info->print_LinkInfo(-fh => $fh, -cb => $coderef); + Function : prints link data for each LinkInfo object. The default is generated + via LinkInfo::to_string Returns : none Args : [optional] -file : file to print to -fh : filehandle to print to (cannot be used concurrently with file) -cb : coderef to use in place of default print method. This is passed - in a DocSum object; + in a LinkInfo object -wrap : number of columns to wrap default text output to (def = 80) - -header : flag/callback for printing main eutil information. - If this is true, checked for a code reference for passing - self to, otherwise defaults to a preset code ref (def = 0) Notes : only applicable for einfo. If -file or -fh are not defined, prints to STDOUT @@ -1203,6 +1270,30 @@ sub get_LinkSets { return ref $self->{'_linksets'} ? @{ $self->{'_linksets'} } : return (); } +=head2 print_LinkSets + + Title : print_LinkSets + Usage : $info->print_LinkSets(); + $info->print_LinkSets(-fh => $fh, -cb => $coderef); + Function : prints link data for each LinkSet object. The default is generated + via LinkSet::to_string + Returns : none + Args : [optional] + -file : file to print to + -fh : filehandle to print to (cannot be used concurrently with file) + -cb : coderef to use in place of default print method. This is passed + in a LinkSet object + -wrap : number of columns to wrap default text output to (def = 80) + Notes : only applicable for einfo. If -file or -fh are not defined, + prints to STDOUT + +=cut + +sub print_LinkSets { + my ($self, @args) = @_; + $self->_print_handler(@args, -type => 'LinkSet'); +} + =head2 get_linked_databases Title : get_linked_databases @@ -1210,26 +1301,14 @@ sub get_LinkSets { Function : returns list of databases linked to in linksets Returns : array of databases Args : none - Notes : only applicable for elink. + Notes : only applicable for elink. Now defers to get_databases. =cut sub get_linked_databases { my $self = shift; - if ($self->is_lazy) { - $self->warn('get_linked_databases() not implemented when using lazy mode'); - return (); - } - $self->parse_data unless $self->data_parsed; - unless (exists $self->{'_linked_db'}) { - my %temp; - # make sure unique db is returned - # do the linksets have a db? (URLs, db checks do not) - - push @{$self->{'_linked_db'}}, map {$_->get_dbto} - grep { $_->get_dbto ? !$temp{$_->get_dbto}++: 0 } $self->get_LinkSets; - } - return @{$self->{'_linked_db'}}; + return $self->get_databases if $self->eutil eq 'elink'; + return (); } =head1 Iterator- and callback-related methods @@ -1413,128 +1492,63 @@ sub callback { # Object printing methods { - my $DEF_FIELDINFO = sub { - my $i = shift; - # order method name - my %tags = (1 => ['get_field_code' => 'Field Code'], - 2 => ['get_field_name' => 'Field Name'], - 3 => ['get_field_description' => 'Description'], - 4 => ['get_term_count' => 'Term Count']); - my $string = ''; - for my $tag (sort {$a <=> $b} keys %tags) { - my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]); - $string .= sprintf("%-15s%s\n", $nm, wrap('', ' 'x16, ":".$i->$m)); - } - $string .= sprintf("%-15s%s\n", "Attributes", - wrap('', ' 'x16, ":".join(',', grep {$i->$_} qw(is_date - is_singletoken is_hierarchy is_hidden is_numerical)))); - $string .= "\n"; - return $string; - }; - - my $DEF_LINKINFO = sub { - my $i = shift; - # order method name - my %tags = (1 => ['get_link_name' => 'Link Name'], - 2 => ['get_link_description' => 'Description'], - 3 => ['get_dbfrom' => 'DB From'], - 4 => ['get_dbto' => 'DB To']); - my $string = ''; - for my $tag (sort {$a <=> $b} keys %tags) { - my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]); - $string .= sprintf("%-15s%s\n", $nm, wrap('', ' 'x16, ":".$i->$m)); - } - $string .= "\n"; - return $string; - }; - - my $DEF_DOCSUM = sub { - my $ds = shift; - my $string = sprintf("UID: %s\n",$ds->get_id); - # flattened mode - while (my $item = $ds->next_Item('flatten')) { - # not all Items have content, so need to check... - my $content = $item->get_content || ''; - $string .= sprintf("%-20s%s\n",$item->get_name(), - wrap('',' 'x21, ":$content")); - } - $string .= "\n"; - return $string; - }; - - my $DEF_EINFO_HEADER = sub { + my $DEF_HANDLER = sub { my $obj = shift; - # order method name - my %tags = (1 => ['get_database' => 'Database Name'], - 2 => ['get_description' => 'Description'], - 3 => ['get_menu_name' => 'Menu Name'], - 4 => ['get_record_count' => 'Records'], - 5 => ['get_last_update' => 'Last Updated']); - my $string = ''; - for my $tag (sort {$a <=> $b} keys %tags) { - my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]); - $string .= sprintf("%-15s%s\n", $nm, wrap('', ' 'x16, ":".$obj->$m)); - } - $string .= "\n"; - return $string; + return $obj->to_string."\n"; }; my %HANDLER = ( - 'DocSum' => $DEF_DOCSUM, - 'FieldInfo' => $DEF_FIELDINFO, - 'LinkInfo' => $DEF_LINKINFO, + 'DocSum' => 1, + 'FieldInfo' => 1, + 'LinkInfo' => 1, + 'GlobalQuery' => 1, + 'LinkSet' => 1, + 'all' => 1, ); - my %HEADER = ( - 'FieldInfo' => $DEF_EINFO_HEADER, - 'LinkInfo' => $DEF_EINFO_HEADER, - ); - sub _print_handler { my $self = shift; - my ($file, $fh, $cb, $wrap, $type, $header) = $self->_rearrange([qw(FILE FH CB WRAP TYPE HEADER)], @_); - $self->throw("Must define object type for handler") if !defined $type; - $wrap ||= 80; + my ($file, $fh, $cb, $wrap, $type, $all) = $self->_rearrange([qw(FILE FH CB WRAP TYPE ALL)], @_); + $type ||= 'all'; + + # default formatting delegates to_string if (!$cb) { - $self->throw("Type $type not registered with print handler, exiting") unless exists - $HANDLER{$type}; - eval {use Text::Wrap qw(wrap $columns);}; - $self->throw("Text::Wrap is not available!") if $@; - $Text::Wrap::columns = $wrap; - $cb = $HANDLER{$type}; + $self->throw("Type $type not registered with print handler, exiting...") + if !exists($HANDLER{$type}); + $cb = $DEF_HANDLER; } else { $self->throw("Callback must be a code reference") if ref $cb ne 'CODE'; } + $file ||= $fh; $self->throw("Have defined both file and filehandle; only use one!") if $file && $fh; my $io = ($file) ? Bio::Root::IO->new(-input => $file, -flush => 1) : Bio::Root::IO->new(-flush => 1); # defaults to STDOUT - my $it = "next_$type"; - $self->throw("Unknown iterator method $it") unless $self->can($it); - if ($header) { - my $headercb = ref($header) eq 'CODE' ? $header : - exists($HEADER{$type}) ? $HEADER{$type}: - $self->throw("Default header code for $type not set"); - my $string = $headercb->($self); - $io->_print($string) if $string; - } - while (my $obj = $self->$it) { - my $string = $cb->($obj); + + if ($type eq 'all') { + my $string = $cb->($self); $io->_print($string) if $string; + } else { + # set up iterator + my $it = "next_$type"; + $self->throw("Unknown iterator method $it") unless $self->can($it); + while (my $obj = $self->$it) { + my $string = $cb->($obj); + $io->_print($string) if $string; + } } $io->close; } - } # Private methods -# fixes odd bad XML issue espell data (still present 6-24-07) - sub _seekable { return shift->{'_seekable'} } +# fixes odd bad XML issue espell data (still present 6-24-07) + sub _fix_espell { my ($self, $response) = @_; my $temp; diff --git a/Bio/Tools/EUtilities/Cookie.pm b/Bio/Tools/EUtilities/Cookie.pm index 56502ef97..9e2194883 100644 --- a/Bio/Tools/EUtilities/Cookie.pm +++ b/Bio/Tools/EUtilities/Cookie.pm @@ -79,7 +79,7 @@ methods are usually preceded with a _ # Let the code begin... -package Bio::Tools::EUtilities::Cookie; +package Bio::Tools::EUtilities::History; use strict; use warnings; diff --git a/Bio/Tools/EUtilities/EUtilDataI.pm b/Bio/Tools/EUtilities/EUtilDataI.pm index a83ad8f56..4f710bbf7 100644 --- a/Bio/Tools/EUtilities/EUtilDataI.pm +++ b/Bio/Tools/EUtilities/EUtilDataI.pm @@ -59,6 +59,7 @@ through the object constructor. package Bio::Tools::EUtilities::EUtilDataI; use strict; use warnings; +use Text::Wrap qw(wrap); use base qw(Bio::Root::RootI); @@ -105,6 +106,20 @@ sub datatype { return $self->{'_type'}; } +=head2 rewind + + Title : rewind + Usage : $esum->rewind + Function : rewinds the requested iterator + Returns : none + Args : [OPTIONAL] may include 'all', 'recursive', etc. + +=cut + +sub rewind { + shift->warn("Object may not need an iterator. Please check the documentation."); +} + =head2 _add_data Title : _add_data @@ -119,18 +134,35 @@ sub _add_data { shift->throw_not_implemented; } -=head2 rewind +=head2 to_string - Title : rewind - Usage : $esum->rewind - Function : rewinds the requested iterator + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string Returns : none - Args : [OPTIONAL] may include 'all', 'recursive', etc. + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for the print_* methods =cut -sub rewind { - shift->warn("Object may not need an iterator. Please check the documentation."); +sub to_string { + shift->throw_not_implemented; +} + +=head2 _text_wrap + + Title : _text_wrap + Usage : $foo->_text_wrap($string) + Function : private internal wrapper for Text::Wrap::wrap + Returns : string + Args : string + Note : Internal use only. Simple wrapper method. + +=cut + +sub _text_wrap { + shift; + return wrap(@_); } 1; diff --git a/Bio/Tools/EUtilities/EUtilParameters.pm b/Bio/Tools/EUtilities/EUtilParameters.pm index d519cb1af..36fbd7cd6 100644 --- a/Bio/Tools/EUtilities/EUtilParameters.pm +++ b/Bio/Tools/EUtilities/EUtilParameters.pm @@ -174,9 +174,11 @@ BEGIN { sub $method { my (\$self, \$val) = \@_; if (defined \$val) { - \$self->{'_statechange'} = 1 if (!defined \$self->{'_$method'}) || - (defined \$self->{'_$method'} && \$self->{'_$method'} ne \$val); - \$self->{'_$method'} = \$val; + if ((!defined \$self->{'_$method'}) || + (defined \$self->{'_$method'} && \$self->{'_$method'} ne \$val)) { + \$self->{'_statechange'} = 1; + \$self->{'_$method'} = \$val; + } } return \$self->{'_$method'}; } @@ -314,7 +316,7 @@ sub available_parameters { though subsets can be returned based on the '-type' parameter. Data originally set as an array ref are returned based on whether the '-join_id' flag is set (default is the same array ref). - Args : -eutil : the eutil name (Default: returns all). Use of '-list' + Args : -type : the eutil name (Default: returns all). Use of '-list' supercedes this -list : array ref of specific parameters -join_ids : Boolean; join IDs based on correspondence (Default: no join) @@ -448,8 +450,10 @@ sub eutil { my ($self, $eutil) = @_; if ($eutil) { $self->throw("$eutil not supported") if !exists $MODE{$eutil}; - $self->{'_eutil'} = $eutil; - $self->{'_statechange'} = 1; + if (!defined $self->{'_eutil'} || ($self->{'_eutil'} && $self->{'_eutil'} ne $eutil)) { + $self->{'_eutil'} = $eutil; + $self->{'_statechange'} = 1; + } } return $self->{'_eutil'}; } diff --git a/Bio/Tools/EUtilities/History.pm b/Bio/Tools/EUtilities/History.pm index 912f311a6..c1ebec73d 100644 --- a/Bio/Tools/EUtilities/History.pm +++ b/Bio/Tools/EUtilities/History.pm @@ -84,7 +84,6 @@ use strict; use warnings; use base qw(Bio::Root::Root Bio::Tools::EUtilities::HistoryI); -use Data::Dumper; sub new { my ($class, @args) = @_; @@ -137,5 +136,28 @@ sub _add_data { $self->{_querykey} = $simple->{QueryKey} && delete $simple->{QueryKey}; } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for the print_* methods + +=cut + +sub to_string { + my $self = shift; + my $string; + my %map = ( + 'get_webenv' => 'WebEnv', + 'get_query_key' => 'Key' + ); + for my $m (qw(get_webenv get_query_key)) { + $string .= sprintf("%-20s:%s\n", $map{$m}, $self->$m); + } + return $string; +} + 1; -__END__ diff --git a/Bio/Tools/EUtilities/Info.pm b/Bio/Tools/EUtilities/Info.pm index 1b1c8e87d..d9250667b 100644 --- a/Bio/Tools/EUtilities/Info.pm +++ b/Bio/Tools/EUtilities/Info.pm @@ -182,5 +182,31 @@ sub _add_data { } } -1; +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for various print methods +=cut + +sub to_string { + my $self = shift; + my $string = $self->SUPER::to_string; + if (my @dbs = $self->get_databases) { + $string .= sprintf("%-20s:%s\n\n", 'DB', + $self->_text_wrap('', ' 'x20 .':', join(', ',@dbs))); + } + while (my $fi = $self->next_FieldInfo) { + $string .= $fi->to_string."\n"; + } + while (my $li = $self->next_LinkInfo) { + $string .= $li->to_string."\n"; + } + return $string; +} + +1; diff --git a/Bio/Tools/EUtilities/Info/FieldInfo.pm b/Bio/Tools/EUtilities/Info/FieldInfo.pm index b1aaad9c0..65eb68387 100644 --- a/Bio/Tools/EUtilities/Info/FieldInfo.pm +++ b/Bio/Tools/EUtilities/Info/FieldInfo.pm @@ -280,5 +280,35 @@ sub _add_data { map { $self->{'_'.lc $_} = $simple->{$_} unless ref $simple->{$_}} keys %$simple; } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for various print methods + +=cut + +sub to_string { + my $self = shift; + # order method name + my %tags = (1 => ['get_field_code' => 'Field Code'], + 2 => ['get_field_name' => 'Field Name'], + 3 => ['get_field_description' => 'Description'], + 4 => ['get_term_count' => 'Term Count']); + my $string; + for my $tag (sort {$a <=> $b} keys %tags) { + my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]); + $string .= sprintf("%-20s%s\n", $nm, + $self->_text_wrap('', ' 'x20 .':', ":".$self->$m)); + } + $string .= sprintf("%-20s%s\n", "Attributes", + $self->_text_wrap('', ' 'x20 .':', ":".join(',', grep {$self->$_} qw(is_date + is_singletoken is_hierarchy is_hidden is_numerical)))); + return $string; +} + 1; diff --git a/Bio/Tools/EUtilities/Info/LinkInfo.pm b/Bio/Tools/EUtilities/Info/LinkInfo.pm index 113383aef..74472c731 100644 --- a/Bio/Tools/EUtilities/Info/LinkInfo.pm +++ b/Bio/Tools/EUtilities/Info/LinkInfo.pm @@ -29,7 +29,7 @@ Bio::Tools::EUtilities::Info::LinkInfo - class for storing einfo link data =head1 DESCRIPTION -This class handles data output (XML) from einfo. +This class handles data output (XML) from einfo and elink. einfo is capable of returning two types of information: 1) a list of all available databases (when called w/o parameters) and 2) information about a @@ -106,18 +106,37 @@ sub new { return $self; } -=head2 get_dbto +=head2 get_database - Title : get_dbto - Usage : my $refd_db = $link->get_dbto; - Function : returns database this link references (points to) + Title : get_database + Usage : my $db = $info->get_database; + Function : returns single database name (eutil-compatible). This is the + queried database. For elinks (which have 'db' and 'dbfrom') + this is equivalent to db/dbto (use get_dbfrom() to for the latter) Returns : string Args : none - Note : This is not the same as db()! (see DESCRIPTION for details) =cut -sub get_dbto { return shift->{'_dbto'} } +sub get_database { + return shift->{'_dbto'}; +} + +=head2 get_db (alias for get_database) + +=cut + +sub get_db { + return shift->get_database; +} + +=head2 get_dbto (alias for get_database) + +=cut + +sub get_dbto { + return shift->get_database; +} =head2 get_dbfrom @@ -225,5 +244,45 @@ sub _add_data { map { $self->{'_'.lc $_} = $simple->{$_} unless ref $simple->{$_}} keys %$simple; } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for various print methods + +=cut + +sub to_string { + my $self = shift; + my $level = shift || 0; + my $pad = 20 - $level; + # order method name + my %tags = (1 => ['get_link_name' => 'Link Name'], + 2 => ['get_link_description' => 'Description'], + 3 => ['get_dbfrom' => 'DB From'], + 4 => ['get_dbto' => 'DB To'], + 5 => ['get_link_menu_name' => 'Menu Name'], + 6 => ['get_priority' => 'Priority'], + 7 => ['get_html_tag' => 'HTML Tag'], + 8 => ['get_url' => 'URL'], + ); + my $string = ''; + for my $tag (sort {$a <=> $b} keys %tags) { + my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]); + my $content = $self->$m(); + next unless $content; + $string .= sprintf("%-*s%-*s%s\n", + $level, '', + $pad, $nm, + $self->_text_wrap(':', + ' ' x ($pad).':', + $content )); + } + return $string; +} + 1; diff --git a/Bio/Tools/EUtilities/Link.pm b/Bio/Tools/EUtilities/Link.pm index 148305879..d1ef78b97 100644 --- a/Bio/Tools/EUtilities/Link.pm +++ b/Bio/Tools/EUtilities/Link.pm @@ -130,6 +130,24 @@ sub _add_data { } -1; +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for various print methods + +=cut -__END__ +sub to_string { + my $self = shift; + my $string = $self->SUPER::to_string; + while (my $ls = $self->next_LinkSet) { + $string .= $ls->to_string; + } + return $string; +} + +1; diff --git a/Bio/Tools/EUtilities/Link/LinkSet.pm b/Bio/Tools/EUtilities/Link/LinkSet.pm index 704308f23..2820fd8f2 100644 --- a/Bio/Tools/EUtilities/Link/LinkSet.pm +++ b/Bio/Tools/EUtilities/Link/LinkSet.pm @@ -82,8 +82,17 @@ sub new { Title : get_ids Usage : my @ids = $linkset->get_ids Function : returns list of retrieved IDs - Returns : array or array ref of IDs + Returns : array of IDs Args : none + Notes : Cmd Description + acheck same as get_submitted_ids + lcheck same as get_submitted_ids + ncheck same as get_submitted_ids + prlinks same as get_submitted_ids + llinks same as get_submitted_ids + llinkslib same as get_submitted_ids + neighbor linked IDs for database in get_database + neighbor_history linked IDs for database in get_database =cut @@ -96,20 +105,71 @@ sub get_ids { $self->{'_id'}->{$b}->[0] } keys %{$self->{'_id'}}; } - return wantarray ? @{$self->{'_sorted_id'}} : $self->{'_sorted_id'}; + return @{$self->{'_sorted_id'}}; } -=head2 get_dbto +=head2 get_database - Title : get_dbto - Usage : my $string = $linkset->get_dbto; - Function : retrieve database referred to for this linkset + Title : get_database + Usage : my $db = $info->get_database; + Function : returns single database name (eutil-compatible). This is the + queried database. For elinks (which have 'db' and 'dbfrom') + this is equivalent to db/dbto (use get_dbfrom() to for the latter). + Note that this only returns the first db; in some cases this may + not be what you want (when multiple dbs are queried, for instance) Returns : string Args : none + Notes : with all elink cmd arguments =cut -sub get_dbto { return shift->{'_dbto'} } +sub get_database { + return ($_[0]->get_databases)[0]; +} + +=head2 get_db (alias for get_database) + +=cut + +sub get_db { + return shift->get_database; +} + +=head2 get_dbto (alias for get_database) + +=cut + +sub get_dbto { + return shift->get_database; +} + +=head2 get_databases + + Title : get_databases + Usage : my $string = $linkset->get_databases; + Function : retrieve databases referred to for this linkset + these may be present as a single database or embedded in + Returns : array of strings + Args : none + +=cut + +sub get_databases { + my $self = shift; + my %tmp; + my @dbs = sort map {$_->get_database} + grep {!$tmp{$_->get_database}++} ($self->get_LinkInfo); + unshift @dbs, $self->{'_dbto'} if $self->{'_dbto'} && !$tmp{$self->{'_dbto'}}++; + return @dbs; +} + +=head2 get_dbs (alias for get_databases) + +=cut + +sub get_dbs { + return shift->get_databases; +} =head2 get_dbfrom @@ -123,17 +183,45 @@ sub get_dbto { return shift->{'_dbto'} } sub get_dbfrom { return shift->{'_dbfrom'} } -=head2 get_linkname +=head2 get_link_names + + Title : get_link_names + Usage : my $string = $linkset->get_link_names; + Function : retrieve eutil-compatible link names + Returns : array of strings + Args : none + Notes : Each LinkSet can hold multiple LinkInfo objects (each containing + a link name). Also, some LinkSets define a single link name. This + returns an array with all unique linknames globbed both sources, if + present and defined - Title : get_linkname - Usage : my $string = $linkset->get_linkname; +=cut + +sub get_link_names { + my ($self) = shift; + my %tmps; + my @lns; + if ($self->{'_linkname'}) { + push @lns, $self->{'_linkname'}; + $tmps{$self->{'_linkname'}}++; + } + push @lns, map {$_->get_link_name} $self->get_LinkInfo; + return @lns; +} + +=head2 get_link_name + + Title : get_link_name + Usage : my $string = $linkset->get_link_name; Function : retrieve eutil-compatible link name - Returns : string + Returns : single link name Args : none =cut -sub get_linkname { return shift->{'_linkname'} } +sub get_link_name { + return ($_[0]->get_linknames)[0]; +} =head2 get_submitted_ids @@ -149,11 +237,11 @@ sub get_submitted_ids { my $self = shift; my $datatype = $self->datatype; if ($datatype eq 'idcheck' || $datatype eq 'urllink') { - return wantarray ? $self->get_ids : [$self->get_ids]; + return $self->get_ids; } elsif ($self->{'_submitted_ids'}) { - return wantarray ? @{$self->{'_submitted_ids'}} : $self->{'_submitted_ids'}; + return @{$self->{'_submitted_ids'}}; } else { - return wantarray ? () : undef; + return (); } } @@ -169,7 +257,7 @@ sub get_submitted_ids { sub has_scores { my $self = shift; - return exists $self->{'_has_scores'} ? $self->{'_has_scores'} : 0; + return exists $self->{'_has_scores'} ? 1 : 0; } =head2 get_scores @@ -188,7 +276,7 @@ sub get_scores { # called more than once... return unless $self->has_scores; my %scores = map {$_ => $self->{'_id'}->{$_}->[1]} keys %{$self->{'_id'}}; - return wantarray ? %scores : \%scores; + return %scores; } =head2 get_score_by_id @@ -213,8 +301,9 @@ sub get_score_by_id { Usage : if ($linkset->has_linkout) {...} Function : returns TRUE if the single ID present in this linkset has a linkout Returns : boolean - Args : none (uses the ID in get_ids(), which for these cases is always - only one) + Args : none + Notes : this checks cmd=lcheck (boolean for a linkout) and also backchecks + cmd=acheck for databases with name 'LinkOut' =cut @@ -222,10 +311,9 @@ sub has_linkout { my $self = shift; if (exists $self->{'_haslinkout'}) { return $self->{'_haslinkout'} eq 'Y' ? 1 : 0; - } else { - $self->warn('No data present; did you use cmd lcheck?'); - return; - } + } else { + return (grep {$_ eq 'LinkOut'} $self->get_databases) ? 1 : 0; + } } =head2 has_neighbor @@ -235,8 +323,9 @@ sub has_linkout { Function : returns TRUE if the single ID present in this linkset has a neighbor in the same database Returns : boolean - Args : none (uses the ID in get_ids(), which for these cases is always - only one) + Args : none + Notes : this checks cmd=ncheck (boolean for a neighbor in same database); no + other checks performed at this time =cut @@ -245,8 +334,7 @@ sub has_neighbor { if (exists $self->{'_hasneighbor'}) { return $self->{'_hasneighbor'} eq 'Y' ? 1 : 0; } else { - $self->warn('No data present; did you use cmd ncheck?'); - return; + return 0; } } @@ -428,6 +516,54 @@ sub _add_linkinfo { } } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for various print methods + +=cut + +sub to_string { + my $self = shift; + my $level = shift || 0; + my $pad = 20 - $level; + # order method name + my %tags = (1 => ['get_databases' => 'DB'], + 2 => ['get_ids' => 'ID'], + 3 => ['get_link_names' => 'Link Names'], + 5 => ['get_submitted_ids' => 'Submitted IDs'], + 6 => ['has_scores' => 'Scores?'], + 7 => ['has_linkout' => 'LinkOut?'], + 8 => ['has_neighbor' => 'DB Neighbors?'], + 9 => ['get_webenv' => 'WebEnv'], + 10 => ['get_query_key' => 'Key'], + ); + my $string; + for my $tag (sort {$a <=> $b} keys %tags) { + my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]); + # using this awkward little construct to deal with both lists and scalars + my @content = grep {defined $_} $self->$m(); + next unless @content; + $string .= sprintf("%-*s%-*s%s\n", + $level, '', + $pad, $nm, + $self->_text_wrap(':', + ' ' x ($pad).':', + join(', ',@content))); + } + while (my $li = $self->next_LinkInfo) { + $string .= $li->to_string(4); + } + while (my $ui = $self->next_UrlLink) { + $string .= $ui->to_string(4); + } + $string .= "\n"; + return $string; +} + 1; -__END__ diff --git a/Bio/Tools/EUtilities/Link/UrlLink.pm b/Bio/Tools/EUtilities/Link/UrlLink.pm index f29e2b20b..a7defc672 100644 --- a/Bio/Tools/EUtilities/Link/UrlLink.pm +++ b/Bio/Tools/EUtilities/Link/UrlLink.pm @@ -98,7 +98,7 @@ sub get_attribute { return shift->{'_attribute'}; } =cut -sub get_iconurl { return shift->{'_iconurl'}; } +sub get_icon_url { return shift->{'_iconurl'}; } =head2 get_subject_type @@ -179,9 +179,9 @@ sub get_provider_abbr { return shift->{'_provider_nameabbr'}; } sub get_provider_id { return shift->{'_provider_id'}[0]; } -=head2 get_provider_iconurl +=head2 get_provider_icon_url - Title : get_provider_iconurl + Title : get_provider_icon_url Usage : Function : Returns : @@ -189,7 +189,7 @@ sub get_provider_id { return shift->{'_provider_id'}[0]; } =cut -sub get_provider_iconurl { return shift->{'_provider_iconurl'}; } +sub get_provider_icon_url { return shift->{'_provider_iconurl'}; } =head2 get_provider_url @@ -215,6 +215,48 @@ sub _add_data { map {$self->{'_'.lc $_} = $data->{$_} if $data->{$_}} keys %$data; } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for various print methods + +=cut + +sub to_string { + my $self = shift; + my $level = shift || 0; + my $pad = 20 - $level; + # order method name + my %tags = (1 => ['get_link_name' => 'Link Name'], + 2 => ['get_subject_type' => 'Subject Type'], + 3 => ['get_dbfrom' => 'DB From'], + 4 => ['get_attribute' => 'Attribute'], + 6 => ['get_icon_url' => 'IconURL'], + 7 => ['get_url' => 'URL'], + 8 => ['get_provider_name' => 'Provider'], + 9 => ['get_provider_abbr' => 'ProvAbbr'], + 10 => ['get_provider_id' => 'ProvID'], + 11 => ['get_provider_url' => 'ProvURL'], + 12 => ['get_provider_icon_url' => 'ProvIcon'], + ); + my $string = ''; + for my $tag (sort {$a <=> $b} keys %tags) { + my ($m, $nm) = ($tags{$tag}->[0], $tags{$tag}->[1]); + my $content = $self->$m(); + next unless $content; + $string .= sprintf("%-*s%-*s%s\n", + $level, '', + $pad, $nm, + $self->_text_wrap(':', + ' ' x ($pad + $level).':', + $content )); + } + return $string; +} + 1; -__END__ diff --git a/Bio/Tools/EUtilities/Query.pm b/Bio/Tools/EUtilities/Query.pm index 55aaadaa0..24c6b74df 100644 --- a/Bio/Tools/EUtilities/Query.pm +++ b/Bio/Tools/EUtilities/Query.pm @@ -76,7 +76,6 @@ use strict; use warnings; use Bio::Tools::EUtilities::Query::GlobalQuery; use Bio::Tools::EUtilities::History; -use Data::Dumper; use base qw(Bio::Tools::EUtilities); @@ -137,5 +136,48 @@ sub _add_data { } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for the print_* methods + +=cut + +sub to_string { + my $self = shift; + my %data = ( + 'DB' => [1, join(', ',$self->get_databases) || ''], + 'Query' => [2, $self->get_term || ''], + 'IDs' => [4, join(', ',$self->get_ids) || ''], + ); + my $string = $self->SUPER::to_string; + if ($self->eutil eq 'esearch') { + $data{'Count'} = [3, $self->get_count ]; + $data{'Translation From'} = [5, $self->get_translation_from || '']; + $data{'Translation To'} = [6, $self->get_translation_to || '']; + $data{'RetStart'} = [7, $self->get_retstart]; + $data{'RetMax'} = [8, $self->get_retmax]; + $data{'Translation'} = [9, $self->get_query_translation || '']; + } + if ($self->eutil eq 'espell') { + $data{'Corrected'} = [3, $self->get_corrected_query || '']; + $data{'Replaced'} = [4, join(',',$self->get_replaced_terms) || '']; + } + for my $k (sort {$data{$a}->[0] <=> $data{$b}->[0]} keys %data) { + $string .= sprintf("%-20s:%s\n",$k, $self->_text_wrap('',' 'x 20 .':', $data{$k}->[1])); + } + while (my $h = $self->next_History) { + $string .= $h->to_string; + } + while (my $gq = $self->next_GlobalQuery) { + $string .= $gq->to_string; + } + return $string; +} + 1; diff --git a/Bio/Tools/EUtilities/Query/GlobalQuery.pm b/Bio/Tools/EUtilities/Query/GlobalQuery.pm index c901ce967..feca54879 100644 --- a/Bio/Tools/EUtilities/Query/GlobalQuery.pm +++ b/Bio/Tools/EUtilities/Query/GlobalQuery.pm @@ -94,6 +94,26 @@ sub _add_data { map {$self->{'_'.lc $_} = $data->{$_}} keys %$data; } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for the print_GlobalQuery method + +=cut + +sub to_string { + my $self = shift; + my $string .= sprintf("%-20s Total:%-10d Status:%s\n", + $self->get_database, + $self->get_count, + $self->get_status); + return $string; +} + 1; diff --git a/Bio/Tools/EUtilities/Summary.pm b/Bio/Tools/EUtilities/Summary.pm index 1e951b99b..0c86fa3dd 100644 --- a/Bio/Tools/EUtilities/Summary.pm +++ b/Bio/Tools/EUtilities/Summary.pm @@ -103,6 +103,32 @@ sub _add_data { } } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for the print_* methods + +=cut + +sub to_string { + my $self = shift; + my %data = ( + 'DB' => [1, join(', ',$self->get_databases) || ''], + ); + my $string = $self->SUPER::to_string."\n"; + for my $k (sort {$data{$a}->[0] <=> $data{$b}->[0]} keys %data) { + $string .= sprintf("%-20s:%s\n\n",$k, $self->_text_wrap('',' 'x 20 .':', $data{$k}->[1])); + } + while (my $ds = $self->next_DocSum) { + $string .= $ds->to_string."\n"; + } + return $string; +} + 1; __END__ diff --git a/Bio/Tools/EUtilities/Summary/DocSum.pm b/Bio/Tools/EUtilities/Summary/DocSum.pm index 8e13add31..33097b28c 100644 --- a/Bio/Tools/EUtilities/Summary/DocSum.pm +++ b/Bio/Tools/EUtilities/Summary/DocSum.pm @@ -194,23 +194,24 @@ sub get_all_Items { return @{$self->{'_ordered_items'}}; } -=head2 get_content_by_name +=head2 get_contents_by_name - Title : get_content_by_Item_name - Usage : my $data = get_content_by_name('CreateDate') - Function : Returns scalar content for named Item in DocSum (indicated by + Title : get_contents_by_name + Usage : my ($data) = get_contents_by_name('CreateDate') + Function : Returns content for named Item(s) in DocSum (indicated by passed argument) - Returns : scalar value (string) if present + Returns : array of laues Args : string (Item name) - Warns : If Item with name is not found =cut -sub get_content_by_name { +sub get_contents_by_name { my ($self, $key) = @_; return unless $key; - my ($it) = grep {$_->get_name eq $key} $self->get_all_Items; - return $it->get_content; + my @data = map {$_->get_content} + grep {$_->get_name eq $key} + $self->get_all_Items; + return @data; } =head2 get_type_by_name @@ -221,7 +222,6 @@ sub get_content_by_name { passed argument) Returns : scalar value (string) if present Args : string (Item name) - Warns : If Item with name is not found =cut @@ -270,4 +270,24 @@ sub _add_data { $self->{'_id'} = $data->{Id} if exists $data->{Id}; } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting + Note : Used generally for debugging and for various print methods + +=cut + +sub to_string { + my $self = shift; + my $string = sprintf("%-20s%s\n",'UID', ':'.$self->get_id); + while (my $item = $self->next_Item) { + $string .= $item->to_string; + } + return $string; +} + 1; \ No newline at end of file diff --git a/Bio/Tools/EUtilities/Summary/Item.pm b/Bio/Tools/EUtilities/Summary/Item.pm index 7e0ddb83f..017330277 100644 --- a/Bio/Tools/EUtilities/Summary/Item.pm +++ b/Bio/Tools/EUtilities/Summary/Item.pm @@ -18,8 +18,8 @@ Bio::DB::EUtilities::Summary::Item - simple layered object for DocSum item data =head1 SYNOPSIS - # Items can be nested up to three levels at this time (Item, ListItem, - # StructureItem). + # Items can be nested up to three levels at this time. These levels can be + # accessed via Item, ListItem, or StructureItem methods: while (my $item = $docsum->next_Item) { print "Name: ",$item->get_name,"\n"; @@ -51,7 +51,8 @@ ListItems (Item objects with a datatype() 'list'), which in turn can have StructureItems (Item objects with a datatype of 'structure'). Items are initially traversed via a DocSum object using next_Item() or obtained all at once with get_Items(). Similarly, nested Items can be accessed by using -next_ListItem/get_ListItems and next_StructureItem/get_StructureItem. +next_ListItem/get_ListItems and next_StructureItem/get_StructureItem. A +flattened list of items can be accessed with get_all_Items(). =head1 FEEDBACK @@ -74,7 +75,7 @@ Bug reports can be submitted via the web. http://bugzilla.open-bio.org/ -=head1 AUTHOR +=head1 AUTHOR Chris Fields Email cjfields at uiuc dot edu @@ -130,7 +131,7 @@ sub new { sub get_ids { my $self = shift; - return wantarray ? $self->{'_id'} : [$self->{'_id'}]; + return ($self->{'_id'}); } =head2 get_id @@ -173,15 +174,16 @@ sub next_ListItem { Title : get_ListItems Usage : my @ls = $item->get_ListItems - Function : returns list of, well, ListItems - Returns : array of ListItems + Function : returns list of, well, List Items + Returns : array of List Items Args : none =cut sub get_ListItems { my $self = shift; - ref $self->{'_lists'} ? return @{ $self->{'_lists'} } : return (); + my @items = $self->get_type eq 'List' ? $self->get_subItems : (); + return @items; } =head2 next_StructureItem @@ -207,7 +209,7 @@ sub next_StructureItem { Title : get_StructureItems Usage : my @structs = $ls->get_StructureItems - Function : returns list of StructureItems + Function : returns list of Structure Items Returns : array of StructureItems Args : none @@ -215,7 +217,46 @@ sub next_StructureItem { sub get_StructureItems { my $self = shift; - ref $self->{'_structures'} ? return @{ $self->{'_structures'} } : return (); + my @items = $self->get_type eq 'Structure' ? $self->get_subItems : (); + return @items; +} + +=head2 next_subItem + + Title : next_subItem + Usage : while (my $it = $ls->next_subItem) {...} + Function : iterates through the next layer of Items + Returns : single Item + Args : none + Notes : unlike next_ListItem and next_Structureitem, this generically + accesses any sub Items (useful for recursive calls, for example) + +=cut + +sub next_subItem { + my $self = shift; + unless ($self->{'_subitem_it'}) { + my @structs = $self->get_subItems; + $self->{'_subitem_it'} = sub {return shift @structs} + } + return $self->{'_subitem_it'}->(); +} + +=head2 get_subItems + + Title : get_subItems + Usage : my @items = $ls->get_subItems + Function : returns list of sub Items + Returns : array of Items + Args : none + Notes : unlike get_ListItems and get_StructureItems, this generically + accesses any sub Items (useful for recursive calls, for example) + +=cut + +sub get_subItems { + my $self = shift; + ref $self->{'_items'} ? return @{ $self->{'_items'} } : return (); } =head2 get_name @@ -291,7 +332,7 @@ sub rewind { sub _add_data { my ($self, $data) = @_; if ($data->{Item}) { - my $objtype = lc $data->{Type}; + my $objtype = lc $data->{Type}.'_item'; $self->{'_id'} = $data->{Id} if exists $data->{Id}; for my $sd (@{ $data->{Item} } ) { $sd->{Id} = $data->{Id} if exists $data->{Id}; @@ -299,14 +340,46 @@ sub _add_data { -datatype => $objtype, -verbose => $self->verbose); $subdoc->_add_data($sd); - push @{ $self->{'_'.lc $objtype.'s'} }, $subdoc; + push @{ $self->{'_items'} }, $subdoc; } } for my $nm (qw(Type content Name)) { - $self->{'_item'.lc $nm} = $data->{$nm} if $data->{$nm}; + $self->{'_item'.lc $nm} = $data->{$nm} if defined $data->{$nm}; } $self->{'_id'} = $data->{Id} if exists $data->{Id}; } +=head2 to_string + + Title : to_string + Usage : $foo->to_string() + Function : converts current object to string + Returns : none + Args : (optional) simple data for text formatting. This implementation + passes an argument for layering Items/subItems + Note : Used generically for debugging and print_DocSums methods + +=cut + +# recursively called to grab subitems, then layer + +sub to_string { + my $self = shift; + my $level = shift || 0; + # this is the field length for the initial data (spaces are padded in front) + my $pad = 20 - $level; + my $content = $self->get_content || ''; + my $string .= sprintf("%-*s%-*s%s\n", + $level, '', + $pad, $self->get_name(), + $self->_text_wrap(':', + ' ' x ($pad).':', + $content)); + for my $sub ($self->get_subItems) { + $string .= $sub->to_string(4 + $level); + } + return $string; +} + 1; -- 2.11.4.GIT