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" );
122 is( ref( $obj6->loader_test5 ), "$schema_class\::$moniker5");
124 # fk that references a non-pk key (UNIQUE)
125 my $obj8 = $rsobj8->find(1);
126 isa_ok( $obj8->loader_test7, "$schema_class\::$moniker7" );
128 # from Chisel's tests...
130 if($self->{vendor} =~ /sqlite/i) {
131 skip 'SQLite cannot do the advanced tests', 8;
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);
139 isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
140 isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
142 my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
145 ok( defined $obj10, '$obj10 is defined' );
147 my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
149 ok( defined $obj11, '$obj11 is defined' );
152 my $obj10_2 = $obj11->loader_test10;
153 $obj10_2->loader_test11( $obj11->id11() );
156 is($@, '', 'No errors after eval{}');
159 skip 'Previous eval block failed', 3
162 my $results = $rsobj10->search({ subject => 'xyzzy' });
163 is( $results->count(), 1,
164 'One $rsobj10 returned from search' );
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' );
176 my ($self, $complain) = @_;
178 my $dbh = DBI->connect(
179 $self->{dsn}, $self->{user},
182 RaiseError => $complain,
183 PrintError => $complain,
188 die "Failed to connect to database: $DBI::errstr" if !$dbh;
198 CREATE TABLE loader_test1 (
199 id $self->{auto_inc_pk},
204 q{ INSERT INTO loader_test1 (dat) VALUES('foo') },
205 q{ INSERT INTO loader_test1 (dat) VALUES('bar') },
206 q{ INSERT INTO loader_test1 (dat) VALUES('baz') },
209 CREATE TABLE loader_test2 (
210 id $self->{auto_inc_pk},
215 q{ INSERT INTO loader_test2 (dat) VALUES('aaa') },
216 q{ INSERT INTO loader_test2 (dat) VALUES('bbb') },
217 q{ INSERT INTO loader_test2 (dat) VALUES('ccc') },
218 q{ INSERT INTO loader_test2 (dat) VALUES('ddd') },
221 my @statements_reltests = (
223 CREATE TABLE loader_test3 (
224 id INTEGER NOT NULL PRIMARY KEY,
229 q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') },
230 q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') },
231 q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') },
232 q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') },
235 CREATE TABLE loader_test4 (
236 id INTEGER NOT NULL PRIMARY KEY,
237 fkid INTEGER NOT NULL,
239 FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
243 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa') },
244 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb') },
245 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') },
246 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') },
249 CREATE TABLE loader_test5 (
250 id1 INTEGER NOT NULL,
251 id2 INTEGER NOT NULL, -- , id2 INTEGER REFERENCES loader_test1,
253 PRIMARY KEY (id1,id2)
257 q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa') },
260 CREATE TABLE loader_test6 (
261 id INTEGER NOT NULL PRIMARY KEY,
263 loader_test2 INTEGER,
265 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
266 FOREIGN KEY (id, id2 ) REFERENCES loader_test5 (id1,id2)
270 (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } .
271 q{ VALUES (1, 1,1,'aaa') }),
274 CREATE TABLE loader_test7 (
275 id INTEGER NOT NULL PRIMARY KEY,
276 id2 VARCHAR(8) NOT NULL UNIQUE,
281 q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb') },
284 CREATE TABLE loader_test8 (
285 id INTEGER NOT NULL PRIMARY KEY,
286 loader_test7 VARCHAR(8) NOT NULL,
288 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
292 (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
293 q{ VALUES (1,'aaa','bbb') }),
296 CREATE TABLE loader_test9 (
297 loader_test9 VARCHAR(8) NOT NULL
302 my @statements_advanced = (
304 CREATE TABLE loader_test10 (
305 id10 $self->{auto_inc_pk},
307 loader_test11 INTEGER
312 CREATE TABLE loader_test11 (
313 id11 $self->{auto_inc_pk},
314 message VARCHAR(8) DEFAULT 'foo',
315 loader_test10 INTEGER,
316 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
320 (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
321 q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
322 q{ REFERENCES loader_test11 (id11) }),
327 $self->{created} = 1;
329 my $dbh = $self->dbconnect(1);
330 $dbh->do($_) for (@statements);
331 unless($self->{skip_rels}) {
332 # hack for now, since DB2 doesn't like inline comments, and we need
333 # to test one for mysql, which works on everyone else...
334 # this all needs to be refactored anyways.
335 if($self->{vendor} =~ /DB2/i) {
336 @statements_reltests = map { s/--.*\n//; $_ } @statements_reltests;
338 $dbh->do($_) for (@statements_reltests);
339 unless($self->{vendor} =~ /sqlite/i) {
340 $dbh->do($_) for (@statements_advanced);
349 return unless $self->{created};
356 my @tables_reltests = qw/
366 my @tables_advanced = qw/
372 q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
375 q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
377 my $dbh = $self->dbconnect(0);
379 unless($self->{skip_rels}) {
380 $dbh->do("DROP TABLE $_") for (@tables_reltests);
381 unless($self->{vendor} =~ /sqlite/i) {
382 if($self->{vendor} =~ /mysql/i) {
383 $dbh->do($drop_fk_mysql);
388 $dbh->do("DROP TABLE $_") for (@tables_advanced);
391 $dbh->do("DROP TABLE $_") for (@tables);
395 sub DESTROY { shift->drop_tables; }