cvsuser 04/11/18 11:47:10
Modified: lib Qpsmtpd.pm
lib/Qpsmtpd Plugin.pm
Log:
Move plugin compile code into the Plugin module
Revision Changes Path
1.45 +1 -46 qpsmtpd/lib/Qpsmtpd.pm
Index: Qpsmtpd.pm
===================================================================
RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- Qpsmtpd.pm 19 Sep 2004 18:49:05 -0000 1.44
+++ Qpsmtpd.pm 18 Nov 2004 19:47:09 -0000 1.45
@@ -121,51 +121,6 @@
return wantarray ? @config : $config[0];
}
-sub _compile {
- my ($self, $plugin, $package, $file) = @_;
-
- my $sub;
- open F, $file or die "could not open $file: $!";
- {
- local $/ = undef;
- $sub = <F>;
- }
- close F;
-
- my $line = "\n#line 1 $file\n";
-
- if ($self->{_test_mode}) {
- if (open(F, "t/plugin_tests/$plugin")) {
- local $/ = undef;
- $sub .= "#line 1 t/plugin_tests/$plugin\n";
- $sub .= <F>;
- close F;
- }
- }
-
- my $eval = join(
- "\n",
- "package $package;",
- 'use Qpsmtpd::Constants;',
- "require Qpsmtpd::Plugin;",
- 'use vars qw(@ISA);',
- '@ISA = qw(Qpsmtpd::Plugin);',
- ($self->{_test_mode} ? 'use Test::More;' : ''),
- "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;
@@ -230,7 +185,7 @@
my $package = "Qpsmtpd::Plugin::$plugin_name";
# don't reload plugins if they are already loaded
- $self->_compile($plugin_name, $package, "$dir/$plugin") unless
+ Qpsmtpd::Plugin->compile($plugin_name, $package, "$dir/$plugin",
$self->{_test_mode}) unless
defined &{"${package}::register"};
my $plug = $package->new();
1.14 +45 -0 qpsmtpd/lib/Qpsmtpd/Plugin.pm
Index: Plugin.pm
===================================================================
RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd/Plugin.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- Plugin.pm 19 Sep 2004 18:49:05 -0000 1.13
+++ Plugin.pm 18 Nov 2004 19:47:10 -0000 1.14
@@ -75,4 +75,49 @@
push @{"${currentPackage}::ISA"}, $newPackage;
}
+sub compile {
+ my ($class, $plugin, $package, $file, $test_mode) = @_;
+
+ my $sub;
+ open F, $file or die "could not open $file: $!";
+ {
+ local $/ = undef;
+ $sub = <F>;
+ }
+ close F;
+
+ my $line = "\n#line 1 $file\n";
+
+ if ($test_mode) {
+ if (open(F, "t/plugin_tests/$plugin")) {
+ local $/ = undef;
+ $sub .= "#line 1 t/plugin_tests/$plugin\n";
+ $sub .= <F>;
+ close F;
+ }
+ }
+
+ my $eval = join(
+ "\n",
+ "package $package;",
+ 'use Qpsmtpd::Constants;',
+ "require Qpsmtpd::Plugin;",
+ 'use vars qw(@ISA);',
+ '@ISA = qw(Qpsmtpd::Plugin);',
+ ($test_mode ? 'use Test::More;' : ''),
+ "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 $@;
+}
+
1;
