source: branches/new-custids/cgi-bin/CommonWeb.pm@ 251

Last change on this file since 251 was 105, checked in by Kris Deugau, 20 years ago

/trunk

Updated printError function so that it does NOT exit, to allow
the caller to clean up anything else necessary after calling.

File size: 2.9 KB
Line 
1# ipdb/cgi-bin/CommonWeb.pm
2###
3# SVN revision info
4# $Date$
5# SVN revision $Rev$
6# Last update by $Author$
7###
8
9package CommonWeb;
10
11# 08/13/2004 kdeugau@vianet
12# Split DB-related functions into new module; they're not
13# specific to CGI/web stuff.
14
15use strict;
16use warnings;
17use Exporter;
18use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
19
20$VERSION = 1.00;
21@ISA = qw(Exporter);
22@EXPORT_OK = qw(&parse_post &printFooter &printHeader &printError &printAndExit &desanitize &cleanInput &desanitize);
23
24@EXPORT = (); #export nothing by default
25%EXPORT_TAGS = ( ALL => [qw( &parse_post &printFooter &printHeader &printError
26 &printAndExit &desanitize &cleanInput )],
27 lean => [qw( &parse_post &printFooter &printHeader &printError
28 &printAndExit &cleanInput )]
29 );
30
31sub parse_post {
32 my $buffer;
33 if ($ENV{'REQUEST_METHOD'} eq "GET") {
34 $buffer=$ENV{'QUERY_STRING'}
35 } elsif ($ENV{'REQUEST_METHOD'} eq 'POST' && $ENV{'CONTENT_TYPE'} eq "application/x-www-form-urlencoded") {
36 read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
37 } else {
38 $buffer = $ENV{'QUERY_STRING'};
39 $buffer || read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
40 }
41 my @pairs = split(/&/, $buffer);
42 my %webvarLocal;
43 foreach my $pair (@pairs) {
44 my ($name, $value) = split(/=/, $pair);
45 $name =~ tr/+/ /;
46 $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
47 $value =~ tr/+/ /;
48 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
49 $value =~ s/\'/\\\'/g;
50 $webvarLocal{$name} = $value;
51 }
52 return %webvarLocal;
53}
54
55sub printHeader($) #(cgiurl)
56{
57 my $cgiURL = $_[0];
58 print "Content-type: text/html\n\n";
59 open(FILE, "../header.inc") || die $!;
60 while (<FILE>)
61 {
62 $_ =~ s/\$\$CGIURL\$\$/$cgiURL/g;
63 print $_;
64 }
65 close(FILE);
66}
67
68sub printFooter
69{
70 open FILE, "../footer.inc"
71 or croak $!;
72 while (<FILE>)
73 {
74 print;
75 }
76 close FILE;
77}
78
79sub printError($)
80{
81 my $errStr = $_[0];
82 print qq(
83 <center><p class="regular"> $errStr </p>
84 <input type="button" value="Back" onclick="history.go(-1)">
85 </center>
86 );
87}
88
89sub printAndExit($)
90{
91 my $errStr = $_[0];
92 print qq(
93 <center><p class="regular"> $errStr </p>
94 <input type="button" value="Back" onclick="history.go(-1)">
95 </center>
96 );
97 printFooter();
98 exit(0);
99}
100
101sub loginAgain
102{
103 print qq(
104 <center><p>Your session has expired. Please login again.</p>
105 <p>
106 <a href="http://hosttest.vianet.ca"> Click here to login again.</a>
107 </p>
108 </center>
109 );
110 printFooter();
111 exit(0);
112}
113
114# needs a reference to the webvar hash.
115# takes out backticks and single quotes
116sub cleanInput($)
117{
118 my $hashRef = $_[0];
119
120 foreach my $key (keys %$hashRef)
121 {
122 $hashRef->{$key} =~ s/`/\\`/g;
123 $hashRef->{$key} =~ s/'/\'/g;
124 }
125}
126
127# undoes clean input. takes a string as an arg.
128sub desanitize($)
129{
130 my $string = $_[0];
131 $string =~ s/\\`/`/g;
132 $string =~ s/\\'/'/g;
133 return $string;
134}
135
136# indicate that the module loaded okay.
1371;
Note: See TracBrowser for help on using the repository browser.