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