1668b1e0b2456a5ce05149941a1c18d8b769f913
[remoteglot] / book / parse-pgn.pl
1 #! /usr/bin/perl
2 use Chess::PGN::Parse;
3 use Data::Dumper;
4 use strict;
5 use warnings;
6 use DBI;
7 use DBD::Pg;
8 require 'Position.pm';
9 require 'Engine.pm';
10 require 'ECO.pm';
11
12 my $DRYRUN = 1;
13 my $TEXTOUT = 0;
14 my $BINOUT = 1;
15
16 ECO::init();
17
18 my $dbh = DBI->connect("dbi:Pg:dbname=ficsopening", "sesse", undef);
19 $dbh->do("COPY opening FROM STDIN") unless $DRYRUN;
20
21 my ($filename, $my_num, $tot_num) = @ARGV;
22
23 my $pgn = Chess::PGN::Parse->new($filename)
24         or die "can't open $filename\n";
25 my $game_num = 0;
26 while ($pgn->read_game()) {
27         next unless ($game_num++ % $tot_num == $my_num);
28         my $tags = $pgn->tags();
29 #       next unless $tags->{'WhiteElo'} >= 2000;
30 #       next unless $tags->{'BlackElo'} >= 2000;
31         $pgn->quick_parse_game;
32         my $pos = Position->start_pos($pgn->white, $pgn->black);
33         my $result = $pgn->result;
34         my $binresult;
35         if ($result eq '1-0') {
36                 $binresult = chr(0);
37         } elsif ($result eq '1/2-1/2') {
38                 $binresult = chr(1);
39         } elsif ($result eq '0-1') {
40                 $binresult = chr(2);
41         } else {
42                 die "Unknown result $result";
43         }
44         my $binwhiteelo = pack('l', $tags->{'WhiteElo'});
45         my $binblackelo = pack('l', $tags->{'BlackElo'});
46         my $moves = $pgn->moves;
47         my $opening = ECO::get_opening_num($pos);
48 #       print STDERR $pgn->white, " ", $pgn->black, "\n";
49         for (my $i = 0; $i + 1 < scalar @$moves; ++$i) {
50                 my ($from_row, $from_col, $to_row, $to_col, $promo) = $pos->parse_pretty_move($moves->[$i]);
51                 my $next_move = $moves->[$i];
52                 my $bpfen = $pos->bitpacked_fen;
53                 my $bpfen_q = $dbh->quote($bpfen, { pg_type => DBD::Pg::PG_BYTEA });
54                 my $fen = $pos->fen;
55                 $opening = ECO::get_opening_num($pos) // $opening;
56                 print "$fen $next_move $result $opening\n" if $TEXTOUT;
57                 if ($BINOUT) {
58                         print chr(length($bpfen) + length($next_move)) . $bpfen . $next_move;
59                         print $binresult . $binwhiteelo . $binblackelo;
60                         print pack('l', $opening);
61                 }
62                 $dbh->pg_putcopydata("$bpfen_q\t$next_move\t$result\n") unless $DRYRUN;
63                 $pos = $pos->make_move($from_row, $from_col, $to_row, $to_col, $promo, $moves->[$i]);
64         }
65 }
66 $dbh->pg_putcopyend unless $DRYRUN;