package SysUsage::Sar;
#------------------------------------------------------------------------------
#    sysusage - Full system monitoring with RRDTOOL
#    Copyright (C) 2003-2009 Gilles Darold
#
#    This program is provided WITHOUT WARRANTY of any kind, either
#    expressed or implied. It is free software, and you are welcome
#    to modify or re-distribute it under same terms of Perl itself.
#
# Author: Gilles Darold <gilles@darold.net>
#
# This module grab system information retrieve from sar command
# and provide all method to get these informations.
#------------------------------------------------------------------------------
use strict qw(vars);

BEGIN {
        use Exporter();
        use vars qw($VERSION $COPYRIGHT $AUTHOR @ISA @EXPORT);
        $VERSION = '2.10';
        $COPYRIGHT = 'Copyright (c) 2003-2009 Gilles Darold - All rights reserved.';
        $AUTHOR = "Gilles Darold - gilles\@darold.net";

        @ISA = qw(Exporter);
        @EXPORT = qw//;

        $| = 1;

}

sub new
{
	my ($class, %options) = @_;

	my $self = {
		'header'  => '',
		'report'  => (),
		'data'    => (),
		'debug'   => 0,
		'sar_cmd' => ''
	};
	bless $self, $class;

	$self->init(%options);

	return ($self);
}

sub init
{
	my ($self, %options) = @_;

	#### Set the sar command to execute.
	my $sar = $options{'sar'} || '/usr/bin/sar';
	if (!-x $sar) {
		die "ERROR: Can't find sar binary at $sar\n";
	}
	my $opt = $options{'opt'} || '-p -A 1 5';
	$self->{'sar_cmd'} = $sar . ' ' . $opt . ' | grep -v -E "^[0-9]"';
	$self->{'debug'} = $options{'debug'} || 0;

}

# Return sar output first line.  Usually kernel information
sub getHeader
{
	my ($self) = @_;

	return $self->{header};
}

# Parse Sar output and return a hash
sub parseSarOutput
{
	my ($self) = @_;

	#### Execute sar command and get result
	unless(open(SAR, "$self->{'sar_cmd'} |")) {
		die "ERROR: Can't execute command $self->{'sar_cmd'}\n";
	}
	while (my $line = <SAR>) {
		$line =~ s/
//gs;
		chomp($line);
		push(@{$self->{data}}, $line);
	}
	close(SAR);

	#### Extract sar head line. Usually kernel information
	$self->{header} = shift(@{$self->{data}});
	print STDERR "Sar header: $self->{header}\n" if ($self->{'debug'});


	my $type = '';
	my @headers = ();
	my @values = ();
	for (my $i = 0; $i <= $#{$self->{data}}; $i++) {
		# Empty line, maybe the end of a report
		if (!$self->{data}[$i]) {
			$type = '';
			@headers = ();
			@values = ();
			next;
		}
		# Remove average header
		$self->{data}[$i] =~ s#^[a-z]+:[\s\t]+##i;
		# Store all header fields
		if ($#headers == -1) {
			push(@headers, split(m#\s+#, $self->{data}[$i]));
		}
		# Try to find the kind of report
		if ($self->{data}[$i] =~ m#^proc/s#i) {
			$type = 'pcrea';
			next;
		}
		if ($self->{data}[$i] =~ m#^cswch/s#i) {
			$type = 'cswch';
			next;
		}
		if ($self->{data}[$i] =~ m#^CPU\s+i\d+#i) {
			$type = 'ncpu';
			$headers[0] = 'number';
			next;
		} elsif ($self->{data}[$i] =~ m#^CPU\s+#i) {
			$type = 'cpu';
			$headers[0] = 'number';
			next;
		}
		if ($self->{data}[$i] =~ m#^INTR\s+#i) {
			$type = 'intr';
			$headers[0] = 'name';
			next;
		}
		if ($self->{data}[$i] =~ m#^pgpgin/s\s+#i) {
			$type = 'page';
			next;
		}
		if ($self->{data}[$i] =~ m#^pswpin/s\s+#i) {
			$type = 'pswap';
			next;
		}
		if ($self->{data}[$i] =~ m#^tps\s+#i) {
			$type = 'io';
			next;
		}
		if ($self->{data}[$i] =~ m#^frmpg/s\s+#i) {
			$type = 'mpage';
			next;
		}
		if ($self->{data}[$i] =~ m#^TTY\s+#i) {
			$type = 'tty';
			$headers[0] = 'number';
			next;
		}
		if ($self->{data}[$i] =~ m#^IFACE\s+rxpck/s\s+#i) {
			$type = 'net';
			$headers[0] = 'name';
			next;
		}
		if ($self->{data}[$i] =~ m#^IFACE\s+rxerr/s\s+#i) {
			$type = 'err';
			$headers[0] = 'name';
			next;
		}
		if ($self->{data}[$i] =~ m#^DEV\s+#i) {
			$type = 'dev';
			$headers[0] = 'name';
			next;
		}
		if ($self->{data}[$i] =~ m#^kbmemfree\s+#i) {
			$type = 'mem';
			next;
		}
		# New in sysstat 8.1.5
		if ($self->{data}[$i] =~ m#^kbswpfree\s+#i) {
			$type = 'swap';
			next;
		}
		if ($self->{data}[$i] =~ m#^dentunusd\s+#i) {
			$type = 'file';
			next;
		}
		if ($self->{data}[$i] =~ m#^totsck\s+#i) {
			$type = 'sock';
			next;
		}
		if ($self->{data}[$i] =~ m#^runq-sz\s+#i) {
			$type = 'load';
			next;
		}
		# Unknow type of report, skipping
		if (!$type) {
			@headers = ();
			@values = ();
			next;
		}
		# Get all values reported
		push(@values, split(m#\s+#, $self->{data}[$i]));
		if ($#values != $#headers) {
			die "ERROR: Parsing of sar output reports different values than headers allow. ($#values != $#headers)\n";
		}
		# Store all into the main hash
		for (my $j = 0; $j <= $#headers; $j++) {
			# Remove extra info into headers
			$headers[$j] =~ s#/s##g;
			# Change decimal character to perl
			$values[$j] =~ s/,/\./;
			if ($values[$j] !~ /[a-z]/i) {
				# Round decimal up to .50
				if ($values[$j] gt 50) {
					$values[$j]++;
				}
				# Store it as integer
				$values[$j] = int($values[$j]);
			}

			# New version of sar report proc and cswch at same time
			if ( ($#headers == 1) && ($headers[$j] eq 'cswch') ) {
				$self->{report}{'cswch'}{$headers[$j]} = $values[$j];
			} elsif ( ($type eq 'mem') && ($headers[$j] eq '%swpused') ) {
				$self->{report}{'swap'}{$headers[$j]} = $values[$j];
print STDERR "Sar report 'swap': $headers[$j] => $self->{report}{'swap'}{$headers[$j]}\n" if ($self->{'debug'});
			} elsif ( ($type eq 'mem') && ($headers[$j] eq '%commit') ) {
				$self->{report}{'work'}{$headers[$j]} = $values[$j];
print STDERR "Sar report 'work': $headers[$j] => $self->{report}{'work'}{$headers[$j]}\n" if ($self->{'debug'});
			} elsif ( ($type eq 'mem') && ($headers[$j] eq 'kbcommit') ) {
				$self->{report}{'work'}{$headers[$j]} = $values[$j];
print STDERR "Sar report 'work': $headers[$j] => $self->{report}{'work'}{$headers[$j]}\n" if ($self->{'debug'});
			} elsif (!grep(/^$headers[0]$/, 'name', 'number')) {
				$self->{report}{$type}{$headers[$j]} = $values[$j];
print STDERR "Sar report '$type': $headers[$j] => $self->{report}{$type}{$headers[$j]}\n" if ($self->{'debug'});
			} else {
				next if ( ($type eq 'intr') && ($values[0] ne 'sum') );
				$headers[$j] = '%user' if ( ($type eq 'cpu') && ($headers[$j] eq '%usr'));
				$headers[$j] = '%system' if ( ($type eq 'cpu') && ($headers[$j] eq '%sys'));
				$self->{report}{$type}{$values[0]}{$headers[$j]} = $values[$j];
print STDERR "Sar report '$type' ($values[0]): $headers[$j] => $self->{report}{$type}{$values[0]}{$headers[$j]}\n" if ($self->{'debug'});
			}
		}
		@values = ();
	}

}

# Return a hash of the given type of report. Here are the allowed type
# of report and the corresponding fields:
#
#	'pcrea'	Report process creation activity
#
#		proc => Total number of processes created per second
#
#	'cswch' Report system switching activity
#
#		cswch => Total number of context switches per second
#
#	'cpu'   Report CPU utilization.
#
#		%user => Percentage of CPU utilization at the user level (application)
#		%nice => Percentage of CPU utilization at the user level with nice priority
#		%system => Percentage of CPU utilization at system level (kernel, I/O)
#		%iowait => percentage of CPU time spent waiting on disk I/O
#		%steal => percentage of time spent in involuntary wait by the  virtual CPU or CPUs while the hypervisor was servicing another virtual processor
#		%idle => Percentage of time that the CPU were idle
#
#	'intr'  Report interrupt statistics
#
#		name => Identifier (can be sum or a number ???)
#		intr => Interrupts per second
#
#	'page'  Report paging statistics
#
#		pgpgin => Total number of blocks the system paged in from disk per second
#		pgpgout => Total number of blocks the system paged out to disk per second
#		fault => Number of page faults (major + minor) made by the system per second
#		majflt => Number of major faults the system has made per second
#
#	'pswap' Report swapping statistics
#
#		pswpin => Total number of swap pages the system brought in per second
#		pswpout => Total number of swap pages the system brought out per second
#
#	'io'    Report I/O and transfer rate statistics
#
#		tps => Total transfers per second that were issued to the physical disk
#		rtps => Total read requests per second issued to the physical disk
#		wtps => Total write requests per second issued to the physical disk
#		bread => Total amount of data read from the drive in blocks per second
#		bwrtn => Total amount of data written to the drive in blocks per second
#
#	'mpage' Report memory statistics
#
#		frmpg => Number of memory pages freed by the system per second
#		shmpg => Number of additionnal memory pages shared by the system per second
#		bufpg => Number of additionnal memory pages used as buffers by the system per second
#		campg => Number of additionnal memory pages cached by the system per second
#
#	'tty' Report TTY device activity
#
#		number => Serial line number
#		rcvin => Number of receive interrupts per second
#		xmtin => Number of transmit interrupts per second
#
#	'net' Report network statistics
#
#		name => Name of the network interface for which statistics are reported
#		rxpck => Total number of packets received per second
#		txpck => Total number of packets transmitted per second
#		rxbyt => Total number of bytes received per second
#		txbyt => Total number of bytes transmitted per second
#		rxcmp => Number of compressed packets received per second
#		txcmp => Number of compressed packets transmitted per second
#		rxmcst => Number of multicast packets received per second
#
#	'err' Report network failure statistics
#
#		name => Name of the network interface for which statistics are reported
#		rxerr => Total number of bad packets received per second
#		txerr => Total number of errors that happened per second
#		coll => Number of collisions that happened per second
#		rxdrop => Number of received packets dropped per second
#		txdrop => Number of transmitted packets dropped per second
#		txcarr => Number of carrier-errors that happened per second
#		rxfram => Number of frame alignment errors that happened per second on received packets
#		rxfifo => Number of FIFO overrun errors that happened per second on received packets
#		txfifo => Number of FIFO overrun errors that happened per second on transmitted packets
#
#	'dev' Report activity for each block device
#
#		name => Name of the device (dev-major-minor or realname with -p)
#		tps => Indicate the number of transfers per second that were issued to the device
#		rd_sec => Number of sectors read from the device. The size of a sector is 512 bytes
#		wr_sec => Number of sectors written to the device. The size of a sector is 512 bytes
#
#	'mem'  Report memory and swap space
#
#		kbmemfree => Amount of free memory available in kilobytes
#		kbmemused => Amount of used memory in kilobytes
#		%memused => Percentage of used memory
#		kbbuffers => Amount of memory used as buffers by the kernel in kilobytes
#		kbcached => Amount of memory used to cache data by the kernel in kilobytes
#		kbswpfree => Amount of free swap space in kilobytes
#		kbswpused => Amount of used swap space in kilobytes
#		%swpused => Percentage of used swap space
#		kbswpcad => Amount of cached swap memory in kilobytes
#		kbcommit => Amount of memory needed for current workload
#		%commit => Percentage of memory needed for current workload
#
#	'file' Report status of inode, file and other kernel tables
#
#		dentunusd => Number of unused cache entries in the directory cache
#		file-sz => Number of used file handles
#		%file-sz => Percentage of used file handles with regard to the maximum number of file handles
#		inode-sz => Number of used inode handlers
#		super-sz => Number of super block handlers allocated by the kernel
#		%super-sz => Percentage of allocated super block handlers with regard to the
#			maximum number of super block handlers that Linux can allocate.
#		dquot-sz => Number of allocated disk quota entries.
#		%dquot-sz => Percentage of allocated disk quota entries with regard to the
#			maximum number of cached disk quota entries that can be allocated.
#		rtsig-sz => Number of queued RT signals
#		%rtsig-sz => Percentage of queued RT signals with regard to the maximum number
#			of RT signals that can be queued.
#
#	'sock' Report sockets in use statistics
#
#		totsck => Total number of used sockets
#		tcpsck => Number of TCP sockets currently in use
#		udpsck => Number of UDP sockets currently in use
#		rawsck => Number of RAW sockets currently in use
#		ip-frag => Number of IP fragments currently in use
#
#	'load'  Report  queue length and load averages
#
#		runq-sz => Run queue length (number of processes  waiting for run time)
#		plist-sz => Number of processes in the process list
#		ldavg-1 => System load average for the last minute
#		ldavg-5 => System  load average for the past 5 minutes
#		ldavg-15 => System load average for the past 15 minutes
#
#
sub getReportType
{
	my ($self, $type) = @_;

	die "ERROR: bad report type $type\n" if (!exists $self->{report}{$type});

	return %{$self->{report}{$type}};

}

sub getReport
{
	my ($self, $type) = @_;

	return %{$self->{report}};

}


1;

__END__