# ipdb/cgi-bin/CommonWeb.pm
###
# SVN revision info
# $Date$
# SVN revision $Rev$
# Last update by $Author$
###

package CommonWeb;

# 08/13/2004 kdeugau@vianet
#	Split DB-related functions into new module;  they're not
#	specific to CGI/web stuff.

use strict;		
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT_OK      = qw(&parse_post &printFooter &printHeader &printError &printAndExit &desanitize &cleanInput &desanitize);

@EXPORT      = (); #export nothing by default
%EXPORT_TAGS = ( ALL => [qw( &parse_post &printFooter &printHeader &printError
				&printAndExit &desanitize &cleanInput )],
                 lean    => [qw( &parse_post &printFooter &printHeader &printError
				&printAndExit &cleanInput )]
		);

sub parse_post {
  my $buffer;
  if ($ENV{'REQUEST_METHOD'} eq "GET") {
    $buffer=$ENV{'QUERY_STRING'}
  } elsif ($ENV{'REQUEST_METHOD'} eq 'POST' && $ENV{'CONTENT_TYPE'} eq "application/x-www-form-urlencoded") {
    read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
  } else {
    $buffer = $ENV{'QUERY_STRING'};
    $buffer || read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
  }
  my @pairs = split(/&/, $buffer);
  my %webvarLocal;
  foreach my $pair (@pairs) {
    my ($name, $value) = split(/=/, $pair);
    $name  =~ tr/+/ /;
    $name  =~ 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/\'/\\\'/g;
    $webvarLocal{$name} = $value;
  }
  return %webvarLocal;
}

sub printHeader($) #(cgiurl)
{
	my $cgiURL = $_[0];
	print "Content-type: text/html\n\n";
	open(FILE, "../header.inc") || die $!;
	while (<FILE>) 
	{
		$_ =~ s/\$\$CGIURL\$\$/$cgiURL/g;
		print $_;
	}
	close(FILE);
}

sub printFooter
{
  open FILE, "../footer.inc"
	or croak $!;
  while (<FILE>) 
  {
    print;
  }
  close FILE;
}

sub printError($)
{
	my $errStr = $_[0];
	print qq(
	<center><p class="regular"> $errStr </p>
	<input type="button" value="Back" onclick="history.go(-1)">
	</center>
	);
}

sub printAndExit($)
{
	my $errStr = $_[0];
	print qq(
	<center><p class="regular"> $errStr </p>
	<input type="button" value="Back" onclick="history.go(-1)">
	</center>
	);
	printFooter();
	exit(0);
}

sub loginAgain
{
	print qq(
	<center><p>Your session has expired. Please login again.</p>
	<p>
	<a href="http://hosttest.vianet.ca"> Click here to login again.</a>
	</p>
	</center>
	);
	printFooter();
	exit(0);
}

# needs a reference to the webvar hash.
# takes out backticks and single quotes
sub cleanInput($)
{
	my $hashRef = $_[0];

	foreach my $key (keys %$hashRef) 
	{
		$hashRef->{$key} =~ s/`/\\`/g;
		$hashRef->{$key} =~ s/'/\'/g;
	}
}

# undoes clean input.  takes a string as an arg.
sub desanitize($)
{
	my $string = $_[0];
	$string =~ s/\\`/`/g;
	$string =~ s/\\'/'/g;
	return $string;
}

# indicate that the module loaded okay.
1;