From 606519b06c32e91f35604223d1a52fe0a407e81a Mon Sep 17 00:00:00 2001 From: Matt Sergeant Date: Sun, 5 Sep 2004 16:28:08 +0000 Subject: [PATCH] Fix for hooks not running with previous patch, caused by qpsmtpd objects not asking each plugin to register. There is slightly more overhead this way, but it feels more correct, and we can fix the overhead later in a more clean way. git-svn-id: https://svn.perl.org/qpsmtpd/trunk@300 958fd67b-6ff1-0310-b445-bb7760255be9 --- lib/Qpsmtpd.pm | 68 ++++++++++++++++++++++++--------------------- lib/Qpsmtpd/SMTP.pm | 2 ++ 2 files changed, 38 insertions(+), 32 deletions(-) diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index bcd9e2e..ed826f6 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -111,6 +111,40 @@ sub _config_from_file { return wantarray ? @config : $config[0]; } +sub _compile { + my ($plugin, $package, $file) = @_; + + my $sub; + open F, $file or die "could not open $file: $!"; + { + local $/ = undef; + $sub = ; + } + close F; + + my $line = "\n#line 1 $file\n"; + + my $eval = join( + "\n", + "package $package;", + 'use Qpsmtpd::Constants;', + "require Qpsmtpd::Plugin;", + 'use vars qw(@ISA);', + '@ISA = qw(Qpsmtpd::Plugin);', + "sub plugin_name { qq[$plugin] }", + $line, + $sub, + "\n", # last line comment without newline? + ); + + #warn "eval: $eval"; + + $eval =~ m/(.*)/s; + $eval = $1; + + eval $eval; + die "eval $@" if $@; +} sub load_plugins { my $self = shift; @@ -174,39 +208,9 @@ sub _load_plugins { my $package = "Qpsmtpd::Plugin::$plugin_name"; # don't reload plugins if they are already loaded - next if defined &{"${package}::register"}; + _compile($plugin_name, $package, "$dir/$plugin") unless + defined &{"${package}::register"}; - my $sub; - open F, "$dir/$plugin" or die "could not open $dir/$plugin: $!"; - { - local $/ = undef; - $sub = ; - } - close F; - - my $line = "\n#line 1 $dir/$plugin\n"; - - my $eval = join( - "\n", - "package $package;", - 'use Qpsmtpd::Constants;', - "require Qpsmtpd::Plugin;", - 'use vars qw(@ISA);', - '@ISA = qw(Qpsmtpd::Plugin);', - "sub plugin_name { qq[$plugin_name] }", - $line, - $sub, - "\n", # last line comment without newline? - ); - - #warn "eval: $eval"; - - $eval =~ m/(.*)/s; - $eval = $1; - - eval $eval; - die "eval $@" if $@; - my $plug = $package->new(); $plug->_register($self, @args); diff --git a/lib/Qpsmtpd/SMTP.pm b/lib/Qpsmtpd/SMTP.pm index 1f4f2d0..3e7bdbc 100644 --- a/lib/Qpsmtpd/SMTP.pm +++ b/lib/Qpsmtpd/SMTP.pm @@ -33,6 +33,8 @@ sub new { my (%commands); @commands{@commands} = ('') x @commands; # this list of valid commands should probably be a method or a set of methods $self->{_commands} = \%commands; + + $self->load_plugins; $self; }