#!/usr/local/bin/perl
# www_pl - perl subroutines for use w/WWW development
#
# by: Eric Hall
# date: 8/11/94
#
# desc: this file contains many useful and reusable subroutines
#
# Enjoy,
# --eric hall
# --ehall1@duck.ford.com
# heavily modified by Sunil
################################################################
################################################################
# perl script has to do something
################################################################
$caption_length=17;
$pad_string=' ';
$has_blank_item=1;
$list_is_sorted=1;
################################################################
#used for alphabetical sorts
################################################################
sub alpha { $a cmp $b; }
%tags;
################################################################
#parses the standard input (STDIN) and generates
#an associative array called %FORM w/the key=input box name
#and value=what user typed into input box
################################################################
sub GET_FIELDS {
local($name,$value,$pair,$buffer,@pairs,%FORM);
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
#want to skip submissions of default values
next if (grep(/\?\?\?\?\?/,$value));
# Stop people from using subshells to execute commands
# Not a big deal when using sendmail, but very important
# when using UCB mail (aka mailx).
$value =~ s/~!/ ~!/g;
$value =~ s/\240/ /g;
$FORM{$name} = $value;
}
return (%FORM);
} #end sub GET_FIELDS
################################################################
#generates required header
#call w/title of page and recognition list
################################################################
sub PRINT_HEADER {
local($title, @flist) = @_;
print "Content-type: text/html\n\n";
print "\n";
print "\n";
if (@flist[0] ne "") { &PRNREC(@flist); }
print "$title\n";
print "\n";
print "\n";
print "\n";
} #end sub PRINT_HEADER
################################################################
#generates footer to file
################################################################
sub PRINT_FOOTER {
print "\n";
print "\n";
print "\n";
print "\n";
print "\n";
} #end sub PRINT_FOOTER
################################################################
#generates a recognition header
################################################################
sub PRNREC {
local($fname,$ftease,$fauth,$fdesc) = @_;
print "\n";
print "\n\
n";
print "\n\
n";
} #end sub PRNREC
################################################################
# whats the name of our server?
################################################################
sub get_username
{
$answer = $ENV{"REMOTE_IDENT"};
}
sub get_this_URL
{
local ($server,$server_port,$scriptname);
$server = $ENV{"SERVER_NAME"};
$server_port = $ENV{"SERVER_PORT"};
if ($server_port ne "80")
{
$server .= ":" . $server_port;
}
$scriptname = $ENV{"SCRIPT_NAME"};
$answer = "http://$server$scriptname";
}
################################################################
# generate a