t/10_04db2_common.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Test::Exception;
   5 use Try::Tiny;
   6 use File::Path 'rmtree';
   7 use DBIx::Class::Schema::Loader 'make_schema_at';
   8
   9 use lib qw(t/lib);
  10
  11 use dbixcsl_common_tests ();
  12 use dbixcsl_test_dir '$tdir';
  13
  14 use constant EXTRA_DUMP_DIR => "$tdir/db2_extra_dump";
  15
  16 my $dsn      = $ENV{DBICTEST_DB2_DSN} || '';
  17 my $user     = $ENV{DBICTEST_DB2_USER} || '';
  18 my $password = $ENV{DBICTEST_DB2_PASS} || '';
  19
  20 plan skip_all => 'You need to set the DBICTEST_DB2_DSN, _USER, and _PASS environment variables'
  21     unless ($dsn && $user);
  22
  23 my ($schema, $schemas_created); # for cleanup in END for extra tests
  24
  25 my $srv_ver = do {
  26     require DBI;
  27     my $dbh = DBI->connect ($dsn, $user, $password, { RaiseError => 1, PrintError => 0} );
  28     eval { $dbh->get_info(18) } || 0;
  29 };
  30 my ($maj_srv_ver) = $srv_ver =~ /^(\d+)/;
  31
  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' },
  38 };
  39
  40 my $tester = dbixcsl_common_tests->new(
  41     vendor         => 'DB2',
  42     auto_inc_pk    => 'INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY',
  43     dsn            => $dsn,
  44     user           => $user,
  45     password       => $password,
  46     null           => '',
  47     preserve_case_mode_is_exclusive => 1,
  48     quote_char                      => '"',
  49     default_is_deferrable => 1,
  50     default_on_clause => 'NO ACTION',
  51     data_types => {
  52         # http://publib.boulder.ibm.com/infocenter/db2luw/v8/index.jsp?topic=/com.ibm.db2.udb.doc/admin/r0008483.htm
  53         #
  54         # Numeric Types
  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] },
  69
  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' },
  76
  77         # Graphic String Types (double-byte strings)
  78         ($maj_srv_ver >= 9) ? (%$extra_graphics_data_types) : (),
  79
  80         # Binary String 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' },
  89
  90         # DateTime Types
  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' } },
 103
 104         # DATALINK Type
 105         # XXX I don't know how to make these
 106 #        datalink           => { data_type => 'datalink' },
 107     },
 108     extra => {
 109         create => [
 110             # 4 through 8 are used for the multi-schema tests
 111             q{
 112                 create table db2_loader_test9 (
 113                     id int generated by default as identity not null primary key
 114                 )
 115             },
 116             q{
 117                 create table db2_loader_test10 (
 118                     id int generated by default as identity not null primary key,
 119                     nine_id int,
 120                     foreign key (nine_id) references db2_loader_test9(id)
 121                         on delete set null on update restrict
 122                 )
 123             },
 124         ],
 125         drop  => [ qw/db2_loader_test9 db2_loader_test10/ ],
 126         count => 4 + 30 * 2,
 127         run => sub {
 128             $schema = shift;
 129
 130             # test on delete/update fk clause introspection
 131             ok ((my $rel_info = $schema->source('Db2LoaderTest10')->relationship_info('nine')),
 132                 'got rel info');
 133
 134             is $rel_info->{attrs}{on_delete}, 'SET NULL',
 135                 'ON DELETE clause introspected correctly';
 136
 137             is $rel_info->{attrs}{on_update}, 'RESTRICT',
 138                 'ON UPDATE clause introspected correctly';
 139
 140             is $rel_info->{attrs}{is_deferrable}, 1,
 141                 'DEFERRABLE defaults to 1';
 142
 143             SKIP: {
 144                 my $dbh = $schema->storage->dbh;
 145
 146                 try {
 147                     $dbh->do('CREATE SCHEMA "dbicsl-test"');
 148                 }
 149                 catch {
 150                     $schemas_created = 0;
 151                     skip "no CREATE SCHEMA privileges", 28 * 2;
 152                 };
 153
 154                 $dbh->do(<<"EOF");
 155                     CREATE TABLE "dbicsl-test".db2_loader_test4 (
 156                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 157                         value VARCHAR(100)
 158                     )
 159 EOF
 160                 $dbh->do(<<"EOF");
 161                     CREATE TABLE "dbicsl-test".db2_loader_test5 (
 162                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 163                         value VARCHAR(100),
 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)
 167                     )
 168 EOF
 169                 $dbh->do('CREATE SCHEMA "dbicsl.test"');
 170                 $dbh->do(<<"EOF");
 171                     CREATE TABLE "dbicsl.test".db2_loader_test5 (
 172                         pk INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 173                         value VARCHAR(100),
 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)
 177                     )
 178 EOF
 179                 $dbh->do(<<"EOF");
 180                     CREATE TABLE "dbicsl.test".db2_loader_test6 (
 181                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 182                         value VARCHAR(100),
 183                         db2_loader_test4_id INTEGER,
 184                         FOREIGN KEY (db2_loader_test4_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
 185                     )
 186 EOF
 187                 $dbh->do(<<"EOF");
 188                     CREATE TABLE "dbicsl.test".db2_loader_test7 (
 189                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 190                         value VARCHAR(100),
 191                         six_id INTEGER NOT NULL UNIQUE,
 192                         FOREIGN KEY (six_id) REFERENCES "dbicsl.test".db2_loader_test6 (id)
 193                     )
 194 EOF
 195                 $dbh->do(<<"EOF");
 196                     CREATE TABLE "dbicsl-test".db2_loader_test8 (
 197                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 198                         value VARCHAR(100),
 199                         db2_loader_test7_id INTEGER,
 200                         FOREIGN KEY (db2_loader_test7_id) REFERENCES "dbicsl.test".db2_loader_test7 (id)
 201                     )
 202 EOF
 203
 204                 $schemas_created = 1;
 205
 206                 foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') {
 207                     lives_and {
 208                         rmtree EXTRA_DUMP_DIR;
 209
 210                         my @warns;
 211                         local $SIG{__WARN__} = sub {
 212                             push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
 213                         };
 214
 215                         make_schema_at(
 216                             'DB2MultiSchema',
 217                             {
 218                                 naming => 'current',
 219                                 db_schema => $db_schema,
 220                                 dump_directory => EXTRA_DUMP_DIR,
 221                                 quiet => 1,
 222                             },
 223                             [ $dsn, $user, $password ],
 224                         );
 225
 226                         diag join "\n", @warns if @warns;
 227
 228                         is @warns, 0;
 229                     } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings';
 230
 231                     my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
 232
 233                     lives_and {
 234                         ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password);
 235                     } 'connected test schema';
 236
 237                     lives_and {
 238                         ok $rsrc = $test_schema->source('Db2LoaderTest4');
 239                     } 'got source for table in schema name with dash';
 240
 241                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 242                         'column in schema name with dash';
 243
 244                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 245                         'column in schema name with dash';
 246
 247                     is try { $rsrc->column_info('value')->{size} }, 100,
 248                         'column in schema name with dash';
 249
 250                     lives_and {
 251                         ok $rs = $test_schema->resultset('Db2LoaderTest4');
 252                     } 'got resultset for table in schema name with dash';
 253
 254                     lives_and {
 255                         ok $row = $rs->create({ value => 'foo' });
 256                     } 'executed SQL on table in schema name with dash';
 257
 258                     $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_db2_loader_test5') };
 259
 260                     is_deeply $rel_info->{cond}, {
 261                         'foreign.four_id' => 'self.id'
 262                     }, 'relationship in schema name with dash';
 263
 264                     is $rel_info->{attrs}{accessor}, 'single',
 265                         'relationship in schema name with dash';
 266
 267                     is $rel_info->{attrs}{join_type}, 'LEFT',
 268                         'relationship in schema name with dash';
 269
 270                     lives_and {
 271                         ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest5');
 272                     } 'got source for table in schema name with dash';
 273
 274                     %uniqs = try { $rsrc->unique_constraints };
 275
 276                     is keys %uniqs, 2,
 277                         'got unique and primary constraint in schema name with dash';
 278
 279                     delete $uniqs{primary};
 280
 281                     is_deeply ((values %uniqs)[0], ['four_id'],
 282                         'correct unique constraint in schema name with dash');
 283
 284                     lives_and {
 285                         ok $rsrc = $test_schema->source('Db2LoaderTest6');
 286                     } 'got source for table in schema name with dot';
 287
 288                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 289                         'column in schema name with dot introspected correctly';
 290
 291                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 292                         'column in schema name with dot introspected correctly';
 293
 294                     is try { $rsrc->column_info('value')->{size} }, 100,
 295                         'column in schema name with dot introspected correctly';
 296
 297                     lives_and {
 298                         ok $rs = $test_schema->resultset('Db2LoaderTest6');
 299                     } 'got resultset for table in schema name with dot';
 300
 301                     lives_and {
 302                         ok $row = $rs->create({ value => 'foo' });
 303                     } 'executed SQL on table in schema name with dot';
 304
 305                     $rel_info = try { $rsrc->relationship_info('db2_loader_test7') };
 306
 307                     is_deeply $rel_info->{cond}, {
 308                         'foreign.six_id' => 'self.id'
 309                     }, 'relationship in schema name with dot';
 310
 311                     is $rel_info->{attrs}{accessor}, 'single',
 312                         'relationship in schema name with dot';
 313
 314                     is $rel_info->{attrs}{join_type}, 'LEFT',
 315                         'relationship in schema name with dot';
 316
 317                     lives_and {
 318                         ok $rsrc = $test_schema->source('Db2LoaderTest7');
 319                     } 'got source for table in schema name with dot';
 320
 321                     %uniqs = try { $rsrc->unique_constraints };
 322
 323                     is keys %uniqs, 2,
 324                         'got unique and primary constraint in schema name with dot';
 325
 326                     delete $uniqs{primary};
 327
 328                     is_deeply ((values %uniqs)[0], ['six_id'],
 329                         'correct unique constraint in schema name with dot');
 330
 331                     lives_and {
 332                         ok $test_schema->source('Db2LoaderTest6')
 333                             ->has_relationship('db2_loader_test4');
 334                     } 'cross-schema relationship in multi-db_schema';
 335
 336                     lives_and {
 337                         ok $test_schema->source('Db2LoaderTest4')
 338                             ->has_relationship('db2_loader_test6s');
 339                     } 'cross-schema relationship in multi-db_schema';
 340
 341                     lives_and {
 342                         ok $test_schema->source('Db2LoaderTest8')
 343                             ->has_relationship('db2_loader_test7');
 344                     } 'cross-schema relationship in multi-db_schema';
 345
 346                     lives_and {
 347                         ok $test_schema->source('Db2LoaderTest7')
 348                             ->has_relationship('db2_loader_test8s');
 349                     } 'cross-schema relationship in multi-db_schema';
 350                 }
 351             }
 352
 353         },
 354     },
 355 );
 356
 357 $tester->run_tests();
 358
 359 END {
 360     if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
 361         if ($schemas_created && (my $dbh = try { $schema->storage->dbh })) {
 362             foreach my $table ('"dbicsl-test".db2_loader_test8',
 363                                '"dbicsl.test".db2_loader_test7',
 364                                '"dbicsl.test".db2_loader_test6',
 365                                '"dbicsl-test".db2_loader_test5',
 366                                '"dbicsl.test".db2_loader_test5',
 367                                '"dbicsl-test".db2_loader_test4') {
 368                 try {
 369                     $dbh->do("DROP TABLE $table");
 370                 }
 371                 catch {
 372                     diag "Error dropping table: $_";
 373                 };
 374             }
 375
 376             foreach my $db_schema (qw/dbicsl-test dbicsl.test/) {
 377                 try {
 378                     $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT});
 379                 }
 380                 catch {
 381                     diag "Error dropping test schema $db_schema: $_";
 382                 };
 383             }
 384         }
 385         rmtree EXTRA_DUMP_DIR;
 386     }
 387 }
 388 # vim:et sts=4 sw=4 tw=0: