File Coverage

blib/lib/Ordeal/Model/Shuffle.pm
Criterion Covered Total %
statement 68 92 73.9
branch 11 22 50.0
condition 2 3 66.6
subroutine 12 16 75.0
pod 8 8 100.0
total 101 141 71.6


line stmt bran cond sub pod time code
1             package Ordeal::Model::Shuffle;
2              
3             # vim: ts=3 sts=3 sw=3 et ai :
4              
5 5     5   88 use 5.020;
  5         19  
6 5     5   27 use strict; # redundant, but still useful to document
  5         9  
  5         99  
7 5     5   22 use warnings;
  5         20  
  5         245  
8             { our $VERSION = '0.003'; }
9 5     5   28 use English qw< -no_match_vars >;
  5         9  
  5         61  
10 5     5   1819 use Mo qw< build default >;
  5         11  
  5         24  
11 5     5   1496 use Ouch;
  5         14  
  5         25  
12              
13 5     5   403 use experimental qw< signatures postderef >;
  5         10  
  5         23  
14 5     5   830 no warnings qw< experimental::signatures experimental::postderef >;
  5         13  
  5         5029  
15              
16             has auto_reshuffle => (default => 0);
17             has deck => (default => undef);
18             has default_n_draw => (default => undef);
19             has random_source => (default => undef);
20             has _draw_sorted => (default => 0);
21             has _i => (default => undef);
22             has _indexes => (default => undef);
23              
24 5     5 1 218 sub BUILD ($self) {
  5         6  
  5         9  
25 5 50       14 ouch 400, 'no deck defined' unless $self->deck;
26 5 100       45 if (! $self->random_source) {
27 1         20 require Ordeal::Model::ChaCha20;
28 1         5 $self->random_source(Ordeal::Model::ChaCha20->new);
29             }
30 5 50       47 $self->default_n_draw($self->deck->n_cards)
31             unless defined $self->default_n_draw;
32              
33 5         37 $self->shuffle;
34              
35 5         11 return $self;
36             }
37              
38 0     0 1 0 sub clone ($self, %args) {
  0         0  
  0         0  
  0         0  
39 0         0 my $other = ref($self)->new(
40             auto_reshuffle => $self->auto_reshuffle, # overridable
41             default_n_draw => $self->default_n_draw, # overridable
42             %args,
43             deck => $self->deck, # this can't be overridden
44             );
45             $other->random_source($self->random_source->clone)
46 0 0       0 unless exists $args{random_source};
47 0         0 $other->_i($self->_i);
48 0 0       0 if (my $indexes = $self->_indexes) {
49 0         0 $other->_indexes([$indexes->@*]);
50             }
51             else {
52 0         0 $other->_indexes(undef);
53             }
54 0         0 return $other;
55             }
56              
57 5     5 1 751 sub draw ($self, $n = undef) {
  5         7  
  5         9  
  5         17  
58 5   66     24 $n //= $self->default_n_draw;
59 5 50       51 ouch 400, 'invalid number of cards', $n
60             unless $n =~ m{\A(?: 0 | [1-9]\d*)\z}mxs;
61 5         12 my $deck = $self->deck;
62              
63 5         34 my $i = $self->_i;
64 5 50       30 $n = $i + 1 if $n == 0; # take them all
65 5 50       17 ouch 400, 'not enough cards left', $n, $i + 1
66             if $n > $i + 1;
67              
68 5         8 my @retval;
69 5 100       10 if (my $indexes = $self->_indexes) {
70 3         30 my $rs = $self->random_source;
71 3         24 while ($n-- > 0) {
72 13         33 my $j = $rs->int_rand(0, $i); # extremes included
73 13         30 (my $retval, $indexes->[$j]) = $indexes->@[$j, $i--];
74 13         32 push @retval, $deck->card_at($retval);
75             }
76             }
77             else {
78 2         14 my $top_index = $deck->n_cards - 1;
79 2         18 while ($n-- > 0) {
80 10         21 push @retval, $deck->card_at($top_index - $i--);
81             }
82             }
83              
84             # prepare for next call
85 5 50       14 $self->auto_reshuffle ? $self->shuffle : $self->_i($i);
86              
87 5 50       61 return $retval[0] if @retval == 1;
88 5         24 return @retval;
89             }
90              
91 0     0 1 0 sub is_sorted ($self) { return !($self->_indexes) }
  0         0  
  0         0  
  0         0  
92              
93 0     0 1 0 sub n_remaining ($self) { return $self->_i + 1 }
  0         0  
  0         0  
  0         0  
94              
95 0     0 1 0 sub reset ($self) {
  0         0  
  0         0  
96 0         0 $self->random_source->reset;
97 0         0 return $self->shuffle;
98             }
99              
100 7     7 1 10 sub shuffle ($self) {
  7         9  
  7         10  
101 7         17 $self->_i(my $i = $self->deck->n_cards - 1);
102 7         108 $self->_indexes([0 .. $i]);
103 7         49 return $self;
104             }
105              
106 4     4 1 16 sub sort ($self) {
  4         6  
  4         7  
107 4         8 $self->_i($self->deck->n_cards - 1);
108 4         50 $self->_indexes(undef);
109 4         58 return $self;
110             }
111              
112             1;