" . "
$err\n"; # debugging $body .= "
";
my @names = $cgi->param;
foreach my $name (@names) {
my $value = $cgi->param($name);
$body .= "$name=\"$value\"\n";
}
$body .= "";
print STDOUT &http_response($head, $body);
exit(0);
};
# open DB environment
my $db;
($db = DBI->connect("dbi:SQLite:dbname=sdb.db", "", ""))
|| die "unable to connect to SQLite database \"sdb.db\"";
$db->{AutoCommit} = 1;
$db->{RaiseError} = 1;
## _________________________________________________________________________
##
## Stage 0: Determine Parameters
## _________________________________________________________________________
##
# list of UI display pages
my @ui_pages = qw(main person);
# initialize UI display parameters
my $ui = {};
foreach my $page (@ui_pages) {
my $found = 0;
foreach my $sub (
"ui_${page}_init",
"ui_init"
) {
if (defined(&$sub)) {
&$sub($my, $cgi, $db, $ui, $page);
$found = 1;
last;
}
}
die "no initialization handler found for page \"$page\""
if (not $found);
}
# determine UI display parameters
my @names = $cgi->param;
foreach my $name (@names) {
if ($name =~ m|^([^.]+)(?:\.([^.]+)(?:\.([^.]+))?)?$|s) {
my ($page, $area, $elem) = ($1, $2, $3);
if (defined($page)) {
$ui->{$page} = { -is => 'disable', -with => 'default' }
if (not defined($ui->{$page}));
}
if (defined($area)) {
$ui->{$page}->{$area} = { -is => 'disable', -with => 'default' }
if (not defined($ui->{$page}->{$area}));
}
if (defined($elem)) {
if ($name =~ m|\+$|s) {
my @values = $cgi->param($name);
$ui->{$page}->{$area}->{$elem} = [ @values ];
}
else {
my $value = $cgi->param($name);
$ui->{$page}->{$area}->{$elem} = $value;
}
}
elsif (defined($area)) {
my $value = $cgi->param($name);
$value = "visible" if ($value eq "1");
$ui->{$page}->{$area}->{-is} = $value;
}
elsif (defined($page)) {
my $value = $cgi->param($name);
$value = "visible" if ($value eq "1");
$ui->{$page}->{-is} = $value;
}
$cgi->param($name, undef);
}
}
## _________________________________________________________________________
##
## Stage 1: Process Last Action
## _________________________________________________________________________
##
# determine default UI display
my $page = undef;
foreach my $p (keys(%{$ui})) {
if ($ui->{$p}->{-is} eq 'visible') {
$page = $p;
last;
}
}
if (not defined($page)) {
$ui->{main}->{-is} = 'visible';
$ui->{main}->{all}->{-is} = 'visible';
}
# determine which button was pressed and
# perform an associated action (if defined)
foreach my $page (keys(%{$ui})) {
foreach my $area (keys(%{$ui->{$page}})) {
foreach my $elem (keys(%{$ui->{$page}->{$area}})) {
if ($elem =~ m|^[A-Z][A-Z0-9_-]*$|) {
if ($ui->{$page}->{$area}->{$elem}) {
my $found = 0;
foreach my $sub (
"ui_${page}_${area}_${elem}_action",
"ui_${page}_${area}_action",
"ui_${page}_action",
"ui_action"
) {
if (defined(&$sub)) {
&$sub($my, $cgi, $db, $ui, $page, $area, $elem);
$found = 1;
last;
}
}
die "no action handler found for element \"$page.$area.$elem\""
if (not $found);
}
delete $ui->{$page}->{$area}->{$elem};
}
}
}
}
## _________________________________________________________________________
##
## Stage 2: Output New Display
## _________________________________________________________________________
##
# start output generation
my $html = new String::Divert;
$html->overload(1);
# generate outmost class
$html .= "\n";
$html .= "\n";
my @names = $cgi->param;
foreach my $name (sort(@names)) {
my $value = $cgi->param($name);
$body .= " $name=\"$value\"\n";
}
$body .= "\n";
# generate output
print STDOUT &http_response($head, $body);
exit(0);
## _________________________________________________________________________
##
## Page: main
## _________________________________________________________________________
##
sub ui_main_init {
my ($my, $cgi, $db, $ui, $page) = @_;
$ui->{main} = { -is => 'disable', -with => 'default' };
$ui->{main}->{all} = { -is => 'disable', -with => 'default' };
}
sub ui_main_action {
my ($my, $cgi, $db, $ui, $page, $area, $elem) = @_;
die "invalid action \"$page.$area.$elem\"";
}
sub ui_main_render {
my ($my, $cgi, $db, $ui, $page) = @_;
# start generating HTML
my $html = new String::Divert;
$html->overload(1);
# generate outer class
$html .= "\n";
$html .= " "; $html *= q{body};
$html .= "\n";
$html >> q{body};
# generate header
$html .= "\n"; $html .= "
| \n"; $html .= " "; $html *= q{area1}; $html .= " | \n"; $html .= "\n"; $html .= " \n"; $html .= " | \n"; $html .= "\n"; $html .= " "; $html *= q{area2}; $html .= " | \n"; $html .= "
| \n"; $html .= " \n"; $html .= " | \n"; $html .= "||
| \n"; $html .= " "; $html *= q{area3}; $html .= " | \n"; $html .= "||
| \n"; $html .= " "; $html *= q{select-list}; $html .= " | \n"; $html .= "\n"; $html .= " "; $html *= q{select-buttons}; $html .= " | \n"; $html .= "