package PGNParser; # temporary name use FileHandle; use Regexp::Common; sub new { my $class = shift; my $filename = shift || return undef; my $fh = new FileHandle "< $filename"; unless (defined $fh) { return undef } my $self = bless { GameMoves =>[], # game moves GameComments =>{}, # comments with reference to the move gamedescr => {}, # will contain the PGN tags GameErrors => {}, # will contain the parsing errors fh => \$fh # filehandle to the PGN file }, $class; return $self; } sub read_game{ # will read the game from a PGN file # after this, the game text will be in $self->{gamedescr}{Game} } my $REresult = qr{(?:1\-0|0\-1|1\/2\-1\/2|\*)}; my $REmove = qr{[KQRBN]?[a-h]?[1-8]?x?[a-h][1-8](?:\=[QRBN])?}; my $REcastling = qr/O\-O(?:\-O)?/; my $REcheck = qr/(?:(?:\#|\+(\+)?))?/; my $REanymove = qr/(?:$REmove|$REcastling)$REcheck/; my $RENAG = qr/\$\d+/; my $REnumber = qr/\d+\.(?:\.\.)?/; my $REescape = qr/^\%[^\n]*\n/; my $REeolcomment= qr/;.*$/; my $REcomment = $RE{balanced}{-parens=>'{}'}; my $RERAV = $RE{balanced}{-parens=>'()'}; my %switchcolor = ('w' => 'b', 'b' => 'w'); sub parse_game { my $self = shift; return undef unless $self->{gamedescr}{Game}; my $movecount = 0; my $color = 'b'; $self->{gamedescr}{Game} =~ s/$REresult\s*\Z//o; PARSER: { $self->{gamedescr}{Game} =~ m/\G($REnumber)\s*/mgc && do { my $num=$1; if (( $num =~ tr/\.//d) > 1) { $color = 'w'; } if ($movecount == 0) { $movecount = $num; } elsif ($movecount == ($num -1)) { $movecount++; } elsif ($movecount != $num) { $self->{GameErrors}->{$movecount.$color} .= " invalid move sequence ($num <=> $movecount)"; $movecount++; } redo }; $self->{gamedescr}{Game} =~ m/\G($REanymove)\s*/mgc && do { push @{$self->{GameMoves}}, $1; $color = $switchcolor{$color}; redo }; $self->{gamedescr}{Game} =~ m/\G($REcomment|$REeolcomment|$RERAV|$RENAG|$REescape)\s*/mgc && do { $self->{GameComments}->{$movecount.$color} .= " " . $1; $self->{GameComments}->{$movecount.$color} =~ tr/\r//d; $self->{GameComments}->{$movecount.$color} =~ s/\n/ /g; redo }; $self->{gamedescr}{Game} =~ m/\G(\S+\s*)/mgc && do { $self->{GameErrors}->{$movecount.$color} .= " " . $1; $self->{GameErrors}->{$movecount.$color} =~ tr/\r//d; $self->{GameErrors}->{$movecount.$color} =~ s/\n/ /g; redo }; } }