#!/usr/bin/perl -w
#################################################
# AddressBook4 cgi script.
#    html interface:   HTML::Template
#    database      :   DBI and DBD::CSV  ,  simple SQL
#
########################################################

use DBI;
my $dbase	= "addresses";
my $table	= "userdata";
my $dbistring   = "dbi:CSV:f_dir=$dbase;csv_eol=\n";
my ($user,$password) = ('','');
my $dbi		= DBI->connect($dbistring,$user,$password)
  or die "Oops - couldn't connect to '$dbistring' \n";

# 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, $dbi);

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

my $query = "SELECT * FROM $table";
my $sth = $dbi->prepare($query);
$sth->execute();

# This array of hashes defines what's being looped over in the template.
my $userloop = [];

while (my $row = $sth->fetchrow_arrayref) {
  push @$userloop, { user	=> $row->[0], 
		     fullname	=> $row->[1],
		     email	=> $row->[2],
		   };
}

# 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 ($cgi,$dbi) = @_;
  my ($redstart,$redend) = ("<p><font color='red'>", "</font><p>\n");
  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;
    }

    # insert this new record into the table
    my $query = "INSERT INTO $table VALUES (?,?,?)";
    my $sth = $dbi->prepare($query);
    $sth->execute( $user, $fullname, $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;
}