X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract.pm;h=c7ca0e5db0a0da555dc172d0c1808c2133fad3c0;hb=e67751dd9effc7f5066e264c1d6149613a7efa42;hp=766091bea36e8c006bc368c068bc38259416d5a7;hpb=ce3531b48040ab0fca3e6f1151abde624dc53d15;p=scpubgit%2FQ-Branch.git

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 766091b..c7ca0e5 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -8,7 +8,7 @@ use List::Util ();
 use Scalar::Util ();
 
 use Exporter 'import';
-our @EXPORT_OK = qw(is_plain_value is_literal_value);
+our @EXPORT_OK = qw(is_plain_value is_literal_value is_undef_value);
 
 BEGIN {
   if ($] < 5.009_005) {
@@ -332,16 +332,13 @@ BEGIN {
   )) {
     my $name = join '_', reverse split '_', $type;
     my $singular = "${type}er";
-    eval qq{sub ${singular} { shift->_ext_rw($name => \@_) }; 1 }
+
+    eval qq{sub ${singular} { shift->${singular}s(\@_) }; 1 }
       or die "Method builder failed for ${singular}: $@";
     eval qq{sub wrap_${singular} {
-      my (\$self, \$key, \$builder) = \@_;
-      my \$orig = \$self->_ext_rw('${name}', \$key);
-      \$self->_ext_rw(
-        '${name}', \$key,
-        \$builder->(\$orig, '${name}', \$key)
-      );
+      shift->wrap_${singular}s(\@_)
     }; 1 } or die "Method builder failed for wrap_${singular}: $@";
+
     eval qq{sub ${singular}s {
       my (\$self, \@args) = \@_;
       while (my (\$this_key, \$this_value) = splice(\@args, 0, 2)) {
@@ -363,9 +360,23 @@ BEGIN {
     eval qq{sub ${singular}_list { sort keys %{\$_[0]->{\$name}} }; 1; }
      or die "Method builder failed for ${singular}_list: $@";
   }
+  foreach my $singular (qw(unop_expander binop_expander)) {
+    eval qq{sub ${singular} { shift->${singular}s(\@_) }; 1 }
+      or die "Method builder failed for ${singular}: $@";
+    eval qq{sub ${singular}s {
+      my (\$self, \@args) = \@_;
+      while (my (\$this_key, \$this_value) = splice(\@args, 0, 2)) {
+        \$self->_ext_rw(
+           expand_op => \$this_key,
+           \$self->make_${singular}(\$this_value),
+        );
+      }
+      return \$self;
+    }; 1 } or die "Method builder failed for ${singular}s: $@";
+  }
 }
 
-sub register_op { $_[0]->{is_op}{$_[1]} = 1; $_[0] }
+#sub register_op { $_[0]->{is_op}{$_[1]} = 1; $_[0] }
 
 sub statement_list { sort keys %{$_[0]->{clauses_of}} }
 
@@ -873,7 +884,7 @@ sub _render_statement {
 sub _normalize_op {
   my ($self, $raw) = @_;
   my $op = lc $raw;
-  return $op if grep $_->{$op}, @{$self}{qw(is_op expand_op render_op)};
+  return $op if grep $_->{$op}, @{$self}{qw(expand_op render_op)};
   s/^-(?=.)//, s/\s+/_/g for $op;
   $op;
 }
@@ -2639,6 +2650,10 @@ module:
 On failure returns C<undef>, on success returns an B<array> reference
 containing the unpacked version of the supplied literal SQL and bind values.
 
+=head2 is_undef_value
+
+Tests for undef, whether expanded or not.
+
 =head1 WHERE CLAUSES
 
 =head2 Introduction
@@ -3294,7 +3309,9 @@ forms. Examples:
 
 
 
-=head1 SPECIAL OPERATORS
+=head1 OLD EXTENSION SYSTEM
+
+=head2 SPECIAL OPERATORS
 
   my $sqlmaker = SQL::Abstract->new(special_ops => [
      {
@@ -3379,7 +3396,7 @@ of the MATCH .. AGAINST syntax for MySQL
   ]);
 
 
-=head1 UNARY OPERATORS
+=head2 UNARY OPERATORS
 
   my $sqlmaker = SQL::Abstract->new(unary_ops => [
      {
@@ -3431,6 +3448,186 @@ When supplied with a coderef, it is called as:
 
 =back
 
+=head1 NEW METHODS
+
+See L<SQL::Abstract::Reference> for the C<expr> versus C<aqt> concept and
+an explanation of what the below extensions are extending.
+
+=head2 render_expr
+
+  my ($sql, @bind) = $sqla->render_expr($expr);
+
+=head2 render_statement
+
+Use this if you may be rendering a top level statement so e.g. a SELECT
+query doesn't get wrapped in parens
+
+  my ($sql, @bind) = $sqla->render_statement($expr);
+
+=head2 expand_expr
+
+Expression expansion with optional default for scalars.
+
+  my $aqt = $self->expand_expr($expr);
+  my $aqt = $self->expand_expr($expr, -ident);
+
+=head2 expand_maybe_list_expr
+
+expand_expr but with commas if there's more than one entry.
+
+  my $aqt = $self->expand_maybe_list_expr([ @exprs ], $default?);
+
+=head2 render_aqt
+
+Top level means avoid parens on statement AQT.
+
+  my $res = $self->render_aqt($aqt, $top_level);
+  my ($sql, @bind) = @$res;
+
+=head2 join_query_parts
+
+Similar to join() but will render hashrefs as nodes for both join and parts,
+and treats arrayref as a nested C<[ $join, @parts ]> structure.
+
+  my $part = $self->join_query_parts($join, @parts);
+
+=head1 NEW EXTENSION SYSTEM
+
+=head2 clone
+
+  my $sqla2 = $sqla->clone;
+
+Performs a semi-shallow copy such that extension methods won't leak state
+but excessive depth is avoided.
+
+=head2 expander
+
+=head2 expanders
+
+=head2 op_expander
+
+=head2 op_expanders
+
+=head2 clause_expander
+
+=head2 clause_expanders
+
+  $sqla->expander('name' => sub { ... });
+  $sqla->expanders('name1' => sub { ... }, 'name2' => sub { ... });
+
+=head2 expander_list
+
+=head2 op_expander_list
+
+=head2 clause_expander_list
+
+  my @names = $sqla->expander_list;
+
+=head2 wrap_expander
+
+=head2 wrap_expanders
+
+=head2 wrap_op_expander
+
+=head2 wrap_op_expanders
+
+=head2 wrap_clause_expander
+
+=head2 wrap_clause_expanders
+
+  $sqla->wrap_expander('name' => sub { my ($orig) = @_; sub { ... } });
+  $sqla->wrap_expanders(
+    'name1' => sub { my ($orig1) = @_; sub { ... } },
+    'name2' => sub { my ($orig2) = @_; sub { ... } },
+  );
+
+=head2 renderer
+
+=head2 renderers
+
+=head2 op_renderer
+
+=head2 op_renderers
+
+=head2 clause_renderer
+
+=head2 clause_renderers
+
+  $sqla->renderer('name' => sub { ... });
+  $sqla->renderers('name1' => sub { ... }, 'name2' => sub { ... });
+
+=head2 renderer_list
+
+=head2 op_renderer_list
+
+=head2 clause_renderer_list
+
+  my @names = $sqla->renderer_list;
+
+=head2 wrap_renderer
+
+=head2 wrap_renderers
+
+=head2 wrap_op_renderer
+
+=head2 wrap_op_renderers
+
+=head2 wrap_clause_renderer
+
+=head2 wrap_clause_renderers
+
+  $sqla->wrap_renderer('name' => sub { my ($orig) = @_; sub { ... } });
+  $sqla->wrap_renderers(
+    'name1' => sub { my ($orig1) = @_; sub { ... } },
+    'name2' => sub { my ($orig2) = @_; sub { ... } },
+  );
+
+=head2 clauses_of
+
+  my @clauses = $sqla->clauses_of('select');
+  $sqla->clauses_of(select => \@new_clauses);
+  $sqla->clauses_of(select => sub {
+    my (undef, @old_clauses) = @_;
+    ...
+    return @new_clauses;
+  });
+
+=head2 statement_list
+
+  my @list = $sqla->statement_list;
+
+=head2 make_unop_expander
+
+  my $exp = $sqla->make_unop_expander(sub { ... });
+
+If the op is found as a binop, assumes it wants a default comparison, so
+the inner expander sub can reliably operate as
+
+  sub { my ($self, $name, $body) = @_; ... }
+
+=head2 make_binop_expander
+
+  my $exp = $sqla->make_binop_expander(sub { ... });
+
+If the op is found as a unop, assumes the value will be an arrayref with the
+LHS as the first entry, and converts that to an ident node if it's a simple
+scalar. So the inner expander sub looks like
+
+  sub {
+    my ($self, $name, $body, $k) = @_;
+    { -blah => [ map $self->expand_expr($_), $k, $body ] }
+  }
+
+=head2 unop_expander
+
+=head2 unop_expanders
+
+=head2 binop_expander
+
+=head2 binop_expanders
+
+The above methods operate exactly like the op_ versions but wrap the coderef
+using the appropriate make_ method first.
 
 =head1 PERFORMANCE