—

              
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;
}
HideShow 83 lines of Pod
=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.