#!/usr/bin/perl
########################################################################
#
# Copyright (c) 2015-2016 Wind River Systems, Inc.
#
# SPDX-License-Identifier: Apache-2.0
#
# 
########################################################################
#
# Description:
#  This displays per-core occupancy information per sample period.
#  Output includes total occupancy, and per-core occupancy based on
#  hi-resolution timings.
#
# Usage: occtop OPTIONS
#  [--delay=<seconds>] [--repeat=<num>] [--period=<seconds>]
#  [--header=<num>]
#  [--help]

use strict;
use warnings;
use Data::Dumper;
use POSIX qw(uname strftime);
use Time::HiRes qw(clock_gettime usleep CLOCK_MONOTONIC CLOCK_REALTIME);

use Benchmark ':hireswallclock';
use Carp qw(croak carp);

# Define toolname
our $TOOLNAME = "occtop";
our $VERSION  = "0.1";

# Constants
use constant SI_k => 1.0E3;
use constant SI_M => 1.0E6;
use constant SI_G => 1.0E9;
use constant Ki => 1024.0;
use constant Mi => 1024.0*1024.0;
use constant Gi => 1024.0*1024.0*1024.0;

# Globals
our %percpu_0 = ();
our %percpu_1 = ();
our %D_percpu = ();
our %loadavg = ();
our $D_total = 0.0;
our $tm_0 = 0.0;
our $tm_1 = 0.0;
our $tr_0 = 0.0;
our $tr_1 = 0.0;
our $tm_elapsed = 0.0;
our $tm_final = 0.0;
our $uptime = 0.0;
our $num_cpus = 1;
our $num_tasks = 0;
our $num_blk = 0;
our $print_host = 1;
our $is_schedstat = 1;
our $USER_HZ = 100; # no easy way to get this
our $CLOCK_NS = SI_G / $USER_HZ;

# Argument list parameters
our ($arg_debug,
     $arg_delay,
     $arg_repeat,
     $arg_period,
     $arg_header,
    ) = ();

#-------------------------------------------------------------------------------
# MAIN Program
#-------------------------------------------------------------------------------
my $MIN_DELAY = 0.001;
my $MAX_DELAY = 0.001;

# benchmark variables
my ($bd, $b0, $b1);

# Autoflush output
select(STDERR);
$| = 1;
select(STDOUT); # default
$| = 1;

# Parse input arguments and print tool usage if necessary
&parse_occtop_args(
  \$::arg_debug,
  \$::arg_delay,
  \$::arg_repeat,
  \$::arg_period,
  \$::arg_header,
);

# Print out some debugging information
if (defined $::arg_debug) {
  $Data::Dumper::Indent = 1;
}

# Check for schedstat support; fallback to stats
$is_schedstat = -e '/proc/schedstat' ? 1 : 0;

# Print out selected options
printf "selected options: delay = %.3fs, repeat = %d, header = %d, source = %s\n",
  $::arg_delay, $::arg_repeat, $::arg_header, $is_schedstat ? 'schedstat' : 'jiffie';

# Capture timestamp
$b0 = new Benchmark;

# Get number of logical cpus
&get_num_logical_cpus(\$::num_cpus);


# Get current hires epoc timestamp
$::tm_1 = clock_gettime(CLOCK_MONOTONIC);
$::tr_1 = clock_gettime(CLOCK_REALTIME);
$::tm_final = $::tm_1 + $::arg_delay*$::arg_repeat;

# Set initial delay
$::tm_elapsed = $::arg_delay;
$MAX_DELAY = $::arg_delay + $MIN_DELAY;

# Get overall per-cpu stats
if ($is_schedstat) {
  &read_schedstat(\%::percpu_1);
} else {
  &read_stat(\%::percpu_1);
}

# Main loop
REPEAT_LOOP: for (my $repeat=1; $repeat <= $::arg_repeat; $repeat++) {

  # copy all state variables
  %::tm_0 = (); %::tr_0 = (); %::percpu_0 = ();
  $::tm_0 = $::tm_1; $::tr_0 = $::tr_1;
  foreach my $cpu (keys %::percpu_1) { $::percpu_0{$cpu} = $::percpu_1{$cpu}; }

  # estimate sleep delay to achieve desired interarrival by subtracting out
  # the measured cpu runtime of the tool.
  my $delay = $::arg_delay;
  $delay = $MIN_DELAY if ($delay < $MIN_DELAY);
  $delay = $MAX_DELAY if ($delay > $MAX_DELAY);
  usleep( SI_M*$delay );

  # Collect current state
  $::tm_1 = (); $::tr_1 = (); %::percpu_1 = ();
  # Get current hires epoc timestamp
  $::tm_1 = clock_gettime(CLOCK_MONOTONIC);
  $::tr_1 = clock_gettime(CLOCK_REALTIME);
  # Get overall per-cpu stats
  if ($is_schedstat) {
    &read_schedstat(\%::percpu_1);
  } else {
    &read_stat(\%::percpu_1);
  }

  # Get current uptime
  &get_uptime(\$::uptime);
  # Get current loadavg
  &get_loadavg(\%::loadavg, \$::runq, \$::num_tasks);
  # Get current processes blocked
  &get_blocked(\$::num_blk);

  # Delta calculation
  %::D_percpu = ();
  $::tm_elapsed = $tm_1 - $tm_0;
  foreach my $cpu (keys %::percpu_1) {
    $::D_percpu{$cpu}{'runtime'} = ($::percpu_1{$cpu} - $::percpu_0{$cpu})/1.0E6;
    if ($::tm_elapsed > 0.0) {
      $::D_percpu{$cpu}{'occ'} = 100.0*$D_percpu{$cpu}{'runtime'}/1.0E3/$::tm_elapsed;
    } else {
      $::D_percpu{$cpu}{'occ'} = 0.0;
    }
  }

  # Print tool header
  if ($repeat == 1) {
    &occtop_header(
      \$::tr_1,
      \$::uptime,
      \%::loadavg,
      \$::runq,
      \$::num_blk,
      \$::num_tasks,
      \$::print_host,
    );
  }

  # Print one-liner summary
  &print_occtop(
    \$::tr_1,
    \$::num_cpus,
    \%::D_percpu,
    \$::arg_header,
  );

  # exit repeat loop if we have exceeded overall time
  last if ($::tm_1 > $::tm_final);

} # REPEAT LOOP

# Print that tool has finished
print "done\n";

# Capture timestamp and report delta
$b1 = new Benchmark; $bd = Benchmark::timediff($b1, $b0);
printf "processing time: %s\n", timestr($bd);
exit 0;


#-------------------------------------------------------------------------------

# Parse per-cpu hi-resolution scheduling stats
sub read_schedstat
{
  (local *::percpu) = @_;
  my ($version, $timestamp);
  my ($cpu, $cputime);
  my ($fh, $file);

  %::percpu = ();

  # parse /proc/schedstat
  $file = '/proc/schedstat';
  open($fh, $file) || croak "Cannot open file: $file ($!)";
  $_ = <$fh>; ($version) = /^version\s+(\d+)/;
  $_ = <$fh>; ($timestamp) = /^timestamp\s+(\d+)/;

  if ($version == 15) {
    LOOP_SCHEDSTAT: while (<$fh>) {
      # version 15: cputime is 7th field
      if (/^cpu(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
        $cpu = $1; $cputime = $2;
        $::percpu{$cpu} = $cputime;
      }
    }
  } else {
    croak "schedstat version: $version method not implemented.";
  }
  close($fh);
}

# Parse per-cpu jiffie stats; cputime excludes iowait.
sub read_stat
{
  (local *::percpu) = @_;
  my ($cpu, $cputime);
  my ($user, $sys, $nice, $idle, $iowt, $hirq, $sirq);
  my ($fh, $file);

  %::percpu = ();

  # parse /proc/stat
  $file = '/proc/stat';
  open($fh, $file) || croak "Cannot open file: $file ($!)";
  LOOP_STAT: while (<$fh>) {
    if (/^cpu(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/) {
      $cpu =$1; $user = $2; $sys = $3; $nice = $4; $idle = $5; $iowt = $6; $hirq = $7; $sirq = $8;
      $cputime = $CLOCK_NS * ($user + $sys + $nice + $iowt + $hirq + $sirq);
      $::percpu{$cpu} = $cputime;
    }
  }
  close($fh);
}

# Parse load-average from /proc/loadavg
sub get_loadavg
{
  (local *::loadavg, local *::runq, *::num_tasks) = @_;

  $::loadavg{'1'} = 0.0;
  $::loadavg{'5'} = 0.0;
  $::loadavg{'15'} = 0.0;
  $::runq = 0;
  $::num_tasks = 0;

  my $file = '/proc/loadavg';
  open(my $fh, $file) || croak "Cannot open file: $file ($!)";
  $_ = <$fh>;
  if (/^(\S+)\s+(\S+)\s+(\S+)\s+(\d+)\/(\d+)\s+\d+/) {
    $::loadavg{'1'} = $1;
    $::loadavg{'5'} = $2;
    $::loadavg{'15'} = $3;
    $::runq = $4;
    $::num_tasks = $5;
  }
  close($fh);
}

# Parse blocked from /proc/stat
sub get_blocked
{
  (local *::num_blk) = @_;

  $::num_blk = 0;

  my $file = '/proc/stat';
  open(my $fh, $file) || croak "Cannot open file: $file ($!)";
  while ($_ = <$fh>) {
    if (/^procs_blocked\s+(\d+)/) {
      $::num_blk = $1;
    }
  }
  close($fh);
}

# Parse uptime from /proc/uptime
sub get_uptime
{
  (local *::uptime) = @_;
  $::uptime = 0.0;

  my $file = '/proc/uptime';
  open(my $fh, $file) || croak "Cannot open file: $file ($!)";
  $_ = <$fh>;
  if (/^(\S+)\s+\S+/) {
    $::uptime = $1;
  }
  close($fh);
}

# Get number of online logical cpus
sub get_num_logical_cpus {
  (local *::num_cpus) = @_;
  $::num_cpus = 0;

  my $file = "/proc/cpuinfo";
  open(my $fh, $file) || croak "Cannot open file: $file ($!)";
  LOOP_CPUINFO: while (<$fh>) {
    if (/^[Pp]rocessor\s+:\s\d+/) {
      $::num_cpus++;
    }
  }
  close($fh);
}

# Print occupancy summary
sub print_occtop {
   (local *::tr_1,
    local *::num_cpus,
    local *::D_percpu,
    local *::arg_header,
   ) = @_;

   # counter
   our $count;
   $::count++; $::count %= $::arg_header;
   $::count = 1 if ($::arg_header == 1);

   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($::tr_1);
   my $msec = 1000.0*($::tr_1 - int($::tr_1));

   # Print heading every so often
   if ($::count == 1) {
      printf "%s ".
             "%7s ",
             'yyyy-mm-dd hh:mm:ss.fff',
             'total';
      for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
        printf "%5s ", $cpu;
      }
      print "\n";
   }

   # Print one summary
   my $occ_total = 0.0;
   for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
      $occ_total += $::D_percpu{$cpu}{'occ'};
   }
   printf "%4d-%02d-%02d %02d:%02d:%02d.%03d ".
          "%7.1f ",
      1900+$year, 1+$mon, $mday, $hour, $min, $sec, $msec,
      $occ_total;
  for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
    printf "%5.1f ", $::D_percpu{$cpu}{'occ'};
  }
  print "\n";
}

# Print header
sub occtop_header {
  (local *::tr_1,
   local *::uptime,
   local *::loadavg,
   local *::runq,
   local *::num_blk,
   local *::num_tasks,
   local *::print_host,
  ) = @_;

  # process epoch to get current timestamp
  my $mm_in_s = 60;
  my $hh_in_s = 60*60;
  my $dd_in_s = 24*60*60;
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($::tr_1);
  my $msec = 1000.0*($::tr_1 - int($::tr_1));

  # convert uptime to elapsed <d>:<hh>:<mm>:<ss>
  my ($up, $up_dd, $up_hh, $up_mm, $up_ss);
  $up = int($::uptime);
  $up_dd = int($up/$dd_in_s);
  $up -= $dd_in_s*$up_dd;
  $up_hh = int($up/$hh_in_s);
  $up -= $hh_in_s*$up_hh;
  $up_mm = int($up/$mm_in_s);
  $up -= $mm_in_s*$up_mm;
  $up_ss = $up;
 
  #occtop -- 2014/03/03 02:00:21.357  ldavg:0.07, 0.09, 0.08  runq:1  nproc:440  up:6:13:00:56
  printf "%s %s -- ".
    "%4d-%02d-%02d %02d:%02d:%02d.%03d  ".
    "ldavg:%.2f, %.2f, %.2f  runq:%d  blk:%d  nproc:%d  ".
    "up:%d:%02d:%02d:%02d\n",
    $::TOOLNAME, $::VERSION,
    1900+$year, 1+$mon, $mday, $hour, $min, $sec, $msec,
    $::loadavg{'1'}, $::loadavg{'5'}, $::loadavg{'15'},
    $::runq, $::num_blk, $::num_tasks,
    $up_dd, $up_hh, $up_mm, $up_ss;

  return if (!($::print_host));
  
  # After first print, disable print host information
  $::print_host = 0;

  # Get host specific information
  my ($OSTYPE, $NODENAME, $OSRELEASE, $version, $MACHINE);
  ($OSTYPE, $NODENAME, $OSRELEASE, $version, $MACHINE) = POSIX::uname();
  my ($NODETYPE, $SUBFUNCTION, $BUILDINFO) = ('-', '-', '-');
  my ($SW_VERSION, $BUILD_ID) = ('-', '-');

  # Get platform nodetype and subfunction
  PLATFORM: {
    my $file = "/etc/platform/platform.conf";
    open(FILE, $file) || next;
    while($_ = <FILE>) {
      s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
      if (/^nodetype=(\S+)/) {
        $NODETYPE = $1;
      }
      if (/^subfunction=(\S+)/) {
        $SUBFUNCTION = $1;
      }
    }
    close(FILE);
  }

  # Get loadbuild info
  BUILD: {
    my $file = "/etc/build.info";
    open(FILE, $file) || next;
    while($_ = <FILE>) {
      s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
      if (/^SW_VERSION=\"([^"]+)\"/) {
        $SW_VERSION = $1;
      }
      if (/^BUILD_ID=\"([^"]+)\"/) {
        $BUILD_ID = $1;
      }
    }
    close(FILE);
  }
  $BUILDINFO = join(' ', $SW_VERSION, $BUILD_ID);

  # Parse /proc/cpuinfo to get specific processor info
  my ($n_cpu, $model_name, $cpu_MHz) = (0, '-', 0);
  CPUINFO: {
    my $file = "/proc/cpuinfo";
    open(FILE, $file) || croak "Cannot open file: $file ($!)";
    while($_ = <FILE>) {
      s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
      if (/^[Pp]rocessor\s+:\s+\d+/) {
        $n_cpu++;
      } elsif (/^model name\s+:\s+(.*)$/) {
        $_ = $1; s/\s+/ /g;
        $model_name = $_;
      } elsif (/^cpu MHz\s+:\s+(\S+)/) {
        $cpu_MHz = $1;
      } elsif (/^bogomips\s+:\s+(\S+)/) {
        $cpu_MHz = $1 if ($cpu_MHz == 0);
      }
    }
    close(FILE);
  }

  printf "  host:%s  nodetype:%s  subfunction:%s\n",
    $NODENAME, $NODETYPE, $SUBFUNCTION;
  printf "  arch:%s  processor:%s  speed:%.0f  #CPUs:%d\n",
    $MACHINE, $model_name, $cpu_MHz, $n_cpu;
  printf "  %s %s  build:%s\n", $OSTYPE, $OSRELEASE, $BUILDINFO;

}

# Parse and validate command line arguments
sub parse_occtop_args {
  (local *::arg_debug,
   local *::arg_delay,
   local *::arg_repeat,
   local *::arg_period,
   local *::arg_header,
  ) = @_;
 
  # Local variables
  my ($fail, $arg_help);

  # Use the Argument processing module
  use Getopt::Long;

  # Print usage if no arguments
  if (!@::ARGV) {
    &Usage();
    exit 0;
  }

  # Process input arguments
  $fail = 0;
  GetOptions(
    "debug:i",     \$::arg_debug,
    "delay=f",     \$::arg_delay,
    "period=i",    \$::arg_period,
    "repeat=i",    \$::arg_repeat,
    "header:i",    \$::arg_header,
    "help|h",      \$arg_help
  ) || GetOptionsMessage();

  # Print help documentation if user has selected --help
  &ListHelp() if (defined $arg_help);

  # Validate options
  if ((defined $::arg_repeat) && (defined $::arg_period)) {
    $fail = 1;
    warn "$::TOOLNAME: Input error: cannot specify both --repeat and --period options.\n";
  }
  if ((defined $::arg_delay) && ($::arg_delay < 0.01)) {
    $fail = 1;
    warn "$::TOOLNAME: Input error: --delay %f is less than 0.01.\n",
          $::arg_delay;
  }
  if (@::ARGV) {
    $fail = 1;
    warn "$::TOOLNAME: Input error: not expecting these options: '@::ARGV'.\n";
  }

  # Set reasonable defaults
  $::arg_header ||= 15;
  $::arg_delay  ||= 1.0;
  $::arg_repeat ||= 1;
  if ($::arg_period) {
    $::arg_repeat = $::arg_period / $::arg_delay;
  } else {
    $::arg_period = $::arg_delay * $::arg_repeat;
  }

  # Upon missing or invalid options, print usage
  if ($fail == 1) {
    &Usage();
    exit 1;
  }
}

# Print out a warning message and usage
sub GetOptionsMessage {  
  warn "$::TOOLNAME: Error processing input arguments.\n";
  &Usage();
  exit 1;
}

# Print out program usage
sub Usage {
  printf "Usage: $::TOOLNAME OPTIONS\n";
  printf " [--delay=<seconds>] [--repeat=<num>] [--period=<seconds>]\n";
  printf " [--header=<num>]\n";
  printf " [--help]\n";

  printf "\n"; 
}

# Print tool help
sub ListHelp {
  printf "$::TOOLNAME -- display hi-resolution per-cpu occupancy\n";
  &Usage();
  printf "Options: miscellaneous\n";
  printf " --delay=<seconds>  : output interval (seconds):       default: 1.0\n";
  printf " --repeat=<num>     : number of repeat samples:        default: 1\n";
  printf " --period=<seconds> : overall tool duration (seconds): default: --\n";
  printf " --header=<num>     : print header every num samples:  default: 15\n";
  printf " --help             : this help\n";
  exit 0;
}

1;