view release on metacpan or  search on metacpan

Das/Feature.pm  view on Meta::CPAN

  return shift->strand eq '-';
}

sub seq {
  my $self = shift;
  my $seg    = $self->segment or return;
  my $das    = $seg->das or return;
  my $newseg = $das->segment($self->seq_id,$self->start,$self->end);
  my $dna = $newseg->dna;
  if ($self->strand < 0) {
    $dna =~ tr/gatcGATC/ctagCTAG/;
    $dna = reverse $dna;
  }
  $dna;
}

sub get_SeqFeatures {
  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;
}

sub add_subfeature {
  my $self    = shift;
  my $feature = shift;
  my $type = $feature->method;
  my $subfeat = $self->{subfeatures}{lc $type} ||= [];
  push @{$subfeat},$feature;
}

# 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 $t = $self->{target};

  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};
	if ($start <= $stop) {
	  $self->{start} = $start if !defined($self->{start}) || $start < $self->{start};
	  $self->{stop}  = $stop  if !defined($self->{stop})  || $stop  > $self->{stop};
	} else {
	  $self->{start} = $start if !defined($self->{start}) || $start > $self->{start};
	  $self->{stop}  = $stop  if !defined($self->{stop})  || $stop  < $self->{stop};
	}

	# fix up endpoints of targets too
	my $st = $feat->{target};
	next unless $t && $st;
	($start,$stop) = (@{$st}[1,2]);
	if ($start < $stop) {
	  $t->[1] = $start if !defined($t->[1]) || $start < $t->[1];  # start
	  $t->[2] = $stop  if !defined($t->[2]) || $stop  > $t->[2];  # stop
	} else {
	  $t->[1] = $start if !defined($t->[1]) || $start > $t->[1];  # start
	  $t->[2] = $stop  if !defined($t->[2]) || $stop  < $t->[2];
	}
      }
    }
  }

  ($self->{start},$self->{stop},$self->strand);
}

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

sub compound  {
  my $self = shift;
  my $d    = $self->{compound};
  $self->{compound} = shift if @_;
  $d;
}

sub primary_tag { shift->type   }
sub class       { shift->method }
sub source_tag  { shift->method }
sub source      {
  my $type = shift->type;
  my ($method,$source) = split ':',$type;
  return $source;
}
sub gff_string {
  my $self = shift;
  return join "\t",(
		    $self->refseq,
		    $self->method,
		    $self->type,
		    $self->start,
		    $self->end,
		    $self->score,
		    $self->{orientation},