# 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 {
  my $title = shift;
  print "Content-type: text/html\n\n";
# This doesn't work well.  Must investigate.
#  my $realm = shift;
#  print qq(WWW-Authenticate: Basic realm="$realm"\n) if $realm;
  open FILE, "../header.inc"
	or carp $!;
  my $html = join('',<FILE>);
  close FILE;

  $html =~ s/\$\$TITLE\$\$/$title/;
# Necessary for mangling arbitrary bits of the header
  my $i=0;
  while (defined(my $param = shift)) {
    $html =~ s/\$\$EXTRA$i\$\$/$param/g;
    $i++;
  }
  print $html;
}

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;