File Coverage

blib/lib/Games/SGF/Tournament.pm

Criterion	Covered	Total	%
statement	36	65	55.3
branch	5	20	25.0
condition			n/a
subroutine	7	9	77.7
pod	3	3	100.0
total	51	97	52.5

package Games::SGF::Tournament;

use version; $VERSION = qv('1.1_2');
use warnings;
use strict;
use Carp;
use CGI qw/ :html /;
use Parse::RecDescent;

sub new {
   my $class = shift;
   my %params = @_;
   $params{sgf_dir} = '.' unless defined $params{sgf_dir};
   $params{base_url} = '' unless defined $params{base_url};
   my @games;
   undef $/;

   unless (opendir(SGF, $params{sgf_dir})) {
      carp "While opening directory \"$params{sgf_dir}\": $!";
      return undef;
   }

   my $parser = Parse::RecDescent->new(q<
      { my %info }
      SGF:        GameTree { $return = \%info }
      GameTree:   '(' Node(s) GameTree(s?) ')'
      Node:       ';' Property(s?)
      Property:   PropIdent PropValue(s) {
                     $info{$item{PropIdent}} =
                        join ';', @{$item{'PropValue(s)'}}
                           if grep $item{PropIdent} eq $_,
                              qw/ RU SZ HA KM PW PB DT TM RE /;
                  }
      PropIdent:  /[[:alnum:]]+/o {
                     ($return = $item[1]) =~ s/[^[:upper:]\d]//go;
                  }
      PropValue:  '[' Character(s?) ']' {
                     $return = join '', @{$item{'Character(s?)'}}
                  }
      Character:  /[^\\\\\]]+/so | Escaped
      Escaped:    '\\\\' | '\]' { $return = substr $item[1], 1 }
   >);

   foreach (grep { /.*\.sgf$/io } readdir SGF) {
      open IN, "$params{sgf_dir}/$_" or next;
      my %info = %{$parser->SGF()};
      foreach (qw/ RU SZ HA KM PW PB DT TM RE /) {
         $info{$_} = '' unless defined $info{$_};
      }
      $info{file} = "$params{base_url}$_" ;
      push @games, \%info;
   }

   bless { _games => \@games }, $class;
}

sub games {
   my $self = shift;
   my %params = @_;
   $params{cgi}->{border} = '1' unless defined $params{cgi}->{border};
   $params{caption} = 'Played games' unless defined $params{caption};
   my @rows = TR(
         th('Game#'),
         th('Black'),
         th('White'),
         th('Setup'),
         th('Date'),
         th('Result')
   );

   my $i;
   foreach (sort { $a->{DT} cmp $b->{DT} } @{$self->{_games}}) {
      push @rows, TR(
         td(a({ -href => $_->{file} }, ++$i)),
         td($_->{PB}),
         td($_->{PW}),
         td("$_->{RU}/$_->{SZ}/$_->{HA}/$_->{KM}/$_->{TM}"),
         td($_->{DT}),
         td($_->{RE})
      );
   }

   table($params{cgi}, caption($params{caption}), @rows);
}

sub scores {
   my $self = shift;
   my %params = @_;
   $params{cgi}->{border} = '1' unless defined $params{cgi}->{border};
   $params{caption} = 'Scoreboard' unless defined $params{caption};
   my @rows = TR(
      th('Pos#'),
      th('Name'),
      th('Score')
   );
   my %scores;

   foreach my $info (@{$self->{_games}}) {
      $info->{RE} =~ /^([BW])\+/o;
      foreach (qw/ B W /) {
         $scores{$info->{"P$_"}} += $1 eq $_ ? 1:0;
      }
   }

   my $i;
   foreach (sort { $scores{$b} <=> $scores{$a} } keys %scores) {
      push @rows, TR(
         td(++$i),
         td($_),
         td($scores{$_})
      );
   }

   table($params{cgi}, caption($params{caption}), @rows);
}

1;

__END__