Mercurial > ~darius > hgwebdir.cgi > SCS_DB
diff adduser.pl @ 1:d95e74cd12f4 RELENG_1_0
Initial commit
| author | darius |
|---|---|
| date | Wed, 06 May 1998 14:33:31 +0000 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/adduser.pl Wed May 06 14:33:31 1998 +0000 @@ -0,0 +1,74 @@ +#!/usr/local/bin/perl + +require "cgi-lib.pl"; +use DBI; + +$user = ""; +$passwd = ""; +$dbname = "scs"; + +MAIN: +{ +# Read in all the variables set by the form + &ReadParse(*input); + + print &PrintHeader; + print "<BODY BGCOLOR=\"#00000\" TEXT=\"#CCCCCC\" LINK=\"#00EE20\""; + print " VLINK=\"#55FF8B\" ALINK=\"#FFFF00\">"; + print "<META HTTP-EQUIV=\"Pragma\" content=\"no-cache\">\n"; + print "<TITLE>Add a user to the SCS Database</TITLE>"; + print "<H2>Add a user to the SCS Database</H2>"; + +# Connect to the Database + $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $passwd) || bad_exit($sth->errstr); + + $fname = san_str($input{'fname'}); + $lname = san_str($input{'lname'}); + $nick = san_str($input{'nick'}); + $pwd1 = san_str($input{'pwd1'}); + $pwd2 = san_str($input{'pwd2'}); + $age = san_num($input{'age'}); + $phone1 = san_str($input{'phone1'}); + $ph1_pub = (san_str($input{'ph1_pub'}) eq 'on') ? 't' : 'f'; + $phone2 = san_str($input{'phone2'}); + $ph2_pub = (san_str($input{'ph2_pub'}) eq 'on') ? 't' : 'f'; + $email = san_str($input{'email'}); + $email_pub = (san_str($input{'email_pub'}) eq 'on') ? 't' : 'f'; + $address1 = san_str($input{'addy1'}); + $address2 = san_str($input{'addy2'}); + $address3 = san_str($input{'addy3'}); + $addy_pub = (san_str($input{'addy_pub'}) eq 'on') ? 't' : 'f'; + $comments = san_str($input{'comments'}); +} + +sub bad_exit +{ + print "<H2>An internal error has occurred</H2><BR>"; + print "Please mail <A HREF=\"mailto:darius\@dons.net.au\">The Administrator</A> and\n"; + print "say the following error occured - $_[0]<P>\n"; + print "<A HREF=\"/scs/games/adduser.html\">Back to the Add User Page</A>\n"; + + print &HtmlBot; + + exit(0); +} + +sub dtrail +{ + $_[0] =~ s/(\ *)$//g; + return $_[0]; +} + +sub san_str +{ + $_[0] =~ s/\\/\\\\/g; + $_[0] =~ s/'/\\'/g; + $_[0] =~ s/"/\\"/g; + return $_[0]; +} + +sub san_num +{ +# $_[0] =~ s/'/\\'/g; + return $_[0]; +}