#!/usr/local/bin/perl
# This was copied from pages 342 and 343 of the book
# Build a Web Site.

# File Name: astm900.pl

local($request_method,$content_length,$query_string);

#
#   This assignment ensures that there are not problems in
#   mixing fortran output with perl output.
#
$| = 1;

#Grab REQUEST_METHOD, CONTENT_LENGTH, and QUERY_STRING

$request_method = $ENV{'REQUEST_METHOD'};
$content_length = $ENV{'CONTENT_LENGTH'};
$query_string = $ENV{'QUERY_STRING'};

#Check whether this was a PUT or a POST

if (($request_method eq 'POST') || ($request_method eq 'PUT')) {

#If so, read the appropriate number of bytes from STDIN

   read(STDIN, $query, $content_length);

#echo these bytes 

   print("Content-Type: text/html\n\n");
#   print("

Today we are debugging.

\n\n"); # print("

\n"); # print("$query



"); # # The material below was written by Steve Verrill, 10/95 -- 11/95 # #Try to parse $query. & separates fields. + separates multiple items in a field. @fields = split(/&/, $query); # print ("@fields

"); # foreach $temp (@fields) { # print ("$temp
"); # } # print("

"); $errflag = 0; # # Number of reductions # $fields[0] =~ s/[^\d]//g; $numred = $fields[0]; # print("numred = $numred
"); # # The reductions # # # pluses in the original input create %2B's. Handle. # $fields[1] =~ s/%2B/\+/g; # # get rid of everything other than minus signs, plus signs, decimals, # and digits # $fields[1] =~ s/[^-\+\.\d]//g; # # get rid of leading pluses # $fields[1] =~ s/^[\+]+//; # # get rid of trailing pluses # $fields[1] =~ s/[\+]+$//; @reds = split(/[\+]+/, $fields[1]); # print("reds = @reds
"); $numred2 = @reds; # print("$numred2
"); if ($numred2 != $numred) { print("
The number of reductions supplied, $numred2, does not equal the number chosen, $numred. Please correct the data entry form.

"); $errflag = 1; } foreach $temp (@reds) { if ($temp < 0 || $temp > 100) { print("
Reductions less than 0 or greater than 100 are not permitted. Please correct the data entry form.

"); $errflag = 1; } } # print("

"); # # Coefficients of variation # $fields[2] =~ s/[^\d]//g; $numcv = $fields[2]; # print("numcv = $numcv
"); # # pluses in the original input create %2B's. Handle. # $fields[3] =~ s/%2B/\+/g; # # get rid of everything other than minus signs, plus signs, decimals, # and digits # $fields[3] =~ s/[^-\+\.\d]//g; # # get rid of leading pluses # $fields[3] =~ s/^[\+]+//; # # get rid of trailing pluses # $fields[3] =~ s/[\+]+$//; @cvs = split(/[\+]+/, $fields[3]); # print("cvs = @cvs
"); $numcv2 = @cvs; # print("$numcv2
"); if ($numcv2 != $numcv) { print("
The number of cvs supplied, $numcv2, does not equal the number chosen, $numcv. Please correct the data entry form.

"); $errflag = 1; } # foreach $temp (@cvs) { # if ($temp <= 0) { # print("
Coefficients of variation # equal to 0 are not permitted. # Please correct the data entry form.

"); # $errflag = 1; # } # } # print("

"); # # number in first batch # $fields[4] =~ s/num1=//; $fields[4] =~ s/[^\d]//g; $num1 = $fields[4]; if ($num1 < 1 || $num1 > 200) { print("
The number of items in the first batch was less than 1 or greater than 200. Please correct the form.

"); $errflag = 1; } # # number in second batch # # $fields[5] =~ s/num2=//; # $fields[5] =~ s/[^\d]//g; # $num2 = $fields[5]; # if ($num2 < 1 || $num2 > 200) { # print("
The number of items in the second batch was less than 1 or # greater than 200. Please correct the form.

"); # $errflag = 1; # } # # The number in the second batch must equal the number in the first # batch as they are paired. # $num2 = $num1; # # id of the order statistic from the first batch # $fields[6] =~ s/[^\d]//g; $idos = $fields[6]; if ($idos < 1 || $idos > $num1) { print("
The ID of the order statistic is less than 1 or greater than the number of specimens, $num1, in the first batch. Please correct the form.

"); $errflag = 1; } # # Fraction of the load level # # # pluses in the original input create %2B's. Handle. # $fields[7] =~ s/%2B/\+/g; # # get rid of everything other than minus signs, plus signs, decimals, # and digits # $fields[7] =~ s/[^-\+\.\d]//g; # # get rid of leading pluses # $fields[7] =~ s/^[\+]+//; # # get rid of trailing pluses # $fields[7] =~ s/[\+]+$//; $frac = $fields[7]; if ($fields[7] < 0.0 || $fields[7] > 1.0) { print("
A fraction less than 0 or greater than 1 is not permitted. Please correct the data entry form.

"); $errflag = 1; } # # number of failures that are permitted in the second batch # $fields[8] =~ s/[^\d]//g; $numfok2 = $fields[8]; # # number in third batch # $fields[9] =~ s/num3=//; $fields[9] =~ s/[^\d]//g; $num3 = $fields[9]; if ($num3 < 0 || $num3 > 200) { print("
The number of items in the third batch was less than 0 or greater than 200. Please correct the form.

"); $errflag = 1; } # # number of failures that are permitted in the third batch # $fields[10] =~ s/[^\d]//g; $numfok3 = $fields[10]; # # Correlation between matched specimens # # # pluses in the original input create %2B's. Handle. # $fields[11] =~ s/%2B/\+/g; # # get rid of everything other than minus signs, plus signs, decimals, # and digits # $fields[11] =~ s/[^-\+\.\d]//g; # # get rid of leading pluses # $fields[11] =~ s/^[\+]+//; # # get rid of trailing pluses # $fields[11] =~ s/[\+]+$//; $corr = $fields[11]; if ($fields[11] < 0.0 || $fields[11] > 1.0) { print("
A correlation less than 0 or greater than 1 is not permitted. Please correct the data entry form.

"); $errflag = 1; } # # number of trials # $fields[12] =~ s/[^\d]//g; $numtrial = $fields[12]; if ($numtrial < 1 || $numtrial > 10000) { print("
The number of trials requested was less than 1 or greater than 10000. Please correct the form.

"); $errflag = 1; } # # istart value # $fields[13] =~ s/[^\d]//g; $istart = $fields[13]; if ($istart < 1 || $istart > 10000000) { print("
The starting value for the random number generator was less than 1 or greater than 10000000. Please correct the form.

"); $errflag = 1; } $fields[14] =~ s/results=//; if ($fields[14] eq "") { $fields[14] = "delme"; } @list = ("/export/home/ftp/pub/data/",$fields[14]); $results = join("",@list); # print("numred = $numred
"); # print("reds = @reds
"); # print("numcv = $numcv
"); # print("cvs = @cvs
"); # print("num1 = $num1
"); # print("num2 = $num2
"); # print("num3 = $num3
"); # print("idos = $idos
"); # print("frac = $frac
"); # print("corr = $corr
"); # print("numfok2 = $numfok2
"); # print("numfok3 = $numfok3
"); # print("numtrial = $numtrial
"); # print("istart = $istart
"); # print("results = $results
"); if ($errflag != 1) { @proglist = ("astm900","$numred","@reds","$numcv","@cvs","$num1", "$num2","$idos","$frac","$numfok2","$num3","$numfok3", "$corr","$numtrial","$istart","$results", "$fields[14]"); system(@proglist); } # print("

"); # print("@fields
"); } elsif ($request_method eq 'GET') { #If so, the data is in QUERY_STRING $query = $query_string; } else { #Otherwise, print an error print("Content-Type: text/html\n\n"); print("

Error: Unacceptable Method

\n\n"); print("
\n"); print("This script does not support the $ENV{'REQUEST_METHOD'}\n"); print("method for submitting forms. Please use the POST method.\n"); exit; }