File Coverage

blib/lib/Algorithm/MedianSelect/XS.pm
Criterion Covered Total %
statement 33 33 100.0
branch 10 12 83.3
condition 4 8 50.0
subroutine 6 6 100.0
pod 1 1 100.0
total 54 60 90.0


line stmt bran cond sub pod time code
1             package Algorithm::MedianSelect::XS;
2              
3 2     2   70698 use strict;
  2         11  
  2         57  
4 2     2   11 use warnings;
  2         4  
  2         54  
5 2     2   10 use base qw(Exporter);
  2         3  
  2         301  
6              
7 2     2   15 use Carp qw(carp croak);
  2         3  
  2         586  
8              
9             our ($VERSION, @EXPORT_OK);
10              
11             $VERSION = '0.22';
12             @EXPORT_OK = qw(median);
13              
14             require XSLoader;
15             XSLoader::load(__PACKAGE__, $VERSION);
16              
17             sub median
18             {
19 6 100   6 1 114 my $opts = pop if ref $_[-1] eq 'HASH';
20 6         16 my @nums = @_;
21              
22 6 100       17 my $count = ref $nums[0] eq 'ARRAY' ? @{$nums[0]} : @nums;
  3         11  
23 6 50 33     34 croak "median(): list must have odd count of elements and must have more than one element\n"
24             if ($count % 2 == 0 or $count == 1);
25              
26 6         10 my $i;
27 6         11 my %valid_alg = map { $_ => ++$i } qw(bubble quick);
  12         39  
28              
29 6         13 my $algorithm;
30              
31 6 100 66     26 if (exists $opts->{algorithm} && $valid_alg{$opts->{algorithm}}) {
32 4         9 $algorithm = $opts->{algorithm};
33             }
34             else {
35             carp "'$opts->{algorithm}' is not a valid algorithm, switching to default...\n"
36 2 50       6 if defined $opts->{algorithm};
37              
38 2   50     9 $algorithm ||= 'quick';
39             }
40              
41 2     2   16 no strict 'refs';
  2         4  
  2         247  
42 6         10 ${__PACKAGE__.'::ALGORITHM'} = $valid_alg{$algorithm};
  6         21  
43              
44 6 100       15 if (ref $nums[0] eq 'ARRAY') { return xs_median($nums[0]) }
  3         30  
45 3         39 else { return xs_median(@nums) }
46             }
47              
48             1;
49             __END__