CGI Subroutine codes

CGI Subroutine codes

sub Parse_Form 
{
	if ($ENV{'REQUEST_METHOD'} eq 'GET') 
	{
       	  @pairs = split(/&/, $ENV{'QUERY_STRING'});
	 } 
	elsif ($ENV{'REQUEST_METHOD'} eq 'POST') 
	{
        	  read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
        	 @pairs = split(/&/, $buffer);
	 } 
	else 
	{
        	  print "Content-type: text/html\n\n";
        	  print "<P>Use Post or Get</P>";
	 }

	foreach $pair (@pairs) 
	{
	    ($key, $value) = split (/=/, $pair);
	    $key =~ tr/+/ /;
	    $key =~ 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;
	    $value =~ s/<!--(.|\n)*-->//g;

	    if ($formdata{$key}) 
	    {
		  $formdata{$key} .= ", $value";
	    }
	    else 
	    {
		  $formdata{$key} = $value;
	    }
	 }
}
1;


(These are the Subroutines...)


# Prints the HTML mime type
sub mime
        { print "Content-type: text/html\n\n"; }

# Prints the HTML header with one input, ("the title"), then closes header & begins body
sub header
        {
          print "<html>\n<head><title>";
          print "$_[0]";
          print "</title></head>\n<body>\n";
        }

# Prints the HTML header with inputs for: ("the title", “the backgroundcolor”), 
# then closes header & begins body
sub headerbgcolor
        {
          print "<html>\n<head><title>";
          print "$_[0]";
          print "</title></head>\n<body bgcolor=$_[1]>\n";
        }

# Prints the HTML footer tags or close body & html
sub footer
        { print "</body>\n</html>"; }


# Print an opening table heading with attribute option
sub theader
        { print "<table $_[0]>\n"; }

# Print an opening table heading with four attribute options
sub theader4
        { print "<table $_[$0], $_[1], $_[2], $_[3]>\n"; }

# Print a closing table footer
sub tfooter
        { print "</table>\n"; }


# Print a table row with 3 cells
sub trow3
        { print "<tr><td>$_[0]</td><td>$_[1]</td><td>$_[2]</td></tr>\n"; }

# Print a table row with 'varying' number of cells
sub trow
        {
          print "<tr>\n";
          for ($i = 0; $i <= $#_; $i++)
          {
                print "\t<td>$_[$i]</td>\n";
          }
          print "</tr>\n";
        }


# Print a table row with 'varying' number of cells and contents 'centered'
sub trowcm
        {
          print "<tr>\n";
          for ($i = 0; $i <= $#_; $i++)
          {
                print "\t<td align=center valign=middle>$_[$i]</td>\n";
          }
          print "</tr>\n";
        }

# Print table row varying #cells, align='center' and bgcolor=a light pinkish-purple
sub trowplus
        {
          print "<tr>\n";
          for ($i = 0; $i <= $#_; $i++)
          {
                print "\t<td align=center valign=middle bgcolor='#FFCCFF'>$_[$i]</td>\n"; 
          }
          print "</tr>\n";
        }

# Print table row varying #cells, align='center' and bgcolor=a light blueish
sub trowblue
        {
          print "<tr>\n";
          for ($i = 0; $i <= $#_; $i++)
          {
                print "\t<td bgcolor='#1ED4F8'>$_[$i]</td>\n";
          }
          print "</tr>\n";
        }

# Print a template-table with 20% colored column & 80% white column
sub templatestart
        {
          print "<html>\n<head><title>";
          print "$_[0]";
          print "</title></head>\n<body bgcolor=white>";
          print "<table width=100% height=100%>\n";
          print "<tr>\n\t<td width=20% valign=top bgcolor=$_[1]>\n";
        }
sub templatebody
        { print "\t</td>\n\t<td width=80% valign=top>"; }
sub templatestop
        { print "\t</td>\n</tr>\n</table>\n</body>\n</html>"; }

# Print out current date
sub get_current_date
        {
          ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); 
          @days = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
          @months = (January, February, March, April, May, June, July, August, September, October, November, December); 
          if ($year = 100) {$year = "2000";}
          $sec=sprintf("%02d", $sec);
          $min=sprintf("%02d", $min);
          $hour=sprintf("%02d", $hour);
        }

# Print the browser's user-agent being veiwed with
sub getbrowserhua
        { $browserhua = $ENV{'HTTP_USER_AGENT'};  }

# Print the browser being veiwed with
sub getbrowser
        {
          $browser = $ENV{'HTTP_USER_AGENT'};
          if ($browser =~ /MSIE/)
                {$browser = "Explorer";}
          elsif ($browser =~ /Mozilla/)
                {$browser = "Netscape";}
          elsif ($browser =~ /Lynx/)
                {$browser = "Lynx";}
          elsif ($browser =~ /Opera/)
                {$browser = "Opera";}
          else  {$browser = "Something besides Netscape of Explorer";}
          return $browser;
        }

# Print out server host
sub getserverht
        { $serverht = $ENV{'HTTP_HOST'}; }

# Print out server admin
sub getserverad
        { $serverad = $ENV{'SERVER_ADMIN'}; }

# Print out last site visited
sub getreferer
        { $referer = $ENV{'HTTP_REFERER'}; }



1; 	<-- this is the end of the subroutines....
Return to Top of Page
Lu's Notes

CGI Subroutine codes
