X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=1b5f4900c1257c2f4fc105e13afb06293a8f3c86;hb=abe1a49124e6b617928466d7c99e22e186612a19;hp=ce4ead9fd03803ea920bd733890ac8c8ab45acd3;hpb=0da0fe34ca9d452d6775777f691b100a28d98907;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index ce4ead9..1b5f490 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -16,6 +16,11 @@ BEGIN { else { require mro; } + + *SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION = $ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION} + ? sub () { 0 } + : sub () { 1 } + ; } #====================================================================== @@ -84,42 +89,51 @@ sub is_literal_value ($) { # FIXME XSify - this can be done so much more efficiently sub is_plain_value ($) { no strict 'refs'; - ! length ref $_[0] ? [ $_[0] ] + ! length ref $_[0] ? \($_[0]) : ( ref $_[0] eq 'HASH' and keys %{$_[0]} == 1 and exists $_[0]->{-value} - ) ? [ $_[0]->{-value} ] + ) ? \($_[0]->{-value}) : ( - Scalar::Util::blessed $_[0] + # reuse @_ for even moar speedz + defined ( $_[1] = Scalar::Util::blessed $_[0] ) and # deliberately not using Devel::OverloadInfo - the checks we are # intersted in are much more limited than the fullblown thing, and # this is a very hot piece of code ( - # FIXME - DBI needs fixing to stringify regardless of DBD + # simply using ->can('(""') can leave behind stub methods that + # break actually using the overload later (see L and the source of overload::mycan()) # # either has stringification which DBI SHOULD prefer out of the box - $_[0]->can( '(""' ) + grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) } or - # has nummification and fallback is *not* disabled - # reuse @_ for even moar speedz + # has nummification or boolification, AND fallback is *not* disabled ( - $_[0]->can('(0+') + SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION + and + ( + grep { *{"${_}::(0+"}{CODE} } @{$_[2]} + or + grep { *{"${_}::(bool"}{CODE} } @{$_[2]} + ) and ( # no fallback specified at all - ! ( ($_[1]) = grep { *{"${_}::()"}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) } ) + ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} ) or # fallback explicitly undef - ! defined ${"$_[1]::()"} + ! defined ${"$_[3]::()"} or # explicitly true - ${"$_[1]::()"} + !! ${"$_[3]::()"} ) ) ) - ) ? [ "$_[0]" ] + ) ? \($_[0]) : undef; } @@ -483,9 +497,15 @@ sub _recurse_where { my ($sql, @bind) = $self->$method($where, $logic); - # DBIx::Class directly calls _recurse_where in scalar context, so - # we must implement it, even if not in the official API - return wantarray ? ($sql, @bind) : $sql; + # DBIx::Class used to call _recurse_where in scalar context + # something else might too... + if (wantarray) { + return ($sql, @bind); + } + else { + belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0"; + return $sql; + } } @@ -733,8 +753,8 @@ sub _where_op_BOOL { sub _where_op_IDENT { my $self = shift; my ($op, $rhs) = splice @_, -2; - if (ref $rhs) { - puke "-$op takes a single scalar argument (a quotable identifier)"; + if (! defined $rhs or length ref $rhs) { + puke "-$op requires a single plain scalar argument (a quotable identifier)"; } # in case we are called as a top level special op (no '=') @@ -1704,7 +1724,7 @@ say something like this: my %data = ( name => 'Bill', - date_entered => \["to_date(?,'MM/DD/YYYY')", "03/02/2003"], + date_entered => \[ "to_date(?,'MM/DD/YYYY')", "03/02/2003" ], ); The first value in the array is the actual SQL. Any other values are @@ -1905,7 +1925,7 @@ are or are not included. You could wrap that above C loop in a simple sub called C or something and reuse it repeatedly. You still get a layer of abstraction over manual SQL specification. -Note that if you set L to C, the C<\[$sql, @bind]> +Note that if you set L to C, the C<\[ $sql, @bind ]> construct (see L) will expect the bind values in this format. @@ -2143,9 +2163,50 @@ module: =back -On failure returns C, on sucess returns a reference to a single -element array containing the string-version of the supplied argument or -C<[ undef ]> in case of an undefined initial argument. +On failure returns C, on sucess returns a B reference +to the original supplied argument. + +=over + +=item * Note + +The stringification overloading detection is rather advanced: it takes +into consideration not only the presence of a C<""> overload, but if that +fails also checks for enabled +L|overload/Magic Autogeneration>, based +on either C<0+> or C. + +Unfortunately testing in the field indicates that this +detection B<< may tickle a latent bug in perl versions before 5.018 >>, +but only when very large numbers of stringifying objects are involved. +At the time of writing ( Sep 2014 ) there is no clear explanation of +the direct cause, nor is there a manageably small test case that reliably +reproduces the problem. + +If you encounter any of the following exceptions in B - this module may be to blame: + + Operation "ne": no method found, + left argument in overloaded package , + right argument in overloaded package + +or perhaps even + + Stub found while resolving method "???" overloading """" in package + +If you fall victim to the above - please attempt to reduce the problem +to something that could be sent to the L +(either publicly or privately). As a workaround in the meantime you can +set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true +value, which will most likely eliminate your problem (at the expense of +not being able to properly detect exotic forms of stringification). + +This notice and environment variable will be removed in a future version, +as soon as the underlying problem is found and a reliable workaround is +devised. + +=back =head2 is_literal_value @@ -2162,8 +2223,8 @@ module: =back -On failure returns C, on sucess returns a reference to an array -cotaining the unpacked version of the supplied literal SQL and bind values. +On failure returns C, on sucess returns an B reference +containing the unpacked version of the supplied literal SQL and bind values. =head1 WHERE CLAUSES @@ -2628,7 +2689,7 @@ not so common, but perfectly legal Perl). For example, to find a date in Postgres you can use something like this: my %where = ( - date_column => \[q/= date '2008-09-30' - ?::integer/, 10/] + date_column => \[ "= date '2008-09-30' - ?::integer", 10 ] ) This would create: @@ -2645,7 +2706,7 @@ L will simply pass it through intact. So if C is set to C the above example will look like: my %where = ( - date_column => \[q/= date '2008-09-30' - ?::integer/, [ dummy => 10 ]/] + date_column => \[ "= date '2008-09-30' - ?::integer", [ {} => 10 ] ] ) Literal SQL is especially useful for nesting parenthesized clauses in the @@ -3036,7 +3097,7 @@ The main changes are : =item * -support for literal SQL through the C<< \ [$sql, bind] >> syntax. +support for literal SQL through the C<< \ [ $sql, @bind ] >> syntax. =item *