#!/usr/bin/perl

# $Id: dbcreate.pl,v 1.4 2003/11/26 11:37:02 bronto Exp $

use strict ;
use warnings ;

use Tie::File ;

die "\nUsage: $0 NProc OutputBlockSize InputPerc InitSize OutputSize DBFile\n\n"
  unless @ARGV == 6 ;

use constant DEBUG => 1 ;
my %suffix = ( K => 1024, M => 1024*1024, G => 1024*1024*1024 ) ;

my $maxchild = shift ;
die "Invalid number of processes" unless $maxchild >= 1 ;

my $outblocksize = shift ;
convert_to_bytes($outblocksize) ;
die "Output block size should be > 0" unless $outblocksize >= 1 ;

my $inperc = shift ;
die "Input percentage too big"   if $inperc >  100 ;
die "Input percentage too small" if $inperc <=   0 ;

my $initsize = shift ;
convert_to_bytes($initsize) ;
die "Initial file size should be > 0" unless $initsize >= 1 ;

my $outsize = shift ;
convert_to_bytes($outsize) ;
die "Output size should be > 0" unless $outsize >= 1 ;

my @db ;
my $dbfile = shift ;
my $initlines  = sprintf "%.0f",($initsize/$outblocksize) ;
my $cachelines = $initlines*(100-$inperc)/100 ;
$cachelines = 100 if $cachelines > 100 ;
my $c1 = $cachelines -1 ;

tie @db, 'Tie::File', $dbfile or die "Cannot open file $dbfile: $!" ;
my @cache ;

{
  my @randomchars = ('A'..'Z','a'..'z','0'..'9') ;
  my $randindex   = scalar @randomchars ;
  my $lines = $initlines ;
  my $l1    = $lines - 1 ;

  sub input {
    my $i = rand($l1) ;
    my $r = $db[$i] ;
    $cache[rand($c1)] = $r ;
    return "r" ;
  }

  sub output {
    my $i = sprintf "%.0f",rand($lines) ;
    $db[$i] = $cache[rand($c1)] ;
    if ($i > $lines) {
      $lines = $i ;
      $l1    = $i - 1 ;
    }
    return "w" ;
  }

  sub random_record {
    return join("",
		@randomchars[
			     map(
				 rand($randindex),
				 (1..$outblocksize))
			    ]
	       ) ;
  }
}

print STDERR "Initializing file and cache..." ;
@db = () ;
for (my $i = 1 ; $i<= $initlines ; $i++) {
  my $r = random_record($outsize) ;
  push @db,$r or
    die "Cannot write record, aborting [$!]" ;
  push @cache,$r if $#cache <= $c1 ;
}

print STDERR "done\n" ;

my $chunks         = $outsize/$outblocksize ;
my $chunksperchild = $chunks/$maxchild ;

my %childpid ;
while (keys(%childpid) < $maxchild) {

  my $pid = fork ;

  # The following instruction comes from node 237098
  die "Cannot fork: $!" unless defined $pid ;

  if ($pid) {
    # Parent process
    $childpid{$pid} = '' ;
  } else {
    # Child process
    for (my $i = 0 ; $i <= $chunksperchild ; $i++) {
      my $random ;
      $random = rand(100) ;

      my $result = $random <= $inperc? input(): output() ;
      print STDERR "$result" if DEBUG ;
      #print STDERR "$random/$inperc: $result\n" ;
    }
    exit ;
  }
}

while (keys(%childpid) > 0) {
  my $dead = wait ;

  # This die added after merlyn's suggestion
  # If you want to check a waitpid solution, see the code
  # posted by merlyn and zentara
  die "Something weird happened while wait!" if $dead == -1 ;

  delete $childpid{$dead} ;
}  ;

print STDERR "\n" if DEBUG ;
exit 0 ;

sub convert_to_bytes {
  if ($_[0] =~ /^\d+(k|m|g)$/i) {
    my $factor = chop $_[0] ;
    $_[0] *= $suffix{uc($factor)} ;
  }
  return $_[0] ;
}