#!/usr/bin/perl -w

use Sys::Mmap;
use Benchmark ':hireswallclock';
use Time::HiRes qw(gettimeofday tv_interval);
use strict;

my @cpids;

my $forkstep = 500;
my $killcnt = 200;
my $mmapsize = 100;

#fork + kill tests
print "No mmaped file\n\n";
allforktests();
print "\n";

#fork +kill tests with mmaped file
print "Creating and mmaping ${mmapsize}M file\n\n";

if (!-s("/tmp/mmaptest") == $mmapsize*1048576) {
  system("/bin/dd if=/dev/zero of=/tmp/mmaptest bs=1048576 count=${mmapsize}");
}
open(my $fh, "+</tmp/mmaptest")
  || die "Could not open map file: $!";
mmap(my $mmap, $mmapsize*1048576, PROT_READ|PROT_WRITE, MAP_SHARED, $fh)
  || die "Could not map file: $!";
# read entire file into memory
for (0 .. $mmapsize-1) { my $a = substr($mmap, $_*1048576, 1048576); }

allforktests();
munmap($mmap);
print "\n";

#modify mmaped file tests
mmap($mmap, $mmapsize*1048576, PROT_READ|PROT_WRITE, MAP_SHARED, $fh)
  || die "Could not map file: $!";
# read entire file into memory
for (0 .. $mmapsize-1) { my $a = substr($mmap, $_*1048576, 1048576); }

print "Modifying random points in ${mmapsize}M mmaped file with 0 children\n\n";
modifyfiletests();
print "\n";

print "Modifying random points in ${mmapsize}M mmaped file with 4000 children\n\n";
forkchildren(4000);
modifyfiletests();
killchildren();

munmap($mmap);

sub modifyfiletests {

  for (my $i = 100; $i < 500; $i += 100) {
    print "Modify $i points\n";
    timethis(500, sub {
      for (1 .. $i) {
        my $pos = int rand($mmapsize*1048576-256);
        substr($mmap, $pos, 256) = chr(ord('a') + rand(26)) x 256;
      }
    });
    sleep(1);
  }

}

sub allforktests {

  # test forking 1 process
  for (1 .. 6) {
    my $nchild = scalar(@cpids);
    print "Time to fork + immediately reap 1 child, $nchild other children\n";
    timefork();
    forkchildren($forkstep);
  }

  killchildren();
  print "\n";

  for (1 .. 5) {
    forkchildren($forkstep);
    my $nchild = scalar(@cpids);
    print "Time to kill + reap $killcnt child processes, $nchild other children\n";
    timekill($killcnt);
  }

  killchildren();
}

sub timefork {

  timethis(500, sub {
    if (my $pid = fork()) {
      # in parent, wait for child
      waitpid($pid, 0);

    } else {
      # in child, exit immediately
      exit(0);
    }
  });

}

sub timekill {
  my $nkill = shift;

  timethis($nkill, sub {
    my $pid = splice(@cpids, rand(@cpids), 1);
    kill 3, $pid;
    waitpid($pid, 0);
  });

  # refork
  forkchildren($nkill);
}

sub forkchildren {
  my $nchild = shift;

  for (1 .. $nchild) {
    if (my $pid = fork()) {
      push @cpids, $pid;
    } else {
      # in child, just slow wait for signal
      $SIG{QUIT} = sub { die; };
      eval { sleep(5) while 1; };
      exit(0);
    }
  }
  sleep(1);

}

sub killchildren {

  my $nchild = scalar(@cpids);
  print "Killing $nchild children\n";

  timethis(1, sub {
    while (my $pid = shift @cpids) {
      kill 3, $pid;
      waitpid($pid, 0);
    }
  });
  sleep(1);
}