#########################################################################
#FILE: lozcgi.pl	AUTHOR: Dave Lozinski								
#VERSION: 1.21		DATE: 04/04/04										
#																		
#CONTACT: http://www.davelozinski.com									
#																		
#HISTORY:																
#This is the lozcgi.pl perl module. I developed this module because I	
#found that all the other "perl" modules out there to perform the basic	
#functions like starting a web page, getting the input data, etc, were 	
#too complex and had too much garbage for my needs. This module is 		
#really intended for those perl programmers who don't want to use the	
#CGI.pm, CGI_LITE.pm, and other big libraries or for those who don't 	
#want/need to do any object-oriented stuff.								
#																		
#SUBROUTINES:															
#The subroutines contained within this package and their descriptions 	
#are as follows (or read their headers for more information) :			
#																		
# GetData -> simply retrieves the information submitted through a form  
#		or URL using the GET and POST methods.							
#																		
# StartHTML -> Contains the common perl code for starting a web page.	
#		Includes all the common HTML attribute settings in the			
#		BODY tag, and an additional feature to instruct browsers		
#		NOT to cache documents. 										
#																		
# FinishHTML ->Contains the common perl code to finish off a web page	
#		and exit a perl program.										
#																		 
# getCookies ->	Retrieves any cookie information from the browser.		
#																		
# setCookie ->	Sets cookie information.									
#																		
# deleteCookie ->	Deletes a cookie or list of cookies.				
#																		
#HOW TO USE:															
#Using this module is even easier than the others. To use this module	
#in your perl programs, all you need to do is have a simple "require"	
#statement at the top of your perl program which should look similar to:
#	require ("lozcgi.pl");													
#That's it! Cool huh? Then, to access any of these subroutines, just 	
#call them like you would any other subroutine in your program. For		
#example:																
#	&GetData;															
#Whammo! You're good to go!												
#																		
#CONDITIONS/LICENSING:													
#This is totally free. I'm sure most (if not all) perl programmers		
#have alreay developed these subroutines in another version. I just		
#got tired of doing it over and over, and developed my own "library". 	
#There are no warranties whatsoever. 									
#																		
#FEEDBACK/HELP:															
#Just send me an email through the web link stated at the top. I'm 		
#here to help. If you make any really cool modifications, please share.	
#:)
#
#HISTORY:
#	1.21	04/04/04	Updated module so it will not produce any
#						errors when using perl -w
#	1.0 - 1.20			All prior history lost. :(
#########################################################################

#########################################################################
#																		
# sub GetData															
#																		
# Template for calling (just copy and paste into your code):			
#	&GetData;															
#																		
#	This subroutine gets the POST data and the GET data! Use either		
#or both methods for passing form information! You are assured of 		
#getting your informatoin no matter what method you use. The information
#is saved in an associative array called %in. To access	the particular	
#element you want, just do it like you would any other	associative 	
#array:																	
#	$in{"element"}														
#Note that this will not retrieve data supplied via the HEAD or PUT		
#(uploading files) methods.												
#																		
#########################################################################
sub GetData {															
																		
my $form_info;															
my @key_value_pairs;													
if ($ENV{"REQUEST_METHOD"} eq "POST") {	#Retrieve any "post" info		
        $size_of_form_information = $ENV{"CONTENT_LENGTH"};				
        read (STDIN, $form_info, $size_of_form_information);			
}																		
if ($ENV{"QUERY_STRING"} ne "") {	#Retrieve any query string info		
	if ($form_info ne "") {		#Append to "post" info					
		$form_info .= "&" . $ENV{"QUERY_STRING"};						
	} else {															
		$form_info = $ENV{"QUERY_STRING"};								
	}																	
}																		
																		
@key_value_pairs = split (/&/, $form_info);								
foreach $key_value (@key_value_pairs) {									
        ($key, $value) = split (/=/, $key_value);						
        $key =~ tr/+/ /;												
        $key =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;		
        $value =~ tr/+/ /;												
        $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;	
        if (defined($in{$key})) {										
                $in{$key} = join (";;", $in{$key}, $value);				
        } else {														
                $in{$key} = $value;										
        }																
}																		
																		
} #GetData																
#########################################################################

#########################################################################
#																		
#sub StartHTML															
#																		
# Template for calling (just copy and paste into your code):			
#	&StartHTML("Title","","","","","","",1);							
#																		
#	This subroutine starts of any web page, including the 				
#content-type and pragma headers. This subroutine expects the following	
#parameters in the following order:										
#$title	-THIS PARAMETER IS REQUIRED! It makes for good HTML too since	
#	every HTML page is supposed to have a tile. :)						
#$bgcolor	-The background color of your web page. Default is white	 
#$text		-Text color of your document. Default is black.				
#$link		-Color of links within your document. Default is green.		
#$vlink		-The color of visited links within your document. 			
#		Default is yellow.												
#$alink		-The color of active links within your page. Default is		
#		blue.															
#$background	-The URL to the background image you'd like in your		
#		webpage.														
#$cache	-either "0" or "1". Passing in "0" (zero) tells the subroutine 	
#	to print the headers instructing the browser NOT to cache			
#	documents. Default is to cache.										
#Note that all the parameters which expect colors can have them supplied
#either by using the hexidecimal color scheme (eg, "#FFFFFF" for white) 
#or by passing in word names (eg, "white"). 							
#																		
#If you are not using a parameter and wish to leave it blank (for 		
#example, no vlink color), just skip the parameter in this subroutine	
#call. However, all of the previous parameters MUST be supplied. For	
#example, if we just wanted the title and text color red, our subroutine
#call would need to look like:											
#Example:																
#	&StartHTML("my title","","red",,,,,,);								
#																		
#########################################################################
sub StartHTML {															
																		
my ($title,$bgcolor,$text,$link,$vlink,$alink,$background,$cache) = @_;	
if ($cache !~ /[01]/) { $cache = 1; }									
if ($title !~ /\w/) { $title= "http://www.davelozinski.com"; }			
if ($bgcolor eq "") { $bgcolor = "#FFFFFF"; }		
if ($text eq "") { $text = "#000000"; }		
if ($link eq "") { $link = "#00FF00"; }									
if ($vlink eq "") { $vlink = "#FF00FF"; }								
if ($alink eq "") { $alink = "#0000FF"; }
#Next line is here because some perl interpreters are trying 
#to be too smart. If removed, could cause 'warnings'.	
if ($background eq "") { $background = ""; }
																
if (!$cache) { print ("Pragma: no-cache\n"); }							
print ("Content-type: text/html\n\n");									
print ("<HTML><HEAD>\n");												
if (!$cache) {															
	print ("<META http-equiv=\"pragma\" CONTENT=\"no-cache\">\n");		
	print ("<META http-equiv=\"expires\" CONTENT=\"0\">\n");			
}																		
print ("<TITLE>" . $title . "</TITLE>\n</HEAD>\n");						
print ("<BODY BGCOLOR=\"" . $bgcolor . "\" ");
if ($background ne "") { print ("BACKGROUND=\"" . $background . "\" "); }
print ("TEXT=\"" . $text . "\" LINK=\"" . $link . "\" ");				
print ("VLINK=\"" . $vlink . "\" ALINK=\"" . $alink . "\">\n");			
																		
} #StartHTML															
#########################################################################

#########################################################################
#																		
#sub FinishHTML															
#																		
# Template for calling (just copy and paste into your code):			
#	&FinishHTML(0);														
#																		
#	This subroutine just closes off the web page. The only 				
#parameters it expects is if you wish to have the program exit upon		
#completion of this subroutine. "1" means yes; "0" (zero) means no		
#(default).																
#																		
#Example:																
#	&FinishHTML(1);														
#would send an "exit(0)" to your perl program after printing the </HTML>
#tag.																	
#																			
#########################################################################
sub FinishHTML {														
																		
my ($finish) = @_;														
if ($finish !~ /[01]/) { $finish = 0; }									
print ("</BODY>\n</HTML>\n");											
if ($finish) { exit(0); }												
																		
} #FinishHTML															
#########################################################################

#########################################################################
#																		
# sub getCookies														
#																			
#       This subroutine gets the cookies from the browser and stores	
#them in the associative array %COOKIE_DATA.							
#																		
#	All you need to do is call this routine by the following:			
#	&getCookies;														
#	Once you've done that, you have access to all the cookie 			
#information contained in the %COOKIE_DATA array and can access it by:	
#	$COOKIE_DATA{"cookie_information_you_want"}							
#																		
#########################################################################
sub getCookies {														
																		
%COOKIE_DATA; #Global variable so you can access it any time.			
my (@cookies, $key_value, $key, $value);								
																		
if (defined($ENV{"HTTP_COOKIE"}) && $ENV{"HTTP_COOKIE"} ne "") {											#
	@cookies = split (/;\s/, $ENV{"HTTP_COOKIE"});						
	foreach $key_value (@cookies) {										
	        ($key,$value) = split (/=/,$key_value);						
	        $key    =~ tr/+/ /;											
	        $value  =~ tr/+/ /;											
	        $key    =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;	
	        $value  =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;	
	        if (defined($COOKIE_DATA{$key})) {							
	                $COOKIE_DATA{$key} = join("\0",$COOKIE_DATA{$key},$value);
	        } else { 													
	                $COOKIE_DATA{$key} = $value;						
	        }															
	} #foreach															
}#if																	
																		
} #getCookies															
#########################################################################

#########################################################################
#																		
#sub setCookie															
#																		
#       This subroutine sets the cookie name, value, and expiration.	
#The expiration time should be in the following formatted example:		
#	02-Dec-99 00:00:00 GMT												
#																		
#	To set a cookie, you need to pass 4 parameters:						
#	1) The name of the cookie											
#	2) The value of the cookie											
#	3) The expiration time as noted above. You can supply no value		
#	which means the cookie will persist for as long as the 				
#	browser is open.													
#																		
#	Your subroutine call should look similar to:						
#&setCookie("cookieName","cookieValue","02-Dec-99 00:00:00 GMT");		
#	OR																	
#&setCookie($name,$value,$expires);										
#																		
#	This MUST be called before the StartHTML subroutine and/or			
#any Content-type headers! 												
#																		
#########################################################################
sub setCookie {															
																		
my ($cookieName,$cookieValue,$cookieExpiration) = @_;					
print ("Set-Cookie: $cookieName=$cookieValue; expires=$cookieExpiration\n");
																		
} #setCookie															
#########################################################################

#########################################################################
#																		
#sub deleteCookie														
#																		
#	This subroutine deletes a list of given cookies. All that needs		
#to be done is just call this subroutine, passing in the list of 		
#cookies you'd like deleted. For example:								
#	&deleteCookie("cookie_to_delete");									
#	OR																	
#	&deleteCookie("cookie1","cookie2","cookie3");						
#	OR																	
#	&deleteCookie($cookie_name);										
#																		
#	This MUST be called before the StartHTML subroutine and/or			
#any Content-type headers!												
#																		
#########################################################################
sub deleteCookie {														
																		
my (@deleteList) = @_;													
for ($x=0; $x<@deleteList; $x++) {										
	undef $COOKIE_DATA{$deleteList[$x]};								
	print ("Set-Cookie: $deleteList[$x]=; expires=Thu, 01-Jan-1970 00:00:00 GMT\n");
}																		
																		
} #deleteCookie															
#########################################################################

1; #DO NOT ERASE THIS LINE!												#
#FILE: lozcgi.pl														#
#########################################################################