lib/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
  63 use strict;
  64
  65 use base qw(Bio::Annotation::DBLink Bio::AnnotationI Bio::Range);
  66
  67
  68 sub new {
  69   my($class,@args) = @_;
  70
  71   my $self = $class->SUPER::new(@args);
  72
  73   my ($target_id, $tstart, $tend, $tstrand) =
  74       $self->_rearrange([ qw(
  75                               TARGET_ID
  76                               START
  77                               END
  78                               STRAND ) ], @args);
  79
  80   $target_id    && $self->target_id($target_id);
  81   $tstart       && $self->start($tstart);
  82   $tend         && $self->end($tend);
  83   $tstrand      && $self->strand($tstrand);
  84
  85   return $self;
  86 }
  87
  88 =head1 AnnotationI implementing functions
  89
  90 =cut
  91
  92
  93 =head2 as_text
  94
  95  Title   : as_text
  96  Usage   :
  97  Function:
  98  Example :
  99  Returns :
 100  Args    :
 101
 102
 103 =cut
 104
 105 sub as_text{
 106   my ($self) = @_;
 107
 108   my $target = $self->target_id || '';
 109   my $start  = $self->start     || '';
 110   my $end    = $self->end       || '';
 111   my $strand = $self->strand    || '';
 112
 113    return "Target=".$target." ".$start." ".$end." ".$strand;
 114 }
 115
 116 =head2 display_text
 117
 118  Title   : display_text
 119  Usage   : my $str = $ann->display_text();
 120  Function: returns a string. Unlike as_text(), this method returns a string
 121            formatted as would be expected for te specific implementation.
 122
 123            One can pass a callback as an argument which allows custom text
 124            generation; the callback is passed the current instance and any text
 125            returned
 126  Example :
 127  Returns : a string
 128  Args    : [optional] callback
 129
 130 =cut
 131
 132 {
 133   my $DEFAULT_CB = sub { $_[0]->as_text || ''};
 134
 135   sub display_text {
 136     my ($self, $cb) = @_;
 137     $cb ||= $DEFAULT_CB;
 138     $self->throw("Callback must be a code reference") if ref $cb ne 'CODE';
 139     return $cb->($self);
 140   }
 141
 142 }
 143
 144 =head2 tagname
 145
 146  Title   : tagname
 147  Usage   : $obj->tagname($newval)
 148  Function: Get/set the tagname for this annotation value.
 149
 150            Setting this is optional. If set, it obviates the need to
 151            provide a tag to Bio::AnnotationCollectionI when adding
 152            this object. When obtaining an AnnotationI object from the
 153            collection, the collection will set the value to the tag
 154            under which it was stored unless the object has a tag
 155            stored already.
 156
 157  Example :
 158  Returns : value of tagname (a scalar)
 159  Args    : new value (a scalar, optional)
 160
 161
 162 =cut
 163
 164 sub tagname{
 165     my ($self,$value) = @_;
 166     if( defined $value) {
 167         $self->{'tagname'} = $value;
 168     }
 169     return $self->{'tagname'};
 170 }
 171
 172 =head1 Specific accessors for Targets
 173
 174 =cut
 175
 176 =head2 target_id
 177
 178 =over
 179
 180 =item Usage
 181
 182   $obj->target_id()        #get existing value
 183   $obj->target_id($newval) #set new value
 184
 185 =item Function
 186
 187 =item Returns
 188
 189 value of target_id (a scalar)
 190
 191 =item Arguments
 192
 193 new value of target_id (to set)
 194
 195 =back
 196
 197 =cut
 198
 199 sub target_id {
 200     my $self = shift;
 201     return $self->{'target_id'} = shift if defined($_[0]);
 202     return $self->{'target_id'} || $self->primary_id();
 203 }
 204
 205 1;