view release on metacpan or  search on metacpan

Ace/Sequence/Multi.pm  view on Meta::CPAN

package Ace::Sequence::Multi;
use strict;

use Carp;
use strict;
use Ace 1.50 qw(:DEFAULT rearrange);
use Ace::Sequence;

use vars '@ISA';
@ISA = 'Ace::Sequence';

# backward compatibility
*db_id = \&db;

sub new {
  my $pack = shift;
  my ($secondary,$rest) = rearrange([['SECONDARY','DBS']],@_);
  return unless my $obj = $pack->SUPER::new($rest);

  if (defined $secondary) {
    my @s = ref $secondary eq 'ARRAY' ? @$secondary : $secondary;
    $obj->{'secondary'} = { map { $_=> $_} @s };
  }

  return bless $obj,$pack;
}

sub secondary {
  return unless my $s = $_[0]->{'secondary'};
  return values %{$s};
}

sub add_secondary {
  my $self = shift;
  foreach (@_) {
    $self->{'secondary'}->{$_}=$_;
  }
}

sub delete_secondary {
  my $self = shift;
  foreach (@_) {
    delete $self->{'secondary'}->{$_};
  }
}

sub db {
  return $_[0]->SUPER::db() unless $_[1];
  return $_[0]->{'secondary'}->{$_[1]} || $_[0]->SUPER::db();
}

# return list of features quickly
sub feature_list {
  my $self = shift;
  return $self->{'feature_list'} if $self->{'feature_list'};
  my $raw;

  for my $db ($self->db,$self->secondary) {
    $raw .= $self->_query($db,'seqfeatures -version 2 -list');
    $raw .= "\n";  # avoid nulls
  }

  return $self->{'feature_list'} = Ace::Sequence::FeatureList->new($raw);
}

# return a unified gff file
sub gff {
  my $self = shift;
  my ($abs,$features) = rearrange([['ABS','ABSOLUTE'],'FEATURES'],@_);
  my   $db = $self->db;

  my $gff = $self->SUPER::gff(-Abs=>$abs,-Features=>$features,-Db=>$db);
  return unless $gff;
  return $gff unless $self->secondary;

  my(%seen,@lines);

  foreach (grep !$seen{$_}++,split("\n",$gff)) {  #ignore duplicates
    next if m!^//!;  # ignore comments
    push @lines,/^\#/ ? $_ : join "\t",$_,$db;
  }

  my $opt = $self->_feature_filter($features);

  for my $db ($self->secondary) {
    my $supplement = $self->_gff($opt,$db);
    $self->transformGFF(\$supplement) unless $abs;

    my $string = $db->asString;

    foreach (grep !$seen{$_}++,split("\n",$supplement)) {  #ignore duplicates
      next if m!^(//|\#)!;  # ignore comments
      push(@lines, join "\t",$_,$string);   # add database as an eighth field
    }
  }

  return join("\n",@lines,'');
}

# turn a GFF file and a filter into a list of Ace::Sequence::Feature objects
sub _make_features {
  my $self = shift;
  my ($gff,$filter) = @_;

  my @dbs = ($self->db,$self->secondary);
  my %dbs = map { $_->asString => $_ } @dbs;

  my ($r,$r_offset,$r_strand) = $self->refseq;
  my $abs = $self->absolute;
  if ($abs) {
    $r_offset  = 0;
    $r = $self->parent;
    $r_strand = '+1';
  }
  my @features;
  foreach (split("\n",$gff)) {
    next if m[^(?:\#|//)];
    next unless $filter->($_);
    next unless my ($dbname) = /\t(\S+)$/;
    next unless my $db = $dbs{$dbname};
    next unless my $parent = $self->parent;
    push @features,Ace::Sequence::Feature->new($parent,$r,$r_offset,$r_strand,$abs,$_,$db);
  }

  return @features;
}

1;

__END__

=head1 NAME