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 user => $self->{user},
52 password => $self->{password},
53 namespace => $namespace,
54 constraint => '^(?:\S+\.)?(?i:loader_test)[0-9]+$',
59 $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
60 $loader_opts{drop_db_schema} = $self->{drop_db_schema} if $self->{drop_db_schema};
64 use base qw/DBIx::Class::Schema::Loader/;
66 __PACKAGE__->load_from_connection(\%loader_opts);
68 ok(!$@, "Loader initialization failed: $@");
70 my $conn = $schema_pkg->connect($self->{dsn},$self->{user},$self->{password});
72 my $moniker1 = $conn->moniker('loader_test1');
73 my $rsobj1 = $conn->resultset($moniker1);
74 my $moniker2 = $conn->moniker('loader_test2');
75 my $rsobj2 = $conn->resultset($moniker2);
77 isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
78 isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
80 my $obj = $rsobj1->find(1);
82 is( $obj->dat, "foo" );
83 is( $rsobj2->count, 4 );
85 my ($obj2) = $rsobj2->find( dat => 'bbb' );
89 skip $self->{skip_rels}, 20 if $self->{skip_rels};
91 my $moniker3 = $conn->moniker('loader_test3');
92 my $rsobj3 = $conn->resultset($moniker3);
93 my $moniker4 = $conn->moniker('loader_test4');
94 my $rsobj4 = $conn->resultset($moniker4);
95 my $moniker5 = $conn->moniker('loader_test5');
96 my $rsobj5 = $conn->resultset($moniker5);
97 my $moniker6 = $conn->moniker('loader_test6');
98 my $rsobj6 = $conn->resultset($moniker6);
99 my $moniker7 = $conn->moniker('loader_test7');
100 my $rsobj7 = $conn->resultset($moniker7);
101 my $moniker8 = $conn->moniker('loader_test8');
102 my $rsobj8 = $conn->resultset($moniker8);
103 my $moniker9 = $conn->moniker('loader_test9');
104 my $rsobj9 = $conn->resultset($moniker9);
106 isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
107 isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
108 isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
109 isa_ok( $rsobj6, "DBIx::Class::ResultSet" );
110 isa_ok( $rsobj7, "DBIx::Class::ResultSet" );
111 isa_ok( $rsobj8, "DBIx::Class::ResultSet" );
112 isa_ok( $rsobj9, "DBIx::Class::ResultSet" );
115 my $obj4 = $rsobj4->find(123);
116 isa_ok( $obj4->fkid, "$namespace\::$moniker3");
118 # fk def in comments should not be parsed
119 my $obj5 = $rsobj5->find( id1 => 1, id2 => 1 );
120 is( ref( $obj5->id2 ), '' );
122 # mulit-col fk def (works for some, not others...)
123 my $obj6 = $rsobj6->find(1);
124 isa_ok( $obj6->loader_test2, "$namespace\::$moniker2" );
126 skip "Multi-column FKs are only half-working for this vendor", 1
127 unless $self->{multi_fk_broken};
128 is( ref( $obj6->id2 ), '' );
131 # fk that references a non-pk key (UNIQUE)
132 my $obj8 = $rsobj8->find(1);
133 isa_ok( $obj8->loader_test7, "$namespace\::$moniker7" );
135 # from Chisel's tests...
137 if($self->{vendor} =~ /sqlite/i) {
138 skip 'SQLite cannot do the advanced tests', 8;
141 my $moniker10 = $conn->moniker('loader_test10');
142 my $rsobj10 = $conn->resultset($moniker10);
143 my $moniker11 = $conn->moniker('loader_test11');
144 my $rsobj11 = $conn->resultset($moniker11);
146 isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
147 isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
149 my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
152 ok( defined $obj10, '$obj10 is defined' );
154 my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
156 ok( defined $obj11, '$obj11 is defined' );
159 my $obj10_2 = $obj11->loader_test10;
160 $obj10_2->loader_test11( $obj11->id11() );
163 is($@, '', 'No errors after eval{}');
166 skip 'Previous eval block failed', 3
169 my $results = $rsobj10->search({ subject => 'xyzzy' });
170 is( $results->count(), 1,
171 'One $rsobj10 returned from search' );
173 my $obj10_3 = $results->first();
174 isa_ok( $obj10_3, "$namespace\::$moniker10" );
175 is( $obj10_3->loader_test11()->id(), $obj11->id(),
176 'found same $rsobj11 object we expected' );
183 my ($self, $complain) = @_;
185 my $dbh = DBI->connect(
186 $self->{dsn}, $self->{user},
189 RaiseError => $complain,
190 PrintError => $complain,
195 die "Failed to connect to database: $DBI::errstr" if !$dbh;
205 CREATE TABLE loader_test1 (
206 id $self->{auto_inc_pk},
211 q{ INSERT INTO loader_test1 (dat) VALUES('foo'); },
212 q{ INSERT INTO loader_test1 (dat) VALUES('bar'); },
213 q{ INSERT INTO loader_test1 (dat) VALUES('baz'); },
216 CREATE TABLE loader_test2 (
217 id $self->{auto_inc_pk},
222 q{ INSERT INTO loader_test2 (dat) VALUES('aaa'); },
223 q{ INSERT INTO loader_test2 (dat) VALUES('bbb'); },
224 q{ INSERT INTO loader_test2 (dat) VALUES('ccc'); },
225 q{ INSERT INTO loader_test2 (dat) VALUES('ddd'); },
228 my @statements_reltests = (
230 CREATE TABLE loader_test3 (
231 id INTEGER NOT NULL PRIMARY KEY,
236 q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa'); },
237 q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb'); },
238 q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc'); },
239 q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd'); },
242 CREATE TABLE loader_test4 (
243 id INTEGER NOT NULL PRIMARY KEY,
244 fkid INTEGER NOT NULL,
246 FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
250 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa'); },
251 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb'); },
252 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc'); },
253 q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd'); },
256 CREATE TABLE loader_test5 (
257 id1 INTEGER NOT NULL,
258 id2 INTEGER NOT NULL, -- , id2 INTEGER REFERENCES loader_test1,
260 PRIMARY KEY (id1,id2)
264 q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa'); },
267 CREATE TABLE loader_test6 (
268 id $self->{auto_inc_pk},
270 loader_test2 INTEGER,
272 FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
273 FOREIGN KEY (id, id2 ) REFERENCES loader_test5 (id1,id2)
277 (q{ INSERT INTO loader_test6 (id2,loader_test2,dat) } .
278 q{ VALUES (1,1,'aaa'); }),
281 CREATE TABLE loader_test7 (
282 id INTEGER NOT NULL PRIMARY KEY,
283 id2 VARCHAR(8) NOT NULL UNIQUE,
288 q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb'); },
291 CREATE TABLE loader_test8 (
292 id INTEGER NOT NULL PRIMARY KEY,
293 loader_test7 VARCHAR(8) NOT NULL,
295 FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
299 (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
300 q{ VALUES (1,'aaa','bbb'); }),
303 CREATE TABLE loader_test9 (
304 loader_test9 VARCHAR(8) NOT NULL
309 my @statements_advanced = (
311 CREATE TABLE loader_test10 (
312 id10 $self->{auto_inc_pk},
314 loader_test11 INTEGER
319 CREATE TABLE loader_test11 (
320 id11 $self->{auto_inc_pk},
321 message VARCHAR(8) DEFAULT 'foo',
322 loader_test10 INTEGER,
323 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
327 (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
328 q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
329 q{ REFERENCES loader_test11 (id11); }),
334 $self->{created} = 1;
336 my $dbh = $self->dbconnect(1);
337 $dbh->do($_) for (@statements);
338 unless($self->{skip_rels}) {
339 # hack for now, since DB2 doesn't like inline comments, and we need
340 # to test one for mysql, which works on everyone else...
341 # this all needs to be refactored anyways.
342 if($self->{vendor} =~ /DB2/i) {
343 @statements_reltests = map { s/--.*\n//; $_ } @statements_reltests;
345 $dbh->do($_) for (@statements_reltests);
346 unless($self->{vendor} =~ /sqlite/i) {
347 $dbh->do($_) for (@statements_advanced);
356 return unless $self->{created};
363 my @tables_reltests = qw/
373 my @tables_advanced = qw/
379 q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
382 q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
384 my $dbh = $self->dbconnect(0);
386 unless($self->{skip_rels}) {
387 $dbh->do("DROP TABLE $_") for (@tables_reltests);
388 unless($self->{vendor} =~ /sqlite/i) {
389 if($self->{vendor} =~ /mysql/i) {
390 $dbh->do($drop_fk_mysql);
395 $dbh->do("DROP TABLE $_") for (@tables_advanced);
398 $dbh->do("DROP TABLE $_") for (@tables);
402 sub DESTROY { shift->drop_tables; }