Bio/Annotation/Target.pm

   1 #
   2 # BioPerl module for Bio::Annotation::Target
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Scott Cain <cain@cshl.org>
   7 #
   8 # Copyright Scott Cain
   9 #
  10 # Based on the Bio::Annotation::DBLink by Ewan Birney
  11 #
  12 # You may distribute this module under the same terms as perl itself
  13
  14 # POD documentation - main docs before the code
  15
  16 =head1 NAME
  17
  18 Bio::Annotation::Target - Provides an object which represents a target (ie, a
  19 similarity hit) from one object to something in another database
  20
  21 =head1 SYNOPSIS
  22
  23    $target1 = Bio::Annotation::Target->new(-target_id  => 'F321966.1',
  24                                           -start      => 1,
  25                                           -end        => 200,
  26                                           -strand     => 1,   # or -1
  27                                          );
  28
  29    # or
  30
  31    $target2 = Bio::Annotation::Target->new();
  32    $target2->target_id('Q75IM5');
  33    $target2->start(7);
  34    # ... etc ...
  35
  36    # Target is-a Bio::AnnotationI object, can be added to annotation
  37    # collections, e.g. the one on features or seqs
  38    $feat->annotation->add_Annotation('Target', $target2);
  39
  40
  41 =head1 DESCRIPTION
  42
  43 Provides an object which represents a target (ie, a similarity hit) from
  44 one object to something in another database without prescribing what is
  45 in the other database
  46
  47 =head1 AUTHOR - Scott Cain
  48
  49 Scott Cain - cain@cshl.org
  50
  51 =head1 APPENDIX
  52
  53 The rest of the documentation details each of the object
  54 methods. Internal methods are usually preceded with a _
  55
  56 =cut
  57
  58
  59 # Let the code begin...
  60
  61 package Bio::Annotation::Target;
  62 use strict;
  63
  64 use base qw(Bio::Annotation::DBLink Bio::AnnotationI Bio::Range);
  65
  66
  67 sub new {
  68   my($class,@args) = @_;
  69
  70   my $self = $class->SUPER::new(@args);
  71
  72   my ($target_id, $tstart, $tend, $tstrand) =
  73       $self->_rearrange([ qw(
  74                               TARGET_ID
  75                               START
  76                               END
  77                               STRAND ) ], @args);
  78
  79   $target_id    && $self->target_id($target_id);
  80   $tstart       && $self->start($tstart);
  81   $tend         && $self->end($tend);
  82   $tstrand      && $self->strand($tstrand);
  83
  84   return $self;
  85 }
  86
  87 =head1 AnnotationI implementing functions
  88
  89 =cut
  90
  91
  92 =head2 as_text
  93
  94  Title   : as_text
  95  Usage   :
  96  Function:
  97  Example :
  98  Returns :
  99  Args    :
 100
 101
 102 =cut
 103
 104 sub as_text{
 105   my ($self) = @_;
 106
 107   my $target = $self->target_id || '';
 108   my $start  = $self->start     || '';
 109   my $end    = $self->end       || '';
 110   my $strand = $self->strand    || '';
 111
 112    return "Target=".$target." ".$start." ".$end." ".$strand;
 113 }
 114
 115 =head2 display_text
 116
 117  Title   : display_text
 118  Usage   : my $str = $ann->display_text();
 119  Function: returns a string. Unlike as_text(), this method returns a string
 120            formatted as would be expected for te specific implementation.
 121
 122            One can pass a callback as an argument which allows custom text
 123            generation; the callback is passed the current instance and any text
 124            returned
 125  Example :
 126  Returns : a string
 127  Args    : [optional] callback
 128
 129 =cut
 130
 131 {
 132   my $DEFAULT_CB = sub { $_[0]->as_text || ''};
 133
 134   sub display_text {
 135     my ($self, $cb) = @_;
 136     $cb ||= $DEFAULT_CB;
 137     $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
 138     return $cb->($self);
 139   }
 140
 141 }
 142
 143 =head2 tagname
 144
 145  Title   : tagname
 146  Usage   : $obj->tagname($newval)
 147  Function: Get/set the tagname for this annotation value.
 148
 149            Setting this is optional. If set, it obviates the need to
 150            provide a tag to Bio::AnnotationCollectionI when adding
 151            this object. When obtaining an AnnotationI object from the
 152            collection, the collection will set the value to the tag
 153            under which it was stored unless the object has a tag
 154            stored already.
 155
 156  Example :
 157  Returns : value of tagname (a scalar)
 158  Args    : new value (a scalar, optional)
 159
 160
 161 =cut
 162
 163 sub tagname{
 164     my ($self,$value) = @_;
 165     if( defined $value) {
 166         $self->{'tagname'} = $value;
 167     }
 168     return $self->{'tagname'};
 169 }
 170
 171 =head1 Specific accessors for Targets
 172
 173 =cut
 174
 175 =head2 target_id
 176
 177 =over
 178
 179 =item Usage
 180
 181   $obj->target_id()        #get existing value
 182   $obj->target_id($newval) #set new value
 183
 184 =item Function
 185
 186 =item Returns
 187
 188 value of target_id (a scalar)
 189
 190 =item Arguments
 191
 192 new value of target_id (to set)
 193
 194 =back
 195
 196 =cut
 197
 198 sub target_id {
 199     my $self = shift;
 200     return $self->{'target_id'} = shift if defined($_[0]);
 201     return $self->{'target_id'} || $self->primary_id();
 202 }
 203
 204 1;