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


line stmt bran cond sub pod time code
1             ## no critic (RCS,prototypes)
2              
3             package List::BinarySearch;
4              
5 6     6   188639 use 5.008000;
  6         18  
  6         197  
6 6     6   24 use strict;
  6         7  
  6         166  
7 6     6   24 use warnings;
  6         6  
  6         210  
8 6     6   24 use Carp;
  6         8  
  6         479  
9              
10 6     6   31 use Scalar::Util qw( looks_like_number );
  6         8  
  6         768  
11              
12              
13             BEGIN {
14              
15 6     6   16 my @imports = qw( binsearch binsearch_pos );
16              
17             # Import XS by default, pure-Perl if XS is unavailable, or if
18             # $ENV{List_BinarySearch_PP} is set.
19              
20             # This conditional has been tested manually. Can't be automatically tested.
21             # uncoverable condition right false
22 6 100 66 2   199 if (
  2         1077  
  2         1246  
  2         92  
23             $ENV{List_BinarySearch_PP}
24             || ! eval 'use List::BinarySearch::XS @imports; 1;' ## no critic (eval)
25             ) {
26 4     4   226 eval 'use List::BinarySearch::PP @imports;'; ## no critic (eval)
  4         1366  
  4         8  
  4         521  
27             }
28              
29             }
30              
31             require Exporter;
32              
33             our @ISA = qw(Exporter); ## no critic (ISA)
34              
35             # Note: binsearch and binsearch_pos come from List::BinarySearch::PP
36             our @EXPORT_OK = qw( binsearch binsearch_pos binsearch_range );
37              
38             our %EXPORT_TAGS = ( all => \@EXPORT_OK );
39              
40             # The prototyping gives List::BinarySearch a similar feel to List::Util,
41             # and List::MoreUtils.
42              
43             our $VERSION = '0.23';
44              
45             # Needed for developer's releases: See perlmodstyle.
46             # $VERSION = eval $VERSION; ## no critic (eval,version)
47              
48              
49             # Custom import() to touch $a and $b in Perl version < 5.20, to eliminate
50             # "used only once" warnings.
51             {
52             if( $] < 5.020 ) {
53             *import = sub {
54             my $pkg = caller;
55 6     6   28 no strict 'refs'; ## no critic(strict)
  6         6  
  6         701  
56             ${"${pkg}::a"} = ${"${pkg}::a"};
57             ${"${pkg}::b"} = ${"${pkg}::b"};
58             # It would feel nicer to call shift->SUPER::import(@_), but
59             # Exporter::import appears to be too fragile for this type of wrapper.
60             goto &Exporter::import;
61             };
62             }
63             }
64              
65              
66              
67             # binsearch and binsearch_pos will be loaded from List::BinarySearch::PP or
68             # List::BinarySearch::XS.
69              
70              
71              
72             sub binsearch_range (&$$\@) {
73 3     3 1 1149 my( $code, $low_target, $high_target, $aref ) = @_;
74 3         5 my( $index_low, $index_high );
75              
76             # Forward along the caller's $a and $b.
77 3         6 local( *a, *b ) = do{
78 6     6   39 no strict 'refs'; ## no critic (strict)
  6         15  
  6         786  
79 3         6 my $pkg = caller();
80 3         5 ( *{$pkg.'::a'}, *{$pkg.'::b'} );
  3         10  
  3         16  
81             };
82 3         16 $index_low = binsearch_pos( \&$code, $low_target, @$aref );
83 3         16 $index_high = binsearch_pos( \&$code, $high_target, @$aref );
84 3         9 local( $a, $b ) = ( $aref->[$index_high], $high_target ); # Use our own.
85 3 100 100     17 if( $index_high == scalar @$aref or $code->( $a, $b ) > 0 )
86             {
87 2         8 $index_high--;
88             }
89 3         17 return ( $index_low, $index_high );
90             }
91              
92              
93              
94             1; # End of List::BinarySearch
95              
96             __END__