File Coverage

blib/lib/Array/Pick/Scan.pm
Criterion Covered Total %
statement 28 35 80.0
branch 8 14 57.1
condition 1 2 50.0
subroutine 5 5 100.0
pod 1 1 100.0
total 43 57 75.4


line stmt bran cond sub pod time code
1             package Array::Pick::Scan;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-05-18'; # DATE
5             our $DIST = 'Array-Pick-Scan'; # DIST
6             our $VERSION = '0.002'; # VERSION
7              
8 1     1   67810 use 5.010001;
  1         11  
9 1     1   5 use strict;
  1         2  
  1         29  
10 1     1   6 use warnings;
  1         2  
  1         27  
11              
12 1     1   4 use Exporter qw(import);
  1         2  
  1         287  
13             our @EXPORT_OK = qw(random_item);
14              
15             sub random_item {
16 200     200 1 2583 my ($src, $num_items) = @_;
17 200         286 my $ref = ref $src;
18              
19 200   50     326 $num_items //= 1;
20              
21 200 100       335 if ($ref eq 'ARRAY') {
    50          
22 100         124 my $ary = $src;
23 100         127 my $ary_size = @$ary;
24              
25 100 50       142 if ($num_items == 1) {
26 100         303 return $ary->[rand() * $ary_size];
27             } else {
28 0         0 my @items;
29 0         0 for my $i (0..$ary_size-1) {
30 0 0       0 if (@items < $num_items) {
31             # we haven't reached $num_items, insert item to array in a
32             # random position
33 0         0 splice @items, rand(@items+1), 0, $ary->[$i];
34             } else {
35             # we have reached $num_items, just replace an item randomly,
36             # using algorithm from Learning Perl, slightly modified
37 0 0       0 rand($i+1) < @items and
38             splice @items, rand(@items), 1, $ary->[$i];
39             }
40             }
41 0         0 return @items;
42             }
43             } elsif ($ref eq 'CODE') {
44 100         118 my $iter = $src;
45 100         127 my @items;
46 100         114 my $i = -1;
47 100         159 while (defined(my $item = $iter->())) {
48 1000         4308 $i++;
49 1000 100       1485 if (@items < $num_items) {
50             # we haven't reached $num_items, insert item to array in a
51             # random position
52 100         242 splice @items, rand(@items+1), 0, $item;
53             } else {
54             # we have reached $num_items, just replace an item randomly,
55             # using algorithm from Learning Perl, slightly modified
56 900 100       2182 rand($i+1) < @items and splice @items, rand(@items), 1, $item;
57             }
58             }
59 100         631 return @items;
60             } else {
61 0           die "Please specify arrayref or coderef iterator as source of items";
62             }
63             }
64              
65             1;
66             # ABSTRACT: Pick random items from an array (or iterator), without duplicates
67              
68             __END__