Test for restricted prefetch (now passing again after previous commit)
[dbsrgits/DBIx-Class.git] / t / 100populate.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use Test::Exception;
6 use lib qw(t/lib);
7 use DBICTest;
8 use Path::Class::File ();
9 use List::Util qw/shuffle/;
10
11 my $schema = DBICTest->init_schema();
12
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
21 my $start_id = 'populateXaaaaaa';
22 my $rows = 10_000;
23 my $offset = 3;
24
25 $schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } shuffle ( 1 .. $rows ) ] );
26 is (
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
32 my $artist = $schema->resultset ('Artist')
33               ->search ({ 'cds.title' => { '!=', undef } }, { join => 'cds' })
34                 ->first;
35 my $ex_title = $artist->cds->first->title;
36
37 throws_ok ( sub {
38   my $i = 600;
39   $schema->populate('CD', [
40     map {
41       {
42         artist => $artist->id,
43         title => $_,
44         year => 2009,
45       }
46     } ('Huey', 'Dewey', $ex_title, 'Louie')
47   ])
48 }, qr/\Qexecute_for_fetch() aborted with '\E.+ at populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
49
50 ## make sure populate honors fields/orders in list context
51 ## schema order
52 my @links = $schema->populate('Link', [
53 [ qw/id url title/ ],
54 [ qw/2 burl btitle/ ]
55 ]);
56 is(scalar @links, 1);
57
58 my $link2 = shift @links;
59 is($link2->id, 2, 'Link 2 id');
60 is($link2->url, 'burl', 'Link 2 url');
61 is($link2->title, 'btitle', 'Link 2 title');
62
63 ## non-schema order
64 @links = $schema->populate('Link', [
65 [ qw/id title url/ ],
66 [ qw/3 ctitle curl/ ]
67 ]);
68 is(scalar @links, 1);
69
70 my $link3 = shift @links;
71 is($link3->id, 3, 'Link 3 id');
72 is($link3->url, 'curl', 'Link 3 url');
73 is($link3->title, 'ctitle', 'Link 3 title');
74
75 ## not all physical columns
76 @links = $schema->populate('Link', [
77 [ qw/id title/ ],
78 [ qw/4 dtitle/ ]
79 ]);
80 is(scalar @links, 1);
81
82 my $link4 = shift @links;
83 is($link4->id, 4, 'Link 4 id');
84 is($link4->url, undef, 'Link 4 url');
85 is($link4->title, 'dtitle', 'Link 4 title');
86
87
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 ]);
94 my $link5 = $schema->resultset('Link')->find(5);
95 is($link5->id, 5, 'Link 5 id');
96 is($link5->url, 'eurl', 'Link 5 url');
97 is($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 ]);
104 my $link6 = $schema->resultset('Link')->find(6);
105 is($link6->id, 6, 'Link 6 id');
106 is($link6->url, 'furl', 'Link 6 url');
107 is($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 ]);
114 my $link7 = $schema->resultset('Link')->find(7);
115 is($link7->id, 7, 'Link 7 id');
116 is($link7->url, undef, 'Link 7 url');
117 is($link7->title, 'gtitle', 'Link 7 title');
118
119 # populate with literals
120 {
121   my $rs = $schema->resultset('Link');
122   $rs->delete;
123
124   # test insert_bulk with all literal sql (no binds)
125
126   $rs->populate([
127     (+{
128         url => \"'cpan.org'",
129         title => \"'The ''best of'' cpan'",
130     }) x 5
131   ]);
132
133   is((grep {
134     $_->url eq 'cpan.org' &&
135     $_->title eq "The 'best of' cpan",
136   } $rs->all), 5, 'populate with all literal SQL');
137
138   $rs->delete;
139
140   # test mixed binds with literal sql
141
142   $rs->populate([
143     (+{
144         url => \"'cpan.org'",
145         title => "The 'best of' cpan",
146     }) x 5
147   ]);
148
149   is((grep {
150     $_->url eq 'cpan.org' &&
151     $_->title eq "The 'best of' cpan",
152   } $rs->all), 5, 'populate with all literal SQL');
153
154   $rs->delete;
155 }
156
157 # populate with literal+bind
158 {
159   my $rs = $schema->resultset('Link');
160   $rs->delete;
161
162   # test insert_bulk with all literal/bind sql
163   $rs->populate([
164     (+{
165         url => \['?', [ {} => 'cpan.org' ] ],
166         title => \['?', [ {} => "The 'best of' cpan" ] ],
167     }) x 5
168   ]);
169
170   is((grep {
171     $_->url eq 'cpan.org' &&
172     $_->title eq "The 'best of' cpan",
173   } $rs->all), 5, 'populate with all literal/bind');
174
175   $rs->delete;
176
177   # test insert_bulk with mix literal and literal/bind
178   $rs->populate([
179     (+{
180         url => \"'cpan.org'",
181         title => \['?', [ {} => "The 'best of' cpan" ] ],
182     }) x 5
183   ]);
184
185   is((grep {
186     $_->url eq 'cpan.org' &&
187     $_->title eq "The 'best of' cpan",
188   } $rs->all), 5, 'populate with all literal/bind SQL');
189
190   $rs->delete;
191
192   # test mixed binds with literal sql/bind
193
194   $rs->populate([ map { +{
195     url => \[ '? || ?', [ {} => 'cpan.org_' ], [ undef, $_ ] ],
196     title => "The 'best of' cpan",
197   } } (1 .. 5) ]);
198
199   for (1 .. 5) {
200     ok($rs->find({ url => "cpan.org_$_" }), "Row $_ correctly created with dynamic literal/bind populate" );
201   }
202
203   $rs->delete;
204 }
205
206 my $rs = $schema->resultset('Artist');
207 $rs->delete;
208 throws_ok {
209     $rs->populate([
210         {
211             artistid => 1,
212             name => 'foo1',
213         },
214         {
215             artistid => 'foo', # this dies
216             name => 'foo2',
217         },
218         {
219             artistid => 3,
220             name => 'foo3',
221         },
222     ]);
223 } qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice';
224
225 is($rs->count, 0, 'populate is atomic');
226
227 # Trying to use a column marked as a bind in the first slice with literal sql in
228 # a later slice should throw.
229
230 throws_ok {
231   $rs->populate([
232     {
233       artistid => 1,
234       name => \"'foo'",
235     },
236     {
237       artistid => \2,
238       name => \"'foo'",
239     }
240   ]);
241 } qr/Literal SQL found where a plain bind value is expected/, 'literal sql where bind expected throws';
242
243 # ... and vice-versa.
244
245 throws_ok {
246   $rs->populate([
247     {
248       artistid => \1,
249       name => \"'foo'",
250     },
251     {
252       artistid => 2,
253       name => \"'foo'",
254     }
255   ]);
256 } qr/\QIncorrect value (expecting SCALAR-ref/, 'bind where literal sql expected throws';
257
258 throws_ok {
259   $rs->populate([
260     {
261       artistid => 1,
262       name => \"'foo'",
263     },
264     {
265       artistid => 2,
266       name => \"'bar'",
267     }
268   ]);
269 } qr/Inconsistent literal SQL value/, 'literal sql must be the same in all slices';
270
271 throws_ok {
272   $rs->populate([
273     {
274       artistid => 1,
275       name => \['?', [ {} => 'foo' ] ],
276     },
277     {
278       artistid => 2,
279       name => \"'bar'",
280     }
281   ]);
282 } qr/\QIncorrect value (expecting ARRAYREF-ref/, 'literal where literal+bind expected throws';
283
284 throws_ok {
285   $rs->populate([
286     {
287       artistid => 1,
288       name => \['?', [ { sqlt_datatype => 'foooo' } => 'foo' ] ],
289     },
290     {
291       artistid => 2,
292       name => \['?', [ {} => 'foo' ] ],
293     }
294   ]);
295 } qr/\QDiffering bind attributes on literal\/bind values not supported for column 'name'/, 'literal+bind with differing attrs throws';
296
297 lives_ok {
298   $rs->populate([
299     {
300       artistid => 1,
301       name => \['?', [ undef, 'foo' ] ],
302     },
303     {
304       artistid => 2,
305       name => \['?', [ {} => 'bar' ] ],
306     }
307   ]);
308 } 'literal+bind with semantically identical attrs works after normalization';
309
310 # the stringification has nothing to do with the artist name
311 # this is solely for testing consistency
312 my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
313 my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
314
315 lives_ok {
316   $rs->populate([
317     {
318       name => 'supplied before stringifying object',
319     },
320     {
321       name => $fn,
322     }
323   ]);
324 } 'stringifying objects pass through';
325
326 # ... and vice-versa.
327
328 lives_ok {
329   $rs->populate([
330     {
331       name => $fn2,
332     },
333     {
334       name => 'supplied after stringifying object',
335     },
336   ]);
337 } 'stringifying objects pass through';
338
339 for (
340   $fn,
341   $fn2,
342   'supplied after stringifying object',
343   'supplied before stringifying object'
344 ) {
345   my $row = $rs->find ({name => $_});
346   ok ($row, "Stringification test row '$_' properly inserted");
347 }
348
349 $rs->delete;
350
351 # test stringification with ->create rather than Storage::insert_bulk as well
352
353 lives_ok {
354   my @dummy = $rs->populate([
355     {
356       name => 'supplied before stringifying object',
357     },
358     {
359       name => $fn,
360     }
361   ]);
362 } 'stringifying objects pass through';
363
364 # ... and vice-versa.
365
366 lives_ok {
367   my @dummy = $rs->populate([
368     {
369       name => $fn2,
370     },
371     {
372       name => 'supplied after stringifying object',
373     },
374   ]);
375 } 'stringifying objects pass through';
376
377 for (
378   $fn,
379   $fn2,
380   'supplied after stringifying object',
381   'supplied before stringifying object'
382 ) {
383   my $row = $rs->find ({name => $_});
384   ok ($row, "Stringification test row '$_' properly inserted");
385 }
386
387 lives_ok {
388    $schema->resultset('TwoKeys')->populate([{
389       artist => 1,
390       cd     => 5,
391       fourkeys_to_twokeys => [{
392             f_foo => 1,
393             f_bar => 1,
394             f_hello => 1,
395             f_goodbye => 1,
396             autopilot => 'a',
397       },{
398             f_foo => 2,
399             f_bar => 2,
400             f_hello => 2,
401             f_goodbye => 2,
402             autopilot => 'b',
403       }]
404    }])
405 } 'multicol-PK has_many populate works';
406
407 lives_ok ( sub {
408   $schema->populate('CD', [
409     {cdid => 10001, artist => $artist->id, title => 'Pretty Much Empty', year => 2011, tracks => []},
410   ])
411 }, 'empty has_many relationship accepted by populate');
412
413 done_testing;