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