File Coverage

blib/lib/POSIX/bsearch.pm

Criterion	Covered	Total	%
statement	93	96	96.8
branch	32	38	84.2
condition			n/a
subroutine	5	5	100.0
pod	0	1	0.0
total	130	140	92.8

package POSIX::bsearch;

use 5.000;
use strict;

require Exporter;
use vars qw($VERSION @ISA @EXPORT
   $a $b $index $count);
@ISA = qw(Exporter);
@EXPORT = qw( bsearch );

$VERSION = '0.02';


sub bsearch(&$\@){
 # warn "in bsearch with args [@_]";
 my $comparator = shift;
 my ($ca,$cb);
 {
   no strict 'refs';
   my $callerpackage = caller();
   $ca = \*{"$callerpackage\::a"};
   $cb = \*{"$callerpackage\::b"};
 };
 local *$ca = \$a;
 local *$cb = \$b;
 $a = shift;
 my $table = shift;
 undef($count);
 my ($lowerbound,$first,$last,$upperbound) = (-1,-1,-1,0+@$table);
 $upperbound or return (); # empty list

 my ($guess,$compres);

 # find index
 our $icount = 0;
 do {{
    # warn join ', ',$lowerbound,$first,$last,$upperbound;
    $icount++ > 40 and die "STUCK";
    $guess = int (($upperbound + $lowerbound)/2);
    if ($guess == $lowerbound){
       $index = $lowerbound;
       return ();
    };
    $b = $table->[$guess];
    $compres =  &$comparator;
    # warn "got $compres";
    if ($compres < 0){
       unless ($guess){
           # guess is zero! we are off the low end
	   $index = -1;
	   return ();
       };
       $upperbound = $guess;
       next;
    };
    if ($compres > 0){
       if ($guess == $#$table){
           # we are off the high end
	   $index = @$table;
	   return ();
       };
       $lowerbound = $guess;
       next;
    };
 }} while ($compres);

 # Found something. POSIX semantics actually stops here.
 wantarray or return $table->[$guess];

 # call in array context for the special sauce.
 ($index,$count) =(-1,0);
 my $GoodGuess = $guess;
 if ($guess ==  1+$lowerbound){
       $first = $guess;
 }else{
       # search for the first
       my $upperboun =  $guess;
       $icount = 0;
       for(;;){
    $icount++ > 40 and die "STUCK";
         # warn join ', ',SearchingForFirst =>$lowerbound,$first,$last,$upperboun;
         $guess = int (( $upperboun + $lowerbound ) /2);
         if ($guess == $lowerbound){

            $first = $upperboun;
            last;
         };
         $b = $table->[$guess];
         $compres =  &$comparator;
         # warn "got $compres";
         if ($compres < 0){
            die "TABLE NOT SORTED\n";
         };
         if ($compres > 0){
            $lowerbound = $guess;
            next;
         };
         if ($guess == 1+ $lowerbound){
            $first = $guess;
            last;
         };
         $upperboun = $guess;
      };
 };


 $guess = $GoodGuess;
 if ($guess ==  -1+$upperbound){
       $last = $guess;
 }else{
       # search for the last
       my $lowerboun =  $guess;
       $icount = 0;
       for(;;){
    $icount++ > 40 and die "STUCK";
         # warn join ', ',SearchingForLast =>$lowerboun,$first,$last,$upperbound;
         $guess = int (( $upperbound + $lowerboun ) /2);
         $b = $table->[$guess];
         $compres =  &$comparator;
         # warn "got $compres";
         if ($compres > 0){
            die "TABLE NOT SORTED\n";
         };
         if ($compres < 0){
            $upperbound = $guess;
            next;
         };
         if ($guess == -1+ $upperbound){
            $last = $guess;
            last;
         };
         $lowerboun = $guess;
       };
 };
 # warn "finished, should have $lowerbound < $first <= $last < $upperbound";


 $index = $first;
 $count = 1 + $last - $first;


 # return result
 @$table[ $first .. $last ];
}

1;
__END__