source: branches/dns/cgi-bin/CommonWeb.pm@ 948

Last change on this file since 948 was 262, checked in by Kris Deugau, 19 years ago

/branches/dns

Update branch base with trunk changes from r216:261

File size: 3.2 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
55
56sub printHeader {
57 my $title = shift;
58 print "Content-type: text/html\n\n";
59# This doesn't work well. Must investigate.
60# my $realm = shift;
61# print qq(WWW-Authenticate: Basic realm="$realm"\n) if $realm;
62 open FILE, "../header.inc"
63 or carp $!;
64 my $html = join('',<FILE>);
65 close FILE;
66
67 $html =~ s/\$\$TITLE\$\$/$title/;
68# Necessary for mangling arbitrary bits of the header
69 my $i=0;
70 while (defined(my $param = shift)) {
71 $html =~ s/\$\$EXTRA$i\$\$/$param/g;
72 $i++;
73 }
74 print $html;
75}
76
77sub printFooter
78{
79 open FILE, "../footer.inc"
80 or croak $!;
81 while (<FILE>)
82 {
83 print;
84 }
85 close FILE;
86}
87
88sub printError($)
89{
90 my $errStr = $_[0];
91 print qq(
92 <center><p class="regular"> $errStr </p>
93 <input type="button" value="Back" onclick="history.go(-1)">
94 </center>
95 );
96}
97
98sub printAndExit($)
99{
100 my $errStr = $_[0];
101 print qq(
102 <center><p class="regular"> $errStr </p>
103 <input type="button" value="Back" onclick="history.go(-1)">
104 </center>
105 );
106 printFooter();
107 exit(0);
108}
109
110sub loginAgain
111{
112 print qq(
113 <center><p>Your session has expired. Please login again.</p>
114 <p>
115 <a href="http://hosttest.vianet.ca"> Click here to login again.</a>
116 </p>
117 </center>
118 );
119 printFooter();
120 exit(0);
121}
122
123# needs a reference to the webvar hash.
124# takes out backticks and single quotes
125sub cleanInput($)
126{
127 my $hashRef = $_[0];
128
129 foreach my $key (keys %$hashRef)
130 {
131 $hashRef->{$key} =~ s/`/\\`/g;
132 $hashRef->{$key} =~ s/'/\'/g;
133 }
134}
135
136# undoes clean input. takes a string as an arg.
137sub desanitize($)
138{
139 my $string = $_[0];
140 $string =~ s/\\`/`/g;
141 $string =~ s/\\'/'/g;
142 return $string;
143}
144
145# indicate that the module loaded okay.
1461;
Note: See TracBrowser for help on using the repository browser.