Commit | Line | Data |
70350518 |
1 | use strict; |
68de9438 |
2 | use warnings; |
70350518 |
3 | |
4 | use Test::More; |
74de7c2c |
5 | use Test::Exception; |
da6a5860 |
6 | |
7 | use DBI::Const::GetInfoType; |
8 | use Scalar::Util qw/weaken/; |
199fbc45 |
9 | use DBIx::Class::Optional::Dependencies (); |
da6a5860 |
10 | |
70350518 |
11 | use lib qw(t/lib); |
12 | use DBICTest; |
aa82ce29 |
13 | use DBIC::SqlMakerTest; |
0567538f |
14 | |
199fbc45 |
15 | plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mysql') |
16 | unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mysql'); |
17 | |
0567538f |
18 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; |
19 | |
20 | #warn "$dsn $user $pass"; |
21 | |
70350518 |
22 | plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test' |
0567538f |
23 | unless ($dsn && $user); |
24 | |
3ff5b740 |
25 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
0567538f |
26 | |
3ff5b740 |
27 | my $dbh = $schema->storage->dbh; |
0567538f |
28 | |
29 | $dbh->do("DROP TABLE IF EXISTS artist;"); |
30 | |
a0dd8679 |
31 | $dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10));"); |
0567538f |
32 | |
74de7c2c |
33 | $dbh->do("DROP TABLE IF EXISTS cd;"); |
34 | |
e0d56e26 |
35 | $dbh->do("CREATE TABLE cd (cdid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, artist INTEGER, title TEXT, year DATE, genreid INTEGER, single_track INTEGER);"); |
74de7c2c |
36 | |
37 | $dbh->do("DROP TABLE IF EXISTS producer;"); |
38 | |
39 | $dbh->do("CREATE TABLE producer (producerid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name TEXT);"); |
40 | |
41 | $dbh->do("DROP TABLE IF EXISTS cd_to_producer;"); |
42 | |
43 | $dbh->do("CREATE TABLE cd_to_producer (cd INTEGER,producer INTEGER);"); |
44 | |
bed3a173 |
45 | $dbh->do("DROP TABLE IF EXISTS owners;"); |
46 | |
47 | $dbh->do("CREATE TABLE owners (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(100) NOT NULL);"); |
48 | |
49 | $dbh->do("DROP TABLE IF EXISTS books;"); |
50 | |
51 | $dbh->do("CREATE TABLE books (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, source VARCHAR(100) NOT NULL, owner integer NOT NULL, title varchar(100) NOT NULL, price integer);"); |
52 | |
0567538f |
53 | #'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', ''); |
54 | |
8273e845 |
55 | # make sure sqlt_type overrides work (::Storage::DBI::mysql does this) |
adbf0c89 |
56 | { |
57 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
58 | |
59 | ok (!$schema->storage->_dbh, 'definitely not connected'); |
60 | is ($schema->storage->sqlt_type, 'MySQL', 'sqlt_type correct pre-connection'); |
61 | } |
62 | |
3ff5b740 |
63 | # This is in Core now, but it's here just to test that it doesn't break |
64 | $schema->class('Artist')->load_components('PK::Auto'); |
0567538f |
65 | |
66 | # test primary key handling |
3ff5b740 |
67 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
0567538f |
68 | ok($new->artistid, "Auto-PK worked"); |
69 | |
70 | # test LIMIT support |
71 | for (1..6) { |
3ff5b740 |
72 | $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); |
0567538f |
73 | } |
3ff5b740 |
74 | my $it = $schema->resultset('Artist')->search( {}, |
0567538f |
75 | { rows => 3, |
76 | offset => 2, |
77 | order_by => 'artistid' } |
78 | ); |
fb4b58e8 |
79 | is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 7 artists |
0567538f |
80 | is( $it->next->name, "Artist 2", "iterator->next ok" ); |
81 | $it->next; |
82 | $it->next; |
83 | is( $it->next, undef, "next past end of resultset ok" ); |
84 | |
e5372da4 |
85 | # Limit with select-lock |
86 | lives_ok { |
87 | $schema->txn_do (sub { |
88 | isa_ok ( |
89 | $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}), |
90 | 'DBICTest::Schema::Artist', |
91 | ); |
92 | }); |
93 | } 'Limited FOR UPDATE select works'; |
94 | |
4e0a89e4 |
95 | # shared-lock |
96 | lives_ok { |
97 | $schema->txn_do (sub { |
98 | isa_ok ( |
99 | $schema->resultset('Artist')->find({artistid => 1}, {for => 'shared'}), |
100 | 'DBICTest::Schema::Artist', |
101 | ); |
102 | }); |
103 | } 'LOCK IN SHARE MODE select works'; |
104 | |
a953d8d9 |
105 | my $test_type_info = { |
106 | 'artistid' => { |
103e3e03 |
107 | 'data_type' => 'INT', |
108 | 'is_nullable' => 0, |
fc22fbac |
109 | 'size' => 11, |
110 | 'default_value' => undef, |
a953d8d9 |
111 | }, |
112 | 'name' => { |
103e3e03 |
113 | 'data_type' => 'VARCHAR', |
a953d8d9 |
114 | 'is_nullable' => 1, |
a0dd8679 |
115 | 'size' => 100, |
fc22fbac |
116 | 'default_value' => undef, |
103e3e03 |
117 | }, |
39da2a2b |
118 | 'rank' => { |
119 | 'data_type' => 'INT', |
120 | 'is_nullable' => 0, |
121 | 'size' => 11, |
122 | 'default_value' => 13, |
123 | }, |
103e3e03 |
124 | 'charfield' => { |
637219ab |
125 | 'data_type' => 'CHAR', |
103e3e03 |
126 | 'is_nullable' => 1, |
fc22fbac |
127 | 'size' => 10, |
128 | 'default_value' => undef, |
103e3e03 |
129 | }, |
a953d8d9 |
130 | }; |
131 | |
bed3a173 |
132 | $schema->populate ('Owners', [ |
133 | [qw/id name /], |
134 | [qw/1 wiggle/], |
135 | [qw/2 woggle/], |
136 | [qw/3 boggle/], |
137 | ]); |
138 | |
139 | $schema->populate ('BooksInLibrary', [ |
140 | [qw/source owner title /], |
13a2f031 |
141 | [qw/Library 1 secrets1/], |
142 | [qw/Eatery 1 secrets2/], |
143 | [qw/Library 2 secrets3/], |
bed3a173 |
144 | ]); |
145 | |
13a2f031 |
146 | # |
8273e845 |
147 | # try a distinct + prefetch on tables with identically named columns |
13a2f031 |
148 | # (mysql doesn't seem to like subqueries with equally named columns) |
149 | # |
bed3a173 |
150 | |
d758ec36 |
151 | { |
13a2f031 |
152 | # try a ->has_many direction (due to a 'multi' accessor the select/group_by group is collapsed) |
153 | my $owners = $schema->resultset ('Owners')->search ( |
154 | { 'books.id' => { '!=', undef }}, |
155 | { prefetch => 'books', distinct => 1 } |
156 | ); |
157 | my $owners2 = $schema->resultset ('Owners')->search ({ id => { -in => $owners->get_column ('me.id')->as_query }}); |
158 | for ($owners, $owners2) { |
b5963465 |
159 | is ($_->all, 2, 'Prefetched grouped search returns correct number of rows'); |
160 | is ($_->count, 2, 'Prefetched grouped search returns correct count'); |
13a2f031 |
161 | } |
162 | |
d758ec36 |
163 | # try a ->belongs_to direction (no select collapse) |
b5963465 |
164 | my $books = $schema->resultset ('BooksInLibrary')->search ( |
165 | { 'owner.name' => 'wiggle' }, |
166 | { prefetch => 'owner', distinct => 1 } |
167 | ); |
168 | my $books2 = $schema->resultset ('BooksInLibrary')->search ({ id => { -in => $books->get_column ('me.id')->as_query }}); |
169 | for ($books, $books2) { |
170 | is ($_->all, 1, 'Prefetched grouped search returns correct number of rows'); |
171 | is ($_->count, 1, 'Prefetched grouped search returns correct count'); |
13a2f031 |
172 | } |
173 | } |
bed3a173 |
174 | |
5db49b9a |
175 | SKIP: { |
176 | my $mysql_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ); |
5db49b9a |
177 | skip "Cannot determine MySQL server version", 1 if !$mysql_version; |
a953d8d9 |
178 | |
f750163c |
179 | my ($v1, $v2, $v3) = $mysql_version =~ /^(\d+)\.(\d+)(?:\.(\d+))?/; |
180 | skip "Cannot determine MySQL server version", 1 if !$v1 || !defined($v2); |
181 | |
182 | $v3 ||= 0; |
183 | |
5db49b9a |
184 | if( ($v1 < 5) || ($v1 == 5 && $v2 == 0 && $v3 <= 3) ) { |
185 | $test_type_info->{charfield}->{data_type} = 'VARCHAR'; |
186 | } |
a953d8d9 |
187 | |
3ff5b740 |
188 | my $type_info = $schema->storage->columns_info_for('artist'); |
5db49b9a |
189 | is_deeply($type_info, $test_type_info, 'columns_info_for - column data types'); |
190 | } |
a953d8d9 |
191 | |
6a999241 |
192 | my $cd = $schema->resultset ('CD')->create ({}); |
193 | my $producer = $schema->resultset ('Producer')->create ({}); |
194 | lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die'; |
195 | |
aa82ce29 |
196 | { |
197 | my $artist = $schema->resultset('Artist')->next; |
198 | my $cd = $schema->resultset('CD')->next; |
199 | $cd->set_from_related ('artist', $artist); |
200 | $cd->update; |
201 | |
202 | my $rs = $schema->resultset('CD')->search ({}, { prefetch => 'artist' }); |
203 | |
204 | lives_ok sub { |
205 | my $cd = $rs->next; |
206 | is ($cd->artist->name, $artist->name, 'Prefetched artist'); |
207 | }, 'join does not throw (mysql 3 test)'; |
208 | |
209 | # induce a jointype override, make sure it works even if we don't have mysql3 |
de5f71ef |
210 | local $schema->storage->sql_maker->{_default_jointype} = 'inner'; |
aa82ce29 |
211 | is_same_sql_bind ( |
212 | $rs->as_query, |
213 | '( |
214 | SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, |
215 | artist.artistid, artist.name, artist.rank, artist.charfield |
216 | FROM cd me |
217 | INNER JOIN artist artist ON artist.artistid = me.artist |
218 | )', |
219 | [], |
220 | 'overriden default join type works', |
221 | ); |
222 | } |
6a999241 |
223 | |
b8391c87 |
224 | { |
225 | # Test support for straight joins |
226 | my $cdsrc = $schema->source('CD'); |
227 | my $artrel_info = $cdsrc->relationship_info ('artist'); |
228 | $cdsrc->add_relationship( |
229 | 'straight_artist', |
230 | $artrel_info->{class}, |
231 | $artrel_info->{cond}, |
232 | { %{$artrel_info->{attrs}}, join_type => 'straight' }, |
233 | ); |
234 | is_same_sql_bind ( |
235 | $cdsrc->resultset->search({}, { prefetch => 'straight_artist' })->as_query, |
236 | '( |
237 | SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, |
238 | straight_artist.artistid, straight_artist.name, straight_artist.rank, straight_artist.charfield |
239 | FROM cd me |
240 | STRAIGHT_JOIN artist straight_artist ON straight_artist.artistid = me.artist |
241 | )', |
242 | [], |
243 | 'straight joins correctly supported for mysql' |
244 | ); |
245 | } |
246 | |
55cfbb70 |
247 | ## Can we properly deal with the null search problem? |
a7e65bb5 |
248 | ## |
249 | ## Only way is to do a SET SQL_AUTO_IS_NULL = 0; on connect |
250 | ## But I'm not sure if we should do this or not (Ash, 2008/06/03) |
0fde80d9 |
251 | # |
252 | # There is now a built-in function to do this, test that everything works |
253 | # with it (ribasushi, 2009/07/03) |
55cfbb70 |
254 | |
255 | NULLINSEARCH: { |
97a0a148 |
256 | my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { on_connect_call => 'set_strict_mode' }); |
8de9298c |
257 | |
258 | $ansi_schema->resultset('Artist')->create ({ name => 'last created artist' }); |
6a999241 |
259 | |
260 | ok my $artist1_rs = $ansi_schema->resultset('Artist')->search({artistid=>6666}) |
261 | => 'Created an artist resultset of 6666'; |
262 | |
55cfbb70 |
263 | is $artist1_rs->count, 0 |
6a999241 |
264 | => 'Got no returned rows'; |
374dd926 |
265 | |
6a999241 |
266 | ok my $artist2_rs = $ansi_schema->resultset('Artist')->search({artistid=>undef}) |
267 | => 'Created an artist resultset of undef'; |
74de7c2c |
268 | |
6a999241 |
269 | is $artist2_rs->count, 0 |
270 | => 'got no rows'; |
74de7c2c |
271 | |
6a999241 |
272 | my $artist = $artist2_rs->single; |
55cfbb70 |
273 | |
6a999241 |
274 | is $artist => undef |
275 | => 'Nothing Found!'; |
74de7c2c |
276 | } |
aa82ce29 |
277 | |
0ce4ab92 |
278 | # check for proper grouped counts |
279 | { |
9f775126 |
280 | my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { |
281 | on_connect_call => 'set_strict_mode', |
282 | quote_char => '`', |
9f775126 |
283 | }); |
0ce4ab92 |
284 | my $rs = $ansi_schema->resultset('CD'); |
285 | |
286 | my $years; |
287 | $years->{$_->year|| scalar keys %$years}++ for $rs->all; # NULL != NULL, thus the keys eval |
288 | |
289 | lives_ok ( sub { |
290 | is ( |
291 | $rs->search ({}, { group_by => 'year'})->count, |
292 | scalar keys %$years, |
293 | 'grouped count correct', |
294 | ); |
295 | }, 'Grouped count does not throw'); |
9f775126 |
296 | |
297 | lives_ok( sub { |
298 | $ansi_schema->resultset('Owners')->search({}, { |
299 | join => 'books', group_by => [ 'me.id', 'books.id' ] |
300 | })->count(); |
301 | }, 'count on grouped columns with the same name does not throw'); |
0ce4ab92 |
302 | } |
303 | |
e0d56e26 |
304 | ZEROINSEARCH: { |
305 | my $cds_per_year = { |
306 | 2001 => 2, |
307 | 2002 => 1, |
308 | 2005 => 3, |
309 | }; |
310 | |
311 | my $rs = $schema->resultset ('CD'); |
312 | $rs->delete; |
313 | for my $y (keys %$cds_per_year) { |
314 | for my $c (1 .. $cds_per_year->{$y} ) { |
315 | $rs->create ({ title => "CD $y-$c", artist => 1, year => "$y-01-01" }); |
316 | } |
317 | } |
318 | |
319 | is ($rs->count, 6, 'CDs created successfully'); |
320 | |
321 | $rs = $rs->search ({}, { |
ca458871 |
322 | select => [ \ 'YEAR(year)' ], as => ['y'], distinct => 1, |
e0d56e26 |
323 | }); |
324 | |
325 | is_deeply ( |
ca458871 |
326 | [ sort ($rs->get_column ('y')->all) ], |
e0d56e26 |
327 | [ sort keys %$cds_per_year ], |
328 | 'Years group successfully', |
329 | ); |
330 | |
331 | $rs->create ({ artist => 1, year => '0-1-1', title => 'Jesus Rap' }); |
332 | |
333 | is_deeply ( |
ca458871 |
334 | [ sort $rs->get_column ('y')->all ], |
e0d56e26 |
335 | [ 0, sort keys %$cds_per_year ], |
336 | 'Zero-year groups successfully', |
337 | ); |
338 | |
8273e845 |
339 | # convoluted search taken verbatim from list |
e0d56e26 |
340 | my $restrict_rs = $rs->search({ -and => [ |
341 | year => { '!=', 0 }, |
342 | year => { '!=', undef } |
343 | ]}); |
344 | |
345 | is_deeply ( |
346 | [ $restrict_rs->get_column('y')->all ], |
347 | [ $rs->get_column ('y')->all ], |
348 | 'Zero year was correctly excluded from resultset', |
349 | ); |
350 | } |
10176e1f |
351 | |
f98120e4 |
352 | # make sure find hooks determine driver |
353 | { |
354 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
355 | $schema->resultset("Artist")->find(4); |
356 | isa_ok($schema->storage->sql_maker, 'DBIx::Class::SQLMaker::MySQL'); |
357 | } |
358 | |
359 | # make sure the mysql_auto_reconnect buggery is avoided |
360 | { |
361 | local $ENV{MOD_PERL} = 'boogiewoogie'; |
362 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
363 | ok (! $schema->storage->_get_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect unset regardless of ENV' ); |
364 | |
da6a5860 |
365 | # Make sure hardcore forking action still works even if mysql_auto_reconnect |
366 | # is true (test inspired by ether) |
367 | |
368 | my $schema_autorecon = DBICTest::Schema->connect($dsn, $user, $pass, { mysql_auto_reconnect => 1 }); |
369 | my $orig_dbh = $schema_autorecon->storage->_get_dbh; |
370 | weaken $orig_dbh; |
371 | |
372 | ok ($orig_dbh, 'Got weak $dbh ref'); |
373 | ok ($orig_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect is properly set if explicitly requested' ); |
374 | |
375 | my $rs = $schema_autorecon->resultset('Artist'); |
376 | |
377 | my $pid = fork(); |
378 | if (! defined $pid ) { |
379 | die "fork() failed: $!" |
380 | } |
381 | elsif ($pid) { |
382 | # sanity check |
383 | $schema_autorecon->storage->dbh_do(sub { |
384 | is ($_[1], $orig_dbh, 'Storage holds correct $dbh in parent'); |
385 | }); |
386 | |
387 | # kill our $dbh |
388 | $schema_autorecon->storage->_dbh(undef); |
e0b2dc74 |
389 | |
390 | TODO: { |
391 | local $TODO = "Perl $] is known to leak like a sieve" |
392 | if DBIx::Class::_ENV_::PEEPEENESS(); |
393 | |
394 | ok (! defined $orig_dbh, 'Parent $dbh handle is gone'); |
395 | } |
da6a5860 |
396 | } |
397 | else { |
398 | # wait for parent to kill its $dbh |
399 | sleep 1; |
400 | |
401 | #simulate a subtest to not confuse the parent TAP emission |
402 | Test::More->builder->reset; |
403 | Test::More->builder->plan('no_plan'); |
404 | Test::More->builder->_indent(' ' x 4); |
405 | |
da6a5860 |
406 | # try to do something dbic-esque |
407 | $rs->create({ name => "Hardcore Forker $$" }); |
408 | |
e0b2dc74 |
409 | |
410 | TODO: { |
411 | local $TODO = "Perl $] is known to leak like a sieve" |
412 | if DBIx::Class::_ENV_::PEEPEENESS(); |
413 | |
414 | ok (! defined $orig_dbh, 'DBIC operation triggered reconnect - old $dbh is gone'); |
415 | } |
da6a5860 |
416 | |
417 | exit 0; |
418 | } |
419 | |
420 | wait; |
421 | ok(!$?, 'Child subtests passed'); |
422 | |
423 | ok ($rs->find({ name => "Hardcore Forker $pid" }), 'Expected row created'); |
f98120e4 |
424 | } |
10176e1f |
425 | |
aa82ce29 |
426 | done_testing; |