#!/usr/local/bin/perl

use strict;
use warnings;
use POSIX;
use Test::More tests => 3;


#---------------------------
# behavioral parameters and globals


use constant DEBUG              => 0;


use constant FILE_NAME          => '/tmp/perl_append_test';
use constant CHILD_REPORT_POINT => 100;
use constant LOG_FORMAT         => "[%6d] %6d %6d\n";


# try changing this to zero to see line size discrepansies
use constant FLUSH_BUFFER => 1;


my $NUM_CHILDREN = shift || 801;
my $NUM_LINES    = shift || 511;
my $MAX_CHILDREN = shift || 100;
my %kids;
my $child_count = 0;

#---------------------------
$|++;

unlink FILE_NAME;

print "# children: $NUM_CHILDREN\n" if DEBUG;
print "# lines:    $NUM_LINES\n\n" if DEBUG;

print "# spawning ... \n" if DEBUG;
print "# parent pid: $$\n" if DEBUG;

spawn_kids();

clean_up_after_kids();


#---------------------------
# make a report
#---------------------------

my $expected_line_length = length( sprintf( LOG_FORMAT, 0, 0, 0 ) );

print "\n# counting money ...\n\n" if DEBUG;
my ($lines, $bytes);
my $discrepansies = 0;

open my $log, '<', FILE_NAME
  or die "$$ couldn't open log: $!";

while ( <$log> ) {
  $lines++;
  $bytes += my $l = length;
  $discrepansies++ if $l != $expected_line_length;
}

close $log;

is( $lines, $NUM_CHILDREN * $NUM_LINES,
    'number of lines in log matches expectation' );
is( $bytes, $NUM_CHILDREN * $NUM_LINES * $expected_line_length,
    'bytes in logfile matches expectation' );
is( $discrepansies, 0, 'no line size discrepansies' );

if ( DEBUG ) {
  print "\n";
  print "# lines: $lines\n";
  print "# bytes: $bytes\n";
  print "# discrepansies: $discrepansies\n";
  print "\n";
}

exit;

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

sub spawn_kids {
  for my $child_num ( 1..$NUM_CHILDREN ) {
    ++$child_count;

    print "\r# concurrent children: $child_count        " if DEBUG;
    print "\n# child count: $child_num\n"
      if !($child_num % CHILD_REPORT_POINT) && DEBUG;

    reap_some();
    while ( $child_count >= $MAX_CHILDREN ) {
      reap_some();
      sleep 1
    }

    my $p = fork();
    die "couldn't fork: $!" unless defined $p;
    if ( $p ) {
      $kids{ $p }++;
    }
    else {
      # I'm the child
      append_like_hell( $child_num );
      exit;
    }
  }
  print "\n" if DEBUG;
}
sub clean_up_after_kids {
  print "# reaping ... \n" if DEBUG;

  while ( keys %kids ) {
    reap_some();
    print "\r# concurrent children: $child_count        " if DEBUG;
    sleep 1;
  }
  print "\n" if DEBUG;
}


#---------------------------
# find dead kids
#---------------------------
sub reap_some {
  while(( my $pid = waitpid(-1, POSIX::WNOHANG)) > 0) {
    --$child_count;
    delete $kids{ $pid };
  }
}


#---------------------------
# this is what the kids do
#---------------------------
sub append_like_hell {
  my $id = shift;
  open my $log, '>>', FILE_NAME
    or die "[$id] $$ couldn't open log: $!";

  select( ( select( $log ), $|++ )[0] ) if FLUSH_BUFFER;

  for ( 1..$NUM_LINES ) {
    print $log sprintf(LOG_FORMAT, $id, $$, $_)
      or die "[$id] $$ couldn't print line $_: $!";
  }
  close $log or die "[$id] $$ couldn't close log: $!";
}