App-Context
view release on metacpan or search on metacpan
lib/App/Context.pm view on Meta::CPAN
$time_elapsed = Time::HiRes::tv_interval($first_timeofday, $last_timeofday);
}
return($time_elapsed);
}
sub profile_stats {
my ($self) = @_;
return($self->{profile_stats} || {});
}
sub profile_clear {
my ($self) = @_;
delete $self->{profile_stats};
delete $self->{profile_state};
}
sub set_profile_state_value {
my ($self, $state_var, $state_value) = @_;
$self->{profile_state}{$state_var} = $state_value;
}
sub profile_log {
my ($self) = @_;
my $profile_stats = $self->profile_stats();
$self->log("PROFILE: cumultime count avgtime mintime maxtime key\n");
my ($stats);
foreach my $key (sort { $profile_stats->{$b}{cumul_time} <=> $profile_stats->{$a}{cumul_time} } keys %$profile_stats) {
$stats = $profile_stats->{$key};
if ($stats->{count}) {
$self->log("PROFILE: %10.4f %10d %8.4f %8.4f %8.4f %s\n",
$stats->{cumul_time},
$stats->{count},
$stats->{cumul_time}/$stats->{count},
$stats->{min_time},
$stats->{max_time},
$key);
}
}
}
#############################################################################
# SYSTEM AND PROCESS INFORMATION
#############################################################################
# /proc/meminfo
# total: used: free: shared: buffers: cached:
# Mem: 525942784 468914176 57028608 0 69124096 51593216
# Swap: 1069268992 56954880 1012314112
# MemTotal: 513616 kB
# MemFree: 55692 kB
# MemShared: 0 kB
# Buffers: 67504 kB
# Cached: 42328 kB
# SwapCached: 8056 kB
# Active: 171720 kB
# ActiveAnon: 88224 kB
# ActiveCache: 83496 kB
# Inact_dirty: 22032 kB
# Inact_laundry: 3120 kB
# Inact_clean: 5572 kB
# Inact_target: 40488 kB
# HighTotal: 0 kB
# HighFree: 0 kB
# LowTotal: 513616 kB
# LowFree: 55692 kB
# SwapTotal: 1044208 kB
# SwapFree: 988588 kB
# /proc/loadavg
# 0.02 0.12 0.15 1/138 30412
# This only works on Linux (as far as I know)
sub get_sys_info {
my ($self) = @_;
my $info = {};
# print "FILE: /proc/meminfo\n";
if (open(App::Context::FILE, "/proc/meminfo")) {
while (<App::Context::FILE>) {
if (/^([A-Za-z]+):\s*([0-9]+)/) {
$info->{lc($1)} = $2;
# print ">>> $1 = $2\n";
}
}
close(App::Context::FILE);
}
# print "FILE: /proc/loadavg\n";
if (open(App::Context::FILE, "/proc/loadavg")) {
while (<App::Context::FILE>) {
if (/^([0-9.]+)\s+([0-9.]+)\s+([0-9.]+)\s+([0-9]+)\/([0-9]+)\s+([0-9]+)/) {
$info->{load} = $1;
$info->{load5} = $2;
$info->{load15} = $3;
$info->{runprocs} = $4;
$info->{nprocs} = $5;
$info->{unknown} = $6;
# print ">>> [$1][$2][$3][$4][$5][$6]\n";
}
}
close(App::Context::FILE);
}
return($info);
}
# /proc/$$/status
# Name: ksh
# State: S (sleeping)
# Tgid: 29147
# Pid: 29147
# PPid: 29146
# TracerPid: 0
# Uid: 102 102 102 102
# Gid: 205 205 205 205
# FDSize: 32
# Groups: 205 201 202 214 3000 203 217
# VmSize: 1624 kB
# VmLck: 0 kB
# VmRSS: 608 kB
# VmData: 124 kB
# VmStk: 12 kB
# VmExe: 176 kB
# VmLib: 1292 kB
# SigPnd: 0000000000000000
# SigBlk: 0000000000000000
# SigIgn: 8000000000380000
# SigCgt: 0000000000016007
# CapInh: 0000000000000000
# CapPrm: 0000000000000000
# CapEff: 0000000000000000
sub get_proc_info {
my ($self, @pids) = @_;
@pids = ($$) if ($#pids == -1);
my ($pid, $proc);
my $procs = {};
foreach $pid (@pids) {
$proc = {};
$procs->{$pid} = $proc;
# print "FILE: /proc/$$/status\n";
if (open(App::Context::FILE, "/proc/$$/status")) {
while (<App::Context::FILE>) {
if (/^Vm([A-Za-z]+):\s*([0-9]+)/) {
$proc->{lc($1)} = $2;
}
}
close(App::Context::FILE);
$proc->{text} = $proc->{exe} + $proc->{lib};
}
else {
$self->log("ERROR: Can't open /proc/$$/status: $!");
}
}
return($procs);
}
# http://www.comptechdoc.org/os/linux/howlinuxworks/linux_hlproc.html
#stat - Status information about the process used by the ps(1) command. Fields are:
# 31137 (bash) S 19885 31137 31137 34841 651 0 1450
# 185030 316 14024 1 3 687 715 14 0 0
# 0 1792102651 4403200 361 4294967295 134512640 135217536 3221217344 3221216648 1074425592
# 0 65536 3686404 1266761467 3222400107 0 0 17 2
# 1. pid - Process id
# 2. comm - The executable filename
# 3. state - R (running), S(sleeping interruptable), D(sleeping), Z(zombie), or T(stopped on a signal).
# 4. ppid - Parent process ID
# 5. pgrp - Process group ID
# 6. session - The process session ID.
# 7. tty - The tty the process is using
# 8. tpgid - The process group ID of the owning process of the tty the current process is connected to.
# 9. flags - Process flags, currently with bugs
# 10. minflt - Minor faults the process has made
# 11. cminflt - Minor faults the process and its children have made.
# 12. majflt
# 13. cmajflt
# 14. utime - The number of jiffies (processor time) that this process has been scheduled in user mode
# 15. stime - in kernel mode
# 16. cutime - This process and its children in user mode
# 17. cstime - in kernel mode
# 18. counter - The maximum time of this processes next time slice.
# 19. priority - The priority of the nice(1) (process priority) value plus fifteen.
# 20. timeout - The time in jiffies of the process's next timeout.
# 21. itrealvalue - The time in jiffies before the next SIGALRM is sent to the process because of an internal timer.
# 22. starttime - Time the process started after system boot
# 23. vsize - Virtual memory size
# 24. rlim - Current limit in bytes of the rss of the process.
# 25. startcode - The address above which program text can run.
# 26. endcode - The address below which program text can run.
# 27. startstack - The address of the start of the stack
# 28. kstkesp - The current value of esp for the process as found in the kernel stack page.
# 29. kstkeip - The current 32 bit instruction pointer, EIP.
# 30. signal - The bitmap of pending signals
# 31. blocked - The bitmap of blocked signals
# 32. sigignore - The bitmap of ignored signals
# 33. sigcatch - The bitmap of catched signals
# 34. wchan - The channel in which the process is waiting. The "ps -l" command gives somewhat of a list.
sub get_proc_info2 {
my ($self, @pids) = @_;
@pids = ($$) if ($#pids == -1);
my ($pid, $proc);
my $procs = {};
foreach $pid (@pids) {
$proc = {};
$procs->{$pid} = $proc;
# print "FILE: /proc/$$/status\n";
if (open(App::Context::FILE, "/proc/$$/stat")) {
my $line = <App::Context::FILE>;
my @f = split(/ +/, $line);
close(App::Context::FILE);
$proc->{cutime} = $f[15];
$proc->{cstime} = $f[16];
$proc->{vsize} = $f[22];
}
else {
$self->log("ERROR: Can't open /proc/$$/stat: $!");
}
}
return($procs);
}
1;
( run in 1.944 second using v1.01-cache-2.11-cpan-39bf76dae61 )