File: //usr/share/perl5/vendor_perl/Amavis/Timing.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::Timing;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&init §ion_time &report &get_time_so_far
&get_rusage &rusage_report);
}
use subs @EXPORT_OK;
use vars qw(@timing $rusage_self_initial $rusage_children_initial);
use Time::HiRes ();
sub get_rusage() {
my($rusage_self, $rusage_children);
$rusage_self = Unix::Getrusage::getrusage()
if Unix::Getrusage->UNIVERSAL::can("getrusage");
$rusage_children = Unix::Getrusage::getrusage_children()
if $rusage_self && Unix::Getrusage->UNIVERSAL::can("getrusage_children");
# ru_minflt no. of page faults serviced without I/O activity
# ru_majflt no. of page faults that required I/O activity
# ru_nswap no. of times a process was swapped out
# ru_inblock no. of times a file system had to perform input
# ru_oublock no. of times a file system had to perform output
# ru_msgsnd no. of IPC messages sent
# ru_msgrcv no. of IPC messages received
# ru_nsignals no. of signals delivered
# ru_nvcsw no. of voluntary context switches
# ru_nivcsw no. of involuntary context switches
# ru_maxrss [kB] maximum resident set size utilized
# ru_ixrss [kBtics] integral of mem used by the shared text segment
# ru_idrss [kBtics] integral of unshared mem in the data segment
# ru_isrss [kBtics] integral of unshared mem in the stack segment
# ru_utime [s] time spent executing in user mode
# ru_stime [s] time spent in the system on behalf of the process
($rusage_self, $rusage_children);
}
# clear array @timing and enter start time
#
sub init() {
@timing = (); section_time('init');
($rusage_self_initial, $rusage_children_initial) = get_rusage();
}
# enter current time reading into array @timing
#
sub section_time($) {
push(@timing, $_[0], Time::HiRes::time);
}
# returns a string - a report of elapsed time by section
#
sub report() {
my($rusage_self, $rusage_children);
($rusage_self, $rusage_children) = get_rusage() if $rusage_self_initial;
section_time('rundown');
my($notneeded, $t0) = (shift(@timing), shift(@timing));
my $total = $t0 <= 0 ? 0 : $timing[-1] - $t0;
if ($total < 0.0000001) { $total = 0.0000001 }
my(@sections); my $t00 = $t0;
while (@timing) {
my($section, $t) = (shift(@timing), shift(@timing));
my $dt = $t <= $t0 ? 0 : $t-$t0; # handle possible clock jumps
my $dt_c = $t <= $t00 ? 0 : $t-$t00; # handle possible clock jumps
my $dtp = $dt >= $total ? 100 : $dt*100.0/$total; # this event
my $dtp_c = $dt_c >= $total ? 100 : $dt_c*100.0/$total; # cumulative
my $fmt = $dt >= 0.005 ? "%.0f" : "%.1f";
push(@sections, sprintf("%s: $fmt (%.0f%%)%.0f",
$section, $dt*1000, $dtp, $dtp_c));
$t0 = $t;
}
my $cpu_usage_sum;
if ($rusage_self && $rusage_children) {
$cpu_usage_sum =
($rusage_self->{ru_utime} - $rusage_self_initial->{ru_utime}) +
($rusage_self->{ru_stime} - $rusage_self_initial->{ru_stime}) +
($rusage_children->{ru_utime} - $rusage_children_initial->{ru_utime}) +
($rusage_children->{ru_stime} - $rusage_children_initial->{ru_stime});
}
!$cpu_usage_sum ?
sprintf('TIMING [total %.0f ms] - %s', $total*1000, join(', ',@sections))
: sprintf('TIMING [total %.0f ms, cpu %.0f ms] - %s',
$total*1000, $cpu_usage_sum*1000, join(', ',@sections));
}
# returns a string - getrusage(2) counters deltas and gauges
#
sub rusage_report() {
my($rusage_self, $rusage_children) = get_rusage();
my(@msg);
if ($rusage_self && $rusage_children) {
my(@fields) = qw(minflt majflt nswap inblock oublock
msgsnd msgrcv nsignals nvcsw nivcsw
maxrss ixrss idrss isrss utime stime);
for (@fields) {
my $cn = 'ru_' . $_;
my $f = '%d';
if ($_ eq 'maxrss') {
# this one is a gauge, not a counter
} else { # is a counter
$rusage_self->{$cn} -= $rusage_self_initial->{$cn};
$rusage_children->{$cn} -= $rusage_children_initial->{$cn};
$f = '%.3f' if /time\z/;
}
push(@msg, sprintf("%s=$f+$f", $_, $rusage_self->{$cn},
$rusage_children->{$cn}));
}
}
!@msg ? undef : join(', ',@msg);
}
# returns value in seconds of elapsed time for processing of this mail so far
#
sub get_time_so_far() {
my($notneeded, $t0) = @timing;
my $total = $t0 <= 0 ? 0 : Time::HiRes::time - $t0;
$total < 0 ? 0 : $total;
}
use vars qw($t_was_busy $t_busy_cum $t_idle_cum $t0);
sub idle_proc(@) {
my $t1 = Time::HiRes::time;
if (defined $t0) {
($t_was_busy ? $t_busy_cum : $t_idle_cum) += $t1 - $t0;
Amavis::Util::ll(5) && Amavis::Util::do_log(5,
'idle_proc, %s: was %s, %.1f ms, total idle %.3f s, busy %.3f s',
$_[0], $t_was_busy ? 'busy' : 'idle', 1000*($t1 - $t0),
$t_idle_cum, $t_busy_cum);
}
$t0 = $t1;
}
sub go_idle(@) {
if ($t_was_busy) { idle_proc(@_); $t_was_busy = 0 }
}
sub go_busy(@) {
if (!$t_was_busy) { idle_proc(@_); $t_was_busy = 1 }
}
sub report_load() {
$t_busy_cum + $t_idle_cum <= 0 ? undef
: sprintf('load: %.0f %%, total idle %.3f s, busy %.3f s',
100*$t_busy_cum / ($t_busy_cum + $t_idle_cum), $t_idle_cum, $t_busy_cum);
}
1;