comparison adduser.pl @ 1:d95e74cd12f4 RELENG_1_0

Initial commit
author darius
date Wed, 06 May 1998 14:33:31 +0000
parents
children
comparison
equal deleted inserted replaced
0:019f8230ae37 1:d95e74cd12f4
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 }