######################  
# Copyright © 2000 Portal Scripts.
# All Rights Reserved.  
#                       
# The original developer of this software module and his/her company, the subsequent
# editors and their companies, have no liability for use of this
# software module or modifications thereof in an implementation.
#                       
# Permission to use, copy, and modify this software and its documentation on
# the server of the customer is hereby granted, provided that the above copyright
# notice, this paragraph and the following two paragraphs appear in all
# copies.               
#                       
# This software program and documentation are copyrighted by Portal Scripts. 
# The software program and documentation are supplied "as is", without any 
# accompanying services. Portal Scripts does not 
# warrant that the operation of the program will be
# uninterrupted or error-free.
#                       
# IN NO EVENT SHALL PORTAL SCRIPTS BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING
# LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION.
#                       
######################  

use strict;
use vars qw(%months_hash);

%months_hash = qw(
	1	January
	2	February
	3	March
	4	April
	5	May
	6	June
	7	July
	8	August
	9	September
	10	October
	11	November
	12	December
);

sub Parse_Form {
	my @pairs;
	my @getpairs;
	my $buffer;
	my $pair;
	my ($key, $value);
	my %formdata;
	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);
		
		if ($ENV{'QUERY_STRING'}) {
			@getpairs =split(/&/, $ENV{'QUERY_STRING'});
			push(@pairs,@getpairs);
			}
	} else {
		print "Content-type: text/html\n\n";
		print "<P>Use Post or Get";
	}

	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;
		}
	}
	return %formdata;
}

sub get_url {
	my $cgi_url = $ENV{'SCRIPT_NAME'};	
	$cgi_url =~ s#/([^/]*)$##;
	my $script_name = $1;
	return ($cgi_url, $script_name);
}

sub read_config {
	open(LIST, "system.conf");
	flock(LIST, 2);
	my @configs = <LIST>;
	flock(LIST, 8);
	close(LIST);
	chomp(@configs);

	for my $conf (@configs){
		$conf =~ s#\s*^##;
	}
	@configs = grep{length} @configs;
	my %CONFIG;
	for (@configs){
		my ($ckey, $cvalue) = split /\s*==\s*/, $_;
		$ckey =~ s#^\s+##;
		$cvalue =~ s#\s+$##;
		$CONFIG{$ckey} = $cvalue;
	}
	return %CONFIG;
}

sub set_cookie {
	my ($type, $cookie) = @_;
	print "Set-Cookie:$type=$cookie\n";
}

sub get_cookie {
	my %cookies;
	my ($name, $value);
	if($ENV{'HTTP_COOKIE'}){
		my @cookies = split(/;/, $ENV{'HTTP_COOKIE'});
		for (@cookies){
			($name,$value) = split(/=/,$_);
			$cookies{$name}=$value;
		}
	}
	return %cookies;
}


1;