lib/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
  90 use strict;
  91
  92 use Bio::Tools::GFF;
  93
  94
  95 use base qw(Bio::Root::Root Bio::SeqFeatureI);
  96
  97 sub new {
  98     my ($caller, @args) = @_;
  99     my $self = $caller->SUPER::new(@args);
 100
 101     my ($feature,$location) = $self->_rearrange([qw(PARENT LOC)],@args);
 102
 103     if( !defined $feature || !ref $feature || !$feature->isa('Bio::SeqFeatureI') ) {
 104       $self->throw("Must have a parent feature, not a [$feature]");
 105     }
 106
 107     if( $feature->isa("Bio::SeqFeature::PositionProxy") ) {
 108       $feature = $feature->parent();
 109     }
 110
 111     if( !defined $location || !ref $location || !$location->isa('Bio::LocationI') ) {
 112       $self->throw("Must have a location, not a [$location]");
 113     }
 114
 115
 116     return $self;
 117 }
 118
 119
 120 =head2 location
 121
 122  Title   : location
 123  Usage   : my $location = $seqfeature->location()
 124  Function: returns a location object suitable for identifying location
 125            of feature on sequence or parent feature
 126  Returns : Bio::LocationI object
 127  Args    : none
 128
 129 =cut
 130
 131 sub location {
 132     my($self, $value ) = @_;
 133
 134     if (defined($value)) {
 135         unless (ref($value) and $value->isa('Bio::LocationI')) {
 136             $self->throw("object $value pretends to be a location but ".
 137                 "does not implement Bio::LocationI");
 138         }
 139         $self->{'_location'} = $value;
 140     }
 141     elsif (! $self->{'_location'}) {
 142         # guarantees a real location object is returned every time
 143         $self->{'_location'} = Bio::Location::Simple->new();
 144     }
 145     return $self->{'_location'};
 146 }
 147
 148
 149 =head2 parent
 150
 151  Title   : parent
 152  Usage   : my $sf = $proxy->parent()
 153  Function: returns the seqfeature parent of this proxy
 154  Returns : Bio::SeqFeatureI object
 155  Args    : none
 156
 157 =cut
 158
 159 sub parent {
 160     my($self, $value ) = @_;
 161
 162     if (defined($value)) {
 163         unless (ref($value) and $value->isa('Bio::SeqFeatureI')) {
 164             $self->throw("object $value pretends to be a location but ".
 165                 "does not implement Bio::SeqFeatureI");
 166         }
 167         $self->{'_parent'} = $value;
 168     }
 169
 170     return $self->{'_parent'};
 171 }
 172
 173
 174
 175 =head2 start
 176
 177  Title   : start
 178  Usage   : $start = $feat->start
 179            $feat->start(20)
 180  Function: Get
 181  Returns : integer
 182  Args    : none
 183
 184 =cut
 185
 186 sub start {
 187    my ($self,$value) = @_;
 188    return $self->location->start($value);
 189 }
 190
 191
 192 =head2 end
 193
 194  Title   : end
 195  Usage   : $end = $feat->end
 196            $feat->end($end)
 197  Function: get
 198  Returns : integer
 199  Args    : none
 200
 201 =cut
 202
 203 sub end {
 204    my ($self,$value) = @_;
 205    return $self->location->end($value);
 206 }
 207
 208
 209 =head2 length
 210
 211  Title   : length
 212  Usage   :
 213  Function:
 214  Example :
 215  Returns :
 216  Args    :
 217
 218 =cut
 219
 220 sub length {
 221    my ($self) = @_;
 222    return $self->end - $self->start() + 1;
 223 }
 224
 225
 226 =head2 strand
 227
 228  Title   : strand
 229  Usage   : $strand = $feat->strand()
 230            $feat->strand($strand)
 231  Function: get/set on strand information, being 1,-1 or 0
 232  Returns : -1,1 or 0
 233  Args    : none
 234
 235 =cut
 236
 237 sub strand {
 238    my ($self,$value) = @_;
 239    return $self->location->strand($value);
 240 }
 241
 242
 243 =head2 attach_seq
 244
 245  Title   : attach_seq
 246  Usage   : $sf->attach_seq($seq)
 247  Function: Attaches a Bio::Seq object to this feature. This
 248            Bio::Seq object is for the *entire* sequence: ie
 249            from 1 to 10000
 250  Example :
 251  Returns : TRUE on success
 252  Args    :
 253
 254 =cut
 255
 256 sub attach_seq {
 257    my ($self, $seq) = @_;
 258
 259    if ( !defined $seq || !ref $seq || ! $seq->isa("Bio::PrimarySeqI") ) {
 260        $self->throw("Must attach Bio::PrimarySeqI objects to SeqFeatures");
 261    }
 262
 263    $self->{'_gsf_seq'} = $seq;
 264
 265    # attach to sub features if they want it
 266
 267    foreach my $sf ( $self->sub_SeqFeature() ) {
 268        if ( $sf->can("attach_seq") ) {
 269            $sf->attach_seq($seq);
 270        }
 271    }
 272    return 1;
 273 }
 274
 275
 276 =head2 seq
 277
 278  Title   : seq
 279  Usage   : $tseq = $sf->seq()
 280  Function: returns the truncated sequence (if there) for this
 281  Example :
 282  Returns : sub seq on attached sequence bounded by start & end
 283  Args    : none
 284
 285 =cut
 286
 287 sub seq {
 288    my ($self, $arg) = @_;
 289
 290    if ( defined $arg ) {
 291        $self->throw("Calling SeqFeature::PositionProxy->seq with an argument. You probably want attach_seq");
 292    }
 293
 294    if ( ! exists $self->{'_gsf_seq'} ) {
 295        return;
 296    }
 297
 298    # assumming our seq object is sensible, it should not have to yank
 299    # the entire sequence out here.
 300
 301    my $seq = $self->{'_gsf_seq'}->trunc($self->start(), $self->end());
 302
 303
 304    if ( $self->strand == -1 ) {
 305        $seq = $seq->revcom;
 306    }
 307
 308    return $seq;
 309 }
 310
 311
 312 =head2 entire_seq
 313
 314  Title   : entire_seq
 315  Usage   : $whole_seq = $sf->entire_seq()
 316  Function: gives the entire sequence that this seqfeature is attached to
 317  Example :
 318  Returns :
 319  Args    :
 320
 321 =cut
 322
 323 sub entire_seq {
 324    my ($self) = @_;
 325
 326    return unless exists($self->{'_gsf_seq'});
 327    return $self->{'_gsf_seq'};
 328 }
 329
 330
 331 =head2 seqname
 332
 333  Title   : seqname
 334  Usage   : $obj->seq_id($newval)
 335  Function: There are many cases when you make a feature that you
 336            do know the sequence name, but do not know its actual
 337            sequence. This is an attribute such that you can store
 338            the seqname.
 339
 340            This attribute should *not* be used in GFF dumping, as
 341            that should come from the collection in which the seq
 342            feature was found.
 343  Returns : value of seqname
 344  Args    : newvalue (optional)
 345
 346 =cut
 347
 348 sub seqname {
 349     my ($obj,$value) = @_;
 350     if ( defined $value ) {
 351         $obj->{'_gsf_seqname'} = $value;
 352     }
 353     return $obj->{'_gsf_seqname'};
 354 }
 355
 356
 357 =head2 Proxies
 358
 359 These functions chain back to the parent for all non sequence related stuff.
 360
 361 =cut
 362
 363 =head2 primary_tag
 364
 365  Title   : primary_tag
 366  Usage   : $tag = $feat->primary_tag()
 367  Function: Returns the primary tag for a feature,
 368            eg 'exon'
 369  Returns : a string
 370  Args    : none
 371
 372 =cut
 373
 374 sub primary_tag {
 375    my ($self,@args) = @_;
 376
 377    return $self->parent->primary_tag();
 378 }
 379
 380
 381 =head2 source_tag
 382
 383  Title   : source_tag
 384  Usage   : $tag = $feat->source_tag()
 385  Function: Returns the source tag for a feature,
 386            eg, 'genscan'
 387  Returns : a string
 388  Args    : none
 389
 390 =cut
 391
 392 sub source_tag {
 393    my ($self) = @_;
 394
 395    return $self->parent->source_tag();
 396 }
 397
 398
 399 =head2 has_tag
 400
 401  Title   : has_tag
 402  Usage   : $tag_exists = $self->has_tag('some_tag')
 403  Function:
 404  Returns : TRUE if the specified tag exists, and FALSE otherwise
 405  Args    :
 406
 407 =cut
 408
 409 sub has_tag {
 410    my ($self,$tag) = @_;
 411
 412    return $self->parent->has_tag($tag);
 413 }
 414
 415
 416 =head2 get_tag_values
 417
 418  Title   : get_tag_values
 419  Usage   : @values = $self->get_tag_values('some_tag')
 420  Function:
 421  Returns : An array comprising the values of the specified tag.
 422  Args    :
 423
 424 =cut
 425
 426 *each_tag_value = \&get_tag_values;
 427
 428 sub get_tag_values {
 429    my ($self,$tag) = @_;
 430
 431    return $self->parent->get_tag_values($tag);
 432 }
 433
 434
 435 =head2 get_all_tags
 436
 437  Title   : get_all_tags
 438  Usage   : @tags = $feat->get_all_tags()
 439  Function: gives all tags for this feature
 440  Returns : an array of strings
 441  Args    : none
 442
 443 =cut
 444
 445 *all_tags = \&get_all_tags;
 446
 447 sub get_all_tags {
 448    my ($self) = @_;
 449
 450    return $self->parent->all_tags();
 451 }
 452
 453 1;