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