Description: |
There were problems with an Oracle database writing data over NFS here. A script was needed to do some random read/write parallel activity and check where things were going wrong.
If you call this script as
./dbcreate.pl 15 8k 90 1m 100m test.txt
it will spawn 15 children, read/write random data in 8kb blocks, doing 90% of input and 10% of output; it will initialize the test file to 1Mb size, will read/write 100Mb of data; the test file will be test.txt
I hope you'll find it useful
--bronto |
#!/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] ;
}
|