use List::Util ();
use Scalar::Util ();
+use Exporter 'import';
+our @EXPORT_OK = qw(is_plain_value is_literal_value);
+
+BEGIN {
+ if ($] < 5.009_005) {
+ require MRO::Compat;
+ }
+ else {
+ require mro;
+ }
+}
+
#======================================================================
# GLOBALS
#======================================================================
Carp::croak "[$func] Fatal: ", @_;
}
+sub is_literal_value ($) {
+ ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
+ : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
+ : (
+ ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
+ and
+ defined $_[0]->{-ident} and ! length ref $_[0]->{-ident}
+ ) ? [ $_[0]->{-ident} ]
+ : 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} ]
+ : (
+ 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
+ (
+ # FIXME - DBI needs fixing to stringify regardless of DBD
+ #
+ # either has stringification which DBI SHOULD prefer out of the box
+ $_[0]->can( '(""' )
+ or
+ # has nummification and fallback is *not* disabled
+ # reuse @_ for even moar speedz
+ (
+ $_[0]->can('(0+')
+ and
+ (
+ # no fallback specified at all
+ ! ( ($_[1]) = grep { *{"${_}::()"}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) } )
+ or
+ # fallback explicitly undef
+ ! defined ${"$_[1]::()"}
+ or
+ # explicitly true
+ ${"$_[1]::()"}
+ )
+ )
+ )
+ ) ? [ "$_[0]" ]
+ : undef;
+}
+
+
#======================================================================
# NEW
Easy, eh?
-=head1 FUNCTIONS
+=head1 METHODS
-The functions are simple. There's one for each major SQL operation,
+The methods are simple. There's one for each major SQL operation,
and a constructor you use first. The arguments are specified in a
-similar order to each function (table, then fields, then a where
+similar order to each method (table, then fields, then a where
clause) to try and simplify things.
-
-
-
=head2 new(option => 'value')
The C<new()> function takes a list of options and values, and returns
You get the idea. Strings get their case twiddled, but everything
else remains verbatim.
+=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 sucess returns a reference to a single
+element array containing the string-version of the supplied argument or
+C<[ undef ]> in case of an undefined initial argument.
+
+=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 ]>
+
+=item * C<< { -ident => $plain_defined_string } >>
+
+=back
+
+On failure returns C<undef>, on sucess returns a reference to an array
+cotaining the unpacked version of the supplied literal SQL and bind values.
+
=head1 WHERE CLAUSES
=head2 Introduction
--- /dev/null
+use warnings;
+use strict;
+
+use Test::More;
+use Test::Exception;
+
+use SQL::Abstract qw(is_plain_value is_literal_value);
+
+{
+ package # hideee
+ SQLATest::SillyInt;
+
+ use overload
+ # *DELIBERATELY* unspecified
+ #fallback => 1,
+ '0+' => sub { ${$_[0]} },
+ ;
+
+ package # hideee
+ SQLATest::SillyInt::Subclass;
+
+ our @ISA = 'SQLATest::SillyInt';
+}
+
+{
+ package # hideee
+ SQLATest::SillierInt;
+
+ use overload
+ fallback => 0,
+ ;
+
+ package # hideee
+ SQLATest::SillierInt::Subclass;
+
+ use overload
+ '0+' => sub { ${$_[0]} },
+ '+' => sub { ${$_[0]} + $_[1] },
+ ;
+
+ our @ISA = 'SQLATest::SillierInt';
+}
+
+# make sure we recognize overloaded stuff properly
+lives_ok {
+ my $num = bless( \do { my $foo = 69 }, 'SQLATest::SillyInt::Subclass' );
+ ok( is_plain_value $num, 'parent-fallback-provided stringification detected' );
+ is("$num", 69, 'test overloaded object stringifies, without specified fallback');
+} 'overload testing lives';
+
+{
+ my $nummifiable_maybefallback_num = bless( \do { my $foo = 42 }, 'SQLATest::SillierInt::Subclass' );
+ lives_ok {
+ ok( ( $nummifiable_maybefallback_num + 1) == 43 )
+ };
+
+ my $can_str = !! eval { "$nummifiable_maybefallback_num" };
+
+ lives_ok {
+ is_deeply(
+ is_plain_value $nummifiable_maybefallback_num,
+ ( $can_str ? [ 42 ] : undef ),
+ 'parent-disabled-fallback stringification detected same as perl',
+ );
+ };
+}
+
+is_deeply
+ is_plain_value { -value => [] },
+ [ [] ],
+ '-value recognized'
+;
+
+for ([], {}, \'') {
+ is
+ is_plain_value $_,
+ undef,
+ 'nonvalues correctly recognized'
+ ;
+}
+
+for (undef, { -value => undef }) {
+ is_deeply
+ is_plain_value $_,
+ [ undef ],
+ 'NULL -value recognized'
+ ;
+}
+
+is_deeply
+ is_literal_value { -ident => 'foo' },
+ [ 'foo' ],
+ '-ident recognized as literal'
+;
+
+is_deeply
+ is_literal_value \[ 'sql', 'bind1', [ {} => 'bind2' ] ],
+ [ 'sql', 'bind1', [ {} => 'bind2' ] ],
+ 'literal correctly unpacked'
+;
+
+
+for ([], {}, \'', undef) {
+ is
+ is_literal_value { -ident => $_ },
+ undef,
+ 'illegal -ident does not trip up detection'
+ ;
+}
+
+done_testing;
projects / dbsrgits/SQL-Abstract.git / commitdiff