#!/usr/bin/perl -w
#################################################
# AddressBook2 cgi script.
#    html interface:   HTML::Template
#    database      :   MLDBM tied multi-level database hash
#
# This one seperates the HTML code from the programming logic.
#
#  Database structure is the same as in AddressBook1
#
########################################################
our %database;  
openDatabase();

# Here we only use CGI.pm for processing the forms
# And outputting the httpd header.
use CGI;
use CGI::Carp qw(fatalsToBrowser);
my $cgi = new CGI;
print $cgi->header();

# Process form
my $formMessage = processFormSubmission($cgi);

use HTML::Template;
my $template = HTML::Template->new( filename => 'addressTemplate.html' );

# Set up the parameters we want to use in the template.
my $users = $database{_users};
# This array of hashes defines what's being looped over in the template.
my $userloop = [ 
                map { 
                        {  user         => $_ , 
                           fullname     => $database{$_}{fullname},
                                email   => $database{$_}{email},
                        }       
                    }  @$users ];

# Define the template variables.
$template->param( userloop    => $userloop );
$template->param( formMessage => $formMessage );

# Print out the webpage.
print $template->output();

closeDatabase();
exit;

# ---------------------------------------------
# misc subroutines

# If the user submits the form, then change the database.
sub processFormSubmission {
  my ($redstart,$redend) = ("<p><font color='red'>", "</font><p>\n");
  my ($cgi) = @_;
  my ($adduser, $user, $fullname, $email) 
    = map {$cgi->param($_) || ''} qw( adduser user fullname email );

  if ( $adduser ) {
    unless ( $user and $fullname and $email) {
      return $redstart . "OOPS - to add someone to the database, " .
        "you must supply a value for each of the fields." . $redend;
    }
    my $users = $database{_users};      # read list of users from the file
    push @$users, $user;
    $database{_users} = $users; # write list of users to the file and
                                        # write new user's data to the file.
    $database{$user} = { fullname => $fullname, email => $email };
  }
  return '' unless $user;
  return $redstart . 
         "OK, the user '$user' has been added to the databse." . $redend;
}

# ---------------------------------------------
# Database routines.

# Open the global %database as an MLDBM tied hash, i.e. a "disk file" hash.
#   *  I'm using the recipe in "CGI Programming in Perl" and flock() for
#     locking the tied hash.  Also, for simplicity I'm simply asking
#     for a write lock whether I need it on this call or not.
#   *  Do make sure that the permissions on $datafile allow the httpd deamon
#     to modify it.  The "0660" sets the permissions to rw for user/group
#     if the file is created with this call - and that can only happen
#     if the directory allows the httpd deamon to create a file.
#     I've found it's usually easier to run the script from the command
#     line the first time, which will create the database, and then set
#     its permissions by hand, with chmod.
#   *  This hash may be a deep data structure.  However, to write to 
#     the disk you must assign to the *top* level part of the hash.
#     Thus $database{this}{that} = 2; won't change the disk file,
#     but $tmp=$database{this};$tmp->{that}=2;$database{this}=$tmp will.
sub openDatabase {
  my $datafile = 'AddressData.db';
  use MLDBM qw (DB_File Storable );
  use Fcntl qw( :DEFAULT :flock );
  my $db = tie(%database, 'MLDBM', $datafile, O_RDWR|O_CREAT, 0666)
     or die " Error - unable to connect to $datafile : $!";
  my $fd = $db->fd;
  open DBM, "+<&=$fd" or die "Could not dup DBM for lock: $!";
  flock DBM, LOCK_EX;
  undef $db;
}

sub closeDatabase {
  untie %database;
}