t/dbixcsl_common_tests.pm

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