Skip to content

Commit

Permalink
More crazy performance stuff
Browse files Browse the repository at this point in the history
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@845 958fd67b-6ff1-0310-b445-bb7760255be9
  • Loading branch information
Matt Sergeant committed Feb 8, 2008
1 parent 367c9a3 commit 214e7e0
Show file tree
Hide file tree
Showing 3 changed files with 41 additions and 61 deletions.
28 changes: 12 additions & 16 deletions lib/Qpsmtpd.pm
Expand Up @@ -15,7 +15,6 @@ my %defaults = (
timeout => 1200,
);
my $_config_cache = {};
clear_config_cache();

#DashProfiler->add_profile("qpsmtpd");
#my $SAMPLER = DashProfiler->prepare("qpsmtpd");
Expand Down Expand Up @@ -57,23 +56,21 @@ sub load_logging {
$self->log(LOGINFO, "Loaded $logger");
}

$configdir = $self->config_dir("loglevel");
$configfile = "$configdir/loglevel";
$TraceLevel = $self->_config_from_file($configfile,'loglevel');

unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
$TraceLevel = LOGWARN; # Default if no loglevel file found.
}

$LOGGING_LOADED = 1;

return @loggers;
}

sub trace_level {
my $self = shift;
return $TraceLevel if $TraceLevel;

my $configdir = $self->config_dir("loglevel");
my $configfile = "$configdir/loglevel";
$TraceLevel = $self->_config_from_file($configfile,'loglevel');

unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
$TraceLevel = LOGWARN; # Default if no loglevel file found.
}

return $TraceLevel;
}

Expand Down Expand Up @@ -106,18 +103,15 @@ sub varlog {
unless ( $rc and $rc == DECLINED or $rc == OK ) {
# no logging plugins registered so fall back to STDERR
warn join(" ", $$ .
(defined $plugin ? " $plugin plugin:" :
(defined $plugin ? " $plugin plugin ($hook):" :
defined $hook ? " running plugin ($hook):" : ""),
@log), "\n"
if $trace <= $self->trace_level();
if $trace <= $TraceLevel;
}
}

sub clear_config_cache {
$_config_cache = {};
for (keys %defaults) {
$_config_cache->{$_} = [$defaults{$_}];
}
}

#
Expand All @@ -133,6 +127,8 @@ sub config {
return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0];
}

$_config_cache->{$c} = [$defaults{$c}] if exists($defaults{$c});

#warn "SELF->config($c) ", ref $self;

my ($rc, @config) = $self->run_hooks_no_respond("config", $c);
Expand Down
4 changes: 2 additions & 2 deletions lib/Qpsmtpd/Plugin.pm
Expand Up @@ -60,8 +60,8 @@ sub qp {

sub log {
my $self = shift;
$self->qp->varlog(shift, $self->hook_name, $self->plugin_name, @_)
unless defined $self->hook_name and $self->hook_name eq 'logging';
$self->{_qp}->varlog(shift, $self->{_hook}, $self->plugin_name, @_)
unless defined $self->{_hook} and $self->{_hook} eq 'logging';
}

sub transaction {
Expand Down
70 changes: 27 additions & 43 deletions lib/Qpsmtpd/PollServer.pm
Expand Up @@ -103,59 +103,43 @@ sub fault {
return;
}

my %cmd_cache;

sub process_line {
my Qpsmtpd::PollServer $self = shift;
my $line = shift || return;
if ($::DEBUG > 1) { print "$$:".($self+0)."C($self->{mode}): $line"; }
eval { $self->_process_line($line) };
if ($@) {
print STDERR "Error: $@\n";
return $self->fault("command failed unexpectedly") if $self->{mode} eq 'cmd';
return $self->fault("unknown error");
if ($self->{mode} eq 'cmd') {
$line =~ s/\r?\n//;
my ($cmd, @params) = split(/ +/, $line, 2);
my $meth = lc($cmd);
if (my $lookup = $cmd_cache{$meth} || $self->{_commands}->{$meth} && $self->can($meth)) {
$cmd_cache{$meth} = $lookup;
eval {
$lookup->($self, @params);
};
if ($@) {
my $error = $@;
chomp($error);
$self->log(LOGERROR, "Command Error: $error");
$self->fault("command '$cmd' failed unexpectedly");
}
}
else {
# No such method - i.e. unrecognized command
my ($rc, $msg) = $self->run_hooks("unrecognized_command", $meth, @params);
}
}
return;
}

sub _process_line {
my Qpsmtpd::PollServer $self = shift;
my $line = shift;

if ($self->{mode} eq 'connect') {
elsif ($self->{mode} eq 'connect') {
$self->{mode} = 'cmd';
my $rc = $self->start_conversation;
return;
}
elsif ($self->{mode} eq 'cmd') {
$line =~ s/\r?\n//;
return $self->process_cmd($line);
# I've removed an eval{} from around this. It shouldn't ever die()
# but if it does we're a bit screwed... Ah well :-)
$self->start_conversation;
}
else {
die "Unknown mode";
}
}

sub process_cmd {
my Qpsmtpd::PollServer $self = shift;
my $line = shift;
my ($cmd, @params) = split(/ +/, $line, 2);
my $meth = lc($cmd);
if (my $lookup = $self->{_commands}->{$meth} && $self->can($meth)) {
my $resp = eval {
$lookup->($self, @params);
};
if ($@) {
my $error = $@;
chomp($error);
$self->log(LOGERROR, "Command Error: $error");
return $self->fault("command '$cmd' failed unexpectedly");
}
return $resp;
}
else {
# No such method - i.e. unrecognized command
my ($rc, $msg) = $self->run_hooks("unrecognized_command", $meth, @params);
return 1;
}
return;
}

sub disconnect {
Expand Down

0 comments on commit 214e7e0

Please sign in to comment.