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 | |
9 | #plan tests => 5; |
10 | plan 'no_plan'; |
11 | |
12 | my $schema = DBICTest->init_schema(); |
13 | |
14 | my $tkfks = $schema->resultset('FourKeys_to_TwoKeys'); |
15 | |
16 | warn "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"; |
17 | |
18 | my ($fa, $fb) = $tkfks->related_resultset ('fourkeys')->populate ([ |
19 | [qw/foo bar hello goodbye sensors read_count/], |
20 | [qw/1 1 1 1 a 10 /], |
21 | [qw/2 2 2 2 b 20 /], |
22 | ]); |
23 | |
24 | # This is already provided by DBICTest |
25 | #my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([ |
26 | # [qw/artist cd /], |
27 | # [qw/1 1 /], |
28 | # [qw/2 2 /], |
29 | #]); |
30 | my ($ta, $tb) = $schema->resultset ('TwoKeys') |
31 | ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ]) |
32 | ->all; |
33 | |
34 | my $tkfk_cnt = $tkfks->count; |
35 | |
36 | my $non_void_ctx = $tkfks->populate ([ |
37 | { autopilot => 'a', fourkeys => $fa, twokeys => $ta, pilot_sequence => 10 }, |
38 | { autopilot => 'b', fourkeys => $fb, twokeys => $tb, pilot_sequence => 20 }, |
39 | { autopilot => 'x', fourkeys => $fa, twokeys => $tb, pilot_sequence => 30 }, |
40 | { autopilot => 'y', fourkeys => $fb, twokeys => $ta, pilot_sequence => 40 }, |
41 | ]); |
42 | is ($tkfks->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully'); |
43 | |
44 | # |
45 | # Make sure the forced group by works (i.e. the joining does not cause double-updates) |
46 | # |
47 | |
48 | # create a resultset matching $fa and $fb only |
49 | my $fks = $schema->resultset ('FourKeys') |
50 | ->search ({ map { $_ => [1, 2] } qw/foo bar hello goodbye/}, { join => 'fourkeys_to_twokeys' }); |
51 | |
52 | is ($fks->count, 4, 'Joined FourKey count correct (2x2)'); |
53 | $fks->update ({ read_count => \ 'read_count + 1' }); |
54 | $_->discard_changes for ($fa, $fb); |
55 | |
56 | is ($fa->read_count, 11, 'Update ran only once on joined resultset'); |
57 | is ($fb->read_count, 21, 'Update ran only once on joined resultset'); |
58 | |
59 | |
60 | # |
61 | # Make sure multicolumn in or the equivalen functions correctly |
62 | # |
63 | |
64 | my $sub_rs = $tkfks->search ( |
65 | [ |
66 | { map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ }, |
67 | { map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ }, |
68 | ], |
69 | { |
70 | join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ], |
71 | }, |
72 | ); |
73 | |
74 | is ($sub_rs->count, 2, 'Only two rows from fourkeys match'); |
75 | |
76 | # attempts to delete a grouped rs should fail miserably |
77 | throws_ok ( |
78 | sub { $sub_rs->search ({}, { distinct => 1 })->delete }, |
79 | qr/attempted a delete operation on a resultset which does group_by/, |
80 | 'Grouped rs update/delete not allowed', |
81 | ); |
82 | |
83 | # grouping on PKs only should pass |
84 | $sub_rs->search ({}, { group_by => [ reverse $sub_rs->result_source->primary_columns ] }) # reverse to make sure the comaprison works |
85 | ->update ({ pilot_sequence => \ 'pilot_sequence + 1' }); |
86 | |
87 | is_deeply ( |
88 | [ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' }) |
89 | ->get_column ('pilot_sequence')->all |
90 | ], |
91 | [qw/11 21 30 40/], |
92 | 'Only two rows incremented', |
93 | ); |
94 | |
95 | $sub_rs->delete; |
96 | |
97 | is ($tkfks->count, $tkfk_cnt -= 2, 'Only two rows deleted'); |