t/10_06sybase_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 use namespace::clean;
   9 use DBI ();
  10
  11 use lib qw(t/lib);
  12
  13 use dbixcsl_common_tests ();
  14 use dbixcsl_test_dir '$tdir';
  15
  16 use constant EXTRA_DUMP_DIR => "$tdir/sybase_extra_dump";
  17
  18 my $dsn      = $ENV{DBICTEST_SYBASE_DSN} || '';
  19 my $user     = $ENV{DBICTEST_SYBASE_USER} || '';
  20 my $password = $ENV{DBICTEST_SYBASE_PASS} || '';
  21
  22 my ($schema, $databases_created); # for cleanup in END for extra tests
  23
  24 my $tester = dbixcsl_common_tests->new(
  25     vendor      => 'sybase',
  26     auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY',
  27     default_function     => 'getdate()',
  28     default_function_def => 'AS getdate()',
  29     dsn         => $dsn,
  30     user        => $user,
  31     password    => $password,
  32     data_types  => {
  33         # http://ispirer.com/wiki/sqlways/sybase/data-types
  34         #
  35         # Numeric Types
  36         'integer identity' => { data_type => 'integer', is_auto_increment => 1 },
  37         int      => { data_type => 'integer' },
  38         integer  => { data_type => 'integer' },
  39         bigint   => { data_type => 'bigint' },
  40         smallint => { data_type => 'smallint' },
  41         tinyint  => { data_type => 'tinyint' },
  42         'double precision' => { data_type => 'double precision' },
  43         real           => { data_type => 'real' },
  44         float          => { data_type => 'double precision' },
  45         'float(14)'    => { data_type => 'real' },
  46         'float(15)'    => { data_type => 'real' },
  47         'float(16)'    => { data_type => 'double precision' },
  48         'float(48)'    => { data_type => 'double precision' },
  49         'numeric(6,3)' => { data_type => 'numeric', size => [6,3] },
  50         'decimal(6,3)' => { data_type => 'numeric', size => [6,3] },
  51         numeric        => { data_type => 'numeric' },
  52         decimal        => { data_type => 'numeric' },
  53         bit            => { data_type => 'bit' },
  54
  55         # Money Types
  56         money          => { data_type => 'money' },
  57         smallmoney     => { data_type => 'smallmoney' },
  58
  59         # Computed Column
  60         'AS getdate()'     => { data_type => undef, inflate_datetime => 1, default_value => \'getdate()' },
  61
  62         # Blob Types
  63         text     => { data_type => 'text' },
  64         unitext  => { data_type => 'unitext' },
  65         image    => { data_type => 'image' },
  66
  67         # DateTime Types
  68         date     => { data_type => 'date' },
  69         time     => { data_type => 'time' },
  70         datetime => { data_type => 'datetime' },
  71         smalldatetime  => { data_type => 'smalldatetime' },
  72
  73         # Timestamp column
  74         timestamp      => { data_type => 'timestamp', inflate_datetime => 0 },
  75
  76         # String Types
  77         'char'         => { data_type => 'char', size => 1 },
  78         'char(2)'      => { data_type => 'char', size => 2 },
  79         'nchar'        => { data_type => 'nchar', size => 1 },
  80         'nchar(2)'     => { data_type => 'nchar', size => 2 },
  81         'unichar(2)'   => { data_type => 'unichar', size => 2 },
  82         'varchar(2)'   => { data_type => 'varchar', size => 2 },
  83         'nvarchar(2)'  => { data_type => 'nvarchar', size => 2 },
  84         'univarchar(2)' => { data_type => 'univarchar', size => 2 },
  85
  86         # Binary Types
  87         'binary'       => { data_type => 'binary', size => 1 },
  88         'binary(2)'    => { data_type => 'binary', size => 2 },
  89         'varbinary(2)' => { data_type => 'varbinary', size => 2 },
  90     },
  91     # test that named constraints aren't picked up as tables (I can't reproduce this on my machine)
  92     failtrigger_warnings => [ qr/^Bad table or view 'sybase_loader_test2_ref_slt1'/ ],
  93     extra => {
  94         create => [
  95             q{
  96                 CREATE TABLE sybase_loader_test1 (
  97                     id int identity primary key
  98                 )
  99             },
 100             q{
 101                 CREATE TABLE sybase_loader_test2 (
 102                     id int identity primary key,
 103                     sybase_loader_test1_id int,
 104                     CONSTRAINT sybase_loader_test2_ref_slt1 FOREIGN KEY (sybase_loader_test1_id) REFERENCES sybase_loader_test1 (id)
 105                 )
 106             },
 107         ],
 108         drop => [ qw/sybase_loader_test1 sybase_loader_test2/ ],
 109         count => 30 * 4,
 110         run => sub {
 111             $schema = shift;
 112
 113             SKIP: {
 114                 my $dbh = $schema->storage->dbh;
 115
 116                 try {
 117                     $dbh->do('USE master');
 118                 }
 119                 catch {
 120                     skip "these tests require the sysadmin role", 30 * 4;
 121                 };
 122
 123                 try {
 124                     $dbh->do('CREATE DATABASE [dbicsl_test1]');
 125                     $dbh->do('CREATE DATABASE [dbicsl_test2]');
 126                 }
 127                 catch {
 128                     skip "cannot create databases: $_", 30 * 4;
 129                 };
 130
 131                 try {
 132                     my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
 133                     local $SIG{__WARN__} = sub {
 134                         $warn_handler->(@_)
 135                             unless $_[0] =~ /^Password correctly set\.$|^Account unlocked\.$|^New login created\.$|^New user added\.$/;
 136                     };
 137
 138                     $dbh->do("sp_addlogin dbicsl_user1, dbicsl, [dbicsl_test1]");
 139                     $dbh->do("sp_addlogin dbicsl_user2, dbicsl, [dbicsl_test2]");
 140
 141                     $dbh->do("USE [dbicsl_test1]");
 142                     $dbh->do("sp_adduser dbicsl_user1");
 143                     $dbh->do("sp_adduser dbicsl_user2");
 144                     $dbh->do("GRANT ALL TO dbicsl_user1");
 145                     $dbh->do("GRANT ALL TO dbicsl_user2");
 146
 147                     $dbh->do("USE [dbicsl_test2]");
 148                     $dbh->do("sp_adduser dbicsl_user2");
 149                     $dbh->do("sp_adduser dbicsl_user1");
 150                     $dbh->do("GRANT ALL TO dbicsl_user2");
 151                     $dbh->do("GRANT ALL TO dbicsl_user1");
 152                 }
 153                 catch {
 154                     skip "cannot add logins: $_", 30 * 4;
 155                 };
 156
 157                 my ($dbh1, $dbh2);
 158                 {
 159                     my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
 160                     local $SIG{__WARN__} = sub {
 161                         $warn_handler->(@_) unless $_[0] =~ /can't change context/;
 162                     };
 163
 164                     $dbh1 = DBI->connect($dsn, 'dbicsl_user1', 'dbicsl', {
 165                         RaiseError => 1,
 166                         PrintError => 0,
 167                     });
 168                     $dbh1->do('USE [dbicsl_test1]');
 169
 170                     $dbh2 = DBI->connect($dsn, 'dbicsl_user2', 'dbicsl', {
 171                         RaiseError => 1,
 172                         PrintError => 0,
 173                     });
 174                     $dbh2->do('USE [dbicsl_test2]');
 175                 }
 176
 177                 $dbh1->do(<<"EOF");
 178                     CREATE TABLE sybase_loader_test4 (
 179                         id INT IDENTITY PRIMARY KEY,
 180                         value VARCHAR(100) NULL
 181                     )
 182 EOF
 183                 $dbh1->do('GRANT ALL ON sybase_loader_test4 TO dbicsl_user2');
 184                 $dbh1->do(<<"EOF");
 185                     CREATE TABLE sybase_loader_test5 (
 186                         id INT IDENTITY PRIMARY KEY,
 187                         value VARCHAR(100) NULL,
 188                         four_id INTEGER,
 189                         CONSTRAINT loader_test5_uniq UNIQUE (four_id),
 190                         FOREIGN KEY (four_id) REFERENCES sybase_loader_test4 (id)
 191                     )
 192 EOF
 193                 $dbh2->do(<<"EOF");
 194                     CREATE TABLE sybase_loader_test5 (
 195                         pk INT IDENTITY PRIMARY KEY,
 196                         value VARCHAR(100) NULL,
 197                         four_id INTEGER,
 198                         CONSTRAINT loader_test5_uniq UNIQUE (four_id),
 199                         FOREIGN KEY (four_id) REFERENCES [dbicsl_test1].dbicsl_user1.sybase_loader_test4 (id)
 200                     )
 201 EOF
 202                 $dbh2->do(<<"EOF");
 203                     CREATE TABLE sybase_loader_test6 (
 204                         id INT IDENTITY PRIMARY KEY,
 205                         value VARCHAR(100) NULL,
 206                         sybase_loader_test4_id INTEGER NULL,
 207                         FOREIGN KEY (sybase_loader_test4_id) REFERENCES [dbicsl_test1].dbicsl_user1.sybase_loader_test4 (id)
 208                     )
 209 EOF
 210                 $dbh2->do(<<"EOF");
 211                     CREATE TABLE sybase_loader_test7 (
 212                         id INT IDENTITY PRIMARY KEY,
 213                         value VARCHAR(100) NULL,
 214                         six_id INTEGER UNIQUE,
 215                         FOREIGN KEY (six_id) REFERENCES sybase_loader_test6 (id)
 216                     )
 217 EOF
 218                 $dbh2->do('GRANT ALL ON sybase_loader_test7 TO dbicsl_user1');
 219                 $dbh1->do(<<"EOF");
 220                     CREATE TABLE sybase_loader_test8 (
 221                         id INT IDENTITY PRIMARY KEY,
 222                         value VARCHAR(100) NULL,
 223                         sybase_loader_test7_id INTEGER,
 224                         FOREIGN KEY (sybase_loader_test7_id) REFERENCES [dbicsl_test2].dbicsl_user2.sybase_loader_test7 (id)
 225                     )
 226 EOF
 227
 228                 $databases_created = 1;
 229
 230                 foreach my $databases (['dbicsl_test1', 'dbicsl_test2'], '%') {
 231                     foreach my $owners ([qw/dbicsl_user1 dbicsl_user2/], '%') {
 232                         lives_and {
 233                             rmtree EXTRA_DUMP_DIR;
 234
 235                             my @warns;
 236                             local $SIG{__WARN__} = sub {
 237                                 push @warns, $_[0] unless $_[0] =~ /\bcollides\b/
 238                                     || $_[0] =~ /can't change context/;
 239                             };
 240
 241                             my $database = $databases;
 242
 243                             $database = [ $database ] unless ref $database;
 244
 245                             my $db_schema = {};
 246
 247                             foreach my $db (@$database) {
 248                                 $db_schema->{$db} = $owners;
 249                             }
 250
 251                             make_schema_at(
 252                                 'SybaseMultiSchema',
 253                                 {
 254                                     naming => 'current',
 255                                     db_schema => $db_schema,
 256                                     moniker_parts => [qw/database name/],
 257                                     dump_directory => EXTRA_DUMP_DIR,
 258                                     quiet => 1,
 259                                 },
 260                                 [ $dsn, $user, $password ],
 261                             );
 262
 263                             diag join "\n", @warns if @warns;
 264
 265                             is @warns, 0;
 266                         } 'dumped schema for "dbicsl_test1" and "dbicsl_test2" databases with no warnings';
 267
 268                         my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info);
 269
 270                         lives_and {
 271                             ok $test_schema = SybaseMultiSchema->connect($dsn, $user, $password);
 272                         } 'connected test schema';
 273
 274                         lives_and {
 275                             ok $rsrc = $test_schema->source('DbicslTest1SybaseLoaderTest4');
 276                         } 'got source for table in database one';
 277
 278                         is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 279                             'column in database one';
 280
 281                         is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 282                             'column in database one';
 283
 284                         is try { $rsrc->column_info('value')->{size} }, 100,
 285                             'column in database one';
 286
 287                         lives_and {
 288                             ok $rs = $test_schema->resultset('DbicslTest1SybaseLoaderTest4');
 289                         } 'got resultset for table in database one';
 290
 291                         lives_and {
 292                             ok $row = $rs->create({ value => 'foo' });
 293                         } 'executed SQL on table in database one';
 294
 295                         $rel_info = try { $rsrc->relationship_info('dbicsl_test1_sybase_loader_test5') };
 296
 297                         is_deeply $rel_info->{cond}, {
 298                             'foreign.four_id' => 'self.id'
 299                         }, 'relationship in database one';
 300
 301                         is $rel_info->{attrs}{accessor}, 'single',
 302                             'relationship in database one';
 303
 304                         is $rel_info->{attrs}{join_type}, 'LEFT',
 305                             'relationship in database one';
 306
 307                         lives_and {
 308                             ok $rsrc = $test_schema->source('DbicslTest1SybaseLoaderTest5');
 309                         } 'got source for table in database one';
 310
 311                         %uniqs = try { $rsrc->unique_constraints };
 312
 313                         is keys %uniqs, 2,
 314                             'got unique and primary constraint in database one';
 315
 316                         delete $uniqs{primary};
 317
 318                         is_deeply ((values %uniqs)[0], ['four_id'],
 319                             'correct unique constraint in database one');
 320
 321                         lives_and {
 322                             ok $rsrc = $test_schema->source('DbicslTest2SybaseLoaderTest6');
 323                         } 'got source for table in database two';
 324
 325                         is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
 326                             'column in database two introspected correctly';
 327
 328                         is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
 329                             'column in database two introspected correctly';
 330
 331                         is try { $rsrc->column_info('value')->{size} }, 100,
 332                             'column in database two introspected correctly';
 333
 334                         lives_and {
 335                             ok $rs = $test_schema->resultset('DbicslTest2SybaseLoaderTest6');
 336                         } 'got resultset for table in database two';
 337
 338                         lives_and {
 339                             ok $row = $rs->create({ value => 'foo' });
 340                         } 'executed SQL on table in database two';
 341
 342                         $rel_info = try { $rsrc->relationship_info('sybase_loader_test7') };
 343
 344                         is_deeply $rel_info->{cond}, {
 345                             'foreign.six_id' => 'self.id'
 346                         }, 'relationship in database two';
 347
 348                         is $rel_info->{attrs}{accessor}, 'single',
 349                             'relationship in database two';
 350
 351                         is $rel_info->{attrs}{join_type}, 'LEFT',
 352                             'relationship in database two';
 353
 354                         lives_and {
 355                             ok $rsrc = $test_schema->source('DbicslTest2SybaseLoaderTest7');
 356                         } 'got source for table in database two';
 357
 358                         %uniqs = try { $rsrc->unique_constraints };
 359
 360                         is keys %uniqs, 2,
 361                             'got unique and primary constraint in database two';
 362
 363                         delete $uniqs{primary};
 364
 365                         is_deeply ((values %uniqs)[0], ['six_id'],
 366                             'correct unique constraint in database two');
 367
 368                         lives_and {
 369                             ok $test_schema->source('DbicslTest2SybaseLoaderTest6')
 370                                 ->has_relationship('sybase_loader_test4');
 371                         } 'cross-database relationship in multi database schema';
 372
 373                         lives_and {
 374                             ok $test_schema->source('DbicslTest1SybaseLoaderTest4')
 375                                 ->has_relationship('sybase_loader_test6s');
 376                         } 'cross-database relationship in multi database schema';
 377
 378                         lives_and {
 379                             ok $test_schema->source('DbicslTest1SybaseLoaderTest8')
 380                                 ->has_relationship('sybase_loader_test7');
 381                         } 'cross-database relationship in multi database schema';
 382
 383                         lives_and {
 384                             ok $test_schema->source('DbicslTest2SybaseLoaderTest7')
 385                                 ->has_relationship('sybase_loader_test8s');
 386                         } 'cross-database relationship in multi database schema';
 387                     }
 388                 }
 389             }
 390         },
 391     },
 392 );
 393
 394 if( !$dsn || !$user ) {
 395     $tester->skip_tests('You need to set the DBICTEST_SYBASE_DSN, _USER, and _PASS environment variables');
 396 }
 397 else {
 398     $tester->run_tests();
 399 }
 400
 401 END {
 402     if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
 403         rmtree EXTRA_DUMP_DIR;
 404
 405         if ($databases_created) {
 406             my $dbh = $schema->storage->dbh;
 407
 408             $dbh->do('USE master');
 409
 410             local $dbh->{FetchHashKeyName} = 'NAME_lc';
 411
 412             my $sth = $dbh->prepare('sp_who');
 413             $sth->execute;
 414
 415             while (my $row = $sth->fetchrow_hashref) {
 416                 if ($row->{dbname} =~ /^dbicsl_test[12]\z/) {
 417                     $dbh->do("kill $row->{spid}");
 418                 }
 419             }
 420
 421             foreach my $table ('[dbicsl_test1].dbicsl_user1.sybase_loader_test8',
 422                                '[dbicsl_test2].dbicsl_user2.sybase_loader_test7',
 423                                '[dbicsl_test2].dbicsl_user2.sybase_loader_test6',
 424                                '[dbicsl_test2].dbicsl_user2.sybase_loader_test5',
 425                                '[dbicsl_test1].dbicsl_user1.sybase_loader_test5',
 426                                '[dbicsl_test1].dbicsl_user1.sybase_loader_test4') {
 427                 try {
 428                     $dbh->do("DROP TABLE $table");
 429                 }
 430                 catch {
 431                     diag "Error dropping table $table: $_";
 432                 };
 433             }
 434
 435             foreach my $db (qw/dbicsl_test1 dbicsl_test2/) {
 436                 try {
 437                     $dbh->do("DROP DATABASE [$db]");
 438                 }
 439                 catch {
 440                     diag "Error dropping test database $db: $_";
 441                 };
 442             }
 443
 444             foreach my $login (qw/dbicsl_user1 dbicsl_user2/) {
 445                 try {
 446                     my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
 447                     local $SIG{__WARN__} = sub {
 448                         $warn_handler->(@_)
 449                             unless $_[0] =~ /^Account locked\.$|^Login dropped\.$/;
 450                     };
 451
 452                     $dbh->do("sp_droplogin $login");
 453                 }
 454                 catch {
 455                     diag "Error dropping login $login: $_"
 456                         unless /Incorrect syntax/;
 457                 };
 458             }
 459         }
 460     }
 461 }
 462 # vim:et sts=4 sw=4 tw=0: