Retire DBIC::DebugObj, replace with $dbictest_schema->is_executed_sql_bind()
[dbsrgits/DBIx-Class.git] / t / resultset / update_delete.t
1 use strict;
2 use warnings;
3
4 use lib qw(t/lib);
5 use Test::More;
6 use Test::Exception;
7
8 use DBICTest::Schema::CD;
9 BEGIN {
10   # the default scalarref table name will not work well for this test
11   DBICTest::Schema::CD->table('cd');
12 }
13
14 use DBICTest;
15
16 my $schema = DBICTest->init_schema;
17
18 my $tkfks = $schema->resultset('FourKeys_to_TwoKeys');
19
20 my ($fa, $fb, $fc) = $tkfks->related_resultset ('fourkeys')->populate ([
21   [qw/foo bar hello goodbye sensors read_count/],
22   [qw/1   1   1     1       a       10         /],
23   [qw/2   2   2     2       b       20         /],
24   [qw/1   1   1     2       c       30         /],
25 ]);
26
27 # This is already provided by DBICTest
28 #my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([
29 #  [qw/artist  cd /],
30 #  [qw/1       1  /],
31 #  [qw/2       2  /],
32 #]);
33 my ($ta, $tb) = $schema->resultset ('TwoKeys')
34                   ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ])
35                     ->all;
36
37 my $tkfk_cnt = $tkfks->count;
38
39 my $non_void_ctx = $tkfks->populate ([
40   { autopilot => 'a', fourkeys =>  $fa, twokeys => $ta, pilot_sequence => 10 },
41   { autopilot => 'b', fourkeys =>  $fb, twokeys => $tb, pilot_sequence => 20 },
42   { autopilot => 'x', fourkeys =>  $fa, twokeys => $tb, pilot_sequence => 30 },
43   { autopilot => 'y', fourkeys =>  $fb, twokeys => $ta, pilot_sequence => 40 },
44 ]);
45 is ($tkfks->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully');
46
47 #
48 # Make sure the forced group by works (i.e. the joining does not cause double-updates)
49 #
50
51 # create a resultset matching $fa and $fb only
52 my $fks = $schema->resultset ('FourKeys')->search (
53   {
54     sensors => { '!=', 'c' },
55     ( map { $_ => [1, 2] } qw/foo bar hello goodbye/ ),
56   }, { join => { fourkeys_to_twokeys => 'twokeys' }}
57 );
58
59 is ($fks->count, 4, 'Joined FourKey count correct (2x2)');
60 $schema->is_executed_sql_bind( sub {
61   $fks->update ({ read_count => \ 'read_count + 1' })
62 }, [[
63   'UPDATE fourkeys
64    SET read_count = read_count + 1
65    WHERE ( ( ( bar = ? OR bar = ? ) AND ( foo = ? OR foo = ? ) AND ( goodbye = ? OR goodbye = ? ) AND ( hello = ? OR hello = ? ) AND sensors != ? ) )
66   ',
67   (1, 2) x 4,
68   'c',
69 ]], 'Correct update-SQL with multijoin with pruning' );
70
71 is ($fa->discard_changes->read_count, 11, 'Update ran only once on discard-join resultset');
72 is ($fb->discard_changes->read_count, 21, 'Update ran only once on discard-join resultset');
73 is ($fc->discard_changes->read_count, 30, 'Update did not touch outlier');
74
75 # make the multi-join stick
76 my $fks_multi = $fks->search({ 'fourkeys_to_twokeys.pilot_sequence' => { '!=' => 666 } });
77 $schema->is_executed_sql_bind( sub {
78   $fks_multi->update ({ read_count => \ 'read_count + 1' })
79 }, [
80   [ 'BEGIN' ],
81   [
82     'SELECT me.foo, me.bar, me.hello, me.goodbye
83       FROM fourkeys me
84       LEFT JOIN fourkeys_to_twokeys fourkeys_to_twokeys
85         ON fourkeys_to_twokeys.f_bar = me.bar AND fourkeys_to_twokeys.f_foo = me.foo AND fourkeys_to_twokeys.f_goodbye = me.goodbye AND fourkeys_to_twokeys.f_hello = me.hello
86       WHERE ( bar = ? OR bar = ? ) AND ( foo = ? OR foo = ? ) AND fourkeys_to_twokeys.pilot_sequence != ? AND ( goodbye = ? OR goodbye = ? ) AND ( hello = ? OR hello = ? ) AND sensors != ?
87       GROUP BY me.foo, me.bar, me.hello, me.goodbye
88     ',
89     (1, 2) x 2,
90     666,
91     (1, 2) x 2,
92     'c',
93   ],
94   [
95     'UPDATE fourkeys
96      SET read_count = read_count + 1
97      WHERE ( bar = ? AND foo = ? AND goodbye = ? AND hello = ? ) OR ( bar = ? AND foo = ? AND goodbye = ? AND hello = ? )
98     ',
99     ( (1) x 4, (2) x 4 ),
100   ],
101   [ 'COMMIT' ],
102 ], 'Correct update-SQL with multijoin without pruning' );
103
104 is ($fa->discard_changes->read_count, 12, 'Update ran only once on joined resultset');
105 is ($fb->discard_changes->read_count, 22, 'Update ran only once on joined resultset');
106 is ($fc->discard_changes->read_count, 30, 'Update did not touch outlier');
107
108 # try the same sql with forced multicolumn in
109 $schema->is_executed_sql_bind( sub {
110   local $schema->storage->{_use_multicolumn_in} = 1;
111
112   # this can't actually execute on sqlite
113   eval { $fks_multi->update ({ read_count => \ 'read_count + 1' }) };
114 }, [[
115   'UPDATE fourkeys
116     SET read_count = read_count + 1
117     WHERE (
118       (foo, bar, hello, goodbye) IN (
119         SELECT me.foo, me.bar, me.hello, me.goodbye
120           FROM fourkeys me
121           LEFT JOIN fourkeys_to_twokeys fourkeys_to_twokeys ON
122                 fourkeys_to_twokeys.f_bar = me.bar
123             AND fourkeys_to_twokeys.f_foo = me.foo
124             AND fourkeys_to_twokeys.f_goodbye = me.goodbye
125             AND fourkeys_to_twokeys.f_hello = me.hello
126         WHERE ( bar = ? OR bar = ? ) AND ( foo = ? OR foo = ? ) AND fourkeys_to_twokeys.pilot_sequence != ? AND ( goodbye = ? OR goodbye = ? ) AND ( hello = ? OR hello = ? ) AND sensors != ?
127       )
128     )
129   ',
130   ( 1, 2) x 2,
131   666,
132   ( 1, 2) x 2,
133   'c',
134 ]], 'Correct update-SQL with multicolumn in support' );
135
136 $schema->is_executed_sql_bind( sub {
137   $fks->search({ 'twokeys.artist' => { '!=' => 666 } })->update({ read_count => \ 'read_count + 1' });
138 }, [
139   [ 'BEGIN' ],
140   [
141     'SELECT me.foo, me.bar, me.hello, me.goodbye
142       FROM fourkeys me
143       LEFT JOIN fourkeys_to_twokeys fourkeys_to_twokeys
144         ON fourkeys_to_twokeys.f_bar = me.bar AND fourkeys_to_twokeys.f_foo = me.foo AND fourkeys_to_twokeys.f_goodbye = me.goodbye AND fourkeys_to_twokeys.f_hello = me.hello
145       LEFT JOIN twokeys twokeys
146         ON twokeys.artist = fourkeys_to_twokeys.t_artist AND twokeys.cd = fourkeys_to_twokeys.t_cd
147       WHERE ( bar = ? OR bar = ? ) AND ( foo = ? OR foo = ? ) AND ( goodbye = ? OR goodbye = ? ) AND ( hello = ? OR hello = ? ) AND sensors != ? AND twokeys.artist != ?
148       GROUP BY me.foo, me.bar, me.hello, me.goodbye
149     ',
150     (1, 2) x 4,
151     'c',
152     666,
153   ],
154   [
155     'UPDATE fourkeys
156      SET read_count = read_count + 1
157      WHERE ( bar = ? AND foo = ? AND goodbye = ? AND hello = ? ) OR ( bar = ? AND foo = ? AND goodbye = ? AND hello = ? )
158     ',
159     ( (1) x 4, (2) x 4 ),
160   ],
161   [ 'COMMIT' ],
162 ], 'Correct update-SQL with premultiplied restricting join without pruning' );
163
164 is ($fa->discard_changes->read_count, 13, 'Update ran only once on joined resultset');
165 is ($fb->discard_changes->read_count, 23, 'Update ran only once on joined resultset');
166 is ($fc->discard_changes->read_count, 30, 'Update did not touch outlier');
167
168 #
169 # Make sure multicolumn in or the equivalent functions correctly
170 #
171
172 my $sub_rs = $tkfks->search (
173   [
174     { map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
175     { map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
176   ],
177   {
178     join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ],
179   },
180 );
181
182 is ($sub_rs->count, 2, 'Only two rows from fourkeys match');
183
184 # attempts to delete a grouped rs should fail miserably
185 throws_ok (
186   sub { $sub_rs->search ({}, { distinct => 1 })->delete },
187   qr/attempted a delete operation on a resultset which does group_by/,
188   'Grouped rs update/delete not allowed',
189 );
190
191 # grouping on PKs only should pass
192 $sub_rs->search (
193   {},
194   {
195     group_by => [ reverse $sub_rs->result_source->primary_columns ],     # reverse to make sure the PK-list comparison works
196   },
197 )->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
198
199 is_deeply (
200   [ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' })
201             ->get_column ('pilot_sequence')->all
202   ],
203   [qw/11 21 30 40/],
204   'Only two rows incremented',
205 );
206
207 # also make sure weird scalarref usage works (RT#51409)
208 $tkfks->search (
209   \ 'pilot_sequence BETWEEN 11 AND 21',
210 )->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
211
212 is_deeply (
213   [ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' })
214             ->get_column ('pilot_sequence')->all
215   ],
216   [qw/12 22 30 40/],
217   'Only two rows incremented (where => scalarref works)',
218 );
219
220 {
221   my $rs = $schema->resultset('FourKeys_to_TwoKeys')->search (
222     {
223       -or => [
224         { 'me.pilot_sequence' => 12 },
225         { 'me.autopilot'      => 'b' },
226       ],
227     }
228   );
229   lives_ok { $rs->update({ autopilot => 'z' }) }
230     'Update with table name qualifier in -or conditions lives';
231   is_deeply (
232     [ $tkfks->search ({ pilot_sequence => [12, 22]})
233               ->get_column ('autopilot')->all
234     ],
235     [qw/z z/],
236     '... and yields the right data',
237   );
238 }
239
240
241 $sub_rs->delete;
242 is ($tkfks->count, $tkfk_cnt -= 2, 'Only two rows deleted');
243
244 # make sure limit-only deletion works
245 cmp_ok ($tkfk_cnt, '>', 1, 'More than 1 row left');
246 $tkfks->search ({}, { rows => 1 })->delete;
247 is ($tkfks->count, $tkfk_cnt -= 1, 'Only one row deleted');
248
249
250 # check with sql-equality, as sqlite will accept most bad sql just fine
251 {
252   my $rs = $schema->resultset('CD')->search(
253     { 'me.year' => { '!=' => 2010 } },
254   );
255
256   $schema->is_executed_sql_bind( sub {
257     $rs->search({}, { join => 'liner_notes' })->delete;
258   }, [[
259     'DELETE FROM cd WHERE ( year != ? )',
260     2010,
261   ]], 'Non-restricting multijoins properly thrown out' );
262
263   $schema->is_executed_sql_bind( sub {
264     $rs->search({}, { prefetch => 'liner_notes' })->delete;
265   }, [[
266     'DELETE FROM cd WHERE ( year != ? )',
267     2010,
268   ]], 'Non-restricting multiprefetch thrown out' );
269
270   $schema->is_executed_sql_bind( sub {
271     $rs->search({}, { prefetch => 'artist' })->delete;
272   }, [[
273     'DELETE FROM cd WHERE ( cdid IN ( SELECT me.cdid FROM cd me JOIN artist artist ON artist.artistid = me.artist WHERE ( me.year != ? ) ) )',
274     2010,
275   ]], 'Restricting prefetch left in, selector thrown out');
276
277 ### switch artist and cd to fully qualified table names
278 ### make sure nothing is stripped out
279   my $cd_rsrc = $schema->source('CD');
280   $cd_rsrc->name('main.cd');
281   $cd_rsrc->relationship_info($_)->{attrs}{cascade_delete} = 0
282     for $cd_rsrc->relationships;
283
284   my $art_rsrc = $schema->source('Artist');
285   $art_rsrc->name(\'main.artist');
286   $art_rsrc->relationship_info($_)->{attrs}{cascade_delete} = 0
287     for $art_rsrc->relationships;
288
289   $schema->is_executed_sql_bind( sub {
290     $rs->delete
291   }, [[
292     'DELETE FROM main.cd WHERE year != ?',
293     2010,
294   ]], 'delete with fully qualified table name' );
295
296   $rs->create({ title => 'foo', artist => 1, year => 2000 });
297   $schema->is_executed_sql_bind( sub {
298     $rs->delete_all
299   }, [
300     [ 'BEGIN' ],
301     [
302       'SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM main.cd me WHERE me.year != ?',
303       2010,
304     ],
305     [
306       'DELETE FROM main.cd WHERE ( cdid = ? )',
307       1,
308     ],
309     [ 'COMMIT' ],
310   ], 'delete_all with fully qualified table name' );
311
312   $rs->create({ cdid => 42, title => 'foo', artist => 2, year => 2000 });
313   my $cd42 = $rs->find(42);
314
315   $schema->is_executed_sql_bind( sub {
316     $cd42->delete
317   }, [[
318     'DELETE FROM main.cd WHERE cdid = ?',
319     42,
320   ]], 'delete of object from table with fully qualified name' );
321
322   $schema->is_executed_sql_bind( sub {
323     $cd42->related_resultset('artist')->delete
324   }, [[
325     'DELETE FROM main.artist WHERE ( artistid IN ( SELECT me.artistid FROM main.artist me WHERE ( me.artistid = ? ) ) )',
326     2,
327   ]], 'delete of related object from scalarref fully qualified named table' );
328
329   my $art3 = $schema->resultset('Artist')->find(3);
330
331   $schema->is_executed_sql_bind( sub {
332     $art3->related_resultset('cds')->delete;
333   }, [[
334     'DELETE FROM main.cd WHERE ( artist = ? )',
335     3,
336   ]], 'delete of related object from fully qualified named table' );
337
338   $schema->is_executed_sql_bind( sub {
339     $art3->cds_unordered->delete;
340   }, [[
341     'DELETE FROM main.cd WHERE ( artist = ? )',
342     3,
343   ]], 'delete of related object from fully qualified named table via relaccessor' );
344
345   $schema->is_executed_sql_bind( sub {
346     $rs->search({}, { prefetch => 'artist' })->delete;
347   }, [[
348     'DELETE FROM main.cd WHERE ( cdid IN ( SELECT me.cdid FROM main.cd me JOIN main.artist artist ON artist.artistid = me.artist WHERE ( me.year != ? ) ) )',
349     2010,
350   ]], 'delete with fully qualified table name and subquery correct' );
351
352   # check that as_subselect_rs works ok
353   # inner query is untouched, then a selector
354   # and an IN condition
355   $schema->is_executed_sql_bind( sub {
356     $schema->resultset('CD')->search({
357       'me.cdid' => 1,
358       'artist.name' => 'partytimecity',
359     }, {
360       join => 'artist',
361     })->as_subselect_rs->delete;
362   }, [[
363     '
364       DELETE FROM main.cd
365       WHERE (
366         cdid IN (
367           SELECT me.cdid
368             FROM (
369               SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
370                 FROM main.cd me
371                 JOIN main.artist artist ON artist.artistid = me.artist
372               WHERE artist.name = ? AND me.cdid = ?
373             ) me
374         )
375       )
376     ',
377     'partytimecity',
378     1,
379   ]], 'Delete from as_subselect_rs works correctly' );
380 }
381
382 done_testing;