1
|
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 }
|