t/dbixcsl_common_tests.pm

   1 package dbixcsl_common_tests;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use DBIx::Class::Schema::Loader;
   8 use DBI;
   9
  10 sub new {
  11     my $class = shift;
  12
  13     my $self;
  14
  15     if( ref($_[0]) eq 'HASH') {
  16        my $args = shift;
  17        $self = { (%$args) };
  18     }
  19     else {
  20        $self = { @_ };
  21     }
  22
  23     # Only MySQL uses this
  24     $self->{innodb} ||= '';
  25
  26     $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
  27
  28     return bless $self => $class;
  29 }
  30
  31 sub skip_tests {
  32     my ($self, $why) = @_;
  33
  34     plan skip_all => $why;
  35 }
  36
  37 sub run_tests {
  38     my $self = shift;
  39
  40     plan tests => 32;
  41
  42     $self->create();
  43
  44     my $schema_class = 'DBIXCSL_Test_' . $self->{vendor} . '::Schema';
  45
  46     my $debug = ($self->{verbose} > 1) ? 1 : 0;
  47
  48     my %loader_opts = (
  49         dsn           => $self->{dsn},
  50         user          => $self->{user},
  51         password      => $self->{password},
  52         constraint    => '^(?:\S+\.)?(?i:loader_test)[0-9]+$',
  53         relationships => 1,
  54         debug         => $debug,
  55     );
  56
  57     $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
  58     $loader_opts{drop_db_schema} = $self->{drop_db_schema} if $self->{drop_db_schema};
  59
  60     eval qq{
  61         package $schema_class;
  62         use base qw/DBIx::Class::Schema::Loader/;
  63
  64         __PACKAGE__->load_from_connection(\%loader_opts);
  65     };
  66     ok(!$@, "Loader initialization failed: $@");
  67
  68     my $conn = $schema_class->connect($self->{dsn},$self->{user},$self->{password});
  69     my $monikers = $schema_class->loader->monikers;
  70     my $classes = $schema_class->loader->classes;
  71
  72     my $moniker1 = $monikers->{loader_test1};
  73     my $class1   = $classes->{loader_test1};
  74     my $rsobj1   = $conn->resultset($moniker1);
  75
  76     my $moniker2 = $monikers->{loader_test2};
  77     my $class2   = $classes->{loader_test2};
  78     my $rsobj2   = $conn->resultset($moniker2);
  79
  80     isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
  81     isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
  82
  83     my $obj    = $rsobj1->find(1);
  84     is( $obj->id,  1 );
  85     is( $obj->dat, "foo" );
  86     is( $rsobj2->count, 4 );
  87
  88     my ($obj2) = $rsobj2->find( dat => 'bbb' );
  89     is( $obj2->id, 2 );
  90
  91     SKIP: {
  92         skip $self->{skip_rels}, 25 if $self->{skip_rels};
  93
  94         my $moniker3 = $monikers->{loader_test3};
  95         my $class3   = $classes->{loader_test3};
  96         my $rsobj3   = $conn->resultset($moniker3);
  97
  98         my $moniker4 = $monikers->{loader_test4};
  99         my $class4   = $classes->{loader_test4};
 100         my $rsobj4   = $conn->resultset($moniker4);
 101
 102         my $moniker5 = $monikers->{loader_test5};
 103         my $class5   = $classes->{loader_test5};
 104         my $rsobj5   = $conn->resultset($moniker5);
 105
 106         my $moniker6 = $monikers->{loader_test6};
 107         my $class6   = $classes->{loader_test6};
 108         my $rsobj6   = $conn->resultset($moniker6);
 109
 110         my $moniker7 = $monikers->{loader_test7};
 111         my $class7   = $classes->{loader_test7};
 112         my $rsobj7   = $conn->resultset($moniker7);
 113
 114         my $moniker8 = $monikers->{loader_test8};
 115         my $class8   = $classes->{loader_test8};
 116         my $rsobj8   = $conn->resultset($moniker8);
 117
 118         my $moniker9 = $monikers->{loader_test9};
 119         my $class9   = $classes->{loader_test9};
 120         my $rsobj9   = $conn->resultset($moniker9);
 121
 122         isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
 123         isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
 124         isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
 125         isa_ok( $rsobj6, "DBIx::Class::ResultSet" );
 126         isa_ok( $rsobj7, "DBIx::Class::ResultSet" );
 127         isa_ok( $rsobj8, "DBIx::Class::ResultSet" );
 128         isa_ok( $rsobj9, "DBIx::Class::ResultSet" );
 129
 130         # basic rel test
 131         my $obj4 = $rsobj4->find(123);
 132         isa_ok( $obj4->fkid, $class3);
 133
 134         # fk def in comments should not be parsed
 135         my $obj5 = $rsobj5->find( id1 => 1, id2 => 1 );
 136         is( ref( $obj5->id2 ), '' );
 137
 138         # mulit-col fk def
 139         my $obj6 = $rsobj6->find(1);
 140         isa_ok( $obj6->loader_test2, $class2);
 141         isa_ok( $obj6->loader_test5, $class5);
 142
 143         # fk that references a non-pk key (UNIQUE)
 144         my $obj8 = $rsobj8->find(1);
 145         isa_ok( $obj8->loader_test7, $class7);
 146
 147         # from Chisel's tests...
 148         SKIP: {
 149             if($self->{vendor} =~ /sqlite/i) {
 150                 skip 'SQLite cannot do the advanced tests', 8;
 151             }
 152
 153             my $moniker10 = $monikers->{loader_test10};
 154             my $class10   = $classes->{loader_test10};
 155             my $rsobj10   = $conn->resultset($moniker10);
 156
 157             my $moniker11 = $monikers->{loader_test11};
 158             my $class11   = $classes->{loader_test11};
 159             my $rsobj11   = $conn->resultset($moniker11);
 160
 161             isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
 162             isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
 163
 164             my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
 165
 166             $obj10->update();
 167             ok( defined $obj10, '$obj10 is defined' );
 168
 169             my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
 170             $obj11->update();
 171             ok( defined $obj11, '$obj11 is defined' );
 172
 173             eval {
 174                 my $obj10_2 = $obj11->loader_test10;
 175                 $obj10_2->loader_test11( $obj11->id11() );
 176                 $obj10_2->update();
 177             };
 178             is($@, '', 'No errors after eval{}');
 179
 180             SKIP: {
 181                 skip 'Previous eval block failed', 3
 182                     unless ($@ eq '');
 183
 184                 my $results = $rsobj10->search({ subject => 'xyzzy' });
 185                 is( $results->count(), 1,
 186                     'One $rsobj10 returned from search' );
 187
 188                 my $obj10_3 = $results->first();
 189                 isa_ok( $obj10_3, $class10 );
 190                 is( $obj10_3->loader_test11()->id(), $obj11->id(),
 191                     'found same $rsobj11 object we expected' );
 192             }
 193         }
 194
 195         SKIP: {
 196             skip 'This vendor cannot do inline relationship definitions', 5
 197                 if $self->{no_inline_rels};
 198
 199             my $moniker12 = $monikers->{loader_test12};
 200             my $class12   = $classes->{loader_test12};
 201             my $rsobj12   = $conn->resultset($moniker12);
 202
 203             my $moniker13 = $monikers->{loader_test13};
 204             my $class13   = $classes->{loader_test13};
 205             my $rsobj13   = $conn->resultset($moniker13);
 206
 207             isa_ok( $rsobj12, "DBIx::Class::ResultSet" );
 208             isa_ok( $rsobj13, "DBIx::Class::ResultSet" );
 209
 210             my $obj13 = $rsobj13->find(1);
 211             isa_ok( $obj13->id, $class12 );
 212             isa_ok( $obj13->loader_test12, $class12);
 213             isa_ok( $obj13->dat, $class12);
 214         }
 215     }
 216 }
 217
 218 sub dbconnect {
 219     my ($self, $complain) = @_;
 220
 221     my $dbh = DBI->connect(
 222          $self->{dsn}, $self->{user},
 223          $self->{password},
 224          {
 225              RaiseError => $complain,
 226              PrintError => $complain,
 227              AutoCommit => 1,
 228          }
 229     );
 230
 231     die "Failed to connect to database: $DBI::errstr" if !$dbh;
 232
 233     return $dbh;
 234 }
 235
 236 sub create {
 237     my $self = shift;
 238
 239     my @statements = (
 240         qq{
 241             CREATE TABLE loader_test1 (
 242                 id $self->{auto_inc_pk},
 243                 dat VARCHAR(32)
 244             ) $self->{innodb}
 245         },
 246
 247         q{ INSERT INTO loader_test1 (dat) VALUES('foo') },
 248         q{ INSERT INTO loader_test1 (dat) VALUES('bar') },
 249         q{ INSERT INTO loader_test1 (dat) VALUES('baz') },
 250
 251         qq{
 252             CREATE TABLE loader_test2 (
 253                 id $self->{auto_inc_pk},
 254                 dat VARCHAR(32)
 255             ) $self->{innodb}
 256         },
 257
 258         q{ INSERT INTO loader_test2 (dat) VALUES('aaa') },
 259         q{ INSERT INTO loader_test2 (dat) VALUES('bbb') },
 260         q{ INSERT INTO loader_test2 (dat) VALUES('ccc') },
 261         q{ INSERT INTO loader_test2 (dat) VALUES('ddd') },
 262     );
 263
 264     my @statements_reltests = (
 265         qq{
 266             CREATE TABLE loader_test3 (
 267                 id INTEGER NOT NULL PRIMARY KEY,
 268                 dat VARCHAR(32)
 269             ) $self->{innodb}
 270         },
 271
 272         q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') },
 273         q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') },
 274         q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') },
 275         q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') },
 276
 277         qq{
 278             CREATE TABLE loader_test4 (
 279                 id INTEGER NOT NULL PRIMARY KEY,
 280                 fkid INTEGER NOT NULL,
 281                 dat VARCHAR(32),
 282                 FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
 283             ) $self->{innodb}
 284         },
 285
 286         q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa') },
 287         q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb') },
 288         q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') },
 289         q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') },
 290
 291         qq{
 292             CREATE TABLE loader_test5 (
 293                 id1 INTEGER NOT NULL,
 294                 id2 INTEGER NOT NULL, -- , id2 INTEGER REFERENCES loader_test1,
 295                 dat VARCHAR(8),
 296                 PRIMARY KEY (id1,id2)
 297             ) $self->{innodb}
 298         },
 299
 300         q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa') },
 301
 302         qq{
 303             CREATE TABLE loader_test6 (
 304                 id INTEGER NOT NULL PRIMARY KEY,
 305                 id2 INTEGER,
 306                 loader_test2 INTEGER,
 307                 dat VARCHAR(8),
 308                 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
 309                 FOREIGN KEY (id, id2 ) REFERENCES loader_test5 (id1,id2)
 310             ) $self->{innodb}
 311         },
 312
 313         (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } .
 314          q{ VALUES (1, 1,1,'aaa') }),
 315
 316         qq{
 317             CREATE TABLE loader_test7 (
 318                 id INTEGER NOT NULL PRIMARY KEY,
 319                 id2 VARCHAR(8) NOT NULL UNIQUE,
 320                 dat VARCHAR(8)
 321             ) $self->{innodb}
 322         },
 323
 324         q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb') },
 325
 326         qq{
 327             CREATE TABLE loader_test8 (
 328                 id INTEGER NOT NULL PRIMARY KEY,
 329                 loader_test7 VARCHAR(8) NOT NULL,
 330                 dat VARCHAR(8),
 331                 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
 332             ) $self->{innodb}
 333         },
 334
 335         (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
 336          q{ VALUES (1,'aaa','bbb') }),
 337
 338         qq{
 339             CREATE TABLE loader_test9 (
 340                 loader_test9 VARCHAR(8) NOT NULL
 341             ) $self->{innodb}
 342         },
 343     );
 344
 345     my @statements_advanced = (
 346         qq{
 347             CREATE TABLE loader_test10 (
 348                 id10 $self->{auto_inc_pk},
 349                 subject VARCHAR(8),
 350                 loader_test11 INTEGER
 351             ) $self->{innodb}
 352         },
 353
 354         qq{
 355             CREATE TABLE loader_test11 (
 356                 id11 $self->{auto_inc_pk},
 357                 message VARCHAR(8) DEFAULT 'foo',
 358                 loader_test10 INTEGER,
 359                 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
 360             ) $self->{innodb}
 361         },
 362
 363         (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
 364          q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
 365          q{ REFERENCES loader_test11 (id11) }),
 366     );
 367
 368     my @statements_inline_rels = (
 369         qq{
 370             CREATE TABLE loader_test12 (
 371                 id INTEGER NOT NULL PRIMARY KEY,
 372                 id2 VARCHAR(8) NOT NULL UNIQUE,
 373                 dat VARCHAR(8) NOT NULL UNIQUE
 374             ) $self->{innodb}
 375         },
 376
 377         q{ INSERT INTO loader_test12 (id,id2,dat) VALUES (1,'aaa','bbb') },
 378
 379         qq{
 380             CREATE TABLE loader_test13 (
 381                 id INTEGER NOT NULL PRIMARY KEY REFERENCES loader_test12,
 382                 loader_test12 VARCHAR(8) NOT NULL REFERENCES loader_test12 (id2),
 383                 dat VARCHAR(8) REFERENCES loader_test12 (dat)
 384             ) $self->{innodb}
 385         },
 386
 387         (q{ INSERT INTO loader_test13 (id,loader_test12,dat) } .
 388          q{ VALUES (1,'aaa','bbb') }),
 389     );
 390
 391
 392     $self->drop_tables;
 393
 394     $self->{created} = 1;
 395
 396     my $dbh = $self->dbconnect(1);
 397     $dbh->do($_) for (@statements);
 398     unless($self->{skip_rels}) {
 399         # hack for now, since DB2 doesn't like inline comments, and we need
 400         # to test one for mysql, which works on everyone else...
 401         # this all needs to be refactored anyways.
 402         if($self->{vendor} =~ /DB2/i) {
 403             @statements_reltests = map { s/--.*\n//; $_ } @statements_reltests;
 404         }
 405         $dbh->do($_) for (@statements_reltests);
 406         unless($self->{vendor} =~ /sqlite/i) {
 407             $dbh->do($_) for (@statements_advanced);
 408         }
 409         unless($self->{no_inline_rels}) {
 410             $dbh->do($_) for (@statements_inline_rels);
 411         }
 412     }
 413     $dbh->disconnect();
 414 }
 415
 416 sub drop_tables {
 417     my $self = shift;
 418
 419     return unless $self->{created};
 420
 421     my @tables = qw/
 422         loader_test1
 423         loader_test2
 424     /;
 425
 426     my @tables_reltests = qw/
 427         loader_test4
 428         loader_test3
 429         loader_test6
 430         loader_test5
 431         loader_test8
 432         loader_test7
 433         loader_test9
 434     /;
 435
 436     my @tables_advanced = qw/
 437         loader_test11
 438         loader_test10
 439     /;
 440
 441     my @tables_inline_rels = qw/
 442         loader_test13
 443         loader_test12
 444     /;
 445
 446     my $drop_fk_mysql =
 447         q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
 448
 449     my $drop_fk =
 450         q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
 451
 452     my $dbh = $self->dbconnect(0);
 453
 454     unless($self->{skip_rels}) {
 455         $dbh->do("DROP TABLE $_") for (@tables_reltests);
 456         unless($self->{vendor} =~ /sqlite/i) {
 457             if($self->{vendor} =~ /mysql/i) {
 458                 $dbh->do($drop_fk_mysql);
 459             }
 460             else {
 461                 $dbh->do($drop_fk);
 462             }
 463             $dbh->do("DROP TABLE $_") for (@tables_advanced);
 464         }
 465         unless($self->{no_inline_rels}) {
 466             $dbh->do("DROP TABLE $_") for (@tables_inline_rels);
 467         }
 468     }
 469     $dbh->do("DROP TABLE $_") for (@tables);
 470     $dbh->disconnect;
 471 }
 472
 473 sub DESTROY { shift->drop_tables; }
 474
 475 1;