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) {