cvs commit: qpsmtpd/lib Qpsmtpd.pm

[email protected] (Matt Sergeant)
Newsgroups perl.cvs.qpsmtpd
Message-ID <[email protected]>
cvsuser     04/09/05 09:28:08

  Modified:    lib/Qpsmtpd SMTP.pm
               lib      Qpsmtpd.pm
  Log:
  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.
  
  Revision  Changes    Path
  1.39      +2 -0      qpsmtpd/lib/Qpsmtpd/SMTP.pm
  
  Index: SMTP.pm
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd/SMTP.pm,v
  retrieving revision 1.38
  retrieving revision 1.39
  diff -u -w -r1.38 -r1.39
  --- SMTP.pm	5 Sep 2004 04:30:21 -0000	1.38
  +++ SMTP.pm	5 Sep 2004 16:28:08 -0000	1.39
  @@ -34,6 +34,8 @@
     # this list of valid commands should probably be a method or a set of methods
     $self->{_commands} = \%commands;
   
  +  $self->load_plugins;
  +
     $self;
   }
   
  
  
  
  1.40      +36 -32    qpsmtpd/lib/Qpsmtpd.pm
  
  Index: Qpsmtpd.pm
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd.pm,v
  retrieving revision 1.39
  retrieving revision 1.40
  diff -u -w -r1.39 -r1.40
  --- Qpsmtpd.pm	4 Sep 2004 03:16:10 -0000	1.39
  +++ Qpsmtpd.pm	5 Sep 2004 16:28:08 -0000	1.40
  @@ -111,6 +111,40 @@
     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 = <F>;
  +    }
  +    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,38 +208,8 @@
       my $package = "Qpsmtpd::Plugin::$plugin_name";
   
       # don't reload plugins if they are already loaded
  -    next if defined &{"${package}::register"};
  -    
  -    my $sub;
  -    open F, "$dir/$plugin" or die "could not open $dir/$plugin: $!";
  -    { 
  -      local $/ = undef;
  -      $sub = <F>;
  -    }
  -    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 $@;
  +    _compile($plugin_name, $package, "$dir/$plugin") unless
  +        defined &{"${package}::register"};
   
       my $plug = $package->new();
       $plug->_register($self, @args);
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.