{regex => qr/^(not )?in$/i, handler => '_where_field_IN'},
);
+# unaryish operators - key maps to handler
+my @BUILTIN_UNARY_OPS = (
+ { regex => qr/^and (\s? \d+)?$/xi, handler => '_where_op_ANDOR' },
+ { regex => qr/^or (\s? \d+)?$/xi, handler => '_where_op_ANDOR' },
+ { regex => qr/^nest (\s? \d+)?$/xi, handler => '_where_op_NEST' },
+ { regex => qr/^(not \s?)? bool$/xi, handler => '_where_op_BOOL' },
+);
+
#======================================================================
# DEBUGGING AND ERROR REPORTING
#======================================================================
$opt{special_ops} ||= [];
push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
+ # unary operators
+ $opt{unary_ops} ||= [];
+ push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
+
return bless \%opt, $class;
}
sub _where_op_in_hash {
- my ($self, $op_str, $v) = @_;
+ my ($self, $op, $v) = @_;
+
+ # put the operator in canonical form
+ $op =~ s/^-//; # remove initial dash
+ $op =~ tr/_/ /; # underscores become spaces
+ $op =~ s/^\s+//; # no initial space
+ $op =~ s/\s+$//; # no final space
+ $op =~ s/\s+/ /; # multiple spaces become one
+
+ $self->_debug("OP(-$op) within hashref, recursing...");
+
+ my $op_entry = first {$op =~ $_->{regex}} @{$self->{unary_ops}};
+ my $handler = $op_entry->{handler};
+ if (! $handler) {
+ puke "unknown operator: -$op";
+ }
+ elsif (not ref $handler) {
+ return $self->$handler ($op, $v);
+ }
+ elsif (ref $handler eq 'CODE') {
+ return $handler->($self, $op, $v);
+ }
+ else {
+ puke "Illegal handler for operator $op - expecting a method name or a coderef";
+ }
+}
- $op_str =~ /^ (AND|OR|NEST) ( \_? \d* ) $/xi
- or puke "unknown operator: -$op_str";
+sub _where_op_ANDOR {
+ my ($self, $op, $v) = @_;
- my $op = uc($1); # uppercase, remove trailing digits
- if ($2) {
+ if ($op =~ s/\s?\d+$//) {
belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
- . "You probably wanted ...-and => [ $op_str => COND1, $op_str => COND2 ... ]";
+ . "You probably wanted ...-and => [ $op => COND1, $op => COND2 ... ]";
+ }
+
+ $self->_SWITCH_refkind($v, {
+ ARRAYREF => sub {
+ return $self->_where_ARRAYREF($v, $op);
+ },
+
+ HASHREF => sub {
+ return ( $op =~ /^or/i )
+ ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
+ : $self->_where_HASHREF($v);
+ },
+
+ SCALARREF => sub {
+ puke "-$op => \\\$scalar not supported, use -nest => ...";
+ },
+
+ ARRAYREFREF => sub {
+ puke "-$op => \\[..] not supported, use -nest => ...";
+ },
+
+ SCALAR => sub { # permissively interpreted as SQL
+ puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
+ },
+
+ UNDEF => sub {
+ puke "-$op => undef not supported";
+ },
+ });
+}
+
+sub _where_op_NEST {
+ my ($self, $op, $v) = @_;
+
+ if ($op =~ s/\s?\d+$//) {
+ belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
+ . "You probably wanted ...-and => [ $op => COND1, $op => COND2 ... ]";
}
- $self->_debug("OP(-$op) within hashref, recursing...");
$self->_SWITCH_refkind($v, {
ARRAYREF => sub {
- return $self->_where_ARRAYREF($v, $op eq 'NEST' ? '' : $op);
+ return $self->_where_ARRAYREF($v, '');
},
HASHREF => sub {
- if ($op eq 'OR') {
- return $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], 'OR');
- }
- else { # NEST | AND
- return $self->_where_HASHREF($v);
- }
+ return $self->_where_HASHREF($v);
},
SCALARREF => sub { # literal SQL
- $op eq 'NEST'
- or puke "-$op => \\\$scalar not supported, use -nest => ...";
return ($$v);
},
ARRAYREFREF => sub { # literal SQL
- $op eq 'NEST'
- or puke "-$op => \\[..] not supported, use -nest => ...";
return @{${$v}};
},
SCALAR => sub { # permissively interpreted as SQL
- $op eq 'NEST'
- or puke "-$op => 'scalar' not supported, use -nest => \\'scalar'";
belch "literal SQL should be -nest => \\'scalar' "
. "instead of -nest => 'scalar' ";
return ($v);
}
+sub _where_op_BOOL {
+ my ($self, $op, $v) = @_;
+
+ my $prefix = ($op =~ /\bnot\b/i) ? 'NOT ' : '';
+ $self->_SWITCH_refkind($v, {
+ SCALARREF => sub { # literal SQL
+ return ($prefix . $$v);
+ },
+
+ SCALAR => sub { # interpreted as SQL column
+ return ($prefix . $self->_convert($self->_quote($v)));
+ },
+ });
+}
+
+
sub _where_hashpair_ARRAYREF {
my ($self, $k, $v) = @_;
-
-
#======================================================================
# ORDER BY
#======================================================================
to extend the syntax understood by L<SQL::Abstract>.
See section L</"SPECIAL OPERATORS"> for details.
+=item unary_ops
+
+Takes a reference to a list of "unary operators"
+to extend the syntax understood by L<SQL::Abstract>.
+See section L</"UNARY OPERATORS"> for details.
+
=back
These are the two builtin "special operators"; but the
list can be expanded : see section L</"SPECIAL OPERATORS"> below.
+=head2 Unary operators: bool
+
+If you wish to test against boolean columns or functions within your
+database you can use the C<-bool> and C<-not_bool> operators. For
+example to test the column C<is_user> being true and the column
+<is_enabled> being false you would use:-
+
+ my %where = (
+ -bool => 'is_user',
+ -not_bool => 'is_enabled',
+ );
+
+Would give you:
+
+ WHERE is_user AND NOT is_enabledmv
+
+
+
=head2 Nested conditions, -and/-or prefixes
So far, we've seen how multiple conditions are joined with a top-level
]);
+=head1 UNARY OPERATORS
+
+ my $sqlmaker = SQL::Abstract->new(unary_ops => [
+ {
+ regex => qr/.../,
+ handler => sub {
+ my ($self, $op, $arg) = @_;
+ ...
+ },
+ },
+ {
+ regex => qr/.../,
+ handler => 'method_name',
+ },
+ ]);
+
+A "unary operator" is a SQL syntactic clause that can be
+applied to a field - the operator goes before the field
+
+You can write your own operator handlers - supply a C<unary_ops>
+argument to the C<new> method. That argument takes an arrayref of
+operator definitions; each operator definition is a hashref with two
+entries:
+
+=over
+
+=item regex
+
+the regular expression to match the operator
+
+=item handler
+
+Either a coderef or a plain scalar method name. In both cases
+the expected return is C<< $sql >>.
+
+When supplied with a method name, it is simply called on the
+L<SQL::Abstract/> object as:
+
+ $self->$method_name ($op, $arg)
+
+ Where:
+
+ $op is the part that matched the handler regex
+ $arg is the RHS or argument of the operator
+
+When supplied with a coderef, it is called as:
+
+ $coderef->($self, $op, $arg)
+
+
+=back
+
+
=head1 PERFORMANCE
Thanks to some benchmarking by Mark Stosberg, it turns out that
projects / scpubgit/Q-Branch.git / blobdiff