From: Matt S Trout Date: Mon, 7 Oct 2019 14:49:24 +0000 (+0000) Subject: mst forgot to git add this. mst is a fool. mst did this with svn too. X-Git-Tag: v2.000000~3^2~27 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=60add55aa345ab75aa24b4fb72917d17595e9eb4;p=dbsrgits%2FSQL-Abstract.git mst forgot to git add this. mst is a fool. mst did this with svn too. --- diff --git a/lib/SQL/Abstract/Role/Plugin.pm b/lib/SQL/Abstract/Role/Plugin.pm new file mode 100644 index 0000000..47c325e --- /dev/null +++ b/lib/SQL/Abstract/Role/Plugin.pm @@ -0,0 +1,72 @@ +package SQL::Abstract::Role::Plugin; + +use Moo::Role; + +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); +} + +requires 'register_extensions'; + +1; + +__END__ + +=head1 NAME + +SQL::Abstract::Role::Plugin - helpful methods for plugin authors + +=head1 METHODS + +=head2 apply_to + +Applies the plugin to an L object. + +=head2 register_extensions + +Provided by the plugin, registers its extensions to the sqla object. + +=head2 cb + +Creates a callback to call a method on the plugin. + +=head2 register + +Calls methods on the sqla object with arguments wrapped as callbacks. + +=head2 sqla + +Available only during plugin callback executions, contains the currently +active L object. + +=cut