File Coverage

blib/lib/Bio/Coordinate/ExtrapolatingPair.pm

Criterion	Covered	Total	%
statement	59	59	100.0
branch	25	34	73.5
condition	3	3	100.0
subroutine	10	10	100.0
pod	3	3	100.0
total	100	109	91.7

package Bio::Coordinate::ExtrapolatingPair;
our $AUTHORITY = 'cpan:BIOPERLML';
$Bio::Coordinate::ExtrapolatingPair::VERSION = '1.007001';
use utf8;
use strict;
use warnings;
use Bio::Root::Root;
use Bio::LocationI;
use parent qw(Bio::Coordinate::Pair);

# ABSTRACT: Continuous match between two coordinate sets.
# AUTHOR:   Heikki Lehvaslaiho
# OWNER:    Heikki Lehvaslaiho
# LICENSE:  Perl_5



sub new {
    my($class,@args) = @_;
    my $self = $class->SUPER::new(@args);

    my($strict) =
        $self->_rearrange([qw(STRICT
                             )],
                         @args);

    $strict  && $self->strict($strict);
    return $self;
}


sub strict {
   my ($self,$value) = @_;
   if( defined $value) {
       $self->{'_strict'} = 1 if $value;
   }
   return $self->{'_strict'};
}


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

   $self->throw("Need to pass me a value.")
       unless defined $value;
   $self->throw("I need a Bio::Location, not [$value]")
       unless $value->isa('Bio::LocationI');
   $self->throw("Input coordinate system not set")
       unless $self->in;
   $self->throw("Output coordinate system not set")
       unless $self->out;

   my $match;

   if ($value->isa("Bio::Location::SplitLocationI")) {

       my $split = Bio::Coordinate::Result->new(-seq_id=>$self->out->seq_id);
       foreach my $loc ( sort { $a->start <=> $b->start }
                         $value->sub_Location ) {

           $match = $self->_map($loc);
           $split->add_sub_Location($match) if $match;

       }
       $split->each_Location ? (return $split) : return ;

   } else {
       return $self->_map($value);
   }
}


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

   my ($offset, $start, $end);

   if ($self->strand == -1) {
       $offset = $self->in->end + $self->out->start;
       $start = $offset - $value->end;
       $end = $offset - $value->start ;
   } else { # undef, 0 or 1
       $offset = $self->in->start - $self->out->start;
       $start = $value->start - $offset;
       $end = $value->end - $offset;
   }

   # strict prevents matches outside stated range
   if ($self->strict) {
       return if $start < 0 and $end < 0;
       return if $start > $self->out->end;
       $start = 1 if $start < 0;
       $end = $self->out->end if $end > $self->out->end;
   }

   my $match = Bio::Location::Simple->
       new(-start => $start,
           -end => $end,
           -strand => $self->strand,
           -seq_id => $self->out->seq_id,
           -location_type => $value->location_type
          );
   $match->strand($match->strand * $value->strand) if $value->strand;
   bless $match, 'Bio::Coordinate::Result::Match';

   return $match;
}

1;

__END__