# MTT's PERL and CGI libary functions
# Michael Toppa - mike@toppa.com
# v1 June 1998
#
# v2 March 1999
# * CleanInput: added ability to replace linefeeds with spaces;
# handling for additional special characters
# * GetDate: complete re-write to supply multiple date formats
# * FileRead: added ability to send data to CGIError
#
# v3 February 2000
# General code cleanup and...
# * ParseInput: changed default separator to the more conventional comma;
# accepts GET and POST only in capitals (conforms to HTTP)
# * CleanInput: added ability to explicitly request conversion of special
# characters to entities
# * DateTime: complete rewrite of former GetDate routine
# * FileRead: improved error message handling
# Here you'll find the following routines:
# ParseInput - Parses name-value pairs from GET or POST input into the
# associative array %in. Optionally accepts a string for use as a seperator
# for multiple values associated with a single name. Defaults to "," if
# no string is defined.
#
# CleanInput - Removes Control-M's from TEXTAREA input, and accepts values
# for these local variables:
# 1. $input = "the input text" (required)
# 2. $linefeed = '0' : leave linefeeds as is (default)
# $linefeed = 'br' : replace single linefeeds with
tags
# $linefeed = 'br_feed' : add
tags to single linefeeds
# $linefeed = 'p' : replace double linefeeds with tags, delete single linefeeds
# $linefeed = 'p_feed' : add
tags to double line feeds
# $linefeed = 'strip' : replace all linefeeds with spaces
# 3. $special = '0' : leave special characters as is (default)
# $special = '1' : convert special characters to HTML entities (incl. MS Word)
# 4. $hypertext = '0' : do not add hyperlinks (default)
# $hypertext = '1' : add hyperlinks to URLs and mailto hyperlinks to email addresses
# 5. $nohtml = '0' : leave <, >, &, and " characters as is (default)
# $nohtml = '1' : replace <, >, &, and " characters with entities
#
# HTMLTop - Returns the top of an HTML documet, including the Content-type.
# Optionally accepts values for these local variables:
# 1. $title = e.g. 'A Title'
# default = none
# 2. $body = e.g. '
'
# default = ''
# 3. $font = e.g. "'
# default = ''
# 4. $header = e.g. 'a header
'
# default = none
#
# HTMLBottom - Returns the bottom of an HTML document.
#
# CGIError - Returns an HTML error page for a CGI error, and exits the script.
# Optionally accepts values for these local variables:
# 1. $message = e.g. 'a specific error message'
# default = 'This application has encountered an internal error. Please
# contact this web server\'s Webmaster or System Administrator for assistance.'
# 2. $header = e.g. 'A Header'
# default = 'Error'
# Used as the and an <H2> header.
# 3. $body = e.g. '<BODY BGCOLOR="#FFFF00">'
# default = '<BODY BGCOLOR="#FFFFFF" TEXT="#000000">'
# 4. $font = e.g. "<FONT SIZE="4">'
# default = '<FONT FACE="Arial,Helvetica" SIZE="2">'
# 5. @errors = e.g. '("Your Name", "Your Email Address", etc...)
# default = none
# The array elements are listed in a <UL> list - this is useful for
# listing required fields left blank in an input form.
#
# DateTime - Returns the current date or time. Optionally accepts a value for
# the following local variable:
# 1. $format = 'dateshort' returns 'MM/DD/YY' (default)
# 2. $format = 'datelong' returns 'Month DD, YYYY'
# 3. $format = 'day' returns 'Day'
# 4. $format = 'timeshort' returns HH:MM AM/PM
# 5. $format = 'timelong' returns HH:MM:SS AM/PM
# 6. $format = 'milshort' returns HH:MM
# 7. $format = 'millong' returns HH:MM:SS
#
# FileRead - opens a file in read mode, reads the lines into the array, and returns
# them in an array. All of the optional values listed below are used only for
# error message formatting (uses CGIError defaults if they are not supplied). Accepts:
# 1. $file = the pathname of the file to open (required)
# 2. $message = e.g. 'a specific error message'
# 3. $header = e.g. 'a header' (optional)
# 4. $body = e.g. '<BODY BGCOLOR="#FFFF00">' (optional)
# 5. $font = e.g. '<FONT SIZE="4">' (optional)
sub ParseInput {
local ($separator) = @_;
local (@pairs, $name, $value, $error);
$separator = "," unless ($separator);
if ($ENV{'REQUEST_METHOD'} eq "GET") {
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
}
else {
&CGIError("The METHOD of your Form must be either GET or POST");
}
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Add each pair to the associative array %in.
# Use $separator to separate multiple values.
if ($in{$name}) {
$in{$name} = "$in{$name}" . "$separator" . "$value";
}
else {
$in{$name} = $value;
}
}
}
sub CleanInput {
if (@_) {
local ($input, $linefeed, $special, $hypertext, $nohtml) = @_;
}
else {
&CGIError ("You must specify input text to use the CleanInput subroutine");
}
# Remove pesky control-M's.
$input =~ s/\cM\n/\n/g;
# If we don't want to allow HTML, convert HTML syntax to
# their harmless HTML entity equivalents.
if ($nohtml) {
$input =~ s/\&/\&\;/g;
$input =~ s/</\<\;/g;
$input =~ s/>/\>\;/g;
$input =~ s/"/\"\;/g;
}
# Replace special characters with HTML entities if requested.
if ($special) {
$input =~ s/¾/\&\#190\;/g;
$input =~ s/”/\"\;/g;
$input =~ s/“/\"\;/g;
$input =~ s/\–/\&\#151\;/g;
$input =~ s/·/\&\#183\;/g;
$input =~ s/\’/\'/g;
$input =~ s/—/\&\#151\;/g;
# Typical text conversions of MSWord "trademark" symbol
$input =~ s/\™/\&\#153\;/g;
$input =~ s/\Ô/\&\#153\;/g;
$input =~ s/\ä/\&\#153\;/g;
# Typical text conversions of MSWord "registered" symbol
$input =~ s/\®/\&\#174\;/g;
$input =~ s/\Ò/\&\#174\;/g;
$input =~ s/\â/\&\#174\;/g;
# Typical text conversions of MSWord "copyright" symbol
$input =~ s/\ã/\©\;/g;
}
# Handle line breaks as requested.
$input =~ s/\n/<BR>/g if ($linefeed eq "br");
$input =~ s/\n/\n<BR>/g if ($linefeed eq "br_feed");
$input =~ s/\n[\r\t\f ]*\n/<P>/g if ($linefeed eq "p");
$input =~ s/\n//g if ($linefeed eq "p");
$input =~ s/\n[\r\t\f ]*\n/\n\n<P>/g if ($linefeed eq "p_feed");
$input =~ s/\n/ /g if ($linefeed eq "strip");
# Add hyperlinks to URLs and mailto's, if requested.
if ($hypertext) {
$input =~ s/\bhttp:\/\/\S*\.\S*\b/<A HREF="$&">$&<\/A>/g;
$input =~ s/\b\S*\@\S*\.\S*\b/<A HREF="mailto:$&">$&<\/A>/g;
}
return $input;
}
sub HTMLTop {
local ($title, $body, $font, $header) = @_;
$body = '<BODY BGCOLOR="#FFFFFF" TEXT="#000000">' unless ($body);
$font = '<FONT FACE="Arial,Helvetica" SIZE="2">' unless ($font);
print "Content-type: text/html\n\n";
print "<HTML>\n<HEAD>\n";
print "<TITLE>$title\n";
print "\n";
print "$body\n";
print "$font";
print "$header\n" if ($header);
}
sub HTMLBottom {
print "\n\n