Dear Monks,

I have a program that's meant to stress the BerkeleyDB::Hash module to see how well it can perform with multiple, concurrent readers/writers. I am new to Perl _and_ BerkeleyDB, so go easy on me ;-)

Running the program below mostly yields the following errors:

db_put failed: DB_RUNRECOVERY: Fatal error, run database recovery ( / 
+Successful return: 0)
    main::spawn_child('BerkeleyDB::Env=ARRAY(0x82e5248)','BerkeleyDB::
+Hash=ARRAY(0x80639b4)') called at douji.pl line 115
    main::spawn_child('BerkeleyDB::Env=ARRAY(0x82e5248)','BerkeleyDB::
+Hash=ARRAY(0x80639b4)') called at douji.pl line 115
[download]

One instance of the above for each child process. Sometimes I get some errors like this, too:

db_put failed: Cannot allocate memory (Cannot allocate memory / reallo
+c: Cannot allocate memory: 4294967190)
        main::spawn_child('BerkeleyDB::Env=ARRAY(0x82e5248)','Berkeley
+DB::Hash=ARRAY(0x80639b4)') called at douji.pl line 115
[download]

Running db_recover does not allow it to then finish correctly the next time, however.

Does anyone have any ideas what I'm doing wrong? I was under the impression that using DB_INIT_CDB was enough to protect against concurrent writes, but do I need transactions instead? I tried using BerkeleyDB's transaction stuff earlier and that failed with the same error messages.

TIA :)

P.S. I am using BerkeleyDB CPAN module version 0.28 on RedHat 9 using the db4 4.0.14 packages.

#!/usr/bin/env perl
# vim:set ts=4 sw=4 ai:
use strict;
use warnings;
use Carp;
use POSIX ":sys_wait_h";
use Data::Dumper;

use lib '/junk/lib';
use BerkeleyDB;
use BerkeleyDB::Hash;
use Time::HiRes qw(gettimeofday tv_interval);

use constant RUNS         => 1000000;
use constant DBPATH       => '/junk/test.db';
use constant NUM_CHILDREN => 10;

$|++;

# print backtrace info
sub bt { croak "DIED ($.)\n"; }

# generate random integer
sub rand_num { 4278190080 + int(rand(1048576)); }

# read an entry from a BDB
sub read_db {
    my ($db, $key) = @_;

    my $val;
    $db->db_get($key, $val);
    return (defined($val)) ? eval($val) : {};
}   

# increment an entry in a BDB, inserting if not there
sub write_db {
    my ($db, $key, $stuff) = @_;

    my $val = read_db($db, $key);
    $val->{timestamp} = time;
    $val->{events}++;
    $val->{stuff}++ if ($stuff);

    my $str = Dumper(\$val) or croak "failed to serialize row data: $!
+\n";
    return $db->db_put($key, $str);
}

# fork off a worker process that will mutate the BDB independently of
# the others
sub spawn_child {
    my ($env, $db) = @_;

    my $pid = fork;
    croak "Could not fork: '$!'\n" unless (defined($pid));
    return unless ($pid == 0);

    # child process starts here
    my ($start, $finish, $key, $ip, $rv, $val, $reads, $writes, $delet
+es);
    print "Staring worker $$...\n";

    # perform a number of operations using BDB transactions
    $start = [ gettimeofday ];
    for (1..RUNS) {
        $key = int(rand(101));
        $ip = rand_num();
        if ($key <= 49) {
            # do random update/insert
            $rv = write_db($db, $ip, ($key % 2 == 0));
            croak "db_put failed: $rv ($! / $BerkeleyDB::Error)\n"
                unless ($rv == 0);
            $reads++; $writes++;
        } elsif ($key <= 98) {
            # do random read
            read_db($db, $ip); $reads++;
        } else {
            # do random delete
            $db->db_del($key); $deletes++;
        }
    }
    $finish = [ gettimeofday ];

    # print summary info for timing
    my $sum = ($reads || 0) + ($writes || 0) + ($deletes || 0);
    my $elapsed = tv_interval($start, $finish);
    printf "$$: %d reads, %d writes, %d deletes (%d total) in %0.2f se
+conds: %0.2f ops/sec\n",
        ($reads || 0),
        ($writes || 0),
        ($deletes || 0),
        $sum,
        $elapsed,
        $sum / $elapsed;
    exit 0;
}

# install signal handlers
$SIG{__WARN__} = \&bt;

# create BDB environment so we can enable transactions
my $env = new BerkeleyDB::Env(
            -Cachesize => 4 * 1024 * 1024,
            -Flags     => (DB_CREATE()    |
                           DB_INIT_CDB()  |
                           DB_INIT_MPOOL()),
            -SetFlags  => DB_CDB_ALLDB())
    or croak "Failed to create DB env: '$!' ($BerkeleyDB::Error)\n";

# open database
my $db = new BerkeleyDB::Hash(
            -Filename => DBPATH,
            -Env      => $env,
            -Flags    => DB_CREATE())
    or croak "Failed to open DBPATH: '$!' ($BerkeleyDB::Error)\n";

# spawn concurrent DB mutators and just wait for them to finish
for (1..NUM_CHILDREN) { spawn_child($env, $db); }
for (1..NUM_CHILDREN) { my $pid = wait; }
[download]