1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
6use lib qw(t/lib);
7use DBICTest;
8use Path::Class::File ();
9
10my $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
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      {
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
51my @links = $schema->populate('Link', [
52[ qw/id url title/ ],
53[ qw/2 burl btitle/ ]
54]);
55is(scalar @links, 1);
56
57my $link2 = shift @links;
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
63@links = $schema->populate('Link', [
64[ qw/id title url/ ],
65[ qw/3 ctitle curl/ ]
66]);
67is(scalar @links, 1);
68
69my $link3 = shift @links;
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
75@links = $schema->populate('Link', [
76[ qw/id title/ ],
77[ qw/4 dtitle/ ]
78]);
79is(scalar @links, 1);
80
81my $link4 = shift @links;
82is($link4->id, 4, 'Link 4 id');
83is($link4->url, undef, 'Link 4 url');
84is($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]);
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
118my $rs = $schema->resultset('Artist');
119$rs->delete;
120
121# test _execute_array_empty (insert_bulk with all literal sql)
122
123$rs->populate([
124    (+{
125        name => \"'DT'",
126        rank => \500,
127        charfield => \"'mtfnpy'",
128    }) x 5
129]);
130
131is((grep {
132  $_->name eq 'DT' &&
133  $_->rank == 500  &&
134  $_->charfield eq 'mtfnpy'
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        name => \"'DT'",
144        rank => 500,
145        charfield => \"'mtfnpy'",
146    }) x 5
147]);
148
149is((grep {
150  $_->name eq 'DT' &&
151  $_->rank == 500  &&
152  $_->charfield eq 'mtfnpy'
153} $rs->all), 5, 'populate with all literal SQL');
154
155$rs->delete;
156
157###
158
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
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
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
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
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   }])
317} 'multicol-PK has_many populate works';
318
319done_testing;
320