lib/SQL/Abstract/Plugin/BangOverrides.pm

   1 package SQL::Abstract::Plugin::BangOverrides;
   2
   3 use Moo;
   4
   5 with 'SQL::Abstract::Role::Plugin';
   6
   7 sub register_extensions {
   8   my ($self, $sqla) = @_;
   9   foreach my $stmt ($sqla->statement_list) {
  10     $sqla->wrap_expander($stmt => sub ($orig) {
  11       sub {
  12         my ($self, $name, $args) = @_;
  13         my %args = %$args;
  14         foreach my $clause (map /^!(.*)$/, keys %args) {
  15           my $override = delete $args{"!${clause}"};
  16           $args{$clause} = (
  17             ref($override) eq 'CODE'
  18               ? $override->($args{$clause})
  19               : $override
  20           );
  21         }
  22         $self->$orig($name, \%args);
  23       }
  24     });
  25   }
  26 }
  27
  28 1;