/
Feature.pm
1114 lines (862 loc) · 29 KB
/
Feature.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
=head1 NAME
Bio::DB::GFF::Feature -- A relative segment identified by a feature type
=head1 SYNOPSIS
See L<Bio::DB::GFF>.
=head1 DESCRIPTION
Bio::DB::GFF::Feature is a stretch of sequence that corresponding to a
single annotation in a GFF database. It inherits from
Bio::DB::GFF::RelSegment, and so has all the support for relative
addressing of this class and its ancestors. It also inherits from
Bio::SeqFeatureI and so has the familiar start(), stop(),
primary_tag() and location() methods (it implements Bio::LocationI
too, if needed).
Bio::DB::GFF::Feature adds new methods to retrieve the annotation's
type, group, and other GFF attributes. Annotation types are
represented by Bio::DB::GFF::Typename objects, a simple class that has
two methods called method() and source(). These correspond to the
method and source fields of a GFF file.
Annotation groups serve the dual purpose of giving the annotation a
human-readable name, and providing higher-order groupings of
subfeatures into features. The groups returned by this module are
objects of the Bio::DB::GFF::Featname class.
Bio::DB::GFF::Feature inherits from and implements the abstract
methods of Bio::SeqFeatureI, allowing it to interoperate with other
Bioperl modules.
Generally, you will not create or manipulate Bio::DB::GFF::Feature
objects directly, but use those that are returned by the
Bio::DB::GFF::RelSegment-E<gt>features() method.
=head2 Important note about start() vs end()
If features are derived from segments that use relative addressing
(which is the default), then start() will be less than end() if the
feature is on the opposite strand from the reference sequence. This
breaks Bio::SeqI compliance, but is necessary to avoid having the real
genomic locations designated by start() and end() swap places when
changing reference points.
To avoid this behavior, call $segment-E<gt>absolute(1) before fetching
features from it. This will force everything into absolute
coordinates.
For example:
my $segment = $db->segment('CHROMOSOME_I');
$segment->absolute(1);
my @features = $segment->features('transcript');
=head1 API
The remainder of this document describes the public and private
methods implemented by this module.
=cut
package Bio::DB::GFF::Feature;
use strict;
use Bio::DB::GFF::Util::Rearrange;
use Bio::DB::GFF::RelSegment;
use Bio::DB::GFF::Featname;
use Bio::DB::GFF::Typename;
use Bio::DB::GFF::Homol;
use Bio::SeqFeatureI;
use Bio::Root::Root;
use Bio::LocationI;
use vars qw($VERSION @ISA $AUTOLOAD);
@ISA = qw(Bio::DB::GFF::RelSegment Bio::SeqFeatureI
Bio::Root::Root);
$VERSION = '0.62';
#'
*segments = \&sub_SeqFeature;
my %CONSTANT_TAGS = (method=>1, source=>1, score=>1, phase=>1, notes=>1, id=>1, group=>1);
=head2 new_from_parent
Title : new_from_parent
Usage : $f = Bio::DB::GFF::Feature->new_from_parent(@args);
Function: create a new feature object
Returns : new Bio::DB::GFF::Feature object
Args : see below
Status : Internal
This method is called by Bio::DB::GFF to create a new feature using
information obtained from the GFF database. It is one of two similar
constructors. This one is called when the feature is generated from a
RelSegment object, and should inherit that object's coordinate system.
The 13 arguments are positional (sorry):
$parent a Bio::DB::GFF::RelSegment object (or descendent)
$start start of this feature
$stop stop of this feature
$method this feature's GFF method
$source this feature's GFF source
$score this feature's score
$fstrand this feature's strand (relative to the source
sequence, which has its own strandedness!)
$phase this feature's phase
$group this feature's group (a Bio::DB::GFF::Featname object)
$db_id this feature's internal database ID
$group_id this feature's internal group database ID
$tstart this feature's target start
$tstop this feature's target stop
tstart and tstop aren't used for anything at the moment, since the
information is embedded in the group object.
=cut
# this is called for a feature that is attached to a parent sequence,
# in which case it inherits its coordinate reference system and strandedness
sub new_from_parent {
my $package = shift;
my ($parent,
$start,$stop,
$method,$source,$score,
$fstrand,$phase,
$group,$db_id,$group_id,
$tstart,$tstop) = @_;
($start,$stop) = ($stop,$start) if defined($fstrand) and $fstrand eq '-';
my $class = $group ? $group->class : $parent->class;
my $self = bless {
factory => $parent->{factory},
sourceseq => $parent->{sourceseq},
strand => $parent->{strand},
ref => $parent->{ref},
refstart => $parent->{refstart},
refstrand => $parent->{refstrand},
absolute => $parent->{absolute},
start => $start,
stop => $stop,
type => Bio::DB::GFF::Typename->new($method,$source),
fstrand => $fstrand,
score => $score,
phase => $phase,
group => $group,
db_id => $db_id,
group_id => $group_id,
class => $class,
},$package;
$self;
}
=head2 new
Title : new
Usage : $f = Bio::DB::GFF::Feature->new(@args);
Function: create a new feature object
Returns : new Bio::DB::GFF::Feature object
Args : see below
Status : Internal
This method is called by Bio::DB::GFF to create a new feature using
information obtained from the GFF database. It is one of two similar
constructors. This one is called when the feature is generated
without reference to a RelSegment object, and should therefore use its
default coordinate system (relative to itself).
The 11 arguments are positional:
$factory a Bio::DB::GFF adaptor object (or descendent)
$srcseq the source sequence
$start start of this feature
$stop stop of this feature
$method this feature's GFF method
$source this feature's GFF source
$score this feature's score
$fstrand this feature's strand (relative to the source
sequence, which has its own strandedness!)
$phase this feature's phase
$group this feature's group
$db_id this feature's internal database ID
=cut
# 'This is called when creating a feature from scratch. It does not have
# an inherited coordinate system.
sub new {
my $package = shift;
my ($factory,
$srcseq,
$start,$stop,
$method,$source,
$score,$fstrand,$phase,
$group,$db_id,$group_id,
$tstart,$tstop) = @_;
my $self = bless { },$package;
($start,$stop) = ($stop,$start) if defined($fstrand) and $fstrand eq '-';
my $class = $group ? $group->class : 'Sequence';
@{$self}{qw(factory sourceseq start stop strand class)} =
($factory,$srcseq,$start,$stop,$fstrand,$class);
# if the target start and stop are defined, then we use this information to create
# the reference sequence
# THIS SHOULD BE BUILT INTO RELSEGMENT
if (0 && $tstart ne '' && $tstop ne '') {
if ($tstart < $tstop) {
@{$self}{qw(ref refstart refstrand)} = ($group,$start - $tstart + 1,'+');
} else {
@{$self}{'start','stop'} = @{$self}{'stop','start'};
@{$self}{qw(ref refstart refstrand)} = ($group,$tstop + $stop - 1,'-');
}
} else {
@{$self}{qw(ref refstart refstrand)} = ($srcseq,1,'+');
}
@{$self}{qw(type fstrand score phase group db_id group_id absolute)} =
(Bio::DB::GFF::Typename->new($method,$source),$fstrand,$score,$phase,
$group,$db_id,$group_id,$factory->{absolute});
$self;
}
=head2 type
Title : type
Usage : $type = $f->type([$newtype])
Function: get or set the feature type
Returns : a Bio::DB::GFF::Typename object
Args : a new Typename object (optional)
Status : Public
This method gets or sets the type of the feature. The type is a
Bio::DB::GFF::Typename object, which encapsulates the feature method
and source.
The method() and source() methods described next provide shortcuts to
the individual fields of the type.
=cut
sub type {
my $self = shift;
my $d = $self->{type};
$self->{type} = shift if @_;
$d;
}
=head2 method
Title : method
Usage : $method = $f->method([$newmethod])
Function: get or set the feature method
Returns : a string
Args : a new method (optional)
Status : Public
This method gets or sets the feature method. It is a convenience
feature that delegates the task to the feature's type object.
=cut
sub method {
my $self = shift;
my $d = $self->{type}->method;
$self->{type}->method(shift) if @_;
$d;
}
=head2 source
Title : source
Usage : $source = $f->source([$newsource])
Function: get or set the feature source
Returns : a string
Args : a new source (optional)
Status : Public
This method gets or sets the feature source. It is a convenience
feature that delegates the task to the feature's type object.
=cut
sub source {
my $self = shift;
my $d = $self->{type}->source;
$self->{type}->source(shift) if @_;
$d;
}
=head2 score
Title : score
Usage : $score = $f->score([$newscore])
Function: get or set the feature score
Returns : a string
Args : a new score (optional)
Status : Public
This method gets or sets the feature score.
=cut
sub score {
my $self = shift;
my $d = $self->{score};
$self->{score} = shift if @_;
$d;
}
=head2 phase
Title : phase
Usage : $phase = $f->phase([$phase])
Function: get or set the feature phase
Returns : a string
Args : a new phase (optional)
Status : Public
This method gets or sets the feature phase.
=cut
sub phase {
my $self = shift;
my $d = $self->{phase};
$self->{phase} = shift if @_;
$d;
}
=head2 strand
Title : strand
Usage : $strand = $f->strand
Function: get the feature strand
Returns : +1, 0 -1
Args : none
Status : Public
Returns the strand of the feature. Unlike the other methods, the
strand cannot be changed once the object is created (due to coordinate
considerations).
=cut
sub strand {
my $self = shift;
return 0 unless $self->{fstrand};
if ($self->absolute) {
return Bio::DB::GFF::RelSegment::_to_strand($self->{fstrand});
}
return $self->SUPER::strand;
}
=head2 group
Title : group
Usage : $group = $f->group([$new_group])
Function: get or set the feature group
Returns : a Bio::DB::GFF::Featname object
Args : a new group (optional)
Status : Public
This method gets or sets the feature group. The group is a
Bio::DB::GFF::Featname object, which has an ID and a class.
=cut
sub group {
my $self = shift;
my $d = $self->{group};
$self->{group} = shift if @_;
$d;
}
=head2 display_id
Title : display_id
Usage : $display_id = $f->display_id([$display_id])
Function: get or set the feature display id
Returns : a Bio::DB::GFF::Featname object
Args : a new display_id (optional)
Status : Public
This method is an alias for group(). It is provided for
Bio::SeqFeatureI compatibility.
=cut
=head2 info
Title : info
Usage : $info = $f->info([$new_info])
Function: get or set the feature group
Returns : a Bio::DB::GFF::Featname object
Args : a new group (optional)
Status : Public
This method is an alias for group(). It is provided for AcePerl
compatibility.
=cut
*info = \&group;
*display_id = \&group;
*display_name = \&group;
=head2 target
Title : target
Usage : $target = $f->target([$new_target])
Function: get or set the feature target
Returns : a Bio::DB::GFF::Featname object
Args : a new group (optional)
Status : Public
This method works like group(), but only returns the group if it
implements the start() method. This is typical for
similarity/assembly features, where the target encodes the start and stop
location of the alignment.
=cut
sub target {
my $self = shift;
my $group = $self->group or return;
return unless $group->can('start');
$group;
}
=head2 hit
Title : hit
Usage : $hit = $f->hit([$new_hit])
Function: get or set the feature hit
Returns : a Bio::DB::GFF::Featname object
Args : a new group (optional)
Status : Public
This is the same as target(), for compatibility with
Bio::SeqFeature::SimilarityPair.
=cut
*hit = \⌖
=head2 id
Title : id
Usage : $id = $f->id
Function: get the feature ID
Returns : a database identifier
Args : none
Status : Public
This method retrieves the database identifier for the feature. It
cannot be changed.
=cut
sub id { shift->{db_id} }
=head2 group_id
Title : group_id
Usage : $id = $f->group_id
Function: get the feature ID
Returns : a database identifier
Args : none
Status : Public
This method retrieves the database group identifier for the feature.
It cannot be changed. Often the group identifier is more useful than
the feature identifier, since it is used to refer to a complex object
containing subparts.
=cut
sub group_id { shift->{group_id} }
=head2 clone
Title : clone
Usage : $feature = $f->clone
Function: make a copy of the feature
Returns : a new Bio::DB::GFF::Feature object
Args : none
Status : Public
This method returns a copy of the feature.
=cut
sub clone {
my $self = shift;
my $clone = $self->SUPER::clone;
if (ref(my $t = $clone->type)) {
my $type = $t->can('clone') ? $t->clone : bless {%$t},ref $t;
$clone->type($type);
}
if (ref(my $g = $clone->group)) {
my $group = $g->can('clone') ? $g->clone : bless {%$g},ref $g;
$clone->group($group);
}
if (my $merged = $self->{merged_segs}) {
$clone->{merged_segs} = { %$merged };
}
$clone;
}
=head2 compound
Title : compound
Usage : $flag = $f->compound([$newflag])
Function: get or set the compound flag
Returns : a boolean
Args : a new flag (optional)
Status : Public
This method gets or sets a flag indicated that the feature is not a
primary one from the database, but the result of aggregation.
=cut
sub compound {
my $self = shift;
my $d = $self->{compound};
$self->{compound} = shift if @_;
$d;
}
=head2 sub_SeqFeature
Title : sub_SeqFeature
Usage : @feat = $feature->sub_SeqFeature([$method])
Function: get subfeatures
Returns : a list of Bio::DB::GFF::Feature objects
Args : a feature method (optional)
Status : Public
This method returns a list of any subfeatures that belong to the main
feature. For those features that contain heterogeneous subfeatures,
you can retrieve a subset of the subfeatures by providing a method
name to filter on.
For AcePerl compatibility, this method may also be called as
segments().
=cut
sub sub_SeqFeature {
my $self = shift;
my $type = shift;
my $subfeat = $self->{subfeatures} or return;
$self->sort_features;
my @a;
if ($type) {
my $features = $subfeat->{lc $type} or return;
@a = @{$features};
} else {
@a = map {@{$_}} values %{$subfeat};
}
return @a;
}
=head2 add_subfeature
Title : add_subfeature
Usage : $feature->add_subfeature($feature)
Function: add a subfeature to the feature
Returns : nothing
Args : a Bio::DB::GFF::Feature object
Status : Public
This method adds a new subfeature to the object. It is used
internally by aggregators, but is available for public use as well.
=cut
sub add_subfeature {
my $self = shift;
my $feature = shift;
my $type = $feature->method;
my $subfeat = $self->{subfeatures}{lc $type} ||= [];
push @{$subfeat},$feature;
}
=head2 attach_seq
Title : attach_seq
Usage : $sf->attach_seq($seq)
Function: Attaches a Bio::Seq object to this feature. This
Bio::Seq object is for the *entire* sequence: ie
from 1 to 10000
Example :
Returns : TRUE on success
Args : a Bio::PrimarySeqI compliant object
=cut
sub attach_seq { }
=head2 location
Title : location
Usage : my $location = $seqfeature->location()
Function: returns a location object suitable for identifying location
of feature on sequence or parent feature
Returns : Bio::LocationI object
Args : none
=cut
sub location {
my $self = shift;
require Bio::Location::Split unless Bio::Location::Split->can('new');
require Bio::Location::Simple unless Bio::Location::Simple->can('new');
my $location;
if (my @segments = $self->segments) {
$location = Bio::Location::Split->new(-seq_id => $self->seq_id);
foreach (@segments) {
$location->add_sub_Location($_->location);
}
} else {
$location = Bio::Location::Simple->new(-start => $self->start,
-end => $self->stop,
-strand => $self->strand,
-seq_id => $self->seq_id);
}
$location;
}
=head2 entire_seq
Title : entire_seq
Usage : $whole_seq = $sf->entire_seq()
Function: gives the entire sequence that this seqfeature is attached to
Example :
Returns : a Bio::PrimarySeqI compliant object, or undef if there is no
sequence attached
Args : none
=cut
sub entire_seq {
my $self = shift;
$self->factory->segment($self->sourceseq);
}
=head2 merged_segments
Title : merged_segments
Usage : @segs = $feature->merged_segments([$method])
Function: get merged subfeatures
Returns : a list of Bio::DB::GFF::Feature objects
Args : a feature method (optional)
Status : Public
This method acts like sub_SeqFeature, except that it merges
overlapping segments of the same time into contiguous features. For
those features that contain heterogeneous subfeatures, you can
retrieve a subset of the subfeatures by providing a method name to
filter on.
A side-effect of this method is that the features are returned in
sorted order by their start tposition.
=cut
#'
sub merged_segments {
my $self = shift;
my $type = shift;
$type ||= ''; # prevent uninitialized variable warnings
my $truename = overload::StrVal($self);
return @{$self->{merged_segs}{$type}} if exists $self->{merged_segs}{$type};
my @segs = map { $_->[0] }
sort { $a->[1] <=> $b->[1] ||
$a->[2] cmp $b->[2] }
map { [$_, $_->start, $_->type] } $self->sub_SeqFeature($type);
# attempt to merge overlapping segments
my @merged = ();
for my $s (@segs) {
my $previous = $merged[-1] if @merged;
my ($pscore,$score) = (eval{$previous->score}||0,eval{$s->score}||0);
if (defined($previous)
&& $previous->stop+1 >= $s->start
&& (!defined($s->score) || $previous->score == $s->score)
&& $previous->method eq $s->method
) {
if ($self->absolute && $self->strand < 0) {
$previous->{start} = $s->{start};
} else {
$previous->{stop} = $s->{stop};
}
# fix up the target too
my $g = $previous->{group};
if ( ref($g) && $g->isa('Bio::DB::GFF::Homol')) {
my $cg = $s->{group};
$g->{stop} = $cg->{stop};
}
} elsif (defined($previous)
&& $previous->start == $s->start
&& $previous->stop == $s->stop) {
next;
} else {
my $copy = $s->clone;
push @merged,$copy;
}
}
$self->{merged_segs}{$type} = \@merged;
@merged;
}
=head2 sub_types
Title : sub_types
Usage : @methods = $feature->sub_types
Function: get methods of all sub-seqfeatures
Returns : a list of method names
Args : none
Status : Public
For those features that contain subfeatures, this method will return a
unique list of method names of those subfeatures, suitable for use
with sub_SeqFeature().
=cut
sub sub_types {
my $self = shift;
my $subfeat = $self->{subfeatures} or return;
return keys %$subfeat;
}
=head2 attributes
Title : attributes
Usage : @attributes = $feature->attributes($name)
Function: get the "attributes" on a particular feature
Returns : an array of string
Args : feature ID
Status : public
Some GFF version 2 files use the groups column to store a series of
attribute/value pairs. In this interpretation of GFF, the first such
pair is treated as the primary group for the feature; subsequent pairs
are treated as attributes. Two attributes have special meaning:
"Note" is for backward compatibility and is used for unstructured text
remarks. "Alias" is considered as a synonym for the feature name.
@gene_names = $feature->attributes('Gene');
@aliases = $feature->attributes('Alias');
If no name is provided, then attributes() returns a flattened hash, of
attribute=E<gt>value pairs. This lets you do:
%attributes = $db->attributes;
=cut
sub attributes {
my $self = shift;
my $factory = $self->factory;
defined(my $id = $self->id) or return;
$factory->attributes($id,@_)
}
=head2 notes
Title : notes
Usage : @notes = $feature->notes
Function: get the "notes" on a particular feature
Returns : an array of string
Args : feature ID
Status : public
Some GFF version 2 files use the groups column to store various notes
and remarks. Adaptors can elect to store the notes in the database,
or just ignore them. For those adaptors that store the notes, the
notes() method will return them as a list.
=cut
sub notes {
my $self = shift;
$self->attributes('Note');
}
=head2 aliases
Title : aliases
Usage : @aliases = $feature->aliases
Function: get the "aliases" on a particular feature
Returns : an array of string
Args : feature ID
Status : public
This method will return a list of attributes of type 'Alias'.
=cut
sub aliases {
my $self = shift;
$self->attributes('Alias');
}
=head2 Autogenerated Methods
Title : AUTOLOAD
Usage : @subfeat = $feature->Method
Function: Return subfeatures using autogenerated methods
Returns : a list of Bio::DB::GFF::Feature objects
Args : none
Status : Public
Any method that begins with an initial capital letter will be passed
to AUTOLOAD and treated as a call to sub_SeqFeature with the method
name used as the method argument. For instance, this call:
@exons = $feature->Exon;
is equivalent to this call:
@exons = $feature->sub_SeqFeature('exon');
=cut
=head2 SeqFeatureI methods
The following Bio::SeqFeatureI methods are implemented:
primary_tag(), source_tag(), all_tags(), has_tag(), each_tag_value().
=cut
*primary_tag = \&method;
*source_tag = \&source;
sub all_tags {
my $self = shift;
my @tags = keys %CONSTANT_TAGS;
# autogenerated methods
if (my $subfeat = $self->{subfeatures}) {
push @tags,keys %$subfeat;
}
@tags;
}
*get_all_tags = \&all_tags;
sub has_tag {
my $self = shift;
my $tag = shift;
my %tags = map {$_=>1} $self->all_tags;
return $tags{$tag};
}
sub each_tag_value {
my $self = shift;
my $tag = shift;
return $self->$tag() if $CONSTANT_TAGS{$tag};
$tag = ucfirst $tag;
return $self->$tag(); # try autogenerated tag
}
sub AUTOLOAD {
my($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
my $sub = $AUTOLOAD;
my $self = $_[0];
# ignore DESTROY calls
return if $func_name eq 'DESTROY';
# fetch subfeatures if func_name has an initial cap
# return sort {$a->start <=> $b->start} $self->sub_SeqFeature($func_name) if $func_name =~ /^[A-Z]/;
return $self->sub_SeqFeature($func_name) if $func_name =~ /^[A-Z]/;
# error message of last resort
$self->throw(qq(Can't locate object method "$func_name" via package "$pack"));
}#'
=head2 adjust_bounds
Title : adjust_bounds
Usage : $feature->adjust_bounds
Function: adjust the bounds of a feature
Returns : ($start,$stop,$strand)
Args : none
Status : Public
This method adjusts the boundaries of the feature to enclose all its
subfeatures. It returns the new start, stop and strand of the
enclosing feature.
=cut
# adjust a feature so that its boundaries are synched with its subparts' boundaries.
# this works recursively, so subfeatures can contain other features
sub adjust_bounds {
my $self = shift;
my $g = $self->{group};
if (my $subfeat = $self->{subfeatures}) {
for my $list (values %$subfeat) {
for my $feat (@$list) {
# fix up our bounds to hold largest subfeature
my($start,$stop,$strand) = $feat->adjust_bounds;
$self->{fstrand} = $strand unless defined $self->{fstrand};
my ($low,$high) = $start < $stop ? ($start,$stop) : ($stop,$start);
if ($self->{fstrand} ne '-') {
$self->{start} = $low if !defined($self->{start}) || $low < $self->{start};
$self->{stop} = $high if !defined($self->{stop}) || $high > $self->{stop};
} else {
$self->{start} = $high if !defined($self->{start}) || $high > $self->{start};
$self->{stop} = $low if !defined($self->{stop}) || $low < $self->{stop};
}
# fix up endpoints of targets too (for homologies only)
my $h = $feat->group;
next unless $h && $h->isa('Bio::DB::GFF::Homol');
next unless $g && $g->isa('Bio::DB::GFF::Homol');
($start,$stop) = ($h->{start},$h->{stop});
if ($start <= $stop) {
$g->{start} = $start if !defined($g->{start}) || $start < $g->{start};
$g->{stop} = $stop if !defined($g->{stop}) || $stop > $g->{stop};
} else {
$g->{start} = $start if !defined($g->{start}) || $start > $g->{start};
$g->{stop} = $stop if !defined($g->{stop}) || $stop < $g->{stop};
}
}
}
}
($self->{start},$self->{stop},$self->strand);
}
=head2 sort_features
Title : sort_features
Usage : $feature->sort_features
Function: sort features
Returns : nothing
Args : none
Status : Public
This method sorts subfeatures in ascending order by their start
position. For reverse strand features, it sorts subfeatures in
descending order. After this is called sub_SeqFeature will return the
features in order.
This method is called internally by merged_segments().
=cut
# sort features
sub sort_features {
my $self = shift;
return if $self->{sorted}++;
my $strand = $self->strand or return;
my $subfeat = $self->{subfeatures} or return;
for my $type (keys %$subfeat) {
$subfeat->{$type} = [map { $_->[0] }
sort {$a->[1] <=> $b->[1] }
map { [$_,$_->start] }
@{$subfeat->{$type}}] if $strand > 0;
$subfeat->{$type} = [map { $_->[0] }
sort {$b->[1] <=> $a->[1]}
map { [$_,$_->start] }
@{$subfeat->{$type}}] if $strand < 0;
}
}
=head2 asString
Title : asString
Usage : $string = $feature->asString
Function: return human-readabled representation of feature