1
|
1 #!/usr/local/bin/perl
|
|
2
|
|
3 require "cgi-lib.pl";
|
|
4 use DBI;
|
|
5
|
|
6 $user = "";
|
|
7 $passwd = "";
|
|
8 $dbname = "scs";
|
|
9
|
|
10 MAIN:
|
|
11 {
|
|
12 # Read in all the variables set by the form
|
|
13 &ReadParse(*input);
|
|
14
|
|
15 print &PrintHeader;
|
|
16 print "<BODY BGCOLOR=\"#00000\" TEXT=\"#CCCCCC\" LINK=\"#00EE20\"";
|
|
17 print " VLINK=\"#55FF8B\" ALINK=\"#FFFF00\">";
|
|
18 print "<META HTTP-EQUIV=\"Pragma\" content=\"no-cache\">\n";
|
|
19 print "<TITLE>Add a user to the SCS Database</TITLE>";
|
|
20 print "<H2>Add a user to the SCS Database</H2>";
|
|
21
|
|
22 # Connect to the Database
|
|
23 $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $passwd) || bad_exit($sth->errstr);
|
|
24
|
|
25 $fname = san_str($input{'fname'});
|
|
26 $lname = san_str($input{'lname'});
|
|
27 $nick = san_str($input{'nick'});
|
|
28 $pwd1 = san_str($input{'pwd1'});
|
|
29 $pwd2 = san_str($input{'pwd2'});
|
|
30 $age = san_num($input{'age'});
|
|
31 $phone1 = san_str($input{'phone1'});
|
|
32 $ph1_pub = (san_str($input{'ph1_pub'}) eq 'on') ? 't' : 'f';
|
|
33 $phone2 = san_str($input{'phone2'});
|
|
34 $ph2_pub = (san_str($input{'ph2_pub'}) eq 'on') ? 't' : 'f';
|
|
35 $email = san_str($input{'email'});
|
|
36 $email_pub = (san_str($input{'email_pub'}) eq 'on') ? 't' : 'f';
|
|
37 $address1 = san_str($input{'addy1'});
|
|
38 $address2 = san_str($input{'addy2'});
|
|
39 $address3 = san_str($input{'addy3'});
|
|
40 $addy_pub = (san_str($input{'addy_pub'}) eq 'on') ? 't' : 'f';
|
|
41 $comments = san_str($input{'comments'});
|
|
42 }
|
|
43
|
|
44 sub bad_exit
|
|
45 {
|
|
46 print "<H2>An internal error has occurred</H2><BR>";
|
|
47 print "Please mail <A HREF=\"mailto:darius\@dons.net.au\">The Administrator</A> and\n";
|
|
48 print "say the following error occured - $_[0]<P>\n";
|
|
49 print "<A HREF=\"/scs/games/adduser.html\">Back to the Add User Page</A>\n";
|
|
50
|
|
51 print &HtmlBot;
|
|
52
|
|
53 exit(0);
|
|
54 }
|
|
55
|
|
56 sub dtrail
|
|
57 {
|
|
58 $_[0] =~ s/(\ *)$//g;
|
|
59 return $_[0];
|
|
60 }
|
|
61
|
|
62 sub san_str
|
|
63 {
|
|
64 $_[0] =~ s/\\/\\\\/g;
|
|
65 $_[0] =~ s/'/\\'/g;
|
|
66 $_[0] =~ s/"/\\"/g;
|
|
67 return $_[0];
|
|
68 }
|
|
69
|
|
70 sub san_num
|
|
71 {
|
|
72 # $_[0] =~ s/'/\\'/g;
|
|
73 return $_[0];
|
|
74 }
|