branch-1-6/Bio/SeqFeature/Generic.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::SeqFeature::Generic
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Ewan Birney <birney@sanger.ac.uk>
   8 #
   9 # Copyright Ewan Birney
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::SeqFeature::Generic - Generic SeqFeature
  18
  19 =head1 SYNOPSIS
  20
  21    $feat = Bio::SeqFeature::Generic->new(
  22             -start        => 10,
  23             -end          => 100,
  24             -strand       => -1,
  25             -primary      => 'repeat', # -primary_tag is a synonym
  26             -source_tag   => 'repeatmasker',
  27             -display_name => 'alu family',
  28             -score        => 1000,
  29             -tag          => { new => 1,
  30                                author => 'someone',
  31                                sillytag => 'this is silly!' } );
  32
  33    $feat = Bio::SeqFeature::Generic->new( -gff_string => $string );
  34    # if you want explicitly GFF1
  35    $feat = Bio::SeqFeature::Generic->new( -gff1_string => $string );
  36
  37    # add it to an annotated sequence
  38
  39    $annseq->add_SeqFeature($feat);
  40
  41 =head1 DESCRIPTION
  42
  43 Bio::SeqFeature::Generic is a generic implementation for the
  44 Bio::SeqFeatureI interface, providing a simple object to provide all
  45 the information for a feature on a sequence.
  46
  47 For many Features, this is all you will need to use (for example, this
  48 is fine for Repeats in DNA sequence or Domains in protein
  49 sequence). For other features, which have more structure, this is a
  50 good base class to extend using inheritence to have new things: this
  51 is what is done in the L<Bio::SeqFeature::Gene>,
  52 L<Bio::SeqFeature::Transcript> and L<Bio::SeqFeature::Exon>, which provide
  53 well coordinated classes to represent genes on DNA sequence (for
  54 example, you can get the protein sequence out from a transcript
  55 class).
  56
  57 For many Features, you want to add some piece of information, for
  58 example a common one is that this feature is 'new' whereas other
  59 features are 'old'.  The tag system, which here is implemented using a
  60 hash can be used here.  You can use the tag system to extend the
  61 L<Bio::SeqFeature::Generic> programmatically: that is, you know that you have
  62 read in more information into the tag 'mytag' which you can then
  63 retrieve. This means you do not need to know how to write inherited
  64 Perl to provide more complex information on a feature, and/or, if you
  65 do know but you do not want to write a new class every time you need
  66 some extra piece of information, you can use the tag system to easily
  67 store and then retrieve information.
  68
  69 The tag system can be written in/out of GFF format, and also into EMBL
  70 format via the L<Bio::SeqIO> system
  71
  72 =head1 Implemented Interfaces
  73
  74 This class implementes the following interfaces.
  75
  76 =over 4
  77
  78 =item L<Bio::SeqFeatureI>
  79
  80 Note that this includes implementing Bio::RangeI.
  81
  82 =item L<Bio::AnnotatableI>
  83
  84 =item L<Bio::FeatureHolderI>
  85
  86 Features held by a feature are essentially sub-features.
  87
  88 =back
  89
  90 =head1 FEEDBACK
  91
  92 =head2 Mailing Lists
  93
  94 User feedback is an integral part of the evolution of this and other
  95 Bioperl modules. Send your comments and suggestions preferably to one
  96 of the Bioperl mailing lists.  Your participation is much appreciated.
  97
  98   bioperl-l@bioperl.org                  - General discussion
  99   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 100
 101 =head2 Support
 102
 103 Please direct usage questions or support issues to the mailing list:
 104
 105 I<bioperl-l@bioperl.org>
 106
 107 rather than to the module maintainer directly. Many experienced and
 108 reponsive experts will be able look at the problem and quickly
 109 address it. Please include a thorough description of the problem
 110 with code and data examples if at all possible.
 111
 112 =head2 Reporting Bugs
 113
 114 Report bugs to the Bioperl bug tracking system to help us keep track
 115 the bugs and their resolution.  Bug reports can be submitted via
 116 the web:
 117
 118   http://bugzilla.open-bio.org/
 119
 120 =head1 AUTHOR - Ewan Birney
 121
 122 Ewan Birney E<lt>birney@sanger.ac.ukE<gt>
 123
 124 =head1 DEVELOPERS
 125
 126 This class has been written with an eye out for inheritance. The fields
 127 the actual object hash are:
 128
 129    _gsf_tag_hash  = reference to a hash for the tags
 130    _gsf_sub_array = reference to an array for subfeatures
 131
 132 =head1 APPENDIX
 133
 134 The rest of the documentation details each of the object
 135 methods. Internal methods are usually preceded with a _
 136
 137 =cut
 138
 139
 140 # Let the code begin...
 141
 142
 143 package Bio::SeqFeature::Generic;
 144 use strict;
 145
 146 use Bio::Annotation::Collection;
 147 use Bio::Location::Simple;
 148 use Bio::Location::Split;
 149 use Bio::Tools::GFF;
 150 #use Tie::IxHash;
 151
 152 use base qw(Bio::Root::Root Bio::SeqFeatureI Bio::FeatureHolderI Bio::AnnotatableI);
 153
 154 sub new {
 155     my ( $caller, @args) = @_;
 156     my ($self) = $caller->SUPER::new(@args);
 157     $self->_register_for_cleanup(\&cleanup_generic);
 158     $self->{'_parse_h'}       = {};
 159     $self->{'_gsf_tag_hash'}  = {};
 160
 161     # bulk-set attributes
 162     $self->set_attributes(@args);
 163
 164     # done - we hope
 165     return $self;
 166 }
 167
 168 =head2 set_attributes
 169
 170  Title   : set_attributes
 171  Usage   :
 172  Function: Sets a whole array of parameters at once.
 173  Example :
 174  Returns : none
 175  Args    : Named parameters, in the form as they would otherwise be passed
 176            to new(). Currently recognized are:
 177
 178                     -start          start position
 179                     -end            end position
 180                     -strand         strand
 181                     -primary_tag    primary tag
 182                     -primary        (synonym for -primary_tag)
 183                     -source         source tag
 184                     -frame          frame
 185                     -score          score value
 186                     -tag            a reference to a tag/value hash
 187                     -gff_string     GFF v.2 string to initialize from
 188                     -gff1_string    GFF v.1 string to initialize from
 189                     -seq_id         the display name of the sequence
 190                     -annotation     the AnnotationCollectionI object
 191                     -location       the LocationI object
 192
 193 =cut
 194
 195 sub set_attributes {
 196     my ($self,@args) = @_;
 197     my ($start, $end, $strand, $primary_tag, $source_tag, $primary,
 198                   $source, $frame, $score, $tag, $gff_string, $gff1_string,
 199         $seqname, $seqid, $annot, $location,$display_name) =
 200             $self->_rearrange([qw(START
 201                                   END
 202                                   STRAND
 203                                   PRIMARY_TAG
 204                                   SOURCE_TAG
 205                                   PRIMARY
 206                                   SOURCE
 207                                   FRAME
 208                                   SCORE
 209                                   TAG
 210                                   GFF_STRING
 211                                   GFF1_STRING
 212                                   SEQNAME
 213                                   SEQ_ID
 214                                   ANNOTATION
 215                                   LOCATION
 216                                   DISPLAY_NAME
 217                                   )], @args);
 218     $location    && $self->location($location);
 219     $gff_string  && $self->_from_gff_string($gff_string);
 220     $gff1_string  && do {
 221         $self->gff_format(Bio::Tools::GFF->new('-gff_version' => 1));
 222         $self->_from_gff_stream($gff1_string);
 223     };
 224     $primary_tag            && $self->primary_tag($primary_tag);
 225     $source_tag             && $self->source_tag($source_tag);
 226     $primary                && $self->primary_tag($primary);
 227     $source                 && $self->source_tag($source);
 228     defined $start          && $self->start($start);
 229     defined $end            && $self->end($end);
 230     defined $strand         && $self->strand($strand);
 231     defined $frame          && $self->frame($frame);
 232     defined $display_name   && $self->display_name($display_name);
 233     defined $score          && $self->score($score);
 234     $annot                  && $self->annotation($annot);
 235     if($seqname) {
 236         $self->warn("-seqname is deprecated. Please use -seq_id instead.");
 237         $seqid = $seqname unless $seqid;
 238     }
 239     $seqid          && $self->seq_id($seqid);
 240     $tag            && do {
 241         foreach my $t ( keys %$tag ) {
 242             $self->add_tag_value($t, UNIVERSAL::isa($tag->{$t}, "ARRAY") ? @{$tag->{$t}} : $tag->{$t});
 243         }
 244     };
 245 }
 246
 247
 248 =head2 direct_new
 249
 250  Title   : direct_new
 251  Usage   : my $obj = Bio::SeqFeature::Generic->direct_new
 252  Function: create a blessed hash - for performance improvement in
 253            object creation
 254  Returns : Bio::SeqFeature::Generic object
 255  Args    : none
 256
 257
 258 =cut
 259
 260 sub direct_new {
 261     my ( $class) = @_;
 262     my ($self) = {};
 263
 264     bless $self,$class;
 265
 266     return $self;
 267 }
 268
 269 =head2 location
 270
 271  Title   : location
 272  Usage   : my $location = $seqfeature->location()
 273  Function: returns a location object suitable for identifying location
 274            of feature on sequence or parent feature
 275  Returns : Bio::LocationI object
 276  Args    : [optional] Bio::LocationI object to set the value to.
 277
 278
 279 =cut
 280
 281 sub location {
 282     my($self, $value ) = @_;
 283
 284     if (defined($value)) {
 285         unless (ref($value) and $value->isa('Bio::LocationI')) {
 286             $self->throw("object $value pretends to be a location but ".
 287                          "does not implement Bio::LocationI");
 288         }
 289         $self->{'_location'} = $value;
 290     }
 291     elsif (! $self->{'_location'}) {
 292         # guarantees a real location object is returned every time
 293         $self->{'_location'} = Bio::Location::Simple->new();
 294     }
 295     return $self->{'_location'};
 296 }
 297
 298
 299 =head2 start
 300
 301  Title   : start
 302  Usage   : $start = $feat->start
 303            $feat->start(20)
 304  Function: Get/set on the start coordinate of the feature
 305  Returns : integer
 306  Args    : none
 307
 308
 309 =cut
 310
 311 sub start {
 312    my ($self,$value) = @_;
 313    return $self->location->start($value);
 314 }
 315
 316 =head2 end
 317
 318  Title   : end
 319  Usage   : $end = $feat->end
 320            $feat->end($end)
 321  Function: get/set on the end coordinate of the feature
 322  Returns : integer
 323  Args    : none
 324
 325
 326 =cut
 327
 328 sub end {
 329    my ($self,$value) = @_;
 330    return $self->location->end($value);
 331 }
 332
 333 =head2 length
 334
 335  Title   : length
 336  Usage   : my $len = $feature->length
 337  Function: Get the feature length computed as
 338            $feat->end - $feat->start + 1
 339  Returns : integer
 340  Args    : none
 341
 342
 343 =cut
 344
 345 sub length {
 346    my $self = shift;
 347    return $self->end - $self->start() + 1;
 348 }
 349
 350 =head2 strand
 351
 352  Title   : strand
 353  Usage   : $strand = $feat->strand()
 354            $feat->strand($strand)
 355  Function: get/set on strand information, being 1,-1 or 0
 356  Returns : -1,1 or 0
 357  Args    : none
 358
 359
 360 =cut
 361
 362 sub strand {
 363    my $self = shift;
 364    return $self->location->strand(@_);
 365 }
 366
 367 =head2 score
 368
 369  Title   : score
 370  Usage   : $score = $feat->score()
 371            $feat->score($score)
 372  Function: get/set on score information
 373  Returns : float
 374  Args    : none if get, the new value if set
 375
 376
 377 =cut
 378
 379 sub score {
 380     my $self = shift;
 381
 382     if (@_) {
 383         my $value = shift;
 384
 385         if ( defined $value && $value && $value !~ /^[A-Za-z]+$/ &&
 386             $value !~ /^[+-]?\d+\.?\d*(e-\d+)?/ and $value != 0) {
 387             $self->throw(-class=>'Bio::Root::BadParameter',
 388                     -text=>"'$value' is not a valid score",
 389                     -value=>$value);
 390         }
 391         if ($self->has_tag('score')) {
 392             $self->warn("Removing score value(s)");
 393             $self->remove_tag('score');
 394         }
 395         $self->add_tag_value('score',$value);
 396     }
 397     my ($score) = $self->has_tag('score') ? $self->get_tag_values('score') : undef;
 398     return $score;
 399 }
 400
 401 =head2 frame
 402
 403  Title   : frame
 404  Usage   : $frame = $feat->frame()
 405            $feat->frame($frame)
 406  Function: get/set on frame information
 407  Returns : 0,1,2, '.'
 408  Args    : none if get, the new value if set
 409
 410
 411 =cut
 412
 413 sub frame {
 414   my $self = shift;
 415
 416   if ( @_ ) {
 417       my $value = shift;
 418       if ( defined $value &&
 419            $value !~ /^[0-2.]$/ ) {
 420           $self->throw("'$value' is not a valid frame");
 421       }
 422       if( defined $value && $value eq '.' ) { $value = '.' }
 423       return $self->{'_gsf_frame'} = $value;
 424   }
 425   return $self->{'_gsf_frame'};
 426 }
 427
 428 =head2 primary_tag
 429
 430  Title   : primary_tag
 431  Usage   : $tag = $feat->primary_tag()
 432            $feat->primary_tag('exon')
 433  Function: get/set on the primary tag for a feature,
 434            eg 'exon'
 435  Returns : a string
 436  Args    : none
 437
 438
 439 =cut
 440
 441 sub primary_tag {
 442     my $self = shift;
 443     return $self->{'_primary_tag'} = shift if @_;
 444     return $self->{'_primary_tag'};
 445 }
 446
 447 =head2 source_tag
 448
 449  Title   : source_tag
 450  Usage   : $tag = $feat->source_tag()
 451            $feat->source_tag('genscan');
 452  Function: Returns the source tag for a feature,
 453            eg, 'genscan'
 454  Returns : a string
 455  Args    : none
 456
 457
 458 =cut
 459
 460 sub source_tag {
 461     my $self = shift;
 462     return $self->{'_source_tag'} = shift if @_;
 463     return $self->{'_source_tag'};
 464 }
 465
 466 =head2 has_tag
 467
 468  Title   : has_tag
 469  Usage   : $value = $self->has_tag('some_tag')
 470  Function: Tests wether a feature contaings a tag
 471  Returns : TRUE if the SeqFeature has the tag,
 472            and FALSE otherwise.
 473  Args    : The name of a tag
 474
 475
 476 =cut
 477
 478 sub has_tag {
 479     my ($self, $tag) = @_;
 480     return exists $self->{'_gsf_tag_hash'}->{$tag};
 481 }
 482
 483 =head2 add_tag_value
 484
 485  Title   : add_tag_value
 486  Usage   : $self->add_tag_value('note',"this is a note");
 487  Returns : TRUE on success
 488  Args    : tag (string) and one or more values (any scalar(s))
 489
 490
 491 =cut
 492
 493 sub add_tag_value {
 494     my $self = shift;
 495     my $tag = shift;
 496     $self->{'_gsf_tag_hash'}->{$tag} ||= [];
 497     push(@{$self->{'_gsf_tag_hash'}->{$tag}},@_);
 498 }
 499
 500
 501 =head2 get_tag_values
 502
 503  Title   : get_tag_values
 504  Usage   : @values = $gsf->get_tag_values('note');
 505  Function: Returns a list of all the values stored
 506            under a particular tag.
 507  Returns : A list of scalars
 508  Args    : The name of the tag
 509
 510
 511 =cut
 512
 513 sub get_tag_values {
 514    my ($self, $tag) = @_;
 515
 516    if( ! defined $tag ) { return (); }
 517    if ( ! exists $self->{'_gsf_tag_hash'}->{$tag} ) {
 518        $self->throw("asking for tag value that does not exist $tag");
 519    }
 520    return @{$self->{'_gsf_tag_hash'}->{$tag}};
 521 }
 522
 523
 524 =head2 get_all_tags
 525
 526  Title   : get_all_tags
 527  Usage   : @tags = $feat->get_all_tags()
 528  Function: Get a list of all the tags in a feature
 529  Returns : An array of tag names
 530  Args    : none
 531
 532 # added a sort so that tags will be returned in a predictable order
 533 # I still think we should be able to specify a sort function
 534 # to the object at some point
 535 # -js
 536
 537 =cut
 538
 539 sub get_all_tags {
 540    my ($self, @args) = @_;
 541    return sort keys %{ $self->{'_gsf_tag_hash'}};
 542 }
 543
 544 =head2 remove_tag
 545
 546  Title   : remove_tag
 547  Usage   : $feat->remove_tag('some_tag')
 548  Function: removes a tag from this feature
 549  Returns : the array of values for this tag before removing it
 550  Args    : tag (string)
 551
 552
 553 =cut
 554
 555 sub remove_tag {
 556    my ($self, $tag) = @_;
 557
 558    if ( ! exists $self->{'_gsf_tag_hash'}->{$tag} ) {
 559        $self->throw("trying to remove a tag that does not exist: $tag");
 560    }
 561    my @vals = @{$self->{'_gsf_tag_hash'}->{$tag}};
 562    delete $self->{'_gsf_tag_hash'}->{$tag};
 563    return @vals;
 564 }
 565
 566 =head2 attach_seq
 567
 568  Title   : attach_seq
 569  Usage   : $sf->attach_seq($seq)
 570  Function: Attaches a Bio::Seq object to this feature. This
 571            Bio::Seq object is for the *entire* sequence: ie
 572            from 1 to 10000
 573  Example :
 574  Returns : TRUE on success
 575  Args    : a Bio::PrimarySeqI compliant object
 576
 577
 578 =cut
 579
 580 sub attach_seq {
 581    my ($self, $seq) = @_;
 582
 583    if ( ! ($seq && ref($seq) && $seq->isa("Bio::PrimarySeqI")) ) {
 584        $self->throw("Must attach Bio::PrimarySeqI objects to SeqFeatures");
 585    }
 586
 587    $self->{'_gsf_seq'} = $seq;
 588
 589    # attach to sub features if they want it
 590    foreach ( $self->sub_SeqFeature() ) {
 591        $_->attach_seq($seq);
 592    }
 593    return 1;
 594 }
 595
 596 =head2 seq
 597
 598  Title   : seq
 599  Usage   : $tseq = $sf->seq()
 600  Function: returns the truncated sequence (if there) for this
 601  Example :
 602  Returns : sub seq (a Bio::PrimarySeqI compliant object) on attached sequence
 603            bounded by start & end, or undef if there is no sequence attached
 604  Args    : none
 605
 606
 607 =cut
 608
 609 sub seq {
 610    my ($self, $arg) = @_;
 611
 612    if ( defined $arg ) {
 613        $self->throw("Calling SeqFeature::Generic->seq with an argument. You probably want attach_seq");
 614    }
 615
 616    if ( ! exists $self->{'_gsf_seq'} ) {
 617        return;
 618    }
 619
 620    # assumming our seq object is sensible, it should not have to yank
 621    # the entire sequence out here.
 622
 623    my $seq = $self->{'_gsf_seq'}->trunc($self->start(), $self->end());
 624
 625
 626    if ( defined $self->strand &&
 627         $self->strand == -1 ) {
 628
 629        # ok. this does not work well (?)
 630        #print STDERR "Before revcom", $seq->str, "\n";
 631        $seq = $seq->revcom;
 632        #print STDERR "After  revcom", $seq->str, "\n";
 633    }
 634
 635    return $seq;
 636 }
 637
 638 =head2 entire_seq
 639
 640  Title   : entire_seq
 641  Usage   : $whole_seq = $sf->entire_seq()
 642  Function: gives the entire sequence that this seqfeature is attached to
 643  Example :
 644  Returns : a Bio::PrimarySeqI compliant object, or undef if there is no
 645            sequence attached
 646  Args    :
 647
 648
 649 =cut
 650
 651 sub entire_seq {
 652    return shift->{'_gsf_seq'};
 653 }
 654
 655
 656 =head2 seq_id
 657
 658  Title   : seq_id
 659  Usage   : $obj->seq_id($newval)
 660  Function: There are many cases when you make a feature that you
 661            do know the sequence name, but do not know its actual
 662            sequence. This is an attribute such that you can store
 663            the ID (e.g., display_id) of the sequence.
 664
 665            This attribute should *not* be used in GFF dumping, as
 666            that should come from the collection in which the seq
 667            feature was found.
 668  Returns : value of seq_id
 669  Args    : newvalue (optional)
 670
 671
 672 =cut
 673
 674 sub seq_id {
 675     my $obj = shift;
 676     return $obj->{'_gsf_seq_id'} = shift if @_;
 677     return $obj->{'_gsf_seq_id'};
 678 }
 679
 680 =head2 display_name
 681
 682  Title   : display_name
 683  Usage   : $featname = $obj->display_name
 684  Function: Implements the display_name() method, which is a human-readable
 685            name for the feature.
 686  Returns : value of display_name (a string)
 687  Args    : Optionally, on set the new value or undef
 688
 689 =cut
 690
 691 sub display_name{
 692     my $self = shift;
 693     return $self->{'display_name'} = shift if @_;
 694     return $self->{'display_name'};
 695 }
 696
 697 =head1 Methods for implementing Bio::AnnotatableI
 698
 699 =cut
 700
 701 =head2 annotation
 702
 703  Title   : annotation
 704  Usage   : $obj->annotation($annot_obj)
 705  Function: Get/set the annotation collection object for annotating this
 706            feature.
 707
 708  Example :
 709  Returns : A Bio::AnnotationCollectionI object
 710  Args    : newvalue (optional)
 711
 712
 713 =cut
 714
 715 sub annotation {
 716     my ($obj,$value) = @_;
 717
 718     # we are smart if someone references the object and there hasn't been
 719     # one set yet
 720     if(defined $value || ! defined $obj->{'annotation'} ) {
 721         $value = Bio::Annotation::Collection->new() unless ( defined $value );
 722         $obj->{'annotation'} = $value;
 723     }
 724     return $obj->{'annotation'};
 725 }
 726
 727 =head1 Methods to implement Bio::FeatureHolderI
 728
 729 This includes methods for retrieving, adding, and removing
 730 features. Since this is already a feature, features held by this
 731 feature holder are essentially sub-features.
 732
 733 =cut
 734
 735 =head2 get_SeqFeatures
 736
 737  Title   : get_SeqFeatures
 738  Usage   : @feats = $feat->get_SeqFeatures();
 739  Function: Returns an array of sub Sequence Features
 740  Returns : An array
 741  Args    : none
 742
 743
 744 =cut
 745
 746 sub get_SeqFeatures {
 747     return @{ shift->{'_gsf_sub_array'} || []};
 748 }
 749
 750 =head2 add_SeqFeature
 751
 752  Title   : add_SeqFeature
 753  Usage   : $feat->add_SeqFeature($subfeat);
 754            $feat->add_SeqFeature($subfeat,'EXPAND')
 755  Function: Adds a SeqFeature into the subSeqFeature array.
 756            With no 'EXPAND' qualifer, subfeat will be tested
 757            as to whether it lies inside the parent, and throw
 758            an exception if not.
 759
 760            If EXPAND is used, the parent's start/end/strand will
 761            be adjusted so that it grows to accommodate the new
 762            subFeature
 763  Returns : nothing
 764  Args    : An object which has the SeqFeatureI interface
 765
 766
 767 =cut
 768
 769 #'
 770 sub add_SeqFeature{
 771     my ($self,$feat,$expand) = @_;
 772     unless( defined $feat ) {
 773         $self->warn("Called add_SeqFeature with no feature, ignoring");
 774         return;
 775     }
 776     if ( !$feat->isa('Bio::SeqFeatureI') ) {
 777         $self->warn("$feat does not implement Bio::SeqFeatureI. Will add it anyway, but beware...");
 778     }
 779
 780     if($expand && ($expand eq 'EXPAND')) {
 781         $self->_expand_region($feat);
 782     } else {
 783         if ( !$self->contains($feat) ) {
 784             $self->throw("$feat is not contained within parent feature, and expansion is not valid");
 785         }
 786     }
 787
 788     $self->{'_gsf_sub_array'} = [] unless exists($self->{'_gsf_sub_array'});
 789     push(@{$self->{'_gsf_sub_array'}},$feat);
 790
 791 }
 792
 793 =head2 remove_SeqFeatures
 794
 795  Title   : remove_SeqFeatures
 796  Usage   : $sf->remove_SeqFeatures
 797  Function: Removes all SeqFeatures
 798
 799            If you want to remove only a subset of features then remove that
 800            subset from the returned array, and add back the rest.
 801  Example :
 802  Returns : The array of Bio::SeqFeatureI implementing features that was
 803            deleted.
 804  Args    : none
 805
 806
 807 =cut
 808
 809 sub remove_SeqFeatures {
 810    my ($self) = @_;
 811
 812    my @subfeats = @{$self->{'_gsf_sub_array'} || []};
 813    $self->{'_gsf_sub_array'} = []; # zap the array implicitly.
 814    return @subfeats;
 815 }
 816
 817 =head1 GFF-related methods
 818
 819 =cut
 820
 821 =head2 gff_format
 822
 823  Title   : gff_format
 824  Usage   : # get:
 825            $gffio = $feature->gff_format();
 826            # set (change the default version of GFF2):
 827            $feature->gff_format(Bio::Tools::GFF->new(-gff_version => 1));
 828  Function: Get/set the GFF format interpreter. This object is supposed to
 829            format and parse GFF. See Bio::Tools::GFF for the interface.
 830
 831            If this method is called as class method, the default for all
 832            newly created instances will be changed. Otherwise only this
 833            instance will be affected.
 834  Example :
 835  Returns : a Bio::Tools::GFF compliant object
 836  Args    : On set, an instance of Bio::Tools::GFF or a derived object.
 837
 838
 839 =cut
 840
 841 sub gff_format {
 842     my ($self, $gffio) = @_;
 843
 844     if(defined($gffio)) {
 845         if(ref($self)) {
 846             $self->{'_gffio'} = $gffio;
 847         } else {
 848             $Bio::SeqFeatureI::static_gff_formatter = $gffio;
 849         }
 850     }
 851     return (ref($self) && exists($self->{'_gffio'}) ?
 852             $self->{'_gffio'} : $self->_static_gff_formatter);
 853 }
 854
 855 =head2 gff_string
 856
 857  Title   : gff_string
 858  Usage   : $str = $feat->gff_string;
 859            $str = $feat->gff_string($gff_formatter);
 860  Function: Provides the feature information in GFF format.
 861
 862            We override this here from Bio::SeqFeatureI in order to use the
 863            formatter returned by gff_format().
 864
 865  Returns : A string
 866  Args    : Optionally, an object implementing gff_string().
 867
 868
 869 =cut
 870
 871 sub gff_string{
 872    my ($self,$formatter) = @_;
 873
 874    $formatter = $self->gff_format() unless $formatter;
 875    return $formatter->gff_string($self);
 876 }
 877
 878 =head2 slurp_gff_file
 879
 880  Title   : slurp_file
 881  Usage   : @features = Bio::SeqFeature::Generic::slurp_gff_file(\*FILE);
 882  Function: Sneaky function to load an entire file as in memory objects.
 883            Beware of big files.
 884
 885            This method is deprecated. Use Bio::Tools::GFF instead, which can
 886            also handle large files.
 887
 888  Example :
 889  Returns :
 890  Args    :
 891
 892 =cut
 893
 894 sub slurp_gff_file {
 895    my ($f) = @_;
 896    my @out;
 897    if ( !defined $f ) {
 898        Bio::Root::Root->throw("Must have a filehandle");
 899    }
 900
 901    Bio::Root::Root->deprecated( -message => "deprecated method slurp_gff_file() called in Bio::SeqFeature::Generic. Use Bio::Tools::GFF instead.",
 902                                 -warn_version  => '1.005',
 903                                 -throw_version => '1.007',
 904                               );
 905
 906    while(<$f>) {
 907        my $sf = Bio::SeqFeature::Generic->new('-gff_string' => $_);
 908        push(@out, $sf);
 909    }
 910
 911    return @out;
 912 }
 913
 914 =head2 _from_gff_string
 915
 916  Title   : _from_gff_string
 917  Usage   :
 918  Function: Set feature properties from GFF string.
 919
 920            This method uses the object returned by gff_format() for the
 921            actual interpretation of the string. Set a different GFF format
 922            interpreter first if you need a specific version, like GFF1. (The
 923            default is GFF2.)
 924  Example :
 925  Returns :
 926  Args    : a GFF-formatted string
 927
 928
 929 =cut
 930
 931 sub _from_gff_string {
 932    my ($self, $string) = @_;
 933
 934    $self->gff_format()->from_gff_string($self, $string);
 935 }
 936
 937
 938 =head2 _expand_region
 939
 940  Title   : _expand_region
 941  Usage   : $self->_expand_region($feature);
 942  Function: Expand the total region covered by this feature to
 943            accomodate for the given feature.
 944
 945            May be called whenever any kind of subfeature is added to this
 946            feature. add_sub_SeqFeature() already does this.
 947  Returns :
 948  Args    : A Bio::SeqFeatureI implementing object.
 949
 950
 951 =cut
 952
 953 sub _expand_region {
 954     my ($self, $feat) = @_;
 955     if(! $feat->isa('Bio::SeqFeatureI')) {
 956         $self->warn("$feat does not implement Bio::SeqFeatureI");
 957     }
 958     # if this doesn't have start set - forget it!
 959     # changed to reflect sanity checks for LocationI
 960     if(!$self->location->valid_Location) {
 961         $self->start($feat->start);
 962         $self->end($feat->end);
 963         $self->strand($feat->strand) unless $self->strand;
 964     } else {
 965         my ($start,$end,$strand) = $self->union($feat);
 966         $self->start($start);
 967         $self->end($end);
 968         $self->strand($strand);
 969     }
 970 }
 971
 972 =head2 _parse
 973
 974  Title   : _parse
 975  Usage   :
 976  Function: Parsing hints
 977  Example :
 978  Returns :
 979  Args    :
 980
 981
 982 =cut
 983
 984 sub _parse {
 985    my ($self) = @_;
 986    return $self->{'_parse_h'};
 987 }
 988
 989 =head2 _tag_value
 990
 991  Title   : _tag_value
 992  Usage   :
 993  Function: For internal use only. Convenience method for those tags that
 994            may only have a single value.
 995  Returns : The first value under the given tag as a scalar (string)
 996  Args    : The tag as a string. Optionally, the value on set.
 997
 998
 999 =cut
1000
1001 sub _tag_value {
1002     my $self = shift;
1003     my $tag = shift;
1004
1005     if(@_ || (! $self->has_tag($tag))) {
1006         $self->remove_tag($tag) if($self->has_tag($tag));
1007         $self->add_tag_value($tag, @_);
1008     }
1009     return ($self->get_tag_values($tag))[0];
1010 }
1011
1012 #######################################################################
1013 # aliases for methods that changed their names in an attempt to make  #
1014 # bioperl names more consistent                                       #
1015 #######################################################################
1016
1017 sub seqname {
1018     my $self = shift;
1019     $self->warn("SeqFeatureI::seqname() is deprecated. Please use seq_id() instead.");
1020     return $self->seq_id(@_);
1021 }
1022
1023 sub display_id {
1024     my $self = shift;
1025     $self->warn("SeqFeatureI::display_id() is deprecated. Please use display_name() instead.");
1026     return $self->display_name(@_);
1027 }
1028
1029 # # this is towards consistent naming
1030 sub each_tag_value { return shift->get_tag_values(@_); }
1031 sub all_tags { return shift->get_all_tags(@_); }
1032
1033 # we revamped the feature containing property to implementing
1034 # Bio::FeatureHolderI
1035 *sub_SeqFeature = \&get_SeqFeatures;
1036 *add_sub_SeqFeature = \&add_SeqFeature;
1037 *flush_sub_SeqFeatures = \&remove_SeqFeatures;
1038 # this one is because of inconsistent naming ...
1039 *flush_sub_SeqFeature = \&remove_SeqFeatures;
1040
1041
1042 sub cleanup_generic {
1043     my $self = shift;
1044     foreach my $f ( @{$self->{'_gsf_sub_array'} || []} ) {
1045         $f = undef;
1046     }
1047     $self->{'_gsf_seq'} = undef;
1048     foreach my $t ( keys %{$self->{'_gsf_tag_hash'} } ) {
1049         $self->{'_gsf_tag_hash'}->{$t} = undef;
1050         delete($self->{'_gsf_tag_hash'}->{$t}); # bug 1720 fix
1051     }
1052 }
1053
1054 1;