Calculate Bowling Score

gistfile1.pl

package Bowling::Score;

use strict;
use warnings;

sub new {
    my $class = shift;
    my @args = @_;
    my $args_ref = ref $args[0] eq 'HASH' ? $args[0] : {@args};

    my $self = bless{}, ref $class || $class;

    $self;
}

sub get_score {
    my $self = shift;
    my $str = shift;

    my $frames = $self->split_frames($str);
    my $calc = $self->calc_score( $frames );

    return $calc->[9]->{score};  # ;-P
}

sub calc_score {
    my $self = shift;
    my $frames = shift;

    for my $i ( 0 .. $#$frames ) {
        my $frame = $frames->[$i];
        $frame->{score} = $i > 0 ? $frames->[$i -1]->{score} : 0;
        for my $j ( 0 .. $#{$frame->{throws}} ) {
            my $score = $frame->{throws}->[$j];
            if ( $score =~ /^\d+$/ ) {
                $frame->{score} += $score;
            }
            elsif ( $score eq 'X' ) {
                $frame->{score} += 10;
                if ( $i < 9 ) {
                    if ( $frames->[$i + 1]->{throws}->[0] eq 'X' ) {
                        $frame->{score} += 10;
                    }
                    elsif ( $frames->[$i + 1]->{throws}->[0] eq '-' ) {
                        $frame->{score} += 0;
                    }
                    else {
                        $frame->{score} += $frames->[$i + 1]->{throws}->[0];
                    }

                    if ( $#{$frames->[$i + 1]->{throws}} > 0 ) {
                        if ( $frames->[$i + 1]->{throws}->[1] eq 'X' ) {
                        $frame->{score} += 10;
                        }
                        elsif ( $frames->[$i + 1]->{throws}->[1] eq '/' ) {
                        $frame->{score} += 10 - $frames->[$i + 1]->{throws}->[0];
                        }
                        elsif ( $frames->[$i + 1]->{throws}->[1] eq '-' ) {
                        $frame->{score} += 0;
                        }
                        else {
                        $frame->{score} += $frames->[$i + 1]->{throws}->[1];
                        }
                    }
                    else {
                        if ( $i < 8 and $frames->[$i + 2]->{throws}->[0] eq 'X' ) {
                        $frame->{score} += 10;
                        }
                        elsif ( $i < 8 and $frames->[$i + 2]->{throws}->[0] eq '-' ) {
                        $frame->{score} += 0;
                        }
                        else {
                        $frame->{score} += $frames->[$i + 2]->{throws}->[0];
                        }
                    }
                }
            }
            elsif ( $score eq '-' ) {
                $frame->{score} += 0;
            }
            elsif ( $score eq '/' ) {
                if ( $frames->[$i]->{throws}->[0] eq '-' ) {
                    $frame->{score} += 10;
                }
                else {
                    $frame->{score} += 10 - $frames->[$i]->{throws}->[0];
                }

                if ( $i < 9 ) {
                    if ( $frames->[$i + 1]->{throws}->[0] eq 'X' ) {
                        $frame->{score} += 10;
                    }
                    elsif ( $frames->[$i + 1]->{throws}->[0] eq '-' ) {
                        $frame->{score} += 0;
                    }
                    else {
                        $frame->{score} += $frames->[$i + 1]->{throws}->[0];
                    }
                }
            }
        }
    }
    return $frames;
}

sub split_frames {
    my $self = shift;
    my $str = shift;

    my @throws = split '', $str;

    my @frames;
    my @tmps;
    for my $throw ( @throws ) {
        push @tmps, $throw;
        if ( ( $#tmps == 1 or $throw eq 'X' ) and $#frames < 8 ) {
            push @frames, { throws => [@tmps] };
            @tmps = ();
        }
    }
    if ( $#tmps ) {
        push @frames, { throws => [@tmps] };
    }

    wantarray ? @frames : [@frames];
}

1;

__END__

=head1 NAME

Bowling::Score

=head1 SYNOPSIS

  use Bowling::Score;
  print Bowling::Score->new()->get_score( shift );

=head1 TEST

  use Test::More;
  use Bowling::Score;
  
  my @qs = qw(
                 9-9-9-9-9-9-9-9-9-9-
                 X54-----------------
                 1/5-----------------
                 1/5-2/-/8-----------
                 ------XX----------
                 ------XXX--------
                 XXXXXXXXXXXX
                 --------------------
                 -------------------/5
                 ------------------X54
                 5/5/5/5/5/5/5/5/5/5/5
            );
  my @as = qw(90 28 20 56 30 60 300 0 15 19 150);
  
  plan tests => $#qs + 1;
  
  my $o = Bowling::Score->new();
  for my $i ( 0 .. $#qs ) {
      my $c = $o->get_score( $qs[$i] );
      is $c,$as[$i],$qs[$i];
  }

=head1 OTHES

Time Atack ! (TechMeeting at Fenrir Inc.)

=cut