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 $namespace = 'DBIXCSL_Test_' . $self->{vendor};
45 my $debug = ($self->{verbose} > 1) ? 1 : 0;
47 my $schema_pkg = "$namespace\::Schema";
51 use base qw/DBIx::Class::Schema::Loader/;
53 __PACKAGE__->load_from_connection(
54 dsn => "$self->{dsn}",
55 user => "$self->{user}",
56 password => "$self->{password}",
57 namespace => "$namespace",
58 constraint => '^loader_test.*',
63 ok(!$@, "Loader initialization failed: $@");
65 my $conn = $schema_pkg->connect($self->{dsn},$self->{user},$self->{passwd});
67 my $moniker1 = $conn->moniker('loader_test1');
68 my $rsobj1 = $conn->resultset($moniker1);
69 my $moniker2 = $conn->moniker('loader_test2');
70 my $rsobj2 = $conn->resultset($moniker2);
72 isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
73 isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
75 my $obj = $rsobj1->find(1);
77 is( $obj->dat, "foo" );
78 is( $rsobj2->count, 4 );
80 my ($obj2) = $rsobj2->find( dat => 'bbb' );
84 skip $self->{skip_rels}, 20 if $self->{skip_rels};
86 my $moniker3 = $conn->moniker('loader_test3');
87 my $rsobj3 = $conn->resultset($moniker3);
88 my $moniker4 = $conn->moniker('loader_test4');
89 my $rsobj4 = $conn->resultset($moniker4);
90 my $moniker5 = $conn->moniker('loader_test5');
91 my $rsobj5 = $conn->resultset($moniker5);
92 my $moniker6 = $conn->moniker('loader_test6');
93 my $rsobj6 = $conn->resultset($moniker6);
94 my $moniker7 = $conn->moniker('loader_test7');
95 my $rsobj7 = $conn->resultset($moniker7);
96 my $moniker8 = $conn->moniker('loader_test8');
97 my $rsobj8 = $conn->resultset($moniker8);
98 my $moniker9 = $conn->moniker('loader_test9');
99 my $rsobj9 = $conn->resultset($moniker9);
101 isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
102 isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
103 isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
104 isa_ok( $rsobj6, "DBIx::Class::ResultSet" );
105 isa_ok( $rsobj7, "DBIx::Class::ResultSet" );
106 isa_ok( $rsobj8, "DBIx::Class::ResultSet" );
107 isa_ok( $rsobj9, "DBIx::Class::ResultSet" );
110 my $obj4 = $rsobj4->find(123);
111 isa_ok( $obj4->fkid, "$namespace\::$moniker3");
113 # fk def in comments should not be parsed
114 my $obj5 = $rsobj5->find( id1 => 1, id2 => 1 );
115 is( ref( $obj5->id2 ), '' );
117 # mulit-col fk def (works for some, not others...)
118 my $obj6 = $rsobj6->find(1);
119 isa_ok( $obj6->loader_test2, "$namespace\::$moniker2" );
121 skip "Multi-column FKs are only half-working for this vendor", 1
122 unless $self->{multi_fk_broken};
123 is( ref( $obj6->id2 ), '' );
126 # fk that references a non-pk key (UNIQUE)
127 my $obj8 = $rsobj8->find(1);
128 isa_ok( $obj8->loader_test7, "$namespace\::$moniker7" );
130 # from Chisel's tests...
132 if($self->{vendor} =~ /sqlite/i) {
133 skip 'SQLite cannot do the advanced tests', 8;
136 my $moniker10 = $conn->moniker('loader_test10');
137 my $rsobj10 = $conn->resultset($moniker10);
138 my $moniker11 = $conn->moniker('loader_test11');
139 my $rsobj11 = $conn->resultset($moniker11);
141 isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
142 isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
144 my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
147 ok( defined $obj10, '$obj10 is defined' );
149 my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
151 ok( defined $obj11, '$obj11 is defined' );
154 my $obj10_2 = $obj11->loader_test10;
155 $obj10_2->loader_test11( $obj11->id11() );
158 is($@, '', 'No errors after eval{}');
161 skip 'Previous eval block failed', 3
164 my $results = $rsobj10->search({ subject => 'xyzzy' });
165 is( $results->count(), 1,
166 'One $rsobj10 returned from search' );
168 my $obj10_3 = $results->first();
169 isa_ok( $obj10_3, "$namespace\::$moniker10" );
170 is( $obj10_3->loader_test11()->id(), $obj11->id(),
171 'found same $rsobj11 object we expected' );
178 my ($self, $complain) = @_;
181 $self->{dsn}, $self->{user},
184 RaiseError => $complain,
185 PrintError => $complain,
196 CREATE TABLE loader_test1 (
197 id $self->{auto_inc_pk},
202 q{ INSERT INTO loader_test1 (dat) VALUES('foo'); },
203 q{ INSERT INTO loader_test1 (dat) VALUES('bar'); },
204 q{ INSERT INTO loader_test1 (dat) VALUES('baz'); },
207 CREATE TABLE loader_test2 (
208 id $self->{auto_inc_pk},
213 q{ INSERT INTO loader_test2 (dat) VALUES('aaa'); },
214 q{ INSERT INTO loader_test2 (dat) VALUES('bbb'); },
215 q{ INSERT INTO loader_test2 (dat) VALUES('ccc'); },
216 q{ INSERT INTO loader_test2 (dat) VALUES('ddd'); },
219 my @statements_reltests = (
221 CREATE TABLE loader_test3 (
222 id INTEGER NOT NULL PRIMARY KEY,
227 q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa'); },
228 q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb'); },
229 q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc'); },
230 q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd'); },
233 CREATE TABLE loader_test4 (
234 id INTEGER NOT NULL PRIMARY KEY,
235 fkid INTEGER NOT NULL,
237 FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
241 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa'); },
242 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb'); },
243 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc'); },
244 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd'); },
247 CREATE TABLE loader_test5 (
248 id1 INTEGER NOT NULL,
249 id2 INTEGER NOT NULL, -- , id2 INTEGER REFERENCES loader_test1,
251 PRIMARY KEY (id1,id2)
255 q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa'); },
258 CREATE TABLE loader_test6 (
259 id $self->{auto_inc_pk},
261 loader_test2 INTEGER,
263 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
264 FOREIGN KEY (id, id2 ) REFERENCES loader_test5 (id1,id2)
268 (q{ INSERT INTO loader_test6 (id2,loader_test2,dat) } .
269 q{ VALUES (1,1,'aaa'); }),
272 CREATE TABLE loader_test7 (
273 id INTEGER NOT NULL PRIMARY KEY,
274 id2 VARCHAR(8) NOT NULL UNIQUE,
279 q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb'); },
282 CREATE TABLE loader_test8 (
283 id INTEGER NOT NULL PRIMARY KEY,
284 loader_test7 VARCHAR(8) NOT NULL,
286 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
290 (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
291 q{ VALUES (1,'aaa','bbb'); }),
294 CREATE TABLE loader_test9 (
295 loader_test9 VARCHAR(8) NOT NULL
300 my @statements_advanced = (
302 CREATE TABLE loader_test10 (
303 id10 $self->{auto_inc_pk},
305 loader_test11 INTEGER
310 CREATE TABLE loader_test11 (
311 id11 $self->{auto_inc_pk},
312 message VARCHAR(8) DEFAULT 'foo',
313 loader_test10 INTEGER NOT NULL,
314 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
318 (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
319 q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
320 q{ REFERENCES loader_test11 (id11); }),
323 $self->{created} = 1;
325 my $dbh = $self->dbconnect(1);
326 $dbh->do($_) for (@statements);
327 unless($self->{skip_rels}) {
328 $dbh->do($_) for (@statements_reltests);
329 unless($self->{vendor} =~ /sqlite/i) {
330 $dbh->do($_) for (@statements_advanced);
339 return unless $self->{created};
346 my @tables_reltests = qw/
356 my @tables_advanced = qw/
362 q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
365 q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
367 my $dbh = $self->dbconnect(0);
369 unless($self->{skip_rels}) {
370 $dbh->do("DROP TABLE $_") for (@tables_reltests);
371 unless($self->{vendor} =~ /sqlite/i) {
372 if($self->{vendor} =~ /mysql/i) {
373 $dbh->do($drop_fk_mysql);
378 $dbh->do("DROP TABLE $_") for (@tables_advanced);
381 $dbh->do("DROP TABLE $_") for (@tables);