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 () { $_ =~ s/\$\$CGIURL\$\$/$cgiURL/g; print $_; } close(FILE); } sub printFooter { open FILE, "../footer.inc" or croak $!; while () { print; } close FILE; } sub printError($) { my $errStr = $_[0]; print qq(

There was an error: $errStr

); printFooter(); exit(0); } sub printAndExit($) { my $errStr = $_[0]; print qq(

$errStr

); printFooter(); exit(0); } sub loginAgain { print qq(

Your session has expired. Please login again.

Click here to login again.

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