3 # This script is invoked when the YPP SC PCTB client phones home to
4 # provide updated character set OCR data or updated screenshot pixmap
5 # interpretation (island name) data.
7 # The client will also phone home anyway to fetch the latest parsedb
10 # This allows me (the operator of the SC server) to:
11 # - review the choices made by the user
12 # - if they are correct, incorporate them in the next client version
13 # - if they are wrong, incorporate fixes of them, or contradictions of them,
16 # The information reported
17 # The SC PCTB client does this so that
19 use strict (qw(vars));
21 $CGI::POST_MAX= 65536;
22 $CGI::DISABLE_UPLOADS= 1;
24 use CGI qw/:standard -private_tempfiles/;
29 #---------- pixmaps ----------
31 sub parseentryin__pixmap ($) {
34 m/^(\w+ \- \w[-+'"#! 0-9a-z]*)\nP3\n([1-9]\d{1,3}) ([1-9]\d{1,3})\n255\n/s or die; # ']);
35 my ($def,$w,$h)= ($1, $2+0, $3+0);
36 my @d= grep { m/./ } split /\s+/, $';
37 @d == $w*$h*3 or die "$d[0]|$d[1]|...|$d[$#d-1]|$d[$#d] ?";
41 $_ >= 0 or die "$_ ?";
42 $_ <= 255 or die "$_ ?";
44 my $ppm= "P3\n$w $h\n255\n";
46 for (my $y=0; $y<$h; $y++) {
47 for (my $x=0; $x<$w; $x++, $di+=3) {
48 #print STDERR ">$x,$y,$di,",scalar(@d),"<\n";
49 $ppm .= sprintf " %3d %3d %3d", @d[$di..$di+2];
54 my $summary= pipeval($ppm,
58 'pnmnorm -bpercent 40 -wpercent 10',
59 'pgmtopbm -threshold');
60 print STDERR ">$summary<\n";
63 # <ship-ahoy.ppm ppmtopgm | pnmscale -width 79 | pnmnorm -bpercent 40 -wpercent 10 | pgmtopbm -threshold | pbmtoascii | cut -c1-79
65 my $entry= "$def\n$ppm";
66 return ('',$def,$entry);
69 #---------- characters ----------
71 #---------- useful stuff ----------
74 my ($val, @cmds) = @_;
77 my $paste_child= open PIPEVAL_PASTE, "-|";
78 defined $paste_child or die $!;
79 if (!$paste_child) { print $val or die $!; exit 0; }
81 my $f= 'PIPEVAL_PASTE';
84 print STDERR ">$_<\n";
86 foreach my $cmd (@cmds) {
88 print STDERR "$cmd | $f\n";
89 push @pids, open2($newf, "<& $f", $cmd);
90 # if (@pids>1) { close $f or die $!; }
91 print STDERR "$cmd | $f $newf @pids\n";
95 $!=0; { local ($/)=undef; $val= <$f>; }
96 defined $val or die $!;
97 $f->error and die $!; close $f or die $!;
99 waitpid($paste_child,0) == $paste_child or die "paste $? $!";
100 $?==0 or $?==13 or die "paste $?";
101 close PIPEVAL_PASTE or die $!;
103 foreach my $cmd (@cmds) {
104 my $pid= shift @pids;
105 waitpid($pid,0) == $pid or die "$pid $? $!";
106 $?==0 or $?==13 or die "$cmd $?";
111 #---------- main program ----------
113 my $path= path_info();
114 my $entry_in= param('entry');
115 defined $entry_in or die;
117 my $owner= `whoami`; $? and die $?;
121 if ($path =~ /(pixmap|char)/) {
127 my ($ctx,$def,$entry)= &{"parseentryin__$kind"}($entry_in);
131 Subject: yppsc dictionary update