File Coverage

blib/lib/Metabrik/System/Freebsd/Top.pm
Criterion Covered Total %
statement 9 77 11.6
branch 0 28 0.0
condition 0 40 0.0
subroutine 3 7 42.8
pod 1 3 33.3
total 13 155 8.3


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # system::freebsd::top Brik
5             #
6             package Metabrik::System::Freebsd::Top;
7 1     1   851 use strict;
  1         2  
  1         27  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   5 use base qw(Metabrik::Shell::Command);
  1         3  
  1         1163  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             commands => {
19             stats => [ ],
20             list => [ ],
21             },
22             require_binaries => {
23             top => [ ],
24             },
25             };
26             }
27              
28             sub _convert_size {
29 0     0     my $self = shift;
30 0           my ($size) = @_;
31              
32 0 0         return unless defined($size);
33              
34 0 0         if ($size =~ m{^(\d+)K$}) {
    0          
    0          
    0          
35 0           return $1."000";
36             }
37             elsif ($size =~ m{^(\d+)M$}) {
38 0           return $1."000000";
39             }
40             elsif ($size =~ m{^(\d+)G$}) {
41 0           return $1."000000000";
42             }
43             elsif ($size =~ m{^(\d+)T$}) { # LOL
44 0           return $1."000000000000";
45             }
46              
47 0           return $size;
48             }
49              
50             sub stats {
51 0     0 0   my $self = shift;
52              
53 0           my $cmd = 'top -Sb 0';
54              
55             #
56             # FreeBSD 10.2-RELEASE
57             #
58             # 0: last pid: 61608; load averages: 0.99, 1.04, 1.06 up 4+20:20:19 10:32:11
59             # 1: 279 processes: 2 running, 269 sleeping, 1 stopped, 6 zombie, 1 waiting
60             # 1: 272 processes: 2 running, 263 sleeping, 6 zombie, 1 waiting,
61             # 2:
62             # 3: Mem: 4116M Active, 15G Inact, 11G Wired, 21M Cache, 958M Free
63             # 3: Mem: 5435M Active, 14G Inact, 11G Wired, 135M Cache, 1655M Buf, 326M Free
64             # 4: ARC: 9086M Total, 3939M MFU, 1973M MRU, 1417K Anon, 102M Header, 3071M Other
65             # 5: Swap: 16G Total, 8940K Used, 16G Free
66              
67 0 0         my $lines = $self->capture($cmd) or return;
68              
69 0           my $info = {
70             raw => $lines,
71             };
72 0           my $row = 0;
73 0           for my $line (@$lines) {
74 0           $line =~ s{^\s*}{};
75 0           $line =~ s{\s*$}{};
76              
77 0 0         if ($row == 0) {
    0          
    0          
    0          
    0          
78 0           my @f = $line =~ m{^last pid:\s+(\d+);\s+load averages:\s+(\S+),\s+(\S+),\s+(\S+)\s+up (\S+)\s+(\S+)$};
79              
80             #$self->log->debug("@f");
81              
82 0           $info->{last_pid} = $f[0];
83 0           $info->{load_average_1m} = $f[1];
84 0           $info->{load_average_5m} = $f[2];
85 0           $info->{load_average_15m} = $f[3];
86 0           $info->{uptime} = $f[4];
87 0           $info->{time} = $f[5];
88             }
89             elsif ($row == 1) {
90 0           my @f = $line =~ m{^(\d+) processes: (?:(\d+) running, )?(?:(\d+) sleeping, )?(?:(\d+) stopped, )?(?:(\d+) zombie, )?(?:(\d+) waiting)?$};
91              
92             #$self->log->debug("@f");
93              
94 0   0       $info->{total_processes} = $f[0] || 0;
95 0   0       $info->{running_processes} = $f[1] || 0;
96 0   0       $info->{sleeping_processes} = $f[2] || 0;
97 0   0       $info->{stopped_processes} = $f[3] || 0;
98 0   0       $info->{zombie_processes} = $f[4] || 0;
99 0   0       $info->{waiting_processes} = $f[5] || 0;
100             }
101             elsif ($row == 3) {
102 0           my @f = $line =~ m{^Mem: (?:(\S+) Active, )?(?:(\S+) Inact, )?(?:(\S+) Wired, )?(?:(\S+) Cache, )?(?:(\S+) Buf, )?(?:(\S+) Free)?$};
103              
104             #$self->log->debug("@f");
105              
106 0   0       $info->{active_memory} = $self->_convert_size($f[0]) || 0;
107 0   0       $info->{inactive_memory} = $self->_convert_size($f[1]) || 0;
108 0   0       $info->{wired_memory} = $self->_convert_size($f[2]) || 0;
109 0   0       $info->{cache_memory} = $self->_convert_size($f[3]) || 0;
110 0   0       $info->{free_memory} = $self->_convert_size($f[4]) || 0;
111             }
112             elsif ($row == 4) {
113 0           my @f = $line =~ m{^ARC: (\S+) Total, (\S+) MFU, (\S+) MRU, (\S+) Anon, (\S+) Header, (\S+) Other$};
114              
115             #$self->log->debug("@f");
116              
117 0   0       $info->{total_arc} = $self->_convert_size($f[0]) || 0;
118 0   0       $info->{mfu_arc} = $self->_convert_size($f[1]) || 0;
119 0   0       $info->{mru_arc} = $self->_convert_size($f[2]) || 0;
120 0   0       $info->{anon_arc} = $self->_convert_size($f[3]) || 0;
121 0   0       $info->{header_arc} = $self->_convert_size($f[4]) || 0;
122 0   0       $info->{other_arc} = $self->_convert_size($f[5]) || 0;
123             }
124             elsif ($row == 5) {
125             # "Swap: 16G Total, 16G Free"
126 0           my @f = $line =~ m{^Swap: (?:(\S+) Total, )?(?:(\S+) Used, )?(?:(\S+) Free)?$};
127              
128             #$self->log->debug("@f");
129              
130 0   0       $info->{total_swap} = $self->_convert_size($f[0]) || 0;
131 0   0       $info->{used_swap} = $self->_convert_size($f[1]) || 0;
132 0   0       $info->{free_swap} = $self->_convert_size($f[2]) || 0;
133             }
134              
135 0           $row++;
136             }
137              
138 0           return $info;
139             }
140              
141             sub list {
142 0     0 0   my $self = shift;
143              
144 0           my $cmd = 'top -Sb 999';
145              
146             #
147             # FreeBSD 10.3-RELEASE
148             #
149             # PID USERNAME THR PRI NICE SIZE RES STATE C TIME WCPU COMMAND
150             # 11 root 4 155 ki31 0K 64K RUN 3 439.6H 400.00% idle
151             # 90893 elasticsearch 70 20 0 53636M 10994M uwait 2 343:24 4.49% java
152             # 834 root 29 20 0 1468M 399M uwait 0 55:51 0.78% java
153            
154              
155 0 0         my $lines = $self->capture($cmd) or return;
156              
157 0           my @list = ();
158 0           my $skip = 1;
159 0           for my $line (@$lines) {
160 0 0         if ($line =~ m{THR\s+PRI\s+NICE}) {
161 0           $skip = 0;
162 0           next;
163             }
164 0 0         if ($skip) {
165 0           next;
166             }
167              
168 0           $line =~ s{^\s*}{};
169 0           $line =~ s{\s*$}{};
170              
171 0           my @t = split(/\s+/, $line);
172              
173 0           push @list, {
174             pid => $t[0],
175             user => $t[1],
176             thread => $t[2],
177             priority => $t[3],
178             nice => $t[4],
179             total_process_memory_size => $t[5],
180             resident_memory_in_kilobytes => $t[6],
181             process_state => $t[7],
182             cpu_number => $t[8],
183             system_and_user_cpu_seconds => $t[9],
184             weighted_cpu_percentage => $t[10],
185             raw => $line,
186             };
187             }
188              
189 0           return \@list;
190             }
191              
192             1;
193              
194             __END__