#!c:/Perl/bin/Perl.exe # NIST/SEMATECH Engineering Statistics Handbook Course Material Browser require 5; #this scrip requires perl version 5 or greater use File::Copy; #*************CONFIGURATION VARIABLES***************************** # URL for handbook's starting page without http://server/ $HANDBOOK_URL = '/index.html'; # working directory $SCRATCH_DIRECTORY = '/tmp'; #if its UNIX use /tmp else \tmp # navigation bar image directory (real operating system directory) $NAVGIFDIR = 'cbuild'; #don't use foward slash "/" at the end, this it the navigation image folder # is operating system unix? this is to choose between TAR and ZIP file. # $UNIX = 1; # 1 = TRUE, 0 = FALSE $UNIX = 0; # 1 = TRUE, 0 = FALSE # operating system command to package many files into one # $PACKAGER_EXE = 'tar -cvf '; # for Unix/Linux platforms $PACKAGER_EXE = 'wzzip '; #******************************************************************** # navigation bar copyright statement (appears in footer) $NAVCOPYRIGHT = '© Copyright Advanced Micro Devices, Inc., 1998'; # navigation bar file names $NAVGIFLOGO = 'c-logo.gif'; $NAVGIFNEXT = 'c-next.gif'; $NAVGIFBACK = 'c-back.gif'; $VERSION = '1.08.08.03.1120'; # version #.date of last modified ex ver 1,Aug,05,03,time #with the use of the module File::Copy the path separator is sytem independent.. alway use "/" $PATH_SEPARATOR = "/"; umask 000; # determine script name $SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || ${0}; $DOCUMENT_ROOT = $ENV{'DOCUMENT_ROOT'} || '.'; # read information from client &parseCookies; &parseRequest; &check_browser; # debugging $DEBUG = $ENV{"DEBUG"} || $REQUEST{"debug"} || 0; # determine whether user has already started building a course $myCourse = $COOKIES{'ESH-Course'}; unless (defined($myCourse)) { # generate "unique" course identifier $myCourse = time; } # determine action if (! defined($REQUEST{'action'})) { # initial view or reload &showFrameset; } elsif ($REQUEST{'action'} eq "add") { # add selected document to course &addDocument; &showCourse; } elsif ($REQUEST{'action'} eq "delete") { # delete selected document from course &deleteDocument; &showCourse; } elsif ($REQUEST{'action'} eq "list") { # list course &showCourse; } elsif ($REQUEST{'action'} eq "clear") { # delete course &deleteCourse; # generate new "unique" course identifier $myCourse = time; &showCourse; } elsif ($REQUEST{'action'} eq "help") { # display introductory help page &showHelp; } elsif ($REQUEST{'action'} eq "controls") { # display control buttons &showControls; } elsif ($REQUEST{'action'} eq "step2") { if ($REQUEST{'button'} eq "Next >>") { &showResults; } elsif ($REQUEST{'button'} eq "Add") { &addBlankDocuments; &showResults; } elsif ($REQUEST{'button'} eq "Sort") { &sortDocuments; &showResults; } elsif ($REQUEST{'button'} eq "Assemble") { &sortDocuments; &assembleCourse; } else { print $REQUEST{'button'}; } } elsif ($REQUEST{'action'} eq "debug") { # display debugging information &showDebugInfo; } exit; ############################################################################### # top-level subroutines # ############################################################################### sub addDocument { # identify local file to update local $myCourseFileName = &getCourseFileName(${myCourse}); # ensure we have the document title (in case JavaScript failed to get it) if (! defined($REQUEST{'selectedDocTitle'}) || $REQUEST{'selectedDocTitle'} eq "undefined") { $REQUEST{'selectedDocTitle'} = &getDocTitle($REQUEST{'selectedDoc'}); } # construct line to write to document local $line = join("\t", $REQUEST{'selectedDocTitle'}, $REQUEST{'selectedDoc'}); # append line to file open(LIST, ">>$myCourseFileName"); print LIST $line; print LIST "\n"; close(LIST); } sub assembleCourse { local $document; local $title; local $i = 10000; local $folder; local @contents; local ($source, $destination); local ($pageprefix, $coursetitle); local @files; local %seen; local %remap; local $time = time(); &log("Received assemble request for course ${myCourse} ver= ${VERSION} time=${time}"); $pageprefix = $REQUEST{'pageprefix'} || 'esh'; $coursetitle = $REQUEST{'coursetitle'} || 'Engineering Statistics'; $MULTIPART_BOUNDARY = "Mayhem's-Wild-Goose-Chase-$$" ; # send overall response header print "Content-type: multipart/mixed; boundary=${MULTIPART_BOUNDARY}\n" ; #print "Content-type: text/html\n" unless ($browser); print "Set-cookie: ESH-Course=${myCourse}; expires=" . &getCookieExpiration . "\n"; print "\n"; # send text portion response header print "--" . $MULTIPART_BOUNDARY . "\n" if ($browser); #print ""; print "Content-type: text/html\n"; print "\n"; print "\n"; print "
\n"; print "\n"; # debugging if ($DEBUG) { print "
| $item | $REQUEST{$item} |
\n";
}
# make scratch directory for user
$folder = join($PATH_SEPARATOR, $SCRATCH_DIRECTORY, "ESH-${myCourse}");
print "folder is ${folder}
\n" if ($DEBUG);
if (-e $folder)
{
print "folder already exists
\n" if ($DEBUG);
if (-d $folder)
{
print "folder is a directory
\n" if ($DEBUG);
opendir(F, $folder);
@contents = grep(!/^\.\.?$/, readdir(F));
closedir(F);
foreach $file (@contents)
{
$file = join($PATH_SEPARATOR, $folder, $file);
unlink($file);
}
}
else
{
print "folder is not a directory
\n" if ($DEBUG);
print "removing it
\n" if ($DEBUG);
unlink($folder);
print "making folder
\n" if ($DEBUG);
mkdir($folder, 0755);
print "status: $!
\n" if ($? && $DEBUG);
}
}
else
{
print "making folder
\n" if ($DEBUG);
mkdir($folder, 0755);
print "status: $!
\n" if ($? && $DEBUG);
}
&log("Assembling course in ${folder}");
# copy navigation images
print "Copying navigation images:\n
| $newtitle |
\n\n";
$j = 1; # skip introduction
while (1)
{
if ($REQUEST{"TITLE${j}"})
{
last if ($REQUEST{"SOURCE${j}"} eq "conclusion");
$jthis = substr($j+10000, $[ + 1, 4);
$cleandocnumber = &getCleanDocNumber($j);
print D $cleandocnumber . ' ' if ($cleandocnumber);
print D '';
print D $REQUEST{"TITLE${j}"};
print D '
';
print D "\n";
}
else
{
last;
}
$j++;
}
print D "
\n\n";
$j = 1; # skip introduction
while (1)
{
if ($REQUEST{"TITLE${j}"})
{
last if ($REQUEST{"SOURCE${j}"} eq "conclusion");
$jthis = substr($j+10000, $[ + 1, 4);
$cleandocnumber = &getCleanDocNumber($j);
print D $cleandocnumber . ' ' if ($cleandocnumber);
print D '';
print D $REQUEST{"TITLE${j}"};
print D '
';
print D "\n";
}
else
{
last;
}
$j++;
}
print D "\n
Any questions?\n\n"; print D "
\n" if ($DEBUG);
open(CMD, "$packcmd |");
while() { $line = $_; print $line if ($DEBUG); &log($line); }
close(CMD);
print " \n" if ($DEBUG);
# pause if debugging
sleep(10) if ($DEBUG);
# done with text portion response header, #note the boundary only works on Mozilla, not msIE
print "--" . $MULTIPART_BOUNDARY . "\n" if ($browser);
#link
my $linkzip = join($PATH_SEPARATOR, $folder, $package);
&log("Link: ${linkzip}") unless ($browser);
# push out the file directly
if (-e $package)
{
if ($browser) #if nescape or mozilla
{
# last step
print "Content-type: text/html\n";
print "\n";
print "\n";
print "\n";
print "| ";
print "";
print "NIST / SEMATECH Engineering Statistics Course Builder";
print " \n"; print "Unpack the course file into its own directory, "; print "and open the first HTML document, "; print "${pageprefix}0000.htm, "; print "to view the course.\n"; print "Download again"; print " | \n
| ";
#print "";
#print "NIST / SEMATECH Engineering Statistics Course Builder";
#print " \n"; print "Download the file below and unpack the course file into its own directory, "; print "and open the first HTML document, "; print "${pageprefix}0000.htm, "; print "to view the course.\n"; print "Download here" ; print " | \n
An error occurred while assembling your course:\n"; print "
Unable to find ${package}\n";
}
print "\n";
print "\n";
}
# send final boundary
print "--" . $MULTIPART_BOUNDARY . "--" . "\n" if ($browser);
}
sub deleteCourse
{
# identify local file to update
local $myCourseFileName = &getCourseFileName(${myCourse});
# remove local file
unlink $myCourseFileName if (-e $myCourseFileName);
}
sub deleteDocument
{
# identify local file to update
local $myCourseFileName = &getCourseFileName(${myCourse});
return unless (-e $myCourseFileName);
local @documents;
local $document;
local $title;
local $i = 10000;
# read lines into documents array
open(LIST, $myCourseFileName);
while( \n";
print "\n";
print "\n";
}
sub showDebugInfo
{
# send response header
print "Content-type: text/html\n";
print "\n";
print <<"CONTENT";
Browse the Table of Contents in the upper left hand corner.
Use the "Add Page" button below to include
the page you are browsing to your course materials.
Your course selection will appear in the lower left hand corner.
When finished selecting pages, use the "Next >>" button.
CONTENT
}
sub showResults
{
# send response header
print "Content-type: text/html\n";
print "Set-cookie: ESH-Course=$myCourse; expires=" . &getCookieExpiration . "\n";
print "\n";
print "\n";
print " \n";
# identify local file to update
local $myCourseFileName = &getCourseFileName(${myCourse});
local @documents;
local $document;
local $title;
local $i = 10000;
local $j;
local $pageprefix;
$pageprefix = $REQUEST{'pageprefix'} || 'esh';
# !!! this is a bit delicate --
# !!! if you add a button you may need to register it here
if ($REQUEST{'button'} eq "Sort" || $REQUEST{'button'} eq "Add")
{
}
else
{
# if file exists, read lines into documents array
$j = 10000;
if (-e $myCourseFileName)
{
open(LIST, $myCourseFileName);
while( ";
# sort the hashes back into the REQUEST "arrays"
$i = 0;
foreach $number (sort(keys(%numbers)))
{
$REQUEST{"SOURCE${i}"} = $sources{$number};
$REQUEST{"TITLE${i}"} = $titles{$number};
if ($REQUEST{"SOURCE${i}"} ne 'conclusion' &&
substr($number, 0, 20) eq '9999.9999.9999.9999.')
{
$REQUEST{"NUM${i}A"} = '';
$REQUEST{"NUM${i}B"} = '';
$REQUEST{"NUM${i}C"} = '';
$REQUEST{"NUM${i}D"} = '';
}
else
{
$REQUEST{"NUM${i}A"} = &naturalvalue(substr($number, 0 * 5, 4));
$REQUEST{"NUM${i}B"} = &naturalvalue(substr($number, 1 * 5, 4));
$REQUEST{"NUM${i}C"} = &naturalvalue(substr($number, 2 * 5, 4));
$REQUEST{"NUM${i}D"} = &naturalvalue(substr($number, 3 * 5, 4));
}
$i++;
}
#print " ";
}
# addBlankDocuments adds blank placeholder pages
sub addBlankDocuments
{
local ($i, $j, $k);
local ($blankpages, $first_insert_page);
local ($conclusion_title);
# determine number of existing pages
$blankpages = 0;
for ($i = 0; $i >= 0; $i++)
{
$source = $REQUEST{"SOURCE${i}"};
last unless ($source);
if ($source eq 'conclusion')
{
$conclusion_title = $REQUEST{"TITLE${i}"};
$first_insert_page = $i;
}
else
{
$blankpages += 1 if ($source =~ 'blank');
}
}
# fix empty addlpages form element
$REQUEST{'addlpages'} = 1 unless ($REQUEST{'addlpages'});
$REQUEST{'addlpages'} += 0;
# do the insert
for ($i = 1; $i <= $REQUEST{'addlpages'}; $i++)
{
print "$i)
{
chomp($line = $_);
next if ($line eq "");
# have to slip numeric counter in to maintain order
push(@documents, join("\t", $i++, $line));
}
close(LIST);
# continue only if there are documents
return if ($#documents == $[ - 1);
# starting at bottom, remove element containing selected doc
# !!! this isn't necessarily the right instance if the selected doc
# !!! occurs more than once in the user's list
foreach $item (reverse(sort(@documents)))
{
if ($item =~ $REQUEST{'selectedDoc'})
{
# !!!
$item = "blorf";
last;
}
}
# remove local file
unlink $myCourseFileName if (-e $myCourseFileName);
# now write them back out to the file
open(LIST, ">$myCourseFileName");
foreach $item (sort(@documents))
{
next if ($item eq "blorf");
($i, $title, $document) = split("\t", $item);
print LIST $title, "\t", $document, "\n";
}
close(LIST);
}
sub showChapters
{
# send response header
print "Content-type: text/html\n";
print "\n";
print <<"CONTENT";
CONTENT
}
sub showControls
{
# send response header
print "Content-type: text/html\n";
print "\n";
print <<"CONTENT";
CONTENT
}
sub showCourse
{
# identify local file to update
local $myCourseFileName = &getCourseFileName(${myCourse});
local @documents;
local $document;
local $title;
local $i = 10000;
# if file exists, read lines into documents array
if (-e $myCourseFileName)
{
open(LIST, $myCourseFileName);
while(
)
{
chomp($line = $_);
next if ($line eq "");
# have to slip numeric counter in to maintain order
push(@documents, join("\t", $i++, $line));
}
close(LIST);
}
# send response header
print "Content-type: text/html\n";
print "Set-cookie: ESH-Course=$myCourse; expires=" . &getCookieExpiration . "\n";
print "\n";
print "\n";
print "\n";
# note the links must be displayed in the display frame
print "
\n";
foreach $item (sort(@documents))
{
chomp($item);
($i, $title, $document) = split("\t", $item);
print "$title";
print "
\n";
}
}
# the URL that got us here will contain a within-document name
print "
action = $REQUEST{'action'}
selectedDoc = $REQUEST{'selectedDoc'}
selectedDocTitle = $REQUEST{'selectedDocTitle'}
ESH-Course = ${myCourse}
CONTENT
}
sub showFrameset
{
# send response header
print "Content-type: text/html\n";
print "Set-cookie: ESH-Course=$myCourse; expires=" . &getCookieExpiration . "\n";
print "\n";
print <<"CONTENT";
\n";
print "
\n";
#print " \n";
print "";
print "";
print "NIST / SEMATECH Engineering Statistics Course Builder";
print " )
{
chomp($line = $_);
next if ($line eq "");
# have to slip numeric counter in to maintain order
push(@documents, join("\t", $j++, $line));
}
close(LIST);
}
# copy file into form-like arrays
$i = 1; # in case they didn't select anything
foreach $item (sort(@documents))
{
chomp($item);
next if ($item eq "");
($j, $title, $document) = split("\t", $item);
($eshnumber, $eshtitle) = split(" ", $title, 2);
$eshtitle =~ s/^\s+|\s+$//g; # remove leading and trailing spaces
#$i = &naturalvalue($i);
$REQUEST{"SOURCE${i}"} = $document;
$REQUEST{"TITLE${i}"} = $eshtitle;
$i++;
}
$REQUEST{"SOURCE0"} = 'introduction';
$REQUEST{"TITLE0"} = 'Course Introduction';
$REQUEST{"SOURCE${i}"} = 'conclusion';
$REQUEST{"TITLE${i}"} = 'Course Conclusion';
}
print "\n";
print "
";
#foreach $key (sort(keys(%REQUEST)))
# { print "$key\t=\t$REQUEST{$key}\n"; }
#print "";
print "\n";
print "\n";
}
###############################################################################
# secondary-level subroutines #
###############################################################################
# getCourseFileName converts course ID (cookie) into physical data file name
sub getCourseFileName
{
local $identifier = $_[0];
local $result;
# ensure that the holding directory exists, make it if necessary
mkdir($SCRATCH_DIRECTORY, 0775)
unless (-e $SCRATCH_DIRECTORY && -d _);
# !!! should verify that it worked and report failure
# assemble filename
$result = join($PATH_SEPARATOR, $SCRATCH_DIRECTORY, "ESH-${identifier}.dat");
return $result;
}
# getDocTitle reads between the TITLE tags to return page title
sub getDocTitle
{
local $document = $_[0];
local $title;
$realname = join($PATH_SEPARATOR, $DOCUMENT_ROOT, $document);
if (-e $realname)
{
open(DOC, $realname);
while(";
#foreach $key (sort(keys(%REQUEST)))
# { print "$key\t=\t$REQUEST{$key}\n"; }
#print "";
#foreach $key (sort(keys(%REQUEST)))
# { print "$key\t=\t$REQUEST{$key}\n"; }
#print "
\n";
$j = $first_insert_page + $i - 1; # form element number (starts w/zero)
$k = $blankpages + $i; # document/cosmetic number (starts w/one)
print "j = $j, k = $k
\n";
$REQUEST{"SOURCE${j}"} = "blank${k}";
$REQUEST{"TITLE${j}"} = "Placeholder Page ${k}";
$REQUEST{"NUM${j}A"} = "";
$REQUEST{"NUM${j}B"} = "";
$REQUEST{"NUM${j}C"} = "";
$REQUEST{"NUM${j}D"} = "";
}
# restore conclusion page using $j leftover from for loop
$j++;
$REQUEST{"SOURCE${j}"} = "conclusion";
$REQUEST{"TITLE${j}"} = $conclusion_title;
}
# write to log file
sub log
{
local $message;
local $logfile;
chomp($message = $_[0]);
$logfile = join($PATH_SEPARATOR, $SCRATCH_DIRECTORY, 'course-builder.log');
if (-e $logfile)
{ open(LOG, ">>$logfile"); }
else
{ open(LOG, ">$logfile"); }
print LOG "$message\n";
close(LOG);
return;
}
###############################################################################
# generic CGI utilities #
###############################################################################
# generic CGI utility to store form data in %REQUEST
sub parseRequest
{
local ($request, @nvpairs, $name, $value);
# put form data into $request
if ($ENV{'REQUEST_METHOD'} eq "POST")
{ read(STDIN, $request, $ENV{'CONTENT_LENGTH'}); }
else
{ $request = $ENV{'QUERY_STRING'}; }
# convert $request into hash %REQUEST
@nvpairs = split(/&/, $request);
foreach (@nvpairs)
{
($name, $value) = split(/=/, $_);
$name =~ tr/+/ /;
$value =~ tr/+/ /;
$name =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
$value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
$value =~ s/;/$$/g;
$value =~ s/&(\S{1,6})$$/&$1;/g;
$value =~ s/$$/ /g;
$value =~ s/\|/ /g;
$value =~ s/^!/ /g;
next if ($value eq "");
$REQUEST{$name} .= ", " if ($REQUEST{$name});
$REQUEST{$name} .= $value;
}
} # end parse_request
# generic CGI utility to store cookies in %COOKIES
sub parseCookies
{
local @key_value_pairs = ();
local $key_value;
local $key;
local $value;
@key_value_pairs = split(/;\s/, $ENV{'HTTP_COOKIE'});
foreach $key_value (@key_value_pairs)
{
($key, $value) = split(/=/, $key_value);
$key =~ tr/+/ /;
$value =~ tr/+/ /;
$key =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
next if ($value eq "");
if (defined($COOKIES{$key}))
{
$COOKIES{$key} = join ("\0", $COOKIES{$key}, $value);
}
else
{
$COOKIES{$key} = $value;
}
}
} # end parse_cookies
sub check_browser
{
$browser = 0; #MSIE / AOL
if ($ENV{'HTTP_USER_AGENT'} =~ /Mozilla/i)
{
if ($ENV{'HTTP_USER_AGENT'} !~ /MSIE/i and $ENV{'HTTP_USER_AGENT'} !~ /opera/i)
{
$browser = 1; #Netscape
}
}
}