plugin registration
Matt S Trout [Thu, 3 Oct 2019 03:34:14 +0000 (03:34 +0000)]
lib/SQL/Abstract.pm
lib/SQL/Abstract/Plugin/BangOverrides.pm [new file with mode: 0644]
lib/SQL/Abstract/Plugin/ExtraClauses.pm [moved from lib/SQL/Abstract/ExtraClauses.pm with 96% similarity]
t/80extra_clauses.t

index c84d134..a130a4d 100644 (file)
@@ -327,6 +327,15 @@ sub make_binop_expander {
   }
 }
 
+sub plugin {
+  my ($self, $plugin, @args) = @_;
+  unless (ref $plugin) {
+    $plugin =~ s/\A\+/${\ref($self)}::Plugin::/;
+    require(join('/', split '::', $plugin).'.pm');
+  }
+  $plugin->apply_to($self, @args);
+}
+
 BEGIN {
   foreach my $type (qw(
     expand op_expand render op_render clause_expand clause_render
diff --git a/lib/SQL/Abstract/Plugin/BangOverrides.pm b/lib/SQL/Abstract/Plugin/BangOverrides.pm
new file mode 100644 (file)
index 0000000..3a0b377
--- /dev/null
@@ -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;
similarity index 96%
rename from lib/SQL/Abstract/ExtraClauses.pm
rename to lib/SQL/Abstract/Plugin/ExtraClauses.pm
index e1029bc..10d5839 100644 (file)
@@ -1,40 +1,8 @@
-package SQL::Abstract::ExtraClauses;
+package SQL::Abstract::Plugin::ExtraClauses;
 
 use Moo;
 
-has sqla => (
-  is => 'ro', init_arg => undef,
-  handles => [ qw(
-    expand_expr render_aqt join_query_parts
-  ) ],
-);
-
-sub cb {
-  my ($self, $method, @args) = @_;
-  return sub {
-    local $self->{sqla} = shift;
-    $self->$method(@args, @_)
-  };
-}
-
-sub register {
-  my ($self, @pairs) = @_;
-  my $sqla = $self->sqla;
-  while (my ($method, $cases) = splice(@pairs, 0, 2)) {
-    my @cases = @$cases;
-    while (my ($name, $case) = splice(@cases, 0, 2)) {
-      $sqla->$method($name, $self->cb($case));
-    }
-  }
-  return $self;
-}
-
-sub apply_to {
-  my ($self, $sqla) = @_;
-  $self = $self->new unless ref($self);
-  local $self->{sqla} = $sqla;
-  $self->register_extensions($sqla);
-}
+with 'SQL::Abstract::Role::Plugin';
 
 sub register_extensions {
   my ($self, $sqla) = @_;
index ad56f95..c985c06 100644 (file)
@@ -3,11 +3,8 @@ use warnings;
 use Test::More;
 use SQL::Abstract::Test import => [ qw(is_same_sql_bind is_same_sql) ];
 use SQL::Abstract;
-use SQL::Abstract::ExtraClauses;
 
-my $sqlac = SQL::Abstract->new;
-
-SQL::Abstract::ExtraClauses->apply_to($sqlac);
+my $sqlac = SQL::Abstract->new->plugin('+ExtraClauses');
 
 is_deeply(
   [ $sqlac->statement_list ],