From: Matt S Trout Date: Wed, 17 Apr 2019 01:32:39 +0000 (+0000) Subject: wrap expander and expander list X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3f9899e505733687a57b30404dff4a060dca7474;p=scpubgit%2FQ-Branch.git wrap expander and expander list --- diff --git a/lib/SQL/Abstract/Clauses.pm b/lib/SQL/Abstract/Clauses.pm index 605424f..a6ba62d 100644 --- a/lib/SQL/Abstract/Clauses.pm +++ b/lib/SQL/Abstract/Clauses.pm @@ -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: $@"; } } diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/ExtraClauses.pm index 6a27d43..eaac9c1 100644 --- a/lib/SQL/Abstract/ExtraClauses.pm +++ b/lib/SQL/Abstract/ExtraClauses.pm @@ -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}" => {