#!/usr/bin/perl -w

use strict;
use warnings;
use Time::ParseDate;

########################################################################
# global variables
########################################################################
# time the zzz line inserted in GMT
our $zzz_second = 0;  # set by "zzz ... " line. 0 means "there are no zzz line"
# system boot time in GMT
our $sys_bootsecond = 0;  # set by $zzz_second and the 1st "top -" line.


# importing global %opts for analyzing opts{quiet} in printProcessing
use vars qw(%opts);


# just print error onto STDERR
sub error {
	print STDERR "Error: ".join("\n", @_)."\n";
}

# just print error onto STDERR and exit 
sub error_exit {
	error(@_);
	exit 1;
}

# just print warning onto STDERR
sub warning {
	print STDERR "Warning: ".join("\n", @_)."\n";
}

# just print message onto STDERR
sub message {
	print STDERR join("\n", @_)."\n";
}
# just print message onto STDERR without newline
sub message_nl {
	print STDERR join("\n", @_);
}

# list/array handling routines
#
# check whether the array a and b is same(value order independent)
sub isEqualList {
	my ($a, $b) = @_;
	return 0 if $#$a != $#$b;
	# at first, compare as string to check they are completely same
	return 1 if ("@$a" eq "@$b");
	my @ary_a = sort(@$a);
	my @ary_b = sort(@$b);
	# compare as sorted string to check whether they have exchanged values
	return ("@ary_a" eq "@ary_b");
}

# get unique items in list b which are unique from list a
sub getUniqueItemsFromListB {
	my ($a, $b) = @_;
	my @ret;
	foreach my $item (@$b) {
		if (!grep { $_ eq $item } @$a) {
			push(@ret, $item);
		}
	}
	return @ret;
}

# get unique items in list a which are unique from list b
sub getUniqueItemsFromListA {
	my ($a, $b) = @_;
	return getUniqueItemsFromListB($b, $a);
}



# subroutines which print progression string, "processing ## % ..."
my $totalsize;
my $prevtime;
my $proccount;
sub initPrintProcessing {
	$totalsize = 0;
	$totalsize = $_[0] if (defined($_[0]));
	$prevtime = time();
	$proccount = 0;
}
sub printProcessing {
	my ($addmes, $forceprint) = @_;
	my $quiet = %opts && $opts{quiet};
	if ((time() - $prevtime >= 3 || $forceprint) && !$quiet) {
		$addmes = "" if (!defined($addmes));
		if ($totalsize > 0) {
			message(sprintf("\tprocessing count :%5d/%5d(%4.1f%%)$addmes", $proccount, $totalsize, 100.0*$proccount/$totalsize));
		} else {
			message(sprintf("\tprocessing count :%5d$addmes", $proccount));
		}
		$prevtime = time();
	}
	$proccount++;
}
sub endPrintProcessing {
	printProcessing($_[0], 1);
	$proccount--;
}


# get date string from seconds. The seconds is from 1970/01/01 00:00:00 UTC.
sub getDateStringFromSeconds {
	my ($nowsec, $globalflg) = @_;
	my ($sec,$min,$hour,$mday,$mon,$year);
	if ($globalflg) {
		($sec,$min,$hour,$mday,$mon,$year,,) = gmtime($nowsec);
	} else {
		($sec,$min,$hour,$mday,$mon,$year,,) = localtime($nowsec);
	}
	return sprintf("%04d/%02d/%02d %02d:%02d:%02d",
			$year+1900,$mon+1,$mday,$hour,$min,$sec);
}

# get seconds(from 1970/01/01 00:00:00 UTC) from time string.
# getSecondsFromDateString($str, $timezene)
sub getSecondsFromDateString {
	my ($str, $tz) = @_;
	$tz = "" if (!$tz);
	my ($sec, $err) = parsedate("$str $tz");
	return ($sec, $err);
}

# $mon, $year is from localtiome() or gmtime();
sub getSecondsFromDateList {
	my ($sec,$min,$hour,$mday,$mon,$year, $tz) = @_;
	$tz = "" if (!$tz);
	my $str = sprintf("%04d/%02d/%02d %02d:%02d:%02d",
			$year+1900, $mon+1, $mday, $hour, $min, $sec);
	my ($ret, $err) = parsedate("$str $tz");
	return ($ret, $err);
}


# isZZZLine($line)
# returns 1(true) if the line begins with "zzz"
sub isZZZLine {
	my $line =$_[0];
	return ($line =~ /^\s*zzz/);
}


# setZZZLine($zzzline)
# returns 1(true) if $zzz_second is updated, 0(false) if can not analized.
# set $zzz_second(seconds from 1970/01/01 00:00:00 UTC) and $timezone from zzz
# line
# <zzz line ex.> ... there are several zzz line format :(
# zzz <12/23/2014 13:31:52> Count:720
# zzz ***Wed Oct 29 13:35:53 EDT 2014 Sample interval: 5 seconds. All measurements in KB (1024 bytes)
# zzz Wed Oct 29 13:35:53 EDT 2014 Sample interval: 5 seconds. All measurements in KB (1024 bytes)
sub setZZZLine {
	my $zzzline = $_[0];
	my $timestr;

	return 0 if (!isZZZLine($zzzline));

	# for case "zzz <12/23/2014 13:31:52> Count:720"
	# add: for case "   zzz <12/23/2014 13:31:52> subcount:720"
	($timestr) = ($zzzline =~ /^.*\D(\d+\/\d+\/\d+ \d+:\d+:\d+)/);
	if (defined($timestr)) {
		my ($sec, $err) = getSecondsFromDateString($timestr);
		if (!$sec) {
			warning("zzz date cannot be parsed:\n".
				"  Line : $zzzline\n".
			        "  Error: $err");
			# not exit 1 but return 0, to try continuing parsing
			return 0;
		}
		$zzz_second = $sec;
		$sys_bootsecond = 0; # clear here

		# no timezone is specified in this case
		return 1;
	}

	# for case "zzz (***|)Wed Oct 29 13:35:53 EDT 2014 ..."
	$_ = $zzzline;
	my ($sp, $timezone);
	($timestr,$sp,$sp,$sp,$timezone) = (/^.*((Mon|Tue|Wed|Thu|Fri|Sat|Sun) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) \d+ \d+:\d+:\d+ ?(|am|pm|AM|PM) ([A-Z\-\+\d]+) \d+)/);
	if (!defined($timestr)) {
		# The last resort to analyze illegal zzz line
		# ex. "2014xx11xx22xx 5:32:52am JST 2014"
		# ex. "11xx22xx 5:32:52am 2014 JST"
		($sp, $timestr,$sp,$timezone,$sp) = (/((\d+:\d+:\d+) ?(|am|pm|AM|PM) .*?(([A-Z]+)(|[\-\+]\d+)))/);
		my ($year,$mon,$day,$sp) = (/(\d+)[^\d:]+(\d+)[^\d:]+(\d+)($|[^\d:])/);
		if (!defined($year) || !defined($mon) || !defined($day)) {
			($year) = (/(20\d{2})/);
			($mon,$day,$sp) = (/(\d+)[^\d:]+(\d+)($|[^\d:])/);
		}
		if (!defined($timestr) || !defined($timezone) ||
		    !defined($year) || !defined($mon) || !defined($day)) {
			warning("zzz date cannot be analyzed:\n".
				"  Line: $zzzline");
			# not exit 1 but return 0, to try continuing parsing
			return 0;
		}
		$timestr = "$year/$mon/$day $timestr $timezone"
	}
	#message("zzzline : $zzzline\ntimestr : $timestr\ntimezone: $timezone");
	my ($sec, $err) = getSecondsFromDateString($timestr);
	if (!$sec) {
		warning("zzz date cannot be parsed:\n".
			"  Line : $zzzline\n".
			"  Error: $err");
		# not exit 1 but return 0, to try continuing parsing
		return 0;
	}
	$zzz_second = $sec;
	$sys_bootsecond = 0; # clear here
	return 1 if ($ENV{TZ} eq $timezone);

	$_ = $timezone;
	# set $ENV{TZ} again
	if (/^[A-Z]+$/ && $_ !~ /^(GMT|UTC|gmt|utc)$/) {
		# change the TZ to $tz[+-][1-9]+, as "JST" is not analized by
		# localtime(), need to set "JST-9"(POSIX) instead.
		my $tz = $_;
		$_ = $timestr;
		s/$timezone/UTC/;
		($sec, $err) = getSecondsFromDateString($_);
		if (!$sec) {
			warning("zzz Timezone cannot set to UTC:\n".
				"  Line : $_\n".
				"  Error: $err");
			return 1;
		}
		# obtain the hour difference between UTC and current timezone
		# how about india...(diff = 3.5hours)?
		my $diff = ($zzz_second - $sec)/3600;
		if ($diff !~ /^[\+\-]?\d+$/) {
			warning("zzz Timezone diff cannot be calcurated:\n".
				"  Timezone: $_, diff=$diff");
			return 1;
		}
		# add '+' if necessary
		$_ = $tz.($diff =~ /^\d+$/ ? "+".$diff : $diff);
		return 1 if ($ENV{TZ} eq $_);
	}
	$ENV{TZ} = $_;
#	message("Configure zzz Timezone to '$_'\n");
	return 1;
}



# setZZZByTimeLine() ... set $zzz_second by analyzing "Time: ##:##:## [AP]M"
# Note: this returns true/false whether the line can be analyzed.
sub setZZZByTimeLine {
	my $line = $_[0];

	# for "Time: \d+:\d+:\d+/"
	$_ = $line;
	my ($nowhour,$nowmin,$nowsec,$nowampm) = /^Time:\s*(\d+):(\d+):(\d+)\s*(AM|PM|am|pm)/;
	if (!defined($nowhour)) {
		($nowhour, $nowmin, $nowsec) = /^Time:\s*(\d+):(\d+):(\d+)\s*/;
		($nowampm) = "";
	}
	if (defined($nowhour)) {
		my ($sec,$min,$hour,$day,$mon,$year,,) = localtime($zzz_second);
		my $cursec = parsedate(($year+1900)."/".($mon+1)."/$day".
				" $nowhour:$nowmin:$nowsec $nowampm $ENV{TZ}");
		$cursec += 86400 if ($cursec < $zzz_second);  # change the day
		$zzz_second = $cursec;
		return 1;
	}

	# for "   <01/29/2015 01:59:37> Count:0", or "09/02/16 06:24:14"
	$_ = $line;
	my ($mon, $day, $year, $hour, $min, $sec) =
			m|^\s*<?(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)>?|;
	if (defined($mon)) {

		$year += 1900 if (70 <= $year && $year <= 99);
		$year += 2000 if (00 <= $year && $year < 70);
		my $curdatestr = sprintf("%04d/%02d/%02d %02d:%02d:%02d %s",
				$year,$mon,$day,$hour,$min,$sec,$ENV{TZ});
		my $cursec = parsedate($curdatestr);
		$cursec += 86400 if ($cursec < $zzz_second);
		$zzz_second = $cursec;
		return 1;
	}
	return 0;
}


# read next line from STDIN, and skip if it is a "blank" and "commented" line
# if the line has been end, this returns "undefined"
sub readNextLineFromSTDIN {
	my ($readcommentflg) = $_[0];
	while (<STDIN>) {
		chomp;
		return $_ unless (/^\s*$/ || (!$readcommentflg && /^\s*#/));
	}
	return $_; # return undef
}


# $phash = {
#     # Note: prockey is a hash as it's faster than array to exclusive the keys
#     prockey   => { "init:1" => 1, "oracle:5562" => 1, ... ];
#     procdata  => { 2364349349(=second of "2016/07/08 10:50:01") => {
#                       "init:1" => 1002,
#                               # selected from VIRT,RES,SHR,%CPU,%MEM
#                       "oracle:5562" => 61488
#                               :
#                  },
#                  { 2364349359(=second of "2016/07/08 10:50:11") => {
#                               :
#                  },
#                               :
# }

# print processhash(%$phash) as CSV
sub printProcessCSV {
	my $phash = $_[0];

message("      outputting the data...");
	# print header
	my @prockeys = sort(keys %{$phash->{prockey}});
	print "Time,Timezone,".join(',', @prockeys)."\n";

	my @alltime = sort { $a <=> $b } keys(%{$phash->{procdata}});
	initPrintProcessing($#alltime+1);
	# print body
	foreach my $second (@alltime) {
		printProcessing();
		my $line = getDateStringFromSeconds($second).",$ENV{TZ}";
		# loop for each of "date seconds"
		my $curphash = $phash->{procdata}->{$second};
		foreach my $proc (@prockeys) {
			$line .= ',';
			$_ = $curphash->{$proc};
			$line .= $_ if (defined($_));
		}
		print $line."\n";
	}
	endPrintProcessing();
}


# print process hash(%$phash) wraped up with same_named_processes as CSV
sub printWrapupedProcessCSV {
	my ($phash, $countnum) = @_;
	my %newphash = ( prockey => {}, procdata => {} );
	my @prockeys = keys %{$phash->{prockey}};

message("      wrapping up processes which have same name ...");
	# generate %newphash, which has process wrap-up-ed information
	my @processedproc;
	initPrintProcessing($#prockeys+1);
	foreach my $proc (@prockeys) {
		printProcessing();
		# skip more operation when $p has been processed
		next if (grep { $_ eq $proc } @processedproc);

		# remove PID info and generate pure process name.
		# note that changing $proc is changing @prockeys, thus
		# new $procname needs to be defined.
		my $procname = $proc;
		$procname =~ s/:\d+$//;
		
		my @procpids = grep(/^\Q$procname\E:\d+$/, @prockeys);
		foreach my $second (keys %{$phash->{procdata}}) {
			my ($sum, $sum_is_valid) = (0, 0);
			my $sechash = $phash->{procdata}->{$second};
			foreach my $procpid (@procpids) {
				if (defined($sechash->{$procpid})) {
					$sum_is_valid = 1;
					if ($countnum) {
						$sum++;
					} else {
						$sum += $sechash->{$procpid};
					}
				}
			}
			next if (!$sum_is_valid);
			$newphash{procdata}->{$second}->{$procname} = $sum;
		}
		push(@processedproc, @procpids);
		$newphash{prockey}->{$procname} = 1;
	}
	endPrintProcessing();

	# print %newphash
	printProcessCSV(\%newphash);
}



1;

