File Coverage

Bio/DB/GFF/Feature.pm

Criterion	Covered	Total	%
statement	163	342	47.6
branch	56	190	29.4
condition	18	123	14.6
subroutine	32	49	65.3
pod	36	38	94.7
total	305	742	41.1

=head1 NAME

Bio::DB::GFF::Feature -- A relative segment identified by a feature type

=head1 SYNOPSIS

See L.

=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
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-Efeatures() 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-Eabsolute(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::Featname;
use Bio::DB::GFF::Typename;
use Bio::DB::GFF::Homol;
use Bio::LocationI;
use Data::Dumper;

use vars qw($AUTOLOAD);
use base qw(Bio::DB::GFF::RelSegment Bio::SeqFeatureI Bio::Root::Root);

#'

*segments = *get_SeqFeatures = \&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 the coordinate system of that
object.

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 are not 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 || Bio::DB::GFF::RelSegment::_to_strand($self->{fstrand});
}

=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::Homol 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.

The returned object is of type Bio::DB::GFF::Homol, which is a
subclass of Bio::DB::GFF::Segment.

=cut


sub target {
    my $self = shift;
    my $group = $self->group or return;
    return unless $group->can('start');
    $group;
}

=head2 flatten_target

 Title   : flatten_target
 Usage   : $target = $f->flatten_target($f->target)
 Function: flatten a target object
 Returns : a string (GFF2), an array [GFF2.5] or an array ref [GFF3]
 Args    : a target object (required), GFF version (optional)
 Status  : Public

This method flattens a target object into text for
GFF dumping.  If a second argument is provided, version-specific
vocabulary is used for the flattened target.

=cut

sub flatten_target {
    my $self = shift;
    my $t    = shift || return;
    my $v    = shift;

    return 0 unless $t->can('start');
    my $class = $t->class;
    my $name  = $t->name;
    my $start = $t->start;
    my $stop  = $t->stop;

    $v ||=2;
    if ( $v == 2.5 ) {

	print STDERR qq(Target "$class:$name"), "tstart $start", "tstop $stop\n";
	return (qq(Target "$class:$name"), "tstart $start", "tstop $stop");
    }
    elsif ( $v == 3 ) {
	return [Target=>"$name $start $stop"];
    }
    else {
	return qq(Target "$class:$name" $start $stop);
    }
}

# override parent a smidgeon so that setting the ref for top-level feature
# sets ref for all subfeatures
sub refseq {
  my $self   = shift;
  my $result = $self->SUPER::refseq(@_);
  if (@_) {
    my $newref = $self->SUPER::refseq;
    for my $sub ($self->get_SeqFeatures) {
      $sub->refseq(@_);
    }
  }
  $result;
}


=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}   }
sub primary_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.

This method may also be called as segments() or get_SeqFeatures().

=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
	&& $pscore == $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
	    && $previous->method eq $s->method
	   ) {
       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=Evalue 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() [renamed get_tag_values()].

=cut

*primary_tag = \&method;
*source_tag  = \&source;
sub all_tags {
  my $self = shift;
  my %atts = $self->attributes;
  my @tags = keys %atts;

  # 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 %att  = $self->attributes;
  my %tags = map {$_=>1} ( $self->all_tags );

  return $tags{$tag};
}

*each_tag_value = \&get_tag_values;

sub get_tag_values {
  my $self = shift;
  my $tag  = shift;
  return $self->$tag() if $CONSTANT_TAGS{$tag};

  my $atts = $self->attributes;
  return @{$atts->{$tag}} if $atts && $atts->{$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 $shrink = shift;
  my $g = $self->{group};

  my $first = 0;
  my $tfirst = 0;
  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($shrink);

	if (defined($self->{fstrand})) {
	  $self->debug("Subfeature's strand ($strand) doesn't match parent strand ($self->{fstrand})\n") if $self->{fstrand} ne $strand;
	} else {
	  $self->{fstrand} = $strand;
	}

	my ($low,$high)  = $start < $stop ? ($start,$stop) : ($stop,$start);
	if ($shrink && !$first++) {
	  # first subfeature resets start & stop:
	  $self->{start} = $self->{fstrand} ne '-' ? $low : $high;
	  $self->{stop}  = $self->{fstrand} ne '-' ? $high : $low;
	} else {
	  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 ($shrink && !$tfirst++) {
	    $g->{start} = $start;
	    $g->{stop}  = $stop;
	} else {
	  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
 Returns : a string
 Args    : none
 Status  : Public

This method returns a human-readable representation of the feature and
is called by the overloaded "" operator.

=cut

sub asString {
  my $self = shift;
  my $type = $self->type;
  my $name = $self->group;
  return "$type($name)" if $name;
  return $type;
#  my $type = $self->method;
#  my $id   = $self->group || 'unidentified';
#  return join '/',$id,$type,$self->SUPER::asString;
}

sub name {
  my $self =shift;
  return $self->group || $self->SUPER::name;
}

=head2 gff_string

 Title   : gff_string
 Usage   : $string = $feature->gff_string
 Function: return GFF2 of GFF2.5 representation of feature
 Returns : a string
 Args    : none
 Status  : Public

=cut

sub gff_string {
  my $self = shift;
  my $version = $self->version;

  # gff3_string and gff_string are synonymous if the version is set to 3
  return $self->gff3_string(@_) if $version == 3;

  my ($start,$stop) = ($self->start,$self->stop);

  # the defined() tests prevent uninitialized variable warnings, when dealing with clone objects
  # whose endpoints may be undefined
  ($start,$stop) = ($stop,$start) if defined($start) && defined($stop) && $start > $stop;

  my ($class,$name) = ('','');
  my $strand = ('-','.','+')[$self->strand+1];

  my @group;

  if (my $t = $self->target) {
    push @group, $version == 2.5 ? $self->flatten_target($t,2.5)
                                 : $self->flatten_target($t);
  }
  elsif (my $g = $self->group) {
    $class = $g->class || '';
    $name  = $g->name  || '';
    ($name =~ /\S\s\S/)?(push @group, "$class '$name'"):(push @group,"$class $name");
  }

  # add exhaustive list of attributes
  my $att = $self->attributes;
  for ( keys %$att ) {
      for my $v ( @{$att->{$_}} ) {
	  $v = qq("$v") if $v=~ /\S\s+\S/;
	  push @group, qq($_ $v);
      }
  }

  my $group_field = join ' ; ',@group;
  my $ref = $self->refseq;
  my $n   = ref($ref) ? $ref->name : $ref;
  my $phase = $self->phase;
  $phase = '.' unless defined $phase;
  return join("\t",
	      $n,
	      $self->source,$self->method,
	      (defined $start ? $start : '.'),
	      (defined $stop  ? $stop  : '.'),
	      (defined $self->score ? $self->score : '.'),
	      (defined $strand ? $strand : '.'),
	      $phase,
	      $group_field);
}

=head2 gff3_string

 Title   : gff3_string
 Usage   : $string = $feature->gff3_string([$recurse])
 Function: return GFF3 representation of feature
 Returns : a string
 Args    : An optional flag, which if true, will cause the feature to recurse over
           subfeatures.
 Status  : Public

=cut

sub gff3_string {
  my $self = shift;
  my ($recurse,$parent) = @_;
  my ($start,$stop) = ($self->start,$self->stop);

  # the defined() tests prevent uninitialized variable warnings, when dealing with clone objects
  # whose endpoints may be undefined
  ($start,$stop) = ($stop,$start) if defined($start) && defined($stop) && $start > $stop;

  my $strand = ('-','.','+')[$self->strand+1];
  my $ref = $self->refseq;
  my $n   = ref($ref) ? $ref->name : $ref;
  my $phase = $self->phase;
  $phase = '.' unless defined $phase;

  my ($class,$name) = ('','');
  my @group;
  if (my $g = $self->group) {
    $class = $g->class || '';
    $name  = $g->name  || '';
    $name  = "$class:$name" if defined $class;
    push @group,[ID =>  $name] if !defined($parent) || $name ne $parent;
  }

  push @group,[Parent => $parent] if defined $parent && $parent ne '';

  if (my $t = $self->target) {
    $strand = '-' if $t->stop < $t->start;
    push @group, $self->flatten_target($t,3);
  }

  my @attributes = $self->attributes;
  while (@attributes) {
    push @group,[shift(@attributes),shift(@attributes)]
  }
  my $group_field = join ';',map {join '=',_escape($_->[0]),_escape($_->[1])} @group;
  my $string = join("\t",$n,$self->source,$self->method,$start||'.',$stop||'.',
                         $self->score||'.',$strand||'.',$phase,$group_field);
  $string .= "\n";
  if ($recurse) {
    foreach ($self->sub_SeqFeature) {
      $string .= $_->gff3_string(1,$name);
    }
  }
  $string;
}

=head2 version

 Title   : version
 Usage   : $feature->version()
 Function: get/set the GFF version to be returned by gff_string
 Returns : the GFF version (default is 2)
 Args    : the GFF version (2, 2.5 of 3)
 Status  : Public

=cut

sub version {
  my ($self, $version) = @_;
  $self->{version} = $version if $version;
  return $self->{version} || 2;
}


sub _escape {
  my $toencode = shift;
  $toencode    =~ s/([^a-zA-Z0-9_. :?^*\(\)\[\]@!-])/uc sprintf("%%%02x",ord($1))/eg;
  $toencode    =~ tr/ /+/;
  $toencode;
}

=head2 cmap_link()

 Title   : cmap_link
 Usage   : $link = $feature->cmap_link
 Function: returns a URL link to the corresponding feature in cmap
 Returns : a string
 Args    : none
 Status  : Public

If integrated cmap/gbrowse installation, it returns a link to the map otherwise
it returns a link to a feature search on the feature name.  See the cmap
documentation for more information.

This function is intended primarily to be used in gbrowse conf files.
For example:

  link       = sub {my $self = shift; return $self->cmap_viewer_link(data_source);}

=cut


sub cmap_viewer_link {
  # Use ONLY if CMap is installed
  my $self        = shift;
  my $data_source = shift;
  my $group_id    = $self->group_id;
  my $factory     = $self->factory; # aka adaptor

  my $link_str;

  if ($factory->can("create_cmap_viewer_link")){
    $link_str = $factory->create_cmap_viewer_link(
        data_source => $data_source,
        group_id    => $group_id,
    );
  }
  my $name = $self->name();
  $link_str = '/cgi-bin/cmap/feature_search?features='
    . $name
    . '&search_field=feature_name&order_by=&data_source='
    . $data_source
    . '&submit=Submit'
    unless $link_str;

  return $link_str;

}

=head1 A Note About Similarities

The current default aggregator for GFF "similarity" features creates a
composite Bio::DB::GFF::Feature object of type "gapped_alignment".
The target() method for the feature as a whole will return a
RelSegment object that is as long as the extremes of the similarity
hit target, but will not necessarily be the same length as the query
sequence.  The length of each "similarity" subfeature will be exactly
the same length as its target().  These subfeatures are essentially
the HSPs of the match.

The following illustrates this:

  @similarities = $segment->feature('similarity:BLASTN');
  $sim          = $similarities[0];

  print $sim->type;        # yields "gapped_similarity:BLASTN"

  $query_length  = $sim->length;
  $target_length = $sim->target->length;  # $query_length != $target_length

  @matches = $sim->Similarity;   # use autogenerated method
  $query1_length  = $matches[0]->length;
  $target1_length = $matches[0]->target->length; # $query1_length == $target1_length

If you merge segments by calling merged_segments(), then the length of
the query sequence segments will no longer necessarily equal the
length of the targets, because the alignment information will have
been lost.  Nevertheless, the targets are adjusted so that the first
and last base pairs of the query match the first and last base pairs
of the target.

=cut

1;

=head1 BUGS

This module is still under development.

=head1 SEE ALSO

L, L, L

=head1 AUTHOR

Lincoln Stein [e-mail].

Copyright (c) 2001 Cold Spring Harbor Laboratory.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut