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;