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 my $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
 131 is((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
 149 is((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
 159 throws_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
 176 is($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
 181 throws_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
 196 throws_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
 209 throws_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
 224 my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
 225 my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
 226
 227 lives_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
 240 lives_ok {
 241   $rs->populate([
 242     {
 243       name => $fn2,
 244     },
 245     {
 246       name => 'supplied after stringifying object',
 247     },
 248   ]);
 249 } 'stringifying objects pass through';
 250
 251 for (
 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
 265 lives_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
 278 lives_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
 289 for (
 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
 299 done_testing;