X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;fp=lib%2FSQL%2FAbstract.pm;h=8c552f273cada91293eca956f722aeb20e933f9c;hb=a3e7d9a72ba6a6854f3ea266ce72670462e5e3a2;hp=45d0425c46d69bd3ca0075b2a799626343607732;hpb=449e13208e09551b354d65df1fa055442be71ad0;p=dbsrgits%2FSQL-Abstract.git diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 45d0425..8c552f2 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -27,6 +27,7 @@ our $AUTOLOAD; my @BUILTIN_SPECIAL_OPS = ( {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'}, {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'}, + {regex => qr/^ func $/ix, handler => '_where_field_FUNC'}, ); # unaryish operators - key maps to handler @@ -36,6 +37,7 @@ my @BUILTIN_UNARY_OPS = ( { 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' }, + { regex => qr/^ func $/ix, handler => '_where_op_FUNC' }, ); #====================================================================== @@ -966,6 +968,85 @@ sub _where_field_BETWEEN { return ($sql, @bind) } +sub _where_field_FUNC { + my ($self, $k, $op, $vals) = @_; + + return $self->_where_generic_FUNC($k,$vals); +} + +sub _where_op_FUNC { + my ($self, $k, $vals) = @_; + + return $self->_where_generic_FUNC('', $vals); +} + +sub _where_generic_FUNC { + my ($self, $k, $vals) = @_; + + my $label = $self->_convert($self->_quote($k)); + my $placeholder = $self->_convert('?'); + my $error = "special op 'func' accepts an arrayref with more than one value."; + + my ($clause, @bind) = $self->_SWITCH_refkind($vals, { + ARRAYREFREF => sub { + my ($s, @b) = @$$vals; + $self->_assert_bindval_matches_bindtype(@b); + ($s, @b); + }, + SCALARREF => sub { + puke $error; + }, + ARRAYREF => sub { + puke $error + if @$vals < 1; + + my (@all_sql, @all_bind); + + my ($func,@rest_of_vals) = @$vals; + + if ($func =~ m{\W}) + { + puke "Function in -func may only contain alphanumeric characters."; + } + + foreach my $val (@rest_of_vals) { + my ($sql, @bind) = $self->_SWITCH_refkind($val, { + SCALAR => sub { + return ($placeholder, $self->_bindtype($k, $val) ); + }, + SCALARREF => sub { + return $$val; + }, + ARRAYREFREF => sub { + my ($sql, @bind) = @$$val; + $self->_assert_bindval_matches_bindtype(@bind); + return ($sql, @bind); + }, + HASHREF => sub { + my ($func, $arg, @rest) = %$val; + puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN") + if (@rest or $func !~ /^ \- (.+)/x); + local $self->{_nested_func_lhs} = $k; + $self->_where_unary_op ($1 => $arg); + } + }); + push @all_sql, $sql; + push @all_bind, @bind; + } + + return ( + ("$func(" . (join ",", @all_sql) . ")"), + @all_bind + ); + }, + FALLBACK => sub { + puke $error; + }, + }); + + my $sql = $k ? "( $label = $clause )" : "( $clause )"; + return ($sql, @bind) +} sub _where_field_IN { my ($self, $k, $op, $vals) = @_; @@ -2223,6 +2304,19 @@ Would give you: These are the two builtin "special operators"; but the list can be expanded : see section L below. +Another operator is C<-func> that allows you to call SQL functions with +arguments. It receives an array reference containing the function name +as the 0th argument and the other arguments being its parameters. For example: + + my %where = { + -func => ['substr', 'Hello', 50, 5], + }; + +Would give you: + + $stmt = "WHERE (substr(?,?,?))"; + @bind = ("Hello", 50, 5); + =head2 Unary operators: bool If you wish to test against boolean columns or functions within your