Mercurial > ~darius > hgwebdir.cgi > SCS_DB

view query.pl @ 1:d95e74cd12f4 RELENG_1_0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial commit
author darius
date Wed, 06 May 1998 14:33:31 +0000
parents
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>Query the SCS Database</TITLE>";
    print "<H2>Query the SCS Database</H2>";
	
    $id = $input{'id'};

# Connect to the Database
	$dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $passwd) || bad_exit($sth->errstr);

# Prepare the select statement
	$sth = $dbh->prepare("SELECT * FROM members WHERE memberid = $id") || bad_exit($sth->errstr);

# Execute it
	$numrows = $sth->execute || bad_exit($sth->errstr);

# Get one row. Only one.. if there is more than one, bad things have happened :)
	if (@array = $sth->fetchrow_array) {
	    $memberid	= dtrail(@array[0]);
	    $firstname	= dtrail(@array[1]);
	    $lastname	= dtrail(@array[2]);
	    $nickname	= dtrail(@array[3]);
	    $pin		= dtrail(@array[4]);
	    $age		= dtrail(@array[5]);
	    $phone1		= dtrail(@array[6]);
	    $ph1_pub	= dtrail(@array[7]);
	    $phone2		= dtrail(@array[8]);
	    $ph2_pub	= dtrail(@array[9]);
	    $email		= dtrail(@array[10]);
	    $email_pub	= dtrail(@array[11]);
	    $address1	= dtrail(@array[12]);
	    $address2	= dtrail(@array[13]);
	    $address3	= dtrail(@array[14]);
	    $addy_pub	= dtrail(@array[15]);
	    $comments	= dtrail(@array[16]);
	    $joined		= dtrail(@array[17]);
	    $lstmemfee	= dtrail(@array[18]);
	    $lstpddate	= dtrail(@array[19]);

		print  "<TABLE WIDTH=\"100%\">\n";
		printf "<TR><TD ALIGN=RIGHT><B>First Name</B><TD>%s</TR>\n", $firstname;
		printf "<TR><TD ALIGN=RIGHT><B>Last Name</B><TD>%s</TR>\n", $lastname;
		printf "<TR><TD ALIGN=RIGHT><B>Nick Name</B><TD>%s</TR>\n", $nickname;
		printf "<TR><TD ALIGN=RIGHT><B>Member ID</B><TD>%s</TR>\n", $memberid;
		printf "<TR><TD ALIGN=RIGHT><B>Age</B><TD>%s</TR>\n", $age;

		if ($ph1_pub eq '1') {
			printf "<TR><TD ALIGN=RIGHT><B>Phone 1</B><TD>%s</TR>\n", $phone1;
		}
		if ($ph2_pub eq '1') {
			printf "<TR><TD ALIGN=RIGHT><B>Phone 2</B><TD>%s</TR>\n", $phone2;
		}
		if ($email_pub eq '1') {
			printf "<TR><TD ALIGN=RIGHT><B>Email</B><TD>%s</TR>\n", $email;
		}
		if ($addy_pub eq '1') {
			printf "<TR><TD ALIGN=RIGHT><B>Address 1</B><TD>%s</TR>\n", $address1;
			printf "<TR><TD ALIGN=RIGHT><B>Address 2</B><TD>%s</TR>\n", $address2;
			printf "<TR><TD ALIGN=RIGHT><B>Address 3</B><TD>%s</TR>\n", $address3;
		}
		printf "<TR><TD ALIGN=RIGHT><B>Comments</B><TD>%s</TR>\n", $comments;
		printf "<TR><TD ALIGN=RIGHT><B>Joined</B><TD>%s</TR>\n", $joined;
		printf "<TR><TD ALIGN=RIGHT><B>Last Membership Fee</B><TD>%s</TR>\n", $lstmemfee;
		printf "<TR><TD ALIGN=RIGHT><B>Paid last membership on</B><TD>%s</TR>\n", $lstpddate;
		print  "</TABLE>\n";
		print  "<A HREF=\"/scs/games/query.html\">Go back to the Query page</A>\n";
		print  "<P>\n";
	} else {
# Couldn't find the member ID given
		print "No such member ID $id<P>\n";
		print "<A HREF=\"/scs/games/query.html\">Try again</A>\n";
	}

# Close down DB stuff
	$sth->finish || bad_exit($sth->errstr);

	$dbh->disconnect || bad_exit($sth->errstr);
}


sub bad_exit
{
    print "<H2>An internal error has occurred</H2><BR>\n";
    print "Please mail <A HREF=\"mailto:darius\@dons.net.au\">The Administrator</A> and<BR>\n";
    print "say the following error occured - $_[0]<P>\n";
	print "<A HREF=\"/scs/games/query.html\">Back to the Query 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];
}