File Coverage

blib/lib/Poker/Deck.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Poker::Deck;
2 1     1   6 use strict;
  1         2  
  1         26  
3 1     1   6 use warnings FATAL => 'all';
  1         9  
  1         28  
4 1     1   5 use Moo;
  1         1  
  1         5  
5 1     1   706 use Poker::Card;
  1         2  
  1         26  
6 1     1   489 use Tie::IxHash;
  0            
  0            
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.01
15              
16             =cut
17              
18             our $VERSION = '0.01';
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             return 'Poker::Card';
48             }
49              
50             sub _build_cards {
51             my $self = shift;
52             my $cards = Tie::IxHash->new;
53             for my $rank (qw(2 3 4 5 6 7 8 9 T J Q K A)) {
54             for my $suit (qw(c d h s)) {
55             $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             return $cards;
66             }
67              
68             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;