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