#! /usr/local/bin/perl -w
use strict ;

# ################################################################# 
# Schema: Survey Database 
my %Survey = 
(
	tblq       => { primID => ['q_id'],
                      cols => ['anstmpl_id', 'short_label', 'question', 'updated'] },
	tblqtmpl   => { primID => ['qtmpl_id'],
					  cols => ['name', 'descr', 'updated'] },
	tblqtmpl_q => { primID => ['qtmpl_id', 'q_id'],
                      cols => ['seq', 'notes', 'updated'] },
);

# ################################################################# 
# Package: Survey Database 
{package Survey ;
	
	# assume %Survey defined somewhere
	
	# = = = = = = = = = = = = = = = = Contructor = = = = = = = = = = = = = = = = = #
	sub dbconnect { }
	# = = = = = = = = = = = = = = = Public Methods = = = = = = = = = = = = = = = = #
	foreach my $tbl (keys %Survey){ # define subroutines <action>_<table> at runtime
		eval qq/sub insert_$tbl {return (shift)->_insert_table(_tblname(),\@_)}/ ;
		eval qq/sub update_$tbl {return (shift)->_update_table(_tblname(),\@_)}/ ;
		eval qq/sub delete_$tbl {return (shift)->_delete_table(_tblname(),\@_)}/ ;
	}
	# = = = = = = = = = = = = = = = Private Methods = = = = = = = = = = = = = = = =#
	sub _insert_table { 
		my ($self, $tbl, $values) = (shift, shift, shift) ;
		# ... and more... 
	}
	sub _update_table { 
		my ($self, $tbl, $values) = (shift, shift, shift) ;
		# ... and more... 
	}
	sub _delete_table { 
		my ($self, $tbl, $values) = (shift, shift, shift) ;
		# ... and more... 
	}	
	# --------------------------------------------------------------
	sub _tblname{   # return <tbl>, if called by <action>_<tbl> e.g. show_tblanstype
		( my $sub = (caller(1))[3] ) =~ s/.*::.*?_(.*)/$1/ ;
		return $sub ;
	}
}

# ################################################################# 
# Test Script: Survey Database Package 

# tblq
$Survey->insert_tblq(\%data) ;
$Survey->update_tblq(\%data) ;
$Survey->delete_tblq(\%data) ;
# tblqtmpl
$Survey->insert_tblqtmpl(\%data) ;
$Survey->update_tblqtmpl(\%data) ;
$Survey->delete_tblqtmpl(\%data) ;
# tblqtmpl_q
$Survey->insert_tblqtmpl_q(\%data) ;
$Survey->update_tblqtmpl_q(\%data) ;
$Survey->delete_tblqtmpl_q(\%data) ;