1 package dbixcsl_common_tests;
6 use DBIx::Class::Schema::Loader;
14 if( ref($_[0]) eq 'HASH') {
22 # Only MySQL uses this
23 $self->{innodb} ||= '';
25 $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
27 return bless $self => $class;
31 my ($self, $why) = @_;
33 plan skip_all => $why;
43 my $schema_class = 'DBIXCSL_Test_' . $self->{vendor} . '::Schema';
45 my $debug = ($self->{verbose} > 1) ? 1 : 0;
49 user => $self->{user},
50 password => $self->{password},
51 constraint => '^(?:\S+\.)?(?i:loader_test)[0-9]+$',
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};
60 package $schema_class;
61 use base qw/DBIx::Class::Schema::Loader/;
63 __PACKAGE__->load_from_connection(\%loader_opts);
65 ok(!$@, "Loader initialization failed: $@");
67 my $conn = $schema_class->connect($self->{dsn},$self->{user},$self->{password});
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);
74 isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
75 isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
77 my $obj = $rsobj1->find(1);
79 is( $obj->dat, "foo" );
80 is( $rsobj2->count, 4 );
82 my ($obj2) = $rsobj2->find( dat => 'bbb' );
86 skip $self->{skip_rels}, 20 if $self->{skip_rels};
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);
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" );
112 my $obj4 = $rsobj4->find(123);
113 isa_ok( $obj4->fkid, "$schema_class\::$moniker3");
115 # fk def in comments should not be parsed
116 my $obj5 = $rsobj5->find( id1 => 1, id2 => 1 );
117 is( ref( $obj5->id2 ), '' );
119 # mulit-col fk def (works for some, not others...)
120 my $obj6 = $rsobj6->find(1);
121 isa_ok( $obj6->loader_test2, "$schema_class\::$moniker2" );
123 skip "Multi-column FKs are only half-working for this vendor", 1
124 unless $self->{multi_fk_broken};
125 is( ref( $obj6->id2 ), '' );
128 # fk that references a non-pk key (UNIQUE)
129 my $obj8 = $rsobj8->find(1);
130 isa_ok( $obj8->loader_test7, "$schema_class\::$moniker7" );
132 # from Chisel's tests...
134 if($self->{vendor} =~ /sqlite/i) {
135 skip 'SQLite cannot do the advanced tests', 8;
138 my $moniker10 = $conn->moniker('loader_test10');
139 my $rsobj10 = $conn->resultset($moniker10);
140 my $moniker11 = $conn->moniker('loader_test11');
141 my $rsobj11 = $conn->resultset($moniker11);
143 isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
144 isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
146 my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
149 ok( defined $obj10, '$obj10 is defined' );
151 my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
153 ok( defined $obj11, '$obj11 is defined' );
156 my $obj10_2 = $obj11->loader_test10;
157 $obj10_2->loader_test11( $obj11->id11() );
160 is($@, '', 'No errors after eval{}');
163 skip 'Previous eval block failed', 3
166 my $results = $rsobj10->search({ subject => 'xyzzy' });
167 is( $results->count(), 1,
168 'One $rsobj10 returned from search' );
170 my $obj10_3 = $results->first();
171 isa_ok( $obj10_3, "$schema_class\::$moniker10" );
172 is( $obj10_3->loader_test11()->id(), $obj11->id(),
173 'found same $rsobj11 object we expected' );
180 my ($self, $complain) = @_;
182 my $dbh = DBI->connect(
183 $self->{dsn}, $self->{user},
186 RaiseError => $complain,
187 PrintError => $complain,
192 die "Failed to connect to database: $DBI::errstr" if !$dbh;
202 CREATE TABLE loader_test1 (
203 id $self->{auto_inc_pk},
208 q{ INSERT INTO loader_test1 (dat) VALUES('foo'); },
209 q{ INSERT INTO loader_test1 (dat) VALUES('bar'); },
210 q{ INSERT INTO loader_test1 (dat) VALUES('baz'); },
213 CREATE TABLE loader_test2 (
214 id $self->{auto_inc_pk},
219 q{ INSERT INTO loader_test2 (dat) VALUES('aaa'); },
220 q{ INSERT INTO loader_test2 (dat) VALUES('bbb'); },
221 q{ INSERT INTO loader_test2 (dat) VALUES('ccc'); },
222 q{ INSERT INTO loader_test2 (dat) VALUES('ddd'); },
225 my @statements_reltests = (
227 CREATE TABLE loader_test3 (
228 id INTEGER NOT NULL PRIMARY KEY,
233 q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa'); },
234 q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb'); },
235 q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc'); },
236 q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd'); },
239 CREATE TABLE loader_test4 (
240 id INTEGER NOT NULL PRIMARY KEY,
241 fkid INTEGER NOT NULL,
243 FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
247 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa'); },
248 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb'); },
249 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc'); },
250 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd'); },
253 CREATE TABLE loader_test5 (
254 id1 INTEGER NOT NULL,
255 id2 INTEGER NOT NULL, -- , id2 INTEGER REFERENCES loader_test1,
257 PRIMARY KEY (id1,id2)
261 q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa'); },
264 CREATE TABLE loader_test6 (
265 id $self->{auto_inc_pk},
267 loader_test2 INTEGER,
269 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
270 FOREIGN KEY (id, id2 ) REFERENCES loader_test5 (id1,id2)
274 (q{ INSERT INTO loader_test6 (id2,loader_test2,dat) } .
275 q{ VALUES (1,1,'aaa'); }),
278 CREATE TABLE loader_test7 (
279 id INTEGER NOT NULL PRIMARY KEY,
280 id2 VARCHAR(8) NOT NULL UNIQUE,
285 q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb'); },
288 CREATE TABLE loader_test8 (
289 id INTEGER NOT NULL PRIMARY KEY,
290 loader_test7 VARCHAR(8) NOT NULL,
292 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
296 (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
297 q{ VALUES (1,'aaa','bbb'); }),
300 CREATE TABLE loader_test9 (
301 loader_test9 VARCHAR(8) NOT NULL
306 my @statements_advanced = (
308 CREATE TABLE loader_test10 (
309 id10 $self->{auto_inc_pk},
311 loader_test11 INTEGER
316 CREATE TABLE loader_test11 (
317 id11 $self->{auto_inc_pk},
318 message VARCHAR(8) DEFAULT 'foo',
319 loader_test10 INTEGER,
320 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
324 (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
325 q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
326 q{ REFERENCES loader_test11 (id11); }),
331 $self->{created} = 1;
333 my $dbh = $self->dbconnect(1);
334 $dbh->do($_) for (@statements);
335 unless($self->{skip_rels}) {
336 # hack for now, since DB2 doesn't like inline comments, and we need
337 # to test one for mysql, which works on everyone else...
338 # this all needs to be refactored anyways.
339 if($self->{vendor} =~ /DB2/i) {
340 @statements_reltests = map { s/--.*\n//; $_ } @statements_reltests;
342 $dbh->do($_) for (@statements_reltests);
343 unless($self->{vendor} =~ /sqlite/i) {
344 $dbh->do($_) for (@statements_advanced);
353 return unless $self->{created};
360 my @tables_reltests = qw/
370 my @tables_advanced = qw/
376 q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
379 q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
381 my $dbh = $self->dbconnect(0);
383 unless($self->{skip_rels}) {
384 $dbh->do("DROP TABLE $_") for (@tables_reltests);
385 unless($self->{vendor} =~ /sqlite/i) {
386 if($self->{vendor} =~ /mysql/i) {
387 $dbh->do($drop_fk_mysql);
392 $dbh->do("DROP TABLE $_") for (@tables_advanced);
395 $dbh->do("DROP TABLE $_") for (@tables);
399 sub DESTROY { shift->drop_tables; }