File Coverage

blib/lib/List/BinarySearch/PP.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	6	6	100.0
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	70	70	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.25';
# $VERSION = eval $VERSION;  ## no critic (eval)



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

sub binsearch (&$\@) {
    my ( $code, $target, $aref ) = @_;
    my $min = 0;
    my $max = $#{$aref};
    my $caller = caller();
    while ( $max > $min ) {
        my $mid = int( ( $max - $min ) / 2 + $min );
        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} );
    my $caller = caller();
    while ( $low < $high ) {
        my $cur = int( ( $high - $low ) / 2 + $low );
        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__