lib/Bio/Annotation/SimpleValue.pm

   1 #
   2 # BioPerl module for Bio::Annotation::SimpleValue
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by bioperl <bioperl-l@bioperl.org>
   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<bioperl-l@bioperl.org>
  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 use strict;
  77
  78 # Object preamble - inherits from Bio::Root::Root
  79
  80 #use Bio::Ontology::TermI;
  81
  82 use base qw(Bio::Root::Root Bio::AnnotationI);
  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    my ($class,@args) = @_;
  98
  99    my $self = $class->SUPER::new(@args);
 100
 101    my ($value,$tag,$term) =
 102        $self->_rearrange([qw(VALUE TAGNAME TAG_TERM)], @args);
 103
 104    # set the term first
 105    defined $term   && $self->tag_term($term);
 106    defined $value  && $self->value($value);
 107    defined $tag    && $self->tagname($tag);
 108
 109    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    my ($self) = @_;
 130
 131    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     my ($self, $cb) = @_;
 155     $cb ||= $DEFAULT_CB;
 156     $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
 157     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     my $self = shift;
 176
 177     my $h = {};
 178     $h->{'value'} = $self->value;
 179     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     my $self = shift;
 201
 202     # check for presence of an ontology term
 203     if($self->{'_tag_term'}) {
 204         # keep a copy in case the term is removed later
 205         $self->{'tagname'} = $_[0] if @_;
 206         # delegate to the ontology term object
 207         return $self->tag_term->name(@_);
 208     }
 209     return $self->{'tagname'} = shift if @_;
 210     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    my ($self,$value) = @_;
 231
 232    if( defined $value) {
 233       $self->{'value'} = $value;
 234     }
 235     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<Bio::Ontology::TermI> 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<Bio::Ontology::TermI> compliant object, or undef
 259  Args    : on set, new value (a L<Bio::Ontology::TermI> compliant
 260            object or undef, optional)
 261
 262
 263 =cut
 264
 265 sub tag_term{
 266     my $self = shift;
 267
 268     return $self->{'_tag_term'} = shift if @_;
 269     return $self->{'_tag_term'};
 270 }
 271
 272 1;