Commit | Line | Data |
ff1234ad |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use lib qw(t/lib); |
5 | use Test::More; |
6 | use Test::Exception; |
7 | use DBICTest; |
8 | |
ff1234ad |
9 | my $schema = DBICTest->init_schema(); |
10 | |
11 | my $tkfks = $schema->resultset('FourKeys_to_TwoKeys'); |
12 | |
ff1234ad |
13 | my ($fa, $fb) = $tkfks->related_resultset ('fourkeys')->populate ([ |
14 | [qw/foo bar hello goodbye sensors read_count/], |
15 | [qw/1 1 1 1 a 10 /], |
16 | [qw/2 2 2 2 b 20 /], |
17 | ]); |
18 | |
19 | # This is already provided by DBICTest |
20 | #my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([ |
21 | # [qw/artist cd /], |
22 | # [qw/1 1 /], |
23 | # [qw/2 2 /], |
24 | #]); |
25 | my ($ta, $tb) = $schema->resultset ('TwoKeys') |
26 | ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ]) |
27 | ->all; |
28 | |
29 | my $tkfk_cnt = $tkfks->count; |
30 | |
31 | my $non_void_ctx = $tkfks->populate ([ |
32 | { autopilot => 'a', fourkeys => $fa, twokeys => $ta, pilot_sequence => 10 }, |
33 | { autopilot => 'b', fourkeys => $fb, twokeys => $tb, pilot_sequence => 20 }, |
34 | { autopilot => 'x', fourkeys => $fa, twokeys => $tb, pilot_sequence => 30 }, |
35 | { autopilot => 'y', fourkeys => $fb, twokeys => $ta, pilot_sequence => 40 }, |
36 | ]); |
37 | is ($tkfks->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully'); |
38 | |
39 | # |
40 | # Make sure the forced group by works (i.e. the joining does not cause double-updates) |
41 | # |
42 | |
43 | # create a resultset matching $fa and $fb only |
44 | my $fks = $schema->resultset ('FourKeys') |
45 | ->search ({ map { $_ => [1, 2] } qw/foo bar hello goodbye/}, { join => 'fourkeys_to_twokeys' }); |
46 | |
47 | is ($fks->count, 4, 'Joined FourKey count correct (2x2)'); |
48 | $fks->update ({ read_count => \ 'read_count + 1' }); |
49 | $_->discard_changes for ($fa, $fb); |
50 | |
51 | is ($fa->read_count, 11, 'Update ran only once on joined resultset'); |
52 | is ($fb->read_count, 21, 'Update ran only once on joined resultset'); |
53 | |
54 | |
55 | # |
56 | # Make sure multicolumn in or the equivalen functions correctly |
57 | # |
58 | |
59 | my $sub_rs = $tkfks->search ( |
60 | [ |
61 | { map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ }, |
62 | { map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ }, |
63 | ], |
64 | { |
65 | join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ], |
66 | }, |
67 | ); |
68 | |
69 | is ($sub_rs->count, 2, 'Only two rows from fourkeys match'); |
70 | |
71 | # attempts to delete a grouped rs should fail miserably |
72 | throws_ok ( |
73 | sub { $sub_rs->search ({}, { distinct => 1 })->delete }, |
74 | qr/attempted a delete operation on a resultset which does group_by/, |
75 | 'Grouped rs update/delete not allowed', |
76 | ); |
77 | |
78 | # grouping on PKs only should pass |
af668ad6 |
79 | $sub_rs->search ( |
80 | {}, |
81 | { |
82 | group_by => [ reverse $sub_rs->result_source->primary_columns ], # reverse to make sure the PK-list comaprison works |
83 | }, |
84 | )->update ({ pilot_sequence => \ 'pilot_sequence + 1' }); |
ff1234ad |
85 | |
86 | is_deeply ( |
87 | [ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' }) |
88 | ->get_column ('pilot_sequence')->all |
89 | ], |
90 | [qw/11 21 30 40/], |
91 | 'Only two rows incremented', |
92 | ); |
93 | |
af668ad6 |
94 | # also make sure weird scalarref usage works (RT#51409) |
95 | $tkfks->search ( |
96 | \ 'pilot_sequence BETWEEN 11 AND 21', |
97 | )->update ({ pilot_sequence => \ 'pilot_sequence + 1' }); |
98 | |
99 | is_deeply ( |
100 | [ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' }) |
101 | ->get_column ('pilot_sequence')->all |
102 | ], |
103 | [qw/12 22 30 40/], |
104 | 'Only two rows incremented (where => scalarref works)', |
105 | ); |
106 | |
ff1234ad |
107 | $sub_rs->delete; |
108 | |
109 | is ($tkfks->count, $tkfk_cnt -= 2, 'Only two rows deleted'); |
fef47a8e |
110 | |
111 | # make sure limit-only deletion works |
112 | cmp_ok ($tkfk_cnt, '>', 1, 'More than 1 row left'); |
113 | $tkfks->search ({}, { rows => 1 })->delete; |
114 | is ($tkfks->count, $tkfk_cnt -= 1, 'Only one row deleted'); |
115 | |
116 | done_testing; |