From: Matt S Trout Date: Thu, 3 Oct 2019 03:34:14 +0000 (+0000) Subject: plugin registration X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FQ-Branch.git;a=commitdiff_plain;h=d10d5b94f1f9b2aec782007c6f528755e1b93cee plugin registration --- diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 1d4a14d..5ed6fcf 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -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 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; diff --git a/lib/SQL/Abstract/ExtraClauses.pm b/lib/SQL/Abstract/Plugin/ExtraClauses.pm similarity index 96% rename from lib/SQL/Abstract/ExtraClauses.pm rename to lib/SQL/Abstract/Plugin/ExtraClauses.pm index e1029bc..10d5839 100644 --- a/lib/SQL/Abstract/ExtraClauses.pm +++ b/lib/SQL/Abstract/Plugin/ExtraClauses.pm @@ -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) = @_; diff --git a/t/80extra_clauses.t b/t/80extra_clauses.t index ad56f95..c985c06 100644 --- a/t/80extra_clauses.t +++ b/t/80extra_clauses.t @@ -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 ],