view release on metacpan or  search on metacpan

lib/Chess/PGN/Extract/Stream.pm  view on Meta::CPAN

package Chess::PGN::Extract::Stream;
use 5.008001;
use strict;
use warnings;

use base 'Exporter::Tiny';
our @EXPORT = qw| pgn_file read_game read_games |;

use Carp       qw| croak |;
use File::Temp qw| tempdir tempfile |;
use Chess::PGN::Extract 'read_games' => { -prefix => '_' };
use IO::Handle;

sub new {
  my ( $class, $pgn_file ) = @_;

  croak ("'new' requires a PGN file name")
    unless defined $pgn_file;

  my $self = {};
  $self->{pgn_file} = $pgn_file;
  open my $pgn_handle, '<', $pgn_file
    or croak ("Cannot open PGN file: \"$pgn_file\"");
  $self->{pgn_handle} = $pgn_handle;

  bless $self => $class;
}

sub pgn_file { $_[0]->{pgn_file} }

sub read_game {
  ( $_[0]->read_games (1) )[0];
}

sub read_games {
  my $self = shift;
  my ($limit) = @_;

  my $handle = $self->{pgn_handle};
  return if $handle->eof;

  unless ( defined $limit ) {
    return _read_all ($handle);
  }

  # Force integer
  $limit = int $limit;

  if    ( $limit  < 0 ) { _read_all ($handle) }
  elsif ( $limit == 0 ) { return }
  else {
    my ( $game, @games );
    while ( $limit-- and $game = _get_one_game_string ($handle) ) {
      push @games, $game;
    }
    return _read_pgn_string ( join '', @games );
  }
}

{
  # Parser contexts:
  #   $start        - Before parsing tag sections
  #   $expect_tag   - Parsing tag sections has started
  #   $expect_moves - Parsing moves section has started
  my ( $start, $expect_tag, $expect_moves ) = 0 .. 2;

  # Regular expressions to identify which section the given $line is
  my $blank     = qr/^[\s\t]*\n$/;
  my $tag       = qr/^[\s\t]*\[[\s\t]*\w+[\s\t]+\".+\"[\s\t]*\][\s\t]*\n$/;
  my $tag_begin = qr/^[\s\t]*\[/;
  # my $moves = ...;

  # _get_one_game_string ($handle) => $pgn_string
  sub _get_one_game_string {
    my $context = $start;
    _parse_lines ( $_[0], $context, [] );
  }

  # _parse_lines ($handle, $context, $buffer) => $pgn_string
  sub _parse_lines {
    return join '', @{ $_[2] } if $_[0]->eof;

    my $line = $_[0]->getline;

    # Ignore blank lines
    goto \&_parse_lines if $line =~ $blank;