#!/usr/bin/perl

# $Id: dbcreate.pl,v 1.3 2003/11/19 12:12:53 bronto Exp $

use strict ;
use warnings ;

use Tie::File ;

die "\nUsage: $0 NProc OutputBlockSize InputPerc InitSize OutputSize D
+BFile\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) ;

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

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

  sub input {
    my $i = rand($lines - 1) ;
    my $x = $db[$i] ;
    return "r" ;
  }

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

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

print STDERR "Initializing file..." ;
@db = () ;
for (my $i = 1 ; $i<= $initlines ; $i++) {
  push @db,random_record($outsize) or
    die "Cannot write record, aborting [$!]" ;
}
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] ;
}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.