#!/usr/bin/perl
########################################################################
#
# Copyright (c) 2015 Wind River Systems, Inc.
#
# SPDX-License-Identifier: Apache-2.0
#
# 
########################################################################
#
# Description:
#  This displays overall memory information per sample period.
#  Output includes total, used, avail, per-numa node breakdown of avail
#  and free hugepages memory.
#
# Usage: memtop OPTIONS
#  memtop [--delay=<seconds>] [--repeat=<num>] [--period=<seconds>] [--help]
#

# Summarize high-level memory usage.
use 5.10.0;
use warnings;
use strict;
use Benchmark ':hireswallclock';
use POSIX qw(strftime);
use Data::Dumper;
use File::Basename;
use File::Spec ();
use Time::HiRes qw(time usleep);
use Carp qw(croak carp);

# IEC and SI 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;

# Name of this program
our $TOOLNAME = basename($0);
our $VERSION  = "0.1";

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

# Globals
our $t_0 = ();
our $t_1 = ();
our $t_elapsed = ();
our $t_final = ();
our $is_strict = ();
our $num_nodes = ();

#-------------------------------------------------------------------------------
# MAIN Program
#-------------------------------------------------------------------------------
# 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_memtop_args(
  \$::arg_debug,
  \$::arg_delay,
  \$::arg_repeat,
  \$::arg_period,
);

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

# Strict vs non-strict memory accounting
$::is_strict = &is_strict();

# Number of numa nodes
$::num_nodes = &num_numa_nodes();

# Print tool header and selected options
printf "%s %s -- ".
       "selected options: delay = %.3fs, repeat = %d, period = %.3fs, %s, unit = %s\n",
       $::TOOLNAME, $::VERSION,
       $::arg_delay, $::arg_repeat, $::arg_period,
       $::is_strict ? 'strict' : 'non-strict',
       'MiB';

# Capture timestamp
$b0 = new Benchmark;

# Get current hires epoc timestamp
$::t_1 = time();
$::t_final = $::t_1 + $::arg_period;

# Set initial delay
$::t_elapsed = $::arg_delay;

# Main loop
my $delay = SI_M*$::arg_delay - 600.0;
REPEAT_LOOP: for (my $rep=1; $rep <= $::arg_repeat; $rep++) {
   # Copy all state variables
   $::t_0 = $::t_1;

   # Sleep for desired interarrival time
   usleep( $delay );

   # Current hires epoc timestamp
   $::t_1 = time();

   # Delta calculation
   $::t_elapsed = $::t_1 - $::t_0;

   # Print summary
   &print_memory(\$::t_1);

   # Exit if we have reached period
   last if ((defined $::t_final) && ($::t_1 > $::t_final));
}

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

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


################################################################################

# Parse input option arguments
sub parse_memtop_args {
   (local *::arg_debug,
    local *::arg_delay,
    local *::arg_repeat,
    local *::arg_period,
   ) = @_;
 
   # Local variables
   my ($fail, $arg_help);

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

   # Process input arguments
   $fail = 0;
   GetOptions(
     "debug:i",   \$::arg_debug,
     "delay=f",   \$::arg_delay,
     "repeat=i",  \$::arg_repeat,
     "period=i",  \$::arg_period,
     "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_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 " [--help]\n";
   printf "\n"; 
}

# Print tool help
sub ListHelp {
   printf "$::TOOLNAME -- displays high memory usage at high level\n";
   &Usage();
   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 " --help             : this help\n";
   printf "\n";
   exit 0;
}

# Print memory summary
sub print_memory {
   (local *::t_1) = @_;

   # counter
   our $count;
   $::count++; $::count %= 15;

   my ($file, $n);
   my %mem  = ();
   my %node = ();

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

   # Process all entries of MEMINFO
   $file = '/proc/meminfo';
   open(FILE, $file) || die "Cannot open file: $file ($!)";
   while($_ = <FILE>) {
      s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
      if (/^(\S+):\s+(\d+)\b/) {
         $mem{$1} = $2;
      }
   }
   close(FILE);

   # Process all entries of per-Node MEMINFO
   for ($n=0; $n < $::num_nodes; $n++) {
      $file = sprintf('/sys/devices/system/node/node%d/meminfo', $n);
      open(FILE, $file) || die "Cannot open file: $file ($!)";
      while($_ = <FILE>) {
         s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
         if (/^Node\s+(\d+)\s+(\S+):\s+(\d+)\b/) {
            $node{$1}{$2} = $3;
         }
      }
      close(FILE);
   }

   # Calculate available memory
   if ($::is_strict) {
      $mem{'Avail'} = $mem{'CommitLimit'} - $mem{'Committed_AS'};
   } else {
      $mem{'Avail'} = $mem{'MemFree'} +
                      $mem{'Cached'} +
                      $mem{'Buffers'} +
                      $mem{'SReclaimable'};
   }
   $mem{'Used'} = $mem{'MemTotal'} - $mem{'Avail'};
   $mem{'Anon'} = $mem{'AnonPages'};
   for ($n=0; $n < $::num_nodes; $n++) {
      $node{$n}{'Avail'} = $node{$n}{'MemFree'} +
                           $node{$n}{'FilePages'} +
                           $node{$n}{'SReclaimable'};
      $node{$n}{'HFree'} = $node{$n}{'HugePages_Free'} * $mem{'Hugepagesize'};
   }

   # Print heading every so often
   if ($::count == 1) {
      printf "%s ".
             "%8s %8s %8s %7s %6s %6s %8s %8s %7s %7s %8s %8s",
             'yyyy-mm-dd hh:mm:ss.fff',
             'Tot', 'Used', 'Free', 'Ca', 'Buf', 'Slab', 'CAS', 'CLim', 'Dirty', 'WBack', 'Anon', 'Avail';
      for ($n=0; $n < $::num_nodes; $n++) {
          printf " %8s %8s", sprintf('%d:Avail', $n), sprintf('%d:HFree', $n);
      }
      printf "\n";
   }

   # Print one line memory summary
   printf "%4d-%02d-%02d %02d:%02d:%02d.%03d ".
          "%8.1f %8.1f %8.1f %7.1f %6.1f %6.1f %8.1f %8.1f %7.1f %7.1f %8.1f %8.1f",
      1900+$year, 1+$mon, $mday, $hour, $min, $sec, $msec,
      $mem{'MemTotal'}/Ki,
      $mem{'Used'}/Ki,
      $mem{'MemFree'}/Ki,
      $mem{'Cached'}/Ki,
      $mem{'Buffers'}/Ki,
      $mem{'Slab'}/Ki,
      $mem{'Committed_AS'}/Ki,
      $mem{'CommitLimit'}/Ki,
      $mem{'Dirty'}/Ki,
      $mem{'Writeback'}/Ki,
      $mem{'Anon'}/Ki,
      $mem{'Avail'}/Ki;
      for ($n=0; $n < $::num_nodes; $n++) {
          printf " %8.1f %8.1f", $node{$n}{'Avail'}/Ki, $node{$n}{'HFree'}/Ki;
      }
      printf "\n";

}

sub num_numa_nodes {
   my $file = '/proc/cpuinfo';
   my %nodes = ();
   open(FILE, $file) || die "Cannot open file: $file ($!)";
   while($_ = <FILE>) {
      s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
      if (/^physical\s+id\s+:\s+(\d+)\b/) {
         $nodes{$1} = 1;
      }
   }
   close(FILE);
   return scalar keys %nodes;
}

sub is_strict {
   my $value = 0;
   my $file = '/proc/sys/vm/overcommit_memory';
   open(FILE, $file) || die "Cannot open file: $file ($!)";
   $_ = <FILE>;
   $value = /(\d+)/;
   close(FILE);
   return ($value == 2) ? 1 : 0;
}

1;