update version and changes (_14 was the last one I can see, so _15 it is)
[dbsrgits/DBIx-Class.git] / t / prefetch / manual.t
1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7 use Test::Deep;
8 use Test::Warn;
9 use Test::Exception;
10
11 use DBICTest;
12
13 delete $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS};
14
15 my $schema = DBICTest->init_schema(no_populate => 1);
16
17 $schema->resultset('Artist')->create({ name => 'JMJ', cds => [{
18   title => 'Magnetic Fields',
19   year => 1981,
20   genre => { name => 'electro' },
21   tracks => [
22     { title => 'm1' },
23     { title => 'm2' },
24     { title => 'm3' },
25     { title => 'm4' },
26   ],
27 } ] });
28
29 $schema->resultset('CD')->create({
30   title => 'Equinoxe',
31   year => 1978,
32   artist => { name => 'JMJ' },
33   genre => { name => 'electro' },
34   tracks => [
35     { title => 'e1' },
36     { title => 'e2' },
37     { title => 'e3' },
38   ],
39   single_track => {
40     title => 'o1',
41     cd => {
42       title => 'Oxygene',
43       year => 1976,
44       artist => { name => 'JMJ' },
45       tracks => [
46         { title => 'o2', position => 2},  # the position should not be here, bug in MC
47       ],
48     },
49   },
50 });
51
52 my $rs = $schema->resultset ('CD')->search ({}, {
53   join => [ 'tracks', { single_track => { cd => { artist => { cds => 'tracks' } } } }  ],
54   collapse => 1,
55   columns => [
56     { 'year'                                    => 'me.year' },               # non-unique
57     { 'genreid'                                 => 'me.genreid' },            # nullable
58     { 'tracks.title'                            => 'tracks.title' },          # non-unique (no me.id)
59     { 'single_track.cd.artist.cds.cdid'         => 'cds.cdid' },              # to give uniquiness to ...tracks.title below
60     { 'single_track.cd.artist.artistid'         => 'artist.artistid' },       # uniqufies entire parental chain
61     { 'single_track.cd.artist.cds.year'         => 'cds.year' },              # non-unique
62     { 'single_track.cd.artist.cds.genreid'      => 'cds.genreid' },           # nullable
63     { 'single_track.cd.artist.cds.tracks.title' => 'tracks_2.title' },        # unique when combined with ...cds.cdid above
64     { 'latest_cd'                     => \ "(SELECT MAX(year) FROM cd)" },    # random function
65     { 'title'                                   => 'me.title' },              # uniquiness for me
66     { 'artist'                                  => 'me.artist' },             # uniquiness for me
67   ],
68   order_by => [{ -desc => 'cds.year' }, { -desc => 'me.title'}, 'tracks.title', 'tracks_2.title' ],
69 });
70
71 my $hri_rs = $rs->search({}, { result_class => 'DBIx::Class::ResultClass::HashRefInflator' });
72
73 cmp_deeply (
74   [$hri_rs->all],
75   [
76     { artist => 1, genreid => 1, latest_cd => 1981, title => "Equinoxe", year => 1978,
77       single_track => {
78         cd => {
79           artist => { artistid => 1, cds => [
80             { cdid => 1, genreid => 1, year => 1981, tracks => [
81               { title => "m1" },
82               { title => "m2" },
83               { title => "m3" },
84               { title => "m4" },
85             ]},
86             { cdid => 3, genreid => 1, year => 1978, tracks => [
87               { title => "e1" },
88               { title => "e2" },
89               { title => "e3" },
90             ]},
91             { cdid => 2, genreid => undef, year => 1976, tracks => [
92               { title => "o1" },
93               { title => "o2" },
94             ]},
95           ]},
96         },
97       },
98       tracks => [
99         { title => "e1" },
100         { title => "e2" },
101         { title => "e3" },
102       ],
103     },
104     {
105       artist => 1, genreid => undef, latest_cd => 1981, title => "Oxygene", year => 1976, single_track => undef,
106       tracks => [
107         { title => "o1" },
108         { title => "o2" },
109       ],
110     },
111     {
112       artist => 1, genreid => 1, latest_cd => 1981, title => "Magnetic Fields", year => 1981, single_track => undef,
113       tracks => [
114         { title => "m1" },
115         { title => "m2" },
116         { title => "m3" },
117         { title => "m4" },
118       ],
119     },
120   ],
121   'W00T, manual prefetch with collapse works'
122 );
123
124 lives_ok { my $dummy = $rs;  warnings_exist {
125
126 ##############
127 ### This is a bunch of workarounds for deprecated behavior - delete entire block when fixed
128   my $cd_obj = ($rs->all)[0]->single_track->cd;
129   my $art_obj = $cd_obj->artist;
130
131   my $empty_single_columns = {
132     cd => undef
133   };
134   my $empty_single_inflated_columns = {
135     cd => $cd_obj
136   };
137   my $empty_cd_columns = {
138     artist => $art_obj->artistid
139   };
140   my $empty_cd_inflated_columns = {
141     artist => $art_obj
142   };
143
144   {
145     local $TODO = "Returning prefetched 'filter' rels as part of get_columns/get_inflated_columns is deprecated";
146     is_deeply($_, {}) for (
147       $empty_single_columns, $empty_single_inflated_columns, $empty_cd_columns, $empty_cd_inflated_columns
148     );
149   }
150 ##############
151
152
153 ### this tests the standard root -> single -> filter ->filter
154   my ($row) = $rs->all; # don't trigger order warnings
155
156   is_deeply(
157     { $row->single_track->get_columns },
158     $empty_single_columns,
159     "No unexpected columns available on intermediate 'single' rel with a chained 'filter' prefetch",
160   );
161
162   is_deeply(
163     { $row->single_track->get_inflated_columns },
164     $empty_single_inflated_columns,
165     "No unexpected inflated columns available on intermediate 'single' rel with a chained 'filter' prefetch",
166   );
167
168   is_deeply(
169     { $row->single_track->cd->get_columns },
170     $empty_cd_columns,
171     "No unexpected columns available on intermediate 'single' rel with 2x chained 'filter' prefetch",
172   );
173
174   is_deeply(
175     { $row->single_track->cd->get_inflated_columns },
176     $empty_cd_inflated_columns,
177     "No unexpected inflated columns available on intermediate 'single' rel with 2x chained 'filter' prefetch",
178   );
179
180 ### also try a different arangement root -> single -> single ->filter
181   ($row) = $rs->result_source->resultset->search({ 'artist.artistid' => 1 }, {
182     join => { single_track => { disc => { artist => 'cds' } } },
183     '+columns' => {
184       'single_track.disc.artist.artistid' => 'artist.artistid',
185       'single_track.disc.artist.cds.cdid' => 'cds.cdid',
186     },
187     collapse => 1,
188   })->all;
189
190   is_deeply(
191     { $row->single_track->get_columns },
192     {},
193     "No unexpected columns available on intermediate 'single' rel with a chained 'single' prefetch",
194   );
195
196   is_deeply(
197     { $row->single_track->get_inflated_columns },
198     {},
199     "No unexpected inflated columns available on intermediate 'single' rel with a chained 'single' prefetch",
200   );
201
202   is_deeply(
203     { $row->single_track->disc->get_columns },
204     $empty_cd_columns,
205     "No unexpected columns available on intermediate 'single' rel with chained 'single' and chained 'filter' prefetch",
206   );
207
208   is_deeply(
209     { $row->single_track->disc->get_inflated_columns },
210     $empty_cd_inflated_columns,
211     "No unexpected inflated columns available on intermediate 'single' rel with chained 'single' and chained 'filter' prefetch",
212   );
213
214 } [
215   qr/\QReturning primary keys of prefetched 'filter' rels as part of get_columns()/,
216   qr/\QUnable to deflate 'filter'-type relationship 'cd' (related object primary key not retrieved)/,
217   qr/\QReturning prefetched 'filter' rels as part of get_inflated_columns()/,
218   qr/\QReturning primary keys of prefetched 'filter' rels as part of get_columns()/,
219   qr/\QReturning prefetched 'filter' rels as part of get_inflated_columns()/,
220   qr/\QReturning primary keys of prefetched 'filter' rels as part of get_columns()/,
221   qr/\QReturning prefetched 'filter' rels as part of get_inflated_columns()/,
222 ], 'expected_warnings'
223 } 'traversing prefetch chain with empty intermediates works';
224
225 # multi-has_many with underdefined root, with rather random order
226 $rs = $schema->resultset ('CD')->search ({}, {
227   join => [ 'tracks', { single_track => { cd => { artist => { cds => 'tracks' } } } }  ],
228   collapse => 1,
229   columns => [
230     { 'single_track.trackid'                    => 'single_track.trackid' },  # definitive link to root from 1:1:1:1:M:M chain
231     { 'year'                                    => 'me.year' },               # non-unique
232     { 'tracks.cd'                               => 'tracks.cd' },             # \ together both uniqueness for second multirel
233     { 'tracks.title'                            => 'tracks.title' },          # / and definitive link back to root
234     { 'single_track.cd.artist.cds.cdid'         => 'cds.cdid' },              # to give uniquiness to ...tracks.title below
235     { 'single_track.cd.artist.cds.year'         => 'cds.year' },              # non-unique
236     { 'single_track.cd.artist.artistid'         => 'artist.artistid' },       # uniqufies entire parental chain
237     { 'single_track.cd.artist.cds.genreid'      => 'cds.genreid' },           # nullable
238     { 'single_track.cd.artist.cds.tracks.title' => 'tracks_2.title' },        # unique when combined with ...cds.cdid above
239   ],
240 });
241
242 for (1..3) {
243   $rs->create({ artist => 1, year => 1977, title => "fuzzy_$_" });
244 }
245
246 my $rs_random = $rs->search({}, { order_by => \ 'RANDOM()' });
247 is ($rs_random->count, 6, 'row count matches');
248
249 if ($ENV{TEST_VERBOSE}) {
250  my @lines = (
251     [ "What are we actually trying to collapse (Select/As, tests below will see a *DIFFERENT* random order):" ],
252     [ map { my $s = $_; $s =~ s/single_track\./sngl_tr./; $s } @{$rs_random->{_attrs}{select} } ],
253     $rs_random->{_attrs}{as},
254     [ "-" x 159 ],
255     $rs_random->cursor->all,
256   );
257
258   diag join ' # ', map { sprintf '% 15s', (defined $_ ? $_ : 'NULL') } @$_
259     for @lines;
260 }
261
262 $schema->is_executed_querycount( sub {
263   for my $use_next (0, 1) {
264     my @random_cds;
265     my $rs_r = $rs_random;
266     if ($use_next) {
267       warnings_exist {
268         while (my $o = $rs_r->next) {
269           push @random_cds, $o;
270         }
271       } qr/performed an eager cursor slurp underneath/,
272       'Warned on auto-eager cursor';
273     }
274     else {
275       @random_cds = $rs_r->all;
276     }
277
278     is (@random_cds, 6, 'object count matches');
279
280     for my $cd (@random_cds) {
281       if ($cd->year == 1977) {
282         is( scalar $cd->tracks, 0, 'no tracks on 1977 cd' );
283         is( $cd->single_track, undef, 'no single_track on 1977 cd' );
284       }
285       elsif ($cd->year == 1976) {
286         is( scalar $cd->tracks, 2, 'Two tracks on 1976 cd' );
287         like( $_->title, qr/^o\d/, "correct title" )
288           for $cd->tracks;
289         is( $cd->single_track, undef, 'no single_track on 1976 cd' );
290       }
291       elsif ($cd->year == 1981) {
292         is( scalar $cd->tracks, 4, 'Four tracks on 1981 cd' );
293         like( $_->title, qr/^m\d/, "correct title" )
294           for $cd->tracks;
295         is( $cd->single_track, undef, 'no single_track on 1981 cd' );
296       }
297       elsif ($cd->year == 1978) {
298         is( scalar $cd->tracks, 3, 'Three tracks on 1978 cd' );
299         like( $_->title, qr/^e\d/, "correct title" )
300           for $cd->tracks;
301         ok( defined $cd->single_track, 'single track prefetched on 1987 cd' );
302         is( $cd->single_track->cd->artist->id, 1, 'Single_track->cd->artist prefetched on 1978 cd' );
303         is( scalar $cd->single_track->cd->artist->cds, 6, '6 cds prefetched on artist' );
304       }
305     }
306   }
307 }, 2, "Only two queries for two prefetch calls total");
308
309 # can't cmp_deeply a random set - need *some* order
310 my $ord_rs = $rs->search({}, {
311   order_by => [ 'tracks_2.title', 'tracks.title', 'cds.cdid', \ 'RANDOM()' ],
312   result_class => 'DBIx::Class::ResultClass::HashRefInflator',
313 });
314 my @hris_all = sort { $a->{year} cmp $b->{year} } $ord_rs->all;
315 is (@hris_all, 6, 'hri count matches' );
316
317 my $iter_rs = $rs->search({}, {
318   order_by => [ 'me.year', 'me.cdid', 'tracks_2.title', 'tracks.title', 'cds.cdid', \ 'RANDOM()' ],
319   result_class => 'DBIx::Class::ResultClass::HashRefInflator',
320 });
321 my @hris_iter;
322 while (my $r = $iter_rs->next) {
323   push @hris_iter, $r;
324 }
325
326 cmp_deeply(
327   \@hris_iter,
328   \@hris_all,
329   'Iteration works correctly',
330 );
331
332 my @hri_contents = (
333   { year => 1976, single_track => undef, tracks => [
334     { cd => 2, title => "o1" },
335     { cd => 2, title => "o2" },
336   ]},
337   { year => 1977, single_track => undef, tracks => [] },
338   { year => 1977, single_track => undef, tracks => [] },
339   { year => 1977, single_track => undef, tracks => [] },
340   {
341     year => 1978,
342     single_track => {
343       trackid => 6,
344       cd => {
345         artist => {
346           artistid => 1, cds => [
347             { cdid => 4, genreid => undef, year => 1977, tracks => [] },
348             { cdid => 5, genreid => undef, year => 1977, tracks => [] },
349             { cdid => 6, genreid => undef, year => 1977, tracks => [] },
350             { cdid => 3, genreid => 1, year => 1978, tracks => [
351               { title => "e1" },
352               { title => "e2" },
353               { title => "e3" },
354             ]},
355             { cdid => 1, genreid => 1, year => 1981, tracks => [
356               { title => "m1" },
357               { title => "m2" },
358               { title => "m3" },
359               { title => "m4" },
360             ]},
361             { cdid => 2, genreid => undef, year => 1976, tracks => [
362               { title => "o1" },
363               { title => "o2" },
364             ]},
365           ]
366         },
367       },
368     },
369     tracks => [
370       { cd => 3, title => "e1" },
371       { cd => 3, title => "e2" },
372       { cd => 3, title => "e3" },
373     ],
374   },
375   { year => 1981, single_track => undef, tracks => [
376     { cd => 1, title => "m1" },
377     { cd => 1, title => "m2" },
378     { cd => 1, title => "m3" },
379     { cd => 1, title => "m4" },
380   ]},
381 );
382
383 cmp_deeply (\@hris_all, \@hri_contents, 'W00T, multi-has_many manual underdefined root prefetch with collapse works');
384
385 cmp_deeply(
386   $rs->search({}, {
387     order_by => [ 'me.year', 'tracks_2.title', 'tracks.title', 'cds.cdid', { -desc => 'name' } ],
388     rows => 4,
389     offset => 2,
390   })->all_hri,
391   [ @hri_contents[2..5] ],
392   'multi-has_many prefetch with limit works too',
393 );
394
395 # left-ordered real iterator
396 $rs = $rs->search({}, { order_by => [ 'me.year', 'me.cdid', \ 'RANDOM()' ] });
397 my @objs_iter;
398 while (my $r = $rs->next) {
399   push @objs_iter, $r;
400 }
401
402 for my $i (0 .. $#objs_iter) {
403   is ($objs_iter[$i]->year, $hris_all[$i]{year}, "Expected year on object $i" );
404   is (
405     (defined $objs_iter[$i]->single_track),
406     (defined $hris_all[$i]{single_track}),
407     "Expected single relation on object $i"
408   );
409 }
410
411 $rs = $schema->resultset('Artist')->search({}, {
412   join => 'cds',
413   columns => ['cds.title', 'cds.artist' ],
414   collapse => 1,
415   order_by => [qw( me.name cds.title )],
416 });
417
418 $rs->create({ name => "${_}_cdless" })
419   for (qw( Z A ));
420
421 cmp_deeply (
422   $rs->all_hri,
423   [
424     { cds => [] },
425     { cds => [
426       { artist => 1, title => "Equinoxe" },
427       { artist => 1, title => "Magnetic Fields" },
428       { artist => 1, title => "Oxygene" },
429       { artist => 1, title => "fuzzy_1" },
430       { artist => 1, title => "fuzzy_2" },
431       { artist => 1, title => "fuzzy_3" },
432     ] },
433     { cds => [] },
434   ],
435   'Expected HRI of 1:M with empty root selection',
436 );
437
438 done_testing;