File Coverage

Bio/Annotation/SimpleValue.pm
Criterion Covered Total %
statement 27 36 75.0
branch 11 18 61.1
condition 1 3 33.3
subroutine 7 9 77.7
pod 7 7 100.0
total 53 73 72.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Annotation::SimpleValue
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by bioperl
7             #
8             # Copyright bioperl
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::Annotation::SimpleValue - A simple scalar
17              
18             =head1 SYNOPSIS
19              
20             use Bio::Annotation::SimpleValue;
21             use Bio::Annotation::Collection;
22              
23             my $col = Bio::Annotation::Collection->new();
24             my $sv = Bio::Annotation::SimpleValue->new(-value => 'someval');
25             $col->add_Annotation('tagname', $sv);
26              
27             =head1 DESCRIPTION
28              
29             Scalar value annotation object
30              
31             =head1 FEEDBACK
32              
33             =head2 Mailing Lists
34              
35             User feedback is an integral part of the evolution of this and other
36             Bioperl modules. Send your comments and suggestions preferably to one
37             of the Bioperl mailing lists. Your participation is much appreciated.
38              
39             bioperl-l@bioperl.org - General discussion
40             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
41              
42             =head2 Support
43              
44             Please direct usage questions or support issues to the mailing list:
45              
46             I
47              
48             rather than to the module maintainer directly. Many experienced and
49             reponsive experts will be able look at the problem and quickly
50             address it. Please include a thorough description of the problem
51             with code and data examples if at all possible.
52              
53             =head2 Reporting Bugs
54              
55             Report bugs to the Bioperl bug tracking system to help us keep track
56             the bugs and their resolution. Bug reports can be submitted via
57             the web:
58              
59             https://github.com/bioperl/bioperl-live/issues
60              
61             =head1 AUTHOR - Ewan Birney
62              
63             Email birney@ebi.ac.uk
64              
65             =head1 APPENDIX
66              
67             The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
68              
69             =cut
70              
71              
72             # Let the code begin...
73              
74              
75             package Bio::Annotation::SimpleValue;
76 187     187   609 use strict;
  187         207  
  187         4931  
77              
78             # Object preamble - inherits from Bio::Root::Root
79              
80             #use Bio::Ontology::TermI;
81              
82 187     187   572 use base qw(Bio::Root::Root Bio::AnnotationI);
  187         229  
  187         56369  
83              
84             =head2 new
85              
86             Title : new
87             Usage : my $sv = Bio::Annotation::SimpleValue->new();
88             Function: Instantiate a new SimpleValue object
89             Returns : Bio::Annotation::SimpleValue object
90             Args : -value => $value to initialize the object data field [optional]
91             -tagname => $tag to initialize the tagname [optional]
92             -tag_term => ontology term representation of the tag [optional]
93              
94             =cut
95              
96             sub new{
97 3933     3933 1 5696 my ($class,@args) = @_;
98              
99 3933         7969 my $self = $class->SUPER::new(@args);
100              
101 3933         10597 my ($value,$tag,$term) =
102             $self->_rearrange([qw(VALUE TAGNAME TAG_TERM)], @args);
103              
104             # set the term first
105 3933 50       8079 defined $term && $self->tag_term($term);
106 3933 100       7856 defined $value && $self->value($value);
107 3933 100       7329 defined $tag && $self->tagname($tag);
108              
109 3933         8215 return $self;
110             }
111              
112              
113             =head1 AnnotationI implementing functions
114              
115             =cut
116              
117             =head2 as_text
118              
119             Title : as_text
120             Usage : my $text = $obj->as_text
121             Function: return the string "Value: $v" where $v is the value
122             Returns : string
123             Args : none
124              
125              
126             =cut
127              
128             sub as_text{
129 39     39 1 35 my ($self) = @_;
130              
131 39         45 return "Value: ".$self->value;
132             }
133              
134             =head2 display_text
135              
136             Title : display_text
137             Usage : my $str = $ann->display_text();
138             Function: returns a string. Unlike as_text(), this method returns a string
139             formatted as would be expected for te specific implementation.
140              
141             One can pass a callback as an argument which allows custom text
142             generation; the callback is passed the current instance and any text
143             returned
144             Example :
145             Returns : a string
146             Args : [optional] callback
147              
148             =cut
149              
150             {
151             my $DEFAULT_CB = sub { $_[0]->value};
152              
153             sub display_text {
154 45     45 1 536 my ($self, $cb) = @_;
155 45   33     193 $cb ||= $DEFAULT_CB;
156 45 50       118 $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
157 45         98 return $cb->($self);
158             }
159              
160             }
161              
162             =head2 hash_tree
163              
164             Title : hash_tree
165             Usage : my $hashtree = $value->hash_tree
166             Function: For supporting the AnnotationI interface just returns the value
167             as a hashref with the key 'value' pointing to the value
168             Returns : hashrf
169             Args : none
170              
171              
172             =cut
173              
174             sub hash_tree{
175 0     0 1 0 my $self = shift;
176              
177 0         0 my $h = {};
178 0         0 $h->{'value'} = $self->value;
179 0         0 return $h;
180             }
181              
182             =head2 tagname
183              
184             Title : tagname
185             Usage : $obj->tagname($newval)
186             Function: Get/set the tagname for this annotation value.
187              
188             Setting this is optional. If set, it obviates the need to
189             provide a tag to AnnotationCollection when adding this
190             object.
191              
192             Example :
193             Returns : value of tagname (a scalar)
194             Args : new value (a scalar, optional)
195              
196              
197             =cut
198              
199             sub tagname{
200 9168     9168 1 6904 my $self = shift;
201              
202             # check for presence of an ontology term
203 9168 50       12729 if($self->{'_tag_term'}) {
204             # keep a copy in case the term is removed later
205 0 0       0 $self->{'tagname'} = $_[0] if @_;
206             # delegate to the ontology term object
207 0         0 return $self->tag_term->name(@_);
208             }
209 9168 100       14898 return $self->{'tagname'} = shift if @_;
210 5357         9537 return $self->{'tagname'};
211             }
212              
213              
214             =head1 Specific accessors for SimpleValue
215              
216             =cut
217              
218             =head2 value
219              
220             Title : value
221             Usage : $obj->value($newval)
222             Function: Get/Set the value for simplevalue
223             Returns : value of value
224             Args : newvalue (optional)
225              
226              
227             =cut
228              
229             sub value{
230 5787     5787 1 27287 my ($self,$value) = @_;
231              
232 5787 100       7745 if( defined $value) {
233 3878         5278 $self->{'value'} = $value;
234             }
235 5787         7334 return $self->{'value'};
236             }
237              
238             =head2 tag_term
239              
240             Title : tag_term
241             Usage : $obj->tag_term($newval)
242             Function: Get/set the L object representing
243             the tag name.
244              
245             This is so you can specifically relate the tag of this
246             annotation to an entry in an ontology. You may want to do
247             this to associate an identifier with the tag, or a
248             particular category, such that you can better match the tag
249             against a controlled vocabulary.
250              
251             This accessor will return undef if it has never been set
252             before in order to allow this annotation to stay
253             light-weight if an ontology term representation of the tag
254             is not needed. Once it is set to a valid value, tagname()
255             will actually delegate to the name() of this term.
256              
257             Example :
258             Returns : a L compliant object, or undef
259             Args : on set, new value (a L compliant
260             object or undef, optional)
261              
262              
263             =cut
264              
265             sub tag_term{
266 0     0 1   my $self = shift;
267              
268 0 0         return $self->{'_tag_term'} = shift if @_;
269 0           return $self->{'_tag_term'};
270             }
271              
272             1;