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