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

# File Name: power.2.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.

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

"); $errflag = 1; } # # Coefficients of variation # $fields[6] =~ s/[^\d]//g; $numcv = $fields[6]; # print("numcv = $numcv
"); # # 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/[\+]+$//; @cvs = split(/[\+]+/, $fields[7]); # 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[8] =~ s/[^\.\d]//g; $powerl = $fields[8]; # 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[9] =~ s/results=//; # print("
The \$fields[9] value is $fields[9].
"); if ($fields[9] eq "") { $fields[9] = "delme"; } # print("
The \$fields[9] value is $fields[9].
"); @list = ("/export/home/ftp/pub/tt/",$fields[9]); $results = join("",@list); if ($errflag != 1) { @proglist = ("power.2","$numfac","@numlev", "$numrep","$idfac","$numdiff", "@diffs","$numcv", "@cvs","$powerl","$results","$fields[9]"); 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; }