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 moniker_parts => [qw/schema name/],
189 dump_directory => EXTRA_DUMP_DIR,
192 [ $dsn, $user, $password ],
195 diag join "\n", @warns if @warns;
198 } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings';
200 my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
203 ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password);
204 } 'connected test schema';
207 ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest4');
208 } 'got source for table in schema name with dash';
210 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
211 'column in schema name with dash';
213 is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
214 'column in schema name with dash';
216 is try { $rsrc->column_info('value')->{size} }, 100,
217 'column in schema name with dash';
220 ok $rs = $test_schema->resultset('DbicslDashTestDb2LoaderTest4');
221 } 'got resultset for table in schema name with dash';
224 ok $row = $rs->create({ value => 'foo' });
225 } 'executed SQL on table in schema name with dash';
227 $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_db2_loader_test5') };
229 is_deeply $rel_info->{cond}, {
230 'foreign.four_id' => 'self.id'
231 }, 'relationship in schema name with dash';
233 is $rel_info->{attrs}{accessor}, 'single',
234 'relationship in schema name with dash';
236 is $rel_info->{attrs}{join_type}, 'LEFT',
237 'relationship in schema name with dash';
240 ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest5');
241 } 'got source for table in schema name with dash';
243 %uniqs = try { $rsrc->unique_constraints };
246 'got unique and primary constraint in schema name with dash';
248 delete $uniqs{primary};
250 is_deeply ((values %uniqs)[0], ['four_id'],
251 'correct unique constraint in schema name with dash');
254 ok $rsrc = $test_schema->source('DbicslDotTestDb2LoaderTest6');
255 } 'got source for table in schema name with dot';
257 is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
258 'column in schema name with dot introspected correctly';
260 is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
261 'column in schema name with dot introspected correctly';
263 is try { $rsrc->column_info('value')->{size} }, 100,
264 'column in schema name with dot introspected correctly';
267 ok $rs = $test_schema->resultset('DbicslDotTestDb2LoaderTest6');
268 } 'got resultset for table in schema name with dot';
271 ok $row = $rs->create({ value => 'foo' });
272 } 'executed SQL on table in schema name with dot';
274 $rel_info = try { $rsrc->relationship_info('db2_loader_test7') };
276 is_deeply $rel_info->{cond}, {
277 'foreign.six_id' => 'self.id'
278 }, 'relationship in schema name with dot';
280 is $rel_info->{attrs}{accessor}, 'single',
281 'relationship in schema name with dot';
283 is $rel_info->{attrs}{join_type}, 'LEFT',
284 'relationship in schema name with dot';
287 ok $rsrc = $test_schema->source('DbicslDotTestDb2LoaderTest7');
288 } 'got source for table in schema name with dot';
290 %uniqs = try { $rsrc->unique_constraints };
293 'got unique and primary constraint in schema name with dot';
295 delete $uniqs{primary};
297 is_deeply ((values %uniqs)[0], ['six_id'],
298 'correct unique constraint in schema name with dot');
301 ok $test_schema->source('DbicslDotTestDb2LoaderTest6')
302 ->has_relationship('db2_loader_test4');
303 } 'cross-schema relationship in multi-db_schema';
306 ok $test_schema->source('DbicslDashTestDb2LoaderTest4')
307 ->has_relationship('db2_loader_test6s');
308 } 'cross-schema relationship in multi-db_schema';
311 ok $test_schema->source('DbicslDashTestDb2LoaderTest8')
312 ->has_relationship('db2_loader_test7');
313 } 'cross-schema relationship in multi-db_schema';
316 ok $test_schema->source('DbicslDotTestDb2LoaderTest7')
317 ->has_relationship('db2_loader_test8s');
318 } 'cross-schema relationship in multi-db_schema';
326 $tester->run_tests();
329 if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
330 if ($schemas_created && (my $dbh = try { $schema->storage->dbh })) {
331 foreach my $table ('"dbicsl-test".db2_loader_test8',
332 '"dbicsl.test".db2_loader_test7',
333 '"dbicsl.test".db2_loader_test6',
334 '"dbicsl-test".db2_loader_test5',
335 '"dbicsl.test".db2_loader_test5',
336 '"dbicsl-test".db2_loader_test4') {
338 $dbh->do("DROP TABLE $table");
341 diag "Error dropping table: $_";
345 foreach my $db_schema (qw/dbicsl-test dbicsl.test/) {
347 $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT});
350 diag "Error dropping test schema $db_schema: $_";
354 rmtree EXTRA_DUMP_DIR;
357 # vim:et sts=4 sw=4 tw=0: