use DB_File;

# brackets in following code indicate optional arguments
[$X =] tie %hash,  "DB_File", $filename [, $flags, $mode, $DB_HASH];
[$X =] tie %hash,  "DB_File", $filename, $flags, $mode, $DB_BTREE;
[$X =] tie @array, "DB_File", $filename, $flags, $mode, $DB_RECNO;

$status = $X->del($key [, $flags]);
$status = $X->put($key, $value [, $flags]);
$status = $X->get($key, $value [, $flags]);
$status = $X->seq($key, $value [, $flags]);
$status = $X->sync([$flags]);
$status = $X->fd;

untie %hash;
untie @array;
*****
DB *
dbopen (const char *file, int flags, int mode,
        DBTYPE type, const void *openinfo)
*****
tie %array, "DB_File", $filename, $flags, $mode, $DB_HASH;
*****
$DB_HASH->{cachesize} = 10_000;
*****
use strict;
use Fcntl;
use DB_File;

my ($k, $v, %hash);

tie(%hash, 'DB_File', undef, O_RDWR|O_CREAT, 0, $DB_BTREE)
    or die "can't tie DB_File: $!":

foreach $k (keys %ENV) {
    $hash{$k} = $ENV{$k};
}

# this will now come out in sorted lexical order 
# without the overhead of sorting the keys
while  (($k,$v) = each %hash) {
    print "$k=$v\n";
}
*****
$db = tie %hash, "DB_File", "filename";
*****
$db->put($key, $value, R_NOOVERWRITE);  # invoke the DB "put" function
*****
use DB_File;
use Fcntl;

tie %h,  "DB_File", "hashed", O_RDWR|O_CREAT, 0644, $DB_HASH;

# Add a key/value pair to the file
$h{apple} = "orange";

# Check for value of a key
print "No, we have some bananas.\n" if $h{banana};

# Delete
delete $h{"apple"};
untie %h;
*****
use DB_File;
use Fcntl;

sub Compare {
    my ($key1, $key2) = @_;
    "\L$key1" cmp "\L$key2";
}

$DB_BTREE->{compare} = 'Compare';
tie %h,  'DB_File', "tree", O_RDWR|O_CREAT, 0644, $DB_BTREE;

# Add a key/value pair to the file
$h{Wall}  = 'Larry';
$h{Smith} = 'John';
$h{mouse} = 'mickey';
$h{duck}  = 'donald';

# Delete
delete $h{duck};

# Cycle through the keys printing them in order.
# Note it is not necessary to sort the keys as
# the btree will have kept them in order automatically.
while ($key = each %h) { print "$key\n" }

untie %h;
*****
my(@line, $number);
$number = 10;
use Fcntl;
use DB_File;
tie(@line, "DB_File", "/tmp/text", O_RDWR|O_CREAT, 0644, $DB_RECNO)
    or die "can't tie file: $!";
$line[$number - 1] = "this is a new line $number";
*****
use Fcntl;
use DB_File;
tie(@file, 'DB_File', "/tmp/sample", O_RDWR, 0644, $DB_RECNO)
    or die "can't update /tmp/sample: $!";
print "line #3 was ", $file[2], "\n";
$file[2] = `date`;
untie @file;
*****
use DB_File;
use Fcntl;
$H = tie(@h, "DB_File", $file, O_RDWR, 0640, $DB_RECNO)
        or die "Cannot open file $file: $!\n";
# print the records in reverse order
for ($i = $H->length - 1; $i >= 0; --$i) { 
    print "$i: $h[$i]\n";
}
untie @h;
*****
use Fcntl;
use DB_File;

use strict;

sub LOCK_SH { 1 }
sub LOCK_EX { 2 }
sub LOCK_NB { 4 }
sub LOCK_UN { 8 }

my($oldval, $fd, $db_obj, %db_hash, $value, $key);

$key   = shift || 'default';
$value = shift || 'magic';

$value .= " $$";

$db_obj = tie(%db_hash, 'DB_File', '/tmp/foo.db', O_CREAT|O_RDWR, 0644)
                    or die "dbcreat /tmp/foo.db $!";
$fd = $db_obj->fd;
print "$$: db fd is $fd\n";
open(DB_FH, "+<&=$fd") or die "dup $!";

unless (flock (DB_FH, LOCK_SH | LOCK_NB)) {
    print "$$: CONTENTION; can't read during write update!
                Waiting for read lock ($!) ....";
    unless (flock (DB_FH, LOCK_SH)) { die "flock: $!" }
}
print "$$: Read lock granted\n";

$oldval = $db_hash{$key};
print "$$: Old value was $oldval\n";
flock(DB_FH, LOCK_UN);

unless (flock (DB_FH, LOCK_EX | LOCK_NB)) {
    print "$$: CONTENTION; must have exclusive lock!
                Waiting for write lock ($!) ....";
    unless (flock (DB_FH, LOCK_EX)) { die "flock: $!" }
}

print "$$: Write lock granted\n";
$db_hash{$key} = $value;
sleep 10;

$db_obj->sync();                # to flush
flock(DB_FH, LOCK_UN);
untie %db_hash;
close(DB_FH);
print "$$: Updated db to $key=$value\n";
