AMXS runprog

#!/usr/bin/perl # sub htencode { local($htencd) = shift; $htencd =~ s/&/&/g; $htencd =~ s/"/"/g; $htencd =~ s//>/g; $htencd; } use CGI; do "acqPATHs.pl"; $qform = CGI->new; $Prog = $qform->param("Prog"); $Wdr = $qform->param("wdr"); $Spec = $qform->param("Spec"); $Par[0] = $qform->param("log"); $cnt = 0; while ($Par[$cnt] ne "\$") { $cnt++; $nam = sprintf("P%02d", $cnt); $Par[$cnt] = $qform->param($nam); if ($cnt == 99) { $Par[$cnt] = "\$"; } } if ($Wdr ne "") { $Wdr .= "/"; } print "Content-type: text/html; charset=iso-8859-1\n\n"; #------- Validity check for parameters -------- # F: filename of pre-existing File # N: filename to create New # U: String "U", or filename to create New # P: filename for any (old or new) file (e.g., PS file) # E: filename of pre-existing File, or blank # M: filename to create New, or blank # Q: filename for any (old or new) file, or blank # f: single floating value # g: one or more floating values (usually two values) # i: single integer value # j: one or more integer values (usually two values) # I: single non-zero integer value # c: valid coordinate number (integer) value # s: any non-blank string # y: y/n selection ('y' or 'n') $ermsg = ""; for ($i=0; $i<$cnt; $i++) { $j = substr($Spec,$i,1); if ($Par[$i] =~ /^#/) { next; } if ($j =~ /[FNPU]/) { if ($Par[$i] !~ /^\s*(\w+\.)*\w+\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid filename\n"; } else { if ($j eq "F") { unless (-e "$DATAPATH/$Wdr$Par[$i]") { $ermsg .= "$i: \"$Par[$i]\" file does not exist\n"; } } elsif ($j eq "U") { if (($Par[$i] ne "U") && (-e "$DATAPATH/$Wdr$Par[$i]")) { $ermsg .= "$i: \"$Par[$i]\" new file already exists\n"; } } elsif ($j eq "N") { if (-e "$DATAPATH/$Wdr$Par[$i]") { $ermsg .= "$i: \"$Par[$i]\" new file already exists\n"; } } } } elsif ($j =~ /[EMQ]/) { if ($Par[$i] =~ /^\s*$/) { } elsif ($Par[$i] !~ /^\s*(\w+\.)*\w+\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid filename\n"; } else { if ($j eq "E") { unless (-e "$DATAPATH/$Wdr$Par[$i]") { $ermsg .= "$i: \"$Par[$i]\" file does not exist\n"; } } elsif ($j eq "M") { if (-e "$DATAPATH/$Wdr$Par[$i]") { $ermsg .= "$i: \"$Par[$i]\" new file already exists\n"; } } } } elsif ($j eq "f") { if ($Par[$i] !~ /^\s*[+-]?(\d+(\.\d*)?)|(\.\d+)\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid floating\n"; } } elsif ($j eq "g") { if ($Par[$i] !~ /^\s*[+-]?(\d+(\.\d*)?)|(\.\d+)(\s+[+-]?(\d+(\.\d*)?)|(\.\d+))?\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid floatings\n"; } } elsif ($j =~ /[iI]/) { if ($Par[$i] !~ /^\s*[+-]?\d+\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid integer\n"; } else { if (($j eq "I") && ($Par[$i] == 0)) { $ermsg .= "$i: \"$Par[$i]\" zero not allotted\n"; } } } elsif ($j eq "j") { if ($Par[$i] !~ /^\s*[+-]?\d+(\s+[+-]?\d+)?\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid integers\n"; } } elsif ($j eq "c") { if ($Par[$i] =~ /^\s*\d+\s*$/) { $k = $Par[$i]; if ($k >= 200) { $k -= 200; } if (($k<=62) || ($k==65) || ($k==70) || ($k==71) || ($k==100) || ($k==109) || ($k==199)) {} else { $ermsg .= "$i: coord. \"$Par[$i]\" is not supported\n"; } } else { $ermsg .= "$i: \"$Par[$i]\" is not valid coord.number\n"; } } elsif ($j eq "s") { if ($Par[$i] !~ /^\s*\S+\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid string\n"; } } elsif ($j eq "y") { if ($Par[$i] !~ /^\s*[yn]\s*$/) { $ermsg .= "$i: \"$Par[$i]\" is not valid y/n selection\n"; } } } if ($ermsg ne "") { print "\n"; print "\n\n"; print ""; print "\n"; print "AMXS runprog\n"; print "\n\n"; print "\n

\n"; print "Prog. $Prog is not started. \n"; print "
\n"; print "

\n";
    print &htencode($ermsg);
    print "

\n\n\n"; exit(0); } #------- Prepare for parameter file -------- $Qidno = $$; unless (open(PIN, "> $HTMLPATH/fout/pin.$Qidno")) { print STDERR "pin.$Qidno (PIN) open fail\n"; exit(9); } print PIN "$DATAPATH/$Wdr\n"; for ($cnt = 0; $Par[$cnt] ne "\$"; $cnt++) { print PIN "$Par[$cnt]\n"; } close(PIN); # $htmlbody =< AMXS running

Prog. __PROG__ (QID: __QIDNO__) running. EOM #------- $htmlbody =~ s/__PROG__/$Prog/g; $htmlbody =~ s/__QIDNO__/$Qidno/g; print $htmlbody; exit(0);