#!/usr/bin/perl -w

#-----------------------------------------------------------
# Formgen 2.0
#-----------------------------------------------------------
# PURPOSE:
# * Generate Perl CGI script for web-based database management
# * Also generate the SQL code to create the database table(s)
#
# Input file is in the form "table.formgen"
# Syntax: formgen.pl database table
#-----------------------------------------------------------

use strict;
unless ($ARGV[0] && $ARGV[1]){
	my $usage = <<USAGE;

-----------------------------------------------------------------------
Welcome to Formgen. Version 2.0
Copyright (c) 2005 by Robert and David Bond.
This software comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to modify and redistribute it under the GPL license  
-----------------------------------------------------------------------

Usage: formgen <database> <table>

Where "database" is the name of the SQL database and
"table" is the name of the database table.

There should be a properly formatted configuration file
in the current directory, named <table>.formgen

This program will output two things:

(a) a SQL script  (<table>.sql) to create the database table
(b) a Perl script (<table>.pl)  to manage the database table

NOTE: The generated script assumes you are using MySQL.
      (It's easy to change to use another Perl DBI-supported database.)

      Also, the script will assume you're connecting to the
      <database> databse on the localhost, using <database> as
      the username and <database> as the password.  Obviously,
      you should change this default.

--------------------------
Configuration File Format
--------------------------

The <table>.formgen file should be a tab-delimited text file
in the current directory, with the following format:

Label->Column->Datatype->Options1->Options2

* Lines beginning with a # are comments.

* If Datatype is "select" (a simple dropdown), then
     Options1 contains a space-delimited list of the values
     to populate the dropdown (the list of options)

* If Datatype is "lookup" then
     Options1 is the database table to use
     Options2 is the column(s) to select
     (an auto-incrementing id named "id" is presumed; don't specify it)

* Checkboxes, radio buttons and multi-select boxes are not
  supported yet in this version.  If you must have these, simply use
  a select or lookup and hand-tune the code afterwards.

USAGE
	die($usage);
}



# The database name
my $database = shift;

# The table aka #TITLE#, #TABLE#
my $table = shift;

create_sql();
create_perl();

#-------------------------------------------------------------
sub create_sql {

	#-----------------------------------------------------
	# Make the SQL CREATE statement
	# To create the table do: mysql -u root -p < [table].sql
	#-----------------------------------------------------

	# NOTE: You will want to create indexes for the table later
	my $sql = "USE $database;\nCREATE TABLE $table (\n";

	open (IN, "$table.formgen") or die("Could not open file: $table.forgen");
	open (SQL, ">$table.sql") or die;

 	while (<IN>){
		next unless /^[a-zA-Z]/;
		my ($fld_text,$fld,$fld_type,$arg) = split(/\t/);
		chomp $arg if $arg;
		chomp $fld_type if $fld_type; 	# in case there's no arg

		#-------------------------------------------
		# HTML form tags have this format: <input type="..." ...>
		# Convert these to their SQL equivalents
		# NOTE: We handle these types:
		#           text, textarea, select
		#       We also handle these SQL types: 
		#           datetime, int, id (auto-incrementing
		# NOTE: We don't handle these ( but they can easily be hand-coded
		#       later by editing the generated perl script):
		#           radio, checkbox
		#-------------------------------------------

		if($fld_type eq "hidden"){
			# A hidden field is assumed to be auto-incrementing primary key
			$fld_type = "int(11) primary key auto_increment";
		}elsif($fld_type eq "text"){
			$fld_type = "varchar(255)";
		}elsif($fld_type eq "select"){
			$fld_type = "varchar(255)";
		}elsif($fld_type eq "lookup"){
			$fld_type = "int";
		}elsif($fld_type eq "textarea"){
			$fld_type = "mediumtext";
		}elsif($fld_type eq "datetime"){
			$fld_type = "datetime";
		}elsif($fld_type eq "timestamp"){
			$fld_type = "timestamp";
		}

		$sql .= "$fld $fld_type,\n";
	}
	$sql =~ s/,$//;
	$sql .= ")\;";

	print SQL $sql;
	close (SQL);
	close (IN);
}
#-------------------------------------------------------------
sub create_perl {
  #--------------------------------------------------------------
  # Generate a perl script by reading in a template which contains
  # a number of tokens (which are replaced with appropriate strings).
  # NOTE: If you have a <select> tag which must be populated via a
  # lookup on another table, a second subroutine template is used.
  #--------------------------------------------------------------

  # 0. Create output file
  open(OUT, ">$table.pl");

  # 1. Read in  the template
  my $tmpl        = read_template();
  my $tmpl_lookup = read_template_lookup();
  my $tmpl_select = read_template_select();

  # Now substitute the following tokens:
  # PROJECT
  # TABLE
  # SELECT_COLS
  # SELECT_COLS_VARS
  # LIST_FORM_HEADER
  # LIST_FORM
  # EDIT_FORM
  # COMMIT_VARS_Q
  # COMMIT_UPDATE_STMT
  # COMMIT_INSERT_COLS
  # COMMIT_INSERT_VARS
  # SELECT_SUBS
  # SELECT_SUBS_CALL
  # LOOKUP_SUBS
  # LOOKUP_SUBS_CALL


  # SELECT_COLS
	my $select_cols = "";

	open (IN,   "$table.formgen") or die("Could not open file: $table.formgen");
 	while (<IN>){
		next unless /^[a-zA-Z]/;
		my ($fld_text,$fld,$fld_type,$arg) = split(/\t/);
		chomp $arg if $arg;
		chomp $fld_type if $fld_type; 	# in case there's no arg
		$select_cols .= "$fld, ";
	}
	$select_cols =~ s/, $//;
	close (IN);
	$tmpl =~ s/#SELECT_COLS#/$select_cols/g;

  # SELECT_COLS_VARS
	my $select_cols_vars = '$' . $select_cols;
	   $select_cols_vars =~ s/, /, \$/g;
	$tmpl =~ s/#SELECT_COLS_VARS#/$select_cols_vars/g;

  # LIST_FORM_HEADER
	# Barf out a table header
	# if a sort has been performed, add _desc to the appropriate column (to give user option of desc sort)
	my $list_form_header = "\n<tr>\n";
	open (IN,   "$table.formgen") or die("Could not open file: $table.formgen");
 	while (<IN>){
		next unless /^[a-zA-Z]/;
		my ($fld_text,$fld,$fld_type,$arg) = split(/\t/);
		chomp $arg if $arg;
		chomp $fld_type if $fld_type; 	# in case there's no arg
		$list_form_header .= "\t<td class=tableheader><a href='$table.pl?action=list&sort=$fld'>$fld_text</a></td>\n";
	}
	close (IN);
	$list_form_header .= "</tr>\n";
	$tmpl =~ s/#LIST_FORM_HEADER#/$list_form_header/g;

  # LIST_FORM

	# Barf out a table containing all the rows
	# Use select_cols as the basis
	# NOTE: we're outputting a <tr>, not a full table
	my $list_form = "\n<tr>\n";
	my @select_cols = split(/, /,$select_cols);

	my $list_form_flag = 0;
	foreach my $col(@select_cols){
		$col = '$' . $col;
		if($list_form_flag){
			$list_form .= "\t<td nowrap class=\$td_class>$col</td>\n";
		}else{
			$list_form .= "\t<td nowrap class=\$td_class><a href='$table.pl?action=edit&id=\$id'>$col</a></td>\n";
			$list_form_flag++;
		}

	}
	$list_form .= "</tr>\n";
	$tmpl =~ s/#LIST_FORM#/$list_form/g;

  # EDIT_FORM

	# Output a form suitable for editing a record (or adding a record)
	# Note: Form has three cols - last one is empty but for help text if req.
	# Remember, if record already exists, it will be populated

	my $edit_form  = qq[\n<form name="editform" action="#TABLE#.pl" method="post" onSubmit="return checkData()">\n];
	$edit_form    .= qq[<input type="hidden" name="action" value="commit">\n];
	$edit_form    .= qq[<table cellspacing="1" cellpadding="5" border="0">];

	open (IN,   "$table.formgen") or die("Could not open file: $table.formgen");
	my $td_class = "tablerow1";
 	while (<IN>){
		next unless /^[a-zA-Z]/;   # skip comments and blank lines

		my ($fld_text,$fld,$fld_type,$arg) = split(/\t/);
		chomp $arg if $arg;
		chomp $fld_type if $fld_type; 	# in case there's no arg

		$edit_form .= qq[<tr>\n\t<td align="right" class="$td_class"><b>$fld_text</b></td>\n];
		$edit_form .= qq[\t<td valign="top" class="$td_class">];

		if ($fld_type eq "hidden"){
			my $value = '$' . $fld;
			$edit_form .= qq[<input type="hidden" name="$fld" value="$value">\$id];

		}elsif ($fld_type eq "text" or $fld_type eq "timestamp"){
			my $value   = '$' . $fld;
			$edit_form .= qq[<input type="text" name="$fld" size="30" value="$value">];

		}elsif($fld_type eq "textarea"){
			my $value   = '$' . $fld;
			$edit_form .= qq[<textarea name="$fld" rows="2" cols="80">$value</textarea>];

		}elsif($fld_type eq "select"){

			# The HTML for this element is created by a subroutine
			# named 'select_' . $fld . '()' which returns a value into '$select_' . $fld
			$edit_form .= '$select_' . $fld;

		}elsif($fld_type eq "lookup"){
			# The HTML for this element is created by a subroutine
			# named 'lookup_' . $fld . '()' which returns a value into '$lookup_' . $fld
			$edit_form .= '$lookup_' . $fld;
		}

		$edit_form .= qq[</td>\n</tr>\n];
		if($td_class eq "tablerow1"){ $td_class = "tablerow2"; }else { $td_class = "tablerow1"; }

	}
	$edit_form .= qq[<tr><td></td><td><input type="submit" name="Submit"></td></tr>\n];
	$edit_form .= "</table>\n</form>\n";
	$tmpl =~ s/#EDIT_FORM#/$edit_form/g;

  # COMMIT_VARS_Q
	# These are the quoted versions of the UPDATE vars
	# Format: $var    = $dbh->quote($q->param('var'));
	my @commit_cols   = "";
	my $commit_vars_q = "";

	open (IN,   "$table.formgen") or die("Could not open file: $table.formgen");
 	while (<IN>){
		next unless /^[a-zA-Z]/;

		my ($fld_text,$fld,$fld_type,$arg) = split(/\t/);
		chomp $arg if $arg;
		chomp $fld_type if $fld_type; 	# in case there's no arg
		next if $fld eq "id";
		push (@commit_cols, $fld);
	}
	close (IN);

	foreach my $col(@commit_cols){
		# if it's more than just a space
		if($col =~ /[a-z]/){
			my $col2 = $col;
			$col2 .= " " until length($col2) > 20;
			# this had a problem when $q->param was empty:
			#$commit_vars_q .= "my \$$col2 = \$dbh->quote(\$q->param('$col'))\;\n";

			$commit_vars_q .= "my \$$col2 = \$q->param('$col'); ";
			$commit_vars_q .= "\$$col = \$dbh->quote(\$$col)\;\n";
		}
	}
	$tmpl =~ s/#COMMIT_VARS_Q#/$commit_vars_q/g;

  # COMMIT_UPDATE_STMT
	# Grab the col's and make an UPDATE stmt like: UPDATE tbl SET this=$this,that=$that
	my $commit_update_stmt = "\n";

	foreach my $col(@commit_cols){
		# if it's more than just a space
		if($col =~ /[a-z]/){
			my $col2 = $col;
			$col2 .= " " until length($col2) > 20;
			$commit_update_stmt .= "$col2 = \$$col,\n";
		}
	}
	$commit_update_stmt =~ s/,$//;
	$tmpl =~ s/#COMMIT_UPDATE_STMT#/$commit_update_stmt/g;



  # COMMIT_INSERT_COLS
	# This is the same as SELECT_COLS minus the id
	# Knock out the id out (since it's auto-incrementing)
	my $commit_insert_cols =  $select_cols;
	$commit_insert_cols =~ s/^id, //;
	$tmpl =~ s/#COMMIT_INSERT_COLS#/$commit_insert_cols/g;

  # COMMIT_INSERT_VARS
	# This is the same as SELECT_VARS minus the id
	# Knock out the id out (since it's auto-incrementing)
	my $commit_insert_vars  = $select_cols_vars;
	$commit_insert_vars =~ s/^\$id, //;
	$tmpl =~ s/#COMMIT_INSERT_VARS#/$commit_insert_vars/g;

  # SELECT_SUBS, SELECT_SUBS_CALL, SELECT_COL, SELECT_OPTIONS

	# Create a subroutine for each fld of type "select"
	# In this case, $arg1 holds a space-delimited list of options
	# If an option has a space inside it, it needs to ge entered
	# into the .formgen file with underscores, which are later
	# with spaces.
	open (IN,   "$table.formgen") or die("Could not open file: $table.formgen");
 	while (<IN>){
		next unless /^[a-zA-Z]/;
		my ($fld_text,$fld,$fld_type,$arg1,$arg2) = split(/\t/);
		next unless $fld_type eq 'select';

		chomp $arg2 if $arg2;
		chomp $arg1 if $arg1;     # just in case there's no arg2
		chomp $fld_type if $fld_type; # in case there's no arg

		# Make a copy of the select template
		my $select = $tmpl_select;  

		# Create all the options
		my @options = split(/ /,$arg1);
		my $options = '';
		foreach my $option(@options){
			$option =~ s/_/ /g;  # convert underscores to spaces
			$options .= qq[<option value="$option">$option</option>];
		}
		
		# Name the subroutine and the select field's name attribute
		$select    =~ s/#SELECT_COL#/$fld/g;

		# Put the options into the select subroutine 
		$select    =~ s/#SELECT_OPTIONS#/$options/g;

		# Put the select subroutine in the main script
		$tmpl =~ s/#SELECT_SUBS#/#SELECT_SUBS#\n$select/g;

		# Put the call to the subroutine into the script
		my $select_sub_call = "\t" . 'my $select_' . $fld . ' = select_' . $fld . '($' . $fld . ');';
		$tmpl =~ s/#SELECT_SUBS_CALL#/#SELECT_SUBS_CALL#\n$select_sub_call/g;

	}
	close (IN);
	$tmpl =~ s/#SELECT_SUBS_CALL#//g;  # All done - remove the token

	
  # LOOKUP_SUBS, LOOKUP_SUBS_CALL, LOOKUP_COL1, LOOKUP_COL2
	# Create a subroutine for each fld of type "lookup"
	open (IN,   "$table.formgen") or die("Could not open file: $table.formgen");
 	while (<IN>){
		next unless /^[a-zA-Z]/;
		my ($fld_text,$fld,$fld_type,$lookup_table,$lookup_col) = split(/\t/);
		next unless $fld_type eq 'lookup';

		chomp $lookup_col if $lookup_col;
		chomp $fld_type if $fld_type; 	# in case there's no arg

		my $lookup = $tmpl_lookup;
		$lookup    =~ s/#LOOKUP_TABLE#/$lookup_table/g;

		# Sometimes the col names in the two tables don't match
		# So we need to handle both names
		# COL1 is in the current table
		# COL2 is in the lookup table
		$lookup    =~ s/#LOOKUP_COL1#/$fld/g;
		$lookup    =~ s/#LOOKUP_COL2#/$lookup_col/g;

		# Put the lookup subroutine in the main script
		$tmpl =~ s/#LOOKUP_SUBS#/#LOOKUP_SUBS#\n$lookup/g;

		# Put the call to the subroutine into the script
		my $lookup_sub_call = "\t" . 'my $lookup_' . $fld . ' = lookup_' . $fld . '($' . $fld . ');';
		$tmpl =~ s/#LOOKUP_SUBS_CALL#/#LOOKUP_SUBS_CALL#\n$lookup_sub_call/g;

	}
	close (IN);
	$tmpl =~ s/#LOOKUP_SUBS_CALL#//g; # All done - remove the token
	



  # PROJECT - has to come last
	$tmpl =~ s/#DATABASE#/$database/g;

  # TABLE   - also has to come last
	$tmpl =~ s/#TABLE#/$table/g;
	my $table_uc = ucfirst($table);
	$tmpl =~ s/#TABLE_UC#/$table_uc/g;





	print OUT $tmpl;
	close(OUT);
	





}

#--------------------------------------------------------------------------
#-------------- READ TEMPLATE ---------------------------------------------
#--------------------------------------------------------------------------
sub read_template {

	my $tmpl = <<'TEMPLATE';   # The single-quotes are necessary
#!/usr/bin/perl -w

use CGI;
use CGI::Carp('fatalsToBrowser');
use DBI;
use strict;
#require "#DATABASE#_common.pl";

my $ip = $ENV{'REMOTE_ADDR'};

my $dbh    = "";
my $q      = CGI->new();
my $id     = $q->param('id');
my $action = $q->param('action');
my $skip   = $q->param('skip');
my $sort   = $q->param('sort');
   $sort   = "" unless $sort;
my $sort2;

# Sanitize input
$id   =~ s/[^0-9]//g;  # nix anything not a number
$skip =~ s/[^0-9]//g;  # nix anything not a number
$skip = 0 unless $skip;

db_connect();

if($action eq "edit"){
	header();
	edit_item($id);
	footer();

}elsif($action eq "commit"){
	commit_item();

}elsif($action eq "delete"){
	delete_item($id);

}else{
	$action = "list";
	header();
	list_items();
	footer();
}



#----------------------------------------------------------------------------------
sub list_items {

  my (#SELECT_COLS_VARS#) = "";
  my $statement = "SELECT #SELECT_COLS# FROM #TABLE#";

  # sort clause
  if($sort){ 
	if($sort =~ /_desc$/){
		$sort2 = $sort;
		$sort2 =~ s/_desc$//;
		$statement .= " ORDER BY $sort2 DESC"; 
	}else{
		$statement .= " ORDER BY $sort"; 
	}
  }

  #------------------------------------------------
  # Paging through rows
  #------------------------------------------------
  # Get a count of the total records, for paging links
  my ($counter) = $dbh->selectrow_array("SELECT count(*) FROM #TABLE#");

  my $rows_per_page = 20;
  my $skip_next     = $skip + $rows_per_page;
  my $skip_prev     = 0;
  if($skip > $rows_per_page){ $skip_prev = $skip - $rows_per_page; }

  my $url_next = "";
  my $url_prev = "";

  # Skip records - don't skip more than what exists, right?
  if($rows_per_page >= $counter){
	# We reached the end already
	$url_next   = "";
	$url_prev   = "";

  }elsif($skip==0){

	$url_prev   = "";  # no previous recs exist becuz we're at the beginning
	$url_next   = "<a href='#TABLE#.pl?action=list&sort=$sort&skip=$skip_next'> More >> </a>";

  }elsif($skip + $rows_per_page >= $counter){
	# We reached the end already
	$url_next   = "";
	$url_prev   = "<a href='#TABLE#.pl?action=list&sort=$sort&skip=$skip_prev'> << More</a>";

  }elsif($skip < $counter){
	# Everything's beautiful, baby -- the world is orderly
	$url_next   = "<a href='#TABLE#.pl?action=list&sort=$sort&skip=$skip_next'> More >> </a>";
	$url_prev   = "<a href='#TABLE#.pl?action=list&sort=$sort&skip=$skip_prev'> << More</a>";
  }
  $statement .= " LIMIT $skip,$rows_per_page";

  #die $statement;
  my $sth = $dbh->prepare($statement);
  $sth->execute;

  my $td_class = "tablerow1";
  my $tableheader = <<TABLEHEADER;
<table CELLSPACING=1 CELLPADDING=5 BORDER=0>
#LIST_FORM_HEADER#
TABLEHEADER
  if($sort) { $tableheader =~ s/(sort=$sort)/$1_desc/; }
  print $tableheader;

  while ( (#SELECT_COLS_VARS#) = $sth->fetchrow_array){
	print <<DONE;

		#LIST_FORM#
DONE

	  if($td_class eq "tablerow1"){ $td_class = "tablerow2"; }else { $td_class = "tablerow1"; }

  }
  print "</table>\n";
  print <<SKIP;
<table width=100%>
<tr>
  <td>$url_prev</td>
  <td align=right>$url_next</td>
</tr>
</table>
SKIP


}
#----------------------------------------------------------------------------------
sub edit_item {

  my $this_id = shift;
  my $statement = "SELECT #SELECT_COLS# FROM #TABLE# WHERE id=$this_id";

  my (#SELECT_COLS_VARS#);

  if($this_id > 0){

	  (#SELECT_COLS_VARS#) = $dbh->selectrow_array($statement);
  }

	#SELECT_SUBS_CALL#
	#LOOKUP_SUBS_CALL#
	my $edit_form = <<DONE;
	#EDIT_FORM#	
DONE
print $edit_form;
print qq[<p><a href="#TABLE#.pl?action=delete&id=$this_id">Delete</a></p>\n] if $this_id > 0;  

}
#----------------------------------------------------------------------------------
sub commit_item {

#COMMIT_VARS_Q#

  my $statement;
  if($id > 0){
	$statement = "UPDATE #TABLE# SET #COMMIT_UPDATE_STMT# WHERE id=$id";
  }else{
	$statement = "INSERT INTO #TABLE# (#COMMIT_INSERT_COLS#) VALUES (#COMMIT_INSERT_VARS#)";
  }

  #die $statement;
  $dbh->do($statement);
  print $q->redirect("#TABLE#.pl?action=list");


}
#----------------------------------------------------------------------------------
sub delete_item {

  my $id = shift;
  $dbh->do("DELETE FROM #TABLE# WHERE id=$id");
  print $q->redirect("#TABLE#.pl?action=list");

}

#SELECT_SUBS#
#LOOKUP_SUBS#


#--------------------------------------------------------------------------------
sub header {

  print <<DONE;
Content-type: text/html

<html><head>
<style type="text/css">

body {background-color : #ffffff; font-family: helvetica, arial,sans-serif; }
p    { font-size: 12px; }
h1   { color:#999999; font-size: 18px;}
h2   { color:#777777; font-size: 16px;}
h3   { color:#000000; font-size: 12px;}

a         {  }
a:link    { color: #000099; text-decoration:none;}
a:visited { color: #000099; }
a:hover   { color: #0000FF; text-decoration:underline;}
a:active  { color: #0000FF; }

td { font-size: 12px; }

.tableheader   { background-color: #dddddd; vertical-align: top;  font-weight: bold; white-space: nowrap; }
.tableheader a { color: #000000; text-decoration:none; }
.tableheader a:hover { text-decoration:underline; }
.tablerow1     { background-color: #e0e0e0; vertical-align: top; }
.tablerow2     { background-color: #eeeeee; vertical-align: top; }

</style>

<script language="JavaScript">
<!--

function checkData (){
	// Put any client-side validation routines in here
	//if(document.addform.name.value.length==0){
	//	alert("You must enter a name.");
	//	return false;
	//}
}
//-->
</script>

<title>#DATABASE# - #TABLE#</title>

</head>

<body>
<h1>#DATABASE# - #TABLE#</h1>

<p>
<a href="../">Home</a> |
<a href="#TABLE#.pl?action=list">List All #TABLE_UC#s</a> |
<a href="#TABLE#.pl?action=edit">Add New #TABLE_UC#</a>
</p>
DONE
}



#----------------------------------------------------------------------------------
sub footer {
  print "</body></html>";

}
#----------------------------------------------------------------------------------
sub db_connect {
  $dbh = DBI->connect('DBI:mysql:#DATABASE#', '#DATABASE#', '#DATABASE#', {PrintError => 0,RaiseError => 1});

}

TEMPLATE

return $tmpl;
}# 

sub read_template_select {

	#---------------------------------
	# Read in a template for <select> fields
	# which are populated by a simple list (no 
	# other table involved)
	#---------------------------------

	my $tmpl_select = <<'SELECT';
#----------------------------------------------------------------------------------
sub select_#SELECT_COL# {

	# This subroutine is for a simple lookup (no other tables involved)
	# May need hand-tweaking depending on whether you want 
	# null's or blanks to be valid choices, or if you want a default choice

	# One argument = the value to highlight in the dropdown
	my $selected = shift;

	my $dropdown = qq[<select name="#SELECT_COL#" size="1"><option value=""></option>#SELECT_OPTIONS#</select>];

	if($selected){
		$dropdown  =~ s/(value="$selected")/$1 selected/;
	}
	return $dropdown;
}
SELECT
	return $tmpl_select;
}

#-----------------------------------------------------------------------------------
sub read_template_lookup {

	#---------------------------------
	# Read in a template for lookup fields -- <select> fields
	# which are populated by data from a lookup table
	# The assumption is that the table has two cols: id, lookup_column
	#---------------------------------

	my $tmpl_lookup = <<'LOOKUP';
#----------------------------------------------------------------------------------
sub lookup_#LOOKUP_COL1# {

	# Note: we assume the lookup table has a column called id
	# This subroutine may need manual tweaking

	# Argument = the value to highlight in the dropdown
	my $selected = shift;

	my $dropdown = qq[<select name="#LOOKUP_COL1#" size="1">\n<option value="0"></option>\n];

	my $stmt    = "SELECT id, #LOOKUP_COL2# FROM #LOOKUP_TABLE# ";
	my $sth     = $dbh->prepare($stmt);
	$sth->execute();

	while ( my ($id,$value) = $sth->fetchrow_array){
		$dropdown .= qq[<option value="$id">$value</option>\n];
	}
	$sth->finish;
	$dropdown .= "</select>\n";
	if($selected){
		$dropdown  =~ s/(value="$selected")/$1 selected/;
	}
	return $dropdown;
}
LOOKUP
	return $tmpl_lookup;
}
