#!/usr/bin/perl -w
###############################################################################
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
#
#    a) the GNU General Public License as published by the Free
#    Software Foundation; either version 1, or (at your option) any
#    later version, or
#
#    b) the "Artistic License" (Read the README file that comes with
#    the standard Perl Distribution)
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
#    the GNU General Public License or the Artistic License for more details.
###############################################################################
#           Author: Jay Flaherty <fty@utk.edu> 
#                   (Small modifications by Mike Miller <mke@paginate.com>)
#            Title: contactME
#          Version: 1.0
#             Date: Fri Jul 17 08:45:11 EDT 1998
#          Version: 1.1
#             Date: Fri Mar 17 17:13:31 CST 2000
#
#          Purpose: Simple Contact Database Script using DBI and CGI modules. 
#                   Based on the PHP script written by   
#                   Michael J Miller Jr. <mke@paginate.com>
# Required Modules: CGI, DBI, DBD::mysql, HTML::Table
###############################################################################
#  Schema follows...
#  mysqladmin -uroot -p create ContactDB
#  mysql -uroot -p ContactDB <schema
#
#CREATE TABLE contact (
#  uid SMALLINT NOT NULL AUTO_INCREMENT,
#  first_name CHAR(20),
#  middle_initial CHAR(1),
#  last_name CHAR(30),
#  phone VARchar(30),
#  fax VARchar(30),
#  email VARchar(70),
#  PRIMARY KEY(uid),
#  KEY(last_name,first_name),
#  KEY(phone)
#);
#
#CREATE TABLE comment (
#  uid SMALLINT NOT NULL,
#  contact_date DATETIME NOT NULL,
#  contact_comment CHAR(80),
#  KEY(uid),
#  KEY(contact_date),
#  KEY(contact_comment)
#);                                     


use strict;
use DBI;
use CGI qw(fatalsToBrowser); # send fatal error messages to the browser
use HTML::Table;
my $q = new CGI; # create new CGI object and store it in $q
my $script = $q->script_name;

# you need to define these to correspond to your database

my $database = "ContactDB";
my $user = undef;
my $password = undef;

# connect to the ContactDB

my $dbh = db_connect($database,$user,$password); 

# Print the standard Content-type: text/html\n\n line

print $q->header;

# If path information is provided we generate the form/response html page,
# else we genrate the side by side frameset

my $path_info = $q->path_info();
$path_info =~ s!^/!!; # remove leading "/"
if (!$path_info) {
   print_frameset();
   exit;
}

# This is a case statement (SWITCH:) that will direct you to the correct 
# subroutine based on the value of $path_info, which is just the path 
# information passed by the "action" tag when you create a form.

SWITCH: {
   if ($path_info eq 'form')          { print_form(); last SWITCH }
   if ($path_info eq 'response')      { print_response(); last SWITCH }   
   if ($path_info eq 'update')        { update(); last SWITCH }
   if ($path_info eq 'print_contact') { print_contact(); last SWITCH }
   if ($path_info eq 'commit_update') { commit_update(); last SWITCH }
   if ($path_info eq 'commit_insert') { commit_insert(); last SWITCH }
   if ($path_info eq 'add_comment')   { add_comment(); last SWITCH }
}
# These 3 statements print the </BODY></HTML> tags, disconnects from
# the database and exits the program.

print $q->end_html;   
$dbh->disconnect;
exit;

####################### END MAIN PROGRAM ################################
#                                                                       #
####################### BEGIN SUBROUTINES ###############################

# This subroutine prints the frameset tags and calls the form and
# response subroutines by passing the appropriate path information

sub print_frameset {
   my $script = $q->script_name;
   print $q->title('Contact Database'),
   $q->frameset({-cols=>'30%,*'},
      $q->frame({-name=>'form', -src=>"$script/form"}),    
      $q->frame({-name=>'response', -src=>"$script/response"})
   ); 
}

# This subroutine prints the <HTML><HEAD><TITLE>... stuff

sub print_html {
   my $title = shift;
   print $q->start_html(
      -title=>$title,
      -author=>'Jay Flaherty <fty@utk.edu',
      -base=>'true',
      -meta=>{'copyright'=>'1998, Jay Flaherty'},
      -bgcolor=>'white');      
}
# This subroutine prints the main form that appears in the left frame

sub print_form {
   my $script = $q->script_name;
   print_html("Contact Database");
   print 
   $q->h2("Contact Database"),
   $q->hr,
   $q->start_form(-action=>"$script/response",
                  -target=>'response'),
   $q->radio_group(-name=>'function',
                   -"value"=>['List','Create'],
                   -default=>'List',
                   -labels=>{'List'=>'List Contacts',
                             'Create'=>'Create a new Contact'},
                   -columns=>1),
   $q->br,
   $q->submit(-name=>'Make Contact',
              -value=>'Make Contact'),
   $q->endform;
}

# This functions gets the parameters from the main form (left frame) and
# calls the appropriate subroutine based on its value. The parameters
# come from the radio group button (function) above.

sub print_response {
   unless($q->param) {
      print_html('Contact Database');   
      print $q->b("No query submitted yet.");
      return;
   }
   my $script   = $q->script_name;
   my $function = $q->param('function');
   display() if $function eq 'List';
   update()  if $function eq 'Create';   
}

# This function is called if the radio group button's value is "List".
# It displays a list of contacts with links to thier full record.

sub display {
   print_html('List Contacts');   
   my $script = $q->script_name;
   my $table  = new HTML::Table();
   $table->setBorder(10);                  
   $table->setCellPadding(2);
   my $statement = qq(SELECT last_name AS "Last Name",
                      first_name AS "First Name",
                      phone AS "Work Phone",
                      uid AS "UID"
                      FROM contact
                      ORDER BY "Last Name");
   my $sth = $dbh->prepare($statement);
   $sth->execute or db_err("Unable to execute query", $dbh->errstr);
   my @fields = @{$sth->{NAME}};
   my @th = map {"<B>$_<B>"} @fields;
   print $q->center($q->h2('Contact List'));
   $table->addRow(@th);
   my @row;
   while(@row = $sth->fetchrow_array) {
      my $uid = $row[3];
      my $last_name = shift(@row);
      $last_name = qq(<A HREF=$script/print_contact?uid=$uid>$last_name</a>);
      unshift(@row, $last_name);
      $table->addRow(@row);
   }
   print "<CENTER>";
   $table->print;
   print "</CENTER>";
}

# This function displays the full contact information for the selected 
# record displayed by the display function above.

sub print_contact {
   print_html('Contact Information');   
   my $uid    = $q->param('uid');
   my $table1 = new HTML::Table();
   $table1->setBorder(10);                  
   $table1->setCellPadding(2);
   my $table2 = new HTML::Table();
   $table2->setBorder(10);                  
   $table2->setCellPadding(2);
   my $script = $q->script_name;
   my $statement = qq(SELECT uid AS "UID",
                      first_name AS "First Name",
                      middle_initial AS "MI",
                      last_name AS "Last Name",
                      phone AS "Work Phone",
                      fax AS "FAX",
                      email AS "Email" 
                      FROM contact WHERE uid = $uid);
   my $sth = $dbh->prepare($statement);
   $sth->execute or db_err("Unable to execute query", $dbh->errstr);
   my @row = $sth->fetchrow_array; 
   my @contact_fields = @{$sth->{NAME}};      
   my @contact_th = map {"<B>$_</B>"} @contact_fields;    
   my $name = "$row[1] $row[3]";
   print $q->center($q->h2("Contact Information for $name"));
     $table1->addCol(@contact_th);   
   $table1->addCol(@row);
   $table1->print;
   print $q->start_form(-action=>"$script/update",
                        -target=>'response');
   print $q->hidden(-name=>'uid',
                    -value=>$uid),
   $q->submit(-name=>'submit',
              -value=>'Update Contact Information');
   print $q->endform;
   $sth->finish;
   print $q->center($q->h2("Comment Information for $name"));
   $statement = qq(SELECT contact_date AS "Date Comment Submitted",
                   contact_comment AS "Comment"
                   FROM comment
                   WHERE uid = $uid);
   $sth = $dbh->prepare($statement);
   $sth->execute or db_err("Unable to execute query", $dbh->errstr);
   my @comment_fields = @{$sth->{NAME}};
   my @comment_th = map {"<B>$_</B>"} @comment_fields;
   $table2->addRow(@comment_th);
   while(@row = $sth->fetchrow_array) {
      $table2->addRow(@row);
   }
   $table2->print;
   print $q->p, "Add New Comment Below\n",
   $q->start_form(-action=>"$script/add_comment",
                  -target=>'response'),
   $q->hidden(-name=>'uid',
              -value=>$uid),
   "COMMENT: ", $q->textfield(-name=>'contact_comment',
                              -size=>60,
                              -maxlength=>60),
   $q->submit(-name=>'submit',
              -value=>'Submit Comment'),
   $q->endform;
   $sth->finish;
}

# This function is called by both print_contact() and print_response(). 
# If a "uid" is passed then it's an update, else its an insert (new record).

sub update {
   print_html("Contact Information Update");   
   print $q->center($q->h2("Contact Information Update"));
   print $q->hr;
   my $script = $q->script_name;
   my $path   = defined($q->param('uid')) ? "commit_update" : "commit_insert";
   my $uid    = defined($q->param('uid')) ? $q->param('uid') : '""';
   my $statement = qq(SELECT * from contact
                      WHERE uid = $uid);
   my $sth = $dbh->prepare($statement);
   $sth->execute or db_err("Unable to execute $statement", $dbh->errstr);      
   my($id,$first,$mi,$last,$phone,$fax,$email) = $sth->fetchrow_array;
   print $q->start_form(-action=>"$script/$path",
                        -target=>'response'),
   $q->hidden(-name=>'uid',
            -value=>$uid),
   "FIRST NAME: ", $q->textfield(-name=>'first_name',
                                 -value=>$first,
                                 -size=>20,
                                 -maxlength=>20),
   $q->br, 
   "MI: ", $q->textfield(-name=>'middle_initial',
                         -value=>$mi,
                         -size=>1,
                         -maxlength=>1),
   $q->br, 
   "LAST NAME: ", $q->textfield(-name=>'last_name',
                                -value=>$last,
                                -size=>30,
                                -maxlength=>30),
   $q->br, 
   "WORK PHONE: ", $q->textfield(-name=>'phone',
                                 -value=>$phone,
                                 -size=>30,
                                 -maxlength=>30),
   $q->br, 
   "FAX: ", $q->textfield(-name=>'fax',
                          -value=>$fax,
                          -size=>30,
                          -maxlength=>30),
   $q->br, 
   "EMAIL: ", $q->textfield(-name=>'email',
                            -value=>$email,
                            -size=>40,
                            -maxlength=>70),
   $q->br, 
   $q->submit(-name=>'submit',
            -value=>'Submit Contact'),
   $q->endform;
   $sth->finish;
}

# This function is called from update(). Since a "uid" was passed to that
# function it must be a database update. This function commits the update.

sub commit_update {
   my $script = $q->script_name;
   my $uid    = $q->param('uid');
   my $first  = $q->param('first_name');
   my $mi     = $q->param('middle_initial');
   my $last   = $q->param('last_name');
   my $phone  = $q->param('phone');
   my $fax    = $q->param('fax');
   my $email  = $q->param('email');
   my $name   = "$first $last";
   print_html("Information Updated");   
   print $q->h2('Database has been updated');
   my $statement = qq(UPDATE contact 
                      SET first_name = '$first',
                      last_name = '$last',
                      middle_initial = '$mi',
                      phone = '$phone',
                      fax = '$fax',
                      email = '$email'
                      WHERE uid = $uid);
   my $sth = $dbh->do($statement) or 
   db_err("Unable to update database", $dbh->errstr);
   $sth->finish;
}

# This function is called from update(). Since a "uid" was not passed to that
# function it must be a database insert. This function commits the insert.
# This function also creates an entry in the comments table.

sub commit_insert {
   my $script = $q->script_name;
   my $first  = $q->param('first_name');
   my $mi     = $q->param('middle_initial');
   my $last   = $q->param('last_name');
   my $phone  = $q->param('phone');
   my $fax    = $q->param('fax');
   my $email  = $q->param('email');
   my $name   = "$first $last";
   my $title  = $name."'s Information Inserted";
   print_html($title);   
   print $q->h2("New database record created");
   my $statement   = qq(SELECT now()); # get current date/time
   my $sth = $dbh->prepare($statement);
   $sth->execute 
   or db_err("Unable to execute $statement", $dbh->errstr);
   my @row = $sth->fetchrow_array;
   my $now = $row[0];
   $sth->finish;
   $statement = qq{INSERT INTO contact ( first_name, middle_initial, last_name,  
                   phone, fax,  email)
                   VALUES('$first','$mi','$last','$phone','$fax','$email')};
   $sth = $dbh->prepare($statement);
   $sth->execute 
   or db_err("Unable to execute $statement", $dbh->errstr);
   my $uid = $sth->{mysql_insertid};
   $sth->finish;
   $statement = qq{INSERT INTO comment
                   VALUES($uid,'$now','Contact Record Created')};
   $sth = $dbh->do($statement)
   or db_err("Unable to execute $statement", $dbh->errstr);
   $sth->finish;
}

# This function is called from print_contact(). It commits the insert 
# into the comment table

sub add_comment {
   print_html("Comment Inserted");   
   print $q->h2("New Comment Added");
   my $script  = $q->script_name;
   my $uid     = $q->param('uid');
   my $comment = $q->param('contact_comment');
   my $statement = qq(SELECT now()); # get current date/time
   my $sth = $dbh->prepare($statement);
   $sth->execute
   or db_err("Unable to execute $statement", $dbh->errstr);
   my @row = $sth->fetchrow_array;
   my $now = $row[0];
   $sth->finish;
   $statement = qq{INSERT INTO comment
                   VALUES($uid,'$now','$comment')};
   $sth = $dbh->do($statement)
   or db_err("Unable to insert record into comment table", $dbh->errstr);
   $sth->finish;
} 

# This function is used to connect to the database and pass a database
# handle ($h) back to main program. 

sub db_connect {
   my ($database,$user,$password) = @_;
   my $h = DBI->connect("DBI:mysql:$database", $user, $password)
   or db_err("Unable to connect to $database", $DBI::errstr);
   return $h;
}

# This function traps DBI errors and prints them to the screen and exits.

sub db_err {
   my($msg, $errstr) = @_;
   print $q->h2($msg);
   print $q->hr;
   print $q->h3($errstr);
   print $q->end_html;
   exit;
}