File Coverage

blib/lib/Array/Pick/Scan.pm
Criterion Covered Total %
statement 29 36 80.5
branch 10 16 62.5
condition 1 2 50.0
subroutine 5 5 100.0
pod 1 1 100.0
total 46 60 76.6


line stmt bran cond sub pod time code
1             package Array::Pick::Scan;
2              
3 1     1   50143 use 5.010001;
  1         10  
4 1     1   4 use strict;
  1         1  
  1         22  
5 1     1   4 use warnings;
  1         2  
  1         20  
6              
7 1     1   3 use Exporter qw(import);
  1         1  
  1         247  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2022-05-20'; # DATE
11             our $DIST = 'Array-Pick-Scan'; # DIST
12             our $VERSION = '0.004'; # VERSION
13              
14             our @EXPORT_OK = qw(random_item);
15              
16             sub random_item {
17 201     201 1 1142 my ($src, $num_items) = @_;
18 201         197 my $ref = ref $src;
19              
20 201   50     231 $num_items //= 1;
21              
22 201 100       268 if ($ref eq 'ARRAY') {
    50          
23 101         84 my $ary = $src;
24 101         89 my $ary_size = @$ary;
25              
26 101 100       121 if (!$ary_size) {
    50          
27 1         14 return ();
28             } elsif ($num_items == 1) {
29 100         230 return $ary->[rand() * $ary_size];
30             } else {
31 0         0 my @items;
32 0         0 for my $i (0..$ary_size-1) {
33 0 0       0 if (@items < $num_items) {
34             # we haven't reached $num_items, insert item to array in a
35             # random position
36 0         0 splice @items, rand(@items+1), 0, $ary->[$i];
37             } else {
38             # we have reached $num_items, just replace an item randomly,
39             # using algorithm from Learning Perl, slightly modified
40 0 0       0 rand($i+1) < @items and
41             splice @items, rand(@items), 1, $ary->[$i];
42             }
43             }
44 0         0 return @items;
45             }
46             } elsif ($ref eq 'CODE') {
47 100         87 my $iter = $src;
48 100         83 my @items;
49 100         84 my $i = -1;
50 100         113 while (defined(my $item = $iter->())) {
51 1000         3006 $i++;
52 1000 100       1021 if (@items < $num_items) {
53             # we haven't reached $num_items, insert item to array in a
54             # random position
55 100         171 splice @items, rand(@items+1), 0, $item;
56             } else {
57             # we have reached $num_items, just replace an item randomly,
58             # using algorithm from Learning Perl, slightly modified
59 900 100       1717 rand($i+1) < @items and splice @items, rand(@items), 1, $item;
60             }
61             }
62 100         463 return @items;
63             } else {
64 0           die "Please specify arrayref or coderef iterator as source of items";
65             }
66             }
67              
68             1;
69             # ABSTRACT: Pick random items from an array (or iterator), without duplicates
70              
71             __END__