Illustrating Persistent Hashes
#!/usr/bin/perl -w
use DB_File;             #  Module which allows persistent hashes!
use Fcntl qw(:flock);    #  Module to lock files!
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);

print header(), start_html("Logbook"), start_form;

$options = (-e "folks") ? (O_RDWR) : (O_CREAT | O_RDWR);

$db = tie(%logbook, 'DB_File', "folks", $options, 0766)
  or die "Cannot tie folks file: $!\n";

$fd = $db->fd;    #  Needed to create file handle for lock!
open(DB, "+<&=$fd") or die "Cannot open duplicate file: $!\n";

print p("Name: "),
      textfield(-name => "name", -size => 50, -override => 1),
      p("Email Address: "),
      textfield(-name => "email", -size => 80, -override => 1),
      reset(-name => "Reset"),
      submit(-name => "Submit"),
      submit(-name => "List All"),
      submit(-name => "Delete"),
      submit(-name => "Look Up");

if (param("Submit"))
{
    $name  = param("name");
    $email = param("email");
    $name =~ s/^\s*(.*?)\s*$/$1/;
    $name =~ s/\s+/ /g;
    $name = uc($name);
    flock(DB, LOCK_EX | LOCK_NB) || die "Cannot write lock folks file:$!\n";
    $logbook{$name} = "$email";   #  Implicit write!!
    $db->sync;   #  Must flush buffers when using lock on dup'ed file.
    flock(DB, LOCK_UN);
}
elsif (param("List All"))
{
     flock(DB, LOCK_SH | LOCK_NB) || die "Cannot read lock folks file!\n";
     foreach $name (sort keys %logbook)
     {
         print p("$name $logbook{$name}");
     }
     flock(DB, LOCK_UN);
} 
elsif (param("Delete"))
{
      print p("Delete Name (first last) :"),
            textfield(-name => "Delete2", -size => 50, -override => 1),
            submit(-name => "Delete It!");
}
elsif (param("Look Up"))
{
      print p("Lookup Name (first last) :"),
            textfield(-name => "lookup", -size => 50),
            submit(-name => "Find It!");
}
elsif (param("Delete It!"))
{
    $name = param("Delete2");
    $name =~ s/^\s*(.*?)\s*$/$1/;
    $name =~ s/\s+/ /g;
    $name = uc($name);
    flock(DB, LOCK_EX | LOCK_NB) || die "Cannot write lock folks file:$!\n";
    delete($logbook{$name}));
    $db->sync;
    flock(DB, LOCK_UN);
}    
elsif (param("Find It!"))
{
    $name = param("lookup");
    $name =~ s/^\s*(.*?)\s*$/$1/;
    $name =~ s/\s+/ /g;
    $name = uc($name);
     
    flock(DB, LOCK_SH | LOCK_NB) || die "Cannot read lock folks file!\n";
    if ($logbook{$name}){print p($logbook{$name})}
    else {print p("No such person!!!")}
    flock(DB, LOCK_UN);
}

print end_form, end_html;