File Coverage

blib/lib/Games/Go/AGA/Parse/Round.pm

Criterion	Covered	Total	%
statement	81	98	82.6
branch	28	50	56.0
condition	6	11	54.5
subroutine	17	18	94.4
pod	3	9	33.3
total	135	186	72.5

#===============================================================================
#
#         FILE:  Games::Go::AGA::Parse::Round.pm
#
#      PODNAME:  Games::Go::AGA::Parse::Round
#     ABSTRACT:  Parses lines from an AGA Tournament Round file
#
#       AUTHOR:  Reid Augustin (REID),
#      COMPANY:  LucidPort Technology, Inc.
#      CREATED:  11/19/2010 03:13:05 PM PST
#===============================================================================

use 5.008;
use strict;
use warnings;

package Games::Go::AGA::Parse::Round;
use parent 'Games::Go::AGA::Parse';

use Carp;
use Readonly;
use String::Tokenizer;
use Games::Go::AGA::Parse::Exceptions;
use Games::Go::AGA::Parse::Util qw( normalize_ID );

our $VERSION = '0.042'; # VERSION

sub white_id {
    my ($self, $new) = @_;

    if (@_ > 1) {
        $self->{white_id} = $new;
    }
    return $self->{white_id} || '';
}

sub black_id {
    my ($self, $new) = @_;

    if (@_ > 1) {
        $self->{black_id} = $new;
    }
    return $self->{black_id} || '';
}

sub result {
    my ($self, $new) = @_;

    if (@_ > 1) {
        $self->{result} = $new;
    }
    return $self->{result} || '';
}

sub handicap {
    my ($self, $new) = @_;

    if (@_ > 1) {
        $self->{handicap} = $new;
    }
    return defined $self->{handicap} ? $self->{handicap} : '0';
}

sub komi {
    my ($self, $new) = @_;

    if (@_ > 1) {
        $self->{komi} = $new;
    }
    return defined $self->{komi} ? $self->{komi} : '0';
}

sub comment {
    my ($self, $new) = @_;

    if (@_ > 1) {
        $self->{comment} = $new;
    }
    return $self->{comment} || '';
}

sub as_array {
    my ($self, $new) = @_;

    my @ret;
    if ($self->white_id) {
        @ret = map(
            { $self->$_ }
            # fields, in order
            qw(
                white_id
                black_id
                result
                handicap
                komi
                comment
            ),
        );
    }
    elsif (exists $self->{comment}) {
        @ret = ($self->comment);
    }
    return wantarray ? @ret : \@ret;
}

sub as_hash {
    my ($self, $new) = @_;

    my %ret;
    if ($self->white_id) {
        %ret =  map(
            { $_, $self->$_ }
            # fields
            qw(
                white_id
                black_id
                result
                handicap
                komi
                comment
            ),
        );
    }
    elsif (exists $self->{comment}) {
        %ret = (comment => $self->comment);
    }
    return wantarray ? %ret : \%ret;
}

Readonly my $WHITE_ID   => 0;
Readonly my $BLACK_ID   => 1;
Readonly my $RESULT     => 2;
Readonly my $HANDICAP   => 3;
Readonly my $KOMI       => 4;

Readonly my %name_of_state => (
    $WHITE_ID   => 'white_id',
    $BLACK_ID   => 'black_id',
    $RESULT     => 'result',
    $HANDICAP   => 'handicap',
    $KOMI       => 'komi',
);

*parse = \&parse_line;  # alias parse to parse_line
sub parse_line  {
    my ($self, $string) = @_;

    map { delete $self->{$_} }
        qw(
            white_id
            black_id
            result
            handicap
            komi
            comment
        );
    return $self->as_hash if (not $string);
    my $tokenizer = String::Tokenizer->new(
                $string,                                # source string
                # delimiters
             #  "~!@#\$\%^&*()`={}[]:;\"'<>,?/|\\\n",
                "@#\$\n",
                String::Tokenizer->RETAIN_WHITESPACE,
                );
    my $iter = $tokenizer->iterator;
    $self->{source} = $string;
    my $state = $WHITE_ID;
    TOKEN:
    while ($iter->hasNextToken) {
        my $token = $iter->nextToken;
#print $self->err("state $state, token $token");
        if ($token eq "\n") {            # a carriage return?
            last TOKEN;
        }
        elsif ($token !~ m/\S/ or       # only whitespace
               $token eq '') {          # empty
            next TOKEN;   # ignore
        }
        elsif ($token eq '#') {             # comment
            if ($state != $WHITE_ID) {
                $self->_parse_error(
                    error => "got comment, expected $name_of_state{$state}",
                    source => $self->{source},
                    );
            }
            $self->{comment} = join q{}, $iter->collectTokensUntil("\n");
            last TOKEN;
        }
        else {
#print $self->err("state $state, token $token");
            if ($state == $WHITE_ID) {
                $self->{white_id} = normalize_ID($token);
                $state = $BLACK_ID;
            }
            elsif ($state == $BLACK_ID) {
                $self->{black_id} = normalize_ID($token);
                $state = $RESULT;
            }
            elsif ($state == $RESULT) {
                $self->{result} = $token;
                $state = $HANDICAP;
            }
            elsif ($state == $HANDICAP) {
                $self->{handicap} = 0 + $token;    # numerify
                $state = $KOMI;
            }
            elsif ($state == $KOMI) {
                $self->{komi} = 0 + $token;        # numerify
                $state = $WHITE_ID;
            }
            else {
                $self->_parse_error(
                    error => "unknown state: $state",
                    source => $self->{source},
                    );
            }
            next TOKEN;
        }
    }
    if ($state != $WHITE_ID) {
        $self->_parse_error(
            error => "got end of line, expected $name_of_state{$state}",
            source => $self->{source},
            );
    }
    return $self->as_hash;
}

1;

__END__