File Coverage

blib/lib/Games/Bowling/Scorecard/Frame.pm

Criterion	Covered	Total	%
statement	50	50	100.0
branch	24	24	100.0
condition	11	12	91.6
subroutine	12	12	100.0
pod	7	7	100.0
total	104	105	99.0

use strict;
use warnings;

package Games::Bowling::Scorecard::Frame;
{
  $Games::Bowling::Scorecard::Frame::VERSION = '0.105';
}
# ABSTRACT: one frame on a scorecard


use Carp ();


sub new {
  my ($class) = @_;

  bless {
    balls => [],
    score => 0,

    done    => 0,
    pending => 0,
  } => $class;
}


sub record { ## no critic Ambiguous
  my ($self, $ball) = @_;

  if ($self->is_done) {
    if ($self->is_pending) {
      $self->{pending}--;
      $self->{score} += $ball;
      return;
    } else {
      Carp::croak "two balls already recorded for frame";
    }
  }

  $self->roll_ok($ball);

  push @{ $self->{balls} }, $ball;
  $self->{score} += $ball;

  $self->_check_done;
  $self->_check_pending;
}

sub _check_pending {
  my ($self) = @_;
  return unless $self->is_done;

  my @balls = $self->balls;

  return $self->{pending} = 2 if @balls == 1 and $balls[0] == 10;
  return $self->{pending} = 1 if @balls == 2 and $balls[0] + $balls[1] == 10;
}

sub _check_done {
  my ($self) = @_;

  my @balls = $self->balls;

  $self->{done} = 1 if (@balls == 1 and $balls[0] == 10) or @balls == 2;
}


sub roll_ok {
  my ($self, $ball) = @_;

  Carp::croak "the frame is done" if $self->is_done;
  Carp::croak "you can't bowl an undefined number of pins!" if !defined $ball;
  Carp::croak "you can't bowl more than 10 on a single ball" if $ball > 10;
  Carp::croak "you can't bowl less than 0 on a single ball" if $ball < 0;
  Carp::croak "you can't knock down a partial pin" if $ball != int($ball);

  my $i = 0;
  $i += $_ for $self->balls, $ball;

  Carp::croak "bowling a $ball would bring the frame above 10" if $i > 10;
}


sub score {
  my ($self) = @_;
  return $self->{score};
}


sub is_pending {
  my ($self) = @_;
  return $self->{pending};
}


sub is_done {
  my ($self) = @_;
  return $self->{done};
}


sub balls {
  my ($self) = @_;
  return @{ $self->{balls} };
}

300;

__END__