use Test::More;
use Test::Exception;
+use Test::Warn;
use lib qw(t/lib);
use DBICTest;
+use DBIx::Class::_Util 'sigwarn_silencer';
use Path::Class::File ();
+use Math::BigInt;
+use List::Util qw/shuffle/;
+use Storable qw/nfreeze dclone/;
my $schema = DBICTest->init_schema();
my $rows = 10;
my $offset = 3;
-$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } ( 1 .. $rows ) ] );
+$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } shuffle ( 1 .. $rows ) ] );
is (
$schema->resultset ('Artist')->search ({ name => { -like => 'populateX%' } })->count,
$rows,
}
} ('Huey', 'Dewey', $ex_title, 'Louie')
])
-}, qr/columns .+ are not unique for populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
+}, qr/\Qexecute_for_fetch() aborted with '\E.+ at populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
## make sure populate honors fields/orders in list context
## schema order
is($link7->url, undef, 'Link 7 url');
is($link7->title, 'gtitle', 'Link 7 title');
-my $rs = $schema->resultset('Artist');
-$rs->delete;
+# populate with literals
+{
+ my $rs = $schema->resultset('Link');
+ $rs->delete;
-# test _execute_array_empty (insert_bulk with all literal sql)
+ # test insert_bulk with all literal sql (no binds)
-$rs->populate([
+ $rs->populate([
(+{
- name => \"'DT'",
- rank => \500,
- charfield => \"'mtfnpy'",
+ url => \"'cpan.org'",
+ title => \"'The ''best of'' cpan'",
}) x 5
-]);
+ ]);
-is((grep {
- $_->name eq 'DT' &&
- $_->rank == 500 &&
- $_->charfield eq 'mtfnpy'
-} $rs->all), 5, 'populate with all literal SQL');
+ is((grep {
+ $_->url eq 'cpan.org' &&
+ $_->title eq "The 'best of' cpan",
+ } $rs->all), 5, 'populate with all literal SQL');
-$rs->delete;
+ $rs->delete;
-# test mixed binds with literal sql
+ # test mixed binds with literal sql
-$rs->populate([
+ $rs->populate([
(+{
- name => \"'DT'",
- rank => 500,
- charfield => \"'mtfnpy'",
+ url => \"'cpan.org'",
+ title => "The 'best of' cpan",
}) x 5
-]);
+ ]);
-is((grep {
- $_->name eq 'DT' &&
- $_->rank == 500 &&
- $_->charfield eq 'mtfnpy'
-} $rs->all), 5, 'populate with all literal SQL');
+ is((grep {
+ $_->url eq 'cpan.org' &&
+ $_->title eq "The 'best of' cpan",
+ } $rs->all), 5, 'populate with all literal SQL');
-$rs->delete;
+ $rs->delete;
+}
+
+# populate with literal+bind
+{
+ my $rs = $schema->resultset('Link');
+ $rs->delete;
+
+ # test insert_bulk with all literal/bind sql
+ $rs->populate([
+ (+{
+ url => \['?', [ {} => 'cpan.org' ] ],
+ title => \['?', [ {} => "The 'best of' cpan" ] ],
+ }) x 5
+ ]);
+
+ is((grep {
+ $_->url eq 'cpan.org' &&
+ $_->title eq "The 'best of' cpan",
+ } $rs->all), 5, 'populate with all literal/bind');
+
+ $rs->delete;
+
+ # test insert_bulk with mix literal and literal/bind
+ $rs->populate([
+ (+{
+ url => \"'cpan.org'",
+ title => \['?', [ {} => "The 'best of' cpan" ] ],
+ }) x 5
+ ]);
-###
+ is((grep {
+ $_->url eq 'cpan.org' &&
+ $_->title eq "The 'best of' cpan",
+ } $rs->all), 5, 'populate with all literal/bind SQL');
+ $rs->delete;
+
+ # test mixed binds with literal sql/bind
+
+ $rs->populate([ map { +{
+ url => \[ '? || ?', [ {} => 'cpan.org_' ], [ undef, $_ ] ],
+ title => "The 'best of' cpan",
+ } } (1 .. 5) ]);
+
+ for (1 .. 5) {
+ ok($rs->find({ url => "cpan.org_$_" }), "Row $_ correctly created with dynamic literal/bind populate" );
+ }
+
+ $rs->delete;
+}
+
+my $rs = $schema->resultset('Artist');
+$rs->delete;
throws_ok {
+ # this warning is correct, but we are not testing it here
+ # what we are after is the correct exception when an int
+ # fails to coerce into a sqlite rownum
+ local $SIG{__WARN__} = sigwarn_silencer( qr/datatype mismatch.+ foo as integer/ );
+
$rs->populate([
{
artistid => 1,
name => 'foo3',
},
]);
-} qr/slice/, 'bad slice';
+} qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice fails PK insert';
is($rs->count, 0, 'populate is atomic');
name => \"'foo'",
}
]);
-} qr/bind expected/, 'literal sql where bind expected throws';
+} qr/Literal SQL found where a plain bind value is expected/, 'literal sql where bind expected throws';
# ... and vice-versa.
name => \"'foo'",
}
]);
-} qr/literal SQL expected/i, 'bind where literal sql expected throws';
+} qr/\QIncorrect value (expecting SCALAR-ref/, 'bind where literal sql expected throws';
throws_ok {
$rs->populate([
name => \"'bar'",
}
]);
-} qr/inconsistent/, 'literal sql must be the same in all slices';
-
-# the stringification has nothing to do with the artist name
-# this is solely for testing consistency
-my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
-my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
+} qr/Inconsistent literal SQL value/, 'literal sql must be the same in all slices';
-lives_ok {
+throws_ok {
$rs->populate([
{
- name => 'supplied before stringifying object',
+ artistid => 1,
+ name => \['?', [ {} => 'foo' ] ],
},
{
- name => $fn,
+ artistid => 2,
+ name => \"'bar'",
}
]);
-} 'stringifying objects pass through';
+} qr/\QIncorrect value (expecting ARRAYREF-ref/, 'literal where literal+bind expected throws';
-# ... and vice-versa.
+throws_ok {
+ $rs->populate([
+ {
+ artistid => 1,
+ name => \['?', [ { sqlt_datatype => 'foooo' } => 'foo' ] ],
+ },
+ {
+ artistid => 2,
+ name => \['?', [ {} => 'foo' ] ],
+ }
+ ]);
+} qr/\QDiffering bind attributes on literal\/bind values not supported for column 'name'/, 'literal+bind with differing attrs throws';
lives_ok {
$rs->populate([
{
- name => $fn2,
+ artistid => 1,
+ name => \['?', [ undef, 'foo' ] ],
},
{
- name => 'supplied after stringifying object',
- },
+ artistid => 2,
+ name => \['?', [ {} => 'bar' ] ],
+ }
]);
-} 'stringifying objects pass through';
-
-for (
- $fn,
- $fn2,
- 'supplied after stringifying object',
- 'supplied before stringifying object'
-) {
- my $row = $rs->find ({name => $_});
- ok ($row, "Stringification test row '$_' properly inserted");
-}
+} 'literal+bind with semantically identical attrs works after normalization';
+
+# test all kinds of population with stringified objects
+warnings_like {
+ local $ENV{DBIC_RT79576_NOWARN};
+
+ my $rs = $schema->resultset('Artist')->search({}, { columns => [qw(name rank)], order_by => 'artistid' });
+
+ # the stringification has nothing to do with the artist name
+ # this is solely for testing consistency
+ my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
+ my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
+ my $rank = Math::BigInt->new(42);
+
+ my $args = {
+ 'stringifying objects after regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ 'supplied before stringifying objects',
+ 'supplied before stringifying objects 2',
+ $fn,
+ $fn2,
+ )
+ ],
+ 'stringifying objects before regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ $fn,
+ $fn2,
+ 'supplied after stringifying objects',
+ 'supplied after stringifying objects 2',
+ )
+ ],
+ 'stringifying objects between regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ 'supplied before stringifying objects',
+ $fn,
+ $fn2,
+ 'supplied after stringifying objects',
+ )
+ ],
+ 'stringifying objects around regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ $fn,
+ 'supplied between stringifying objects',
+ $fn2,
+ )
+ ],
+ };
+
+ local $Storable::canonical = 1;
+ my $preimage = nfreeze([$fn, $fn2, $rank, $args]);
+
+ for my $tst (keys %$args) {
+
+ # test void ctx
+ $rs->delete;
+ $rs->populate($args->{$tst});
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst},
+ "Populate() $tst in void context"
+ );
+
+ # test non-void ctx
+ $rs->delete;
+ my $dummy = $rs->populate($args->{$tst});
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst},
+ "Populate() $tst in non-void context"
+ );
+
+ # test create() as we have everything set up already
+ $rs->delete;
+ $rs->create($_) for @{$args->{$tst}};
+
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst},
+ "Create() $tst"
+ );
+ }
+
+ ok (
+ ($preimage eq nfreeze( [$fn, $fn2, $rank, $args] )),
+ 'Arguments fed to populate()/create() unchanged'
+ );
+
+ $rs->delete;
+} [
+ # warning to be removed around Apr 1st 2015
+ # smokers start failing a month before that
+ (
+ ( DBICTest::RunMode->is_author and ( time() > 1427846400 ) )
+ or
+ ( DBICTest::RunMode->is_smoker and ( time() > 1425168000 ) )
+ )
+ ? ()
+ # one unique for populate() and create() each
+ : (qr/\QPOSSIBLE *PAST* DATA CORRUPTION detected \E.+\QTrigger condition encountered at @{[ __FILE__ ]} line\E \d/) x 2
+], 'Data integrity warnings as planned';
+
+lives_ok {
+ $schema->resultset('TwoKeys')->populate([{
+ artist => 1,
+ cd => 5,
+ fourkeys_to_twokeys => [{
+ f_foo => 1,
+ f_bar => 1,
+ f_hello => 1,
+ f_goodbye => 1,
+ autopilot => 'a',
+ },{
+ f_foo => 2,
+ f_bar => 2,
+ f_hello => 2,
+ f_goodbye => 2,
+ autopilot => 'b',
+ }]
+ }])
+} 'multicol-PK has_many populate works';
+
+lives_ok ( sub {
+ $schema->populate('CD', [
+ {cdid => 10001, artist => $artist->id, title => 'Pretty Much Empty', year => 2011, tracks => []},
+ ])
+}, 'empty has_many relationship accepted by populate');
+
+lives_ok ( sub {
+ my $genre_max = $schema->resultset('Genre')->get_column('genreid')->max;
+ $schema->populate('CD', [
+ {cdid => 10002, artist => $artist->id, title => 'Pretty Much Foo', year => 2011, genre => { name => 'country' } }
+ ]);
+
+ is_deeply($schema->resultset('Genre')->search({ name => 'country' })->all_hri,
+ [{ genreid => $genre_max + 1, name => 'country' }],
+ "Populate() belongs_to inserts in void context"
+ );
+}, 'void context belongs_to rels are populated');
+
+#my $q = $schema->resultset('CD')->search({}, { columns => [qw/artist year/], group_by => 'artist' })->as_query;
+#$schema->storage->insert_bulk($artist_src, [qw/name rank/], [[[qw/foo 1/], [qw/baz 2/]], $q, [[qw/asdf 5/], [qw/uhiuh 6/]]]);
+#my @cols = $artist_src->columns;
+
+my $artist_rs = $schema->resultset('Artist');
+my $artist_src = $artist_rs->result_source;
+
+#use DDP::S; scope {
+my $count = 0;
+my $name = "zaaaaa";
+$artist_rs->populate([
+ [qw/artistid name/],
+ [109, 'some crap'],
+ [110, 'some crap'],
+ sub {
+ return [$name++, ++$count] unless $count > 5;
+ return undef;
+ },
+]);
+#};
done_testing;
projects / dbsrgits/DBIx-Class.git / blobdiff