File Coverage

blib/lib/Game/Cribbage/Deck.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	6	6	100.0
condition	6	6	100.0
subroutine	14	14	100.0
pod	8	9	88.8
total	83	84	98.8

package Game::Cribbage::Deck;

use strict;
use warnings;

use Object::Proto::Sugar -types;
use List::Util qw//;
use Game::Cribbage::Deck::Card;

has deck => (
	is => 'rw',
	isa => ArrayRef,
	default => []
);


sub BUILD {
	return $_[0]->reset();
}

sub cards {
	return $_[0]->deck;
}

sub reset {
	$_[0]->shuffle();
	$_[0];
}

sub shuffle {
	my $i = 0;
	my @DECK;
	for my $suit (qw/H S D C/) {
		for ('A', 2 .. 10, 'J', 'Q', 'K') {
			$i++;
			push @DECK,
				Game::Cribbage::Deck::Card->new(
					suit => $suit,
					symbol => $_,
					id => $i
				);
		}
	}
	$_[0]->deck([List::Util::shuffle @DECK]);
	$_[0];
}

sub draw {
	shift @{$_[0]->deck}
}

sub force_draw {
	my ($self, $card) = @_;

	my $i = 0;
	for (@{$self->deck}) {
		if ($_->suit eq $card->{suit} && $_->symbol =~ m/^$card->{symbol}$/) {
			last;
		} else {
			$i++;
		}
	}

	my $force = splice @{$self->deck}, $i, 1;

	#if ($card->{used}) {
	#	$force->used = 1;
	#}

	return $force;
}

sub get {
	$_[0]->deck->[$_[1]];
}

sub card_exists {
	my ($self, $card) = @_;

	my ($suit, $sym) = ref($card) eq 'HASH'
		? ($card->{suit}, $card->{symbol})
		: ($card->suit, $card->symbol);
	for (@{$self->deck}) {
		if ($_->suit eq $suit && $_->symbol =~ m/^$sym$/) {
			return 1;
		}
	}

	return 0;
}

sub generate_card {
	return Game::Cribbage::Deck::Card->new(
		%{ $_[1] }
	);
}

1;

__END__