1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
use strict;
use warnings;
use lib qw(t/lib);
use Test::More;
use Test::Exception;
use DBICTest;
use DBIC::DebugObj;
use DBIC::SqlMakerTest;
my $schema = DBICTest->init_schema();
my $tkfks = $schema->resultset('FourKeys_to_TwoKeys');
my ($fa, $fb) = $tkfks->related_resultset ('fourkeys')->populate ([
[qw/foo bar hello goodbye sensors read_count/],
[qw/1 1 1 1 a 10 /],
[qw/2 2 2 2 b 20 /],
]);
# This is already provided by DBICTest
#my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([
# [qw/artist cd /],
# [qw/1 1 /],
# [qw/2 2 /],
#]);
my ($ta, $tb) = $schema->resultset ('TwoKeys')
->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ])
->all;
my $tkfk_cnt = $tkfks->count;
my $non_void_ctx = $tkfks->populate ([
{ autopilot => 'a', fourkeys => $fa, twokeys => $ta, pilot_sequence => 10 },
{ autopilot => 'b', fourkeys => $fb, twokeys => $tb, pilot_sequence => 20 },
{ autopilot => 'x', fourkeys => $fa, twokeys => $tb, pilot_sequence => 30 },
{ autopilot => 'y', fourkeys => $fb, twokeys => $ta, pilot_sequence => 40 },
]);
is ($tkfks->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully');
#
# Make sure the forced group by works (i.e. the joining does not cause double-updates)
#
# create a resultset matching $fa and $fb only
my $fks = $schema->resultset ('FourKeys')
->search ({ map { $_ => [1, 2] } qw/foo bar hello goodbye/}, { join => 'fourkeys_to_twokeys' });
is ($fks->count, 4, 'Joined FourKey count correct (2x2)');
$fks->update ({ read_count => \ 'read_count + 1' });
$_->discard_changes for ($fa, $fb);
is ($fa->read_count, 11, 'Update ran only once on joined resultset');
is ($fb->read_count, 21, 'Update ran only once on joined resultset');
#
# Make sure multicolumn in or the equivalen functions correctly
#
my $sub_rs = $tkfks->search (
[
{ map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
{ map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
],
{
join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ],
},
);
is ($sub_rs->count, 2, 'Only two rows from fourkeys match');
# attempts to delete a grouped rs should fail miserably
throws_ok (
sub { $sub_rs->search ({}, { distinct => 1 })->delete },
qr/attempted a delete operation on a resultset which does group_by/,
'Grouped rs update/delete not allowed',
);
# grouping on PKs only should pass
$sub_rs->search (
{},
{
group_by => [ reverse $sub_rs->result_source->primary_columns ], # reverse to make sure the PK-list comaprison works
},
)->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
is_deeply (
[ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' })
->get_column ('pilot_sequence')->all
],
[qw/11 21 30 40/],
'Only two rows incremented',
);
# also make sure weird scalarref usage works (RT#51409)
$tkfks->search (
\ 'pilot_sequence BETWEEN 11 AND 21',
)->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
is_deeply (
[ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' })
->get_column ('pilot_sequence')->all
],
[qw/12 22 30 40/],
'Only two rows incremented (where => scalarref works)',
);
$sub_rs->delete;
is ($tkfks->count, $tkfk_cnt -= 2, 'Only two rows deleted');
# make sure limit-only deletion works
cmp_ok ($tkfk_cnt, '>', 1, 'More than 1 row left');
$tkfks->search ({}, { rows => 1 })->delete;
is ($tkfks->count, $tkfk_cnt -= 1, 'Only one row deleted');
# Make sure prefetch is properly stripped too
# check with sql-equality, as sqlite will accept bad sql just fine
my ($sql, @bind);
my $orig_debugobj = $schema->storage->debugobj;
my $orig_debug = $schema->storage->debug;
$schema->storage->debugobj (DBIC::DebugObj->new (\$sql, \@bind) );
$schema->storage->debug (1);
$schema->resultset('CD')->search(
{ year => { '!=' => 2010 } },
{ prefetch => 'liner_notes' },
)->delete;
$schema->storage->debugobj ($orig_debugobj);
$schema->storage->debug ($orig_debug);
is_same_sql_bind (
$sql,
\@bind,
'DELETE FROM cd WHERE ( cdid IN ( SELECT me.cdid FROM cd me WHERE ( year != ? ) GROUP BY me.cdid ) )',
["'2010'"],
'Update on prefetching resultset strips prefetch correctly'
);
done_testing;
|
