More crazy performance stuff

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@845 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant 2008-02-08 21:26:25 +00:00
parent 367c9a31a9
commit 214e7e0ec0
3 changed files with 42 additions and 62 deletions

View File

@ -15,7 +15,6 @@ my %defaults = (
timeout => 1200,
);
my $_config_cache = {};
clear_config_cache();
#DashProfiler->add_profile("qpsmtpd");
#my $SAMPLER = DashProfiler->prepare("qpsmtpd");
@ -57,6 +56,14 @@ 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;
@ -64,16 +71,6 @@ sub load_logging {
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;
}
@ -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{$_}];
}
}
#
@ -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);

View File

@ -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 {

View File

@ -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");
}
return;
}
sub _process_line {
my Qpsmtpd::PollServer $self = shift;
my $line = shift;
if ($self->{mode} eq 'connect') {
$self->{mode} = 'cmd';
my $rc = $self->start_conversation;
return;
}
elsif ($self->{mode} eq 'cmd') {
if ($self->{mode} eq 'cmd') {
$line =~ s/\r?\n//;
return $self->process_cmd($line);
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);
}
}
elsif ($self->{mode} eq 'connect') {
$self->{mode} = 'cmd';
# 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 {