#! /usr/bin/perl

# edit_member - edit Historical League member entries

# program ignores validation currently

use DBI;
use strict;

# parse connection parameters from command line if given

use Getopt::Long;
$Getopt::Long::ignorecase = 0; # options are case sensitive

# default parameters - all missing
my ($host_name, $user_name, $password) = (undef, undef, undef);

# GetOptions doesn't seem to allow -uuser_name form, only -u user_name?
GetOptions(
	# =s means a string argument is required after the option
	"host|h=s"      => \$host_name
	,"user|u=s"      => \$user_name
	# :s means a string argument is optional after the option
	,"password|p:s"  => \$password
) or exit (1);

# solicit password if option specified without option value
if (defined ($password) && !$password)
{
	# turn off echoing but don't interfere with STDIN
	open (TTY, "/dev/tty") or die "Cannot open terminal\n";
	system ("stty -echo < /dev/tty");
	print STDERR "Enter password: ";
	chomp ($password = <TTY>);
	system ("stty echo < /dev/tty");
	close (TTY);
	print STDERR "\n";
}

# construct data source
my ($dsn) = "dbi:mysql:samp_db";
$dsn .= ":hostname=$host_name" if $host_name;
$dsn .= ";mysql_read_default_file=$ENV{HOME}/.my.cnf";

# connect to server
my (%attr) = ( RaiseError => 1 );
my ($dbh) = DBI->connect ($dsn, $user_name, $password, \%attr);

# get member table column names
my ($sth) = $dbh->prepare (qq{ SELECT * FROM member WHERE 0 });
$sth->execute ();
my (@col_name) = @{$sth->{NAME}};
$sth->finish ();

if (@ARGV == 0) # if no arguments, create new entry
{
		new_member (\@col_name);
}
else			# otherwise edit entries using arguments as member IDs
{
my (@id);

	# save @ARGV, then empty it so that reads from STDIN
	# don't use the arguments as filenames
	@id = @ARGV;
	@ARGV = ();
	# for each ID value, look up the entry, then edit it
	while (my $id = shift (@id))
	{
	my ($entry_ref);

		$sth = $dbh->prepare (qq{
					SELECT * FROM member WHERE member_id = ?
				});
		$sth->execute ($id);
		$entry_ref = $sth->fetchrow_hashref ();
		$sth->finish ();
		if (!$entry_ref)
		{
			warn "No member with member ID = $id\n";
			next;
		}
		edit_member (\@col_name, $entry_ref);
	}
}

$dbh->disconnect ();
exit (0);

# ask a question, prompt for an answer

sub prompt
{
my ($str) = shift;

	print STDERR $str;
	chomp ($str = <STDIN>);
	return ($str);
}

# prompt for a column value; show current value in prompt if
# $show_current is true

sub col_prompt
{
my ($name, $val, $show_current) = @_;
my ($prompt, $str);

loop:
	$prompt = $name;
	$prompt .= " [$val]" if $show_current;
	$prompt .= ": ";
	print STDERR $prompt;
	chomp ($str = <STDIN>);
	# perform rudimentary check on the expiration date
	if ($str && $name eq "expiration")	# check expiration date format
	{
		if ($str !~ /^\d+[^\d]\d+[^\d]\d+$/)
		{
			warn "$str is not a legal date, try again\n";
			goto loop;
		}
	}
	return ($str ? $str : $val);
}

# display contents of an entry

sub show_member
{
my ($col_name_ref, $entry_ref) = @_;
my ($col_val);

	print "\n";
	foreach my $col_name (@{$col_name_ref})
	{
		$col_val = $entry_ref->{$col_name};
		$col_val = "NULL" unless defined ($col_val);
		printf "%s: %s\n", $col_name, $col_val;
	}
}

# create new member entry

sub new_member
{
my ($col_name_ref) = shift;
my ($entry_ref);
my ($col_val, $query, $delim);

	return unless prompt ("Create new entry? ") =~ /^y/i;
	# prompt for new values; user types in new value,
	# "null" to enter a NULL value, "exit" to exit
	# early.
	foreach my $col_name (@{$col_name_ref})
	{
		next if $col_name eq "member_id";	# skip key field
		$col_val = col_prompt ($col_name, "", 0);
		next if $col_val eq "";				# user pressed Enter
		return if $col_val =~ /^exit$/i;	# early exit
		$col_val = undef if $col_val =~ /^null$/i;
		$entry_ref->{$col_name} = $col_val;
	}
	# show values, ask for confirmation before inserting
	show_member ($col_name_ref, $entry_ref);
	return unless prompt ("\nInsert this entry? ") =~ /^y/i;

	# construct an INSERT query, then issue it.
	$query = "INSERT INTO member";
	$delim = " SET "; # put "SET" before first column, "," before others
	foreach my $col_name (@{$col_name_ref})
	{
		# only specify values for columns that were given one
		next if !defined ($entry_ref->{$col_name});
		# quote() quotes undef as the word NULL (without quotes),
		# which is what we want.
		$query .= sprintf ("%s %s=%s", $delim, $col_name,
							$dbh->quote ($entry_ref->{$col_name}));
		$delim = ",";
	}
	warn "Warning: entry not inserted?\n"
		unless $dbh->do ($query) == 1;
}

# edit existing contents of an entry

sub edit_member
{
my ($col_name_ref, $entry_ref) = @_;
my ($col_val, $query, $delim);

	# show initial values, ask for okay to go ahead and edit
	show_member ($col_name_ref, $entry_ref);
	return unless prompt ("\nEdit this entry? ") =~ /^y/i;
	# prompt for new values; user types in new value to replace
	# existing value, "null" to enter a NULL value, "exit" to exit
	# early, or Enter to accept existing value.
	foreach my $col_name (@{$col_name_ref})
	{
		next if $col_name eq "member_id";	# skip key field
		$col_val = $entry_ref->{$col_name};
		$col_val = "NULL" unless defined ($col_val);
		$col_val = col_prompt ($col_name, $col_val, 1);
		return if $col_val =~ /^exit$/i;	# early exit
		$col_val = undef if $col_val =~ /^null$/i;
		$entry_ref->{$col_name} = $col_val;
	}
	# show new values, ask for confirmation before updating
	show_member ($col_name_ref, $entry_ref);
	return unless prompt ("\nUpdate this entry? ") =~ /^y/i;

	# construct an UPDATE query, then issue it.
	$query = "UPDATE member";
	$delim = " SET "; # put "SET" before first column, "," before others
	foreach my $col_name (@{$col_name_ref})
	{
		next if $col_name eq "member_id";	# skip key field
		# quote() quotes undef as the word NULL (without quotes),
		# which is what we want.
		$query .= sprintf ("%s %s=%s", $delim, $col_name,
							$dbh->quote ($entry_ref->{$col_name}));
		$delim = ",";
	}
	$query .= " WHERE member_id = ?";
	warn "Warning: entry not updated?\n"
		unless $dbh->do ($query, undef, $entry_ref->{member_id}) == 1;
}