view adduser.pl @ 2:791e87929f83 default tip

Added tag RELENG_1_0 for changeset d95e74cd12f4
author darius@midget.dons.net.au
date Tue, 23 Oct 2007 10:07:21 +0930
parents d95e74cd12f4
children
line wrap: on
line source

#!/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];
}