Initial Commit

database/perl/vendor/lib/SQL/Abstract/Util.pm

@@ -0,0 +1,164 @@
+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.
+
+