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     data_types => {
  50         # http://publib.boulder.ibm.com/infocenter/db2luw/v8/index.jsp?topic=/com.ibm.db2.udb.doc/admin/r0008483.htm
  51         #
  52         # Numeric Types
  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] },
  67
  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' },
  74
  75         # Graphic String Types (double-byte strings)
  76         ($maj_srv_ver >= 9) ? (%$extra_graphics_data_types) : (),
  77
  78         # Binary String 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' },
  87
  88         # DateTime Types
  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' } },
 101
 102         # DATALINK Type
 103         # XXX I don't know how to make these
 104 #        datalink           => { data_type => 'datalink' },
 105     },
 106     extra => {
 107         count => 30 * 2,
 108         run => sub {
 109             SKIP: {
 110                 $schema = shift;
 111
 112                 my $dbh = $schema->storage->dbh;
 113
 114                 try {
 115                     $dbh->do('CREATE SCHEMA "dbicsl-test"');
 116                 }
 117                 catch {
 118                     $schemas_created = 0;
 119                     skip "no CREATE SCHEMA privileges", 28 * 2;
 120                 };
 121
 122                 $dbh->do(<<"EOF");
 123                     CREATE TABLE "dbicsl-test".db2_loader_test4 (
 124                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 125                         value VARCHAR(100)
 126                     )
 127 EOF
 128                 $dbh->do(<<"EOF");
 129                     CREATE TABLE "dbicsl-test".db2_loader_test5 (
 130                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 131                         value VARCHAR(100),
 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)
 135                     )
 136 EOF
 137                 $dbh->do('CREATE SCHEMA "dbicsl.test"');
 138                 $dbh->do(<<"EOF");
 139                     CREATE TABLE "dbicsl.test".db2_loader_test5 (
 140                         pk INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 141                         value VARCHAR(100),
 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)
 145                     )
 146 EOF
 147                 $dbh->do(<<"EOF");
 148                     CREATE TABLE "dbicsl.test".db2_loader_test6 (
 149                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 150                         value VARCHAR(100),
 151                         db2_loader_test4_id INTEGER,
 152                         FOREIGN KEY (db2_loader_test4_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
 153                     )
 154 EOF
 155                 $dbh->do(<<"EOF");
 156                     CREATE TABLE "dbicsl.test".db2_loader_test7 (
 157                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 158                         value VARCHAR(100),
 159                         six_id INTEGER NOT NULL UNIQUE,
 160                         FOREIGN KEY (six_id) REFERENCES "dbicsl.test".db2_loader_test6 (id)
 161                     )
 162 EOF
 163                 $dbh->do(<<"EOF");
 164                     CREATE TABLE "dbicsl-test".db2_loader_test8 (
 165                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 166                         value VARCHAR(100),
 167                         db2_loader_test7_id INTEGER,
 168                         FOREIGN KEY (db2_loader_test7_id) REFERENCES "dbicsl.test".db2_loader_test7 (id)
 169                     )
 170 EOF
 171
 172                 $schemas_created = 1;
 173
 174                 foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') {
 175                     lives_and {
 176                         rmtree EXTRA_DUMP_DIR;
 177
 178                         my @warns;
 179                         local $SIG{__WARN__} = sub {
 180                             push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
 181                         };
 182
 183                         make_schema_at(
 184                             'DB2MultiSchema',
 185                             {
 186                                 naming => 'current',
 187                                 db_schema => $db_schema,
 188                                 dump_directory => EXTRA_DUMP_DIR,
 189                                 quiet => 1,
 190                             },
 191                             [ $dsn, $user, $password ],
 192                         );
 193
 194                         diag join "\n", @warns if @warns;
 195
 196                         is @warns, 0;
 197                     } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings';
 198
 199                     my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
 200
 201                     lives_and {
 202                         ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password);
 203                     } 'connected test schema';
 204
 205                     lives_and {
 206                         ok $rsrc = $test_schema->source('Db2LoaderTest4');
 207                     } 'got source for table in schema name with dash';
 208
 209                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 210                         'column in schema name with dash';
 211
 212                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 213                         'column in schema name with dash';
 214
 215                     is try { $rsrc->column_info('value')->{size} }, 100,
 216                         'column in schema name with dash';
 217
 218                     lives_and {
 219                         ok $rs = $test_schema->resultset('Db2LoaderTest4');
 220                     } 'got resultset for table in schema name with dash';
 221
 222                     lives_and {
 223                         ok $row = $rs->create({ value => 'foo' });
 224                     } 'executed SQL on table in schema name with dash';
 225
 226                     $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_db2_loader_test5') };
 227
 228                     is_deeply $rel_info->{cond}, {
 229                         'foreign.four_id' => 'self.id'
 230                     }, 'relationship in schema name with dash';
 231
 232                     is $rel_info->{attrs}{accessor}, 'single',
 233                         'relationship in schema name with dash';
 234
 235                     is $rel_info->{attrs}{join_type}, 'LEFT',
 236                         'relationship in schema name with dash';
 237
 238                     lives_and {
 239                         ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest5');
 240                     } 'got source for table in schema name with dash';
 241
 242                     %uniqs = try { $rsrc->unique_constraints };
 243
 244                     is keys %uniqs, 2,
 245                         'got unique and primary constraint in schema name with dash';
 246
 247                     delete $uniqs{primary};
 248
 249                     is_deeply ((values %uniqs)[0], ['four_id'],
 250                         'correct unique constraint in schema name with dash');
 251
 252                     lives_and {
 253                         ok $rsrc = $test_schema->source('Db2LoaderTest6');
 254                     } 'got source for table in schema name with dot';
 255
 256                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 257                         'column in schema name with dot introspected correctly';
 258
 259                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 260                         'column in schema name with dot introspected correctly';
 261
 262                     is try { $rsrc->column_info('value')->{size} }, 100,
 263                         'column in schema name with dot introspected correctly';
 264
 265                     lives_and {
 266                         ok $rs = $test_schema->resultset('Db2LoaderTest6');
 267                     } 'got resultset for table in schema name with dot';
 268
 269                     lives_and {
 270                         ok $row = $rs->create({ value => 'foo' });
 271                     } 'executed SQL on table in schema name with dot';
 272
 273                     $rel_info = try { $rsrc->relationship_info('db2_loader_test7') };
 274
 275                     is_deeply $rel_info->{cond}, {
 276                         'foreign.six_id' => 'self.id'
 277                     }, 'relationship in schema name with dot';
 278
 279                     is $rel_info->{attrs}{accessor}, 'single',
 280                         'relationship in schema name with dot';
 281
 282                     is $rel_info->{attrs}{join_type}, 'LEFT',
 283                         'relationship in schema name with dot';
 284
 285                     lives_and {
 286                         ok $rsrc = $test_schema->source('Db2LoaderTest7');
 287                     } 'got source for table in schema name with dot';
 288
 289                     %uniqs = try { $rsrc->unique_constraints };
 290
 291                     is keys %uniqs, 2,
 292                         'got unique and primary constraint in schema name with dot';
 293
 294                     delete $uniqs{primary};
 295
 296                     is_deeply ((values %uniqs)[0], ['six_id'],
 297                         'correct unique constraint in schema name with dot');
 298
 299                     lives_and {
 300                         ok $test_schema->source('Db2LoaderTest6')
 301                             ->has_relationship('db2_loader_test4');
 302                     } 'cross-schema relationship in multi-db_schema';
 303
 304                     lives_and {
 305                         ok $test_schema->source('Db2LoaderTest4')
 306                             ->has_relationship('db2_loader_test6s');
 307                     } 'cross-schema relationship in multi-db_schema';
 308
 309                     lives_and {
 310                         ok $test_schema->source('Db2LoaderTest8')
 311                             ->has_relationship('db2_loader_test7');
 312                     } 'cross-schema relationship in multi-db_schema';
 313
 314                     lives_and {
 315                         ok $test_schema->source('Db2LoaderTest7')
 316                             ->has_relationship('db2_loader_test8s');
 317                     } 'cross-schema relationship in multi-db_schema';
 318                 }
 319             }
 320
 321         },
 322     },
 323 );
 324
 325 $tester->run_tests();
 326
 327 END {
 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') {
 336                 try {
 337                     $dbh->do("DROP TABLE $table");
 338                 }
 339                 catch {
 340                     diag "Error dropping table: $_";
 341                 };
 342             }
 343
 344             foreach my $db_schema (qw/dbicsl-test dbicsl.test/) {
 345                 try {
 346                     $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT});
 347                 }
 348                 catch {
 349                     diag "Error dropping test schema $db_schema: $_";
 350                 };
 351             }
 352         }
 353         rmtree EXTRA_DUMP_DIR;
 354     }
 355 }
 356 # vim:et sts=4 sw=4 tw=0: