X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FQ-Branch.git;a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FPlugin%2FBangOverrides.pm;fp=lib%2FSQL%2FAbstract%2FPlugin%2FBangOverrides.pm;h=3a0b377a97aab323a1ddb76279fd0d7907986cbe;hp=0000000000000000000000000000000000000000;hb=d10d5b94f1f9b2aec782007c6f528755e1b93cee;hpb=e376aa8053a377ca85e9a16205132b30436b2ce5

diff --git a/lib/SQL/Abstract/Plugin/BangOverrides.pm b/lib/SQL/Abstract/Plugin/BangOverrides.pm
new file mode 100644
index 0000000..3a0b377
--- /dev/null
+++ b/lib/SQL/Abstract/Plugin/BangOverrides.pm
@@ -0,0 +1,28 @@
+package SQL::Abstract::Plugin::BangOverrides;
+
+use Moo;
+
+with 'SQL::Abstract::Role::Plugin';
+
+sub register_extensions {
+  my ($self, $sqla) = @_;
+  foreach my $stmt ($sqla->statement_list) {
+    $sqla->wrap_expander($stmt => sub ($orig) {
+      sub {
+        my ($self, $name, $args) = @_;
+        my %args = %$args;
+        foreach my $clause (map /^!(.*)$/, keys %args) {
+          my $override = delete $args{"!${clause}"};
+          $args{$clause} = (
+            ref($override) eq 'CODE'
+              ? $override->($args{$clause})
+              : $override
+          );
+        }
+        $self->$orig($name, \%args);
+      }
+    });
+  }
+}
+
+1;