1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
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.
|
