This test in fact requires DT::F::SQLite
[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 ();
54e0bd06 9
54e0bd06 10my $schema = DBICTest->init_schema();
54e0bd06 11
d35a6fed 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
20my $start_id = 'populateXaaaaaa';
21my $rows = 10;
22my $offset = 3;
23
24$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } ( 1 .. $rows ) ] );
25is (
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
31my $artist = $schema->resultset ('Artist')
32 ->search ({ 'cds.title' => { '!=', undef } }, { join => 'cds' })
33 ->first;
34my $ex_title = $artist->cds->first->title;
35
36throws_ok ( sub {
37 my $i = 600;
38 $schema->populate('CD', [
39 map {
40 {
d35a6fed 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');
b0457415 48
89b2e3e4 49## make sure populate honors fields/orders in list context
b0457415 50## schema order
89b2e3e4 51my @links = $schema->populate('Link', [
b0457415 52[ qw/id url title/ ],
53[ qw/2 burl btitle/ ]
54]);
89b2e3e4 55is(scalar @links, 1);
56
57my $link2 = shift @links;
b0457415 58is($link2->id, 2, 'Link 2 id');
59is($link2->url, 'burl', 'Link 2 url');
60is($link2->title, 'btitle', 'Link 2 title');
61
62## non-schema order
89b2e3e4 63@links = $schema->populate('Link', [
b0457415 64[ qw/id title url/ ],
65[ qw/3 ctitle curl/ ]
66]);
89b2e3e4 67is(scalar @links, 1);
68
69my $link3 = shift @links;
b0457415 70is($link3->id, 3, 'Link 3 id');
71is($link3->url, 'curl', 'Link 3 url');
72is($link3->title, 'ctitle', 'Link 3 title');
73
74## not all physical columns
89b2e3e4 75@links = $schema->populate('Link', [
b0457415 76[ qw/id title/ ],
77[ qw/4 dtitle/ ]
78]);
89b2e3e4 79is(scalar @links, 1);
80
81my $link4 = shift @links;
b0457415 82is($link4->id, 4, 'Link 4 id');
83is($link4->url, undef, 'Link 4 url');
84is($link4->title, 'dtitle', 'Link 4 title');
85
86
89b2e3e4 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]);
93my $link5 = $schema->resultset('Link')->find(5);
94is($link5->id, 5, 'Link 5 id');
95is($link5->url, 'eurl', 'Link 5 url');
96is($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]);
103my $link6 = $schema->resultset('Link')->find(6);
104is($link6->id, 6, 'Link 6 id');
105is($link6->url, 'furl', 'Link 6 url');
106is($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]);
113my $link7 = $schema->resultset('Link')->find(7);
114is($link7->id, 7, 'Link 7 id');
115is($link7->url, undef, 'Link 7 url');
116is($link7->title, 'gtitle', 'Link 7 title');
117
84f7e8a1 118# populate with literals
119{
120 my $rs = $schema->resultset('Link');
121 $rs->delete;
aac0bfd0 122
84f7e8a1 123 # test _execute_array_empty (insert_bulk with all literal sql)
aac0bfd0 124
84f7e8a1 125 $rs->populate([
574d7df6 126 (+{
84f7e8a1 127 url => \"'cpan.org'",
128 title => \"'The ''best of'' cpan'",
574d7df6 129 }) x 5
84f7e8a1 130 ]);
574d7df6 131
84f7e8a1 132 is((grep {
133 $_->url eq 'cpan.org' &&
134 $_->title eq "The 'best of' cpan",
135 } $rs->all), 5, 'populate with all literal SQL');
bbd6f348 136
84f7e8a1 137 $rs->delete;
bbd6f348 138
84f7e8a1 139 # test mixed binds with literal sql
aac0bfd0 140
84f7e8a1 141 $rs->populate([
aac0bfd0 142 (+{
84f7e8a1 143 url => \"'cpan.org'",
144 title => "The 'best of' cpan",
aac0bfd0 145 }) x 5
84f7e8a1 146 ]);
aac0bfd0 147
84f7e8a1 148 is((grep {
149 $_->url eq 'cpan.org' &&
150 $_->title eq "The 'best of' cpan",
151 } $rs->all), 5, 'populate with all literal SQL');
aac0bfd0 152
84f7e8a1 153 $rs->delete;
154}
aac0bfd0 155
84f7e8a1 156my $rs = $schema->resultset('Artist');
157$rs->delete;
bbd6f348 158throws_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
175is($rs->count, 0, 'populate is atomic');
176
1295943f 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
180throws_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
195throws_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
208throws_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
c0d8cb1f 221# the stringification has nothing to do with the artist name
222# this is solely for testing consistency
223my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
224my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
225
226lives_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
239lives_ok {
240 $rs->populate([
241 {
242 name => $fn2,
243 },
244 {
245 name => 'supplied after stringifying object',
246 },
247 ]);
248} 'stringifying objects pass through';
249
250for (
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
8464d1a4 260$rs->delete;
261
262# test stringification with ->create rather than Storage::insert_bulk as well
263
264lives_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
277lives_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
288for (
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
18d80024 298lives_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 }])
d6eda469 316} 'multicol-PK has_many populate works';
18d80024 317
bbd6f348 318done_testing;