#!/usr/bin/perl # do "acqPATHs.pl"; $str = $ENV{"QUERY_STRING"}; ($Prog, $Qidno) = split(/\+/, $str); # $pin = "$HTMLPATH/fout/pin.$Qidno"; $out = "$HTMLPATH/fout/out.$Qidno"; $pid = fork(); if (!defined $pid) { print STDERR "runprogx: fork fail\n"; exit(9); } elsif ($pid == 0) { #------- Child process -------- if ($DebugAMXS) { # 最新$pinデータを残す [必要時に有効化] if (open(PIN, "< $pin")) { if (open(POT, "> $HTMLPATH/fout/PINdata")) { while ($_ = ) { print POT $_; } close(POT); } close(PIN); } } unless (open(STDIN, "< $pin")) { print STDERR "runprogx: STDIN $pin open fail\n"; exit(9); } unless (open(STDOUT, "> $out")) { print STDERR "runprogx: STDOUT $out open fail\n"; exit(9); } unless (open(STDERR, '>&', fileno(STDOUT))) { print STDERR "runprogx: STDERR >& STDOUT fail\n"; exit(9); } exec("$PROGPATH/$Prog"); print STDERR "runprogx: unable to start exec($Prog)\n"; exit(9); } else { #------- Parent process -------- print "Content-type: text/html; charset=iso-8859-1\n\n"; $htmlbody =< AMXS runprogx $Prog $Qidno (__PID__)
EOM #------- $htmlbody =~ s/__PID__/$pid/g; print $htmlbody; close(STDOUT); wait(); if ($?) { $rcode = $? >> 8; $signo = $? & 127; $dcore = ""; if ($? & 128) { $dcore = " core-dumped "; } if (open(OUT, ">> $out")) { if ($signo == 9) { print OUT "\n******** ABORTED RC=$rcode ********\n"; } else { print OUT "\n******** ERROR RC=$rcode SIG=$signo $dcore\n"; } print OUT " Check above output carefully.\n"; print OUT " No information will be written in log file.\n"; close(OUT); } else { print STDERR "ERROR: message append fail\n"; } } exit(0); }