Release 1.55

[scpubgit/Q-Branch.git] / lib / SQL / Abstract.pm

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 399bfe8..05c2271 100644 (file)
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -15,7 +15,7 @@ use Scalar::Util qw/blessed/;
 # GLOBALS
 #======================================================================
 
-our $VERSION  = '1.51';
+our $VERSION  = '1.55';
 
 # This would confuse some packagers
 #$VERSION      = eval $VERSION; # numify for warning-free dev releases
@@ -25,8 +25,8 @@ our $AUTOLOAD;
 # special operators (-in, -between). May be extended/overridden by user.
 # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
 my @BUILTIN_SPECIAL_OPS = (
-  {regex => qr/^(not )?between$/i, handler => \&_where_field_BETWEEN},
-  {regex => qr/^(not )?in$/i,      handler => \&_where_field_IN},
+  {regex => qr/^(not )?between$/i, handler => '_where_field_BETWEEN'},
+  {regex => qr/^(not )?in$/i,      handler => '_where_field_IN'},
 );
 
 #======================================================================
@@ -422,7 +422,6 @@ sub _where_HASHREF {
   my ($self, $where) = @_;
   my (@sql_clauses, @all_bind);
 
-  # LDNOTE : don't really know why we need to sort keys
   for my $k (sort keys %$where) { 
     my $v = $where->{$k};
 
@@ -463,7 +462,7 @@ sub _where_op_in_hash {
 
     HASHREF => sub {
       if ($op eq 'OR') {
-        return $self->_where_ARRAYREF([%$v], 'OR');
+        return $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], 'OR');
       } 
       else {                  # NEST | AND
         return $self->_where_HASHREF($v);
@@ -549,7 +548,19 @@ sub _where_hashpair_HASHREF {
     # CASE: special operators like -in or -between
     my $special_op = first {$op =~ $_->{regex}} @{$self->{special_ops}};
     if ($special_op) {
-      ($sql, @bind) = $special_op->{handler}->($self, $k, $op, $val);
+      my $handler = $special_op->{handler};
+      if (! $handler) {
+        puke "No handler supplied for special operator matching $special_op->{regex}";
+      }
+      elsif (not ref $handler) {
+        ($sql, @bind) = $self->$handler ($k, $op, $val);
+      }
+      elsif (ref $handler eq 'CODE') {
+        ($sql, @bind) = $handler->($self, $k, $op, $val);
+      }
+      else {
+        puke "Illegal handler for special operator matching $special_op->{regex} - expecting a method name or a coderef";
+      }
     }
     else {
       $self->_SWITCH_refkind($val, {
@@ -604,18 +615,20 @@ sub _where_hashpair_HASHREF {
 sub _where_field_op_ARRAYREF {
   my ($self, $k, $op, $vals) = @_;
 
-  if(@$vals) {
-    $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
+  my @vals = @$vals;  #always work on a copy
+
+  if(@vals) {
+    $self->_debug("ARRAY($vals) means multiple elements: [ @vals ]");
 
     # see if the first element is an -and/-or op
     my $logic;
-    if ($vals->[0] =~ /^ - ( AND|OR ) $/ix) {
+    if ($vals[0] =~ /^ - ( AND|OR ) $/ix) {
       $logic = uc $1;
-      shift @$vals;
+      shift @vals;
     }
 
-    # distribute $op over each remaining member of @$vals, append logic if exists
-    return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
+    # distribute $op over each remaining member of @vals, append logic if exists
+    return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
 
     # LDNOTE : had planned to change the distribution logic when 
     # $op =~ $self->{inequality_op}, because of Morgan laws : 
@@ -624,7 +637,7 @@ sub _where_field_op_ARRAYREF {
     # WHERE field != 22 AND field != 33.
     # To do this, replace the above to roughly :
     # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
-    # return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
+    # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
 
   } 
   else {
@@ -2124,11 +2137,16 @@ or an array of either of the two previous forms. Examples:
 =head1 SPECIAL OPERATORS
 
   my $sqlmaker = SQL::Abstract->new(special_ops => [
-     {regex => qr/.../,
+     {
+      regex => qr/.../,
       handler => sub {
         my ($self, $field, $op, $arg) = @_;
         ...
-        },
+      },
+     },
+     {
+      regex => qr/.../,
+      handler => 'method_name',
      },
    ]);
 
@@ -2141,12 +2159,13 @@ For example :
    WHERE MATCH(field) AGAINST (?, ?)
 
 Special operators IN and BETWEEN are fairly standard and therefore
-are builtin within C<SQL::Abstract>. For other operators,
-like the MATCH .. AGAINST example above which is 
-specific to MySQL, you can write your own operator handlers :
-supply a C<special_ops> argument to the C<new> method. 
-That argument takes an arrayref of operator definitions;
-each operator definition is a hashref with two entries
+are builtin within C<SQL::Abstract> (as the overridable methods
+C<_where_field_IN> and C<_where_field_BETWEEN>). For other operators,
+like the MATCH .. AGAINST example above which is specific to MySQL,
+you can write your own operator handlers - supply a C<special_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
 
@@ -2156,10 +2175,24 @@ the regular expression to match the operator
 
 =item handler
 
-coderef that will be called when meeting that operator
-in the input tree. The coderef will be called with 
-arguments  C<< ($self, $field, $op, $arg) >>, and 
-should return a C<< ($sql, @bind) >> structure.
+Either a coderef or a plain scalar method name. In both cases
+the expected return is C<< ($sql, @bind) >>.
+
+When supplied with a method name, it is simply called on the
+L<SQL::Abstract/> object as:
+
+ $self->$method_name ($field, $op, $arg)
+
+ Where:
+
+  $op is the part that matched the handler regex
+  $field is the LHS of the operator
+  $arg is the RHS
+
+When supplied with a coderef, it is called as:
+
+ $coderef->($self, $field, $op, $arg)
+
 
 =back
 
@@ -2340,6 +2373,8 @@ While not an official support venue, C<DBIx::Class> makes heavy use of
 C<SQL::Abstract>, and as such list members there are very familiar with
 how to create queries.
 
+=head1 LICENSE
+
 This module is free software; you may copy this under the terms of
 the GNU General Public License, or the Artistic License, copies of
 which should have accompanied your Perl kit.