line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::DBUnit; |
2
|
1
|
|
|
1
|
|
24156
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
3
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
42
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
7
|
use vars qw($VERSION @EXPORT); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
59
|
|
6
|
1
|
|
|
1
|
|
6
|
use base qw(Exporter); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
99
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
15
|
use DBUnit ':all'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
209
|
|
9
|
1
|
|
|
1
|
|
8
|
use DBIx::Connection; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
106
|
|
10
|
1
|
|
|
1
|
|
7
|
use Carp 'confess'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
59
|
|
11
|
1
|
|
|
1
|
|
906
|
use Sub::Uplevel qw(uplevel); |
|
1
|
|
|
|
|
1138
|
|
|
1
|
|
|
|
|
7
|
|
12
|
1
|
|
|
1
|
|
46
|
use Test::Builder; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6058
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
$VERSION = '0.20'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
@EXPORT = qw( |
17
|
|
|
|
|
|
|
expected_dataset_ok dataset_ok expected_xml_dataset_ok xml_dataset_ok |
18
|
|
|
|
|
|
|
reset_schema_ok populate_schema_ok reset_sequence_ok set_refresh_load_strategy |
19
|
|
|
|
|
|
|
set_insert_load_strategy test_connection set_test_connection add_test_connection test_dbh |
20
|
|
|
|
|
|
|
execute_ok throws_ok |
21
|
|
|
|
|
|
|
has_table hasnt_table |
22
|
|
|
|
|
|
|
has_view hasnt_view has_sequence hasnt_sequence |
23
|
|
|
|
|
|
|
has_column hasnt_column column_is_null column_is_not_null has_columns column_type_is |
24
|
|
|
|
|
|
|
column_default_is column_is_unique |
25
|
|
|
|
|
|
|
has_pk has_fk |
26
|
|
|
|
|
|
|
has_index index_is_unique index_is_primary index_is_type |
27
|
|
|
|
|
|
|
has_trigger trigger_is has_routine |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 NAME |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Test::DBUnit - Database testing framework. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 SYNOPSIS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use DBIx::Connection; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
use Test::DBUnit connection_name => 'test'; |
39
|
|
|
|
|
|
|
use Test::More tests => $tests; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
DBIx::Connection->new( |
42
|
|
|
|
|
|
|
name => 'test', |
43
|
|
|
|
|
|
|
dsn => $ENV{DB_TEST_CONNECTION}, |
44
|
|
|
|
|
|
|
username => $ENV{DB_TEST_USERNAME}, |
45
|
|
|
|
|
|
|
password => $ENV{DB_TEST_PASSWORD}, |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
#or |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
use Test::DBUnit; |
51
|
|
|
|
|
|
|
use Test::More tests => $tests; |
52
|
|
|
|
|
|
|
use DBI; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
my $dbh = DBI->connect(...); |
55
|
|
|
|
|
|
|
add_test_connection('test', $dbh) |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
#or |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
use Test::More; |
60
|
|
|
|
|
|
|
use Test::DBUnit dsn => 'dbi:Oracle:localhost:1521/ORACLE_INSTANCE', username => 'user', password => 'password'; |
61
|
|
|
|
|
|
|
plan tests => $tests; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $connection = test_connection(); |
64
|
|
|
|
|
|
|
my $dbh = test_dbh(); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
reset_schema_ok('t/sql/create_schema.sql'); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
populate_schema_ok('t/sql/create_schema.sql'); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
xml_dataset_ok('test1'); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#you database operations here |
73
|
|
|
|
|
|
|
$connection->execute_statement("UPDATE ...."); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
expected_xml_dataset_ok('test1'); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
#or |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
reset_sequence_ok('table1_seq1'); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
dataset_ok( |
82
|
|
|
|
|
|
|
table1 => [column1 => 'x', column2 => 'y'], |
83
|
|
|
|
|
|
|
table1 => [column1 => 'x1_X', column2 => 'y1_X'], |
84
|
|
|
|
|
|
|
... |
85
|
|
|
|
|
|
|
table2 => [column1 => 'x2, column2 => 'y2'], |
86
|
|
|
|
|
|
|
table2 => [column1 => 'x1_N', column2 => 'y1_N'], |
87
|
|
|
|
|
|
|
); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
#you database operations here |
90
|
|
|
|
|
|
|
$connection->execute_statement("UPDATE ...."); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
expected_dataset_ok( |
93
|
|
|
|
|
|
|
table1 => [column1 => 'z', column2 => 'y'], |
94
|
|
|
|
|
|
|
) |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
has_table('table1'); |
97
|
|
|
|
|
|
|
has_columns('table1', [ |
98
|
|
|
|
|
|
|
'column1', 'column2' |
99
|
|
|
|
|
|
|
]); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
column_is_null('table1', 'column1'); |
103
|
|
|
|
|
|
|
column_is_not_null('table1', 'columne2'); |
104
|
|
|
|
|
|
|
column_type_is('table1', 'column1', 'varchar(20)'); |
105
|
|
|
|
|
|
|
has_pk('table1', 'id'); |
106
|
|
|
|
|
|
|
has_fk('table2', 'tab1_id', 'table1'); |
107
|
|
|
|
|
|
|
has_index('table1', 'tab1_idx1', 'column1'); |
108
|
|
|
|
|
|
|
index_is_unique('table1', tab_idx1'); |
109
|
|
|
|
|
|
|
index_is_primary('tabl1', 'tab_idx_pk'); |
110
|
|
|
|
|
|
|
index_is_type('tabl1', 'tab_idx_pk', 'btree'); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
has_routine('approve_document', ['IN varchar', 'RETURN record']); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head1 DESCRIPTION |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Database testing framework that covers both black-box testing and clear-box(white-box) testing. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
Black-box testing allows you to verify that your database data match expected set of values. |
120
|
|
|
|
|
|
|
This dataset comes either from tables, views, stored procedure/functions. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Clear-box testing focuses on existence database schema elements like tables, views, columns, indexes, triggers, |
123
|
|
|
|
|
|
|
procedures, functions, constraints. Additionally you can test particular characteristic of those object like |
124
|
|
|
|
|
|
|
type, default value, is unique, exceptions etc . |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 Managing test data |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Database tests should giving you complete and fine grained control over the test data that is used. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
use Test::DBUnit dsn => $dsn, username => $username, password => $password; |
131
|
|
|
|
|
|
|
reset_schema_ok('t/sql/create_schema.sql'); |
132
|
|
|
|
|
|
|
populate_schema_ok('t/sql/create_schema.sql'); |
133
|
|
|
|
|
|
|
reset_sequence_ok('emp_seq'); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 Loading test data sets |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Before you want to test your business logic it is essential to have repeatable snapshot of the data to be tested, |
138
|
|
|
|
|
|
|
so this module allows you fill in/synchronize your database with the testing data. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
dataset_ok( |
141
|
|
|
|
|
|
|
emp => [ename => "john", deptno => "10", job => "project manager"], |
142
|
|
|
|
|
|
|
emp => [ename => "scott", deptno => "10", job => "project manager"], |
143
|
|
|
|
|
|
|
bonus => [ename => "scott", job => "project manager", sal => "20"], |
144
|
|
|
|
|
|
|
); |
145
|
|
|
|
|
|
|
or |
146
|
|
|
|
|
|
|
xml_dataset_ok('test1'); |
147
|
|
|
|
|
|
|
t/test_unit.test1.xml #given that you testing module is t/test_unit.t |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
You may automatically create testing dataset or expected dataset using L module. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 Getting connection to test database |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
my $connection = test_connection(); |
160
|
|
|
|
|
|
|
#business logic that change tested data comes here |
161
|
|
|
|
|
|
|
.... |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head2 Verifying test results |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
It can be useful to use data sets for checking the contents of a database after is has been modified by a test. |
166
|
|
|
|
|
|
|
You may want to check the result of a update/insert/delete method or a stored procedure. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
expected_dataset_ok( |
169
|
|
|
|
|
|
|
emp => [empno => "1", ename => "Scott", deptno => "10", job => "project manager"], |
170
|
|
|
|
|
|
|
emp => [empno => "2", ename => "John", deptno => "10", job => "engineer"], |
171
|
|
|
|
|
|
|
emp => [empno => "3", ename => "Mark", deptno => "10", job => "sales assistant"], |
172
|
|
|
|
|
|
|
bonus => [ename => "scott", job => "project manager", sal => "20"], |
173
|
|
|
|
|
|
|
); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
expected_dataset_ok( |
176
|
|
|
|
|
|
|
emp => [empno => "1", ename => "Scott", deptno => "10", job => "project manager"], |
177
|
|
|
|
|
|
|
emp => [empno => "2", ename => "John", deptno => "10", job => "engineer"], |
178
|
|
|
|
|
|
|
emp => [empno => "3", ename => "Mark", deptno => "10", job => "sales assistant"], |
179
|
|
|
|
|
|
|
bonus => [ename => "scott", job => "project manager", sal => "20"], |
180
|
|
|
|
|
|
|
$description |
181
|
|
|
|
|
|
|
); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
or |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
expected_xml_dataset_ok('test1'); |
186
|
|
|
|
|
|
|
t/test_unit.test1-result.xml #given that you testing module is t/test_unit.t |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head3 Dynamic tests |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
You may want to check not just a particular value but range of values or perform complex condition against |
200
|
|
|
|
|
|
|
database column's value, so that you can use callback. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
expected_dataset_ok( |
203
|
|
|
|
|
|
|
emp => [empno => "1", ename => "Scott", deptno => "10", job => "project manager"], |
204
|
|
|
|
|
|
|
emp => [empno => "2", ename => "John", deptno => "10", job => "engineer"], |
205
|
|
|
|
|
|
|
emp => [empno => "3", ename => "Mark", deptno => "10", |
206
|
|
|
|
|
|
|
job => sub { |
207
|
|
|
|
|
|
|
my $value = shift; |
208
|
|
|
|
|
|
|
!! ($value =~ /sales assistant/i); |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
], |
211
|
|
|
|
|
|
|
bonus => [ename => "scott", job => "project manager", sal => "20"], |
212
|
|
|
|
|
|
|
); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
expected_dataset_ok( |
215
|
|
|
|
|
|
|
emp => [empno => "1", ename => "Scott", deptno => "10", job => "project manager"], |
216
|
|
|
|
|
|
|
emp => [empno => "2", ename => "John", deptno => "10", job => "engineer"], |
217
|
|
|
|
|
|
|
emp => [empno => "3", ename => "Mark", deptno => "10", |
218
|
|
|
|
|
|
|
job => sub { |
219
|
|
|
|
|
|
|
my $value = shift; |
220
|
|
|
|
|
|
|
!! ($value =~ /sales assistant/i); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
], |
223
|
|
|
|
|
|
|
bonus => [ename => "scott", job => "project manager", sal => "20"], |
224
|
|
|
|
|
|
|
$description |
225
|
|
|
|
|
|
|
); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
or |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my $val = shift; |
236
|
|
|
|
|
|
|
!! ($val eq "sales assistant"); |
237
|
|
|
|
|
|
|
]]> |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 Configuring the dataset load strategy |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
By default, datasets are loaded into the database using an insert load strategy. |
245
|
|
|
|
|
|
|
This means that all data in the tables that are present in the dataset is deleted, |
246
|
|
|
|
|
|
|
after which the test data records are inserted. Order in with all data is deleted |
247
|
|
|
|
|
|
|
depends on reverse table occurrence in the dataset, however you may force order of |
248
|
|
|
|
|
|
|
data by specifying empty table: |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
table1 => [], #this fore delete operation in occurrence order |
251
|
|
|
|
|
|
|
table1 => [col1 => 1, col2 => 'some data'], |
252
|
|
|
|
|
|
|
or in xml file |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
In this strategy number of rows will be validated against datasets in (xml_)expexted_dataset_ok method. |
257
|
|
|
|
|
|
|
Load strategy behavior is configurable, |
258
|
|
|
|
|
|
|
it can be modified by calling: |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
set_insert_load_strategy(); |
261
|
|
|
|
|
|
|
or in XML |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
.... |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
set_refresh_load_strategy(); |
269
|
|
|
|
|
|
|
or in XML |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
The alternative to the insert load strategy is refresh load strategy. |
277
|
|
|
|
|
|
|
In this case update on existing rows will take place or insert occurs if rows are missing. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head3 Tests with multiple database instances. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
You may need to test data from more then one database instance, |
282
|
|
|
|
|
|
|
so that you have to specify connection against which tests will be performed |
283
|
|
|
|
|
|
|
either by adding prefix to test methods, or by setting explicit test connection context. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
use Test::DBUnit connection_names => ['my_connection_1', 'my_connection_2']; |
287
|
|
|
|
|
|
|
my $dbh = DBI->connect($dsn_1, $username, $password); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
add_test_connection('my_connection_1', dbh => $dbh); |
290
|
|
|
|
|
|
|
# or |
291
|
|
|
|
|
|
|
my $connection = DBIx::Connection->new( |
292
|
|
|
|
|
|
|
name => 'my_connection_2', |
293
|
|
|
|
|
|
|
dsn => $dsn_2, |
294
|
|
|
|
|
|
|
username => $username, |
295
|
|
|
|
|
|
|
password => $password, |
296
|
|
|
|
|
|
|
); |
297
|
|
|
|
|
|
|
add_test_connection($connection); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
#set connection context by prefix |
301
|
|
|
|
|
|
|
my_connection_1_reset_schema_ok('t/sql/create_schema_1.sql'); |
302
|
|
|
|
|
|
|
my_connection_1_populate_schema_ok('t/sql/create_schema_1.sql'); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my_connection_2_xml_dataset_ok('test1'); |
305
|
|
|
|
|
|
|
... |
306
|
|
|
|
|
|
|
my_connection_2_expected_xml_dataset_ok('test1'); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
#set connection context explicitly. |
310
|
|
|
|
|
|
|
set_test_connection('my_connection_2'); |
311
|
|
|
|
|
|
|
reset_schema_ok('t/sql/create_schema_2.sql'); |
312
|
|
|
|
|
|
|
populate_schema_ok('t/sql/create_schema_2.sql'); |
313
|
|
|
|
|
|
|
xml_dataset_ok('test1'); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
expected_xml_dataset_ok('test1'); |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
=head2 Working with sequences |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
You may use sequences or auto generated features, so this module allows you handle that. |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
reset_sequence_ok('emp_seq'); |
323
|
|
|
|
|
|
|
or for MySQL |
324
|
|
|
|
|
|
|
reset_sequence_ok('test_table_name') |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
The ALTER TABLE test_table_name AUTO_INCREMENT = 1 will be issued |
327
|
|
|
|
|
|
|
Note that for MySQL reset sequence the test_table_name must be empty. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
or in XML |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
.... |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=head3 Sequence tests with Oracle |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
t/sql/create_schema.sql |
339
|
|
|
|
|
|
|
CREATE SEQUENCE emp_seq; |
340
|
|
|
|
|
|
|
CREATE TABLE emp( |
341
|
|
|
|
|
|
|
empno NUMBER NOT NULL, |
342
|
|
|
|
|
|
|
ename VARCHAR2(10), |
343
|
|
|
|
|
|
|
job VARCHAR2(20), |
344
|
|
|
|
|
|
|
mgr NUMBER(4), |
345
|
|
|
|
|
|
|
hiredate DATE, |
346
|
|
|
|
|
|
|
sal NUMBER(7,2), |
347
|
|
|
|
|
|
|
comm NUMBER(7,2), |
348
|
|
|
|
|
|
|
deptno NUMBER(2), |
349
|
|
|
|
|
|
|
CONSTRAINT emp_pk PRIMARY KEY(empno), |
350
|
|
|
|
|
|
|
FOREIGN KEY (deptno) REFERENCES dept (deptno) |
351
|
|
|
|
|
|
|
); |
352
|
|
|
|
|
|
|
CREATE OR REPLACE TRIGGER emp_autogen |
353
|
|
|
|
|
|
|
BEFORE INSERT ON emp FOR EACH ROW |
354
|
|
|
|
|
|
|
BEGIN |
355
|
|
|
|
|
|
|
IF :new.empno is null then |
356
|
|
|
|
|
|
|
SELECT emp_seq.nextval INTO :new.empno FROM dual; |
357
|
|
|
|
|
|
|
END IF; |
358
|
|
|
|
|
|
|
END; |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
#unit test |
361
|
|
|
|
|
|
|
reset_sequence_ok('emp_seq'); |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
dataset_ok( |
364
|
|
|
|
|
|
|
emp => [ename => "John", deptno => "10", job => "project manager"], |
365
|
|
|
|
|
|
|
emp => [ename => "Scott", deptno => "10", job => "project manager"] |
366
|
|
|
|
|
|
|
); |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
.... |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
expected_dataset_ok( |
371
|
|
|
|
|
|
|
emp => [empno => 1, ename => "John", deptno => "10", job => "project manager"], |
372
|
|
|
|
|
|
|
emp => [empno => 2, ename => "Scott", deptno => "10", job => "project manager"] |
373
|
|
|
|
|
|
|
) |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=head3 Sequence tests with PostgreSQL |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
t/sql/create_schema.sql |
378
|
|
|
|
|
|
|
CREATE SEQUENCE emp_seq; |
379
|
|
|
|
|
|
|
CREATE TABLE emp( |
380
|
|
|
|
|
|
|
empno INT4 DEFAULT nextval('emp_seq') NOT NULL, |
381
|
|
|
|
|
|
|
ename VARCHAR(10), |
382
|
|
|
|
|
|
|
job VARCHAR(20), |
383
|
|
|
|
|
|
|
mgr NUMERIC(4), |
384
|
|
|
|
|
|
|
hiredate DATE, |
385
|
|
|
|
|
|
|
sal NUMERIC(7,2), |
386
|
|
|
|
|
|
|
comm NUMERIC(7,2), |
387
|
|
|
|
|
|
|
deptno NUMERIC(2), |
388
|
|
|
|
|
|
|
CONSTRAINT emp_pk PRIMARY KEY(empno), |
389
|
|
|
|
|
|
|
FOREIGN KEY (deptno) REFERENCES dept (deptno) |
390
|
|
|
|
|
|
|
); |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
#unit test |
393
|
|
|
|
|
|
|
reset_sequence_ok('emp_seq'); |
394
|
|
|
|
|
|
|
.... |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head3 Auto generated field values tests with MySQL |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
t/sql/create_schema.sql |
399
|
|
|
|
|
|
|
CREATE TABLE emp( |
400
|
|
|
|
|
|
|
empno MEDIUMINT AUTO_INCREMENT, |
401
|
|
|
|
|
|
|
ename VARCHAR(10), |
402
|
|
|
|
|
|
|
job VARCHAR(20), |
403
|
|
|
|
|
|
|
mgr NUMERIC(4), |
404
|
|
|
|
|
|
|
hiredate DATE, |
405
|
|
|
|
|
|
|
sal NUMERIC(7,2), |
406
|
|
|
|
|
|
|
comm NUMERIC(7,2), |
407
|
|
|
|
|
|
|
deptno NUMERIC(2), |
408
|
|
|
|
|
|
|
CONSTRAINT emp_pk PRIMARY KEY(empno), |
409
|
|
|
|
|
|
|
FOREIGN KEY (deptno) REFERENCES dept (empno) |
410
|
|
|
|
|
|
|
); |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
#unit test |
413
|
|
|
|
|
|
|
reset_sequence_ok('emp'); |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
dataset_ok( |
416
|
|
|
|
|
|
|
emp => [ename => "John", deptno => "10", job => "project manager"], |
417
|
|
|
|
|
|
|
emp => [ename => "Scott", deptno => "10", job => "project manager"] |
418
|
|
|
|
|
|
|
); |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
.... |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
expected_dataset_ok( |
423
|
|
|
|
|
|
|
emp => [empno => 1, ename => "John", deptno => "10", job => "project manager"], |
424
|
|
|
|
|
|
|
emp => [empno => 2, ename => "Scott", deptno => "10", job => "project manager"] |
425
|
|
|
|
|
|
|
) |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=head2 Working with LOBs |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
For handling very large datasets, the DB vendors provide the LOB (large object) data types. |
430
|
|
|
|
|
|
|
You may use this features, and this module allows you test it. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head3 LOBs tests with Oracle |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
Oracle BLOB data type that contains binary data with a maximum size of 4 gigabytes. |
435
|
|
|
|
|
|
|
It is advisable to store blob size in separate column to optimize fetch process.(doc_size) |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
CREATE TABLE image(id NUMBER, name VARCHAR2(100), doc_size NUMBER, blob_content BLOB); |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
dataset_ok( |
440
|
|
|
|
|
|
|
emp => [empno => 1, ename => 'scott', deptno => 10], |
441
|
|
|
|
|
|
|
image => [id => 1, name => 'Moon' |
442
|
|
|
|
|
|
|
blob_content => {file => 'data/chart1.jpg', size_column => 'doc_size'} |
443
|
|
|
|
|
|
|
] |
444
|
|
|
|
|
|
|
); |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
..... |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
expected_dataset_ok( |
449
|
|
|
|
|
|
|
emp => [empno => 1, ename => 'scott', deptno => 10], |
450
|
|
|
|
|
|
|
image => [id => 1, name => 'Moon' |
451
|
|
|
|
|
|
|
blob_content => {file => 'data/chart2.jpg', size_column => 'doc_size'} |
452
|
|
|
|
|
|
|
] |
453
|
|
|
|
|
|
|
); |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=head3 LOBs tests with PostgreSQL |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
PostgreSQL has the large object facility, but in this case the tested table doesn't contain LOBs type |
459
|
|
|
|
|
|
|
instead it keeps reference to lob_id, created by lo_creat PostgreSQL functions. |
460
|
|
|
|
|
|
|
It requires storing blob size in separate column to be able to fetch blob.(doc_size) |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
CREATE TABLE image(id NUMERIC, name VARCHAR(100), doc_size NUMERIC, blob_content oid) |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
dataset_ok( |
465
|
|
|
|
|
|
|
emp => [empno => 1, ename => 'scott', deptno => 10], |
466
|
|
|
|
|
|
|
image => [id => 1, name => 'Moon' |
467
|
|
|
|
|
|
|
blob_content => {file => 'data/chart1.jpg', size_column => 'doc_size'} |
468
|
|
|
|
|
|
|
] |
469
|
|
|
|
|
|
|
); |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=head3 LOBs test with MySQL |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
In MySQL, binary LOBs are just table fields like any other types , so storing blob size is optional. |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
CREATE TABLE lob_test(id NUMERIC, name VARCHAR(100), doc_size NUMERIC, blob_content LONGBLOB) |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
dataset_ok( |
479
|
|
|
|
|
|
|
emp => [empno => 1, ename => 'scott', deptno => 10], |
480
|
|
|
|
|
|
|
image => [id => 1, name => 'Moon' |
481
|
|
|
|
|
|
|
blob_content => {file => 'data/chart1.jpg', size_column => 'doc_size'} |
482
|
|
|
|
|
|
|
] |
483
|
|
|
|
|
|
|
); |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
=head2 Testing database stored procedures/functions |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
You may need to test execution of database stored procedures/functions. This module |
489
|
|
|
|
|
|
|
allows you test both normal and exception execution path. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
execute_ok($plsql, $expected_values); |
493
|
|
|
|
|
|
|
throws_ok($sql, $errcode, $errmsg, $description); |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
=head2 Testing database schema objects |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
It can be useful to validate existence or characteristic of any schema objects including tables, columns, |
499
|
|
|
|
|
|
|
indexes, constraints, etc .... |
500
|
|
|
|
|
|
|
No once do the staging, life environments have discrepancy starting with missing indexes, constraints, |
501
|
|
|
|
|
|
|
ending at difference in the table structures. This may lead too many problems including |
502
|
|
|
|
|
|
|
poor performance due to missing or wrong index type, |
503
|
|
|
|
|
|
|
execution errors caused by incorrect columns data type, |
504
|
|
|
|
|
|
|
logical errors by wrong or missing trigger/function. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
It's felt that validation of schema objects significantly mitigate the risk of having out of sync state. |
507
|
|
|
|
|
|
|
The following method allows you tests schema objects: |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=head3 Table validation |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
Allows you testing existence/non-existence of the particular table. |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
has_table('table1'); |
515
|
|
|
|
|
|
|
hasnt_table('table1'); |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=head3 Table's columns validation |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
Focuses on testing existence/non existence column, additionally you may test column definition. |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
has_columns('table1', [ |
523
|
|
|
|
|
|
|
'column1', 'column2', 'columnN' |
524
|
|
|
|
|
|
|
]); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
has_column('table1', 'column1'); |
527
|
|
|
|
|
|
|
hasnt_column('table1', 'column1'); |
528
|
|
|
|
|
|
|
column_is_null('table1', 'column1'); |
529
|
|
|
|
|
|
|
column_is_not_null('table1', 'columne2'); |
530
|
|
|
|
|
|
|
column_type_is('table1', 'column1', 'varchar(20)'); |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=head3 Constraints validation |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Gives you options to validate primary, foreign keys. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
has_pk('table1', 'id'); |
538
|
|
|
|
|
|
|
has_fk('table2', 'tab1_id', 'table1'); |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=head3 Indexes validation. |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
Allows you testing existence of the index, you may also test index uniqueness, type. |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
has_index('table1', 'tab1_idx1', 'column1'); |
545
|
|
|
|
|
|
|
index_is_unique('table1', tab_idx1'); |
546
|
|
|
|
|
|
|
index_is_primary('tabl1', 'tab_idx_pk'); |
547
|
|
|
|
|
|
|
index_is_type('tabl1', 'tab_idx_pk', 'btree'); |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=head3 Functions/procedures validation |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
You may be interested in testing both existence of database functions/procedures |
553
|
|
|
|
|
|
|
with the specified interface. |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
has_routine('approve_document', ['IN varchar', 'RETURN record']); |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
You may automatically create schema objects tests using L module. |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=head2 EXPORT |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
expected_data_set_ok |
563
|
|
|
|
|
|
|
dataset_ok |
564
|
|
|
|
|
|
|
expected_xml_dataset_ok |
565
|
|
|
|
|
|
|
xml_dataset_ok |
566
|
|
|
|
|
|
|
reset_schema_ok |
567
|
|
|
|
|
|
|
populate_schema_ok |
568
|
|
|
|
|
|
|
reset_sequence_ok |
569
|
|
|
|
|
|
|
execute_ok |
570
|
|
|
|
|
|
|
throws_ok |
571
|
|
|
|
|
|
|
has_table |
572
|
|
|
|
|
|
|
hasnt_table |
573
|
|
|
|
|
|
|
has_view |
574
|
|
|
|
|
|
|
hasnt_view |
575
|
|
|
|
|
|
|
has_column |
576
|
|
|
|
|
|
|
hasnt_column |
577
|
|
|
|
|
|
|
has_columns |
578
|
|
|
|
|
|
|
column_is_null |
579
|
|
|
|
|
|
|
column_is_not_null |
580
|
|
|
|
|
|
|
column_type_is |
581
|
|
|
|
|
|
|
has_sequence |
582
|
|
|
|
|
|
|
hasnt_sequence |
583
|
|
|
|
|
|
|
has_pk |
584
|
|
|
|
|
|
|
has_fk |
585
|
|
|
|
|
|
|
has_index |
586
|
|
|
|
|
|
|
index_is_unique |
587
|
|
|
|
|
|
|
index_is_primary |
588
|
|
|
|
|
|
|
index_is_type |
589
|
|
|
|
|
|
|
has_trigger |
590
|
|
|
|
|
|
|
trigger_is |
591
|
|
|
|
|
|
|
has_routine |
592
|
|
|
|
|
|
|
set_refresh_load_strategy |
593
|
|
|
|
|
|
|
set_insert_load_strategy |
594
|
|
|
|
|
|
|
add_test_connection |
595
|
|
|
|
|
|
|
set_test_connection |
596
|
|
|
|
|
|
|
test_connection |
597
|
|
|
|
|
|
|
test_dbh |
598
|
|
|
|
|
|
|
by default. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
_(expected_data_set_ok | dataset_ok | expected_xml_dataset_ok | xml_dataset_ok | |
602
|
|
|
|
|
|
|
reset_schema_ok | populate_schema_ok | reset_sequence_ok | execute_ok | throws_ok | |
603
|
|
|
|
|
|
|
has_table | hasnt_table | has_view | hasnt_view | has_column | |
604
|
|
|
|
|
|
|
hasnt_column | has_columns | column_is_null | column_is_not_null column_type_is | |
605
|
|
|
|
|
|
|
has_pk | has_fk | has_index | index_is_unique | index_is_primary | index_is_type |
606
|
|
|
|
|
|
|
has_trigger | trigger_is | has_routine |
607
|
|
|
|
|
|
|
set_refresh_load_strategy | set_insert_load_strategy) |
608
|
|
|
|
|
|
|
by connection_name tags. |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
=head2 METHODS |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=over |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
=item connection_name |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
=cut |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
{ |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
my $Tester = Test::Builder->new; |
621
|
|
|
|
|
|
|
my $dbunit; |
622
|
|
|
|
|
|
|
my $multiple_tests; |
623
|
|
|
|
|
|
|
sub import { |
624
|
0
|
|
|
0
|
|
|
my ($self, %args) = @_; |
625
|
0
|
0
|
|
|
|
|
if($args{connection_names}) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
626
|
0
|
|
|
|
|
|
generate_connection_test_stubs($args{connection_names}); |
627
|
0
|
|
|
|
|
|
$multiple_tests = 1; |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
} elsif($args{connection_name}) { |
630
|
0
|
|
|
|
|
|
$dbunit = DBUnit->new(%args); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
} elsif(scalar(%args)) { |
633
|
0
|
|
|
|
|
|
eval { |
634
|
0
|
|
|
|
|
|
$dbunit = DBUnit->new(connection_name => 'test'); |
635
|
0
|
|
|
|
|
|
_initialise_connection(%args); |
636
|
|
|
|
|
|
|
}; |
637
|
0
|
0
|
|
|
|
|
if ($@) { |
638
|
0
|
|
|
|
|
|
my ($msg) = ($@ =~ /([^\n]+)/); |
639
|
0
|
|
|
|
|
|
$Tester->plan( skip_all => $msg); |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
} |
642
|
0
|
|
0
|
|
|
|
$dbunit ||= DBUnit->new(connection_name => 'test'); |
643
|
0
|
|
|
|
|
|
$self->export_to_level( 1, $self, $_ ) foreach @EXPORT; |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=item generate_connection_test_stubs |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
Generated test stubs on fly for passed in connection names. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=cut |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub generate_connection_test_stubs { |
654
|
0
|
|
|
0
|
1
|
|
my ($connections) = @_; |
655
|
0
|
|
|
|
|
|
for my $connection (@$connections) { |
656
|
0
|
|
|
|
|
|
for my $exp (@EXPORT[0 ..9]) { |
657
|
0
|
|
|
|
|
|
my $method_name = "${connection}_$exp"; |
658
|
|
|
|
|
|
|
Abstract::Meta::Class::add_method(__PACKAGE__, |
659
|
|
|
|
|
|
|
$method_name, sub { |
660
|
0
|
|
|
0
|
|
|
my $ory_connection_name = $dbunit->connection_name; |
661
|
0
|
|
|
|
|
|
set_test_connection($connection); |
662
|
0
|
|
|
|
|
|
my $method = __PACKAGE__->can($exp); |
663
|
0
|
|
|
|
|
|
$method->(@_); |
664
|
0
|
|
|
|
|
|
set_test_connection($ory_connection_name); |
665
|
|
|
|
|
|
|
} |
666
|
0
|
|
|
|
|
|
); |
667
|
0
|
|
|
|
|
|
push @EXPORT, $method_name; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
=item reset_schema_ok |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
Tests database schema reset using sql file. Takes file name as parameter. |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
use Test::More tests => $tests; |
678
|
|
|
|
|
|
|
use Test::DBUnit dsn => $dsn, username => $username, password => $password; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
... |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
reset_schema_ok('t/sql/create_schema.sql'); |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=cut |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
sub reset_schema_ok { |
687
|
0
|
|
|
0
|
1
|
|
my ($file_name) = @_; |
688
|
0
|
|
|
|
|
|
my $description = "should reset schema" . test_connection_context() . " (${file_name})"; |
689
|
0
|
|
|
|
|
|
my $ok; |
690
|
0
|
|
|
|
|
|
eval { |
691
|
0
|
|
|
|
|
|
$dbunit->reset_schema($file_name); |
692
|
0
|
|
|
|
|
|
$ok = 1; |
693
|
|
|
|
|
|
|
}; |
694
|
0
|
|
|
|
|
|
my $explanation = ""; |
695
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
696
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description ); |
697
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
698
|
0
|
|
|
|
|
|
$ok; |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=item populate_schema_ok |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Tests database schema population using sql file. Takes file name as parameter. |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
use Test::More tests => $tests; |
707
|
|
|
|
|
|
|
use Test::DBUnit dsn => $dsn, username => $username, password => $password; |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
... |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
populate_schema_ok('t/sql/populate_schema.sql'); |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=cut |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
sub populate_schema_ok { |
717
|
0
|
|
|
0
|
1
|
|
my ($file_name) = @_; |
718
|
0
|
|
|
|
|
|
my $description = "should populate schema". test_connection_context() ." (${file_name})"; |
719
|
0
|
|
|
|
|
|
my $ok; |
720
|
0
|
|
|
|
|
|
eval { |
721
|
0
|
|
|
|
|
|
$dbunit->populate_schema($file_name); |
722
|
0
|
|
|
|
|
|
$ok = 1; |
723
|
|
|
|
|
|
|
}; |
724
|
0
|
|
|
|
|
|
my $explanation = ""; |
725
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
726
|
0
|
|
|
|
|
|
$Tester->ok( $ok, $description ); |
727
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
728
|
0
|
|
|
|
|
|
$ok; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=item reset_sequence_ok |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
Resets database sequence. Takes sequence name as parameter. |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
use Test::More tests => $tests; |
737
|
|
|
|
|
|
|
use Test::DBUnit dsn => $dsn, username => $username, password => $password; |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
reset_sequnce('table_seq1'); |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=cut |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
sub reset_sequence_ok { |
745
|
0
|
|
|
0
|
1
|
|
my ($sequence_name) = @_; |
746
|
0
|
|
|
|
|
|
my $description = "should reset sequence" . test_connection_context() . " ${sequence_name}"; |
747
|
0
|
|
|
|
|
|
my $ok; |
748
|
0
|
|
|
|
|
|
eval { |
749
|
0
|
|
|
|
|
|
$dbunit->reset_sequence($sequence_name); |
750
|
0
|
|
|
|
|
|
$ok = 1; |
751
|
|
|
|
|
|
|
}; |
752
|
0
|
|
|
|
|
|
my $explanation = ""; |
753
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
754
|
0
|
|
|
|
|
|
$Tester->ok( $ok, $description ); |
755
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
756
|
0
|
|
|
|
|
|
$ok; |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=item xml_dataset_ok |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Tests database schema population/sync to the content of the xml file. |
763
|
|
|
|
|
|
|
Takes test unit name, that is used to resolve xml file name. |
764
|
|
|
|
|
|
|
Xml file name that will be loaded is build as follow |
765
|
|
|
|
|
|
|
..xml |
766
|
|
|
|
|
|
|
for instance |
767
|
|
|
|
|
|
|
the following invocation xml_dataset_ok('test1') from t/sub_dir/001_test.t file will |
768
|
|
|
|
|
|
|
expect t/sub_dir/001_test.test1.xml file. |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=cut |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
sub xml_dataset_ok { |
781
|
0
|
|
|
0
|
1
|
|
my ($unit_name) = @_; |
782
|
0
|
0
|
|
|
|
|
my $xm_file = ($unit_name =~ /.xml$/i) |
783
|
|
|
|
|
|
|
? $unit_name |
784
|
|
|
|
|
|
|
: _xml_test_file($unit_name) . ".xml"; |
785
|
0
|
|
|
|
|
|
my $description = "should load dataset" . test_connection_context() . " (${xm_file})"; |
786
|
0
|
|
|
|
|
|
my $ok; |
787
|
0
|
|
|
|
|
|
eval { |
788
|
0
|
|
|
|
|
|
$dbunit->xml_dataset($xm_file); |
789
|
0
|
|
|
|
|
|
$ok = 1; |
790
|
|
|
|
|
|
|
}; |
791
|
0
|
|
|
|
|
|
my $explanation = ""; |
792
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
793
|
0
|
|
|
|
|
|
$Tester->ok( $ok, $description ); |
794
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
795
|
0
|
|
|
|
|
|
$ok; |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=item expected_xml_dataset_ok |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
Validates expected database loaded from xml file against database schema. |
802
|
|
|
|
|
|
|
Takes test unit name, that is used to resolve xml file name. |
803
|
|
|
|
|
|
|
Xml file name that will be loaded is build as follow |
804
|
|
|
|
|
|
|
..xml unless you pass full xml file name. |
805
|
|
|
|
|
|
|
for instance |
806
|
|
|
|
|
|
|
the following invocation xml_dataset_ok('test1') from t/sub_dir/001_test.t file will |
807
|
|
|
|
|
|
|
expect t/sub_dir/001_test.test1.xml file. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=cut |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub expected_xml_dataset_ok { |
819
|
0
|
|
|
0
|
1
|
|
my ($unit_name) = @_; |
820
|
0
|
0
|
|
|
|
|
my $xm_file = ($unit_name =~ /.xml$/i) |
821
|
|
|
|
|
|
|
? $unit_name |
822
|
|
|
|
|
|
|
: _xml_test_file($unit_name) . "-result.xml"; |
823
|
0
|
|
|
|
|
|
my $description = "should validate expected dataset" . test_connection_context() . "(${xm_file})"; |
824
|
0
|
|
|
|
|
|
my $validation; |
825
|
|
|
|
|
|
|
my $ok; |
826
|
0
|
|
|
|
|
|
eval { |
827
|
0
|
|
|
|
|
|
$validation = $dbunit->expected_xml_dataset($xm_file); |
828
|
0
|
0
|
|
|
|
|
$ok = 1 unless $validation; |
829
|
|
|
|
|
|
|
}; |
830
|
0
|
|
|
|
|
|
my $explanation = ""; |
831
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $validation if $validation; |
832
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
833
|
0
|
|
|
|
|
|
$Tester->ok( $ok, $description ); |
834
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
835
|
0
|
|
|
|
|
|
$ok; |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=item dataset_ok |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
Tests database schema population/sync to the passed in dataset. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
dataset_ok( |
845
|
|
|
|
|
|
|
$table => $row1, |
846
|
|
|
|
|
|
|
$table => $row2, |
847
|
|
|
|
|
|
|
$description |
848
|
|
|
|
|
|
|
); |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
dataset_ok( |
851
|
|
|
|
|
|
|
table1 => [], #this deletes all data from table1 (DELETE FROM table1) |
852
|
|
|
|
|
|
|
table2 => [], #this deletes all data from table2 (DELETE FROM table2) |
853
|
|
|
|
|
|
|
table1 => [col1 => 'va1', col2 => 'val2'], #this insert or update depend on strategy |
854
|
|
|
|
|
|
|
table1 => [col1 => 'xval1', col2 => 'xval2'], |
855
|
|
|
|
|
|
|
) |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=cut |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
sub dataset_ok { |
860
|
0
|
|
|
0
|
1
|
|
my (@dataset) = @_; |
861
|
0
|
0
|
|
|
|
|
my $description = (@dataset % 2) |
862
|
|
|
|
|
|
|
? pop(@dataset) |
863
|
|
|
|
|
|
|
: "should load dataset" . test_connection_context(); |
864
|
0
|
|
|
|
|
|
my $ok; |
865
|
0
|
|
|
|
|
|
eval { |
866
|
0
|
|
|
|
|
|
$dbunit->dataset(@dataset); |
867
|
0
|
|
|
|
|
|
$ok = 1; |
868
|
|
|
|
|
|
|
}; |
869
|
0
|
|
|
|
|
|
my $explanation = ""; |
870
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
871
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description ); |
872
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
873
|
0
|
|
|
|
|
|
$ok; |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=item expected_dataset_ok |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
Validates database schema against passed in dataset. |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
expected_dataset_ok( |
882
|
|
|
|
|
|
|
table1 => [col1 => 'va1', col2 => 'val2'], |
883
|
|
|
|
|
|
|
) |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
expected_dataset_ok( |
886
|
|
|
|
|
|
|
table1 => [col1 => 'va11', col2 => 'val2'], |
887
|
|
|
|
|
|
|
table1 => [col1 => 'va13', col2 => 'val4'], |
888
|
|
|
|
|
|
|
$desctiption |
889
|
|
|
|
|
|
|
); |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=cut |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
sub expected_dataset_ok { |
896
|
0
|
|
|
0
|
1
|
|
my (@dataset) = @_; |
897
|
0
|
0
|
|
|
|
|
my $description = (@dataset % 2) |
898
|
|
|
|
|
|
|
? pop(@dataset) |
899
|
|
|
|
|
|
|
: "should validate expected dataset" . test_connection_context(); |
900
|
0
|
|
|
|
|
|
my $validation; |
901
|
|
|
|
|
|
|
my $ok; |
902
|
0
|
|
|
|
|
|
eval { |
903
|
0
|
|
|
|
|
|
$validation = $dbunit->expected_dataset(@dataset); |
904
|
0
|
0
|
|
|
|
|
$ok = 1 unless $validation; |
905
|
|
|
|
|
|
|
}; |
906
|
0
|
|
|
|
|
|
my $explanation = ""; |
907
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $validation if $validation; |
908
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
909
|
0
|
|
|
|
|
|
$Tester->ok( $ok, $description ); |
910
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
911
|
0
|
|
|
|
|
|
$ok; |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=item execute_ok |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
Tests execution of the plsql code against expected values. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
execute_ok($plsql, $expected_resultset); |
921
|
|
|
|
|
|
|
execute_ok($plsql, $expected_resultset, $bind_variables_definition); |
922
|
|
|
|
|
|
|
execute_ok($plsql, $expected_resultset, $bind_variables_definition, $description); |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
execute_ok("SELECT my_function(NOW()) INTO :var", {var => 360}); |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=cut |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
sub execute_ok { |
929
|
0
|
|
|
0
|
1
|
|
my ($plsql, $expected_resultset, $bind_varialbes_defintion, $description) = @_; |
930
|
0
|
|
0
|
|
|
|
$description ||= "should have expected plsql data " . test_connection_context(); |
931
|
0
|
|
|
|
|
|
my $result; |
932
|
0
|
|
|
|
|
|
eval { |
933
|
0
|
|
|
|
|
|
$result = $dbunit->execute($plsql, $bind_varialbes_defintion); |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
}; |
936
|
0
|
|
|
|
|
|
my $explanation = ""; |
937
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
938
|
0
|
|
|
|
|
|
my $ok = Test::More::is_deeply($result, $expected_resultset ,$description); |
939
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
940
|
0
|
|
|
|
|
|
$ok; |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=item throws_ok |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Tests database exceptions. |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
throws_ok($sql, $errcode, $errmsg, $description); |
949
|
|
|
|
|
|
|
throws_ok($sql, $errcode, $errmsg); |
950
|
|
|
|
|
|
|
throws_ok($sql, $errmsg); |
951
|
|
|
|
|
|
|
throws_ok($sql, $errmsg, $description); |
952
|
|
|
|
|
|
|
throws_ok($sql, $errcode); |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=cut |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
sub throws_ok { |
957
|
0
|
|
|
0
|
1
|
|
my ($plsql, @args) = @_; |
958
|
0
|
0
|
|
|
|
|
my ($expexted_errcode)= map {($_ =~ /^\d+$/) ? ($_) : ()} @args; |
|
0
|
|
|
|
|
|
|
959
|
0
|
0
|
0
|
|
|
|
my $description = (@args == 3 || (! $expexted_errcode && @args == 2))? pop(@args) : ''; |
960
|
0
|
0
|
0
|
|
|
|
my $expexted_errmsg = ($expexted_errcode && @args == 2) ? $args[-1] : $args[0]; |
961
|
0
|
0
|
|
|
|
|
confess "error message shouldnt conatin error code" |
962
|
|
|
|
|
|
|
if($expexted_errmsg =~ /^\d+$/); |
963
|
|
|
|
|
|
|
|
964
|
0
|
|
|
|
|
|
my ($errcode, $errmsg); |
965
|
0
|
|
|
|
|
|
my $explanation = ""; |
966
|
0
|
|
|
|
|
|
my $ok = 1; |
967
|
0
|
|
|
|
|
|
eval { |
968
|
0
|
|
|
|
|
|
($errcode, $errmsg) = $dbunit->throws($plsql); |
969
|
0
|
0
|
|
|
|
|
if(defined $expexted_errcode) { |
970
|
0
|
|
|
|
|
|
$ok = $expexted_errcode eq $errcode; |
971
|
|
|
|
|
|
|
} |
972
|
0
|
0
|
0
|
|
|
|
if($ok && defined $expexted_errmsg) { |
973
|
0
|
|
|
|
|
|
$ok = ($errmsg =~ /$expexted_errmsg/i); |
974
|
|
|
|
|
|
|
} |
975
|
0
|
0
|
|
|
|
|
unless ($ok) { |
976
|
|
|
|
|
|
|
#warn $expexted_errmsg ,' ', $expexted_errcode; |
977
|
0
|
0
|
0
|
|
|
|
if ($expexted_errmsg || $expexted_errcode) { |
978
|
0
|
0
|
|
|
|
|
$explanation = sprintf("caught: %s: %s\nexpected: %s: %s", |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
979
|
|
|
|
|
|
|
($expexted_errcode ? $errcode : ''), |
980
|
|
|
|
|
|
|
($expexted_errmsg ? $errmsg : ''), |
981
|
|
|
|
|
|
|
($expexted_errcode ? $expexted_errcode : ''), |
982
|
|
|
|
|
|
|
($expexted_errmsg ? $expexted_errmsg : ''), |
983
|
|
|
|
|
|
|
); |
984
|
|
|
|
|
|
|
} |
985
|
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
|
}; |
987
|
|
|
|
|
|
|
|
988
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
989
|
0
|
|
|
|
|
|
$Tester->ok( $ok, $description ); |
990
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
991
|
|
|
|
|
|
|
} |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=back |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=head2 SCHEMA TESTS METHODS |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
This part focus on testing schema objects like table, column, index, triggers, |
999
|
|
|
|
|
|
|
function, procedures.(clear database test) |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
API of the following methods partly was inspired by PgTap L |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
=over |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
=item has_table |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
Tests if the specified table exists. |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
has_table($schema, $table, $description); |
1010
|
|
|
|
|
|
|
has_table($table, $description); |
1011
|
|
|
|
|
|
|
has_table($table); |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
=cut |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
sub has_table { |
1016
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1017
|
0
|
0
|
|
|
|
|
my ($table, $schema) = @args > 2 ? @args [1,0] : $args[0]; |
1018
|
0
|
0
|
|
|
|
|
my $description = (@args > 1) |
1019
|
|
|
|
|
|
|
? pop(@args) |
1020
|
|
|
|
|
|
|
: "should have ${table} table" . test_connection_context(); |
1021
|
0
|
|
|
|
|
|
my $ok; |
1022
|
0
|
|
|
|
|
|
eval { |
1023
|
0
|
0
|
|
|
|
|
$ok = $dbunit->has_table($schema ? ($schema, $table) : ($table)); |
1024
|
|
|
|
|
|
|
}; |
1025
|
0
|
|
|
|
|
|
my $explanation = ""; |
1026
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1027
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1028
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1029
|
0
|
|
|
|
|
|
$ok; |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=item hasnt_table |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
Tests if the specified table doesn't exist. |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
hasnt_table($schema, $table, $description); |
1038
|
|
|
|
|
|
|
hasnt_table($table, $description); |
1039
|
|
|
|
|
|
|
hasnt_table($table); |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
=cut |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
sub hasnt_table { |
1044
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1045
|
0
|
0
|
|
|
|
|
my ($table, $schema) = @args > 2 ? @args [1,0] : $args[0]; |
1046
|
0
|
0
|
|
|
|
|
my $description = (@args > 1) |
1047
|
|
|
|
|
|
|
? pop(@args) |
1048
|
|
|
|
|
|
|
: "should not have table ${table} " . test_connection_context(); |
1049
|
0
|
|
|
|
|
|
my $ok; |
1050
|
0
|
|
|
|
|
|
eval { |
1051
|
0
|
0
|
|
|
|
|
$ok = ! $dbunit->has_table($schema ? ($schema, $table) : ($table)); |
1052
|
|
|
|
|
|
|
}; |
1053
|
0
|
|
|
|
|
|
my $explanation = ""; |
1054
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1055
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1056
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1057
|
0
|
|
|
|
|
|
$ok; |
1058
|
|
|
|
|
|
|
} |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
=item has_view |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
Tests if the specified view exists. |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
has_view($schema, $view, $description); |
1066
|
|
|
|
|
|
|
has_view($view, $description); |
1067
|
|
|
|
|
|
|
has_view($view); |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
=cut |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
sub has_view { |
1072
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1073
|
0
|
0
|
|
|
|
|
my ($view, $schema) = @args > 2 ? @args [1,0] : $args[0]; |
1074
|
0
|
0
|
|
|
|
|
my $description = (@args > 1) |
1075
|
|
|
|
|
|
|
? pop(@args) |
1076
|
|
|
|
|
|
|
: "should have view ${view} " . test_connection_context(); |
1077
|
0
|
|
|
|
|
|
my $ok; |
1078
|
0
|
|
|
|
|
|
eval { |
1079
|
0
|
0
|
|
|
|
|
$ok = $dbunit->has_view($schema ? ($schema, $view) : ($view)); |
1080
|
|
|
|
|
|
|
}; |
1081
|
0
|
|
|
|
|
|
my $explanation = ""; |
1082
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1083
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1084
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1085
|
0
|
|
|
|
|
|
$ok; |
1086
|
|
|
|
|
|
|
} |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=item hasnt_view |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
Tests if the specified view exists. |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
hasnt_view($schema, $view, $description); |
1094
|
|
|
|
|
|
|
hasnt_view($view, $description); |
1095
|
|
|
|
|
|
|
hasnt_view($view); |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
=cut |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
sub hasnt_view { |
1100
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1101
|
0
|
0
|
|
|
|
|
my ($view, $schema) = @args > 2 ? @args [1,0] : $args[0]; |
1102
|
0
|
0
|
|
|
|
|
my $description = (@args > 1) |
1103
|
|
|
|
|
|
|
? pop(@args) |
1104
|
|
|
|
|
|
|
: "should have view ${view} " . test_connection_context(); |
1105
|
0
|
|
|
|
|
|
my $ok; |
1106
|
0
|
|
|
|
|
|
eval { |
1107
|
0
|
0
|
|
|
|
|
$ok = ! $dbunit->has_view($schema ? ($schema, $view) : ($view)); |
1108
|
|
|
|
|
|
|
}; |
1109
|
0
|
|
|
|
|
|
my $explanation = ""; |
1110
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1111
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1112
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1113
|
0
|
|
|
|
|
|
$ok; |
1114
|
|
|
|
|
|
|
} |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=item has_column |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
Tests if the specified column exists in the given table. |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
has_column($schema, $table, $column, $description); |
1122
|
|
|
|
|
|
|
has_column($table, $column, $description); |
1123
|
|
|
|
|
|
|
has_column($table, $column); |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
=cut |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
sub has_column { |
1128
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1129
|
0
|
0
|
|
|
|
|
my ($table, $column, $description, $schema) = @args == 4 ? @args [1,2,3,0] : @args; |
1130
|
0
|
|
0
|
|
|
|
$description ||= "should have column ${column} on table ${table} " . test_connection_context(); |
1131
|
0
|
|
|
|
|
|
my $ok; |
1132
|
0
|
|
|
|
|
|
eval { |
1133
|
0
|
0
|
|
|
|
|
$ok = $dbunit->has_column($schema ? ($schema, $table, $column) : ($table, $column)); |
1134
|
|
|
|
|
|
|
}; |
1135
|
0
|
|
|
|
|
|
my $explanation = ""; |
1136
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1137
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1138
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1139
|
0
|
|
|
|
|
|
$ok; |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=item has_sequence |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
Tests if the specified table exists. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
has_sequence($schema, $sequence, $description); |
1149
|
|
|
|
|
|
|
has_sequence($sequence, $description); |
1150
|
|
|
|
|
|
|
has_sequence($sequence); |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=cut |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
sub has_sequence { |
1155
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1156
|
0
|
0
|
|
|
|
|
my ($sequence, $schema) = @args > 2 ? @args [1,0] : $args[0]; |
1157
|
0
|
0
|
|
|
|
|
my $description = (@args > 1) |
1158
|
|
|
|
|
|
|
? pop(@args) |
1159
|
|
|
|
|
|
|
: "should have ${sequence} sequence" . test_connection_context(); |
1160
|
0
|
|
|
|
|
|
my $ok; |
1161
|
0
|
|
|
|
|
|
eval { |
1162
|
0
|
0
|
|
|
|
|
$ok = $dbunit->has_sequence($schema ? ($schema, $sequence) : ($sequence)); |
1163
|
|
|
|
|
|
|
}; |
1164
|
0
|
|
|
|
|
|
my $explanation = ""; |
1165
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1166
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1167
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1168
|
0
|
|
|
|
|
|
$ok; |
1169
|
|
|
|
|
|
|
} |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=item hasnt_sequence |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
Tests if the specified table doesn't exist. |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
hasnt_sequence($schema, $sequence, $description); |
1177
|
|
|
|
|
|
|
hasnt_sequence($sequence, $description); |
1178
|
|
|
|
|
|
|
hasnt_sequence($sequence); |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=cut |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
sub hasnt_sequence { |
1183
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1184
|
0
|
0
|
|
|
|
|
my ($sequence, $schema) = @args > 2 ? @args [1,0] : $args[0]; |
1185
|
0
|
0
|
|
|
|
|
my $description = (@args > 1) |
1186
|
|
|
|
|
|
|
? pop(@args) |
1187
|
|
|
|
|
|
|
: "should not have ${sequence} sequence" . test_connection_context(); |
1188
|
0
|
|
|
|
|
|
my $ok; |
1189
|
0
|
|
|
|
|
|
eval { |
1190
|
0
|
0
|
|
|
|
|
$ok = ! $dbunit->has_sequence($schema ? ($schema, $sequence) : ($sequence)); |
1191
|
|
|
|
|
|
|
}; |
1192
|
0
|
|
|
|
|
|
my $explanation = ""; |
1193
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1194
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1195
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1196
|
0
|
|
|
|
|
|
$ok; |
1197
|
|
|
|
|
|
|
} |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
=item has_columns |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
Tests if all specified columns exist for given table. |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
my $columms = ['id', 'name'] |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
has_columns($schema, $table, $columms); |
1207
|
|
|
|
|
|
|
has_columns($schema, $table, $columms, $description); |
1208
|
|
|
|
|
|
|
has_columns($table, $columms); |
1209
|
|
|
|
|
|
|
has_columns($table, $columms, $description); |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
=cut |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
sub has_columns { |
1214
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1215
|
0
|
0
|
0
|
|
|
|
my $description = ((@args == 4) || (@args == 3 && ref($args[-2]))) |
1216
|
|
|
|
|
|
|
? pop @args |
1217
|
|
|
|
|
|
|
: 'should have columns'; |
1218
|
0
|
|
|
|
|
|
my $ok; |
1219
|
0
|
|
|
|
|
|
eval { |
1220
|
0
|
|
|
|
|
|
$ok = $dbunit->has_columns(@args); |
1221
|
|
|
|
|
|
|
}; |
1222
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1223
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1224
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1225
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1226
|
0
|
|
|
|
|
|
$ok; |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
=item hasnt_column |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
Tests if the specified column doesn't exist in the given table. |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
hasnt_column($schema, $table, $column, $description); |
1235
|
|
|
|
|
|
|
hasnt_column($table, $column, $description); |
1236
|
|
|
|
|
|
|
hasnt_column($table, $column); |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
=cut |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
sub hasnt_column { |
1241
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1242
|
0
|
0
|
|
|
|
|
my ($table, $column, $description, $schema) = @args == 4 ? @args [1,2,3,0] : @args; |
1243
|
0
|
|
0
|
|
|
|
$description ||= "should not have column ${column} on ${table} table " . test_connection_context(); |
1244
|
0
|
|
|
|
|
|
my $ok; |
1245
|
0
|
|
|
|
|
|
eval { |
1246
|
0
|
0
|
|
|
|
|
$ok = ! $dbunit->has_column($schema ? ($schema, $table, $column) : ($table, $column)); |
1247
|
|
|
|
|
|
|
}; |
1248
|
0
|
|
|
|
|
|
my $explanation = ""; |
1249
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1250
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1251
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1252
|
0
|
|
|
|
|
|
$ok; |
1253
|
|
|
|
|
|
|
} |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=item column_is_null |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
Tests if the specified column is nullable |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
column_is_null($schema, $table, $columm, $description); |
1262
|
|
|
|
|
|
|
column_is_null($table, $columm, $description); |
1263
|
|
|
|
|
|
|
column_is_null($table, $columm); |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
=cut |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
sub column_is_null { |
1268
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1269
|
0
|
0
|
|
|
|
|
my ($table, $column, $description, $schema) = @args == 4 ? @args [1,2,3,0] : @args; |
1270
|
0
|
|
0
|
|
|
|
$description ||= "should have column ${column} nullable" . test_connection_context(); |
1271
|
0
|
|
|
|
|
|
my $ok; |
1272
|
0
|
|
|
|
|
|
eval { |
1273
|
0
|
0
|
|
|
|
|
$ok = $dbunit->column_is_null($schema ? ($schema, $table, $column) : ($table, $column)); |
1274
|
|
|
|
|
|
|
}; |
1275
|
0
|
|
|
|
|
|
my $explanation = ""; |
1276
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1277
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1278
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1279
|
0
|
|
|
|
|
|
$ok; |
1280
|
|
|
|
|
|
|
} |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
=item column_is_not_null |
1284
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
Tests if the specified column is not nullable |
1286
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
column_is_not_null($schema, $table, $columm, $description); |
1288
|
|
|
|
|
|
|
column_is_not_null($table, $columm, $description); |
1289
|
|
|
|
|
|
|
column_is_not_null($table, $columm); |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
=cut |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
sub column_is_not_null { |
1294
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1295
|
0
|
0
|
|
|
|
|
my ($table, $column, $description, $schema) = @args == 4 ? @args [1,2,3,0] : @args; |
1296
|
0
|
|
0
|
|
|
|
$description ||= "should not have column ${column} nullable" . test_connection_context(); |
1297
|
0
|
|
|
|
|
|
my $ok; |
1298
|
0
|
|
|
|
|
|
eval { |
1299
|
0
|
0
|
|
|
|
|
$ok = $dbunit->column_is_not_null($schema ? ($schema, $table, $column) : ($table, $column)); |
1300
|
|
|
|
|
|
|
}; |
1301
|
0
|
|
|
|
|
|
my $explanation = ""; |
1302
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1303
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1304
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1305
|
0
|
|
|
|
|
|
$ok; |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
=item column_type_is |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
Tests if the specified column's type for given table matches underlying column type definition. |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
column_type_is($schema, $table, $columm, $type); |
1314
|
|
|
|
|
|
|
column_type_is($schema, $table, $columm, $type, $description); |
1315
|
|
|
|
|
|
|
column_type_is($table, $columm, $type); |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
=cut |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
sub column_type_is { |
1320
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1321
|
0
|
0
|
|
|
|
|
my $description = @args == 5 ? pop @args : 'should validate colunmm type'; |
1322
|
0
|
|
|
|
|
|
my $ok; |
1323
|
0
|
|
|
|
|
|
eval { |
1324
|
0
|
|
|
|
|
|
$ok = $dbunit->column_type_is(@args); |
1325
|
|
|
|
|
|
|
}; |
1326
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1327
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1328
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1329
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1330
|
0
|
|
|
|
|
|
$ok; |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
=item column_default_is |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
Tests the specified default value matches database column definition. |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
column_default_is_ok($schema, $table, $columm, $default); |
1338
|
|
|
|
|
|
|
column_default_is_ok($schema, $table, $columm, $default, $description); |
1339
|
|
|
|
|
|
|
column_default_is_ok($table, $columm, $default); |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
=cut |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
sub column_default_is { |
1344
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1345
|
0
|
0
|
|
|
|
|
my $description = @args == 5 ? pop @args : 'should check column default value'; |
1346
|
0
|
|
|
|
|
|
my $ok; |
1347
|
0
|
|
|
|
|
|
eval { |
1348
|
0
|
|
|
|
|
|
$ok = $dbunit->column_default_is(@args); |
1349
|
|
|
|
|
|
|
}; |
1350
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1351
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1352
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1353
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1354
|
0
|
|
|
|
|
|
$ok; |
1355
|
|
|
|
|
|
|
} |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
=item column_is_unique |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
column_is_unique($table, $column); |
1361
|
|
|
|
|
|
|
column_is_unique($schema, $table, $column); |
1362
|
|
|
|
|
|
|
column_is_unique($schema, $table, $column, $description); |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
=cut |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
sub column_is_unique { |
1367
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1368
|
0
|
0
|
|
|
|
|
my $description = @args == 4 ? pop @args : 'should column be unique'; |
1369
|
0
|
|
|
|
|
|
my $ok; |
1370
|
0
|
|
|
|
|
|
eval { |
1371
|
0
|
|
|
|
|
|
$ok = $dbunit->column_is_unique(@args); |
1372
|
|
|
|
|
|
|
}; |
1373
|
0
|
|
|
|
|
|
my $explanation = ''; |
1374
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1375
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1376
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1377
|
0
|
|
|
|
|
|
$ok; |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
=item has_pk |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
Tests existence of the primary key for given table with optionally |
1384
|
|
|
|
|
|
|
specified columns that should be part of the primary key. |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
has_pk($table); |
1387
|
|
|
|
|
|
|
has_pk($schema, $table); |
1388
|
|
|
|
|
|
|
has_pk($table, $column_or_columns); |
1389
|
|
|
|
|
|
|
has_pk($schema, $table, $column_or_columns); |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
has_pk($schema, $table, $description); |
1393
|
|
|
|
|
|
|
has_pk($table, $column_or_columns, $description); |
1394
|
|
|
|
|
|
|
has_pk($schema, $table, $column_or_columns, $description); |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
=cut |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
sub has_pk { |
1399
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1400
|
0
|
0
|
|
|
|
|
my $description = @args == 4 ? pop @args : 'should have pk'; |
1401
|
|
|
|
|
|
|
|
1402
|
0
|
|
|
|
|
|
my $ok; |
1403
|
0
|
|
|
|
|
|
eval { |
1404
|
0
|
0
|
|
|
|
|
$description = ($args[-1] =~ /\s/) ? pop @args : $description; |
1405
|
0
|
|
|
|
|
|
$ok = $dbunit->has_pk(@args); |
1406
|
|
|
|
|
|
|
}; |
1407
|
|
|
|
|
|
|
|
1408
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1409
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1410
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1411
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1412
|
0
|
|
|
|
|
|
$ok; |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
=item has_fk |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
Tests existence of the foreign key for given table and reference table |
1419
|
|
|
|
|
|
|
with the specified columns. |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
has_fk($schema, $table, $columns, $referenced_schema, $referenced_table); |
1422
|
|
|
|
|
|
|
has_fk($table, $columns, $referenced_table); |
1423
|
|
|
|
|
|
|
has_fk($schema, $table, $columns, $referenced_schema, $referenced_table, $description); |
1424
|
|
|
|
|
|
|
has_fk($table, $columns, $referenced_table, $description); |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
=cut |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
sub has_fk { |
1429
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1430
|
0
|
0
|
|
|
|
|
my $description = (@args == 6) ? pop @args : 'should have fk'; |
1431
|
0
|
|
|
|
|
|
my $ok; |
1432
|
0
|
|
|
|
|
|
eval { |
1433
|
0
|
0
|
|
|
|
|
$description = ($args[-1] =~ /\s/) ? pop @args : $description; |
1434
|
0
|
|
|
|
|
|
$ok = $dbunit->has_fk(@args); |
1435
|
|
|
|
|
|
|
}; |
1436
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1437
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1438
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1439
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1440
|
0
|
|
|
|
|
|
$ok; |
1441
|
|
|
|
|
|
|
} |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
=item has_index |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
Tests index existence for given table with the optionally specified columns. |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
has_index($table, $index, $column_or_expressions); |
1449
|
|
|
|
|
|
|
has_index($schema, $table, $index, $column_or_expressions); |
1450
|
|
|
|
|
|
|
has_index($table, $index); |
1451
|
|
|
|
|
|
|
has_index($schema, $table, $index); |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
has_index($table, $index, $column_or_expressions, $desciption); |
1454
|
|
|
|
|
|
|
has_index($schema, $table, $index, $column_or_expressions, $desciption); |
1455
|
|
|
|
|
|
|
has_index($table, $index, $desciption); |
1456
|
|
|
|
|
|
|
has_index($schema, $table, $index, $desciption); |
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
=cut |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
sub has_index { |
1461
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1462
|
0
|
0
|
|
|
|
|
my $description = (@args == 5) ? pop @args : undef; |
1463
|
0
|
|
|
|
|
|
my $ok; |
1464
|
0
|
|
|
|
|
|
eval { |
1465
|
0
|
|
|
|
|
|
$ok = $dbunit->has_index(@args); |
1466
|
0
|
0
|
0
|
|
|
|
if(! $ok && ! $description && ! ref($args[-1])) { |
|
|
|
0
|
|
|
|
|
1467
|
0
|
|
|
|
|
|
$description = pop @args; |
1468
|
0
|
|
|
|
|
|
$ok = $dbunit->has_index(@args); |
1469
|
|
|
|
|
|
|
} |
1470
|
|
|
|
|
|
|
}; |
1471
|
0
|
|
0
|
|
|
|
$description ||= 'should have index'; |
1472
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1473
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1474
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1475
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1476
|
0
|
|
|
|
|
|
$ok; |
1477
|
|
|
|
|
|
|
} |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
=item index_is_unique |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
index_is_unique($schema, $table, $index); |
1483
|
|
|
|
|
|
|
index_is_unique($table, $index); |
1484
|
|
|
|
|
|
|
index_is_unique($schema, $table, $index, $description); |
1485
|
|
|
|
|
|
|
index_is_unique($table, $index, $description); |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
=cut |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
sub index_is_unique { |
1490
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1491
|
0
|
0
|
|
|
|
|
my $description = (@args == 4) ? pop @args : undef; |
1492
|
0
|
|
|
|
|
|
my $ok; |
1493
|
0
|
|
|
|
|
|
eval { |
1494
|
0
|
|
|
|
|
|
$ok = $dbunit->index_is_unique(@args); |
1495
|
0
|
0
|
0
|
|
|
|
if(! $ok && ! $description && @args > 2 && ($args[-1] =~ /\s/)) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1496
|
0
|
|
|
|
|
|
$description = pop @args; |
1497
|
0
|
|
|
|
|
|
$ok = $dbunit->index_is_unique(@args); |
1498
|
|
|
|
|
|
|
} |
1499
|
|
|
|
|
|
|
}; |
1500
|
0
|
|
0
|
|
|
|
$description ||= 'should have unique index '; |
1501
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1502
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1503
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1504
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1505
|
0
|
|
|
|
|
|
$ok; |
1506
|
|
|
|
|
|
|
} |
1507
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
=item index_is_primary |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
index_is_primary($schema, $table, $index); |
1512
|
|
|
|
|
|
|
index_is_primary($table, $index); |
1513
|
|
|
|
|
|
|
index_is_primary($schema, $table, $index, $description); |
1514
|
|
|
|
|
|
|
index_is_primary$table, $index, $description); |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
=cut |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
sub index_is_primary { |
1519
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1520
|
0
|
0
|
|
|
|
|
my $description = (@args == 4) ? pop @args : undef; |
1521
|
0
|
|
|
|
|
|
my $ok; |
1522
|
0
|
|
|
|
|
|
eval { |
1523
|
0
|
|
|
|
|
|
$ok = $dbunit->index_is_primary(@args); |
1524
|
0
|
0
|
0
|
|
|
|
if(! $ok && ! $description && @args > 2 && ($args[-1] =~ /\s/)) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1525
|
0
|
|
|
|
|
|
$description = pop @args; |
1526
|
0
|
|
|
|
|
|
$ok = $dbunit->index_is_primary(@args); |
1527
|
|
|
|
|
|
|
} |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
}; |
1530
|
0
|
|
0
|
|
|
|
$description ||= 'should have primary_key index'; |
1531
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1532
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1533
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1534
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1535
|
0
|
|
|
|
|
|
$ok; |
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
=item index_is_type |
1540
|
|
|
|
|
|
|
|
1541
|
|
|
|
|
|
|
Tests if the specified index's type matches defined index type |
1542
|
|
|
|
|
|
|
|
1543
|
|
|
|
|
|
|
index_is_type($schema, $table, $index, $type); |
1544
|
|
|
|
|
|
|
index_is_type($table, $index, $type); |
1545
|
|
|
|
|
|
|
index_is_type($schema, $table, $index, $type, $description); |
1546
|
|
|
|
|
|
|
index_is_type($table, $index, $type, $description); |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
type can be: |
1549
|
|
|
|
|
|
|
- btree, bitmap, etc. - check you database vendor documentation. |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
=cut |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
sub index_is_type { |
1554
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1555
|
0
|
0
|
|
|
|
|
my $description = (@args == 5) ? pop @args : undef; |
1556
|
0
|
|
|
|
|
|
my $ok; |
1557
|
0
|
|
|
|
|
|
eval { |
1558
|
0
|
0
|
0
|
|
|
|
$description = pop @args if (! $description && ($args[-1] =~ /\s/)); |
1559
|
0
|
|
|
|
|
|
$ok = $dbunit->index_is_type(@args); |
1560
|
|
|
|
|
|
|
}; |
1561
|
0
|
|
0
|
|
|
|
$description ||= 'should validate index type'; |
1562
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1563
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1564
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1565
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1566
|
0
|
|
|
|
|
|
$ok; |
1567
|
|
|
|
|
|
|
} |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
=item has_trigger |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
Tests if the specified trigger exists for the given table. |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
has_trigger($schema, $table, $trigger); |
1575
|
|
|
|
|
|
|
has_trigger($table, $trigger); |
1576
|
|
|
|
|
|
|
has_trigger($schema, $table, $trigger, $description); |
1577
|
|
|
|
|
|
|
has_trigger($table, $trigger, $description); |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
=cut |
1580
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
sub has_trigger { |
1582
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1583
|
0
|
0
|
|
|
|
|
my $description = (@args == 4) ? pop @args : undef; |
1584
|
0
|
|
|
|
|
|
my $ok; |
1585
|
0
|
|
|
|
|
|
eval { |
1586
|
0
|
0
|
0
|
|
|
|
$description = pop @args if (! $description && ($args[-1] =~ /\s/)); |
1587
|
0
|
|
|
|
|
|
$ok = $dbunit->has_trigger(@args); |
1588
|
|
|
|
|
|
|
}; |
1589
|
0
|
|
0
|
|
|
|
$description ||= 'should have trigger'; |
1590
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1591
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1592
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1593
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1594
|
0
|
|
|
|
|
|
$ok; |
1595
|
|
|
|
|
|
|
} |
1596
|
|
|
|
|
|
|
|
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
=item trigger_is |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
Tests if the specified trigger body matches the trigger body (or function in case of postgresql) |
1602
|
|
|
|
|
|
|
|
1603
|
|
|
|
|
|
|
trigger_is($schema, $table, $trigger, $trigger_body); |
1604
|
|
|
|
|
|
|
trigger_is($table, $trigger, $trigger_body); |
1605
|
|
|
|
|
|
|
trigger_is($schema, $table, $trigger, $trigger_body, $description); |
1606
|
|
|
|
|
|
|
trigger_is($table, $trigger, $trigger_body, $description); |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
=cut |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
sub trigger_is { |
1611
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1612
|
0
|
0
|
|
|
|
|
my $description = (@args == 5) ? pop @args : undef; |
1613
|
0
|
|
|
|
|
|
my $ok; |
1614
|
0
|
|
|
|
|
|
eval { |
1615
|
0
|
|
|
|
|
|
$ok = $dbunit->trigger_is(@args); |
1616
|
0
|
0
|
0
|
|
|
|
if (! $ok && ! $description && (@args == 4)) { |
|
|
|
0
|
|
|
|
|
1617
|
0
|
|
|
|
|
|
$description = pop @args; |
1618
|
0
|
|
|
|
|
|
$ok = $dbunit->trigger_is(@args); |
1619
|
|
|
|
|
|
|
} |
1620
|
|
|
|
|
|
|
}; |
1621
|
0
|
|
0
|
|
|
|
$description ||= 'should match trigger body'; |
1622
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1623
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1624
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1625
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1626
|
0
|
|
|
|
|
|
$ok; |
1627
|
|
|
|
|
|
|
} |
1628
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
=item has_routine |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
Tests if the specified routine exists in database and optionally has expected arguments type. |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
my $args = ['type1', 'type2', 'return_type']; |
1635
|
|
|
|
|
|
|
or |
1636
|
|
|
|
|
|
|
my $args = ['IN type1', 'OUT type2', 'type3']; |
1637
|
|
|
|
|
|
|
or |
1638
|
|
|
|
|
|
|
my $args = ['name1 type1', 'name2 type2', 'return type3']; |
1639
|
|
|
|
|
|
|
or |
1640
|
|
|
|
|
|
|
my $args = ['IN name1 type1', 'INOUT name2 type2', 'return type3']; |
1641
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
has_routine($schema, $function); |
1643
|
|
|
|
|
|
|
has_routine($function); |
1644
|
|
|
|
|
|
|
has_routine($schema, $function, $args); |
1645
|
|
|
|
|
|
|
has_routine($function, $args); |
1646
|
|
|
|
|
|
|
|
1647
|
|
|
|
|
|
|
has_routine($schema, $function, $description); |
1648
|
|
|
|
|
|
|
has_routine($schema, $function, $args, $description); |
1649
|
|
|
|
|
|
|
has_routine($function, $args, $description); |
1650
|
|
|
|
|
|
|
has_routine($function, $description); |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
=cut |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
sub has_routine { |
1655
|
0
|
|
|
0
|
1
|
|
my @args = @_; |
1656
|
0
|
0
|
|
|
|
|
my $description = (@args == 4) ? pop @args : undef; |
1657
|
0
|
|
|
|
|
|
my $ok; |
1658
|
0
|
|
|
|
|
|
eval { |
1659
|
0
|
|
|
|
|
|
$ok = $dbunit->has_routine(@args); |
1660
|
0
|
0
|
0
|
|
|
|
if (! $ok && ! $description && ! ref($args[-1])) { |
|
|
|
0
|
|
|
|
|
1661
|
0
|
|
|
|
|
|
$description = pop @args; |
1662
|
0
|
|
|
|
|
|
$ok = $dbunit->has_routine(@args); |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
}; |
1665
|
0
|
|
0
|
|
|
|
$description ||= 'should have routine'; |
1666
|
0
|
0
|
|
|
|
|
my $explanation = $ok ? '' : $dbunit->failed_test_info; |
1667
|
0
|
0
|
|
|
|
|
$explanation .= "\n" . $@ if $@; |
1668
|
0
|
|
|
|
|
|
$Tester->ok($ok, $description); |
1669
|
0
|
0
|
|
|
|
|
$Tester->diag($explanation) unless $ok; |
1670
|
0
|
|
|
|
|
|
$ok; |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
} |
1673
|
|
|
|
|
|
|
|
1674
|
|
|
|
|
|
|
=item _initialise_connection |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
Initializes default test connection |
1677
|
|
|
|
|
|
|
|
1678
|
|
|
|
|
|
|
=cut |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
my $connection; |
1681
|
|
|
|
|
|
|
sub _initialise_connection { |
1682
|
0
|
|
|
0
|
|
|
add_test_connection('test', @_); |
1683
|
|
|
|
|
|
|
} |
1684
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
=item test_connection_context |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
Returns tested connection name, |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
=cut |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
sub test_connection_context { |
1693
|
0
|
0
|
|
0
|
1
|
|
return '' unless $multiple_tests; |
1694
|
0
|
|
|
|
|
|
"[" .$dbunit->connection_name . "]"; |
1695
|
|
|
|
|
|
|
} |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
=item test_connection |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
Returns test connection object. |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
=cut |
1702
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
sub test_connection { |
1704
|
0
|
|
|
0
|
1
|
|
$connection = DBIx::Connection->connection($dbunit->connection_name); |
1705
|
|
|
|
|
|
|
} |
1706
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
=item add_test_connection |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
Adds tests connection |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
use Test::DBUnit; |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
# or |
1716
|
|
|
|
|
|
|
|
1717
|
|
|
|
|
|
|
use Test::DBUnit connection_names => ['my_connection_name', 'my_connection_name1']; |
1718
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
my $connection = DBIx::Connection->new(...); |
1720
|
|
|
|
|
|
|
add_test_connection($connection); |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
#or |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
add_test_connection('my_connection_name', dsn => $dsn, username => $username, password => 'password'); |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
#or |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
add_test_connection('my_connection_name', dbh => $dbh); |
1729
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
Note: By default there is "test" connection name, so if you would like to use only DBI then add $dbh as 'test' connection |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
add_test_connection('test', dbh => $dbh); |
1734
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
=cut |
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
sub add_test_connection { |
1739
|
0
|
|
|
0
|
1
|
|
my ($connection_, @args) = @_; |
1740
|
0
|
0
|
|
|
|
|
if(ref($connection_)) { |
1741
|
0
|
|
|
|
|
|
$connection = $connection_; |
1742
|
0
|
|
|
|
|
|
$connection_ = $connection->name; |
1743
|
|
|
|
|
|
|
} |
1744
|
0
|
|
|
|
|
|
set_test_connection($connection_); |
1745
|
0
|
0
|
|
|
|
|
if(@args) { |
1746
|
0
|
|
|
|
|
|
$connection = DBIx::Connection->new(name => $connection_, @args); |
1747
|
|
|
|
|
|
|
} |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
} |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
=item set_test_connection |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
Sets test connection that will be tested. |
1754
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
=cut |
1756
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
sub set_test_connection { |
1758
|
0
|
|
|
0
|
1
|
|
my ($connection_name) = @_; |
1759
|
0
|
|
|
|
|
|
$dbunit->set_connection_name($connection_name); |
1760
|
|
|
|
|
|
|
} |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
=item test_dbh |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
Returns test database handler. |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
=cut |
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
sub test_dbh { |
1770
|
0
|
|
|
0
|
1
|
|
test_connection()->dbh; |
1771
|
|
|
|
|
|
|
} |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
=item set_insert_load_strategy |
1775
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
Sets insert as the load strategy |
1777
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
=cut |
1779
|
|
|
|
|
|
|
|
1780
|
|
|
|
|
|
|
sub set_insert_load_strategy { |
1781
|
0
|
|
|
0
|
1
|
|
$dbunit->set_load_strategy(INSERT_LOAD_STRATEGY); |
1782
|
|
|
|
|
|
|
} |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
=item set_refresh_load_strategy |
1786
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
Sets refresh as the load strategy |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=cut |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
sub set_refresh_load_strategy { |
1792
|
0
|
|
|
0
|
1
|
|
$dbunit->set_load_strategy(REFRESH_LOAD_STRATEGY); |
1793
|
|
|
|
|
|
|
} |
1794
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
} |
1796
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
=item _xml_test_file |
1799
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
Returns xml file prefix to test |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
=cut |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
sub _xml_test_file { |
1805
|
0
|
|
|
0
|
|
|
my ($unit_name) = @_; |
1806
|
0
|
|
|
|
|
|
my $test_file = $0; |
1807
|
0
|
|
|
|
|
|
$test_file =~ s/\.t/.$unit_name/; |
1808
|
0
|
|
|
|
|
|
$test_file; |
1809
|
|
|
|
|
|
|
} |
1810
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
1; |
1814
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
__END__ |