File Coverage

blib/lib/Bio/Coordinate/Result.pm

Criterion	Covered	Total	%
statement	58	64	90.6
branch	19	26	73.0
condition	3	6	50.0
subroutine	12	12	100.0
pod	8	8	100.0
total	100	116	86.2

package Bio::Coordinate::Result;
our $AUTHORITY = 'cpan:BIOPERLML';
$Bio::Coordinate::Result::VERSION = '1.007001';
use utf8;
use strict;
use warnings;
use parent qw(Bio::Location::Split Bio::Coordinate::ResultI);

# ABSTRACT: Results from coordinate transformation.
# AUTHOR:   Heikki Lehvaslaiho
# OWNER:    Heikki Lehvaslaiho
# LICENSE:  Perl_5



sub add_sub_Location {
  my ($self,$value) = @_;
  if( ! $value ) {
      $self->warn("provding an empty value for location\n");
      return;
  }
  $self->throw("Is not a Bio::LocationI but [$value]")
      unless $value->isa('Bio::LocationI');

  $self->{'_match'} = $value
      if $value->isa('Bio::Coordinate::Result::Match');

  $self->{'_gap'} = $value
      if $value->isa('Bio::Coordinate::Result::Gap');

  $self->SUPER::add_sub_Location($value);

}


sub add_result {
  my ($self,$value) = @_;

  $self->throw("Is not a Bio::Coordinate::Result but [$value]")
      unless $value->isa('Bio::Coordinate::Result');

  map { $self->add_sub_Location($_) } $value->each_Location;
}


sub seq_id {
    my ($self, $seqid) = @_;

    my @ls = $self->each_Location;
    if (@ls) {
        return $ls[0]->seq_id;
    } else {
        return;
    }
}


sub each_gap {
   my ($self) = @_;

   my @gaps;
   foreach my $gap ($self->each_Location) {
       push @gaps, $gap if $gap->isa('Bio::Coordinate::Result::Gap');
   }
   return @gaps;

}


sub each_match {
   my ($self) = @_;

   my @matches;
   foreach my $match ($self->each_Location) {
       push @matches, $match if $match->isa('Bio::Coordinate::Result::Match');
   }
   return @matches;
}


sub match {
   my ($self) = @_;

   $self->warn("More than one match in results")
       if $self->each_match > 1 and $self->verbose > 0;
   unless (defined $self->{'_match'} ) {
       my @m = $self->each_match;
       $self->{'_match'} = $m[-1];
   }
   return $self->{'_match'};
}


sub gap {
   my ($self) = @_;

   $self->warn("More than one gap in results")
       if $self->each_gap > 1 and $self->verbose > 0;
   unless (defined $self->{'_gap'} ) {
       my @m = $self->each_gap;
       $self->{'_gap'} = $m[-1];
   }
   return $self->{'_gap'};
}


sub purge_gaps {
    my ($self) = @_;
    my @matches;
    my $count = 0;

    foreach my $loc ($self->each_Location) {
        if ($loc->isa('Bio::Coordinate::Result::Match')) {
            push @matches, $loc;
        } else {
            $count++
        }
    }
    @{$self->{'_sublocations'}} = ();
    delete $self->{'_gap'} ;
    push @{$self->{'_sublocations'}}, @matches;
    return $count;
}

1;

__END__