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 => 28 * 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 UNIQUE,
 133                         FOREIGN KEY (four_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
 134                     )
 135 EOF
 136                 $dbh->do('CREATE SCHEMA "dbicsl.test"');
 137                 $dbh->do(<<"EOF");
 138                     CREATE TABLE "dbicsl.test".db2_loader_test6 (
 139                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 140                         value VARCHAR(100),
 141                         db2_loader_test4_id INTEGER,
 142                         FOREIGN KEY (db2_loader_test4_id) REFERENCES "dbicsl-test".db2_loader_test4 (id)
 143                     )
 144 EOF
 145                 $dbh->do(<<"EOF");
 146                     CREATE TABLE "dbicsl.test".db2_loader_test7 (
 147                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 148                         value VARCHAR(100),
 149                         six_id INTEGER NOT NULL UNIQUE,
 150                         FOREIGN KEY (six_id) REFERENCES "dbicsl.test".db2_loader_test6 (id)
 151                     )
 152 EOF
 153                 $dbh->do(<<"EOF");
 154                     CREATE TABLE "dbicsl-test".db2_loader_test8 (
 155                         id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY,
 156                         value VARCHAR(100),
 157                         db2_loader_test7_id INTEGER,
 158                         FOREIGN KEY (db2_loader_test7_id) REFERENCES "dbicsl.test".db2_loader_test7 (id)
 159                     )
 160 EOF
 161
 162                 $schemas_created = 1;
 163
 164                 foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') {
 165                     lives_and {
 166                         rmtree EXTRA_DUMP_DIR;
 167
 168                         my @warns;
 169                         local $SIG{__WARN__} = sub {
 170                             push @warns, $_[0] unless $_[0] =~ /\bcollides\b/;
 171                         };
 172
 173                         make_schema_at(
 174                             'DB2MultiSchema',
 175                             {
 176                                 naming => 'current',
 177                                 db_schema => $db_schema,
 178                                 dump_directory => EXTRA_DUMP_DIR,
 179                                 quiet => 1,
 180                             },
 181                             [ $dsn, $user, $password ],
 182                         );
 183
 184                         diag join "\n", @warns if @warns;
 185
 186                         is @warns, 0;
 187                     } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings';
 188
 189                     my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
 190
 191                     lives_and {
 192                         ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password);
 193                     } 'connected test schema';
 194
 195                     lives_and {
 196                         ok $rsrc = $test_schema->source('Db2LoaderTest4');
 197                     } 'got source for table in schema name with dash';
 198
 199                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 200                         'column in schema name with dash';
 201
 202                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 203                         'column in schema name with dash';
 204
 205                     is try { $rsrc->column_info('value')->{size} }, 100,
 206                         'column in schema name with dash';
 207
 208                     lives_and {
 209                         ok $rs = $test_schema->resultset('Db2LoaderTest4');
 210                     } 'got resultset for table in schema name with dash';
 211
 212                     lives_and {
 213                         ok $row = $rs->create({ value => 'foo' });
 214                     } 'executed SQL on table in schema name with dash';
 215
 216                     $rel_info = try { $rsrc->relationship_info('db2_loader_test5') };
 217
 218                     is_deeply $rel_info->{cond}, {
 219                         'foreign.four_id' => 'self.id'
 220                     }, 'relationship in schema name with dash';
 221
 222                     is $rel_info->{attrs}{accessor}, 'single',
 223                         'relationship in schema name with dash';
 224
 225                     is $rel_info->{attrs}{join_type}, 'LEFT',
 226                         'relationship in schema name with dash';
 227
 228                     lives_and {
 229                         ok $rsrc = $test_schema->source('Db2LoaderTest5');
 230                     } 'got source for table in schema name with dash';
 231
 232                     %uniqs = try { $rsrc->unique_constraints };
 233
 234                     is keys %uniqs, 2,
 235                         'got unique and primary constraint in schema name with dash';
 236
 237                     lives_and {
 238                         ok $rsrc = $test_schema->source('Db2LoaderTest6');
 239                     } 'got source for table in schema name with dot';
 240
 241                     is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 242                         'column in schema name with dot introspected correctly';
 243
 244                     is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 245                         'column in schema name with dot introspected correctly';
 246
 247                     is try { $rsrc->column_info('value')->{size} }, 100,
 248                         'column in schema name with dot introspected correctly';
 249
 250                     lives_and {
 251                         ok $rs = $test_schema->resultset('Db2LoaderTest6');
 252                     } 'got resultset for table in schema name with dot';
 253
 254                     lives_and {
 255                         ok $row = $rs->create({ value => 'foo' });
 256                     } 'executed SQL on table in schema name with dot';
 257
 258                     $rel_info = try { $rsrc->relationship_info('db2_loader_test7') };
 259
 260                     is_deeply $rel_info->{cond}, {
 261                         'foreign.six_id' => 'self.id'
 262                     }, 'relationship in schema name with dot';
 263
 264                     is $rel_info->{attrs}{accessor}, 'single',
 265                         'relationship in schema name with dot';
 266
 267                     is $rel_info->{attrs}{join_type}, 'LEFT',
 268                         'relationship in schema name with dot';
 269
 270                     lives_and {
 271                         ok $rsrc = $test_schema->source('Db2LoaderTest7');
 272                     } 'got source for table in schema name with dot';
 273
 274                     %uniqs = try { $rsrc->unique_constraints };
 275
 276                     is keys %uniqs, 2,
 277                         'got unique and primary constraint in schema name with dot';
 278
 279                     lives_and {
 280                         ok $test_schema->source('Db2LoaderTest6')
 281                             ->has_relationship('db2_loader_test4');
 282                     } 'cross-schema relationship in multi-db_schema';
 283
 284                     lives_and {
 285                         ok $test_schema->source('Db2LoaderTest4')
 286                             ->has_relationship('db2_loader_test6s');
 287                     } 'cross-schema relationship in multi-db_schema';
 288
 289                     lives_and {
 290                         ok $test_schema->source('Db2LoaderTest8')
 291                             ->has_relationship('db2_loader_test7');
 292                     } 'cross-schema relationship in multi-db_schema';
 293
 294                     lives_and {
 295                         ok $test_schema->source('Db2LoaderTest7')
 296                             ->has_relationship('db2_loader_test8s');
 297                     } 'cross-schema relationship in multi-db_schema';
 298                 }
 299             }
 300
 301         },
 302     },
 303 );
 304
 305 $tester->run_tests();
 306
 307 END {
 308     if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
 309         if ($schemas_created && (my $dbh = try { $schema->storage->dbh })) {
 310             foreach my $table ('"dbicsl-test".db2_loader_test8',
 311                                '"dbicsl.test".db2_loader_test7',
 312                                '"dbicsl.test".db2_loader_test6',
 313                                '"dbicsl-test".db2_loader_test5',
 314                                '"dbicsl-test".db2_loader_test4') {
 315                 try {
 316                     $dbh->do("DROP TABLE $table");
 317                 }
 318                 catch {
 319                     diag "Error dropping table: $_";
 320                 };
 321             }
 322
 323             foreach my $db_schema (qw/dbicsl-test dbicsl.test/) {
 324                 try {
 325                     $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT});
 326                 }
 327                 catch {
 328                     diag "Error dropping test schema $db_schema: $_";
 329                 };
 330             }
 331         }
 332         rmtree EXTRA_DUMP_DIR;
 333     }
 334 }
 335 # vim:et sts=4 sw=4 tw=0: