6 use File::Path 'rmtree';
7 use DBIx::Class::Schema::Loader 'make_schema_at';
11 use dbixcsl_common_tests ();
12 use dbixcsl_test_dir '$tdir';
14 use constant EXTRA_DUMP_DIR => "$tdir/db2_extra_dump";
16 my $dsn = $ENV{DBICTEST_DB2_DSN} || '';
17 my $user = $ENV{DBICTEST_DB2_USER} || '';
18 my $password = $ENV{DBICTEST_DB2_PASS} || '';
20 plan skip_all => 'You need to set the DBICTEST_DB2_DSN, _USER, and _PASS environment variables'
21 unless ($dsn && $user);
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 my $tester = 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,
50 # http://publib.boulder.ibm.com/infocenter/db2luw/v8/index.jsp?topic=/com.ibm.db2.udb.doc/admin/r0008483.htm
53 smallint => { data_type => 'smallint' },
54 integer => { data_type => 'integer' },
55 'int' => { data_type => 'integer' },
56 real => { data_type => 'real' },
57 'double precision' => { data_type => 'double precision' },
58 double => { data_type => 'double precision' },
59 float => { data_type => 'double precision' },
60 'float(24)' => { data_type => 'real' },
61 'float(25)' => { data_type => 'double precision' },
62 'float(53)' => { data_type => 'double precision' },
63 numeric => { data_type => 'numeric' },
64 decimal => { data_type => 'numeric' },
65 'numeric(6,3)' => { data_type => 'numeric', size => [6,3] },
66 'decimal(6,3)' => { data_type => 'numeric', size => [6,3] },
68 # Character String Types
69 char => { data_type => 'char', size => 1 },
70 'char(3)' => { data_type => 'char', size => 3 },
71 'varchar(3)' => { data_type => 'varchar', size => 3 },
72 'long varchar' => { data_type => 'long varchar' },
73 'clob' => { data_type => 'clob' },
75 # Graphic String Types (double-byte strings)
76 ($maj_srv_ver >= 9) ? (%$extra_graphics_data_types) : (),
79 'char for bit data'=> { data_type => 'binary', size => 1, original => { data_type => 'char for bit data' } },
80 'char(3) for bit data'
81 => { data_type => 'binary', size => 3, original => { data_type => 'char for bit data' } },
82 'varchar(3) for bit data'
83 => { data_type => 'varbinary', size => 3, original => { data_type => 'varchar for bit data' } },
84 'long varchar for bit data'
85 => { data_type => 'blob', original => { data_type => 'long varchar for bit data' } },
86 blob => { data_type => 'blob' },
89 'date' => { data_type => 'date' },
90 'date default current date'
91 => { data_type => 'date', default_value => \'current_timestamp',
92 original => { default_value => \'current date' } },
93 'time' => { data_type => 'time' },
94 'time default current time'
95 => { data_type => 'time', default_value => \'current_timestamp',
96 original => { default_value => \'current time' } },
97 timestamp => { data_type => 'timestamp' },
98 'timestamp default current timestamp'
99 => { data_type => 'timestamp', default_value => \'current_timestamp',
100 original => { default_value => \'current timestamp' } },
103 # XXX I don't know how to make these
104 # datalink => { data_type => 'datalink' },
112 my $dbh = $schema->storage->dbh;
115 $dbh->do('CREATE SCHEMA "dbicsl-test"');
118 $schemas_created = 0;
119 skip "no CREATE SCHEMA privileges", 28 * 2;
123 CREATE TABLE "dbicsl-test".db2_loader_test4 (
124 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
129 CREATE TABLE "dbicsl-test".db2_loader_test5 (
130 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
132 four_id INTEGER NOT NULL,
133 CONSTRAINT loader_test5_uniq UNIQUE (four_id),
134 FOREIGN KEY (four_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
137 $dbh->do('CREATE SCHEMA "dbicsl.test"');
139 CREATE TABLE "dbicsl.test".db2_loader_test5 (
140 pk INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
142 four_id INTEGER NOT NULL,
143 CONSTRAINT loader_test5_uniq UNIQUE (four_id),
144 FOREIGN KEY (four_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
148 CREATE TABLE "dbicsl.test".db2_loader_test6 (
149 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
151 db2_loader_test4_id INTEGER,
152 FOREIGN KEY (db2_loader_test4_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
156 CREATE TABLE "dbicsl.test".db2_loader_test7 (
157 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
159 six_id INTEGER NOT NULL UNIQUE,
160 FOREIGN KEY (six_id) REFERENCES "dbicsl.test".db2_loader_test6 (id)
164 CREATE TABLE "dbicsl-test".db2_loader_test8 (
165 id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
167 db2_loader_test7_id INTEGER,
168 FOREIGN KEY (db2_loader_test7_id) REFERENCES "dbicsl.test".db2_loader_test7 (id)
172 $schemas_created = 1;
174 foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') {
176 rmtree EXTRA_DUMP_DIR;
179 local $SIG{__WARN__} = sub {
180 push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
187 db_schema => $db_schema,
188 dump_directory => EXTRA_DUMP_DIR,
191 [ $dsn, $user, $password ],
194 diag join "\n", @warns if @warns;
197 } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings';
199 my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
202 ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password);
203 } 'connected test schema';
206 ok $rsrc = $test_schema->source('Db2LoaderTest4');
207 } 'got source for table in schema name with dash';
209 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
210 'column in schema name with dash';
212 is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
213 'column in schema name with dash';
215 is try { $rsrc->column_info('value')->{size} }, 100,
216 'column in schema name with dash';
219 ok $rs = $test_schema->resultset('Db2LoaderTest4');
220 } 'got resultset for table in schema name with dash';
223 ok $row = $rs->create({ value => 'foo' });
224 } 'executed SQL on table in schema name with dash';
226 $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_db2_loader_test5') };
228 is_deeply $rel_info->{cond}, {
229 'foreign.four_id' => 'self.id'
230 }, 'relationship in schema name with dash';
232 is $rel_info->{attrs}{accessor}, 'single',
233 'relationship in schema name with dash';
235 is $rel_info->{attrs}{join_type}, 'LEFT',
236 'relationship in schema name with dash';
239 ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest5');
240 } 'got source for table in schema name with dash';
242 %uniqs = try { $rsrc->unique_constraints };
245 'got unique and primary constraint in schema name with dash';
247 delete $uniqs{primary};
249 is_deeply ((values %uniqs)[0], ['four_id'],
250 'correct unique constraint in schema name with dash');
253 ok $rsrc = $test_schema->source('Db2LoaderTest6');
254 } 'got source for table in schema name with dot';
256 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
257 'column in schema name with dot introspected correctly';
259 is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
260 'column in schema name with dot introspected correctly';
262 is try { $rsrc->column_info('value')->{size} }, 100,
263 'column in schema name with dot introspected correctly';
266 ok $rs = $test_schema->resultset('Db2LoaderTest6');
267 } 'got resultset for table in schema name with dot';
270 ok $row = $rs->create({ value => 'foo' });
271 } 'executed SQL on table in schema name with dot';
273 $rel_info = try { $rsrc->relationship_info('db2_loader_test7') };
275 is_deeply $rel_info->{cond}, {
276 'foreign.six_id' => 'self.id'
277 }, 'relationship in schema name with dot';
279 is $rel_info->{attrs}{accessor}, 'single',
280 'relationship in schema name with dot';
282 is $rel_info->{attrs}{join_type}, 'LEFT',
283 'relationship in schema name with dot';
286 ok $rsrc = $test_schema->source('Db2LoaderTest7');
287 } 'got source for table in schema name with dot';
289 %uniqs = try { $rsrc->unique_constraints };
292 'got unique and primary constraint in schema name with dot';
294 delete $uniqs{primary};
296 is_deeply ((values %uniqs)[0], ['six_id'],
297 'correct unique constraint in schema name with dot');
300 ok $test_schema->source('Db2LoaderTest6')
301 ->has_relationship('db2_loader_test4');
302 } 'cross-schema relationship in multi-db_schema';
305 ok $test_schema->source('Db2LoaderTest4')
306 ->has_relationship('db2_loader_test6s');
307 } 'cross-schema relationship in multi-db_schema';
310 ok $test_schema->source('Db2LoaderTest8')
311 ->has_relationship('db2_loader_test7');
312 } 'cross-schema relationship in multi-db_schema';
315 ok $test_schema->source('Db2LoaderTest7')
316 ->has_relationship('db2_loader_test8s');
317 } 'cross-schema relationship in multi-db_schema';
325 $tester->run_tests();
328 if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
329 if ($schemas_created && (my $dbh = try { $schema->storage->dbh })) {
330 foreach my $table ('"dbicsl-test".db2_loader_test8',
331 '"dbicsl.test".db2_loader_test7',
332 '"dbicsl.test".db2_loader_test6',
333 '"dbicsl-test".db2_loader_test5',
334 '"dbicsl.test".db2_loader_test5',
335 '"dbicsl-test".db2_loader_test4') {
337 $dbh->do("DROP TABLE $table");
340 diag "Error dropping table: $_";
344 foreach my $db_schema (qw/dbicsl-test dbicsl.test/) {
346 $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT});
349 diag "Error dropping test schema $db_schema: $_";
353 rmtree EXTRA_DUMP_DIR;
356 # vim:et sts=4 sw=4 tw=0: