source: branches/stable/cgi-bin/CommonWeb.pm@ 482

Last change on this file since 482 was 445, checked in by Kris Deugau, 14 years ago

/branches/stable

Bring /branches/stable up to date with /trunk. See #13.

  • Property svn:keywords set to Date Rev Author
File size: 2.8 KB
Line 
1# ipdb/cgi-bin/CommonWeb.pm
2###
3# SVN revision info
4# $Date: 2010-07-26 21:00:00 +0000 (Mon, 26 Jul 2010) $
5# SVN revision $Rev: 445 $
6# Last update by $Author: kdeugau $
7###
8
9package CommonWeb;
10
11use strict;
12use warnings;
13use Exporter;
14use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
15
16$VERSION = 1.00;
17@ISA = qw(Exporter);
18@EXPORT_OK = qw(&parse_post &printFooter &printHeader &printError &printAndExit &desanitize &cleanInput &desanitize);
19
20@EXPORT = (); #export nothing by default
21%EXPORT_TAGS = ( ALL => [qw( &parse_post &printFooter &printHeader &printError
22 &printAndExit &desanitize &cleanInput )],
23 lean => [qw( &parse_post &printFooter &printHeader &printError
24 &printAndExit &cleanInput )]
25 );
26
27sub parse_post {
28 my $buffer;
29 if ($ENV{'REQUEST_METHOD'} eq "GET") {
30 $buffer=$ENV{'QUERY_STRING'}
31 } elsif ($ENV{'REQUEST_METHOD'} eq 'POST' && $ENV{'CONTENT_TYPE'} eq "application/x-www-form-urlencoded") {
32 read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
33 } else {
34 $buffer = $ENV{'QUERY_STRING'};
35 $buffer || read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
36 }
37 my @pairs = split(/&/, $buffer);
38 my %webvarLocal;
39 foreach my $pair (@pairs) {
40 my ($name, $value) = split(/=/, $pair);
41 $name =~ tr/+/ /;
42 $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
43 $value =~ tr/+/ /;
44 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
45 $value =~ s/\'/\\\'/g;
46 $webvarLocal{$name} = $value;
47 }
48 return %webvarLocal;
49}
50
51
52sub printHeader {
53 my $title = shift;
54 print "Content-type: text/html\n\n";
55# This doesn't work well. Must investigate.
56# my $realm = shift;
57# print qq(WWW-Authenticate: Basic realm="$realm"\n) if $realm;
58 open FILE, "../header.inc"
59 or carp $!;
60 my $html = join('',<FILE>);
61 close FILE;
62
63 $html =~ s/\$\$TITLE\$\$/$title/;
64# Necessary for mangling arbitrary bits of the header
65 my $i=0;
66 while (defined(my $param = shift)) {
67 $html =~ s/\$\$EXTRA$i\$\$/$param/g;
68 $i++;
69 }
70 print $html;
71}
72
73sub printFooter
74{
75 open FILE, "../footer.inc"
76 or croak $!;
77 while (<FILE>)
78 {
79 print;
80 }
81 close FILE;
82}
83
84sub printError($)
85{
86 my $errStr = $_[0];
87 print qq(
88 <center><p class="regular"> $errStr </p>
89 <input type="button" value="Back" onclick="history.go(-1)">
90 </center>
91 );
92}
93
94sub printAndExit($)
95{
96 my $errStr = $_[0];
97 print qq(
98 <center><p class="regular"> $errStr </p>
99 <input type="button" value="Back" onclick="history.go(-1)">
100 </center>
101 );
102 printFooter();
103 exit(0);
104}
105
106# needs a reference to the webvar hash.
107# takes out backticks and single quotes
108sub cleanInput($)
109{
110 my $hashRef = $_[0];
111
112 foreach my $key (keys %$hashRef)
113 {
114 $hashRef->{$key} =~ s/`/\\`/g;
115 $hashRef->{$key} =~ s/'/\'/g;
116 }
117}
118
119# undoes clean input. takes a string as an arg.
120sub desanitize($)
121{
122 my $string = $_[0];
123 $string =~ s/\\`/`/g;
124 $string =~ s/\\'/'/g;
125 return $string;
126}
127
128# indicate that the module loaded okay.
1291;
Note: See TracBrowser for help on using the repository browser.