File Coverage

blib/lib/Test/DBUnit.pm
Criterion Covered Total %
statement 27 449 6.0
branch 0 302 0.0
condition 0 89 0.0
subroutine 9 53 16.9
pod 40 40 100.0
total 76 933 8.1


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__