File: 04misc.t

package info (click to toggle)
libdbd-pg-perl 2.8.7-1%2Blenny1
  • links: PTS, VCS
  • area: main
  • in suites: lenny
  • size: 940 kB
  • ctags: 597
  • sloc: perl: 7,750; ansic: 4,374; makefile: 51
file content (338 lines) | stat: -rw-r--r-- 9,313 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
#!perl

## Various stuff that does not go elsewhere

use 5.006;
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use DBI;
use DBD::Pg;
use lib 't','.';
require 'dbdpg_test_setup.pl';
select(($|=1,select(STDERR),$|=1)[1]);

my $dbh = connect_database();

if (! defined $dbh) {
	plan skip_all => 'Connection to database failed, cannot continue testing';
}
plan tests => 54;

isnt ($dbh, undef, 'Connect to database for miscellaneous tests');

my $t = q{Method 'server_trace_flag' is available without a database handle};
my $num;
eval {
	$num = DBD::Pg->parse_trace_flag('NONE');
};
is ($@, q{}, $t);

$t='Method "server_trace_flag" returns undef on bogus argument';
is ($num, undef, $t);

$t=q{Method "server_trace_flag" returns 0x00000100 for DBI value 'SQL'};
$num = DBD::Pg->parse_trace_flag('SQL');
is ($num, 0x00000100, $t);

$t=q{Method "server_trace_flag" returns 0x01000000 for DBD::Pg flag 'pglibpq'};
$num = DBD::Pg->parse_trace_flag('pglibpq');
is ($num, 0x01000000, $t);

$t=q{Database handle method "server_trace_flag" returns undef on bogus argument};
$num = $dbh->parse_trace_flag('NONE');
is ($num, undef, $t);

$t=q{Database handle method "server_trace_flag" returns 0x00000100 for DBI value 'SQL'};
$num = $dbh->parse_trace_flag('SQL');
is ($num, 0x00000100, $t);

$t=q{Database handle method 'server_trace_flags' returns 0x01000100 for 'SQL|pglibpq'};
$num = $dbh->parse_trace_flags('SQL|pglibpq');
is ($num, 0x01000100, $t);

$t=q{Database handle method 'server_trace_flags' returns 0x03000100 for 'SQL|pglibpq|pgstart'};
$num = $dbh->parse_trace_flags('SQL|pglibpq|pgstart');
is ($num, 0x03000100, $t);

my $flagexp = 24;
my $sth = $dbh->prepare('SELECT 1');
for my $flag (qw/pglibpq pgstart pgend pgprefix pglogin pgquote/) {

	my $hex = 2**$flagexp++;
	$t = qq{Database handle method "server_trace_flag" returns $hex for flag $flag};
	$num = $dbh->parse_trace_flag($flag);
	is ($num, $hex, $t);

	$t = qq{Database handle method 'server_trace_flags' returns $hex for flag $flag};
	$num = $dbh->parse_trace_flags($flag);
	is ($num, $hex, $t);

	$t = qq{Statement handle method "server_trace_flag" returns $hex for flag $flag};
	$num = $sth->parse_trace_flag($flag);
	is ($num, $hex, $t);

	$t = qq{Statement handle method 'server_trace_flags' returns $hex for flag $flag};
	$num = $sth->parse_trace_flag($flag);
	is ($num, $hex, $t);
}

SKIP: {

	eval {
		require File::Temp;
	};
	$@ and skip ('Must have File::Temp to complete trace flag testing', 9);

	my ($fh,$filename) = File::Temp::tempfile('dbdpg_test_XXXXXX', SUFFIX => 'tst', UNLINK => 1);
	my ($flag, $info, $expected, $SQL);

	$t=q{Trace flag 'SQL' works as expected};
	$flag = $dbh->parse_trace_flags('SQL');
	$dbh->trace($flag, $filename);
	$SQL = q{SELECT 'dbdpg_flag_testing'};
	$dbh->do($SQL);
	$dbh->commit();
	$dbh->trace(0);
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = qq{begin;\n\n$SQL;\n\ncommit;\n\n};
	is ($info, $expected, $t);

	$t=q{Trace flag 'pglibpq' works as expected};
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	$dbh->trace($dbh->parse_trace_flag('pglibpq'), $filename);
	$dbh->do($SQL);
	$dbh->commit();
	$dbh->trace(0);
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = q{PQexec
PQresultStatus
PQresultErrorField
PQclear
PQexec
PQresultStatus
PQresultErrorField
PQntuples
PQclear
PQtransactionStatus
PQtransactionStatus
PQexec
PQresultStatus
PQresultErrorField
PQclear
};
	is ($info, $expected, $t);

	$t=q{Trace flag 'pgstart' works as expected};
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	$dbh->trace($dbh->parse_trace_flags('pgstart'), $filename);
	$dbh->do($SQL);
	$dbh->commit();
	$dbh->trace(0);
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = q{Begin pg_quickexec (query: SELECT 'dbdpg_flag_testing' async: 0 async_status: 0)
Begin _result (sql: begin)
Begin _sqlstate
Begin _sqlstate
Begin dbd_db_commit
Begin pg_db_rollback_commit (action: commit AutoCommit: 0 BegunWork: 0)
Begin PGTransactionStatusType
Begin _result (sql: commit)
Begin _sqlstate
};
	is ($info, $expected, $t);

	$t=q{Trace flag 'pgprefix' works as expected};
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	$dbh->trace($dbh->parse_trace_flags('pgstart|pgprefix'), $filename);
	$dbh->do($SQL);
	$dbh->commit();
	$dbh->trace(0);
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = q{dbdpg: Begin pg_quickexec (query: SELECT 'dbdpg_flag_testing' async: 0 async_status: 0)
dbdpg: Begin _result (sql: begin)
dbdpg: Begin _sqlstate
dbdpg: Begin _sqlstate
dbdpg: Begin dbd_db_commit
dbdpg: Begin pg_db_rollback_commit (action: commit AutoCommit: 0 BegunWork: 0)
dbdpg: Begin PGTransactionStatusType
dbdpg: Begin _result (sql: commit)
dbdpg: Begin _sqlstate
};
	is ($info, $expected, $t);

	$t=q{Trace flag 'pgend' works as expected};
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	$dbh->trace($dbh->parse_trace_flags('pgend'), $filename);
	$dbh->do($SQL);
	$dbh->commit();
	$dbh->trace(0);
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = q{End _sqlstate (imp_dbh->sqlstate: 00000)
End _sqlstate (status: 1)
End _result
End _sqlstate (imp_dbh->sqlstate: 00000)
End _sqlstate (status: 2)
End pg_quickexec (rows: 1, txn_status: 2)
End _sqlstate (imp_dbh->sqlstate: 00000)
End _sqlstate (status: 1)
End _result
End pg_db_rollback_commit (result: 1)
};
	is ($info, $expected, $t);

	$t=q{Trace flag 'pglogin' returns undef if no activity};
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	$dbh->trace($dbh->parse_trace_flags('pglogin'), $filename);
	$dbh->do($SQL);
	$dbh->commit();
	$dbh->trace(0);
	seek $fh,0,0;
	{ local $/; $info = <$fh>; }
	$expected = undef;
	is ($info, $expected, $t);

	$t=q{Trace flag 'pglogin' works as expected with DBD::Pg->parse_trace_flag()};
	$dbh->disconnect();
	my $flagval = DBD::Pg->parse_trace_flag('pglogin');
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	DBI->trace($flagval, $filename);
	$dbh = connect_database({nosetup => 1});
	$dbh->do($SQL);
	$dbh->disconnect();
	$dbh = connect_database({nosetup => 1});
	$dbh->disconnect();
	DBI->trace(0);
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = q{Login connection string: 
Connection complete
Disconnection complete
};
	$info =~ s/(Login connection string: ).+/$1/g;
	is ($info, "$expected$expected", $t);

	$t=q{Trace flag 'pglogin' works as expected with DBD::Pg->parse_trace_flag()};
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	DBI->trace($flagval, $filename);
	$dbh = connect_database({nosetup => 1});
	$dbh->disconnect();
	DBI->trace(0);
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = q{Login connection string: 
Connection complete
Disconnection complete
};
	$info =~ s/(Login connection string: ).+/$1/g;
	is ($info, "$expected", $t);

	$t=q{Trace flag 'pgprefix' and 'pgstart' appended to 'pglogin' work as expected};
	seek $fh, 0, 0;
	truncate $fh, tell($fh);
	DBI->trace($flagval, $filename);
	$dbh = connect_database({nosetup => 1});
	$dbh->do($SQL);
	$flagval += $dbh->parse_trace_flags('pgprefix|pgstart');
	$dbh->trace($flagval);
	$dbh->do($SQL);
	$dbh->trace(0);
	$dbh->rollback();
	seek $fh,0,0;
	{ local $/; ($info = <$fh>) =~ s/\r//go; }
	$expected = q{Login connection string: 
Connection complete
dbdpg: Begin pg_quickexec (query: SELECT 'dbdpg_flag_testing' async: 0 async_status: 0)
dbdpg: Begin _sqlstate
};
	$info =~ s/(Login connection string: ).+/$1/g;
	is ($info, "$expected", $t);

} ## end trace flag testing using File::Temp

#
# Test of the "data_sources" method
#

$t='The "data_sources" method did not throw an exception';
my @result;
eval {
	@result = DBI->data_sources('Pg');
};
is ($@, q{}, $t);

$t='The "data_sources" method returns a template1 listing';
if (! defined $result[0]) {
	fail ('The data_sources() method returned an empty list');
}
else {
	is (grep (/^dbi:Pg:dbname=template1$/, @result), '1', $t);
}

$t='The "data_sources" method returns undef when fed a bogus second argument';
@result = DBI->data_sources('Pg','foobar');
is_deeply (@result, undef, $t);

$t='The "data_sources" method returns information when fed a valid port as the second arg';
my $port = $dbh->{pg_port};
@result = DBI->data_sources('Pg',"port=$port");
isnt ($result[0], undef, $t);

#
# Test the use of $DBDPG_DEFAULT
#

$t=qq{Using \$DBDPG_DEFAULT ($DBDPG_DEFAULT) works};
$sth = $dbh->prepare(q{INSERT INTO dbd_pg_test (id, pname) VALUES (?,?)});
eval {
$sth->execute(600,$DBDPG_DEFAULT);
};
$sth->execute(602,123);
is ($@, q{}, $t);

#
# Test transaction status changes
#

$t='Raw ROLLBACK via do() resets the transaction status correctly';
$dbh->{AutoCommit} = 1;
$dbh->begin_work();
$dbh->do('SELECT 123');
eval { $dbh->do('ROLLBACK'); };
is ($@, q{}, $t);
eval { $dbh->begin_work(); };
is ($@, q{}, $t);

$t='Using dbh->commit() resets the transaction status correctly';
eval { $dbh->commit(); };
is ($@, q{}, $t);
eval { $dbh->begin_work(); };
is ($@, q{}, $t);

$t='Raw COMMIT via do() resets the transaction status correctly';
eval { $dbh->do('COMMIT'); };
is ($@, q{}, $t);
eval { $dbh->begin_work(); };
is ($@, q{}, $t);

$t='Calling COMMIT via prepare/execute resets the transaction status correctly';
$sth = $dbh->prepare('COMMIT');
$sth->execute();
eval { $dbh->begin_work(); };
is ($@, q{}, $t);

cleanup_database($dbh,'test');
$dbh->disconnect();