projects / dbsrgits/DBIx-Class-Schema-Loader.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
update requirements
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / lib / dbixcsl_common_tests.pm
CommitLineData
fbd83464 1package dbixcsl_common_tests;
a78e3fed 2
3use strict;
3980d69c 4use warnings;
a78e3fed 5
6use Test::More;
18fca96a 7use DBIx::Class::Schema::Loader;
a78e3fed 8use DBI;
9
10sub 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} ||= '';
af6c2665 25
26 $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
a78e3fed 27
28 return bless $self => $class;
29}
30
31sub skip_tests {
32 my ($self, $why) = @_;
33
34 plan skip_all => $why;
35}
36
4350370d 37sub _monikerize {
38 my $name = shift;
39 return 'LoaderTest2X' if $name =~ /^loader_test2$/i;
40 return undef;
41}
42
a78e3fed 43sub run_tests {
44 my $self = shift;
45
8ac8926d 46 plan tests => 76;
a78e3fed 47
48 $self->create();
49
c2849787 50 my $schema_class = 'DBIXCSL_Test::Schema';
a78e3fed 51
af6c2665 52 my $debug = ($self->{verbose} > 1) ? 1 : 0;
53
996be9ee 54 my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} );
af96f52e 55 my %loader_opts = (
996be9ee 56 constraint => qr/^(?:\S+\.)?loader_test[0-9]+$/i,
507034ad 57 relationships => 1,
58 additional_classes => 'TestAdditional',
59 additional_base_classes => 'TestAdditionalBase',
60 left_base_classes => [ qw/TestLeftBase/ ],
9fa99683 61 components => [ qw/TestComponent/ ],
996be9ee 62 inflect_plural => { loader_test4 => 'loader_test4zes' },
63 inflect_singular => { fkid => 'fkid_singular' },
4350370d 64 moniker_map => \&_monikerize,
507034ad 65 debug => $debug,
af96f52e 66 );
67
68 $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
996be9ee 69 eval { require Class::Inspector };
70 if($@) {
71 $self->{_no_rs_components} = 1;
72 }
73 else {
74 $loader_opts{resultset_components} = [ qw/TestRSComponent/ ];
75 }
af96f52e 76
996be9ee 77 {
78 my @loader_warnings;
79 local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
80 eval qq{
81 package $schema_class;
82 use base qw/DBIx::Class::Schema::Loader/;
83
84 __PACKAGE__->loader_options(\%loader_opts);
85 __PACKAGE__->connection(\@connect_info);
86 };
87 ok(!$@, "Loader initialization") or diag $@;
88 if($self->{skip_rels}) {
89 is(scalar(@loader_warnings), 0)
90 or diag "Did not get the expected 0 warnings. Warnings are: "
91 . join('',@loader_warnings);
92 ok(1);
93 }
94 else {
95 is(scalar(@loader_warnings), 1)
96 or diag "Did not get the expected 1 warning. Warnings are: "
97 . join('',@loader_warnings);
98 like($loader_warnings[0], qr/loader_test9 has no primary key/i);
99 }
100 }
a4a19f3c 101
996be9ee 102 my $conn = $schema_class->clone;
59cfa251 103 my $monikers = {};
104 my $classes = {};
105 foreach my $source_name ($schema_class->sources) {
106 my $table_name = $schema_class->source($source_name)->from;
107 $monikers->{$table_name} = $source_name;
108 $classes->{$table_name} = $schema_class . q{::} . $source_name;
109 }
a4a19f3c 110
3980d69c 111 my $moniker1 = $monikers->{loader_test1};
112 my $class1 = $classes->{loader_test1};
113 my $rsobj1 = $conn->resultset($moniker1);
114
115 my $moniker2 = $monikers->{loader_test2};
116 my $class2 = $classes->{loader_test2};
117 my $rsobj2 = $conn->resultset($moniker2);
a78e3fed 118
996be9ee 119 my $moniker23 = $monikers->{LOADER_TEST23};
120 my $class23 = $classes->{LOADER_TEST23};
121 my $rsobj23 = $conn->resultset($moniker1);
122
123 my $moniker24 = $monikers->{LoAdEr_test24};
124 my $class24 = $classes->{LoAdEr_test24};
125 my $rsobj24 = $conn->resultset($moniker2);
126
af6c2665 127 isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
128 isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
996be9ee 129 isa_ok( $rsobj23, "DBIx::Class::ResultSet" );
130 isa_ok( $rsobj24, "DBIx::Class::ResultSet" );
131
8ac8926d 132 my @columns_lt2 = $class2->columns;
133 is($columns_lt2[0], 'id', "Column Ordering 0");
134 is($columns_lt2[1], 'dat', "Column Ordering 1");
135 is($columns_lt2[2], 'dat2', "Column Ordering 2");
136
996be9ee 137 my %uniq1 = $class1->unique_constraints;
138 my $uniq1_test = 0;
139 foreach my $ucname (keys %uniq1) {
140 my $cols_arrayref = $uniq1{$ucname};
141 if(@$cols_arrayref == 1 && $cols_arrayref->[0] eq 'dat') {
142 $uniq1_test = 1;
143 last;
144 }
145 }
146 ok($uniq1_test) or diag "Unique constraints not working";
147
148 my %uniq2 = $class2->unique_constraints;
149 my $uniq2_test = 0;
150 foreach my $ucname (keys %uniq2) {
151 my $cols_arrayref = $uniq2{$ucname};
152 if(@$cols_arrayref == 2
5223f24a 153 && $cols_arrayref->[0] eq 'dat2'
154 && $cols_arrayref->[1] eq 'dat') {
996be9ee 155 $uniq2_test = 2;
156 last;
157 }
158 }
159 ok($uniq2_test) or diag "Multi-col unique constraints not working";
a78e3fed 160
4350370d 161 is($moniker2, 'LoaderTest2X', "moniker_map testing");
162
c2849787 163 {
164 my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth,
9fa99683 165 $skip_rsmeth, $skip_tcomp, $skip_trscomp);
c2849787 166
167 can_ok( $class1, 'test_additional_base' ) or $skip_tab = 1;
168 can_ok( $class1, 'test_additional_base_override' ) or $skip_tabo = 1;
169 can_ok( $class1, 'test_additional_base_additional' ) or $skip_taba = 1;
9fa99683 170 can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1;
c2849787 171 can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1;
8563178e 172
4350370d 173 TODO: {
174 local $TODO = "Not yet supported by ResultSetManger code";
8563178e 175 can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
4350370d 176 }
c2849787 177
178 SKIP: {
9fa99683 179 skip "Pre-requisite test failed", 1 if $skip_tab;
c2849787 180 is( $class1->test_additional_base, "test_additional_base",
181 "Additional Base method" );
9fa99683 182 }
c2849787 183
184 SKIP: {
9fa99683 185 skip "Pre-requisite test failed", 1 if $skip_tabo;
c2849787 186 is( $class1->test_additional_base_override,
9fa99683 187 "test_left_base_override",
c2849787 188 "Left Base overrides Additional Base method" );
189 }
190
191 SKIP: {
9fa99683 192 skip "Pre-requisite test failed", 1 if $skip_taba;
c2849787 193 is( $class1->test_additional_base_additional, "test_additional",
194 "Additional Base can use Additional package method" );
195 }
196
9fa99683 197 SKIP: {
198 skip "Pre-requisite test failed", 1 if $skip_tcomp;
c2849787 199 is( $class1->dbix_class_testcomponent,
9fa99683 200 'dbix_class_testcomponent works' );
201 }
c2849787 202
9fa99683 203 SKIP: {
996be9ee 204 skip "These two tests need Class::Inspector installed", 2
205 if $self->{_no_rs_components};
206 can_ok($rsobj1, 'dbix_class_testrscomponent') or $skip_trscomp = 1;
207 SKIP: {
208 skip "Pre-requisite test failed", 1 if $skip_trscomp;
209 is( $rsobj1->dbix_class_testrscomponent,
210 'dbix_class_testrscomponent works' );
211 }
9fa99683 212 }
c2849787 213
9fa99683 214 SKIP: {
215 skip "Pre-requisite test failed", 1 if $skip_cmeth;
c2849787 216 is( $class1->loader_test1_classmeth, 'all is well' );
9fa99683 217 }
c2849787 218
8563178e 219 # XXX put this back in when the TODO above works...
220 #SKIP: {
221 # skip "Pre-requisite test failed", 1 if $skip_rsmeth;
222 # is( $rsobj1->loader_test1_rsmeth, 'all is still well' );
223 #}
c2849787 224 }
507034ad 225
507034ad 226
af6c2665 227 my $obj = $rsobj1->find(1);
a78e3fed 228 is( $obj->id, 1 );
229 is( $obj->dat, "foo" );
af6c2665 230 is( $rsobj2->count, 4 );
b71790b1 231 my $saved_id;
232 eval {
233 my $new_obj1 = $rsobj1->create({ dat => 'newthing' });
996be9ee 234 $saved_id = $new_obj1->id;
b71790b1 235 };
236 ok(!$@) or diag "Died during create new record using a PK::Auto key: $@";
237 ok($saved_id) or diag "Failed to get PK::Auto-generated id";
238
239 my $new_obj1 = $rsobj1->search({ dat => 'newthing' })->first;
240 ok($new_obj1) or diag "Cannot find newly inserted PK::Auto record";
241 is($new_obj1->id, $saved_id);
a78e3fed 242
a13b2803 243 my ($obj2) = $rsobj2->search({ dat => 'bbb' })->first;
a78e3fed 244 is( $obj2->id, 2 );
245
246 SKIP: {
996be9ee 247 skip $self->{skip_rels}, 42 if $self->{skip_rels};
a78e3fed 248
3980d69c 249 my $moniker3 = $monikers->{loader_test3};
250 my $class3 = $classes->{loader_test3};
251 my $rsobj3 = $conn->resultset($moniker3);
252
253 my $moniker4 = $monikers->{loader_test4};
254 my $class4 = $classes->{loader_test4};
255 my $rsobj4 = $conn->resultset($moniker4);
256
257 my $moniker5 = $monikers->{loader_test5};
258 my $class5 = $classes->{loader_test5};
259 my $rsobj5 = $conn->resultset($moniker5);
260
261 my $moniker6 = $monikers->{loader_test6};
262 my $class6 = $classes->{loader_test6};
263 my $rsobj6 = $conn->resultset($moniker6);
264
265 my $moniker7 = $monikers->{loader_test7};
266 my $class7 = $classes->{loader_test7};
267 my $rsobj7 = $conn->resultset($moniker7);
268
269 my $moniker8 = $monikers->{loader_test8};
270 my $class8 = $classes->{loader_test8};
271 my $rsobj8 = $conn->resultset($moniker8);
272
273 my $moniker9 = $monikers->{loader_test9};
274 my $class9 = $classes->{loader_test9};
275 my $rsobj9 = $conn->resultset($moniker9);
af6c2665 276
996be9ee 277 my $moniker16 = $monikers->{loader_test16};
278 my $class16 = $classes->{loader_test16};
279 my $rsobj16 = $conn->resultset($moniker16);
280
281 my $moniker17 = $monikers->{loader_test17};
282 my $class17 = $classes->{loader_test17};
283 my $rsobj17 = $conn->resultset($moniker17);
284
285 my $moniker18 = $monikers->{loader_test18};
286 my $class18 = $classes->{loader_test18};
287 my $rsobj18 = $conn->resultset($moniker18);
288
289 my $moniker19 = $monikers->{loader_test19};
290 my $class19 = $classes->{loader_test19};
291 my $rsobj19 = $conn->resultset($moniker19);
292
293 my $moniker20 = $monikers->{loader_test20};
294 my $class20 = $classes->{loader_test20};
295 my $rsobj20 = $conn->resultset($moniker20);
296
297 my $moniker21 = $monikers->{loader_test21};
298 my $class21 = $classes->{loader_test21};
299 my $rsobj21 = $conn->resultset($moniker21);
300
301 my $moniker22 = $monikers->{loader_test22};
302 my $class22 = $classes->{loader_test22};
303 my $rsobj22 = $conn->resultset($moniker22);
304
af6c2665 305 isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
306 isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
307 isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
308 isa_ok( $rsobj6, "DBIx::Class::ResultSet" );
309 isa_ok( $rsobj7, "DBIx::Class::ResultSet" );
310 isa_ok( $rsobj8, "DBIx::Class::ResultSet" );
311 isa_ok( $rsobj9, "DBIx::Class::ResultSet" );
996be9ee 312 isa_ok( $rsobj16, "DBIx::Class::ResultSet" );
313 isa_ok( $rsobj17, "DBIx::Class::ResultSet" );
314 isa_ok( $rsobj18, "DBIx::Class::ResultSet" );
315 isa_ok( $rsobj19, "DBIx::Class::ResultSet" );
316 isa_ok( $rsobj20, "DBIx::Class::ResultSet" );
317 isa_ok( $rsobj21, "DBIx::Class::ResultSet" );
318 isa_ok( $rsobj22, "DBIx::Class::ResultSet" );
a78e3fed 319
320 # basic rel test
af6c2665 321 my $obj4 = $rsobj4->find(123);
996be9ee 322 isa_ok( $obj4->fkid_singular, $class3);
a78e3fed 323
9fa99683 324 my $obj3 = $rsobj3->find(1);
4350370d 325 my $rs_rel4 = $obj3->search_related('loader_test4zes');
9fa99683 326 isa_ok( $rs_rel4->first, $class4);
c5de0b0c 327
996be9ee 328 # find on multi-col pk
d65cda9e 329 my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
996be9ee 330 is( $obj5->id2, 1 );
a78e3fed 331
4ce22656 332 # mulit-col fk def
af6c2665 333 my $obj6 = $rsobj6->find(1);
3980d69c 334 isa_ok( $obj6->loader_test2, $class2);
335 isa_ok( $obj6->loader_test5, $class5);
a78e3fed 336
337 # fk that references a non-pk key (UNIQUE)
af6c2665 338 my $obj8 = $rsobj8->find(1);
3980d69c 339 isa_ok( $obj8->loader_test7, $class7);
a78e3fed 340
996be9ee 341 # test double-fk 17 ->-> 16
342 my $obj17 = $rsobj17->find(33);
343
344 my $rs_rel16_one = $obj17->loader16_one;
345 isa_ok($rs_rel16_one, $class16);
346 is($rs_rel16_one->dat, 'y16');
347
348 my $rs_rel16_two = $obj17->loader16_two;
349 isa_ok($rs_rel16_two, $class16);
350 is($rs_rel16_two->dat, 'z16');
351
352 my $obj16 = $rsobj16->find(2);
353 my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones');
354 isa_ok($rs_rel17->first, $class17);
355 is($rs_rel17->first->id, 3);
356
357 # XXX test m:m 18 <- 20 -> 19
358
359 # XXX test double-fk m:m 21 <- 22 -> 21
360
a78e3fed 361 # from Chisel's tests...
362 SKIP: {
363 if($self->{vendor} =~ /sqlite/i) {
364 skip 'SQLite cannot do the advanced tests', 8;
365 }
366
3980d69c 367 my $moniker10 = $monikers->{loader_test10};
368 my $class10 = $classes->{loader_test10};
369 my $rsobj10 = $conn->resultset($moniker10);
370
371 my $moniker11 = $monikers->{loader_test11};
372 my $class11 = $classes->{loader_test11};
373 my $rsobj11 = $conn->resultset($moniker11);
a78e3fed 374
af6c2665 375 isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
376 isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
a78e3fed 377
af6c2665 378 my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
a78e3fed 379
380 $obj10->update();
381 ok( defined $obj10, '$obj10 is defined' );
382
af6c2665 383 my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
a78e3fed 384 $obj11->update();
385 ok( defined $obj11, '$obj11 is defined' );
386
387 eval {
388 my $obj10_2 = $obj11->loader_test10;
389 $obj10_2->loader_test11( $obj11->id11() );
390 $obj10_2->update();
391 };
392 is($@, '', 'No errors after eval{}');
393
394 SKIP: {
395 skip 'Previous eval block failed', 3
396 unless ($@ eq '');
397
af6c2665 398 my $results = $rsobj10->search({ subject => 'xyzzy' });
a78e3fed 399 is( $results->count(), 1,
af6c2665 400 'One $rsobj10 returned from search' );
a78e3fed 401
402 my $obj10_3 = $results->first();
3980d69c 403 isa_ok( $obj10_3, $class10 );
a78e3fed 404 is( $obj10_3->loader_test11()->id(), $obj11->id(),
af6c2665 405 'found same $rsobj11 object we expected' );
a78e3fed 406 }
407 }
4ce22656 408
409 SKIP: {
410 skip 'This vendor cannot do inline relationship definitions', 5
411 if $self->{no_inline_rels};
412
3980d69c 413 my $moniker12 = $monikers->{loader_test12};
414 my $class12 = $classes->{loader_test12};
415 my $rsobj12 = $conn->resultset($moniker12);
416
417 my $moniker13 = $monikers->{loader_test13};
418 my $class13 = $classes->{loader_test13};
419 my $rsobj13 = $conn->resultset($moniker13);
4ce22656 420
421 isa_ok( $rsobj12, "DBIx::Class::ResultSet" );
422 isa_ok( $rsobj13, "DBIx::Class::ResultSet" );
423
424 my $obj13 = $rsobj13->find(1);
3980d69c 425 isa_ok( $obj13->id, $class12 );
426 isa_ok( $obj13->loader_test12, $class12);
427 isa_ok( $obj13->dat, $class12);
4ce22656 428 }
52bf3f26 429
430 SKIP: {
431 skip 'This vendor cannot do out-of-line implicit rel defs', 3
432 if $self->{no_implicit_rels};
433 my $moniker14 = $monikers->{loader_test14};
434 my $class14 = $classes->{loader_test14};
435 my $rsobj14 = $conn->resultset($moniker14);
436
437 my $moniker15 = $monikers->{loader_test15};
438 my $class15 = $classes->{loader_test15};
439 my $rsobj15 = $conn->resultset($moniker15);
440
441 isa_ok( $rsobj14, "DBIx::Class::ResultSet" );
442 isa_ok( $rsobj15, "DBIx::Class::ResultSet" );
443
444 my $obj15 = $rsobj15->find(1);
445 isa_ok( $obj15->loader_test14, $class14 );
446 }
a78e3fed 447 }
448}
449
450sub dbconnect {
451 my ($self, $complain) = @_;
452
af96f52e 453 my $dbh = DBI->connect(
a78e3fed 454 $self->{dsn}, $self->{user},
455 $self->{password},
456 {
457 RaiseError => $complain,
458 PrintError => $complain,
459 AutoCommit => 1,
460 }
461 );
af96f52e 462
463 die "Failed to connect to database: $DBI::errstr" if !$dbh;
464
465 return $dbh;
a78e3fed 466}
467
468sub create {
469 my $self = shift;
470
996be9ee 471 $self->{_created} = 1;
472
a78e3fed 473 my @statements = (
474 qq{
475 CREATE TABLE loader_test1 (
476 id $self->{auto_inc_pk},
996be9ee 477 dat VARCHAR(32) NOT NULL UNIQUE
66742793 478 ) $self->{innodb}
a78e3fed 479 },
480
66742793 481 q{ INSERT INTO loader_test1 (dat) VALUES('foo') },
482 q{ INSERT INTO loader_test1 (dat) VALUES('bar') },
483 q{ INSERT INTO loader_test1 (dat) VALUES('baz') },
a78e3fed 484
485 qq{
486 CREATE TABLE loader_test2 (
487 id $self->{auto_inc_pk},
996be9ee 488 dat VARCHAR(32) NOT NULL,
489 dat2 VARCHAR(32) NOT NULL,
5223f24a 490 UNIQUE (dat2, dat)
996be9ee 491 ) $self->{innodb}
492 },
493
494 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') },
495 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') },
496 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ccc', 'xxx') },
497 q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ddd', 'www') },
498
499 qq{
500 CREATE TABLE LOADER_TEST23 (
501 ID INTEGER NOT NULL PRIMARY KEY,
502 DAT VARCHAR(32) NOT NULL UNIQUE
66742793 503 ) $self->{innodb}
a78e3fed 504 },
505
996be9ee 506 qq{
507 CREATE TABLE LoAdEr_test24 (
508 iD INTEGER NOT NULL PRIMARY KEY,
509 DaT VARCHAR(32) NOT NULL UNIQUE
510 ) $self->{innodb}
511 },
a78e3fed 512 );
513
514 my @statements_reltests = (
515 qq{
516 CREATE TABLE loader_test3 (
517 id INTEGER NOT NULL PRIMARY KEY,
518 dat VARCHAR(32)
66742793 519 ) $self->{innodb}
a78e3fed 520 },
521
66742793 522 q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') },
523 q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') },
524 q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') },
525 q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') },
a78e3fed 526
527 qq{
528 CREATE TABLE loader_test4 (
529 id INTEGER NOT NULL PRIMARY KEY,
530 fkid INTEGER NOT NULL,
531 dat VARCHAR(32),
6eecda8a 532 FOREIGN KEY( fkid ) REFERENCES loader_test3 (id)
66742793 533 ) $self->{innodb}
a78e3fed 534 },
535
66742793 536 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa') },
537 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb') },
538 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') },
539 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') },
a78e3fed 540
541 qq{
542 CREATE TABLE loader_test5 (
9b046d97 543 id1 INTEGER NOT NULL,
996be9ee 544 iD2 INTEGER NOT NULL,
9b046d97 545 dat VARCHAR(8),
a78e3fed 546 PRIMARY KEY (id1,id2)
66742793 547 ) $self->{innodb}
a78e3fed 548 },
549
66742793 550 q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa') },
a78e3fed 551
552 qq{
553 CREATE TABLE loader_test6 (
708c0939 554 id INTEGER NOT NULL PRIMARY KEY,
996be9ee 555 Id2 INTEGER,
a78e3fed 556 loader_test2 INTEGER,
9b046d97 557 dat VARCHAR(8),
f8c39323 558 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
559 FOREIGN KEY(id,Id2) REFERENCES loader_test5 (id1,iD2)
66742793 560 ) $self->{innodb}
a78e3fed 561 },
562
708c0939 563 (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } .
66742793 564 q{ VALUES (1, 1,1,'aaa') }),
a78e3fed 565
566 qq{
567 CREATE TABLE loader_test7 (
568 id INTEGER NOT NULL PRIMARY KEY,
569 id2 VARCHAR(8) NOT NULL UNIQUE,
9b046d97 570 dat VARCHAR(8)
66742793 571 ) $self->{innodb}
a78e3fed 572 },
573
66742793 574 q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb') },
a78e3fed 575
576 qq{
577 CREATE TABLE loader_test8 (
578 id INTEGER NOT NULL PRIMARY KEY,
579 loader_test7 VARCHAR(8) NOT NULL,
9b046d97 580 dat VARCHAR(8),
a78e3fed 581 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
66742793 582 ) $self->{innodb}
a78e3fed 583 },
584
585 (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
66742793 586 q{ VALUES (1,'aaa','bbb') }),
a78e3fed 587
588 qq{
589 CREATE TABLE loader_test9 (
9b046d97 590 loader_test9 VARCHAR(8) NOT NULL
66742793 591 ) $self->{innodb}
a78e3fed 592 },
996be9ee 593
594 qq{
595 CREATE TABLE loader_test16 (
596 id INTEGER NOT NULL PRIMARY KEY,
597 dat VARCHAR(8)
598 ) $self->{innodb}
599 },
600
601 qq{ INSERT INTO loader_test16 (id,dat) VALUES (2,'x16') },
602 qq{ INSERT INTO loader_test16 (id,dat) VALUES (4,'y16') },
603 qq{ INSERT INTO loader_test16 (id,dat) VALUES (6,'z16') },
604
605 qq{
606 CREATE TABLE loader_test17 (
607 id INTEGER NOT NULL PRIMARY KEY,
608 loader16_one INTEGER,
609 loader16_two INTEGER,
610 FOREIGN KEY (loader16_one) REFERENCES loader_test16 (id),
611 FOREIGN KEY (loader16_two) REFERENCES loader_test16 (id)
612 ) $self->{innodb}
613 },
614
615 qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (3, 2, 4) },
616 qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (33, 4, 6) },
617
618 qq{
619 CREATE TABLE loader_test18 (
620 id INTEGER NOT NULL PRIMARY KEY,
621 dat VARCHAR(8)
622 ) $self->{innodb}
623 },
624
625 qq{ INSERT INTO loader_test18 (id,dat) VALUES (1,'x18') },
626 qq{ INSERT INTO loader_test18 (id,dat) VALUES (2,'y18') },
627 qq{ INSERT INTO loader_test18 (id,dat) VALUES (3,'z18') },
628
629 qq{
630 CREATE TABLE loader_test19 (
631 id INTEGER NOT NULL PRIMARY KEY,
632 dat VARCHAR(8)
633 ) $self->{innodb}
634 },
635
636 qq{ INSERT INTO loader_test19 (id,dat) VALUES (4,'x19') },
637 qq{ INSERT INTO loader_test19 (id,dat) VALUES (5,'y19') },
638 qq{ INSERT INTO loader_test19 (id,dat) VALUES (6,'z19') },
639
640 qq{
641 CREATE TABLE loader_test20 (
642 parent INTEGER NOT NULL,
643 child INTEGER NOT NULL,
644 PRIMARY KEY (parent, child),
645 FOREIGN KEY (parent) REFERENCES loader_test18 (id),
646 FOREIGN KEY (child) REFERENCES loader_test19 (id)
647 ) $self->{innodb}
648 },
649
650 q{ INSERT INTO loader_test20 (parent, child) VALUES (1,4) },
651 q{ INSERT INTO loader_test20 (parent, child) VALUES (2,5) },
652 q{ INSERT INTO loader_test20 (parent, child) VALUES (3,6) },
653
654 qq{
655 CREATE TABLE loader_test21 (
656 id INTEGER NOT NULL PRIMARY KEY,
657 dat VARCHAR(8)
658 ) $self->{innodb}
659 },
660
661 q{ INSERT INTO loader_test21 (id,dat) VALUES (7,'a21')},
662 q{ INSERT INTO loader_test21 (id,dat) VALUES (11,'b21')},
663 q{ INSERT INTO loader_test21 (id,dat) VALUES (13,'c21')},
664 q{ INSERT INTO loader_test21 (id,dat) VALUES (17,'d21')},
665
666 qq{
667 CREATE TABLE loader_test22 (
668 parent INTEGER NOT NULL,
669 child INTEGER NOT NULL,
670 PRIMARY KEY (parent, child),
671 FOREIGN KEY (parent) REFERENCES loader_test21 (id),
672 FOREIGN KEY (child) REFERENCES loader_test21 (id)
673 ) $self->{innodb}
674 },
675
676 q{ INSERT INTO loader_test22 (parent, child) VALUES (7,11)},
677 q{ INSERT INTO loader_test22 (parent, child) VALUES (11,13)},
678 q{ INSERT INTO loader_test22 (parent, child) VALUES (13,17)},
a78e3fed 679 );
680
681 my @statements_advanced = (
682 qq{
683 CREATE TABLE loader_test10 (
684 id10 $self->{auto_inc_pk},
685 subject VARCHAR(8),
686 loader_test11 INTEGER
66742793 687 ) $self->{innodb}
a78e3fed 688 },
689
690 qq{
691 CREATE TABLE loader_test11 (
692 id11 $self->{auto_inc_pk},
693 message VARCHAR(8) DEFAULT 'foo',
af96f52e 694 loader_test10 INTEGER,
a78e3fed 695 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
66742793 696 ) $self->{innodb}
a78e3fed 697 },
698
699 (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
700 q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
66742793 701 q{ REFERENCES loader_test11 (id11) }),
a78e3fed 702 );
703
4ce22656 704 my @statements_inline_rels = (
705 qq{
706 CREATE TABLE loader_test12 (
707 id INTEGER NOT NULL PRIMARY KEY,
708 id2 VARCHAR(8) NOT NULL UNIQUE,
cfb6add1 709 dat VARCHAR(8) NOT NULL UNIQUE
4ce22656 710 ) $self->{innodb}
711 },
712
713 q{ INSERT INTO loader_test12 (id,id2,dat) VALUES (1,'aaa','bbb') },
714
715 qq{
716 CREATE TABLE loader_test13 (
717 id INTEGER NOT NULL PRIMARY KEY REFERENCES loader_test12,
718 loader_test12 VARCHAR(8) NOT NULL REFERENCES loader_test12 (id2),
719 dat VARCHAR(8) REFERENCES loader_test12 (dat)
720 ) $self->{innodb}
721 },
722
723 (q{ INSERT INTO loader_test13 (id,loader_test12,dat) } .
724 q{ VALUES (1,'aaa','bbb') }),
725 );
726
727
52bf3f26 728 my @statements_implicit_rels = (
729 qq{
730 CREATE TABLE loader_test14 (
731 id INTEGER NOT NULL PRIMARY KEY,
732 dat VARCHAR(8)
733 ) $self->{innodb}
734 },
735
736 q{ INSERT INTO loader_test14 (id,dat) VALUES (123,'aaa') },
737
738 qq{
739 CREATE TABLE loader_test15 (
740 id INTEGER NOT NULL PRIMARY KEY,
741 loader_test14 INTEGER NOT NULL,
742 FOREIGN KEY (loader_test14) REFERENCES loader_test14
743 ) $self->{innodb}
744 },
745
746 q{ INSERT INTO loader_test15 (id,loader_test14) VALUES (1,123) },
747 );
748
af96f52e 749 $self->drop_tables;
750
a78e3fed 751 my $dbh = $self->dbconnect(1);
ddf91322 752
753 # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
754 local $SIG{__WARN__} = sub {
755 my $msg = shift;
756 print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
757 };
758
a78e3fed 759 $dbh->do($_) for (@statements);
760 unless($self->{skip_rels}) {
af96f52e 761 # hack for now, since DB2 doesn't like inline comments, and we need
762 # to test one for mysql, which works on everyone else...
763 # this all needs to be refactored anyways.
a78e3fed 764 $dbh->do($_) for (@statements_reltests);
765 unless($self->{vendor} =~ /sqlite/i) {
766 $dbh->do($_) for (@statements_advanced);
767 }
4ce22656 768 unless($self->{no_inline_rels}) {
769 $dbh->do($_) for (@statements_inline_rels);
770 }
52bf3f26 771 unless($self->{no_implicit_rels}) {
772 $dbh->do($_) for (@statements_implicit_rels);
773 }
a78e3fed 774 }
775 $dbh->disconnect();
776}
777
af96f52e 778sub drop_tables {
a78e3fed 779 my $self = shift;
780
a78e3fed 781 my @tables = qw/
782 loader_test1
783 loader_test2
996be9ee 784 LOADER_TEST23
785 LoAdEr_test24
a78e3fed 786 /;
787
788 my @tables_reltests = qw/
789 loader_test4
790 loader_test3
791 loader_test6
792 loader_test5
793 loader_test8
794 loader_test7
795 loader_test9
996be9ee 796 loader_test17
797 loader_test16
798 loader_test20
799 loader_test19
800 loader_test18
801 loader_test22
802 loader_test21
a78e3fed 803 /;
804
805 my @tables_advanced = qw/
806 loader_test11
807 loader_test10
808 /;
809
4ce22656 810 my @tables_inline_rels = qw/
811 loader_test13
812 loader_test12
813 /;
814
52bf3f26 815 my @tables_implicit_rels = qw/
816 loader_test15
817 loader_test14
818 /;
819
a78e3fed 820 my $drop_fk_mysql =
821 q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
822
823 my $drop_fk =
824 q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
825
826 my $dbh = $self->dbconnect(0);
827
828 unless($self->{skip_rels}) {
829 $dbh->do("DROP TABLE $_") for (@tables_reltests);
830 unless($self->{vendor} =~ /sqlite/i) {
831 if($self->{vendor} =~ /mysql/i) {
832 $dbh->do($drop_fk_mysql);
833 }
834 else {
835 $dbh->do($drop_fk);
836 }
837 $dbh->do("DROP TABLE $_") for (@tables_advanced);
838 }
4ce22656 839 unless($self->{no_inline_rels}) {
840 $dbh->do("DROP TABLE $_") for (@tables_inline_rels);
841 }
52bf3f26 842 unless($self->{no_implicit_rels}) {
843 $dbh->do("DROP TABLE $_") for (@tables_implicit_rels);
844 }
a78e3fed 845 }
846 $dbh->do("DROP TABLE $_") for (@tables);
af96f52e 847 $dbh->disconnect;
a78e3fed 848}
849
996be9ee 850sub DESTROY {
851 my $self = shift;
852 $self->drop_tables if $self->{_created};
853}
af96f52e 854
a78e3fed 8551;
Generate DBIx::Class Schemas from a Database