Mercurial > ~darius > hgwebdir.cgi > SCS_DB

comparison 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
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>Query the SCS Database</TITLE>";
20 print "<H2>Query the SCS Database</H2>";
21
22 $id = $input{'id'};
23
24 # Connect to the Database
25 $dbh = DBI->connect("dbi:Pg:dbname=$dbname", $user, $passwd) || bad_exit($sth->errstr);
26
27 # Prepare the select statement
28 $sth = $dbh->prepare("SELECT * FROM members WHERE memberid = $id") || bad_exit($sth->errstr);
29
30 # Execute it
31 $numrows = $sth->execute || bad_exit($sth->errstr);
32
33 # Get one row. Only one.. if there is more than one, bad things have happened :)
34 if (@array = $sth->fetchrow_array) {
35 $memberid = dtrail(@array[0]);
36 $firstname = dtrail(@array[1]);
37 $lastname = dtrail(@array[2]);
38 $nickname = dtrail(@array[3]);
39 $pin = dtrail(@array[4]);
40 $age = dtrail(@array[5]);
41 $phone1 = dtrail(@array[6]);
42 $ph1_pub = dtrail(@array[7]);
43 $phone2 = dtrail(@array[8]);
44 $ph2_pub = dtrail(@array[9]);
45 $email = dtrail(@array[10]);
46 $email_pub = dtrail(@array[11]);
47 $address1 = dtrail(@array[12]);
48 $address2 = dtrail(@array[13]);
49 $address3 = dtrail(@array[14]);
50 $addy_pub = dtrail(@array[15]);
51 $comments = dtrail(@array[16]);
52 $joined = dtrail(@array[17]);
53 $lstmemfee = dtrail(@array[18]);
54 $lstpddate = dtrail(@array[19]);
55
56 print "<TABLE WIDTH=\"100%\">\n";
57 printf "<TR><TD ALIGN=RIGHT><B>First Name</B><TD>%s</TR>\n", $firstname;
58 printf "<TR><TD ALIGN=RIGHT><B>Last Name</B><TD>%s</TR>\n", $lastname;
59 printf "<TR><TD ALIGN=RIGHT><B>Nick Name</B><TD>%s</TR>\n", $nickname;
60 printf "<TR><TD ALIGN=RIGHT><B>Member ID</B><TD>%s</TR>\n", $memberid;
61 printf "<TR><TD ALIGN=RIGHT><B>Age</B><TD>%s</TR>\n", $age;
62
63 if ($ph1_pub eq '1') {
64 printf "<TR><TD ALIGN=RIGHT><B>Phone 1</B><TD>%s</TR>\n", $phone1;
65 }
66 if ($ph2_pub eq '1') {
67 printf "<TR><TD ALIGN=RIGHT><B>Phone 2</B><TD>%s</TR>\n", $phone2;
68 }
69 if ($email_pub eq '1') {
70 printf "<TR><TD ALIGN=RIGHT><B>Email</B><TD>%s</TR>\n", $email;
71 }
72 if ($addy_pub eq '1') {
73 printf "<TR><TD ALIGN=RIGHT><B>Address 1</B><TD>%s</TR>\n", $address1;
74 printf "<TR><TD ALIGN=RIGHT><B>Address 2</B><TD>%s</TR>\n", $address2;
75 printf "<TR><TD ALIGN=RIGHT><B>Address 3</B><TD>%s</TR>\n", $address3;
76 }
77 printf "<TR><TD ALIGN=RIGHT><B>Comments</B><TD>%s</TR>\n", $comments;
78 printf "<TR><TD ALIGN=RIGHT><B>Joined</B><TD>%s</TR>\n", $joined;
79 printf "<TR><TD ALIGN=RIGHT><B>Last Membership Fee</B><TD>%s</TR>\n", $lstmemfee;
80 printf "<TR><TD ALIGN=RIGHT><B>Paid last membership on</B><TD>%s</TR>\n", $lstpddate;
81 print "</TABLE>\n";
82 print "<A HREF=\"/scs/games/query.html\">Go back to the Query page</A>\n";
83 print "<P>\n";
84 } else {
85 # Couldn't find the member ID given
86 print "No such member ID $id<P>\n";
87 print "<A HREF=\"/scs/games/query.html\">Try again</A>\n";
88 }
89
90 # Close down DB stuff
91 $sth->finish || bad_exit($sth->errstr);
92
93 $dbh->disconnect || bad_exit($sth->errstr);
94 }
95
96
97 sub bad_exit
98 {
99 print "<H2>An internal error has occurred</H2><BR>\n";
100 print "Please mail <A HREF=\"mailto:darius\@dons.net.au\">The Administrator</A> and<BR>\n";
101 print "say the following error occured - $_[0]<P>\n";
102 print "<A HREF=\"/scs/games/query.html\">Back to the Query Page</A>\n";
103
104 print &HtmlBot;
105
106 exit(0);
107 }
108
109 sub dtrail
110 {
111 $_[0] =~ s/(\ *)$//g;
112 return $_[0];
113 }
114
115 sub san_str
116 {
117 $_[0] =~ s/\\/\\\\/g;
118 $_[0] =~ s/'/\\'/g;
119 $_[0] =~ s/"/\\"/g;
120 return $_[0];
121 }
122
123 sub san_num
124 {
125 # $_[0] =~ s/'/\\'/g;
126 return $_[0];
127 }