File Coverage

blib/lib/SQL/Abstract/Util.pm
Criterion Covered Total %
statement 19 20 95.0
branch 12 14 85.7
condition 7 9 77.7
subroutine 7 7 100.0
pod 2 2 100.0
total 47 52 90.3


line stmt bran cond sub pod time code
1             package SQL::Abstract::Util;
2              
3 14     14   60664 use warnings;
  14         31  
  14         371  
4 14     14   58 use strict;
  14         20  
  14         1094  
5              
6             BEGIN {
7 14 50   14   73 if ($] < 5.009_005) {
8 0         0 require MRO::Compat;
9             }
10             else {
11 14         59 require mro;
12             }
13              
14             *SQL::Abstract::Util::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION = $ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}
15             ? sub () { 0 }
16             : sub () { 1 }
17 14 50       236 ;
18             }
19              
20 14     14   53 use Exporter ();
  14         27  
  14         1416  
21             our @ISA = 'Exporter';
22             our @EXPORT_OK = qw(is_plain_value is_literal_value);
23              
24             sub is_literal_value ($) {
25 13         46 ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
26 50 100 66 50 1 1839 : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
  9 100       33  
27             : undef;
28             }
29              
30             # FIXME XSify - this can be done so much more efficiently
31             sub is_plain_value ($) {
32 14     14   74 no strict 'refs';
  14         27  
  14         3436  
33             ! length ref $_[0] ? \($_[0])
34             : (
35             ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
36             and
37             exists $_[0]->{-value}
38             ) ? \($_[0]->{-value})
39             : (
40             # reuse @_ for even moar speedz
41             defined ( $_[1] = Scalar::Util::blessed $_[0] )
42             and
43             # deliberately not using Devel::OverloadInfo - the checks we are
44             # intersted in are much more limited than the fullblown thing, and
45             # this is a very hot piece of code
46             (
47             # simply using ->can('(""') can leave behind stub methods that
48             # break actually using the overload later (see L
49             # found while resolving method "%s" overloading "%s" in package
50             # "%s"> and the source of overload::mycan())
51             #
52             # either has stringification which DBI SHOULD prefer out of the box
53             grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
54             or
55             # has nummification or boolification, AND fallback is *not* disabled
56             (
57             SQL::Abstract::Util::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
58             and
59             (
60             grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
61             or
62             grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
63             )
64             and
65             (
66             # no fallback specified at all
67             ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
68             or
69             # fallback explicitly undef
70             ! defined ${"$_[3]::()"}
71             or
72             # explicitly true
73 47 100 66 47 1 18872 !! ${"$_[3]::()"}
    100 100        
    100          
74             )
75             )
76             )
77             ) ? \($_[0])
78             : undef;
79             }
80              
81             =head1 NAME
82              
83             SQL::Abstract::Util - Small collection of utilities for SQL::Abstract::Classic
84              
85             =head1 EXPORTABLE FUNCTIONS
86              
87             =head2 is_plain_value
88              
89             Determines if the supplied argument is a plain value as understood by this
90             module:
91              
92             =over
93              
94             =item * The value is C
95              
96             =item * The value is a non-reference
97              
98             =item * The value is an object with stringification overloading
99              
100             =item * The value is of the form C<< { -value => $anything } >>
101              
102             =back
103              
104             On failure returns C, on success returns a B reference
105             to the original supplied argument.
106              
107             =over
108              
109             =item * Note
110              
111             The stringification overloading detection is rather advanced: it takes
112             into consideration not only the presence of a C<""> overload, but if that
113             fails also checks for enabled
114             L|overload/Magic Autogeneration>, based
115             on either C<0+> or C.
116              
117             Unfortunately testing in the field indicates that this
118             detection B<< may tickle a latent bug in perl versions before 5.018 >>,
119             but only when very large numbers of stringifying objects are involved.
120             At the time of writing ( Sep 2014 ) there is no clear explanation of
121             the direct cause, nor is there a manageably small test case that reliably
122             reproduces the problem.
123              
124             If you encounter any of the following exceptions in B
125             your application stack> - this module may be to blame:
126              
127             Operation "ne": no method found,
128             left argument in overloaded package ,
129             right argument in overloaded package
130              
131             or perhaps even
132              
133             Stub found while resolving method "???" overloading """" in package
134              
135             If you fall victim to the above - please attempt to reduce the problem
136             to something that could be sent to the SQL::Abstract::Classic developers
137             (either publicly or privately). As a workaround in the meantime you can
138             set C<$ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}> to a true
139             value, which will most likely eliminate your problem (at the expense of
140             not being able to properly detect exotic forms of stringification).
141              
142             This notice and environment variable will be removed in a future version,
143             as soon as the underlying problem is found and a reliable workaround is
144             devised.
145              
146             =back
147              
148             =head2 is_literal_value
149              
150             Determines if the supplied argument is a literal value as understood by this
151             module:
152              
153             =over
154              
155             =item * C<\$sql_string>
156              
157             =item * C<\[ $sql_string, @bind_values ]>
158              
159             =back
160              
161             On failure returns C, on success returns an B reference
162             containing the unpacked version of the supplied literal SQL and bind values.
163              
164