Skip to content

Commit 7343288

Browse files
Edmund MerglEdmund Mergl
Edmund Mergl
authored and
Edmund Mergl
committed
1.7.01.7.0
1 parent 30b9b52 commit 7343288

File tree

3 files changed

+48
-45
lines changed

3 files changed

+48
-45
lines changed

‎src/interfaces/perl5/eg/ApachePg.pl

Lines changed: 27 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,44 +1,48 @@
11
#!/usr/local/bin/perl
22

33
# demo script, tested with:
4-
# - PostgreSQL-6.2
5-
# - apache_1.2.4
6-
# - mod_perl-1.00
7-
# - perl5.004_03
4+
# - PostgreSQL-6.3
5+
# - apache_1.3
6+
# - mod_perl-1.08
7+
# - perl5.004_04
88

99
use CGI;
1010
use Pg;
11+
use strict;
1112

12-
$query = new CGI;
13+
my $query = new CGI;
1314

1415
print $query->header,
1516
$query->start_html(-title=>'A Simple Example'),
1617
$query->startform,
1718
"<CENTER><H3>Testing Module Pg</H3></CENTER>",
18-
"Enter database name: ",
19-
$query->textfield(-name=>'dbname'),
20-
"<P>",
21-
"Enter select command: ",
22-
$query->textfield(-name=>'cmd', -size=>40),
23-
"<P>",
24-
$query->submit(-value=>'Submit'),
19+
"<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>",
20+
"<TR><TD>Enter conninfo string: </TD>",
21+
"<TD>", $query->textfield(-name=>'conninfo', -size=>40, -default=>'dbname=template1 host=localhost'), "</TD>",
22+
"</TR>",
23+
"<TR><TD>Enter select command: </TD>",
24+
"<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>",
25+
"</TR>",
26+
"</TABLE></CENTER><P>",
27+
"<CENTER>", $query->submit(-value=>'Submit'), "</CENTER>",
2528
$query->endform;
2629

2730
if ($query->param) {
2831

29-
$dbname = $query->param('dbname');
30-
$conn = Pg::connectdb("dbname = $dbname");
31-
$cmd = $query->param('cmd');
32-
$result = $conn->exec($cmd);
33-
print "<TABLE>";
34-
for ($i = 0; $i < $result->ntuples; $i++) {
35-
print "<TR>";
36-
for ($j = 0; $j < $result->nfields; $j++) {
37-
print "<TD>", $result->getvalue($i, $j), "</TD>";
32+
my $conninfo = $query->param('conninfo');
33+
my $conn = Pg::connectdb($conninfo);
34+
if ($conn->status == PGRES_CONNECTION_OK) {
35+
my $cmd = $query->param('cmd');
36+
my $result = $conn->exec($cmd);
37+
print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
38+
my @row;
39+
while (@row = $result->fetchrow) {
40+
print "<TR><TD>", join("</TD><TD>", @row), "</TD></TR>\n";
3841
}
39-
print "</TR>";
42+
print "</TABLE></CENTER><P>\n";
43+
} else {
44+
print "<CENTER><H2>Connect to database failed</H2></CENTER>\n";
4045
}
41-
print "</TABLE>";
4246
}
4347

4448
print $query->end_html;

‎src/interfaces/perl5/eg/example.newstyle

Lines changed: 15 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
#-------------------------------------------------------
44
#
5-
# $Id: example.newstyle,v 1.2 1997/09/25 21:15:02 mergl Exp $
5+
# $Id: example.newstyle,v 1.3 1998/02/20 21:26:06 mergl Exp $
66
#
77
# Copyright (c) 1997 Edmund Mergl
88
#
@@ -13,7 +13,7 @@
1313

1414
######################### We start with some black magic to print on failure.
1515

16-
BEGIN { $| = 1; print "1..61\n"; }
16+
BEGIN { $| = 1; print "1..57\n"; }
1717
END {print "not ok 1\n" unless $loaded;}
1818
use Pg;
1919
$loaded = 1;
@@ -23,6 +23,7 @@ print "ok 1\n";
2323

2424
$dbmain = 'template1';
2525
$dbname = 'pgperltest';
26+
$dbhost = 'localhost';
2627
$trace = '/tmp/pgtrace.out';
2728
$cnt = 2;
2829
$DEBUG = 0; # set this to 1 for traces
@@ -88,7 +89,7 @@ $SIG{PIPE} = sub { print "broken pipe\n" };
8889
######################### create and connect to test database
8990
# 2-4
9091

91-
$conn = Pg::connectdb("dbname=$dbmain");
92+
$conn = Pg::connectdb("dbname=$dbmain host=$dbhost");
9293
cmp_eq(PGRES_CONNECTION_OK, $conn->status);
9394

9495
# might fail if $dbname doesn't exist => don't check resultStatus
@@ -97,7 +98,7 @@ $result = $conn->exec("DROP DATABASE $dbname");
9798
$result = $conn->exec("CREATE DATABASE $dbname");
9899
cmp_eq(PGRES_COMMAND_OK, $result->resultStatus);
99100

100-
$conn = Pg::connectdb("dbname=$dbname");
101+
$conn = Pg::connectdb("dbname=$dbname host=$dbhost");
101102
cmp_eq(PGRES_CONNECTION_OK, $conn->status);
102103

103104
######################### debug, PQtrace
@@ -200,25 +201,22 @@ for ($k = 0; $k < $result->nfields; $k++) {
200201
cmp_eq($k, $fnumber);
201202
}
202203

203-
for ($k = 0; $k < $result->ntuples; $k++) {
204-
$string = "";
205-
for ($l = 0; $l < $result->nfields; $l++) {
206-
$string .= $result->getvalue($k, $l) . " ";
207-
}
208-
$i = $k + 1;
209-
cmp_eq("$i Edmund Mergl ", $string);
204+
$string = "";
205+
while (@row = $result->fetchrow) {
206+
$string = join(" ", @row);
210207
}
208+
cmp_eq("5 Edmund Mergl", $string);
211209

212210
######################### PQnotifies
213-
# 49-51
211+
# 44-47
214212

215213
if (! defined($pid = fork)) {
216214
die "can not fork: $!";
217215
} elsif (! $pid) {
218216
# i'm the child
219217
sleep 2;
220218
bless $conn;
221-
$conn = Pg::connectdb("dbname=$dbname");
219+
$conn = Pg::connectdb("dbname=$dbname host=$dbhost");
222220
$result = $conn->exec("NOTIFY person");
223221
exit;
224222
}
@@ -236,7 +234,7 @@ while (1) {
236234
cmp_eq("person", $table);
237235

238236
######################### PQprint
239-
# 52-53
237+
# 48-49
240238

241239
$result = $conn->exec("SELECT name FROM person WHERE id = 2");
242240
cmp_eq(PGRES_TUPLES_OK, $result->resultStatus);
@@ -246,7 +244,7 @@ $result->print(PRINT, 0, 0, 0, 0, 1, 0, " ", "", "", "myName");
246244
close(PRINT) || die "bad PRINT: $!";
247245

248246
######################### PQlo_import, PQlo_export, PQlo_unlink
249-
# 54-59
247+
# 50-55
250248

251249
$filename = 'ApachePg.pl';
252250
$cwd = `pwd`;
@@ -276,9 +274,9 @@ if ($DEBUG) {
276274
}
277275

278276
######################### disconnect and drop test database
279-
# 60-61
277+
# 56-57
280278

281-
$conn = Pg::connectdb("dbname=$dbmain");
279+
$conn = Pg::connectdb("dbname=$dbmain host=$dbhost");
282280
cmp_eq(PGRES_CONNECTION_OK, $conn->status);
283281

284282
$result = $conn->exec("DROP DATABASE $dbname");

‎src/interfaces/perl5/eg/example.oldstyle

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
#-------------------------------------------------------
44
#
5-
# $Id: example.oldstyle,v 1.2 1997/09/25 21:15:04 mergl Exp $
5+
# $Id: example.oldstyle,v 1.3 1998/02/20 21:26:08 mergl Exp $
66
#
77
# Copyright (c) 1997 Edmund Mergl
88
#
@@ -23,6 +23,7 @@ print "ok 1\n";
2323

2424
$dbmain = 'template1';
2525
$dbname = 'pgperltest';
26+
$dbhost = 'localhost';
2627
$trace = '/tmp/pgtrace.out';
2728
$cnt = 2;
2829
$DEBUG = 0; # set this to 1 for traces
@@ -88,7 +89,7 @@ $SIG{PIPE} = sub { print "broken pipe\n" };
8889
######################### create and connect to test database
8990
# 2-4
9091

91-
$conn = PQsetdb('', '', '', '', $dbmain);
92+
$conn = PQsetdb($dbhost, '', '', '', $dbmain);
9293
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
9394

9495
# might fail if $dbname doesn't exist => don't check resultStatus
@@ -101,7 +102,7 @@ PQclear($result);
101102

102103
PQfinish($conn);
103104

104-
$conn = PQsetdb('', '', '', '', $dbname);
105+
$conn = PQsetdb($dbhost, '', '', '', $dbname);
105106
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
106107

107108
######################### debug, PQtrace
@@ -230,7 +231,7 @@ if (! defined($pid = fork)) {
230231
} elsif (! $pid) {
231232
# i'm the child
232233
sleep 2;
233-
$conn = PQsetdb('', '', '', '', $dbname);
234+
$conn = PQsetdb($dbhost, '', '', '', $dbname);
234235
$result = PQexec($conn, "NOTIFY person");
235236
PQclear($result);
236237
PQfinish($conn);
@@ -299,7 +300,7 @@ if ($DEBUG) {
299300

300301
PQfinish($conn);
301302

302-
$conn = PQsetdb('', '', '', '', $dbmain);
303+
$conn = PQsetdb($dbhost, '', '', '', $dbmain);
303304
cmp_eq(PGRES_CONNECTION_OK, PQstatus($conn));
304305

305306
$result = PQexec($conn, "DROP DATABASE $dbname");

0 commit comments

Comments
 (0)