File Coverage

blib/lib/List/BinarySearch/PP.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	6	6	100.0
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	68	68	100.0

## no critic (RCS,prototypes)

package List::BinarySearch::PP;

use 5.006000;

use strict;
use warnings;
use Carp;

require Exporter;

our @ISA    = qw(Exporter);    ## no critic (ISA)
our @EXPORT = qw( binsearch binsearch_pos ); ## no critic (export)


our $VERSION = '0.23';
# $VERSION = eval $VERSION;  ## no critic (eval)



#---------------------------------------------
# Use a callback for comparisons.

sub binsearch (&$\@) {
    my ( $code, $target, $aref ) = @_;
    my $min = 0;
    my $max = $#{$aref};
    while ( $max > $min ) {
        my $mid = int( ( $min + $max ) / 2 );
        no strict 'refs'; ## no critic(strict)
        local ( ${caller() . '::a'}, ${caller() . '::b'} )
          = ( $target, $aref->[$mid] );
        if ( $code->( $target, $aref->[$mid] ) > 0 ) {
            $min = $mid + 1;
        }
        else {
            $max = $mid;
        }
    }
    {
      no strict 'refs'; ## no critic(strict)
      local ( ${caller() . '::a'}, ${caller() . '::b'} )
        = ( $target, $aref->[$min] );
      return $min if $code->( $target, $aref->[$min] ) == 0;
    }
    return;    # Undef in scalar context, empty list in list context.
}


#------------------------------------------------------
# Identical to binsearch, but upon match-failure returns best insert
# position for $target.


sub binsearch_pos (&$\@) {
    my ( $comp, $target, $aref ) = @_;
    my ( $low, $high ) = ( 0, scalar @{$aref} );
    while ( $low < $high ) {
        my $cur = int( ( $low + $high ) / 2 );
        no strict 'refs';  ## no critic(strict)
        local ( ${ caller() . '::a'}, ${ caller() . '::b'} )
          = ( $target, $aref->[$cur] );                            # Future use.
        if ( $comp->( $target, $aref->[$cur] ) > 0 ) {
            $low = $cur + 1;
        }
        else {
            $high = $cur;
        }
    }
    return $low;
}


1;

__END__