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                                 moniker_parts => [qw/schema name/],
 189                                 dump_directory => EXTRA_DUMP_DIR,
 190                                 quiet => 1,
 191                             },
 192                             [ $dsn, $user, $password ],
 193                         );
 194
 195                         diag join "\n", @warns if @warns;
 196
 197                         is @warns, 0;
 198                     } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings';
 199
 200                     my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
 201
 202                     lives_and {
 203                         ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password);
 204                     } 'connected test schema';
 205
 206                     lives_and {
 207                         ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest4');
 208                     } 'got source for table in schema name with dash';
 209
 210                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 211                         'column in schema name with dash';
 212
 213                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 214                         'column in schema name with dash';
 215
 216                     is try { $rsrc->column_info('value')->{size} }, 100,
 217                         'column in schema name with dash';
 218
 219                     lives_and {
 220                         ok $rs = $test_schema->resultset('DbicslDashTestDb2LoaderTest4');
 221                     } 'got resultset for table in schema name with dash';
 222
 223                     lives_and {
 224                         ok $row = $rs->create({ value => 'foo' });
 225                     } 'executed SQL on table in schema name with dash';
 226
 227                     $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_db2_loader_test5') };
 228
 229                     is_deeply $rel_info->{cond}, {
 230                         'foreign.four_id' => 'self.id'
 231                     }, 'relationship in schema name with dash';
 232
 233                     is $rel_info->{attrs}{accessor}, 'single',
 234                         'relationship in schema name with dash';
 235
 236                     is $rel_info->{attrs}{join_type}, 'LEFT',
 237                         'relationship in schema name with dash';
 238
 239                     lives_and {
 240                         ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest5');
 241                     } 'got source for table in schema name with dash';
 242
 243                     %uniqs = try { $rsrc->unique_constraints };
 244
 245                     is keys %uniqs, 2,
 246                         'got unique and primary constraint in schema name with dash';
 247
 248                     delete $uniqs{primary};
 249
 250                     is_deeply ((values %uniqs)[0], ['four_id'],
 251                         'correct unique constraint in schema name with dash');
 252
 253                     lives_and {
 254                         ok $rsrc = $test_schema->source('DbicslDotTestDb2LoaderTest6');
 255                     } 'got source for table in schema name with dot';
 256
 257                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 258                         'column in schema name with dot introspected correctly';
 259
 260                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 261                         'column in schema name with dot introspected correctly';
 262
 263                     is try { $rsrc->column_info('value')->{size} }, 100,
 264                         'column in schema name with dot introspected correctly';
 265
 266                     lives_and {
 267                         ok $rs = $test_schema->resultset('DbicslDotTestDb2LoaderTest6');
 268                     } 'got resultset for table in schema name with dot';
 269
 270                     lives_and {
 271                         ok $row = $rs->create({ value => 'foo' });
 272                     } 'executed SQL on table in schema name with dot';
 273
 274                     $rel_info = try { $rsrc->relationship_info('db2_loader_test7') };
 275
 276                     is_deeply $rel_info->{cond}, {
 277                         'foreign.six_id' => 'self.id'
 278                     }, 'relationship in schema name with dot';
 279
 280                     is $rel_info->{attrs}{accessor}, 'single',
 281                         'relationship in schema name with dot';
 282
 283                     is $rel_info->{attrs}{join_type}, 'LEFT',
 284                         'relationship in schema name with dot';
 285
 286                     lives_and {
 287                         ok $rsrc = $test_schema->source('DbicslDotTestDb2LoaderTest7');
 288                     } 'got source for table in schema name with dot';
 289
 290                     %uniqs = try { $rsrc->unique_constraints };
 291
 292                     is keys %uniqs, 2,
 293                         'got unique and primary constraint in schema name with dot';
 294
 295                     delete $uniqs{primary};
 296
 297                     is_deeply ((values %uniqs)[0], ['six_id'],
 298                         'correct unique constraint in schema name with dot');
 299
 300                     lives_and {
 301                         ok $test_schema->source('DbicslDotTestDb2LoaderTest6')
 302                             ->has_relationship('db2_loader_test4');
 303                     } 'cross-schema relationship in multi-db_schema';
 304
 305                     lives_and {
 306                         ok $test_schema->source('DbicslDashTestDb2LoaderTest4')
 307                             ->has_relationship('db2_loader_test6s');
 308                     } 'cross-schema relationship in multi-db_schema';
 309
 310                     lives_and {
 311                         ok $test_schema->source('DbicslDashTestDb2LoaderTest8')
 312                             ->has_relationship('db2_loader_test7');
 313                     } 'cross-schema relationship in multi-db_schema';
 314
 315                     lives_and {
 316                         ok $test_schema->source('DbicslDotTestDb2LoaderTest7')
 317                             ->has_relationship('db2_loader_test8s');
 318                     } 'cross-schema relationship in multi-db_schema';
 319                 }
 320             }
 321
 322         },
 323     },
 324 );
 325
 326 $tester->run_tests();
 327
 328 END {
 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') {
 337                 try {
 338                     $dbh->do("DROP TABLE $table");
 339                 }
 340                 catch {
 341                     diag "Error dropping table: $_";
 342                 };
 343             }
 344
 345             foreach my $db_schema (qw/dbicsl-test dbicsl.test/) {
 346                 try {
 347                     $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT});
 348                 }
 349                 catch {
 350                     diag "Error dropping test schema $db_schema: $_";
 351                 };
 352             }
 353         }
 354         rmtree EXTRA_DUMP_DIR;
 355     }
 356 }
 357 # vim:et sts=4 sw=4 tw=0: