165 lines
4.9 KiB
Perl
165 lines
4.9 KiB
Perl
package SQL::Abstract::Util;
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
BEGIN {
|
|
if ($] < 5.009_005) {
|
|
require MRO::Compat;
|
|
}
|
|
else {
|
|
require mro;
|
|
}
|
|
|
|
*SQL::Abstract::Util::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION = $ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}
|
|
? sub () { 0 }
|
|
: sub () { 1 }
|
|
;
|
|
}
|
|
|
|
use Exporter ();
|
|
our @ISA = 'Exporter';
|
|
our @EXPORT_OK = qw(is_plain_value is_literal_value);
|
|
|
|
sub is_literal_value ($) {
|
|
ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
|
|
: ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
|
|
: undef;
|
|
}
|
|
|
|
# FIXME XSify - this can be done so much more efficiently
|
|
sub is_plain_value ($) {
|
|
no strict 'refs';
|
|
! length ref $_[0] ? \($_[0])
|
|
: (
|
|
ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
|
|
and
|
|
exists $_[0]->{-value}
|
|
) ? \($_[0]->{-value})
|
|
: (
|
|
# 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
|
|
(
|
|
# simply using ->can('(""') can leave behind stub methods that
|
|
# break actually using the overload later (see L<perldiag/Stub
|
|
# found while resolving method "%s" overloading "%s" in package
|
|
# "%s"> and the source of overload::mycan())
|
|
#
|
|
# either has stringification which DBI SHOULD prefer out of the box
|
|
grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
|
|
or
|
|
# has nummification or boolification, AND fallback is *not* disabled
|
|
(
|
|
SQL::Abstract::Util::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
|
|
and
|
|
(
|
|
grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
|
|
or
|
|
grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
|
|
)
|
|
and
|
|
(
|
|
# no fallback specified at all
|
|
! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
|
|
or
|
|
# fallback explicitly undef
|
|
! defined ${"$_[3]::()"}
|
|
or
|
|
# explicitly true
|
|
!! ${"$_[3]::()"}
|
|
)
|
|
)
|
|
)
|
|
) ? \($_[0])
|
|
: undef;
|
|
}
|
|
|
|
=head1 NAME
|
|
|
|
SQL::Abstract::Util - Small collection of utilities for SQL::Abstract::Classic
|
|
|
|
=head1 EXPORTABLE FUNCTIONS
|
|
|
|
=head2 is_plain_value
|
|
|
|
Determines if the supplied argument is a plain value as understood by this
|
|
module:
|
|
|
|
=over
|
|
|
|
=item * The value is C<undef>
|
|
|
|
=item * The value is a non-reference
|
|
|
|
=item * The value is an object with stringification overloading
|
|
|
|
=item * The value is of the form C<< { -value => $anything } >>
|
|
|
|
=back
|
|
|
|
On failure returns C<undef>, on success returns a B<scalar> 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<autogenerated versions of C<"">|overload/Magic Autogeneration>, based
|
|
on either C<0+> or C<bool>.
|
|
|
|
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<random places within
|
|
your application stack> - this module may be to blame:
|
|
|
|
Operation "ne": no method found,
|
|
left argument in overloaded package <something>,
|
|
right argument in overloaded package <something>
|
|
|
|
or perhaps even
|
|
|
|
Stub found while resolving method "???" overloading """" in package <something>
|
|
|
|
If you fall victim to the above - please attempt to reduce the problem
|
|
to something that could be sent to the SQL::Abstract::Classic developers
|
|
(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
|
|
|
|
Determines if the supplied argument is a literal value as understood by this
|
|
module:
|
|
|
|
=over
|
|
|
|
=item * C<\$sql_string>
|
|
|
|
=item * C<\[ $sql_string, @bind_values ]>
|
|
|
|
=back
|
|
|
|
On failure returns C<undef>, on success returns an B<array> reference
|
|
containing the unpacked version of the supplied literal SQL and bind values.
|
|
|
|
|