File Coverage

blib/lib/List/BinarySearch.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	4	4	100.0
condition	5	6	100.0
subroutine	11	11	100.0
pod	1	1	100.0
total	64	65	100.0

## no critic (RCS,prototypes)

package List::BinarySearch;

use 5.008000;
use strict;
use warnings;
use Carp;

use Scalar::Util qw( looks_like_number );


BEGIN {

  my @imports = qw( binsearch binsearch_pos );

  # Import XS by default, pure-Perl if XS is unavailable, or if
  # $ENV{List_BinarySearch_PP} is set.

  # This conditional has been tested manually.  Can't be automatically tested.
  # uncoverable condition right false
  if (
       $ENV{List_BinarySearch_PP}
    || ! eval 'use List::BinarySearch::XS @imports; 1;'  ## no critic (eval)
  ) {
    eval 'use List::BinarySearch::PP  @imports;';        ## no critic (eval)
  }

}

require Exporter;

our @ISA       = qw(Exporter);    ## no critic (ISA)

# Note: binsearch and binsearch_pos come from List::BinarySearch::PP
our @EXPORT_OK = qw(  binsearch         binsearch_pos       binsearch_range  );

our %EXPORT_TAGS = ( all => \@EXPORT_OK );

# The prototyping gives List::BinarySearch a similar feel to List::Util,
# and List::MoreUtils.

our $VERSION = '0.25';

# Needed for developer's releases: See perlmodstyle.
# $VERSION = eval $VERSION;    ## no critic (eval,version)


# Custom import() to touch $a and $b in Perl version < 5.20, to eliminate
# "used only once" warnings.
{
  if( $] < 5.020 ) {
    *import = sub {
      my $pkg = caller;
      no strict 'refs'; ## no critic(strict)
      ${"${pkg}::a"} = ${"${pkg}::a"};
      ${"${pkg}::b"} = ${"${pkg}::b"};
      # It would feel nicer to call shift->SUPER::import(@_), but
      # Exporter::import appears to be too fragile for this type of wrapper.
      goto &Exporter::import;
    };
  }
}



# binsearch and binsearch_pos will be loaded from List::BinarySearch::PP or
# List::BinarySearch::XS.



sub binsearch_range (&$$\@) {
  my( $code, $low_target, $high_target, $aref ) = @_;
  my( $index_low, $index_high );

  # Forward along the caller's $a and $b.
  local( *a, *b ) = do{
    no strict 'refs';  ## no critic (strict)
    my $pkg = caller();
    ( *{$pkg.'::a'}, *{$pkg.'::b'} );
  };
  $index_low  = binsearch_pos( \&$code, $low_target,  @$aref );
  $index_high = binsearch_pos( \&$code, $high_target, @$aref );
  local( $a, $b ) = ( $aref->[$index_high], $high_target ); # Use our own.
  if(  $index_high == scalar @$aref    or    $code->( $a, $b ) > 0  )
  {
    $index_high--;
  }
  return ( $index_low, $index_high );
}



1;    # End of List::BinarySearch

__END__