#!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 "NIST / SEMATECH Engineering Statistics Course Builder\n"; print "\n"; print '' . "\n"; print ""; print "NIST / SEMATECH Engineering Statistics Course Builder"; print "

\n"; # debugging if ($DEBUG) { print "\n"; print "\n"; foreach $item (sort(keys(%REQUEST))) { print "\n"; } print "
Contents of REQUEST Hash
$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

\n\n"; print "Copying source pages:\n\n\n"; chdir($folder) || print "can't chdir to $folder
\n"; # !!! $| = 1; #unbuffer STDOUT: $| = 1; if ($UNIX) { $package = 'mycourse.tar'; $packcmd = join(" ", $PACKAGER_EXE, $package, sort @files); } else { $, = "\n"; open(LIST, ">ziplist.txt"); print LIST sort @files; close(LIST); $, = ""; $package = 'mycourse.zip'; $packcmd = join(" ", $PACKAGER_EXE, $package, '@ziplist.txt'); } unlink $package if -e $package; #******************DEBUG************************************** &log("**Debug Images ln55x PATH SEPARATOR = ${PATH_SEPARATOR}"); &log("**Debug Images ln57x DOCUMENTROOT= ${DOCUMENT_ROOT}"); #************************************************************ &log("packing command: ${packcmd}"); print "packcmd is ${packcmd}
\noutput from packcmd:
\n
\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 "NIST / SEMATECH Engineering Statistics Course Builder\n"; print "\n"; print '' . "\n"; print "\n\n\n\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 "\n"; print "\n"; # send next boundary print "--" . $MULTIPART_BOUNDARY . "\n"; # push package out to browser 512 bytes at a time open(ZIP, $package); binmode (ZIP) unless ($UNIX); # only on windows?? binmode STDOUT unless ($UNIX); print "Content-type: application/x-tar\n" if ($UNIX); print "Content-type: application/x-zip-compressed\n"; $bytes = (stat($package))[7]; &log("package is ${package} and is ${bytes} bytes"); print "Content-Disposition: attachment; filename=${package}\n"; print "Content-Length: ${bytes}\n\n"; for ($loop=0; $loop <= $bytes; $loop += 512) { read(ZIP, $data, 512); print $data; } binmode ZIP, ":text"; close ZIP; binmode STDOUT, ":text"; print "\n"; } else #if msIE or similar { #print "Content-type: text/html\n"; print "\n"; print "\n"; #print "\n"; #print "NIST / SEMATECH Engineering Statistics Course Builder\n"; #print "\n"; #print '' . "\n"; #print "\n\n\n\n"; print "
"; #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"; print "\n"; print "\n"; } } else { print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "Error Assembling Course\n"; print "\n"; print '' . "\n"; if ($?) { print "

An error occurred while assembling your course:\n"; print "

    $!
\n"; } else { 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() { 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"; print "\n"; print "\n"; if ($#documents == $[ - 1) { print "No pages selected.\n"; } else { print "Your selection:
\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 "

\n"; print "\n"; print "\n"; } sub showDebugInfo { # send response header print "Content-type: text/html\n"; print "\n"; print <<"CONTENT"; button = $REQUEST{'button'}
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"; Course Builder CONTENT } sub showHelp { # send response header print "Content-type: text/html\n"; print "\n"; print <<"CONTENT"; NIST / SEMATECH Engineering Statistics Course Builder

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"; print "NIST / SEMATECH Engineering Statistics Course Builder\n"; print "\n"; print '' . "\n"; print "\n"; print "\n"; print "
"; print ""; print "NIST / SEMATECH Engineering Statistics Course Builder"; 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() { 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 "\n"; # prompt for course title $REQUEST{'coursetitle'} = $REQUEST{'coursetitle'} || 'Engineering Statistics'; print "\n"; print ""; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; for ($j = 0; $j >= 0; $j++) { last unless ($REQUEST{"SOURCE${j}"}); print "\n"; print "\n"; #print "\n"; print "\n"; print "\n"; print "\n"; } print "
Course Title:
 
Page NumberPage Title
${eshnumber}"; if ('introduction:conclusion' =~ $REQUEST{"SOURCE${j}"}) { print " "; } else { print "."; print "."; print "."; print ""; } print "
\n"; print "

Prefix for HTML files: \n"; print ""; print " (three character maximum)

\n"; print " "; print " blank page(s)

"; print "\n"; print "\n"; print "

\n"; 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() { #last if ( ($title) = /(.*)<\/TITLE>/i ); # assumes one-line tag last if ( ($title) = /<TITLE>(.*)/i ); } close(DOC); } $title =~ s```gi; $title =~ s/\t/ /g; $title =~ s/^\s+|\s+$//g; return $title; } # getCookieExpiration returns HTTP header friendly future time sub getCookieExpiration { local ($future, $dd, $mm, $yy, $m); # calculate 60 days into future $future = time + 60 * 24 * 60 * 60; ($dd, $m, $yy) = (gmtime($future))[3,4,5]; $mm = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$m]; return join("-", $dd, $mm, $yy + 1900) . ' GMT'; } # padleft will add leading zeroes, returning four characters sub padleft { return substr('0000' . substr($_[0],0,4), -4, 4); } # naturalvalue is intended to undo padleft sub naturalvalue { return $_[0] + 0; } # getDocNumber returns sort-able aaaa.bbbb.cccc.dddd sub getDocNumber { local ($i, $j, $result); $i = $_[0]; $result = ""; for ($j = "A"; $j le "D"; $j++) { $result .= "." if ($result ne ""); $result .= &padleft($REQUEST{"NUM$i$j"}); } return $result; } # getCleanDocNumber returns view-able a.[b.[c.[d]]] sub getCleanDocNumber { local ($i, $result); $i = $_[0]; # !!! this is pretty sloppy if I say so myself # assemble four digits each with a following decimal $result = &naturalvalue($REQUEST{"NUM${i}A"}) . '.' . &naturalvalue($REQUEST{"NUM${i}B"}) . '.' . &naturalvalue($REQUEST{"NUM${i}C"}) . '.' . &naturalvalue($REQUEST{"NUM${i}D"}) . '.'; # working from the right remove 0.'s if (substr($result, 6, 2) eq '0.') { $result = substr($result, 0, 6); if (substr($result, 4, 2) eq '0.') { $result = substr($result, 0, 4); if (substr($result, 2, 2) eq '0.') { $result = substr($result, 0, 2); if ($result eq '0.') { $result = ""; } } } } return $result; } # sortDocuments changes the %REQUEST hash sub sortDocuments { local ($i, $source, %titles, %sources, %numbers); # first add the aaaa.bbbb.cccc.dddd number to the REQUEST hash # note that un-numbered pages will be 0000.0000.0000.0000 for ($i = 0; $i >= 0; $i++) { $source = $REQUEST{"SOURCE${i}"}; last unless ($source); $REQUEST{"NUM${i}"} = &getDocNumber($i); if ($REQUEST{"NUM${i}"} eq '0000.0000.0000.0000') { if ($source eq 'introduction') { $REQUEST{"NUM${i}"} = '0000.0000.0000.0000'; } elsif ($source eq 'conclusion') { $REQUEST{"NUM${i}"} = '9999.9999.9999.9999.9999'; } else { # make this un-numbered document unique: 9999.9999.9999.9999.???? $REQUEST{"NUM${i}"} = '9999.9999.9999.9999.' . &padleft($i); } } # copy information into sortable hashes $numbers{$REQUEST{"NUM${i}"}} = $i; $sources{$REQUEST{"NUM${i}"}} = $source; $titles{$REQUEST{"NUM${i}"}} = $REQUEST{"TITLE${i}"}; } #print "Content-type: text/html\n\n"; #print "
";
    #foreach $key (sort(keys(%REQUEST)))
    #    { print "$key\t=\t$REQUEST{$key}\n"; }
    #print "

"; # 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 "

";
    #foreach $key (sort(keys(%REQUEST)))
    #    { print "$key\t=\t$REQUEST{$key}\n"; }
    #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
\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 } } }