view release on metacpan or  search on metacpan

lib/Chess4p/Pgn/Reader.pm  view on Meta::CPAN

package Chess4p::Pgn::Reader;

use v5.36;

use utf8;

use Chess4p;

use Exporter 'import';

our @EXPORT_OK = qw(
    &read_game
);

our $_debug = 0;

my $NAG_GOOD_MOVE = 1;
my $NAG_MISTAKE = 2;
my $NAG_BRILLIANT_MOVE = 3;
my $NAG_BLUNDER = 4;
my $NAG_SPECULATIVE_MOVE = 5;
my $NAG_DUBIOUS_MOVE = 6;

my $move_text_rx = qr'
                       [NBKRQ]?[a-h]?[1-8]?[\-x]?[a-h][1-8](?:=?[nbrqkNBRQK])?
                     | -- | Z0 | 0000 | @@@@
                     | O-O(?:-O)?
                     | 0-0(?:-0)?    
                     | [?!]{1,2}
                     | \* | 1-0 | 0-1 | 1/2-1/2
                     | \$[0-9]+    # NAG
                     | \{.*        # Game comment    
                     | ;.*         # PGN file comment    
                     | \(          # Variation start
                     | \)          # Variation end
                     'xo;

my $tag_rx = qr'^\[([A-Za-z0-9][A-Za-z0-9_+#=:-]*)\s+\"([^\r]*)\"\]\s*$'o;

my $skip_move_text_rx = qr';|\{|\}'o;

  
sub read_game {
    my ($fh, $visitor) = @_;

    my @errors;

    my $line = <$fh>;

    # Remove BOM if needed
    $line =~ s/^\x{FEFF}// if defined $line;

    say "10---------> $line" if $_debug;

    # Ignore leading empty lines and comments.
    while (defined $line && $line =~/^[;%]?\s*$/) {
        $line = <$fh>; #  Use of uninitialized value $line in pattern match (m//) at lib/Chess4p/Pgn/Reader.pm line 53,
    }

    return undef unless $line;

    say "20---------> $line" if $_debug;

    my $found_game = 0;
    my $skipping_game = 0;
    my @board_stack = ();
    my $consecutive_empty_lines = 0;
    my $fen;

    # Loop to collect game headers
    while ($line) {

        say "30---------> $line" if $_debug;
        
        # Ignore comments.
        if ($line =~/^[;%]/) {
            $line = <$fh>;
            next;
        }
        
        # Ignore up to one consecutive empty line between headers.
        if ($consecutive_empty_lines < 1 && $line =~/^\s*$/) {
            $consecutive_empty_lines++;
            $line = <$fh>;
            next;
        }
        
        # First token of the game.
        unless ($found_game) {
            $found_game = 1;
            $skipping_game = $visitor->begin_game();