1 use DBIx::Class::Schema::Loader::Optional::Dependencies
2 -skip_all_without => 'test_rdbms_db2';
9 use File::Path 'rmtree';
10 use DBIx::Class::Schema::Loader 'make_schema_at';
14 use dbixcsl_common_tests ();
15 use dbixcsl_test_dir '$tdir';
17 use constant EXTRA_DUMP_DIR => "$tdir/db2_extra_dump";
19 my $dsn = $ENV{DBICTEST_DB2_DSN} || '';
20 my $user = $ENV{DBICTEST_DB2_USER} || '';
21 my $password = $ENV{DBICTEST_DB2_PASS} || '';
23 my ($schema, $schemas_created); # for cleanup in END for extra tests
27 my $dbh = DBI->connect ($dsn, $user, $password, { RaiseError => 1, PrintError => 0} );
28 eval { $dbh->get_info(18) } || 0;
30 my ($maj_srv_ver) = $srv_ver =~ /^(\d+)/;
32 my $extra_graphics_data_types = {
33 graphic => { data_type => 'graphic', size => 1 },
34 'graphic(3)' => { data_type => 'graphic', size => 3 },
35 'vargraphic(3)' => { data_type => 'vargraphic', size => 3 },
36 'long vargraphic' => { data_type => 'long vargraphic' },
37 'dbclob' => { data_type => 'dbclob' },
40 dbixcsl_common_tests->new(
42 auto_inc_pk => 'INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY',
45 password => $password,
47 preserve_case_mode_is_exclusive => 1,
49 default_is_deferrable => 1,
50 default_on_clause => 'NO ACTION',
52 # http://publib.boulder.ibm.com/infocenter/db2luw/v8/index.jsp?topic=/com.ibm.db2.udb.doc/admin/r0008483.htm
55 smallint => { data_type => 'smallint' },
56 integer => { data_type => 'integer' },
57 'int' => { data_type => 'integer' },
58 real => { data_type => 'real' },
59 'double precision' => { data_type => 'double precision' },
60 double => { data_type => 'double precision' },
61 float => { data_type => 'double precision' },
62 'float(24)' => { data_type => 'real' },
63 'float(25)' => { data_type => 'double precision' },
64 'float(53)' => { data_type => 'double precision' },
65 numeric => { data_type => 'numeric' },
66 decimal => { data_type => 'numeric' },
67 'numeric(6,3)' => { data_type => 'numeric', size => [6,3] },
68 'decimal(6,3)' => { data_type => 'numeric', size => [6,3] },
70 # Character String Types
71 char => { data_type => 'char', size => 1 },
72 'char(3)' => { data_type => 'char', size => 3 },
73 'varchar(3)' => { data_type => 'varchar', size => 3 },
74 'long varchar' => { data_type => 'long varchar' },
75 'clob' => { data_type => 'clob' },
77 # Graphic String Types (double-byte strings)
78 ($maj_srv_ver >= 9) ? (%$extra_graphics_data_types) : (),
81 'char for bit data'=> { data_type => 'binary', size => 1, original => { data_type => 'char for bit data' } },
82 'char(3) for bit data'
83 => { data_type => 'binary', size => 3, original => { data_type => 'char for bit data' } },
84 'varchar(3) for bit data'
85 => { data_type => 'varbinary', size => 3, original => { data_type => 'varchar for bit data' } },
86 'long varchar for bit data'
87 => { data_type => 'blob', original => { data_type => 'long varchar for bit data' } },
88 blob => { data_type => 'blob' },
91 'date' => { data_type => 'date' },
92 'date default current date'
93 => { data_type => 'date', default_value => \'current_timestamp',
94 original => { default_value => \'current date' } },
95 'time' => { data_type => 'time' },
96 'time default current time'
97 => { data_type => 'time', default_value => \'current_timestamp',
98 original => { default_value => \'current time' } },
99 timestamp => { data_type => 'timestamp' },
100 'timestamp default current timestamp'
101 => { data_type => 'timestamp', default_value => \'current_timestamp',
102 original => { default_value => \'current timestamp' } },
105 # XXX I don't know how to make these
106 # datalink => { data_type => 'datalink' },
110 # 4 through 8 are used for the multi-schema tests
112 create table db2_loader_test9 (
113 id int generated by default as identity not null primary key
117 create table db2_loader_test10 (
118 id int generated by default as identity not null primary key,
120 foreign key (nine_id) references db2_loader_test9(id)
121 on delete set null on update restrict
125 drop => [ qw/db2_loader_test9 db2_loader_test10/ ],
130 # test on delete/update fk clause introspection
131 ok ((my $rel_info = $schema->source('Db2LoaderTest10')->relationship_info('nine')),
134 is $rel_info->{attrs}{on_delete}, 'SET NULL',
135 'ON DELETE clause introspected correctly';
137 is $rel_info->{attrs}{on_update}, 'RESTRICT',
138 'ON UPDATE clause introspected correctly';
140 is $rel_info->{attrs}{is_deferrable}, 1,
141 'DEFERRABLE defaults to 1';
144 my $dbh = $schema->storage->dbh;
147 $dbh->do('CREATE SCHEMA "dbicsl-test"');
150 $schemas_created = 0;
151 skip "no CREATE SCHEMA privileges", 30 * 2;
155 CREATE TABLE "dbicsl-test".db2_loader_test4 (
156 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
161 CREATE TABLE "dbicsl-test".db2_loader_test5 (
162 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
164 four_id INTEGER NOT NULL,
165 CONSTRAINT loader_test5_uniq UNIQUE (four_id),
166 FOREIGN KEY (four_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
169 $dbh->do('CREATE SCHEMA "dbicsl.test"');
171 CREATE TABLE "dbicsl.test".db2_loader_test5 (
172 pk INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
174 four_id INTEGER NOT NULL,
175 CONSTRAINT loader_test5_uniq UNIQUE (four_id),
176 FOREIGN KEY (four_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
180 CREATE TABLE "dbicsl.test".db2_loader_test6 (
181 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
183 db2_loader_test4_id INTEGER,
184 FOREIGN KEY (db2_loader_test4_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
188 CREATE TABLE "dbicsl.test".db2_loader_test7 (
189 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
191 six_id INTEGER NOT NULL UNIQUE,
192 FOREIGN KEY (six_id) REFERENCES "dbicsl.test".db2_loader_test6 (id)
196 CREATE TABLE "dbicsl-test".db2_loader_test8 (
197 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
199 db2_loader_test7_id INTEGER,
200 FOREIGN KEY (db2_loader_test7_id) REFERENCES "dbicsl.test".db2_loader_test7 (id)
204 $schemas_created = 1;
206 foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') {
208 rmtree EXTRA_DUMP_DIR;
211 local $SIG{__WARN__} = sub {
212 push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
219 db_schema => $db_schema,
220 dump_directory => EXTRA_DUMP_DIR,
223 [ $dsn, $user, $password ],
226 diag join "\n", @warns if @warns;
229 } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings';
231 my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
234 ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password);
235 } 'connected test schema';
238 ok $rsrc = $test_schema->source('Db2LoaderTest4');
239 } 'got source for table in schema name with dash';
241 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
242 'column in schema name with dash';
244 is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
245 'column in schema name with dash';
247 is try { $rsrc->column_info('value')->{size} }, 100,
248 'column in schema name with dash';
251 ok $rs = $test_schema->resultset('Db2LoaderTest4');
252 } 'got resultset for table in schema name with dash';
255 ok $row = $rs->create({ value => 'foo' });
256 } 'executed SQL on table in schema name with dash';
258 $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_db2_loader_test5') };
260 is_deeply $rel_info->{cond}, {
261 'foreign.four_id' => 'self.id'
262 }, 'relationship in schema name with dash';
264 is $rel_info->{attrs}{accessor}, 'single',
265 'relationship in schema name with dash';
267 is $rel_info->{attrs}{join_type}, 'LEFT',
268 'relationship in schema name with dash';
271 ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest5');
272 } 'got source for table in schema name with dash';
274 %uniqs = try { $rsrc->unique_constraints };
277 'got unique and primary constraint in schema name with dash';
279 delete $uniqs{primary};
281 is_deeply ((values %uniqs)[0], ['four_id'],
282 'correct unique constraint in schema name with dash');
285 ok $rsrc = $test_schema->source('Db2LoaderTest6');
286 } 'got source for table in schema name with dot';
288 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
289 'column in schema name with dot introspected correctly';
291 is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
292 'column in schema name with dot introspected correctly';
294 is try { $rsrc->column_info('value')->{size} }, 100,
295 'column in schema name with dot introspected correctly';
298 ok $rs = $test_schema->resultset('Db2LoaderTest6');
299 } 'got resultset for table in schema name with dot';
302 ok $row = $rs->create({ value => 'foo' });
303 } 'executed SQL on table in schema name with dot';
305 $rel_info = try { $rsrc->relationship_info('db2_loader_test7') };
307 is_deeply $rel_info->{cond}, {
308 'foreign.six_id' => 'self.id'
309 }, 'relationship in schema name with dot';
311 is $rel_info->{attrs}{accessor}, 'single',
312 'relationship in schema name with dot';
314 is $rel_info->{attrs}{join_type}, 'LEFT',
315 'relationship in schema name with dot';
318 ok $rsrc = $test_schema->source('Db2LoaderTest7');
319 } 'got source for table in schema name with dot';
321 %uniqs = try { $rsrc->unique_constraints };
324 'got unique and primary constraint in schema name with dot';
326 delete $uniqs{primary};
328 is_deeply ((values %uniqs)[0], ['six_id'],
329 'correct unique constraint in schema name with dot');
332 ok $test_schema->source('Db2LoaderTest6')
333 ->has_relationship('db2_loader_test4');
334 } 'cross-schema relationship in multi-db_schema';
337 ok $test_schema->source('Db2LoaderTest4')
338 ->has_relationship('db2_loader_test6s');
339 } 'cross-schema relationship in multi-db_schema';
342 ok $test_schema->source('Db2LoaderTest8')
343 ->has_relationship('db2_loader_test7');
344 } 'cross-schema relationship in multi-db_schema';
347 ok $test_schema->source('Db2LoaderTest7')
348 ->has_relationship('db2_loader_test8s');
349 } 'cross-schema relationship in multi-db_schema';
358 if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
359 if ($schemas_created && (my $dbh = try { $schema->storage->dbh })) {
360 foreach my $table ('"dbicsl-test".db2_loader_test8',
361 '"dbicsl.test".db2_loader_test7',
362 '"dbicsl.test".db2_loader_test6',
363 '"dbicsl-test".db2_loader_test5',
364 '"dbicsl.test".db2_loader_test5',
365 '"dbicsl-test".db2_loader_test4') {
367 $dbh->do("DROP TABLE $table");
370 diag "Error dropping table: $_";
374 foreach my $db_schema (qw/dbicsl-test dbicsl.test/) {
376 $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT});
379 diag "Error dropping test schema $db_schema: $_";
383 rmtree EXTRA_DUMP_DIR;
386 # vim:et sts=4 sw=4 tw=0: