File Coverage

blib/lib/Poker/Deck.pm
Criterion Covered Total %
statement 22 22 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 30 31 96.7


line stmt bran cond sub pod time code
1             package Poker::Deck;
2 2     2   15 use strict;
  2         4  
  2         110  
3 2     2   11 use warnings FATAL => 'all';
  2         16  
  2         114  
4 2     2   11 use Moo;
  2         5  
  2         11  
5 2     2   1857 use Poker::Card;
  2         7  
  2         79  
6 2     2   1389 use Tie::IxHash;
  2         11623  
  2         736  
7              
8             =head1 NAME
9              
10             Poker::Deck - Simple class to represent a deck of poker cards.
11              
12             =head1 VERSION
13              
14             Version 0.09
15              
16             =cut
17              
18             our $VERSION = '0.09';
19              
20              
21             =head1 SYNOPSIS
22              
23             This class is used internally by Poker::Dealer. You probably don't want to use it directly. Attributes include cards, discards, and card_type.
24              
25             =cut;
26              
27             has 'cards' => (
28             is => 'rw',
29             isa =>
30             sub { die "Not a Tie::IxHash!" unless $_[0]->isa( 'Tie::IxHash') },
31             builder => '_build_cards',
32             );
33              
34             has 'discards' => (
35             is => 'rw',
36             isa =>
37             sub { die "Not an array!" unless ref($_[0]) eq 'ARRAY' },
38             default => sub { [] },
39             );
40              
41             has 'card_type' => (
42             is => 'rw',
43             builder => '_build_card_type',
44             );
45              
46             sub _build_card_type {
47 1     1   2413 return 'Poker::Card';
48             }
49              
50             sub _build_cards {
51 1     1   8 my $self = shift;
52 1         12 my $cards = Tie::IxHash->new;
53 1         26 for my $rank (qw(2 3 4 5 6 7 8 9 T J Q K A)) {
54 13         903 for my $suit (qw(c d h s)) {
55 52         4575 $cards->Push(
56             $rank
57             . $suit => $self->card_type->new(
58             id => $cards->Length,
59             suit => $suit,
60             rank => $rank
61             )
62             );
63             }
64             }
65 1         104 return $cards;
66             }
67              
68       1 0   sub BUILD { }
69              
70             =head1 AUTHOR
71              
72             Nathaniel Graham, C<< >>
73              
74             =head1 LICENSE AND COPYRIGHT
75              
76             Copyright 2016 Nathaniel Graham.
77              
78             This program is free software; you can redistribute it and/or modify it
79             under the terms of the the Artistic License (2.0). You may obtain a
80             copy of the full license at:
81              
82             L
83              
84             =cut
85              
86             1;