File Coverage

blib/lib/Acme/Mitey/Cards/Deck.pm
Criterion Covered Total %
statement 34 34 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 43 43 100.0


line stmt bran cond sub pod time code
1             package Acme::Mitey::Cards::Deck;
2              
3             our $VERSION = '0.014';
4             our $AUTHORITY = 'cpan:TOBYINK';
5              
6 2     2   900 use Acme::Mitey::Cards::Mite qw( -all );
  2         4  
  2         17  
7 2     2   19 use Acme::Mitey::Cards::Types qw( :types );
  2         6  
  2         591  
8              
9             extends 'Acme::Mitey::Cards::Set';
10              
11 2     2   397 use Acme::Mitey::Cards::Suit;
  2         4  
  2         46  
12 2     2   401 use Acme::Mitey::Cards::Card::Numeric;
  2         3  
  2         41  
13 2     2   393 use Acme::Mitey::Cards::Card::Face;
  2         6  
  2         34  
14 2     2   400 use Acme::Mitey::Cards::Card::Joker;
  2         3  
  2         46  
15 2     2   777 use Acme::Mitey::Cards::Hand;
  2         6  
  2         798  
16              
17             has reverse => (
18             is => ro,
19             isa => NonEmptyStr,
20             default => 'plain',
21             );
22              
23             has original_cards => (
24             is => lazy,
25             isa => CardArray,
26             );
27              
28             sub _build_cards {
29 1     1   2 my $self = shift;
30              
31 1         1 return [ @{ $self->original_cards } ];
  1         3  
32             }
33              
34             sub _build_original_cards {
35 1     1   7 my $self = shift;
36              
37 1         3 my @cards;
38              
39 1         25 for my $suit ( Acme::Mitey::Cards::Suit->standard_suits ) {
40 4         9 for my $number ( 1 .. 10 ) {
41 40         97 push @cards, Acme::Mitey::Cards::Card::Numeric->new(
42             suit => $suit,
43             number => $number,
44             deck => $self,
45             );
46             }
47 4         8 for my $face ( 'Jack', 'Queen', 'King' ) {
48 12         31 push @cards, Acme::Mitey::Cards::Card::Face->new(
49             suit => $suit,
50             face => $face,
51             deck => $self,
52             );
53             }
54             }
55              
56 1         9 push @cards, Acme::Mitey::Cards::Card::Joker->new( deck => $self );
57 1         3 push @cards, Acme::Mitey::Cards::Card::Joker->new( deck => $self );
58              
59 1         3 return \@cards;
60             }
61              
62             signature_for discard_jokers => (
63             pos => [],
64             );
65              
66             sub discard_jokers {
67             my $self = shift;
68              
69             my ( @jokers, @rest );
70              
71             for my $card ( @{ $self->cards } ) {
72             if ( $card->isa('Acme::Mitey::Cards::Card::Joker') ) {
73             push @jokers, $card;
74             }
75             else {
76             push @rest, $card;
77             }
78             }
79              
80             @{ $self->cards } = @rest;
81              
82             return Acme::Mitey::Cards::Set->new( cards => \@jokers );
83             }
84              
85             signature_for deal_hand => (
86             named => [
87             count => Int, { default => 7 },
88             args_for_hand => HashRef, { slurpy => true },
89             ],
90             );
91              
92             sub deal_hand {
93             my ( $self, $arg ) = @_;
94              
95             croak "Not enough cards: wanted %d but only have %d", $arg->count, $self->count
96             if $arg->count > $self->count;
97              
98             my $took = $self->take( $arg->count );
99             return Acme::Mitey::Cards::Hand->new(
100             %{ $arg->args_for_hand },
101             cards => [ @{ $took->cards } ],
102             );
103             }
104              
105             1;