Bio/Annotation/Comment.pm

   1 #
   2 # BioPerl module for Bio::Annotation::Comment
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Ewan Birney <birney@ebi.ac.uk>
   7 #
   8 # Copyright Ewan Birney
   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::Comment - A comment object, holding text
  17
  18 =head1 SYNOPSIS
  19
  20
  21     $comment = Bio::Annotation::Comment->new();
  22     $comment->text("This is the text of this comment");
  23     $annotation->add_Annotation('comment', $comment);
  24
  25
  26 =head1 DESCRIPTION
  27
  28 A holder for comments in annotations, just plain text. This is a very simple
  29 object, and justifiably so.
  30
  31 =head1 AUTHOR - Ewan Birney
  32
  33 Email birney@ebi.ac.uk
  34
  35 =head1 APPENDIX
  36
  37 The rest of the documentation details each of the object
  38 methods. Internal methods are usually preceded with a _
  39
  40 =cut
  41
  42
  43 # Let the code begin...
  44
  45 package Bio::Annotation::Comment;
  46 use strict;
  47
  48 use base qw(Bio::Root::Root Bio::AnnotationI);
  49
  50 =head2 new
  51
  52  Title   : new
  53  Usage   : $comment = Bio::Annotation::Comment->new( '-text' => 'some text for this comment');
  54  Function: This returns a new comment object, optionally with
  55            text filed
  56  Example :
  57  Returns : a Bio::Annotation::Comment object
  58  Args    : a hash with -text optionally set
  59
  60
  61 =cut
  62
  63
  64 sub new {
  65   my($class,@args) = @_;
  66
  67   my $self = $class->SUPER::new(@args);
  68   my ($text,$tag, $type) = $self->_rearrange([qw(TEXT TAGNAME TYPE)], @args);
  69
  70   defined $text && $self->text($text);
  71   defined $tag && $self->tagname($tag);
  72   defined $type && $self->type($type);
  73   return $self;
  74 }
  75
  76 =head1 AnnotationI implementing functions
  77
  78 =cut
  79
  80 =head2 as_text
  81
  82  Title   : as_text
  83  Usage   :
  84  Function:
  85  Example :
  86  Returns :
  87  Args    :
  88
  89
  90 =cut
  91
  92 sub as_text{
  93    my ($self) = @_;
  94
  95    return "Comment: ".$self->text;
  96 }
  97
  98 =head2 display_text
  99
 100  Title   : display_text
 101  Usage   : my $str = $ann->display_text();
 102  Function: returns a string. Unlike as_text(), this method returns a string
 103            formatted as would be expected for te specific implementation.
 104
 105            One can pass a callback as an argument which allows custom text
 106            generation; the callback is passed the current instance and any text
 107            returned
 108  Example :
 109  Returns : a string
 110  Args    : [optional] callback
 111
 112 =cut
 113
 114 {
 115   my $DEFAULT_CB = sub {$_[0]->text || ''};
 116
 117   sub display_text {
 118     my ($self, $cb) = @_;
 119     $cb ||= $DEFAULT_CB;
 120     $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
 121     return $cb->($self);
 122   }
 123
 124 }
 125
 126 =head2 hash_tree
 127
 128  Title   : hash_tree
 129  Usage   :
 130  Function:
 131  Example :
 132  Returns :
 133  Args    :
 134
 135
 136 =cut
 137
 138 sub hash_tree{
 139     my $self = shift;
 140
 141     my $h = {};
 142     $h->{'text'} = $self->text;
 143     return $h;
 144 }
 145
 146 =head2 tagname
 147
 148  Title   : tagname
 149  Usage   : $obj->tagname($newval)
 150  Function: Get/set the tagname for this annotation value.
 151
 152            Setting this is optional. If set, it obviates the need to
 153            provide a tag to Bio::AnnotationCollectionI when adding
 154            this object. When obtaining an AnnotationI object from the
 155            collection, the collection will set the value to the tag
 156            under which it was stored unless the object has a tag
 157            stored already.
 158
 159  Example :
 160  Returns : value of tagname (a scalar)
 161  Args    : new value (a scalar, optional)
 162
 163
 164 =cut
 165
 166 sub tagname{
 167     my ($self,$value) = @_;
 168     if( defined $value) {
 169         $self->{'tagname'} = $value;
 170     }
 171     return $self->{'tagname'};
 172 }
 173
 174 =head1 Specific accessors for Comments
 175
 176 =cut
 177
 178
 179 =head2 text
 180
 181  Title   : text
 182  Usage   : $value = $self->text($newval)
 183  Function: get/set for the text field. A comment object
 184            just holds a single string which is accessible through
 185            this method
 186  Example :
 187  Returns : value of text
 188  Args    : newvalue (optional)
 189
 190
 191 =cut
 192
 193 sub text{
 194    my ($self,$value) = @_;
 195    if( defined $value) {
 196       $self->{'text'} = $value;
 197     }
 198     return $self->{'text'};
 199
 200 }
 201
 202 =head2 value
 203
 204  Title   : value
 205  Usage   : $value = $self->value($newval)
 206  Function: Alias of the 'text' method
 207  Example :
 208  Returns : value of text
 209  Args    : newvalue (optional)
 210
 211
 212 =cut
 213
 214
 215 *value = \&text;
 216
 217 =head2 type
 218
 219  Title   : type
 220  Usage   : $value = $self->type($newval)
 221  Function: get/set for the comment type field.  The comment type
 222            is normally found as a subfield within comment sections
 223            in some files, such as SwissProt
 224  Example :
 225  Returns : value of text
 226  Args    : newvalue (optional)
 227
 228
 229 =cut
 230
 231 sub type {
 232    my ($self,$type) = @_;
 233    if( defined $type) {
 234       $self->{'type'} = $type;
 235     }
 236     return $self->{'type'};
 237
 238 }
 239
 240 1;