#!/usr/bin/perl
use strict;
use warnings;
package TaskStatsV1;
use base qw(Exporter);
use File::Basename "dirname";
use lib dirname(__FILE__);
use Config;

#NASTY HACK:

our @EXPORT = qw(get_readable_stats get_stats register_pid unregister_pid);
BEGIN {
	#some initialization code to test which module to load depending on the
	#kernel/arch that is found..
	#use the same arch-detect method as configure.pl
	sub _getarch() {
		#returns a  module suffix for the supported architecture, or undef if
		#the architecture is not supported
		my $arch = "";
		if($Config{"archname"} =~ m/x86_64/) {
			#running on 64 bit kernel, 64 bit perl
			return "_amd64";
		}
		my $uname = `uname -a`;
		if ($uname =~ m/x86_64|amd64/) {
			printf(STDERR "%s:%d: WARNING! this module is one of the few things " .
				"that will not work properly on a 32-bit based userland with a 64 " .
				"bit kernel!\n", __FILE__, __LINE__);
			return undef
		}
		$arch .= "_i386";
		if ($uname =~ m/pae/i) {
			$arch .= "_PAE";
		}
		return $arch;
	}
	sub default_dummy(;$) {
		#dummy function, just return a hashref with the "err" key set to 1.
		#The get_stats routine below will do its job and consider that something
		#happened from the C program.. this isn't the best way to do this, but hopefully
		#it shouldn't cause things to crash.
		*get_readable_stats = sub { return { err => 1 }; };
		if($_[0]) {
			print STDERR $_[0];
		}
	}
	my $arch = _getarch();
	if(!$arch) {
		default_dummy();
	} else {
		my $module_name = "pacctinfo$arch";
		eval("require ${module_name};");
		if($@) {
			default_dummy(sprintf("%s:%d: couldn't load %s: %s\nUsing dummy get_readable_stats\n",
					__FILE__, __LINE__, $module_name, $@));
		} else {
			$module_name->import();
			eval("*get_readable_stats = \\&${module_name}::pacctinfo_get_readable_stats;");
			if($@) { print STDERR "$@\n"; }
		}
	}
}




use Time::HiRes qw(sleep usleep);
use Scalar::Util qw(looks_like_number);
use Data::Dumper;
#this is an array of fields available in the struct taskstats provided in
#<linux/taskstats.h>, see that header for an explanation of the fields.
my @FIELDS = qw(cpu_count cpu_delay_total blkio_count blkio_delay_total
swapin_count swapin_delay_total cpu_run_real_total cpu_run_virtual_total);

#keep a hash of {pid}{last_stats}
my $procstats = {};
my @monitored_pids;

sub register_pid {
	#performs simple initialization and registration of the PID
	#The registration functions are used to keep deltas;
	#Currently they don't do much, but are provided for symmetry
	#in case the module would need to be expanded/operated upon.
	#Currently these are essentially no-ops.
	my $pid = $_[0];
	print "Registering $pid\n";
	$procstats->{$pid} = undef;
}
sub unregister_pid {
	#Remove a PID from the registry.
	my $pid = $_[0];
	delete($procstats->{$pid});
}

sub get_stats {
	#returns a list of (actual, deltas) statistics;
	#all statistics are integers; and are stored in a
	#hash using the FIELDS defined in /usr/include/linux/taskstats.h
	#If this function fails, a list of empty hashrefs are returned.
	my $pid = $_[0];
	my (%actual, %deltas);
	#$r is the actual (well.. wrapped, see C source) taskstats structure.
	#I'm avoiding dealing/passing/manipulating this directly as I'm really
	#edgy with swig setting/getting C objects, and funny things can happen (
	#ex. perl can apparently use numbers up to 250 digits, which would not scale
	#well with the struct which uses a 64 bit integer)
	my $r = get_readable_stats($pid);
	#the C module will set this field to nonzero if an error occurred
	#while retrieving process information
	if($r->{"err"}) {
		return ({},{});
	}
	#if we don't have a previous value, fill it in so we can calculate deltas
	if(!$procstats->{$pid}) {
		foreach (@FIELDS) {
			#first time stats are gathered, the 'old' and 'new' values should
			#be the same
			$actual{$_} = $procstats->{$pid}->{$_} = $r->{$_};
			$deltas{$_} = 0;
		}
		#phony delta, return..
		return (\%actual, \%deltas);
	}
	foreach (@FIELDS) {
		my $orig = $procstats->{$pid};
		$actual{$_} = $r->{$_};
		if($actual{$_} < $orig->{$_}) {
			#overlow detected, add $orig to $actual;
			$actual{$_} += $orig->{$_};
		}
		$deltas{$_} = abs($actual{$_} - $orig->{$_});
		$orig->{$_} = $actual{$_};
	}
	return (\%actual, \%deltas);
}

#This is just some testcode
if (!caller) {
	#perl has some real issues with buffer messups
	$| = 1;
	@monitored_pids = map(int, @ARGV);
	if(!@monitored_pids) {
		opendir(my $procps, "/proc");
		@monitored_pids = (map { int($_) } grep { looks_like_number($_) } (readdir($procps)));
		closedir($procps);
	}
	print STDERR "\nMonitoring ". @monitored_pids . " processes\n";

	register_pid($_) foreach (@monitored_pids);
	while(1) {
		foreach (keys %$procstats) {
			my ($actual, $deltas) = get_stats($_);
			if((!%$actual)||(!%$deltas)) {
				print STDERR "something happened for $_: $!\n";
				unregister_pid($_);
				next;
			}
			foreach my $f (grep(!/count/, (@FIELDS))) {
				printf("%-25s %-15f DELTA: %-15f\n", $f,
					$actual->{$f}/ 1_000_000_000,
					$deltas->{$f} / 1_000_000_000);
			}
		}
		print "\n";
		sleep(0.5);
	}
}
1;