File Coverage

blib/lib/Proc/Stat.pm
Criterion Covered Total %
statement 43 124 34.6
branch 10 52 19.2
condition 1 10 10.0
subroutine 6 14 42.8
pod 9 9 100.0
total 69 209 33.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             package Proc::Stat;
3              
4 1     1   564 use strict;
  1         2  
  1         26  
5 1     1   679 use diagnostics;
  1         227252  
  1         8  
6              
7 1     1   298 use vars qw($VERSION);
  1         2  
  1         1429  
8              
9             $VERSION = do { my @r = (q$Revision: 0.02 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
10              
11       0     sub DESTROY {}; # make modperl happy
12              
13             =head1 NAME
14              
15             Proc::Stat
16              
17             =head1 SYNOPSIS
18              
19             use Proc::Stat;
20              
21             my $ps = new Proc::Stat;
22             my $psj = $ut->jiffy();
23             my $ut = $ps->uptime();
24             my $stat = $ps->stat($pid0,$pid1,$pid...);
25             my $usage = $ut->usage($pid0,$pid1,$pid...);
26             my $prep = $ps->prepare($pid0,$pid1,...);
27             my $percent = $prep->loadavg($pid0,$pid1,...);
28             my $percent = $ps->loadkid($pid0,$pid1,...);
29              
30              
31              
32             =head1 DESCRIPTION
33              
34             This module reads /proc/uptime and /proc/{pid}/stat to gather statistics
35             and calculate cpu utilization of designatated PID's with or without children
36              
37             All the data from /proc/[pid]/stat is returned attached to the method pointer, see list below by index (-1).
38              
39             Calculates processor JIFFY
40              
41             Calculate realtime load average of a particular job(pid) or list of job(pid's)
42              
43             Real load Balancing using $ps->loadavg(pid list) below.
44              
45             =over 4
46              
47             =item * $ref = new Proc::Stat;
48              
49             Return a method pointer
50              
51             =cut
52              
53             sub new {
54 1     1 1 53 my $proto = shift;
55 1   50     11 my $class = ref $proto || $proto || __PACKAGE__;
56 1         4 return bless {}, $class;
57             }
58              
59             =item * $psj = $ut->jiffy();
60              
61             Returns a blessed reference with a scalar representing the best guess
62             of the SC_CLK_TCK or USR_HZ for this system based on proc data
63              
64             input: [optional] method pointer from "uptime"
65             returns:
66              
67             $psj->{
68             jiffy => number
69             };
70              
71             Returns 9999 on error and sets $@
72              
73             Will call $ps->uptime() if not a $ut->method pointer
74              
75             NOTE: known to be supported on LINUX, requires the /proc/filesystem
76              
77             =cut
78              
79             my @jiftab = ( # bounded table of known common jiffy values
80             24,
81             48,
82             96,
83             100, # linux
84             192,
85             250, # linux
86             300, # linux
87             384,
88             768,
89             1000, # linux
90             1536,
91             9999 # oops
92             );
93              
94             sub jiffy {
95 1     1 1 4 my $ps = shift;
96 1 50       8 $ps = $ps->uptime() unless exists $ps->{current};
97 1         2 my $f;
98 1 50       43 open($f,'<','/proc/stat') or return undef;
99 1         73 my $stat = <$f>;
100 1         64 close $f;
101             # user nice sys idle
102 1 50       10 return undef unless $stat =~ /cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/i;
103 1         4 my $idleticks = $4; # total idle ticks
104 1         4 my $idlesecs = $ps->{current}->{idle}; # total idle seconds since boot
105 1         6 my $uhz = $idleticks / $idlesecs; # should be jiffy withing a nats eyelash
106 1         2 my $i;
107 1         5 for ($i = 0;$i < $#jiftab -1;$i++) { # iterate to tablen -1
108 3 100       18 if ($uhz < $jiftab[$i+1]) {
109 1         3 my $diflo = $uhz - $jiftab[$i];
110 1         3 my $difhi = $jiftab[$i+1] - $uhz;
111 1 50       5 if ($diflo < $difhi) { # choose closest boundry
112 0         0 $uhz = $jiftab[$i];
113             } else {
114 1         2 $uhz = $jiftab[$i+1];
115             }
116 1         2 last;
117             }
118             }
119 1 50       9 if ($i == @jiftab) {
120 0         0 eval {
121 0         0 die "jiffie overflow, unknown HIGH clock rate '$uhz'";
122             };
123 0         0 $uhz = $jiftab[$i];;
124             }
125 1         2 $ps->{jiffy} = $uhz;
126 1         5 $ps;
127             }
128              
129              
130              
131             =item * $ut = $ps->uptime();
132              
133             input: none
134             returns: blessed method pointer of the form
135              
136             $ut->{ # seconds and fractions
137             current => {
138             uptime => uptime of the system,
139             idle => time spent in idle
140             },
141             last => {
142             uptime => 0,
143             idle => 0,
144             }
145              
146             };
147              
148             Subsequent calls will return:
149              
150             $ut->{ # seconds and fractions
151             current => {
152             uptime => uptime of the system,
153             idle => time spent in idle
154             },
155             last => {
156             uptime => previous uptime,
157             idle => previous idle
158             }
159             };
160              
161             Returns undef on error
162              
163             =cut
164              
165             sub uptime {
166 1     1 1 2 my $ps = shift;
167 1         1 my $f;
168 1 50       4 if (exists $ps->{last}) {
169 0 0       0 if (exists $ps->{current}) {
170 0         0 @{$ps->{last}}{qw(uptime idle)} = @{$ps->{current}}{qw(uptime idle)};
  0         0  
  0         0  
171             } else {
172 0         0 @{$ps->{last}}{qw(uptime idle)} = (0,0);
  0         0  
173             }
174             } else {
175 1         2 @{$ps->{last}}{qw(uptime idle)} = (0,0);
  1         4  
176             }
177 1 50       46 open ($f,'<','/proc/uptime') or return undef;
178 1         27 @{$ps->{current}}{qw(uptime idle)} = split /\s+/, (<$f>);
  1         6  
179 1         15 close $f;
180 1 50       8 return $ps->{current}->{uptime} ? $ps : undef;
181             }
182              
183             =item * = $stat = $ps->stat($pid0,$pid1,...);
184              
185             Returns pointer to an array of values for each proc/PID/stat as defined in L
186              
187             input: an array of PID's or ref to array of PID's
188             returns: blessed method pointer of the form
189              
190             $stat->{
191             curstat => {
192             $pid0 => [stat array],
193             $pid1 => [stat array],
194             ...
195             },
196             lastat => {
197             $pid0 => [],
198             $pid1 => [],
199             ...
200             }
201             };
202              
203             Subsequent calls will return:
204              
205             $stat->{
206             curstat => {
207             $pid0 => [stat array],
208             $pid1 => [stat array],
209             ...
210             },
211             lastat => {
212             $pid0 => [],
213             $pid1 => [],
214             ...
215             }
216             };
217              
218             Returns undef on error.
219              
220             Will not populate PID's missing from /proc
221              
222             May be chained. i.e.
223              
224             $stat = $ps->uptime()->stat($pid,...);
225              
226             =cut
227              
228             sub stat {
229 0     0 1   my $ps = shift;
230 0 0         my $pids = ref $_[0] ? $_[0] : [@_];
231 0 0         return undef unless @{$pids};
  0            
232              
233 0           foreach my $pid (@{$pids}) {
  0            
234 0           my $f;
235 0 0         next unless open($f,'<',"/proc/$pid/stat");
236 0 0         if (exists $ps->{lastat}->{$pid}) {
237 0           @{$ps->{lastat}->{$pid}} = @{$ps->{curstat}->{$pid}};
  0            
  0            
238             } else {
239 0           $ps->{lastat}->{$pid} = [];
240             }
241 0           @{$ps->{curstat}->{$pid}} = split /\s+/, (<$f>);
  0            
242 0           close $f;
243             }
244 0           $ps;
245             }
246              
247             =item * $usage = $ut->usage();
248              
249             Calculate the CPU usage from data in a chained uptime, stat call pair
250              
251             i.e $usage = $ps->uptime()->jiffy()->stats(pid0,pid1,...)->usage();
252             in any order, only "stats" required
253              
254             calculates differences for
255             utime
256             stime
257             cutime
258             cstime
259              
260             First call for a particular PID will return the absolute value since job start
261              
262             Subsequent calls for a particular PID will return the difference from the last call
263              
264             input: an array of PID's or ref to array of PID's
265             returns: additional fields added to "uptime" and "stats"
266              
267             $usage->{
268             utime => {
269             $pid0 => diff,
270             $pid1 => diff,
271             ... etc...
272             },
273             stime => {
274             $pid0 => diff,
275             $pid1 => diff,
276             ... etc...
277             },
278             cutime => {
279             $pid0 => diff,
280             $pid1 => diff,
281             ... etc...
282             },
283             cstime => {
284             $pid0 => diff,
285             $pid1 => diff,
286             ... etc...
287             }
288             };
289              
290             Returns undef on error
291              
292             =cut
293              
294             my %times = (
295             utime => 13,
296             stime => 14,
297             cutime => 15,
298             cstime => 16
299             );
300              
301             sub usage {
302 0     0 1   my $ps = shift;
303 0 0 0       return undef unless exists $ps->{curstat} && keys %{$ps->{curstat}};
  0            
304 0           foreach my $pid (keys %{$ps->{curstat}}) {
  0            
305 0           foreach (keys %times) {
306 0           my $idx = $times{$_};
307 0   0       $ps->{$_}->{$pid} = $ps->{curstat}->{$pid}->[$idx] - ($ps->{lastat}->{$pid}->[$idx] || 0);
308             }
309             }
310 0           $ps;
311             }
312              
313             =item * $prep = $ps->prepare($pid0,$pid1,...);
314              
315             Collect information about jobs(pids) needed to calculate cpu utilization.
316             Call repetitively at intervals.
317              
318             input: an array of PID's or ref to array of PID's
319             returns: a blessed hash structure containing data
320              
321             This is a wrapper around:
322              
323             $ps->uptime()->stat($pids);
324              
325             ...and will conditionally call ->jiffy if it is not populated
326              
327             =cut
328              
329             sub prepare {
330 0     0 1   my $ps = shift;
331 0 0         my $pids = ref $_[0] ? $_[0] : [@_];
332 0 0         return undef unless @{$pids};
  0            
333              
334 0           $ps->uptime()->stat($pids);
335 0 0         $ps->jiffy() unless exists $ps->{jiffy};
336 0           $ps;
337             }
338              
339             =item * $percent = $prep->loadavg($pid0,$pid1,...);
340              
341             =item * $percent = $prep->loadkid($pid0,$pid1,...);
342              
343             Call:
344              
345             method: loadavg for job(pid) utilization
346             method: loadkid to include utilization of child processes
347              
348             Calculates the % CPU utilization of each job (pid) over the period between calls
349              
350             input: an array of PID's or ref to array of PID's
351             returns: a blessed hash structure of the form:
352              
353             $ps = {
354             utilize => {
355             $pid0 => num[float 0..100] representing %,
356             $pid1 => num...,
357             ...
358             },
359             };
360              
361             Method will report ZERO for a job(pid) which does not have a previous call entry.
362              
363             Return undef on error.
364              
365             Will call the other package methods as needed to populate the '$ps' hash.
366              
367             =cut
368              
369             sub loadavg {
370 0     0 1   _util(0,@_);
371             }
372              
373             sub loadkid {
374 0     0 1   _util(1,@_);
375             }
376              
377             sub _util {
378 0     0     my $kid = shift;
379 0           my $ps = shift;
380 0 0         my $pids = ref $_[0] ? $_[0] : [@_];
381 0 0         return undef unless @{$pids};
  0            
382              
383 0           $ps->usage();
384              
385             my $cputime = ( $ps->{current}->{uptime}
386             - $ps->{last}->{uptime}
387             + $ps->{current}->{idle}
388             - $ps->{last}->{idle}
389 0           ) * $ps->{jiffy};
390 0           foreach my $pid (@{$pids}) {
  0            
391 0           my $util;
392 0 0 0       if ( exists $ps->{lastat}->{$pid} && $ps->{lastat}->{$pid} ) {
393 0           $util = $ps->{utime}->{$pid} + $ps->{stime}->{$pid};
394 0 0         if ($kid) {
395 0           $util += $ps->{cutime}->{$pid} + $ps->{cstime}->{$pid};
396             }
397 0           $util /= $cputime;
398             # round to 2 decimal places and render in % 0 -> 100 more or less
399 0           $util *= 10000;
400 0           $util += 0.5;
401 0           $util = int($util) / 100;
402             } else {
403 0           $util = 0;
404             }
405 0           $ps->{utilize}->{$pid} = $util;
406             }
407 0           $ps;
408             }
409              
410             =item * $ps = $ps->purgemissing($pid0,$pid1,...);
411              
412             Removes all PID's from the '$ps' structure not in the PID list
413              
414             input: an array of PID's or ref to array of PID's
415             returns: bless reference stripped of all other PID's
416              
417             Returns undef on error
418              
419             =cut
420              
421             sub purgemissing {
422 0     0 1   my $ps = shift;
423 0 0         my $pids = ref $_[0] ? $_[0] : [@_];
424 0 0         return undef unless @{$pids};
  0            
425              
426 0           my $live = {};
427 0           @{$live}{@{$pids}} = (); # hash of undefs
  0            
  0            
428            
429 0           foreach (qw(
430             utime
431             stime
432             cutime
433             cstime
434             lastat
435             curstat )) {
436 0           my @allpids = keys %{$ps->{$_}};
  0            
437 0           foreach my $pid (@allpids) {
438 0 0         next if exists $live->{$pid};
439 0 0         delete $ps->{$_}->{$pid} if exists $ps->{$_}->{$pid};
440             }
441             }
442 0           $ps;
443             }
444              
445             =back
446              
447             =head1 Contents of /proc/[pid]/stat from proc(5)
448              
449             pid %d
450              
451             (1) The process ID.
452              
453             comm %s
454              
455             (2) The filename of the executable, in parentheses. This is visible whether or not the executable is swapped out.
456              
457             state %c
458              
459             (3) One character from the string "RSDZTW" where R is running, S is sleeping in an interruptible wait, D is waiting in uninterruptible disk sleep, Z is zombie, T is traced or stopped (on a signal), and W is paging.
460              
461             ppid %d
462              
463             (4) The PID of the parent.
464              
465             pgrp %d
466              
467             (5) The process group ID of the process.
468              
469             session %d
470              
471             (6) The session ID of the process.
472              
473             tty_nr %d
474              
475             (7) The controlling terminal of the process. (The minor device number is contained in the combination of bits 31 to 20 and 7 to 0; the major device number is in bits 15 to 8.)
476              
477             tpgid %d
478              
479             (8) The ID of the foreground process group of the controlling terminal of the process.
480              
481             flags %u (%lu before Linux 2.6.22)
482              
483             (9) The kernel flags word of the process. For bit meanings, see the PF_* defines in the Linux kernel source file include/linux/sched.h. Details depend on the kernel version.
484              
485             minflt %lu
486              
487             (10) The number of minor faults the process has made which have not required loading a memory page from disk.
488              
489             cminflt %lu
490              
491             (11) The number of minor faults that the process's waited-for children have made.
492              
493             majflt %lu
494              
495             (12) The number of major faults the process has made which have required loading a memory page from disk.
496              
497             cmajflt %lu
498              
499             (13) The number of major faults that the process's waited-for children have made.
500              
501             utime %lu
502              
503             (14) Amount of time that this process has been scheduled in user mode, measured in clock ticks (divide by sysconf(_SC_CLK_TCK)). This includes guest time, guest_time (time spent running a virtual CPU, see below), so that applications that are not aware of the guest time field do not lose that time from their calculations.
504              
505             stime %lu
506              
507             (15) Amount of time that this process has been scheduled in kernel mode, measured in clock ticks (divide by sysconf(_SC_CLK_TCK)).
508              
509             cutime %ld
510              
511             (16) Amount of time that this process's waited-for children have been scheduled in user mode, measured in clock ticks (divide by sysconf(_SC_CLK_TCK)). (See also times(2).) This includes guest time, cguest_time (time spent running a virtual CPU, see below).
512              
513             cstime %ld
514              
515             (17) Amount of time that this process's waited-for children have been scheduled in kernel mode, measured in clock ticks (divide by sysconf(_SC_CLK_TCK)).
516              
517             priority %ld
518              
519             (18) (Explanation for Linux 2.6) For processes running a real-time scheduling policy (policy below; see sched_setscheduler(2)), this is the negated scheduling priority, minus one; that is, a number in the range -2 to -100, corresponding to real-time priorities 1 to 99. For processes running under a non-real-time scheduling policy, this is the raw nice value (setpriority(2)) as represented in the kernel. The kernel stores nice values as numbers in the range 0 (high) to 39 (low), corresponding to the user-visible nice range of -20 to 19.
520              
521             Before Linux 2.6, this was a scaled value based on the scheduler weighting given to this process.
522              
523             nice %ld
524              
525             (19) The nice value (see setpriority(2)), a value in the range 19 (low priority) to -20 (high priority).
526              
527             num_threads %ld
528              
529             (20) Number of threads in this process (since Linux 2.6). Before kernel 2.6, this field was hard coded to 0 as a placeholder for an earlier removed field.
530              
531             itrealvalue %ld
532              
533             (21) The time in jiffies before the next SIGALRM is sent to the process due to an interval timer. Since kernel 2.6.17, this field is no longer maintained, and is hard coded as 0.
534              
535             starttime %llu (was %lu before Linux 2.6)
536              
537             (22) The time the process started after system boot. In kernels before Linux 2.6, this value was expressed in jiffies. Since Linux 2.6, the value is expressed in clock ticks (divide by sysconf(_SC_CLK_TCK)).
538              
539             vsize %lu
540              
541             (23) Virtual memory size in bytes.
542              
543             rss %ld
544              
545             (24) Resident Set Size: number of pages the process has in real memory. This is just the pages which count toward text, data, or stack space. This does not include pages which have not been demand-loaded in, or which are swapped out.
546              
547             rsslim %lu
548              
549             (25) Current soft limit in bytes on the rss of the process; see the description of RLIMIT_RSS in getrlimit(2).
550              
551             startcode %lu
552              
553             (26) The address above which program text can run.
554              
555             endcode %lu
556              
557             (27) The address below which program text can run.
558              
559             startstack %lu
560              
561             (28) The address of the start (i.e., bottom) of the stack.
562              
563             kstkesp %lu
564              
565             (29) The current value of ESP (stack pointer), as found in the kernel stack page for the process.
566              
567             kstkeip %lu
568              
569             (30) The current EIP (instruction pointer).
570              
571             signal %lu
572              
573             (31) The bitmap of pending signals, displayed as a decimal number. Obsolete, because it does not provide information on real-time signals; use /proc/[pid]/status instead.
574              
575             blocked %lu
576              
577             (32) The bitmap of blocked signals, displayed as a decimal number. Obsolete, because it does not provide information on real-time signals; use /proc/[pid]/status instead.
578              
579             sigignore %lu
580              
581             (33) The bitmap of ignored signals, displayed as a decimal number. Obsolete, because it does not provide information on real-time signals; use /proc/[pid]/status instead.
582              
583             sigcatch %lu
584              
585             (34) The bitmap of caught signals, displayed as a decimal number. Obsolete, because it does not provide information on real-time signals; use /proc/[pid]/status instead.
586              
587             wchan %lu
588              
589             (35) This is the "channel" in which the process is waiting. It is the address of a system call, and can be looked up in a namelist if you need a textual name. (If you have an up-to-date /etc/psdatabase, then try ps -l to see the WCHAN field in action.)
590              
591             nswap %lu
592              
593             (36) Number of pages swapped (not maintained).
594              
595             cnswap %lu
596              
597             (37) Cumulative nswap for child processes (not maintained).
598              
599             exit_signal %d (since Linux 2.1.22)
600              
601             (38) Signal to be sent to parent when we die.
602              
603             processor %d (since Linux 2.2.8)
604              
605             (39) CPU number last executed on.
606              
607             rt_priority %u (since Linux 2.5.19; was %lu before Linux 2.6.22)
608              
609             (40) Real-time scheduling priority, a number in the range 1 to 99 for processes scheduled under a real-time policy, or 0, for non-real-time processes (see sched_setscheduler(2)).
610              
611             policy %u (since Linux 2.5.19; was %lu before Linux 2.6.22)
612              
613             (41) Scheduling policy (see sched_setscheduler(2)). Decode using the SCHED_* constants in linux/sched.h.
614              
615             delayacct_blkio_ticks %llu (since Linux 2.6.18)
616              
617             (42) Aggregated block I/O delays, measured in clock ticks (centiseconds).
618              
619             guest_time %lu (since Linux 2.6.24)
620              
621             (43) Guest time of the process (time spent running a virtual CPU for a guest operating system), measured in clock ticks (divide by sysconf(_SC_CLK_TCK)).
622              
623             cguest_time %ld (since Linux 2.6.24)
624              
625             (44) Guest time of the process's children, measured in clock ticks (divide by sysconf(_SC_CLK_TCK)).
626              
627             =head1 BUGS
628              
629             none so far
630              
631             =head1 COPYRIGHT 2019
632              
633             Michael Robinton
634              
635             All rights reserved.
636              
637             This program is free software; you can redistribute it and/or modify
638             it under the terms of either:
639              
640             a) the GNU General Public License as published by the Free
641             Software Foundation; either version 2, or (at your option) any
642             later version, or
643              
644             b) the "Artistic License" which comes with this distribution.
645              
646             This program is distributed in the hope that it will be useful,
647             but WITHOUT ANY WARRANTY; without even the implied warranty of
648             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
649             the GNU General Public License or the Artistic License for more details.
650              
651             You should have received a copy of the Artistic License with this
652             distribution, in the file named "Artistic". If not, I'll be glad to provide
653             one.
654              
655             You should also have received a copy of the GNU General Public License
656             along with this program in the file named "Copying". If not, write to the
657              
658             Free Software Foundation, Inc.
659             51 Franklin Street, Fifth Floor
660             Boston, MA 02110-1301 USA.
661              
662             or visit their web page on the internet at:
663              
664             http://www.gnu.org/copyleft/gpl.html.
665              
666             =head1 AUTHOR
667              
668             Michael Robinton
669              
670             =cut
671              
672             1;