source: branches/htmlform/cgi-bin/CommonWeb.pm@ 453

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

package CommonWeb;

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( &printHeader &printError &printAndExit &desanitize &cleanInput &desanitize);

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


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 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>
        );
        print "<br>would print footer but already dun gone and shot(self->foot)\n";
        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;