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";

