wrap expander and expander list
Matt S Trout [Wed, 17 Apr 2019 01:32:39 +0000 (01:32 +0000)]
lib/SQL/Abstract/Clauses.pm
lib/SQL/Abstract/ExtraClauses.pm

index 605424f..a6ba62d 100644 (file)
@@ -287,17 +287,27 @@ BEGIN {
   foreach my $type (qw(
     expand op_expand render op_render clause_expand clause_render
   )) {
-    my $key = join '_', reverse split '_', $type;
+    my $name = join '_', reverse split '_', $type;
     my $singular = "${type}er";
-    eval qq{sub ${singular} { shift->_ext_rw($key => \@_) }; 1 }
-      or die "Method builder failed for ${type}er: $@";
+    eval qq{sub ${singular} { shift->_ext_rw($name => \@_) }; 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)
+      );
+    }; 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)) {
-        \$self->{${key}}{\$this_key} = \$this_value;
+        \$self->{${name}}{\$this_key} = \$this_value;
       }
       return \$self;
     }; 1 } or die "Method builder failed for ${singular}s: $@";
+    eval qq{sub ${singular}_list { sort keys %{\$_[0]->{\$name}} }; 1; }
+     or die "Method builder failed for ${singular}_list: $@";
   }
 }
 
index 6a27d43..eaac9c1 100644 (file)
@@ -62,9 +62,9 @@ sub register_defaults {
   );
 
   # set ops
-  {
-    my $orig = $self->expander('select');
-    $self->expander(select => sub {
+  $self->wrap_expander(select => sub {
+    my $orig = shift;
+    sub {
       my $self = shift;
       my $exp = $self->$orig(@_);
       return $exp unless my $setop = (my $sel = $exp->{-select})->{setop};
@@ -74,8 +74,8 @@ sub register_defaults {
           { -select => \%inner };
       }
       return $exp;
-    });
-  }
+    }
+  });
   my $expand_setop = sub {
     my ($self, $setop, $args) = @_;
     +{ "-${setop}" => {