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.016';
4             our $AUTHORITY = 'cpan:TOBYINK';
5              
6 3     3   1157 use Acme::Mitey::Cards::Mite qw( -all );
  3         8  
  3         28  
7 3     3   23 use Acme::Mitey::Cards::Types qw( :types );
  3         6  
  3         1136  
8              
9             extends 'Acme::Mitey::Cards::Set';
10              
11 3     3   670 use Acme::Mitey::Cards::Suit;
  3         8  
  3         91  
12 3     3   566 use Acme::Mitey::Cards::Card::Numeric;
  3         7  
  3         76  
13 3     3   553 use Acme::Mitey::Cards::Card::Face;
  3         10  
  3         84  
14 3     3   548 use Acme::Mitey::Cards::Card::Joker;
  3         6  
  3         82  
15 3     3   1376 use Acme::Mitey::Cards::Hand;
  3         11  
  3         1425  
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   3 my $self = shift;
30              
31 1         3 return [ @{ $self->original_cards } ];
  1         5  
32             }
33              
34             sub _build_original_cards {
35 1     1   3 my $self = shift;
36              
37 1         2 my @cards;
38              
39 1         34 for my $suit ( Acme::Mitey::Cards::Suit->standard_suits ) {
40 4         12 for my $number ( 1 .. 10 ) {
41 40         130 push @cards, Acme::Mitey::Cards::Card::Numeric->new(
42             suit => $suit,
43             number => $number,
44             deck => $self,
45             );
46             }
47 4         10 for my $face ( 'Jack', 'Queen', 'King' ) {
48 12         42 push @cards, Acme::Mitey::Cards::Card::Face->new(
49             suit => $suit,
50             face => $face,
51             deck => $self,
52             );
53             }
54             }
55              
56 1         16 push @cards, Acme::Mitey::Cards::Card::Joker->new( deck => $self );
57 1         11 push @cards, Acme::Mitey::Cards::Card::Joker->new( deck => $self );
58              
59 1         5 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;