File Coverage

blib/lib/Chess/PGN/Extract/Stream.pm

Criterion	Covered	Total	%
statement	21	57	36.8
branch	0	14	0.0
condition	0	3	0.0
subroutine	7	12	58.3
pod	4	4	100.0
total	32	90	35.5

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 => '_' };

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 eof $handle;

  if ( ( not defined $limit ) || $limit < 0 ) {
    # Slurp the PGN file if $limit is not set or negative
    my $all = do { local $/; <$handle> };
    return ( _read_pgn_string ($all) );
  }
  elsif ( $limit == 0 ) {return}
  else {
    my @games;
    my @lines = ( scalar readline $handle );
    while ( my $line = readline $handle ) {
      unless ( $line =~ /^\[Event / ) {
        # We merely check the end of a game by the above regex.
        # It should be implemented by a more strict manner.
        push @lines, $line;
      }
      else {
        push @games, join ( '', @lines );
        unless ( --$limit > 0 ) {
          return ( _read_pgn_string ( join ( '', @games ) ) );
        }
        @lines = ($line);
      }
    }
    push @games, join ( '', @lines );
    return ( _read_pgn_string ( join ( '', @games ) ) );
  }
}

# _read_pgn_string ($pgn_string) => @games
sub _read_pgn_string {
  my ($pgn_string) = @_;

  my $tmp_dir = tempdir (
    $ENV{TMPDIR} . "/chess_pgn_extract_stream_XXXXXXXX",
    CLEANUP => 1 );
  my ( $tmp_handle, $tmp_file ) = tempfile ( DIR => $tmp_dir );
  print $tmp_handle $pgn_string;
  close $tmp_handle;

  return ( _read_games ($tmp_file) );
}

1;
__END__