#!/usr/bin/perl -w
#
# This script is invoked when the YPP SC PCTB client phones home to
# provide updated character set OCR data or updated screenshot pixmap
# interpretation (island name) data.
#
# The client will also phone home anyway to fetch the latest parsedb
# before 
#
# This allows me (the operator of the SC server) to:
#    - review the choices made by the user
#    - if they are correct, incorporate them in the next client version
#    - if they are wrong, incorporate fixes of them, or contradictions of them,
#      in

# The information reported 
# The SC PCTB client does this so that 

use strict (qw(vars));
use POSIX;

$CGI::POST_MAX= 65536;
$CGI::DISABLE_UPLOADS= 1;

use CGI qw/:standard -private_tempfiles/;
use IO::Pipe;
use IO::Handle;

#---------- pixmaps ----------

sub parseentryin__pixmap ($) {
    my ($entry_in) = @_;
    $entry_in =~
	m/^(\w+ \- \w[-+\'\"\#! 0-9a-z]*)\nP3\n([1-9]\d{1,3}) ([1-9]\d{1,3})\n255\n/s or die;
    my ($def,$w,$h)= ($1, $2+0, $3+0);
    my @d= grep { m/./ } split /\s+/, $';
    @d == $w*$h*3 or die "$d[0]|$d[1]|...|$d[$#d-1]|$d[$#d] ?";
    map {
	m/\D/ and die "$& ?";
	$_ += 0;
	$_ >= 0 or die "$_ ?";
	$_ <= 255 or die "$_ ?";
    } @d;
    my $ppm= "P3\n$w $h\n255\n";
    my $di=0;
    for (my $y=0; $y<$h; $y++) {
	for (my $x=0; $x<$w; $x++, $di+=3) {
#print STDERR ">$x,$y,$di,",scalar(@d),"<\n";
	    $ppm .= sprintf "  %3d %3d %3d", @d[$di..$di+2];
	}
	$ppm .= "\n";
    }

    return ('',$def,$ppm,$ppm,$def);
}

#---------- characters ----------

sub parseentryin__char ($$) {
    my ($ei,$h) = @_;
    $ei =~ m/^(Digit|Upper|Lower)\n((?:[-&\'A-F0-9a-f ]|\x20)+)\n/s or die;
    my ($ctx,$str)= ($1,$2);
#print STDERR ">$'<\n";
    my @d= grep { m/./ } split /\n/, $';
#print STDERR ">@d<\n";
    die if $h>31;
    die if @d>400;
    my $maxval= (1<<$h)-1;
    map {
	m/^[0-9a-f]{1,8}$/ or die;
	$_= hex $_;
	die "$_ ?" if $_ > $maxval;
    } @d;
    my $w= @d;
    my $ppm= "P2\n$w $h\n1\n";
    for (my $y=0; $y<$h; $y++) {
	for (my $x=0; $x<$w; $x++) {
	    $ppm .= sprintf " %d", !($d[$x] & (1<<$y));
	}
	$ppm .= "\n";
    }
    my $key= join ' ', $ctx, map { sprintf "%x", $_; } @d;
    
    return ($ctx,$str,$ppm,$key,$str);
}

#---------- main program ----------

my $dict= param('dict');
my $entry_in= param('entry');
defined $entry_in or die;

my $ocean= param('ocean');
my $pirate= param('pirate');
if (defined $ocean && defined $pirate) {
    $pirate= "$ocean - $pirate";
} else {
    $pirate= $ENV{'REMOTE_ADDR'};
    my $fwdf= $ENV{'HTTP_X_FORWARDED_FOR'};
    if (defined $fwdf) {
	$fwdf =~ s/\s//g;
	$fwdf =~ s/[^0-9.,]/?/g;
	$pirate= "$fwdf,$pirate";
    }
}

my $du=$ENV{'YPPSC_DICTUPDATES'};
chdir $du or die "$du $!"
    if defined $du;

my $kind;
my @xa;

if ($dict =~ m/^pixmap$/) {
    $kind= $&;
} elsif ($dict =~ m/^(char)([1-9]\d?)$/) {
    ($kind,@xa)= ($1,$2);
} else {
    die "$dict ?";
}
$dict= $&;

my ($ctx,$def,$image,$key,$val)= &{"parseentryin__$kind"}($entry_in, @xa);

my $fn_t= "_update.$$-xxxxxxxxxxxxxxxx.tmp";
open F, "> $fn_t" or die "$fn_t $!";
(stat F) or die $!;
my $fn_i= sprintf "_update.$$-%016x.rdy", (stat _)[1];

print F "ypp-sc-tools dictionary update v1\n";

foreach my $v ($pirate,$dict,$ctx,$def,$image,$key,$val) {
    printf F "%d\n", length($v) or die $!;
    print F $v,"\n" or die $!;
}

close F or die $!;

my @tm= localtime;
my $tm= strftime "%Y-%m-%d %H:%M:%S %Z", @tm;

open L, ">> _dict.log" or die $!;
my $ll= sprintf "%s %-6s %-31s %s %s\n", $tm, $dict, $pirate, $fn_i, "submit";
print L $ll or die $!;
close L or die $!;

rename $fn_t, $fn_i or die "$fn_t $fn_i $!";