WIP yppsc-parsedb-updatereceiver; wip pipeval

[ypp-sc-tools.db-test.git] / pctb / yppsc-parsedb-updatereceiver

diff --git a/pctb/yppsc-parsedb-updatereceiver b/pctb/yppsc-parsedb-updatereceiver
index 17ba86888c6f83ad782f99f1759adff37f2d1cd2..1bce6c5c53dd54f0bfe03b93afd27b2ab364f3ae 100755 (executable)
--- a/pctb/yppsc-parsedb-updatereceiver
+++ b/pctb/yppsc-parsedb-updatereceiver
@@ -22,14 +22,16 @@ $CGI::POST_MAX= 65536;
 $CGI::DISABLE_UPLOADS= 1;
 
 use CGI qw/:standard -private_tempfiles/;
-
+use IPC::Open2;
+use IO::Handle;
+use File::Temp;
 
 #---------- pixmaps ----------
 
-sub parseentryin_pixmap ($) {
+sub parseentryin__pixmap ($) {
     my ($entry_in) = @_;
     $entry_in =~
-       m/^(\w+ \- \w[-+'"#! 0-9a-z]*\w)\nP3\n([1-9]\d{1,3}) ([1-9]\d{1,3})\n255\n/s or die; # ']);
+       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] ?";
@@ -49,9 +51,16 @@ sub parseentryin_pixmap ($) {
        $ppm .= "\n";
     }
 
-    ppmtopgm | pnmscale -width 79 | pnmnorm -bpercent 40 -wpercent 10 | pgmtopbm -threshold
+    my $summary= pipeval($ppm,
+                        'set -x; cat >&2',
+                        'ppmtopgm',
+                        'pnmscale -width 79',
+                        'pnmnorm -bpercent 40 -wpercent 10',
+                        'pgmtopbm -threshold');
+    print STDERR ">$summary<\n";
+    
 
- <ship-ahoy.ppm ppmtopgm | pnmscale -width 79 | pnmnorm -bpercent 40 -wpercent 10 | pgmtopbm -threshold | pbmtoascii | cut -c1-79
+# <ship-ahoy.ppm ppmtopgm | pnmscale -width 79 | pnmnorm -bpercent 40 -wpercent 10 | pgmtopbm -threshold | pbmtoascii | cut -c1-79
        
     my $entry= "$def\n$ppm";
     return ('',$def,$entry);
@@ -59,6 +68,46 @@ sub parseentryin_pixmap ($) {
 
 #---------- characters ----------
 
+#---------- useful stuff ----------
+
+sub pipeval ($@) {
+    my ($val, @cmds) = @_;
+    my (@pids);
+
+    my $paste_child= open PIPEVAL_PASTE, "-|";
+    defined $paste_child or die $!;
+    if (!$paste_child) { print $val or die $!; exit 0; }
+
+    my $f= 'PIPEVAL_PASTE';
+
+$_=<$f>;
+print STDERR ">$_<\n";
+
+    foreach my $cmd (@cmds) {
+       my $newf;
+print STDERR "$cmd | $f\n";
+       push @pids, open2($newf, "<& $f", $cmd);
+#      if (@pids>1) { close $f or die $!; }
+print STDERR "$cmd | $f $newf @pids\n";
+       $f= $newf;
+    }
+
+    $!=0; { local ($/)=undef; $val= <$f>; }
+    defined $val or die $!;
+    $f->error and die $!;  close $f or die $!;
+
+    waitpid($paste_child,0) == $paste_child or die "paste $? $!";
+    $?==0 or $?==13 or die "paste $?";
+    close PIPEVAL_PASTE or die $!;
+
+    foreach my $cmd (@cmds) {
+       my $pid= shift @pids;
+       waitpid($pid,0) == $pid or die "$pid $? $!";
+       $?==0 or $?==13 or die "$cmd $?";
+    }
+    return $val;
+}
+
 #---------- main program ----------
 
 my $path= path_info();
@@ -75,7 +124,7 @@ if ($path =~ /(pixmap|char)/) {
     die "$path ?";
 }
 
-my ($ctx,$def,$entry)= ${"parseentryin__$kind"}($entry_in);
+my ($ctx,$def,$entry)= &{"parseentryin__$kind"}($entry_in);
 
 my $summary= <<END
 To: $owner
@@ -86,11 +135,3 @@ Definition: $def
 
 END
     ;
-
-
-    
-    print $entry or die $!;
-} else {
-    die "$path ?";
-}
-