File Coverage

blib/lib/Test/Parser/Sar.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Test::Parser::Sar;
2              
3             =head1 NAME
4              
5             Test::Parser::Sar - Perl module to parse output from sar.
6              
7             =head1 SYNOPSIS
8              
9             use Test::Parser::Sar;
10              
11             my $parser = new Test::Parser::Sar;
12             $parser->parse($text);
13              
14             =head1 DESCRIPTION
15              
16             This module transforms sar output into a hash that can be used to generate
17             XML.
18              
19             =head1 FUNCTIONS
20              
21             Also see L for functions available from the base class.
22              
23             =cut
24              
25 1     1   23851 use strict;
  1         4  
  1         39  
26 1     1   6 use warnings;
  1         1  
  1         29  
27 1     1   571 use Test::Parser;
  1         11  
  1         28  
28 1     1   1915 use XML::Simple;
  0            
  0            
29             use File::Basename;
30              
31             @Test::Parser::Sar::ISA = qw(Test::Parser);
32             use base 'Test::Parser';
33              
34             use fields qw(
35             time_units
36             info
37             proc_s
38             cpu
39             cswch_s
40             inode
41             intr
42             intr_s
43             io_tr
44             io_bd
45             memory
46             memory_usage
47             net_ok
48             net_err
49             net_sock
50             paging
51             queue
52             swapping
53             );
54              
55             use vars qw( %FIELDS $AUTOLOAD $VERSION );
56             our $VERSION = '1.7';
57              
58             =head2 new()
59              
60             Creates a new Test::Parser::Sar instance.
61             Also calls the Test::Parser base class' new() routine.
62             Takes no arguments.
63              
64             =cut
65              
66             sub new {
67             my $class = shift;
68             my Test::Parser::Sar $self = fields::new($class);
69             $self->SUPER::new();
70              
71             $self->name('sar');
72             $self->type('standards');
73              
74             #
75             # Sar data.
76             #
77             $self->{info} = '';
78             $self->{proc_s} = ();
79             $self->{cpu} = ();
80             $self->{cswch_s} = ();
81             $self->{inode} = ();
82             $self->{intr} = ();
83             $self->{intr_s} = ();
84             $self->{io_tr} = ();
85             $self->{io_bd} = ();
86             $self->{memory} = ();
87             $self->{memory_usage} = ();
88             $self->{net_ok} = ();
89             $self->{net_err} = ();
90             $self->{net_sock} = ();
91             $self->{paging} = ();
92             $self->{queue} = ();
93             $self->{swapping} = ();
94              
95             return $self;
96             }
97              
98             =head3 data()
99              
100             Returns a hash representation of the sar data.
101              
102             =cut
103             sub data {
104             my $self = shift;
105             if (@_) {
106             $self->{data} = @_;
107             }
108             return {
109             sar => {
110             proc_s => {data => $self->{proc_s}},
111             cswch_s => {data => $self->{cswch_s}},
112             cpu => {data => $self->{cpu}},
113             inode => {data => $self->{inode}},
114             intr => {data => $self->{intr}},
115             intr_s => {data => $self->{intr_s}},
116             io => {
117             tr => {data => $self->{io_tr}},
118             bd => {data => $self->{io_bd}}},
119             memory => {data => $self->{memory}},
120             memory_usage => {data => $self->{memory_usage}},
121             paging => {data => $self->{paging}},
122             network => {
123             ok => {data => $self->{net_ok}},
124             err => {data => $self->{net_err}},
125             sock => {data => $self->{net_sock}}},
126             queue => {data => $self->{queue}},
127             swapping => {data => $self->{swapping}}}};
128             }
129              
130             =head3
131              
132             Override of Test::Parser's default parse() routine to make it able
133             to parse sar output. Support only reading from a file until a better
134             parsing algorithm comes along.
135              
136             =cut
137             sub parse {
138             #
139             # TODO
140             # Make this handle GLOBS and stuff like the parent class.
141             #
142             my $self = shift;
143             my $input = shift or return undef;
144             my ($name, $path) = @_;
145              
146             my $retval = 1;
147              
148             if (!ref($input) && -f $input) {
149             $name ||= basename($input);
150             $path ||= dirname($input);
151              
152             open (FILE, "< $input")
153             or warn "Could not open '$input' for reading: $!\n"
154             and return undef;
155             while () {
156             chomp($_);
157             my @data = split / +/, $_;
158             my $count = scalar @data;
159             #
160             # Capture the interrupts per processor. sar -I SUM -P ALL
161             # This is hard because the number of columns varies depending on the
162             # number of interrupt addresses.
163             #
164             # Let's hope we can always determine this is when the 2nd column
165             # starts with CPU and the next column is i000/s, but we'll try to
166             # pattern match the beginning 'i' and ending '/s' parts.
167             #
168             if ($count > 2 and $data[1] eq 'CPU' and $data[2] =~ /^i.*\/s$/) {
169             while (my $line = ) {
170             chomp($line);
171             my @data2 = split / +/, $line;
172             last if (scalar @data2 == 0 or $data2[0] eq 'Average:');
173             my $h = {time => $data2[0], cpu => $data2[1]};
174             for (my $i = 2; $i < $count; $i++) {
175             $data[$i] =~ /^(i.*)\/s$/;
176             $h->{$1} = $data2[$i];
177             }
178             push @{$self->{intr}}, $h;
179             }
180             } elsif ($count == 2) {
181             if ($data[1] eq 'proc/s') {
182             #
183             # Process creation activity. sar -c
184             # Keep reading until we hit an empty line.
185             #
186             while (my $line = ) {
187             chomp($line);
188             @data = split / +/, $line;
189             if (scalar @data == 2 and $data[0] ne 'Average:') {
190             push @{$self->{proc_s}},
191             {time => $data[0], proc_s => $data[1]};
192             } else {
193             last;
194             }
195             }
196             } elsif ($data[1] eq 'cswch/s') {
197             #
198             # System (context) switching activity. sar -w
199             # Keep reading until we hit an empty line.
200             #
201             while (my $line = ) {
202             chomp($line);
203             @data = split / +/, $line;
204             if (scalar @data == 2 and $data[0] ne 'Average:') {
205             push @{$self->{cswch_s}},
206             {time => $data[0], cswch_s => $data[1]};
207             } else {
208             last;
209             }
210             }
211             }
212             } elsif ($count == 3) {
213             if ($data[1] eq 'INTR') {
214             #
215             # Total interrupts. sar -I SUM
216             # Keep reading until we hit an empty line.
217             #
218             while (my $line = ) {
219             chomp($line);
220             @data = split / +/, $line;
221             if (scalar @data == 3 and $data[0] ne 'Average:' and
222             $data[1] eq 'sum') {
223             push @{$self->{intr_s}},
224             {time => $data[0], intr_s => $data[2]};
225             } else {
226             last;
227             }
228             }
229             } elsif ($data[1] eq 'pswpin/s' and $data[2] eq 'pswpout/s') {
230             #
231             # Swapping statistics. sar -W
232             # Keep reading until we hit an empty line.
233             #
234             while (my $line = ) {
235             chomp($line);
236             @data = split / +/, $line;
237             if (scalar @data == 3 and $data[0] ne 'Average:') {
238             push @{$self->{swapping}},
239             {time => $data[0],
240             pswpin_s => $data[1],
241             pswpout_s => $data[2]};
242             } else {
243             last;
244             }
245             }
246             }
247             } elsif ($count == 4) {
248             if ($data[1] eq 'frmpg/s') {
249             #
250             # Memory statistics. sar -R
251             # Keep reading until we hit an empty line.
252             #
253             while (my $line = ) {
254             chomp($line);
255             @data = split / +/, $line;
256             if (scalar @data == 4 and $data[0] ne 'Average:') {
257             push @{$self->{memory}},
258             {time => $data[0],
259             frmpg_s => $data[1],
260             bufpg_s => $data[2],
261             campg_s => $data[3]};
262             } else {
263             last;
264             }
265             }
266             }
267             } elsif ($count == 5) {
268             if ($data[1] eq 'DEV') {
269             #
270             # I/O block device statistics. sar -d
271             # Keep reading until we hit an empty line.
272             #
273             while (my $line = ) {
274             chomp($line);
275             @data = split / +/, $line;
276             if (scalar @data == 5 and $data[0] ne 'Average:') {
277             push @{$self->{io_bd}},
278             {time => $data[0],
279             dev => $data[1],
280             tps => $data[2],
281             rd_sec_s => $data[3],
282             wr_sec_s => $data[4]};
283             } else {
284             last;
285             }
286             }
287             } elsif ($data[1] eq 'pgpgin/s') {
288             #
289             # Paging statistics. sar -B
290             # Keep reading until we hit an empty line.
291             #
292             while (my $line = ) {
293             chomp($line);
294             @data = split / +/, $line;
295             if (scalar @data == 5 and $data[0] ne 'Average:') {
296             push @{$self->{paging}},
297             {time => $data[0],
298             pgpgin_s => $data[1],
299             pgpgout_s => $data[2],
300             fault_s => $data[3],
301             majflt_s => $data[4]};
302             } else {
303             last;
304             }
305             }
306             }
307             } elsif ($count == 6) {
308             if ($data[1] eq 'tps') {
309             #
310             # I/O transfer rate statistics. sar -b
311             # Keep reading until we hit an empty line.
312             #
313             while (my $line = ) {
314             chomp($line);
315             @data = split / +/, $line;
316             if (scalar @data == 6 and $data[0] ne 'Average:') {
317             push @{$self->{io_tr}},
318             {time => $data[0],
319             tps => $data[1],
320             rtps => $data[2],
321             wtps => $data[3],
322             bread_s => $data[4],
323             bwrtn_s => $data[5]};
324             } else {
325             last;
326             }
327             }
328             } elsif ($data[1] eq 'totsck') {
329             #
330             # Part of the network statitics, sockets. sar -n FULL
331             # Keep reading until we hit an empty line.
332             #
333             while (my $line = ) {
334             chomp($line);
335             @data = split / +/, $line;
336             if (scalar @data == 6 and $data[0] ne 'Average:') {
337             push @{$self->{net_sock}},
338             {time => $data[0],
339             totsck => $data[1],
340             tcpsck => $data[2],
341             udpsck => $data[3],
342             rawsck => $data[4],
343             'ip-frag' => $data[5]};
344             } else {
345             last;
346             }
347             }
348             } elsif ($data[1] eq 'runq-sz') {
349             #
350             # Queue and load averages. sar -q
351             # Keep reading until we hit an empty line.
352             #
353             while (my $line = ) {
354             chomp($line);
355             @data = split / +/, $line;
356             if (scalar @data == 6 and $data[0] ne 'Average:') {
357             push @{$self->{queue}},
358             {time => $data[0],
359             'runq-sz' => $data[1],
360             'plist-sz' => $data[2],
361             'ldavg-1' => $data[3],
362             'ldavg-5' => $data[4],
363             'ldavg-15' => $data[5]};
364             } else {
365             last;
366             }
367             }
368             }
369             } elsif ($count == 7) {
370             if ($data[1] eq 'CPU') {
371             #
372             # CPU utilization report. sar -u
373             # Keep reading until we hit an empty line.
374             #
375             while (my $line = ) {
376             chomp($line);
377             @data = split / +/, $line;
378             if (scalar @data == 7 and $data[0] ne 'Average:') {
379             push @{$self->{cpu}},
380             {time => $data[0],
381             cpu => $data[1],
382             user => $data[2],
383             nice => $data[3],
384             system => $data[4],
385             iowait => $data[5],
386             idle => $data[6]};
387             } else {
388             last;
389             }
390             }
391             }
392             } elsif ($count == 9) {
393             if ($data[1] eq 'IFACE') {
394             #
395             # Part of the network statitics, ok packets. sar -n FULL
396             # Keep reading until we hit an empty line.
397             #
398             while (my $line = ) {
399             chomp($line);
400             @data = split / +/, $line;
401             if (scalar @data == 9 and $data[0] ne 'Average:') {
402             push @{$self->{net_ok}},
403             {time => $data[0],
404             iface => $data[1],
405             rxpck_s => $data[2],
406             txpck_s => $data[3],
407             rxbyt_s => $data[4],
408             txbyt_s => $data[5],
409             rxcmp_s => $data[6],
410             txcmp_s => $data[7],
411             rxmcst_s => $data[8]};
412             } else {
413             last;
414             }
415             }
416             }
417             } elsif ($count == 10) {
418             if ($data[1] eq 'kbmemfree') {
419             #
420             # Memory and swap space utilization statistics. sar -r
421             # Keep reading until we hit an empty line.
422             #
423             while (my $line = ) {
424             chomp($line);
425             @data = split / +/, $line;
426             if (scalar @data == 10 and $data[0] ne 'Average:') {
427             push @{$self->{memory_usage}},
428             {time => $data[0],
429             kbmemfree => $data[1],
430             kbmemused => $data[2],
431             memused => $data[3],
432             kbbuffers => $data[4],
433             kbcached => $data[5],
434             kbswpfree => $data[6],
435             kbswpused => $data[7],
436             swpused => $data[8],
437             kbswpcad => $data[9]};
438             } else {
439             last;
440             }
441             }
442             } elsif ($data[1] eq 'dentunusd') {
443             #
444             # Inode, file and other kernel statistics. sar -v
445             # Keep reading until we hit an empty line.
446             #
447             while (my $line = ) {
448             chomp($line);
449             @data = split / +/, $line;
450             if (scalar @data == 10 and $data[0] ne 'Average:') {
451             push @{$self->{inode}},
452             {time => $data[0],
453             dentunusd => $data[1],
454             'file-sz' => $data[2],
455             'inode-sz' => $data[3],
456             'super-sz' => $data[4],
457             'psuper-sz' => $data[5],
458             'dquot-sz' => $data[6],
459             'pdquot-sz' => $data[7],
460             'rtsig-sz' => $data[8],
461             'prtsig-sz' => $data[9]};
462             } else {
463             last;
464             }
465             }
466             }
467             } elsif ($count == 11) {
468             if ($data[1] eq 'IFACE') {
469             #
470             # Part of the network statitics, error packets. sar -n FULL
471             # Keep reading until we hit an empty line.
472             #
473             while (my $line = ) {
474             chomp($line);
475             @data = split / +/, $line;
476             if (scalar @data == 11 and $data[0] ne 'Average:') {
477             push @{$self->{net_err}},
478             {time => $data[0],
479             iface => $data[1],
480             rxerr_s => $data[2],
481             txerr_s => $data[3],
482             coll_s => $data[4],
483             rxdrop_s => $data[5],
484             txdrop_s => $data[6],
485             txcarr_s => $data[7],
486             rxfram_s => $data[8],
487             rxfifo_s => $data[9],
488             txfifo_s => $data[10]};
489             } else {
490             last;
491             }
492             }
493             }
494             }
495             }
496             close(FILE);
497             }
498             $self->{name} = $name;
499             $self->{path} = $path;
500              
501             return $retval;
502              
503             return 1;
504             }
505              
506             =head3 to_xml()
507              
508             Returns sar data transformed into XML.
509              
510             =cut
511             sub to_xml {
512             my $self = shift;
513             my $outfile = shift;
514             return XMLout({
515             proc_s => {data => $self->{proc_s}},
516             cswch_s => {data => $self->{cswch_s}},
517             cpu => {data => $self->{cpu}},
518             inode => {data => $self->{inode}},
519             intr => {data => $self->{intr}},
520             intr_s => {data => $self->{intr_s}},
521             io => {
522             tr => {data => $self->{io_tr}},
523             bd => {data => $self->{io_bd}}},
524             memory => {data => $self->{memory}},
525             memory_usage => {data => $self->{memory_usage}},
526             paging => {data => $self->{paging}},
527             network => {
528             ok => {data => $self->{net_ok}},
529             err => {data => $self->{net_err}},
530             sock => {data => $self->{net_sock}}},
531             queue => {data => $self->{queue}},
532             swapping => {data => $self->{swapping}} },
533             RootName => 'sar');
534             }
535              
536             1;
537             __END__