#!/usr/local/bin/perl
use strict;
use warnings;
use BSD::Sysctl;
use JSON;
use Time::HiRes qw(gettimeofday sleep);

my $scanInterval = 0.9;     # Interval in seconds, may be fractional.
my $stop_after = 268435456; # how many lost wired pages to stop this after? You can also ^C.

my $pagesize = BSD::Sysctl->new('vm.stats.vm.v_page_size')->get();
my $wired = BSD::Sysctl->new('vm.stats.vm.v_wire_count');
my $prettybytes = sub {
  my $pages = shift;
  my $bytes = $pages * $pagesize;
  return sprintf("%.3f Gb", $bytes/(1024*1024*1024));
};

sub indexOutput {
  my ($s, $key1, $key2, $indexfield) = @_;
  my $jsonhash = decode_json($s);
  my $cursor = $jsonhash->{$key1}->{$key2};

  my $indexed = {};
  my $ct = 0;   # this madness is because there are duplicated names
  foreach my $thing (@$cursor) {
    my $name = $thing->{$indexfield} . ' (' . $ct++ . ')';
    $indexed->{$name} = $thing;
  }
  return $indexed;
}

# vmstat -z
sub getZ {
  my $s = `/usr/bin/vmstat -z --libxo json`;
  return indexOutput($s, 'memory-zone-statistics','zone','name');
}

# vmstat -m
sub getM {
  my $s = `/usr/bin/vmstat -m --libxo json`;
  return indexOutput($s, 'malloc-statistics','memory','type');
}

my $initZ = my $lastZ = getZ();
my $initM = my $lastM = getM();
my $initW = my $lastW = $wired->get();

my $maxZname = 0;
foreach my $name (keys %$initZ) {
  $maxZname = (length($name) > $maxZname) ? length($name) : $maxZname;
}
my $maxMname = 0;
foreach my $name (keys %$initM) {
  $maxMname = (length($name) > $maxMname) ? length($name) : $maxMname;
}

my $runloop = 1;
$SIG{'INT'} = sub { $runloop = 0; };

while ($runloop && $lastW - $initW < $stop_after) {
  sleep($scanInterval);

  my $curZ = getZ();
  my $curM = getM();
  my $curW = $wired->get();

  my @now = (gettimeofday);
  my $nowstr = sprintf("[%s] (%06d) ", scalar(localtime($now[0])), $now[1]);

  # Check if Wired changes
  my $deltaW = $curW - $lastW;
  printf("%s (wired) Changed by %5d pages (now at %s, total change since start %d pages)\n",
         $nowstr, $deltaW, $prettybytes->($curW), $curW-$initW) if ($deltaW != 0);

  # Check if Z changes
  foreach my $name (keys %$curZ) {
    my $delta =  $curZ->{$name}->{'used'} - $lastZ->{$name}->{'used'};
    my $since =  $curZ->{$name}->{'used'} - $initZ->{$name}->{'used'};
    printf("%s (vmstat -z) %".$maxZname."s size changed by %d units of whatever the 'used' field is in (%d since start)\n",
           $nowstr, $name, $delta, $since) if ($delta > 0 && $since > 0);
  }

  # Check if M changes
  foreach my $name (keys %$curM) {
    my $delta =  $curM->{$name}->{'memory-use'} - $lastM->{$name}->{'memory-use'};
    my $since =  $curM->{$name}->{'memory-use'} - $initM->{$name}->{'memory-use'};
    printf("%s (vmstat -m) %".$maxMname."s memory-use changed by %d Kbytes (%d Kb since start)\n",
           $nowstr, $name, $delta, $since) if ($delta > 0 && $since > 0);
  }

  $lastW = $curW; $lastM = $curM; $lastZ = $curZ;
}

my $deltaW = $lastW - $initW;
printf("Stopped due to %s. Total wired change: %5d pages\n",
       (($runloop) ? 'reaching configured wired page count' : 'signal'),
       $deltaW);

my %Zsort = ();
foreach my $name (keys %$lastZ) {
  my $since =  $lastZ->{$name}->{'used'} - $initZ->{$name}->{'used'};
  $Zsort{$name} = $since + 0 if ($since !=0);
}
foreach my $name (sort {$Zsort{$b} <=> $Zsort{$a}} keys %Zsort) {
  printf("(vmstat -z) %".$maxZname."s grew %d units of whatever the 'used' field is in inside that time period\n",
         $name, $Zsort{$name});
}
my %Msort = ();
foreach my $name (keys %$lastM) {
  my $since =  $lastM->{$name}->{'memory-use'} - $initM->{$name}->{'memory-use'};
  $Msort{$name} = $since + 0 if ($since !=0);
}
foreach my $name (sort {$Msort{$b} <=> $Msort{$a}} keys %Msort) {
  printf("(vmstat -m) %".$maxZname."s grew by %d Kbytes in that time period)\n",
         $name, $Msort{$name});

}