Bio/SeqFeature/PositionProxy.pm

   1 #
   2 # BioPerl module for Bio::SeqFeature::PositionProxy
   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::SeqFeature::PositionProxy - handle features when truncation/revcom sequences span a feature
  17
  18 =head1 SYNOPSIS
  19
  20    $proxy = Bio::SeqFeature::PositionProxy->new( -loc => $loc,
  21                                                  -parent => $basefeature);
  22
  23    $seq->add_SeqFeature($feat);
  24
  25 =head1 DESCRIPTION
  26
  27 PositionProxy is a Proxy Sequence Feature to handle truncation
  28 and revcomp without duplicating all the data within the sequence features.
  29 It holds a new location for a sequence feature and the original feature
  30 it came from to provide the additional annotation information.
  31
  32 =head1 FEEDBACK
  33
  34 =head2 Mailing Lists
  35
  36 User feedback is an integral part of the evolution of this and other
  37 Bioperl modules. Send your comments and suggestions preferably to one
  38 of the Bioperl mailing lists.  Your participation is much appreciated.
  39
  40   bioperl-l@bioperl.org                  - General discussion
  41   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  42
  43 =head2 Support
  44
  45 Please direct usage questions or support issues to the mailing list:
  46
  47 I<bioperl-l@bioperl.org>
  48
  49 rather than to the module maintainer directly. Many experienced and
  50 reponsive experts will be able look at the problem and quickly
  51 address it. Please include a thorough description of the problem
  52 with code and data examples if at all possible.
  53
  54 =head2 Reporting Bugs
  55
  56 Report bugs to the Bioperl bug tracking system to help us keep track
  57 the bugs and their resolution.  Bug reports can be submitted via the
  58 web:
  59
  60   https://github.com/bioperl/bioperl-live/issues
  61
  62 =head1 AUTHOR - Ewan Birney
  63
  64 Ewan Birney E<lt>birney@sanger.ac.ukE<gt>
  65
  66 =head1 DEVELOPERS
  67
  68 This class has been written with an eye out of inheritance. The fields
  69 the actual object hash are:
  70
  71    _gsf_tag_hash  = reference to a hash for the tags
  72    _gsf_sub_array = reference to an array for sub arrays
  73    _gsf_start     = scalar of the start point
  74    _gsf_end       = scalar of the end point
  75    _gsf_strand    = scalar of the strand
  76
  77 =head1 APPENDIX
  78
  79 The rest of the documentation details each of the object
  80 methods. Internal methods are usually preceded with a _
  81
  82 =cut
  83
  84
  85 # Let the code begin...
  86
  87
  88 package Bio::SeqFeature::PositionProxy;
  89 use strict;
  90
  91 use Bio::Tools::GFF;
  92
  93
  94 use base qw(Bio::Root::Root Bio::SeqFeatureI);
  95
  96 sub new {
  97     my ($caller, @args) = @_;
  98     my $self = $caller->SUPER::new(@args);
  99
 100     my ($feature,$location) = $self->_rearrange([qw(PARENT LOC)],@args);
 101
 102     if( !defined $feature || !ref $feature || !$feature->isa('Bio::SeqFeatureI') ) {
 103       $self->throw("Must have a parent feature, not a [$feature]");
 104     }
 105
 106     if( $feature->isa("Bio::SeqFeature::PositionProxy") ) {
 107       $feature = $feature->parent();
 108     }
 109
 110     if( !defined $location || !ref $location || !$location->isa('Bio::LocationI') ) {
 111       $self->throw("Must have a location, not a [$location]");
 112     }
 113
 114
 115     return $self;
 116 }
 117
 118
 119 =head2 location
 120
 121  Title   : location
 122  Usage   : my $location = $seqfeature->location()
 123  Function: returns a location object suitable for identifying location
 124            of feature on sequence or parent feature
 125  Returns : Bio::LocationI object
 126  Args    : none
 127
 128 =cut
 129
 130 sub location {
 131     my($self, $value ) = @_;
 132
 133     if (defined($value)) {
 134         unless (ref($value) and $value->isa('Bio::LocationI')) {
 135             $self->throw("object $value pretends to be a location but ".
 136                 "does not implement Bio::LocationI");
 137         }
 138         $self->{'_location'} = $value;
 139     }
 140     elsif (! $self->{'_location'}) {
 141         # guarantees a real location object is returned every time
 142         $self->{'_location'} = Bio::Location::Simple->new();
 143     }
 144     return $self->{'_location'};
 145 }
 146
 147
 148 =head2 parent
 149
 150  Title   : parent
 151  Usage   : my $sf = $proxy->parent()
 152  Function: returns the seqfeature parent of this proxy
 153  Returns : Bio::SeqFeatureI object
 154  Args    : none
 155
 156 =cut
 157
 158 sub parent {
 159     my($self, $value ) = @_;
 160
 161     if (defined($value)) {
 162         unless (ref($value) and $value->isa('Bio::SeqFeatureI')) {
 163             $self->throw("object $value pretends to be a location but ".
 164                 "does not implement Bio::SeqFeatureI");
 165         }
 166         $self->{'_parent'} = $value;
 167     }
 168
 169     return $self->{'_parent'};
 170 }
 171
 172
 173
 174 =head2 start
 175
 176  Title   : start
 177  Usage   : $start = $feat->start
 178            $feat->start(20)
 179  Function: Get
 180  Returns : integer
 181  Args    : none
 182
 183 =cut
 184
 185 sub start {
 186    my ($self,$value) = @_;
 187    return $self->location->start($value);
 188 }
 189
 190
 191 =head2 end
 192
 193  Title   : end
 194  Usage   : $end = $feat->end
 195            $feat->end($end)
 196  Function: get
 197  Returns : integer
 198  Args    : none
 199
 200 =cut
 201
 202 sub end {
 203    my ($self,$value) = @_;
 204    return $self->location->end($value);
 205 }
 206
 207
 208 =head2 length
 209
 210  Title   : length
 211  Usage   :
 212  Function:
 213  Example :
 214  Returns :
 215  Args    :
 216
 217 =cut
 218
 219 sub length {
 220    my ($self) = @_;
 221    return $self->end - $self->start() + 1;
 222 }
 223
 224
 225 =head2 strand
 226
 227  Title   : strand
 228  Usage   : $strand = $feat->strand()
 229            $feat->strand($strand)
 230  Function: get/set on strand information, being 1,-1 or 0
 231  Returns : -1,1 or 0
 232  Args    : none
 233
 234 =cut
 235
 236 sub strand {
 237    my ($self,$value) = @_;
 238    return $self->location->strand($value);
 239 }
 240
 241
 242 =head2 attach_seq
 243
 244  Title   : attach_seq
 245  Usage   : $sf->attach_seq($seq)
 246  Function: Attaches a Bio::Seq object to this feature. This
 247            Bio::Seq object is for the *entire* sequence: ie
 248            from 1 to 10000
 249  Example :
 250  Returns : TRUE on success
 251  Args    :
 252
 253 =cut
 254
 255 sub attach_seq {
 256    my ($self, $seq) = @_;
 257
 258    if ( !defined $seq || !ref $seq || ! $seq->isa("Bio::PrimarySeqI") ) {
 259        $self->throw("Must attach Bio::PrimarySeqI objects to SeqFeatures");
 260    }
 261
 262    $self->{'_gsf_seq'} = $seq;
 263
 264    # attach to sub features if they want it
 265
 266    foreach my $sf ( $self->sub_SeqFeature() ) {
 267        if ( $sf->can("attach_seq") ) {
 268            $sf->attach_seq($seq);
 269        }
 270    }
 271    return 1;
 272 }
 273
 274
 275 =head2 seq
 276
 277  Title   : seq
 278  Usage   : $tseq = $sf->seq()
 279  Function: returns the truncated sequence (if there) for this
 280  Example :
 281  Returns : sub seq on attached sequence bounded by start & end
 282  Args    : none
 283
 284 =cut
 285
 286 sub seq {
 287    my ($self, $arg) = @_;
 288
 289    if ( defined $arg ) {
 290        $self->throw("Calling SeqFeature::PositionProxy->seq with an argument. You probably want attach_seq");
 291    }
 292
 293    if ( ! exists $self->{'_gsf_seq'} ) {
 294        return;
 295    }
 296
 297    # assumming our seq object is sensible, it should not have to yank
 298    # the entire sequence out here.
 299
 300    my $seq = $self->{'_gsf_seq'}->trunc($self->start(), $self->end());
 301
 302
 303    if ( $self->strand == -1 ) {
 304        $seq = $seq->revcom;
 305    }
 306
 307    return $seq;
 308 }
 309
 310
 311 =head2 entire_seq
 312
 313  Title   : entire_seq
 314  Usage   : $whole_seq = $sf->entire_seq()
 315  Function: gives the entire sequence that this seqfeature is attached to
 316  Example :
 317  Returns :
 318  Args    :
 319
 320 =cut
 321
 322 sub entire_seq {
 323    my ($self) = @_;
 324
 325    return unless exists($self->{'_gsf_seq'});
 326    return $self->{'_gsf_seq'};
 327 }
 328
 329
 330 =head2 seqname
 331
 332  Title   : seqname
 333  Usage   : $obj->seq_id($newval)
 334  Function: There are many cases when you make a feature that you
 335            do know the sequence name, but do not know its actual
 336            sequence. This is an attribute such that you can store
 337            the seqname.
 338
 339            This attribute should *not* be used in GFF dumping, as
 340            that should come from the collection in which the seq
 341            feature was found.
 342  Returns : value of seqname
 343  Args    : newvalue (optional)
 344
 345 =cut
 346
 347 sub seqname {
 348     my ($obj,$value) = @_;
 349     if ( defined $value ) {
 350         $obj->{'_gsf_seqname'} = $value;
 351     }
 352     return $obj->{'_gsf_seqname'};
 353 }
 354
 355
 356 =head2 Proxies
 357
 358 These functions chain back to the parent for all non sequence related stuff.
 359
 360 =cut
 361
 362 =head2 primary_tag
 363
 364  Title   : primary_tag
 365  Usage   : $tag = $feat->primary_tag()
 366  Function: Returns the primary tag for a feature,
 367            eg 'exon'
 368  Returns : a string
 369  Args    : none
 370
 371 =cut
 372
 373 sub primary_tag {
 374    my ($self,@args) = @_;
 375
 376    return $self->parent->primary_tag();
 377 }
 378
 379
 380 =head2 source_tag
 381
 382  Title   : source_tag
 383  Usage   : $tag = $feat->source_tag()
 384  Function: Returns the source tag for a feature,
 385            eg, 'genscan'
 386  Returns : a string
 387  Args    : none
 388
 389 =cut
 390
 391 sub source_tag {
 392    my ($self) = @_;
 393
 394    return $self->parent->source_tag();
 395 }
 396
 397
 398 =head2 has_tag
 399
 400  Title   : has_tag
 401  Usage   : $tag_exists = $self->has_tag('some_tag')
 402  Function:
 403  Returns : TRUE if the specified tag exists, and FALSE otherwise
 404  Args    :
 405
 406 =cut
 407
 408 sub has_tag {
 409    my ($self,$tag) = @_;
 410
 411    return $self->parent->has_tag($tag);
 412 }
 413
 414
 415 =head2 get_tag_values
 416
 417  Title   : get_tag_values
 418  Usage   : @values = $self->get_tag_values('some_tag')
 419  Function:
 420  Returns : An array comprising the values of the specified tag.
 421  Args    :
 422
 423 =cut
 424
 425 *each_tag_value = \&get_tag_values;
 426
 427 sub get_tag_values {
 428    my ($self,$tag) = @_;
 429
 430    return $self->parent->get_tag_values($tag);
 431 }
 432
 433
 434 =head2 get_all_tags
 435
 436  Title   : get_all_tags
 437  Usage   : @tags = $feat->get_all_tags()
 438  Function: gives all tags for this feature
 439  Returns : an array of strings
 440  Args    : none
 441
 442 =cut
 443
 444 *all_tags = \&get_all_tags;
 445
 446 sub get_all_tags {
 447    my ($self) = @_;
 448
 449    return $self->parent->all_tags();
 450 }
 451
 452 1;