source: trunk/cgi-bin/CommonWeb.pm@ 143

# 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;