Perl and CGI (Common Gateway Interface)


What is CGI ?

CGI is known as the Common Gateway Interface. CGI is supported by most web servers. CGI is a way of executing content on a web server dynamically where information can be read from and written to a web server. To a certain extent CGI has been superceded by Java Servlets and the IIS/ASP combination. CGI applications are generally written either in C or Perl. C is highly complex, requires extensive skills and a prolonged development effort. Perl (Practical Extraction and Report Language) is a highly sophisticated text parser (much like Tawk and Awk). A text parser is a tool which will search through text for expected patterns (words and word combinations, etc). Both Perl and C have extremely fast execution times.

CGI does have a disadvantage. For each client requesting a CGI web page a new process must be created on the server. This involves high usage of server resources and processing time. This problem is exacerbated when many clients access a web page at once. Internet Server API uses DLL's and does tend to solve this over usage of the web server to a certain extent. Java Servlets and the IIS/ASP combination do tend to offer good solutions to this problem of high useage of server resources.

Note that Perl is a much more capable tool that shown on this web page. Perl is capable of the following functions

  1. Dynamic web page generation and communcation.
  2. Highly sophisticated Text parsing.
  3. Database communication.
  4. Perl is the type of scripting language with which anything can be done given enough imagination.

An HTML Web Page Generator Using Perl

Below is an example Perl script. This script will add comments to an HTML file. The HTML file is passed in as a parameter in the $source variable and the comments file is stored in the $comments variable.

$source = shift;
$comments = shift;
$type = shift;
$title = shift;

@cArray = ();
%cList = ();
$line = 0;
$previous = "";

if (&openFiles() == 1)
{

	print "<HTML>\n";
	print "<HEAD>\n";
	print "<TITLE>$type $title</TITLE>\n";
	print "</HEAD>\n";
	print "<BODY>\n";
	print "<PRE>\n";

	if ($cList{$line} ne "")
	{
		print "<CENTER>\n";
		print "<HR>\n";
		print "<H1>$type</H1>\n";
		print "<HR>\n";
		print "<H1>$title</H1>\n";
		&wrapInTable("red");
		print "</CENTER>\n";
	}

	while (<perlScript>)
	{
		chomp($_);
		if ($_ eq "" && $previous eq "" && $line > 0) {}
		else
		{
			$line = $line + 1;
			print "<FONT COLOR=\"blue\"><B>".&pad($line,4,"0")."</B></FONT> : $_";
			if ($cList{$line} ne "")
			{
				if ($_ ne "")
				{
					print " <FONT COLOR=\"green\"><B>//".$cList{$line}."</B></FONT>";
				}
				else
				{
					&wrapInTable("green");
				}
			}
			print "\n";
		}
		$previous = $_;
	}

	print "<HR>\n";
	print "</PRE>\n";
	print "</BODY>\n";
	print "</HTML>\n";
	
}
closeFiles();

sub wrapInTable()
{
	local($col) = @_;

	print "<HR>\n";
	print "<TABLE CELLSPACING=\"0\" CELLPADDING=\"0\" WIDTH=\"800\">\n";
	print "<TR><TD>\n";
	print "<FONT COLOR=$col><B>\n";
	print "$cList{$line}\n";
	print "</B></FONT>\n";
	print "</TD></TR>\n";
	print "</TABLE>\n";
	print "<HR>\n";
}

sub pad
{
	local($val, $count, $filler) = @_;
	my($i);

	for ($i = length($val); $i < $count; $i++)
	{
		$val = "$filler$val";
	}
	return ($val);
}

sub openFiles
{
	if (open(perlScript, $source) != 1)
	{
		print "Error opening file $source : $!\n";
		$cmdout = <dis>;
		close(dis);
		return 0;
	}

	if (open(commentsFile, $comments) != 1)
	{
		print "Error opening file $comments $!\n";
		$cmdout = <dis>;
		close(dis);
	}

	@cArray = <commentsFile>;
	$len = @cArray;

	$x = 0;
	while ($cArray[$x] ne "")
	{
		if ($cArray[$x] =~ /^(\d*) : (.*)$/i) { $cList{$1} = $2; }
		$x = $x + 1;
	}

	#print "length = $len<BR>\n<BR>\n<HR>\n"; $x = 0; while ($cArray[$x] ne "") { print "$x : $cArray[$x]<BR>\n"; $x = $x + 1;}
	#print "<BR>\n<HR>\n<BR>\n";
	#foreach $key (sort keys %cList) { print "$cList{$key}<BR>\n"; }

	return 1;
}

sub closeFiles
{
	close (perlScript);
	close (commentsFile);
}

Pattern Matching in Perl

Perl is an excellent language for text pattern matching, for instance, with natural language parsing. The variable IN is an input parameter into the Perl script and contains the name of a file.

open (IN, shift);
while (<IN>)
{

	if ($_ =~ /^.* (\d*) .*Match.*this.*$/i)
	{
		if ($_ =~ /^\S* \S*-\S* \S*:\S*:\S* \s* (\d*) .*Backup (\S*) to (\S*) .*$/i)
		{
			print "$1 $2 $3\n";
		}						
	}

	if ($_ =~ /^.* (\d*) .* and .* this sentence.*$/i)
	{
		if ($_ =~ /^\S* \S*-\S* \S*:\S*:\S* \s* (\d*) \s* (\S*) files (\S*) KB written to \S* @ (\S*).*$/i)
		{
			print "$1 $2 this $3 and this $4 and some more of this\n";
		}
	}

}
close (IN);

String Parse-Replacing in Perl

Note that this script has not been tested and will probably not work as it is.

// perl parseReplaceInFiles.pl a.in c:\internet\demo\vbscript\

open (IN, shift);
$path = shift;
$find = shift;
$replace = shift;

while (<IN>)
{

	@lines = ();
	chomp($_);
	$_ = "$path$_";
	print "$_\n";

	if (&getFile($_) == 1)
	{

		print "length = $len\n"; $x = 0; while ($x < $len) { print "$x : $lines[$x]"; $x = $x + 1;}

		$x = 0;
		$len = @lines;

		while ($x < $len)
		{
			$done = 0;
			if ($lines[$x] =~ /^$find(.*)$/i) { if ($replace ne "") { print "$replace$1\n"; $done = 1; } }	
			while ($lines[$x] =~ /^(.*)$find(.*)$/i) { if ($replace ne "") { print "$1$replace$2\n"; $done = 1; } }	
			if ($lines[$x] =~ /^(.*)$find$/i)) { if ($replace ne "") { print "$1$replace\n"; $done = 1; } }	
			if ($done == 0) { print "$_\n"; }
			$x = $x + 1;
		}

	}

}
close (IN);

sub getFile
{
	local($filename) = @_;
	if (open(aFile, $filename) != 1)
	{
		print "Error opening file $filename : $!\n";
		$cmdout = <dis>;
		close(dis);
		return 0;
	}
	@lines = <aFile>;
	close ($filename);
}

Pattern Matching and Generating Other Files Using Perl

This example will read a text file in a known pattern and generate and XML equivalent.

Burundi 6,457 11,569 15,571 
Comoros 658 1,176 1,577 
Djibouti 623 1,026 1,346 
Eritrea 3,577 6,681 9,085 
.
.
.
open (IN, shift);
$place = shift;

if ($place eq "africa") { print "\t\t\t<continent name=\"Africa\" year1998=\"748,927\" year2025=\"1,298,311\" year2050=\"1,766,082\">\n\n"; }
if ($place eq "asia") { print "\t\t\t<continent name=\"Asia\" year1998=\"3,585,372\" year2025=\"4,723,140\" year2050=\"5,268,451\">\n\n"; }
if ($place eq "europe") { print "\t\t\t<continent name=\"Europe\" year1998=\"728,871\" year2025=\"702,335\" year2050=\"627,691\">\n\n"; }
if ($place eq "oceania") { print "\t\t\t<continent name=\"Oceania\" year1998=\"29,644\" year2025=\"39,647\" year2050=\"46,180\">\n\n"; }
if ($place eq "northAmerica") { print "\t\t\t<continent name=\"North America\" year1998=\"304,716\" year2025=\"363,612\" year2050=\"391,781\">\n\n"; }
if ($place eq "latinAmericaCaribbean") { print "\t\t\t<continent name=\"Latin America and the Caribbean\" year1998=\"503,524\" year2025=\"696,658\" year2050=\"808,910\">\n\n"; }

print "\t\t\t\t<countries>\n\n";

while (<IN>)
{
	chomp($_);
	if ($_ =~ /^(\S*) (\S*) (\S*) (\S*).*$/i)
	{
		print "\t\t\t\t\t<country name=\"$1\">\n\n";
		print "\t\t\t\t\t\t<year1998>".&removeCommas($2)."</year1998>\n";
		print "\t\t\t\t\t\t<year2025>".&removeCommas($3)."</year2025>\n";
		print "\t\t\t\t\t\t<year2050>".&removeCommas($4)."</year2050>\n";
		print "\n\t\t\t\t\t</country>\n\n";
	}
}
close (IN);

print "\t\t\t\t</countries>\n\n\t\t\t</continent>\n\n";

sub removeCommas
{

	local($val) = @_;
	local $i;

	$data = "";
	@number = split(",",$val);
	$numbers = @number;
	if ($numbers gt 1)
	{
		for ($i = 0; $i < $numbers; $i++)
		{
			$data = $data.$number[$i];
		}
		return ($data);
	}
	else
	{
		return ($val);
	}

}

This is the XML code produced.

<continent name="Africa" year1998="748,927" year2025="1,298,311" year2050="1,766,082">
	<countries>
		<country name="Burundi">
			<year1998>6457</year1998>
			<year2025>11569</year2025>
			<year2050>15571</year2050>
		</country>
		<country name="Comoros">
			<year1998>658</year1998>
			<year2025>1176</year2025>
			<year2050>1577</year2050>
		</country>
		<country name="Djibouti">
			<year1998>623</year1998>
			<year2025>1026</year2025>
			<year2050>1346</year2050>
		</country>
		<country name="Eritrea">
			<year1998>3577</year1998>
			<year2025>6681</year2025>
			<year2050>9085</year2050>
		</country>
	</countries>
</continent>

Some Useful Functions

sub getFile
{
	local($filename) = @_;
	my(@lines);
	if (open(aFile, $filename) != 1)
	{
		print "Error opening file $filename : $!\n";
		$cmdout = <dis>;
		close(dis);
		return null;
	}
	@lines = <aFile>;
	close ($filename);
	return @lines;
}

sub dateDec
{
	local($dte) = @_;
	my(@dateparts);
	my($m, $d, $y);

	#Thu Sep 28 16:41:36 2000

	@dateParts = split(" ",localtime($dte));
	$m = int(&getMonthNumber($dateParts[1]));
	$y = int($dateParts[4]);	
	$d = int($dateParts[2]);

	$d = $d - 1;
	if (&dateValid(&datePad("$m/$d/$y")) == 0)
	{
		$d = 1;
		$m = $m - 1;
		if (&dateValid(&datePad("$m/$d/$y")) == 0)
		{
			$m = 1;
			$y = $y - 1;
		}
	}

	return (&datePad("$m/$d/$y"));
}

sub dateToInt
{
	local($dte) = @_;
	my(@dateparts);

	#09/27/2000

	@dateParts = split("/",$dte);
	return (substr($dateParts[2],2,2).$dateParts[0].$dateParts[1]);
}

sub getMonthNumber
{
	local($str) = @_;
	local @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	my($i);

	for ($i = 0; $i < 12; $i++)
	{
		if ($str eq $months[$i])
		{
			return (&pad ($i + 1, 2, "0"));
		}
	}
	return ("01");
}

sub dateValid
{
	local($dte) = @_;
	my(@dateparts);
	my($i, $month, $day, $year);

	@dateParts = split("/",$dte);
	$month = $dateParts[0];
	$day = $dateParts[1];
	$year = $dateParts[2];

	$i = 0;
	while ($i == 0)
	{
		if ($month < 1 || $month > 12) { last; }
		if ($day < 1) { last; }
		if (($month == 2 && $year % 4 == 0 && $day > 29) || ($month == 2 && $year % 4 > 0 && $day > 28)) { last; }
		if (($month == 4 || $month == 9 || $month == 6 || $month == 11) && $day > 30) { last; }
		if ($day > 31) { last; }
		return 1;
	}
	return 0;
}

sub datePad
{
	local($dte) = @_;
	my(@dateparts);
	my($m, $d, $y);

	@dateParts = split("/",$dte);
	$m = $dateParts[0];
	$d = $dateParts[1];
	$y = $dateParts[2];

	$m = &pad ($m, 2, "0");
	$d = &pad ($d, 2, "0");
	$y = &pad ($y, 2, "0");

	return ("$m/$d/$y");
}

sub pad
{
	local($val, $count, $filler) = @_;
	my($i);

	for ($i = length($val); $i < $count; $i++) { $val = "$filler$val"; }
	return ($val);
}

Perl and CGI

Hello World

Great Perl Websites

perldoc.perl.org, Download Perl.