[Slim-Checkins] r10663 - in /trunk/server/Slim: Control/Request.pm
Networking/Select.pm
Schema/Storage.pm Utils/Log.pm Utils/PerfMon.pm Utils/Scheduler.pm
Utils/Timers.pm Web/HTTP.pm Web/Template/Context.pm
adrian at svn.slimdevices.com
adrian at svn.slimdevices.com
Sun Nov 12 08:03:47 PST 2006
Author: adrian
Date: Sun Nov 12 08:03:47 2006
New Revision: 10663
URL: http://svn.slimdevices.com?rev=10663&view=rev
Log:
Bug: N/A
Description: move perfmon to use log4perl logging for warnings. Add two
new l4p appenders with alternative format and send warning messages to these
Modified:
trunk/server/Slim/Control/Request.pm
trunk/server/Slim/Networking/Select.pm
trunk/server/Slim/Schema/Storage.pm
trunk/server/Slim/Utils/Log.pm
trunk/server/Slim/Utils/PerfMon.pm
trunk/server/Slim/Utils/Scheduler.pm
trunk/server/Slim/Utils/Timers.pm
trunk/server/Slim/Web/HTTP.pm
trunk/server/Slim/Web/Template/Context.pm
Modified: trunk/server/Slim/Control/Request.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Control/Request.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Control/Request.pm (original)
+++ trunk/server/Slim/Control/Request.pm Sun Nov 12 08:03:47 2006
@@ -417,7 +417,7 @@
our @notificationQueue; # contains the Requests waiting to be notified
-our $requestTask = Slim::Utils::PerfMon->new('Request Task', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5], 1);
+our $requestTask = Slim::Utils::PerfMon->new('Request Task', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5]);
my $log = logger('control.command');
@@ -1460,8 +1460,6 @@
}
# call the execute function
- my $funcName = Slim::Utils::PerlRunTime::realNameForCodeRef($self->{'_func'});
-
if (my $funcPtr = $self->{'_func'}) {
# notify for commands
@@ -1474,7 +1472,7 @@
eval { &{$funcPtr}($self) };
if ($@) {
-
+ my $funcName = Slim::Utils::PerlRunTime::realNameForCodeRef($funcPtr);
logError("While trying to run function coderef [$funcName]: [$@]");
$self->setStatusBadDispatch();
$self->dump('Request');
@@ -1484,7 +1482,7 @@
# contine execution unless the Request is still work in progress (async)...
$self->executeDone() unless $self->isStatusProcessing();
- $::perfmon && $now && $requestTask->log(Time::HiRes::time() - $now) && msg(" Execute: $funcName\n", undef, 1);
+ $::perfmon && $now && $requestTask->log(Time::HiRes::time() - $now, "Execute: ", $self->{'_func'});
}
# perform end of execution, calling the callback etc...
@@ -1642,8 +1640,7 @@
&$notifyFuncRef($self);
- $::perfmon && $requestTask->log(Time::HiRes::time() - $now) &&
- msg(sprintf(" Notify: %s\n", Slim::Utils::PerlRunTime::realNameForCodeRef($notifyFuncRef)), undef, 1);
+ $::perfmon && $requestTask->log(Time::HiRes::time() - $now, "Notify: ", $notifyFuncRef);
}
}
Modified: trunk/server/Slim/Networking/Select.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Networking/Select.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Networking/Select.pm (original)
+++ trunk/server/Slim/Networking/Select.pm Sun Nov 12 08:03:47 2006
@@ -48,7 +48,7 @@
};
our $responseTime = Slim::Utils::PerfMon->new('Response Time', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5]);
-our $selectTask = Slim::Utils::PerfMon->new('Select Task', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5], 1);
+our $selectTask = Slim::Utils::PerfMon->new('Select Task', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5]);
my $endSelectTime;
@@ -234,8 +234,7 @@
$callback->( $sock, @{$passthrough} );
- $::perfmon && $now && $selectTask->log(Time::HiRes::time() - $now) &&
- msg(sprintf(" %s\n", Slim::Utils::PerlRunTime::realNameForCodeRef($callback)), undef, 1);
+ $::perfmon && $now && $selectTask->log(Time::HiRes::time() - $now, undef, $callback);
}
$count++;
Modified: trunk/server/Slim/Schema/Storage.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Schema/Storage.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Schema/Storage.pm (original)
+++ trunk/server/Slim/Schema/Storage.pm Sun Nov 12 08:03:47 2006
@@ -21,7 +21,7 @@
use Slim::Utils::MySQLHelper;
use Slim::Utils::Prefs;
-our $dbAccess = Slim::Utils::PerfMon->new('Database Access', [0.002, 0.005, 0.01, 0.015, 0.025, 0.05, 0.1, 0.5, 1, 5], 1);
+our $dbAccess = Slim::Utils::PerfMon->new('Database Access', [0.002, 0.005, 0.01, 0.015, 0.025, 0.05, 0.1, 0.5, 1, 5]);
sub dbh {
my $self = shift;
@@ -80,7 +80,7 @@
my @ret = $self->next::method(@_);
- $::perfmon && $dbAccess->log(Time::HiRes::time() - $now) && msg(" DBIx select\n", undef, 1);
+ $::perfmon && $dbAccess->log(Time::HiRes::time() - $now, "DBIx select");
return wantarray ? @ret : $ret[0];
}
@@ -92,7 +92,7 @@
my @ret = $self->next::method(@_);
- $::perfmon && $dbAccess->log(Time::HiRes::time() - $now) && msg(" DBIx select_single\n", undef, 1);
+ $::perfmon && $dbAccess->log(Time::HiRes::time() - $now, "DBIx select_single");
return wantarray ? @ret : $ret[0];
}
Modified: trunk/server/Slim/Utils/Log.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Utils/Log.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Utils/Log.pm (original)
+++ trunk/server/Slim/Utils/Log.pm Sun Nov 12 08:03:47 2006
@@ -410,6 +410,9 @@
while (my ($key, $value) = each %config) {
+ # hide the following as they are not debugging categories
+ next if ($key =~ /additivity|perfmon/);
+
$key =~ s/^log4perl\.logger\.//;
$categories{$key} = $value;
@@ -543,6 +546,23 @@
}
return _logFileFor('scanner');
+}
+
+=head2 perfmonLogFile ( )
+
+Returns the location of SlimServer's performance monitor log file.
+
+=cut
+
+sub perfmonLogFile {
+ my $class = shift;
+
+ # If the user has requested an override.
+ if ($::logfile) {
+ return $::logfile;
+ }
+
+ return _logFileFor('perfmon');
}
sub _logFileFor {
@@ -726,6 +746,8 @@
'scan' => 'INFO',
'scan.scanner' => 'INFO',
'scan.import' => 'INFO',
+
+ 'perfmon' => 'WARN, screen-raw, perfmon',
);
# Map our shortened names to the ones l4p wants.
@@ -734,6 +756,12 @@
while (my ($category, $level) = each %defaultCategories) {
$mappedCategories{"log4perl.logger.$category"} = $level;
+
+ # turn off propagation to default appenders if specific appenders are specified
+ if ($level =~ /,/) {
+ $mappedCategories{"log4perl.additivity.$category"} = 0;
+ }
+
}
return %mappedCategories;
@@ -747,6 +775,11 @@
'screen' => {
'appender' => 'Log::Log4perl::Appender::Screen',
+ },
+
+ 'screen-raw' => {
+ 'appender' => 'Log::Log4perl::Appender::Screen',
+ 'layout' => 'raw'
},
'server' => {
@@ -760,6 +793,14 @@
'mode' => 'append',
'filename' => 'sub { Slim::Utils::Log::scannerLogFile() }',
},
+
+ 'perfmon' => {
+ 'appender' => 'Log::Log4perl::Appender::File',
+ 'mode' => 'append',
+ 'filename' => 'sub { Slim::Utils::Log::perfmonLogFile() }',
+ 'layout' => 'raw'
+ },
+
);
return $class->_fixupAppenders(\%defaultAppenders);
@@ -770,20 +811,22 @@
my $appenders = shift;
my $pattern = '';
+ my $rawpattern= '';
if ($::LogTimestamp) {
- $pattern = '[%d{HH:mm:ss.SSSS}] %M (%L) %m%n';
+ $pattern = '[%d{HH:mm:ss.SSSS}] %M (%L) %m%n';
+ $rawpattern = '[%d{HH:mm:ss.SSSS}] %m%n';
} else {
$pattern = '%M (%L) %m%n';
- }
-
- my %properties = (
+ $rawpattern = '%m%n';
+ }
+
+ my %baseProperties = (
'utf8' => 1,
'layout' => 'PatternLayout',
- 'layout.ConversionPattern' => $pattern,
);
# Make sure everyone has these properties
@@ -791,6 +834,19 @@
while (my ($appender, $data) = each %{$appenders}) {
+ my %properties = %baseProperties;
+
+ if ($data->{'layout'} && $data->{'layout'} eq 'raw') {
+
+ $properties{'layout.ConversionPattern'} = $rawpattern;
+ delete $data->{'layout'};
+
+ } else {
+
+ $properties{'layout.ConversionPattern'} = $pattern;
+
+ }
+
while (my ($property, $value) = each %properties) {
$mappedAppenders{"log4perl.appender.$appender.$property"} = $value;
Modified: trunk/server/Slim/Utils/PerfMon.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Utils/PerfMon.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Utils/PerfMon.pm (original)
+++ trunk/server/Slim/Utils/PerfMon.pm Sun Nov 12 08:03:47 2006
@@ -11,7 +11,10 @@
# version 2.
use strict;
-use Slim::Utils::Misc;
+use Slim::Utils::Log;
+use Slim::Utils::PerlRunTime;
+
+my $log = logger('perfmon');
sub new {
my $class = shift;
@@ -19,11 +22,11 @@
my $ref = {};
bless $ref, $class;
- return adjust($ref, at _);
+ return $ref->adjust(@_);
}
sub adjust {
- my ($ref, $name, $array, $noend, $warnLo, $warnHi, $warnbt) = @_;
+ my ($ref, $name, $array, $warnLo, $warnHi, $warnbt) = @_;
my $buckets = $#{$array};
@@ -35,9 +38,8 @@
$ref->{sum} = 0; # sum of logged values
$ref->{val} = []; # array holding counts per bucket
$ref->{thres} = []; # array holding thresholds per bucket
- $ref->{warnend} = $noend ? '' : "\n"; # line ending for warning message
- $ref->{warnlo} = $warnLo; # low warning threshold - msg if crossed
- $ref->{warnhi} = $warnHi; # high warning threshold - msg if crossed
+ $ref->{warnlo} = $warnLo; # low warning threshold - log if crossed
+ $ref->{warnhi} = $warnHi; # high warning threshold - log if crossed
$ref->{warnbt} = $warnbt; # bt() if warning threshold crossed
# optimise speed of logging to lowest & highest buckets by storing extra data in hash direct
@@ -84,7 +86,7 @@
my $val = shift;
$ref->{warnbt} = $val;
-}
+}
sub clear {
my $ref = shift;
@@ -98,34 +100,64 @@
$ref->{val}[$entry] = 0;
}
$ref->{valL} = 0;
-}
+}
sub log {
# normal logging method including checking of warning thresholds
- # returns 1 if threshold crossing msg produced to allow caller to add more details
# [optimised for speed by use of && rather than if statements]
- my $ref = shift;
- my $val = shift;
-
- my $warn;
+ #
+ # caller may pass 4 params:
+ # $ref - perfmon object
+ # $val - value to be logged
+ # $detail - string or sub returning a string to be added when logging threshold crossings
+ # $coderef- coderef to be convered to real name and displayed on end of threshold crossing message
+
+ my $ref = shift;
+ my $val = shift;
$ref->{sum} += $val;
($val > $ref->{max}) && ($ref->{max} = $val);
($val < $ref->{min}) && ($ref->{min} = $val);
- # test for crossing warning threshold and log msg if appropriate
- defined $ref->{warnlo} && ($val < $ref->{warnlo}) && msgf("%-16s < %5s : %8.5f%s", $ref->{name}, $ref->{warnlo}, $val, $ref->{warnend}) && ($warn = 1) && $ref->{warnbt} && bt();
- defined $ref->{warnhi} && ($val > $ref->{warnhi}) && msgf("%-16s > %5s : %8.5f%s", $ref->{name}, $ref->{warnhi}, $val, $ref->{warnend}) && ($warn = 1) && $ref->{warnbt} && bt();
+ # test for crossing warning threshold and log if appropriate
+ defined $ref->{warnlo} && $val < $ref->{warnlo} && $ref->_warn(-1, $val, @_);
+ defined $ref->{warnhi} && $val > $ref->{warnhi} && $ref->_warn( 1, $val, @_);
# shortcut for hits on first bucket
- ($val < $ref->{thresL}) && ++$ref->{valL} && return $warn;
+ $val < $ref->{thresL} && ++$ref->{valL} && return;
# shortcut for overflows past all buckets
- ($val >= $ref->{thresH}) && ++$ref->{over} && return $warn;
+ $val >= $ref->{thresH} && ++$ref->{over} && return;
# update appropriate other bucket
for my $entry (1..$ref->{buckets}) {
- ($val < $ref->{thres}[$entry]) && ++$ref->{val}[$entry] && return $warn;
+ ($val < $ref->{thres}[$entry]) && ++$ref->{val}[$entry] && return;
+ }
+}
+
+sub _warn {
+ my $ref = shift;
+ my $warn = shift;
+ my $val = shift;
+ my $details = shift || '';
+ my $coderef = shift;
+
+ if (ref $details eq 'CODE') {
+ $details = &$details;
+ }
+
+ if ($coderef) {
+ $details .= Slim::Utils::PerlRunTime::realNameForCodeRef($coderef);
+ }
+
+ my $warning = $warn < 0 ?
+ sprintf("%-16s < %5s : %8.5f %s\n", $ref->{name}, $ref->{warnlo}, $val, $details) :
+ sprintf("%-16s > %5s : %8.5f %s\n", $ref->{name}, $ref->{warnhi}, $val, $details) ;
+
+ $log->warn($warning);
+
+ if ($ref->{warnbt}) {
+ $log->warn(Slim::Utils::Misc::bt(1));
}
}
@@ -152,7 +184,7 @@
$str .= sprintf " avg : %8f\n", $ref->{sum}/$total;
} else {
-
+
for my $entry (0..$ref->{buckets}) {
$str .= sprintf "%8s : %8d :%3.0f%%\n","< ".$ref->{thres}[$entry], 0, 0;
}
@@ -179,7 +211,7 @@
}
return $count;
-}
+}
sub above {
my $ref = shift;
Modified: trunk/server/Slim/Utils/Scheduler.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Utils/Scheduler.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Utils/Scheduler.pm (original)
+++ trunk/server/Slim/Utils/Scheduler.pm Sun Nov 12 08:03:47 2006
@@ -53,7 +53,7 @@
my $log = logger('server.scheduler');
-our $schedulerTask = Slim::Utils::PerfMon->new('Scheduler Task', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5]), 1;
+our $schedulerTask = Slim::Utils::PerfMon->new('Scheduler Task', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5]);
=head1 METHODS
@@ -160,8 +160,7 @@
$curtask = 0;
}
- $::perfmon && $schedulerTask->log(Time::HiRes::time() - $now) &&
- msg(sprintf(" %s\n", Slim::Utils::PerlRunTime::realNameForCodeRef($subptr)), undef, 1);
+ $::perfmon && $schedulerTask->log(Time::HiRes::time() - $now, undef, $subptr);
}
return 1;
Modified: trunk/server/Slim/Utils/Timers.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Utils/Timers.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Utils/Timers.pm (original)
+++ trunk/server/Slim/Utils/Timers.pm Sun Nov 12 08:03:47 2006
@@ -90,7 +90,7 @@
my $checkingHighTimers = 0; # Semaphore for high priority timers
our $timerLate = Slim::Utils::PerfMon->new('Timer Late', [0.002, 0.005, 0.01, 0.015, 0.025, 0.05, 0.1, 0.5, 1, 5]);
-our $timerTask = Slim::Utils::PerfMon->new('Timer Task', [0.002, 0.005, 0.01, 0.015, 0.025, 0.05, 0.1, 0.5, 1, 5], 1);
+our $timerTask = Slim::Utils::PerfMon->new('Timer Task', [0.002, 0.005, 0.01, 0.015, 0.025, 0.05, 0.1, 0.5, 1, 5]);
my $log = logger('server.timers');
@@ -200,11 +200,7 @@
$log->warn("Normal timer with no subptr: " . Data::Dump::dump($timer));
}
- if ($::perfmon && $timerTask->log(Time::HiRes::time() - $now)) {
-
- # Supress the timestamp
- msg(sprintf(" %s\n", Slim::Utils::PerlRunTime::realNameForCodeRef($subptr)), undef, 1);
- }
+ $::perfmon && $timerTask->log(Time::HiRes::time() - $now, undef, $subptr);
}
$checkingNormalTimers = 0;
Modified: trunk/server/Slim/Web/HTTP.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Web/HTTP.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Web/HTTP.pm (original)
+++ trunk/server/Slim/Web/HTTP.pm Sun Nov 12 08:03:47 2006
@@ -91,7 +91,7 @@
our %forkFunctions = ();
tie %forkFunctions, 'Tie::RegexpHash';
-our $pageBuild = Slim::Utils::PerfMon->new('Web Page Build', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5], 1);
+our $pageBuild = Slim::Utils::PerfMon->new('Web Page Build', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5]);
our %dangerousCommands = (
# name of command => regexp for URI patterns that make it dangerous
@@ -874,8 +874,7 @@
);
}
- $::perfmon && $startTime && $pageBuild->log(Time::HiRes::time() - $startTime) &&
- msg(sprintf(" Page: %s\n", $path || '/'), undef, 1);
+ $::perfmon && $startTime && $pageBuild->log(Time::HiRes::time() - $startTime, "Page: $path");
} elsif ($path =~ /^(?:stream\.mp3|stream)$/o) {
Modified: trunk/server/Slim/Web/Template/Context.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Web/Template/Context.pm?rev=10663&r1=10662&r2=10663&view=diff
==============================================================================
--- trunk/server/Slim/Web/Template/Context.pm (original)
+++ trunk/server/Slim/Web/Template/Context.pm Sun Nov 12 08:03:47 2006
@@ -14,7 +14,7 @@
use strict;
use base 'Template::Context';
-our $procTemplate = Slim::Utils::PerfMon->new('Process Template', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5], 1);
+our $procTemplate = Slim::Utils::PerfMon->new('Process Template', [0.002, 0.005, 0.010, 0.015, 0.025, 0.050, 0.1, 0.5, 1, 5]);
my $indent = 0;
my $last = 0;
@@ -22,8 +22,6 @@
sub process {
my $self = shift;
-
- $::perfmon && $indent++;
my $now = Time::HiRes::time();
@@ -35,12 +33,25 @@
}
- my $ret = \$self->SUPER::process(@_);
+ unless ($::perfmon) {
- $::perfmon && $indent-- && $procTemplate->log(Time::HiRes::time() - $now) &&
- Slim::Utils::Misc::msg(sprintf(" %s%s\n", " " x $indent, ref $_[0] ? $_[0]->{'name'} : $_[0]), undef, 1);
+ return $self->SUPER::process(@_);
- return $$ret;
+ } else {
+
+ my $temp = $_[0];
+
+ $indent++;
+
+ my $ret = \$self->SUPER::process(@_);
+
+ $indent--;
+
+ $procTemplate->log(Time::HiRes::time() - $now, sub { " " x $indent . (ref $temp ? $temp->{'name'} : $temp) } );
+
+ return $$ret;
+
+ }
}
1;
More information about the checkins
mailing list