lichess-db-decoder.pl

use strict;
use MIME::Base64;

$| ++;

use constant DEBUG => 0;

my $move_type;
$move_type->[0] = 'SimplePawn';
$move_type->[1] = 'SimplePiece';
$move_type->[2] = 'FullPawn';
$move_type->[3] = 'FullPiece';

my $piece_type;
$piece_type->[1] = "K";
$piece_type->[2] = "Q";
$piece_type->[3] = "R";
$piece_type->[4] = "N";
$piece_type->[5] = "B";
$piece_type->[6] = "O-O";
$piece_type->[7] = "O-O-O";

my $promotion_type;
$promotion_type->[1] = "Q";
$promotion_type->[2] = "R";
$promotion_type->[3] = "N";
$promotion_type->[4] = "B";

my $check_type;
$check_type->[1] = "+";
$check_type->[2] = "#";

sub pg_bin_to_moves {
   my ($pg_bin, @out_expected) = @_;
   my $out;
   my $move = 1;
   my $white = 1;
   my $i = 0;
   while ($i < length($pg_bin)) {
      $out .= sprintf qq[%u. ], $move if ($white);

      my $b1 = substr($pg_bin, $i + 0, 1);
      my $b2 = substr($pg_bin, $i + 1, 1);
      my $b3 = substr($pg_bin, $i + 2, 1);
      my $b1b6_7 = (ord $b1) >> 6;
      my $b1b0_5 = (ord $b1) & ((1 << 6) - 1);
      my $b2b5_7 = (ord $b2) >> 5;
      printf qq[- move #$move: %s: examining at pos %u: b1=%u;%08b b1shr6=%u;%s\n], $white ? 'white' : 'black', $i, ord $b1, ord $b1, $b1b6_7, $move_type->[$b1b6_7] if DEBUG;
      if ($move_type->[$b1b6_7] eq 'SimplePawn') {
         $out .= sprintf qq[%c%c], ($b1b0_5 >> 3) + 97, ($b1b0_5 & 7) + 49;
         $i += 1;
      }
      elsif ($move_type->[$b1b6_7] eq 'SimplePiece') {
         my $what;
         my $b2b3_4 = ((ord $b2) >> 3) & 3;
         if ($piece_type->[$b2b5_7] =~ m~(O-O|O-O-O)~) { $out .= $piece_type->[$b2b5_7] . $check_type->[$b2b3_4] } # fixme 4 correct?
         else { $out .= sprintf qq[%s%s%c%c%s],
               $piece_type->[$b2b5_7], ord($b2) & 4 ? 'x' : '', ($b1b0_5 >> 3) + 97, ($b1b0_5 & 7) + 49, $check_type->[$b2b3_4];
            #my $pos = sprintf qq[%c%c], ($b1b0_5 >> 3) + 97, ($b1b0_5 & 7) + 49;
         }
         printf qq[b2=%u;%08b b2b4_5=%u\n], ord $b2, ord $b2, $b2b3_4 if DEBUG;
         $i += 2;
      }
      elsif ($move_type->[$b1b6_7] eq 'FullPawn') {
         my $b2b6_7 = (ord $b2) >> 6;
         my $b2b4_5 = ((ord $b2) >> 4) & 3;
         my $b2b1_3 = ((ord $b2) >> 1) & 7;
         $out .= sprintf qq[%s%c%c%s%s],
            0 == $b2b6_7 ? "" :
            1 == $b2b6_7 ? sprintf qq[%cx], ($b1b0_5 >> 3) + 97 - 1 :
            2 == $b2b6_7 ? sprintf qq[%cx], ($b1b0_5 >> 3) + 97 + 1 : '<INTERNAL ERROR>',
            ($b1b0_5 >> 3) + 97, ($b1b0_5 & 7) + 49,
            0 == $b2b1_3 ? '' : sprintf(qq[=%s], $promotion_type->[$b2b1_3]),
            $check_type->[$b2b4_5];
         printf qq[b2=%u;%08b ??\n], ord $b2, ord $b2 if DEBUG;
         $i += 2;
      }
      elsif ($move_type->[$b1b6_7] eq 'FullPiece') {
         my $b2b5_7 = (ord $b2) >> 5;
         my $b3b6_7 = (ord $b3) >> 6;
         my $b3b0_2 = (ord $b3) & 7;
         my $b2b3_4 = ((ord $b2) >> 3) & 3;
         $out .= sprintf qq[%s%c%s%c%c%s],
            $piece_type->[$b2b5_7],
            0 == $b3b6_7 ? $b3b0_2 + 97 : 
            1 == $b3b6_7 ? $b3b0_2 + 49 : "<INTERNAL ERROR>",
            ord($b2) & 4 ? 'x' : '',
            ($b1b0_5 >> 3) + 97, ($b1b0_5 & 7) + 49,
            $check_type->[$b2b3_4];
         printf qq[b2=%u;%08b b3=%u;%08b\n], ord $b2, ord $b2, ord $b3, ord $b3 if DEBUG;
         $i += 3;
      }
      else {
         printf qq[todo!!!\n];
         exit;
      }

      if ((not $white) || ($i == length($pg_bin))) {
         if ($out ne $out_expected[$move - 1]) {
            printf qq[Unpacked: '%s'\n], $out;
            printf qq[Expected: '%s'\n], $out_expected[$move - 1];
            exit;
         }
         printf qq[- %s\n], $out;
         undef $out;
         $move ++;
      }
      else {
         $out .= ' ';
      }
      $white = $white ? 0 : 1;
   }
}

# ymAi6GGY
# I22AJFyAU6BNgEqgVYBqgB10gCVqQHREnYCdQBpQTA==
# {"id":"ymAi6GGY","rated":false,"variant":"standard","speed":"classical","perf":"classical","timestamp":1416414220491,"turns":18,"status":"resign","clock":{"initial":900,"increment":0,"totalTime":900},"players":{"white":{},"black":{}},
# "moves":"e4 Nf6 e5 Nd5 Bc4 Nb6 Bb3 Nc6 Nf3 d6 Ng5 e6 Qf3 Qxg5 exd6 cxd6 d3 Qxc1+","winner":"black","url":"http://lichess.org/ymAi6GGY/black"}
#         {
#                 "_id" : "ymAi6GGY",
#                 "ps" : BinData(0,"NKAQA2ZgBmYFBgIAAAAAAAAAAAAMzuAA7gAO7rDQnQs="),
#                 "s" : 31,
#                 "t" : 18,
#                 "c" : BinData(0,"DwAAT8sAHZ8AAAAA"),
#                 "cl" : BinData(0,"/RAACv0g"),
#                 "mt" : BinData(0,"Bcal1cXM593K"),
#                 "ca" : ISODate("2014-11-19T16:23:40.491Z"),
#                 "ua" : ISODate("2014-11-19T16:28:27.246Z"),
#                 "so" : 1,
#                 "pg" : BinData(0,"I22AJFyAU6BNgEqgVYBqgB10gCVqQHREnYCdQBpQTA=="),
#                 "p1" : {
#                         "b" : 2
#                 },
#                 "w" : false
#         },
my $file_count = 0;
my @file_names = glob('games/game-*.txt');
foreach my $file_name (sort @file_names) {
   $file_count ++;
   my $file_lines = `cat $file_name`;
   my ( $moves ) = $file_lines =~ m~"moves":"(.*?)"~s;
   my @moves = split (m~ ~, $moves);
   my @moves_expected;
   my $move_count = 1;
   while (scalar @moves >= 2) {
      push @moves_expected, sprintf qq[%u. %s %s], $move_count, shift @moves, shift @moves;
      $move_count ++;
   }
   push @moves_expected, sprintf qq[%u. %s], $move_count, shift @moves if (scalar @moves > 0);
   my ( $so ) = $file_lines =~ m~"so" : (.*?),~s;
   my ( $pg ) = $file_lines =~ m~"pg" : BinData\(0,"(.*?)"\)~s;
   my $pg_bin = decode_base64($pg);
   printf qq[- loaded file #%u: %4u bytes; %s: so=%s %2u moves=%3u:%-80s pg=%3u:%-80s:%3u\n],
      $file_count, length $file_lines, $file_name, $so, (scalar $#moves) / 2, length $moves, substr($moves, 0, 80), length $pg, substr($pg, 0, 80), length $pg_bin;
   #debug printf qq[- @moves_expected\n];
   if ($moves ne '') {
      pg_bin_to_moves($pg_bin, @moves_expected);
   }
}
exit;