> > In terms of backwards compatibility - we can maintain it by having the
> > (current) register subroutine create the appropriate subroutine or
> > alias.
>
> Or the other way around - if the hook_* functions exist, have
> register_hook called magically behind the scenes when you lookup whether
> it "can" do the hooks.
Good idea. This is cleaner. Patch below.
> Interesting idea. Since many plugins use register() as an opportunity
> to parse their config line options and initialize private storage,
> your new scheme would require some other way of accomplishing that
> task, like an init() function which is called when loading the plugin
> (supplying the command line args, which is why BEGIN {} wouldn't
> work).
register() doesn't have to go away -- it can still be used for parsing
command line options and initializing private storage.
> Other than that, it sounds good! As you say, it's going to slightly
> annoying to loop over the available hook subs for each plugin; perhaps
> the loop should shortcut if the plugin _has_ a register() sub already
> (old-style, in other words).
I'm not sure if this is worth it. 20 $class->can's can't be that slow.
Do we want to "draw a line" and say old style has register() and new
style has init()? (And use that to differentiate?) Backwards
compatibility is preserved either way.
Anyway, here's a patch for eyeballing. I'll commit it if nobody
screams. Then, after 0.30 goes out, I'll modify all the core hooks to
use this model.
One issue is some of our hook names aren't valid subroutine names.
I've handled that with the s/\W/_/g;
Further below is an example of a child plugin. Works quite nicely.
-R
=== lib/Qpsmtpd/Plugin.pm
==================================================================
--- lib/Qpsmtpd/Plugin.pm (revision 454)
+++ lib/Qpsmtpd/Plugin.pm (local)
@@ -16,7 +16,7 @@
sub register_hook {
my ($plugin, $hook, $method, $unshift) = @_;
-
+
die $plugin->plugin_name . " : Invalid hook: $hook" unless $hooks{$hook};
# I can't quite decide if it's better to parse this code ref or if
@@ -33,6 +33,7 @@
my $qp = shift;
local $self->{_qp} = $qp;
$self->register($qp, @_);
+ $self->register_standard_hooks($qp, @_);
}
sub qp {
@@ -86,7 +87,7 @@
return if defined &{"${newPackage}::register"};
- Qpsmtpd::_compile($self->plugin_name . "_isa",
+ $self->compile($self->plugin_name . "_isa",
$newPackage,
"plugins/$parent"); # assumes Cwd is qpsmtpd root
@@ -141,4 +142,16 @@
die "eval $@" if $@;
}
+sub register_standard_hooks {
+ my ($plugin, $qp) = @_;
+
+ for my $hook (keys %hooks) {
+ my $hooksub = "hook_$hook";
+ $hooksub =~ s/\W/_/g;
+ $plugin->register_hook( $hook, $hooksub )
+ if ($plugin->can($hooksub));
+ }
+}
+
+
#- --- example child plugin
# -*- perl -*-
sub register {
my ($self, $qp) = @_;
$self->isa_plugin('rcpt_ok');
}
sub hook_rcpt {
my ($self, $transaction, $recipient) = @_;
warn "uh.. don't really care, just calling child\n";
$self->SUPER::hook_rcpt( $transaction, $recipient );
}
sub hook_helo {
return DECLINED;
}
