#!/usr/bin/perl -w use lib qw(.. . lib ../lib); eval "use Sync"; print $@; use Fcntl; use Time::HiRes qw(time); use Carp qw(confess); use strict; use Getopt::Long; my $INSERTS = 25; my $PIDS = 4; my $BASE = $INSERTS * $PIDS; my $parent = $$; $SIG{__DIE__} = \&confess; srand(0); $MLDBM::UseDB = $MLDBM::UseDB; # supress warning use vars qw($opt_cache $opt_number $opt_bundle); &GetOptions('c' => \$opt_cache, 'n=i' => \$opt_number, 'bundle=i' => \$opt_bundle); if(! $opt_number or $opt_number < $BASE) { $opt_number = $BASE; } $opt_number = int( $opt_number / $BASE ) * $BASE; if($^O =~ /win32/i) { $PIDS = 1; } if($opt_number) { $opt_number /= $PIDS; } else { $opt_number = $INSERTS; } print "NUMBER OF PROCESSES IN TEST: $PIDS\n"; for my $SIZE (50, 500, 5000, 20000, 50000) { print "\n=== INSERT OF $SIZE BYTE RECORDS ===\n"; for my $DB ('SDBM_File', 'MLDBM::Sync::SDBM_File', 'GDBM_File', 'DB_File', 'Tie::TextDir .04') { eval "use $DB"; next if $@; if($DB eq 'SDBM_File' and $SIZE > 100) { print " (skipping test for SDBM_File 100 byte limit)\n"; next; }; if($DB eq 'MLDBM::Sync::SDBM_File' and ($SIZE * $opt_number * $PIDS) > (1 * 1024 * 1024)) { print " (skipping test for MLDBM::Sync db size > 1M)\n"; next; } my $real_db = $DB; $real_db =~ s/\s+\.\d+$//isg; local $MLDBM::UseDB = $real_db; my $file_suffix = $real_db; $file_suffix =~ s/\W/_/isg; my %mldbm; my $sync = tie(%mldbm, 'MLDBM::Sync', "MLDBM_SYNC_BENCH_".$file_suffix, O_CREAT|O_RDWR, 0666) || die("can't tie to /tmp/bench_mldbm: $!"); if($opt_cache) { $sync->SyncCacheSize('1000K'); } %mldbm = (); my $time = time; if($PIDS > 1) { # 4 processes in all fork; fork; } my $bundle = 0; for(0..($opt_number-1)) { my $rand; for(1..($SIZE/10)) { $rand .= ''.rand().rand(); last if length($rand) > $SIZE; } $rand = substr($rand, 0, $SIZE); my $key = "$$.$_"; # add lock & unlock to increase performance # $sync->Lock; if($opt_bundle && ( ! ($_ % $opt_bundle ))) { # print "LOCK $$ $_\n"; $bundle++; $sync->UnLock; $sync->Lock; } $mldbm{$key} = $rand; ($mldbm{$key} eq $rand) || warn("can't fetch written value for $key => $mldbm{$key} === $rand"); # $sync->UnLock; } $opt_bundle && $sync->UnLock; if($^O !~ /win32/i) { while(wait != -1) {} } if($$ == $parent) { my $total_time = time() - $time; my $num_keys = scalar(keys %mldbm); ($num_keys % $INSERTS) && warn("error, $num_keys should be a multiple of $INSERTS"); my $bundles_print = $bundle ? "locks/pid=$bundle" : ''; printf " Time for $num_keys writes + $num_keys reads for %-24s %6.2f seconds %8d bytes $bundles_print\n", $DB, $total_time, $sync->SyncSize; } else { exit; } %mldbm = (); } }