";
$form=@form;
for ($count=0; $count/$results/g;
$form[$count]=~s/%%%cginame%%%/$CGINAME/g;
}
print @form;
exit;
}
sub Read_DB {
$result=&Read_File($db_name, *db);
if ($result==-1) { &ERROR("$db_name not found! Please report to Webmaster."); }
#Build Country & Category list
foreach $line (@db) {
($id, $country_field, $category_field, $organisation, $url)=split(/\|/,$line);
foreach $country (split(/,/,$country_field)) {
$temp_country{$country}=1; }
foreach $category (split(/,/,$category_field)) {
$temp_category{$category}=1; }
}
$countrylist_html=""; $categorylist_html="";
@countrylist=(sort keys (%temp_country));
@categorylist=(sort keys (%temp_category));
foreach $country (@countrylist) {
$countrylist_html.="\n";
}
foreach $category (@categorylist) {
$categorylist_html.="\n";
}
}
sub ERROR {
local ($error=@_[0]);
&Print_Header("html");
print $HTMLHEAD;
print "$error\n";
print $HTMLFOOT;
exit;
}
sub Table {
local (@html=@_, $width, $formname, $method, $action, $count, $startpoint, $result);
local ($type, $value, $align);
$width=$html[4];
$formname=$html[1];
$method=$html[3];
$action=$html[2];
$num=$html[0];
$startpoint=5;
$result="
";
$result.="
";
return ($result);
}
#Common Perl routines
# All routines should be able to cater for OS_Type="linux|dos"
# Written by Alex Jeffreys
# Started 08/08/1997.
# V1.00
#
#Start of common routines
#-----------------------
#-----------------------
# Print_Header
#
# if parameter then check for type of:
# txt - plain text
#-----------------------
sub Print_Header {
local ($value=@_[0], $content);
if ($print_header_done==1) { return; }
if (($OS_type eq "linux")||($OS_type eq "dos"))
{
$content="text/html";
if ($value eq "txt") { $content="plain-text"; }
print "Content-type: $content\n";
}
print "\n";
$print_header_done=1;
}
#-----------------------
# Read_File
#
# parameter 1 is filename to read - if not set or file not found then error = -1
# parameter 2 is variable to read the file to (set with *variablename)
# when sucessful, the return value is the # of textlines in the file.
#-----------------------
sub Read_File {
local ($filename);
$filename=@_[0];
*array=@_[1];
if ($filename eq "") { return (-1); }
if (! -e $filename) { return (-1); }
open (filehandle, $filename);
@array=;
close (filehandle);
$filename=@array;
return ($filename);
}
#-----------------------
# View_Form
#
#parameter 1 - title of form
#parameter 2 - HTML contents for form
#-----------------------
sub View_Form {
local ($title=@_[0], $html=@_[1], $width=@_[2]);
if ($width eq "") { $width=400; }
print "
";
print "
";
print "
";
print "$title
";
print "
$html
";
print "
";
print "
";
}
# alexcgi.pl included below:
# MethGet
# Return true if this cgi call was using the GET request, false otherwise
sub MethGet {
return ($ENV{'REQUEST_METHOD'} eq "GET");
}
# MethPost
# Return true if this cgi call was using the POST request, false otherwise
# Alex Jeffreys 03/12/96
sub MethPost {
return ($ENV{'REQUEST_METHOD'} eq "POST");
}
# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections
# Returns TRUE if there was input, FALSE if there was no input
# UNDEF may be used in the future to indicate some failure.
# Now that cgi scripts can be put in the normal file space, it is useful
# to combine both the form and the script in one place. If no parameters
# are given (i.e., ReadParse returns FALSE), then a form could be output.
# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
# information is stored there, rather than in $in, @in, and %in.
sub ParseBack {
local ($pass=@_[0]);
$pass=~s/ /\+/g;
return ($pass);
}
sub ReadParse {
local (*in) = @_ if @_;
local ($i, $key, $val);
# Read in text
if (&MethGet) {
$in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
}
@in = split(/&/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
# Convert %XX from hex numbers to alphanumeric
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;
# Associate key and value
$in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
$in{$key} .= $val;
}
return length($in);
}
# PrintVariables
# Nicely formats variables in an associative array passed as a parameter
# And returns the HTML string.
sub PrintVariables {
local (%in) = @_;
local ($old, $out, $output);
$old = $*; $* =1;
$output .= "
";
$* = $old;
return $output;
}
# PrintVariablesShort
# Nicely formats variables in an associative array passed as a parameter
# Using one line per pair (unless value is multiline)
# And returns the HTML string.
sub PrintVariablesShort {
local (%in) = @_;
local ($old, $out, $output);
$old = $*; $* =1;
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/ /g;
$output .= "$key is $out ";
}
}
$* = $old;
return $output;
}
#-----------------------
# End
# DO NOT REMOVE THE LINE BELOW!!! NEEDED FOR A REQUIRED FILE....
##return true;