view release on metacpan or  search on metacpan

Bio/DB/GFF/Feature.pm  view on Meta::CPAN

  # 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;