$colinfos = $ident->columns_info;
}
- my ($sql, @bind) = $self->sql_maker->$op( ($from || $ident), @$args );
+ my ($sql, $bind);
+ ($sql, @$bind) = $self->sql_maker->$op( ($from || $ident), @$args );
+
+ $bind = $self->_resolve_bindattrs(
+ $ident, [ @{$args->[2]{bind}||[]}, @$bind ], $colinfos
+ );
if (
! $ENV{DBIC_DT_SEARCH_OK}
and
$op eq 'select'
and
- first { blessed($_->[1]) && $_->[1]->isa('DateTime') } @bind
+ first {
+ length ref $_->[1]
+ and
+ blessed($_->[1])
+ and
+ $_->[1]->isa('DateTime')
+ } @$bind
) {
carp_unique 'DateTime objects passed to search() are not supported '
. 'properly (InflateColumn::DateTime formats and settings are not '
. 'set $ENV{DBIC_DT_SEARCH_OK} to true'
}
- return( $sql, $self->_resolve_bindattrs(
- $ident, [ @{$args->[2]{bind}||[]}, @bind ], $colinfos
- ));
+ return( $sql, $bind );
}
sub _resolve_bindattrs {
};
return [ map {
- if (ref $_ ne 'ARRAY') {
- [{}, $_]
- }
- elsif (! defined $_->[0]) {
- [{}, $_->[1]]
- }
- elsif (ref $_->[0] eq 'HASH') {
- [
- ($_->[0]{dbd_attrs} or $_->[0]{sqlt_datatype}) ? $_->[0] : $resolve_bindinfo->($_->[0]),
- $_->[1]
- ]
- }
- elsif (ref $_->[0] eq 'SCALAR') {
- [ { sqlt_datatype => ${$_->[0]} }, $_->[1] ]
- }
- else {
- [ $resolve_bindinfo->({ dbic_colname => $_->[0] }), $_->[1] ]
+ my $resolved =
+ ( ref $_ ne 'ARRAY' or @$_ != 2 ) ? [ {}, $_ ]
+ : ( ! defined $_->[0] ) ? [ {}, $_->[1] ]
+ : (ref $_->[0] eq 'HASH') ? [ (exists $_->[0]{dbd_attrs} or $_->[0]{sqlt_datatype})
+ ? $_->[0]
+ : $resolve_bindinfo->($_->[0])
+ , $_->[1] ]
+ : (ref $_->[0] eq 'SCALAR') ? [ { sqlt_datatype => ${$_->[0]} }, $_->[1] ]
+ : [ $resolve_bindinfo->(
+ { dbic_colname => $_->[0] }
+ ), $_->[1] ]
+ ;
+
+ if (
+ ! exists $resolved->[0]{dbd_attrs}
+ and
+ ! $resolved->[0]{sqlt_datatype}
+ and
+ length ref $resolved->[1]
+ and
+ ! overload::Method($resolved->[1], '""')
+ ) {
+ require Data::Dumper;
+ local $Data::Dumper::Maxdepth = 1;
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Useqq = 1;
+ local $Data::Dumper::Indent = 0;
+ local $Data::Dumper::Pad = ' ';
+ $self->throw_exception(
+ 'You must supply a datatype/bindtype (see DBIx::Class::ResultSet/DBIC BIND VALUES) '
+ . 'for non-scalar value '. Data::Dumper::Dumper ($resolved->[1])
+ );
}
+
+ $resolved;
+
} @$bind ];
}
use strict;
use warnings;
+
use Test::More;
+use Test::Exception;
+use Math::BigInt;
use lib qw(t/lib);
use DBICTest;
# see if we get anything back at all
isa_ok ($complex_rs->next, 'DBIx::Class::Row');
+# Make sure that the bind shorthand syntax translation is accurate (and doesn't error)
+shorthand_check(
+ [ _sub => 2 ],
+ [ { dbic_colname => '_sub' } => 2 ],
+ '[ $name => $val ] === [ { dbic_colname => $name }, $val ]',
+);
+shorthand_check(
+ [ artist => 2 ],
+ [ { dbic_colname => 'artist', sqlt_datatype => 'integer' } => 2 ],
+ 'resolution of known column during [ $name => $val ] === [ { dbic_colname => $name }, $val ]',
+);
+shorthand_check(
+ [ \ 'number' => 2 ],
+ [ { sqlt_datatype => 'number' } => 2 ],
+ '[ \$dt => $val ] === [ { sqlt_datatype => $dt }, $val ]',
+);
+shorthand_check(
+ [ {} => 2 ],
+ [ {} => 2 ],
+ '[ {} => $val ] === [ {}, $val ]',
+);
+shorthand_check(
+ [ undef, 2 ],
+ [ {} => 2 ],
+ '[ undef, $val ] === [ {}, $val ]',
+);
+shorthand_check(
+ 2,
+ [ {} => 2 ],
+ '$val === [ {}, $val ]',
+);
+
+shorthand_check(
+ Math::BigInt->new(42),
+ [ {} => Math::BigInt->new(42) ],
+ 'stringifyable $object === [ {}, $object ]',
+);
+
+throws_ok {
+ shorthand_check(
+ [ 2 ],
+ [],
+ )
+} qr !You must supply a datatype/bindtype .+ for non-scalar value \Q[ 2 ]!,
+ 'exception on bare array bindvalue';
+
+throws_ok {
+ shorthand_check(
+ [ {} => [ 2 ] ],
+ [],
+ )
+} qr !You must supply a datatype/bindtype .+ for non-scalar value \Q[ 2 ]!,
+ 'exception on untyped array bindvalue';
+
+throws_ok {
+ shorthand_check(
+ [ {}, 2, 3 ],
+ [],
+ )
+} qr !You must supply a datatype/bindtype .+ for non-scalar value \[ 'HASH\(\w+\)', 2, 3 \]!,
+ 'exception on bare multielement array bindvalue';
+
+throws_ok {
+ shorthand_check(
+ bless( {}, 'Foo'),
+ [],
+ )
+} qr !You must supply a datatype/bindtype .+ for non-scalar value \Qbless( {}, 'Foo' )!,
+ 'exception on bare object';
+
+throws_ok {
+ shorthand_check(
+ [ {}, bless( {}, 'Foo') ],
+ [],
+ )
+} qr !You must supply a datatype/bindtype .+ for non-scalar value \Qbless( {}, 'Foo' )!,
+ 'exception on untyped object';
+
+
+sub shorthand_check {
+ my ($bind_shorthand, $bind_expected, $testname) = @_;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ is_same_sql_bind (
+ $schema->resultset('CD')->search({}, {
+ columns => [qw(cdid artist)],
+ group_by => ['cdid', \[ 'artist - ?', $bind_shorthand ] ],
+ })->as_query,
+ '(
+ SELECT me.cdid, me.artist
+ FROM cd me
+ GROUP BY cdid, artist - ?
+ )',
+ [ $bind_expected ],
+ $testname||(),
+ );
+}
+
+undef $schema;
+
done_testing;
use Test::More;
use Test::Exception;
+use Storable 'dclone';
use lib qw(t/lib);
use DBICTest;
use DBIC::SqlMakerTest;
my $schema = DBICTest->init_schema;
my $native_limit_dialect = $schema->storage->sql_maker->{limit_dialect};
-my $attr = {};
my @where_bind = (
- [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } => 'Study' ],
- [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.title' } => 'kama sutra' ],
+ [ {} => 'Study' ],
+ [ {} => 'kama sutra' ],
[ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } => 'Library' ],
);
my @select_bind = (
- [ $attr => 11 ], [ $attr => 12 ], [ $attr => 13 ],
+ [ { sqlt_datatype => 'numeric' } => 11 ],
+ [ {} => 12 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.id' } => 13 ],
);
my @group_bind = (
- [ $attr => 21 ],
+ [ {} => 21 ],
);
my @having_bind = (
- [ $attr => 31 ],
+ [ {} => 31 ],
);
my @order_bind = (
- [ $attr => 1 ], [ $attr => 2 ], [ $attr => 3 ],
+ [ { sqlt_datatype => 'int' } => 1 ],
+ [ { sqlt_datatype => 'varchar', dbic_colname => 'name', sqlt_size => 100 } => 2 ],
+ [ {} => 3 ],
);
my $tests = {
@where_bind,
@group_bind,
@having_bind,
- (map { [ @$_ ] } @order_bind), # without this is_deeply throws a fit
+ @{ dclone \@order_bind }, # without this is_deeply throws a fit
],
],
limit_offset_prefetch => [
@where_bind,
@group_bind,
@having_bind,
- (map { [ @$_ ] } @order_bind), # without this is_deeply throws a fit
+ @{ dclone \@order_bind }, # without this is_deeply throws a fit
],
],
limit_offset_prefetch => [
my $can_run = ($limtype eq $native_limit_dialect or $limtype eq 'GenericSubQ');
# chained search is necessary to exercise the recursive {where} parser
- my $rs = $schema->resultset('BooksInLibrary')->search({ 'me.title' => { '=' => 'kama sutra' } })->search({ source => { '!=', 'Study' } }, {
- columns => [ { identifier => 'me.id' }, 'owner.id', 'owner.name' ], # people actually do that. BLEH!!! :)
- join => 'owner', # single-rel manual prefetch
- rows => 4,
- '+columns' => { bar => \['? * ?', [ $attr => 11 ], [ $attr => 12 ]], baz => \[ '?', [ $attr => 13 ]] },
- group_by => \[ '(me.id / ?), owner.id', [ $attr => 21 ] ],
- having => \[ '?', [ $attr => 31 ] ],
- });
+ my $rs = $schema->resultset('BooksInLibrary')->search(
+ { 'me.title' => { '=' => \[ '?', 'kama sutra' ] } }
+ )->search(
+ { source => { '!=', \[ '?', [ {} => 'Study' ] ] } },
+ {
+ columns => [ { identifier => 'me.id' }, 'owner.id', 'owner.name' ], # people actually do that. BLEH!!! :)
+ join => 'owner', # single-rel manual prefetch
+ rows => 4,
+ '+columns' => { bar => \['? * ?', [ \ 'numeric' => 11 ], 12 ], baz => \[ '?', [ 'me.id' => 13 ] ] },
+ group_by => \[ '(me.id / ?), owner.id', 21 ],
+ having => \[ '?', 31 ],
+ }
+ );
#
# not all tests run on all dialects (somewhere impossible, somewhere makes no sense)
# only limit, no offset, no order
if ($tests->{$limtype}{limit}) {
- is_same_sql_bind(
- $rs->as_query,
- @{$tests->{$limtype}{limit}},
- "$limtype: Unordered limit with select/group/having",
- );
-
- lives_ok { $rs->all } "Grouped limit runs under $limtype"
- if $can_run;
+ lives_ok {
+ is_same_sql_bind(
+ $rs->as_query,
+ @{$tests->{$limtype}{limit}},
+ "$limtype: Unordered limit with select/group/having",
+ );
+
+ $rs->all if $can_run;
+ } "Grouped limit under $limtype";
}
# limit + offset, no order
if ($tests->{$limtype}{limit_offset}) {
- my $subrs = $rs->search({}, { offset => 3 });
- is_same_sql_bind(
- $subrs->as_query,
- @{$tests->{$limtype}{limit_offset}},
- "$limtype: Unordered limit+offset with select/group/having",
- );
-
- lives_ok { $subrs->all } "Grouped limit+offset runs under $limtype"
- if $can_run;
+
+ lives_ok {
+ my $subrs = $rs->search({}, { offset => 3 });
+
+ is_same_sql_bind(
+ $subrs->as_query,
+ @{$tests->{$limtype}{limit_offset}},
+ "$limtype: Unordered limit+offset with select/group/having",
+ );
+
+ $subrs->all if $can_run;
+ } "Grouped limit+offset runs under $limtype";
}
# order + limit, no offset
$rs = $rs->search(undef, {
order_by => ( $limtype =~ /GenericSubQ/
- ? [ { -desc => 'price' }, 'me.id', \[ 'owner.name + ?', [ {} => 'bah' ] ] ] # needs a same-table stable order to be happy
- : [ \['? / ?', [ $attr => 1 ], [ $attr => 2 ]], \[ '?', [ $attr => 3 ]] ]
+ ? [ { -desc => 'price' }, 'me.id', \[ 'owner.name + ?', 'bah' ] ] # needs a same-table stable order to be happy
+ : [ \['? / ?', [ \ 'int' => 1 ], [ name => 2 ]], \[ '?', 3 ] ]
),
});
if ($tests->{$limtype}{ordered_limit}) {
- is_same_sql_bind(
- $rs->as_query,
- @{$tests->{$limtype}{ordered_limit}},
- "$limtype: Ordered limit with select/group/having",
- );
- lives_ok { $rs->all } "Grouped ordered limit runs under $limtype"
- if $can_run;
+ lives_ok {
+ is_same_sql_bind(
+ $rs->as_query,
+ @{$tests->{$limtype}{ordered_limit}},
+ "$limtype: Ordered limit with select/group/having",
+ );
+
+ $rs->all if $can_run;
+ } "Grouped ordered limit runs under $limtype"
}
# order + limit + offset
if ($tests->{$limtype}{ordered_limit_offset}) {
- my $subrs = $rs->search({}, { offset => 3 });
- is_same_sql_bind(
- $subrs->as_query,
- @{$tests->{$limtype}{ordered_limit_offset}},
- "$limtype: Ordered limit+offset with select/group/having",
- );
-
- lives_ok { $subrs->all } "Grouped ordered limit+offset runs under $limtype"
- if $can_run;
+ lives_ok {
+ my $subrs = $rs->search({}, { offset => 3 });
+
+ is_same_sql_bind(
+ $subrs->as_query,
+ @{$tests->{$limtype}{ordered_limit_offset}},
+ "$limtype: Ordered limit+offset with select/group/having",
+ );
+
+ $subrs->all if $can_run;
+ } "Grouped ordered limit+offset runs under $limtype";
}
# complex prefetch on partial-fetch root with limit
prefetch => 'books',
($limtype !~ /GenericSubQ/ ? () : (
# needs a same-table stable order to be happy
- order_by => [ { -asc => 'me.name' }, \'me.id DESC' ]
+ order_by => [ { -asc => 'me.name' }, \ 'me.id DESC' ]
)),
});
- is_same_sql_bind (
- $pref_rs->as_query,
- @{$tests->{$limtype}{limit_offset_prefetch}},
- "$limtype: Prefetch with limit+offset",
- ) if $tests->{$limtype}{limit_offset_prefetch};
+ lives_ok {
+ is_same_sql_bind (
+ $pref_rs->as_query,
+ @{$tests->{$limtype}{limit_offset_prefetch}},
+ "$limtype: Prefetch with limit+offset",
+ ) if $tests->{$limtype}{limit_offset_prefetch};
- if ($can_run) {
- lives_ok { is ($pref_rs->all, 1, 'Expected count of objects on limited prefetch') }
- "Complex limited prefetch runs under $limtype"
- }
+ is ($pref_rs->all, 1, 'Expected count of objects on limited prefetch')
+ if $can_run;
+ } "Complex limited prefetch runs under $limtype";
}
done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff