do not use "me" on the related_resultset pessimization
[dbsrgits/DBIx-Class-Historic.git] / t / 100populate.t
CommitLineData
54e0bd06 1use strict;
d35a6fed 2use warnings;
54e0bd06 3
4use Test::More;
d35a6fed 5use Test::Exception;
54e0bd06 6use lib qw(t/lib);
7use DBICTest;
c0d8cb1f 8use Path::Class::File ();
569b9fe6 9use List::Util qw/shuffle/;
54e0bd06 10
54e0bd06 11my $schema = DBICTest->init_schema();
54e0bd06 12
d35a6fed 13# The map below generates stuff like:
14# [ qw/artistid name/ ],
15# [ 4, "b" ],
16# [ 5, "c" ],
17# ...
18# [ 9999, "ntm" ],
19# [ 10000, "ntn" ],
20
21my $start_id = 'populateXaaaaaa';
569b9fe6 22my $rows = 10_000;
d35a6fed 23my $offset = 3;
24
569b9fe6 25$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } shuffle ( 1 .. $rows ) ] );
d35a6fed 26is (
27 $schema->resultset ('Artist')->search ({ name => { -like => 'populateX%' } })->count,
28 $rows,
29 'populate created correct number of rows with massive AoA bulk insert',
30);
31
32my $artist = $schema->resultset ('Artist')
33 ->search ({ 'cds.title' => { '!=', undef } }, { join => 'cds' })
34 ->first;
35my $ex_title = $artist->cds->first->title;
36
37throws_ok ( sub {
38 my $i = 600;
39 $schema->populate('CD', [
40 map {
41 {
d35a6fed 42 artist => $artist->id,
43 title => $_,
44 year => 2009,
45 }
46 } ('Huey', 'Dewey', $ex_title, 'Louie')
47 ])
48}, qr/columns .+ are not unique for populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
b0457415 49
89b2e3e4 50## make sure populate honors fields/orders in list context
b0457415 51## schema order
89b2e3e4 52my @links = $schema->populate('Link', [
b0457415 53[ qw/id url title/ ],
54[ qw/2 burl btitle/ ]
55]);
89b2e3e4 56is(scalar @links, 1);
57
58my $link2 = shift @links;
b0457415 59is($link2->id, 2, 'Link 2 id');
60is($link2->url, 'burl', 'Link 2 url');
61is($link2->title, 'btitle', 'Link 2 title');
62
63## non-schema order
89b2e3e4 64@links = $schema->populate('Link', [
b0457415 65[ qw/id title url/ ],
66[ qw/3 ctitle curl/ ]
67]);
89b2e3e4 68is(scalar @links, 1);
69
70my $link3 = shift @links;
b0457415 71is($link3->id, 3, 'Link 3 id');
72is($link3->url, 'curl', 'Link 3 url');
73is($link3->title, 'ctitle', 'Link 3 title');
74
75## not all physical columns
89b2e3e4 76@links = $schema->populate('Link', [
b0457415 77[ qw/id title/ ],
78[ qw/4 dtitle/ ]
79]);
89b2e3e4 80is(scalar @links, 1);
81
82my $link4 = shift @links;
b0457415 83is($link4->id, 4, 'Link 4 id');
84is($link4->url, undef, 'Link 4 url');
85is($link4->title, 'dtitle', 'Link 4 title');
86
87
89b2e3e4 88## make sure populate -> insert_bulk honors fields/orders in void context
89## schema order
90$schema->populate('Link', [
91[ qw/id url title/ ],
92[ qw/5 eurl etitle/ ]
93]);
94my $link5 = $schema->resultset('Link')->find(5);
95is($link5->id, 5, 'Link 5 id');
96is($link5->url, 'eurl', 'Link 5 url');
97is($link5->title, 'etitle', 'Link 5 title');
98
99## non-schema order
100$schema->populate('Link', [
101[ qw/id title url/ ],
102[ qw/6 ftitle furl/ ]
103]);
104my $link6 = $schema->resultset('Link')->find(6);
105is($link6->id, 6, 'Link 6 id');
106is($link6->url, 'furl', 'Link 6 url');
107is($link6->title, 'ftitle', 'Link 6 title');
108
109## not all physical columns
110$schema->populate('Link', [
111[ qw/id title/ ],
112[ qw/7 gtitle/ ]
113]);
114my $link7 = $schema->resultset('Link')->find(7);
115is($link7->id, 7, 'Link 7 id');
116is($link7->url, undef, 'Link 7 url');
117is($link7->title, 'gtitle', 'Link 7 title');
118
84f7e8a1 119# populate with literals
120{
121 my $rs = $schema->resultset('Link');
122 $rs->delete;
aac0bfd0 123
84f7e8a1 124 # test _execute_array_empty (insert_bulk with all literal sql)
aac0bfd0 125
84f7e8a1 126 $rs->populate([
574d7df6 127 (+{
84f7e8a1 128 url => \"'cpan.org'",
129 title => \"'The ''best of'' cpan'",
574d7df6 130 }) x 5
84f7e8a1 131 ]);
574d7df6 132
84f7e8a1 133 is((grep {
134 $_->url eq 'cpan.org' &&
135 $_->title eq "The 'best of' cpan",
136 } $rs->all), 5, 'populate with all literal SQL');
bbd6f348 137
84f7e8a1 138 $rs->delete;
bbd6f348 139
84f7e8a1 140 # test mixed binds with literal sql
aac0bfd0 141
84f7e8a1 142 $rs->populate([
aac0bfd0 143 (+{
84f7e8a1 144 url => \"'cpan.org'",
145 title => "The 'best of' cpan",
aac0bfd0 146 }) x 5
84f7e8a1 147 ]);
aac0bfd0 148
84f7e8a1 149 is((grep {
150 $_->url eq 'cpan.org' &&
151 $_->title eq "The 'best of' cpan",
152 } $rs->all), 5, 'populate with all literal SQL');
aac0bfd0 153
84f7e8a1 154 $rs->delete;
155}
aac0bfd0 156
84f7e8a1 157my $rs = $schema->resultset('Artist');
158$rs->delete;
bbd6f348 159throws_ok {
160 $rs->populate([
161 {
162 artistid => 1,
163 name => 'foo1',
164 },
165 {
166 artistid => 'foo', # this dies
167 name => 'foo2',
168 },
169 {
170 artistid => 3,
171 name => 'foo3',
172 },
173 ]);
174} qr/slice/, 'bad slice';
175
176is($rs->count, 0, 'populate is atomic');
177
1295943f 178# Trying to use a column marked as a bind in the first slice with literal sql in
179# a later slice should throw.
180
181throws_ok {
182 $rs->populate([
183 {
184 artistid => 1,
185 name => \"'foo'",
186 },
187 {
188 artistid => \2,
189 name => \"'foo'",
190 }
191 ]);
192} qr/bind expected/, 'literal sql where bind expected throws';
193
194# ... and vice-versa.
195
196throws_ok {
197 $rs->populate([
198 {
199 artistid => \1,
200 name => \"'foo'",
201 },
202 {
203 artistid => 2,
204 name => \"'foo'",
205 }
206 ]);
207} qr/literal SQL expected/i, 'bind where literal sql expected throws';
208
209throws_ok {
210 $rs->populate([
211 {
212 artistid => 1,
213 name => \"'foo'",
214 },
215 {
216 artistid => 2,
217 name => \"'bar'",
218 }
219 ]);
220} qr/inconsistent/, 'literal sql must be the same in all slices';
221
c0d8cb1f 222# the stringification has nothing to do with the artist name
223# this is solely for testing consistency
224my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
225my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
226
227lives_ok {
228 $rs->populate([
229 {
230 name => 'supplied before stringifying object',
231 },
232 {
233 name => $fn,
234 }
235 ]);
236} 'stringifying objects pass through';
237
238# ... and vice-versa.
239
240lives_ok {
241 $rs->populate([
242 {
243 name => $fn2,
244 },
245 {
246 name => 'supplied after stringifying object',
247 },
248 ]);
249} 'stringifying objects pass through';
250
251for (
252 $fn,
253 $fn2,
254 'supplied after stringifying object',
255 'supplied before stringifying object'
256) {
257 my $row = $rs->find ({name => $_});
258 ok ($row, "Stringification test row '$_' properly inserted");
259}
260
8464d1a4 261$rs->delete;
262
263# test stringification with ->create rather than Storage::insert_bulk as well
264
265lives_ok {
266 my @dummy = $rs->populate([
267 {
268 name => 'supplied before stringifying object',
269 },
270 {
271 name => $fn,
272 }
273 ]);
274} 'stringifying objects pass through';
275
276# ... and vice-versa.
277
278lives_ok {
279 my @dummy = $rs->populate([
280 {
281 name => $fn2,
282 },
283 {
284 name => 'supplied after stringifying object',
285 },
286 ]);
287} 'stringifying objects pass through';
288
289for (
290 $fn,
291 $fn2,
292 'supplied after stringifying object',
293 'supplied before stringifying object'
294) {
295 my $row = $rs->find ({name => $_});
296 ok ($row, "Stringification test row '$_' properly inserted");
297}
298
18d80024 299lives_ok {
300 $schema->resultset('TwoKeys')->populate([{
301 artist => 1,
302 cd => 5,
303 fourkeys_to_twokeys => [{
304 f_foo => 1,
305 f_bar => 1,
306 f_hello => 1,
307 f_goodbye => 1,
308 autopilot => 'a',
309 },{
310 f_foo => 2,
311 f_bar => 2,
312 f_hello => 2,
313 f_goodbye => 2,
314 autopilot => 'b',
315 }]
316 }])
d6eda469 317} 'multicol-PK has_many populate works';
18d80024 318
d6170b26 319lives_ok ( sub {
320 $schema->populate('CD', [
321 {cdid => 10001, artist => $artist->id, title => 'Pretty Much Empty', year => 2011, tracks => []},
322 ])
323}, 'empty has_many relationship accepted by populate');
324
bbd6f348 325done_testing;