#!/usr/local/bin/perl
# This was copied from pages 342 and 343 of the book
# Build a Web Site.
# File Name: power.mult.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("The data received was:
\n\n");
# print("
\n");
# print("$query
");
#
# The material below was written by Steve Verrill, 1/97
#
#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 factors
#
$fields[0] =~ s/[^\d]//g;
$numfac = $fields[0];
# print("numfac = $numfac
");
#
# Number of levels
#
#
# 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/[\+]+$//;
@numlev = split(/[\+]+/, $fields[1]);
# print("numlev = @numlev
");
$numltot = 0;
$numalloc = 1;
foreach $temp (@numlev) {
if ($temp < 1) {
print("
Level values must be positive. Please correct the
data entry form.
");
$errflag = 1;
}
$numltot = $numltot + $temp;
$numalloc = $numalloc*$temp;
}
if ($numltot > 25) {
print("
The total number of levels may not exceed 25. Please correct the
data entry form.
");
$errflag = 1;
}
if ($numalloc > 5000) {
print("
As currently written, the program cannot handle the numbers
of factors and levels that you wish to handle. Please contact
Steve Verrill at 608-231-9375 or at steve\@www1.fpl.fs.fed.us
for assistance.
");
$errflag = 1;
}
$maxrep = 5000/$numalloc;
# print("numlev = @numlev
");
$numfac2 = @numlev;
# print("$numfac2
");
if ($numfac2 != $numfac) {
print("
The number of level values supplied, $numfac2, does not equal
the number of factors, $numfac. Please correct the data entry form.
");
$errflag = 1;
}
# print("
");
#
# Number of replicates
#
$fields[2] =~ s/[^-\d]//g;
$numrep = $fields[2];
if ($numrep < 1) {
print("
The number of replicates must be positive. Please
correct the data entry form.
");
$errflag = 1;
}
# print("numrep = $numrep
");
if ($numrep > $maxrep) {
print("
As currently written, the program can handle at most 5000
observations. Given your proposed design, this means that there
may be at most $maxrep replicates per factor combination. Please
correct the data entry form.If you must deal with more than 5000
observations, please contact
Steve Verrill at 608-231-9375 or at steve\@www1.fpl.fs.fed.us.
");
$errflag = 1;
}
#
# factor to test
#
$fields[3] =~ s/[^\d]//g;
$idfac = $fields[3];
if ($idfac > $numfac) {
print("
There are only $numfac factors in your design.
You must specify one of these as the factor to test.
Instead you have specified the nonexistent factor
$idfac. Please correct the data entry form and
resubmit the problem.
");
}
#
# level means
#
#
# pluses in the original input create %2B's. Handle.
#
$fields[4] =~ s/%2B/\+/g;
#
# get rid of everything other than minus signs, plus signs, decimals,
# and digits
#
$fields[4] =~ s/[^-\+\.\d]//g;
#
# get rid of leading pluses
#
$fields[4] =~ s/^[\+]+//;
#
# get rid of trailing pluses
#
$fields[4] =~ s/[\+]+$//;
@fracs = split(/[\+]+/, $fields[4]);
$numfracs = $numlev[$idfac - 1];
$numfracs2 = @fracs;
if ($numfracs2 != $numfracs) {
print("
The number of fractions supplied, $numfracs2,
does not equal the number needed to match the number
of levels in the factor, $numfracs. Please correct
the data entry form.
");
$errflag = 1;
}
#
# Coefficients of variation
#
$fields[5] =~ s/[^\d]//g;
$numcv = $fields[5];
# print("numcv = $numcv
");
#
# pluses in the original input create %2B's. Handle.
#
$fields[6] =~ s/%2B/\+/g;
#
# get rid of everything other than minus signs, plus signs, decimals,
# and digits
#
$fields[6] =~ s/[^-\+\.\d]//g;
#
# get rid of leading pluses
#
$fields[6] =~ s/^[\+]+//;
#
# get rid of trailing pluses
#
$fields[6] =~ s/[\+]+$//;
@cvs = split(/[\+]+/, $fields[6]);
# 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;
}
# $iii = 0;
foreach $temp (@cvs) {
# print("
\$cvs[\$iii] is $cvs[$iii]
");
# if ($temp < 0) {
# $cvs[$iii] = -$temp;
# }
if ($temp == 0) {
print("
Coefficients of variation equal to zero are not permitted.
Please correct the data entry form.
");
$errflag = 1;
}
# $iii += 1;
}
# print("
The cvs are @cvs
");
# print("
");
#
# Power desired
#
$fields[7] =~ s/[^\.\d]//g;
$powerl = $fields[7];
# print("power desired = $powerl
");
if (($powerl <= 0.0) || ($powerl >= 1.0)) {
print("
The desired power must lie between 0.0 and 1.0. Please
correct the data entry form.
");
$errflag = 1;
}
# print("
");
$fields[8] =~ s/results=//;
# print("
The \$fields[8] value is $fields[8].
");
if ($fields[8] eq "") {
$fields[8] = "delme";
}
# print("
The \$fields[8] value is $fields[8].
");
@list = ("/export/home/ftp/pub/tt/",$fields[8]);
$results = join("",@list);
if ($errflag != 1) {
@proglist = ("power.mult","$numfac","@numlev",
"$numrep","$idfac","@fracs",
"$numcv",
"@cvs","$powerl","$results","$fields[8]");
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;
}