File Coverage

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

Criterion	Covered	Total	%
statement	32	39	82.0
branch	2	8	25.0
condition	7	15	46.6
subroutine	11	12	91.6
pod	6	6	100.0
total	58	80	72.5

#===============================================================================
#
#         FILE:  Games::Go::AGA::Parse::Util.pm
#
#      PODNAME:  Games::Go::AGA::Parse::Util
#     ABSTRACT:  Utilities to help Parse lines from AGA format files
#
#       AUTHOR:  Reid Augustin (REID),
#      COMPANY:  LucidPort Technology, Inc.
#      CREATED:  Thu Jan 27 09:22:26 PST 2011
#===============================================================================

use 5.008;
use strict;
use warnings;

package Games::Go::AGA::Parse::Util;
use parent 'Exporter';

our @EXPORT_OK = qw(
    is_ID
    is_Rank
    is_Rating
    is_Rank_or_Rating
    normalize_ID
    Rank_to_Rating
);

use Scalar::Util qw( looks_like_number );
use Carp;

our $VERSION = '0.042'; # VERSION

sub is_ID {
    my ($token) = @_;

    return (
        defined $token and      # of course
        $token =~ /^\w+$/ and   # only alphanums and underscore
        $token =~ /^\D/         # not digit in first position
    );
}

sub is_Rank {
    my ($token) = @_;

    return (
        defined $token and
        (($token =~ m/^(\d+)[dD]$/ and
           $1 >= 1 and
           $1 < 20)
        or
         ($token =~ m/^(\d+)[kK]$/ and
           $1 >= 1 and
           $1 < 100)
        )
    );
}

sub is_Rating {
    my ($token) = @_;

    return (looks_like_number($token) and
            (($token < 20.0 and
              $token >= 1.0) or
             ($token <= -1.0 and
              $token >  -100.0)));
}

sub is_Rank_or_Rating {
    my ($token) = @_;

    return (
        is_Rating($token) or
        is_Rank($token)
        );
}

sub normalize_ID  {
    my ($id) = @_;

    $id = uc $id;
    $id = "USA$id" if ($id =~ m/^\d/);
    # remove preceding 0 from numeric parts: X0010 => X10
    $id =~ s/([\D])0+(\d)/$1$2/g;
    # shorten remaining sequences of 0: A000B => A0B
    $id =~ s/00+(\D)/0$1/g;
    return $id;
}

sub Rank_to_Rating {
    my ($rank) = @_;

    if (is_Rank($rank) and
        $rank =~ m/(\d+)([dkDK])/) {
        if (lc $2  eq 'k') {
            return -0.5 - $1;
        }
        return 0.5 + $1;
    }
    elsif (is_Rating($rank)) {
        return $rank;
    }
    croak("$rank is not a rank or a rating");
}

1;

__END__