# Selima Website Content Management System
# Form.pm: The base form

#  Copyright (c) 2004-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2004-09-28

package Selima::Form;
use 5.008;
use strict;
use warnings;

use CGI qw();
use Data::Dumper qw();
use URI::Escape qw(uri_escape);

use Selima::A2HTML;
use Selima::Array;
use Selima::CallForm;
use Selima::ChkFunc;
use Selima::CommText;
use Selima::Country;
use Selima::DataVars qw($DBH $SESSION FORM_CAPTCHA :dataman :hostconf :l10n
    :lninfo :requri :scptconf :siteconf);
use Selima::FormFunc;
use Selima::Format;
use Selima::GetLang;
use Selima::Guest;
use Selima::HTTP;
use Selima::HTTPS;
use Selima::LnInfo;
use Selima::MarkAbbr;
use Selima::Picture;
use Selima::ShortCut;
use Selima::UserName;

# Load these classes
use Selima::Form::User;
use Selima::Form::Group;
use Selima::Form::UserMem;
use Selima::Form::GroupMem;
use Selima::Form::UserPref;
use Selima::Form::ScptPriv;

use Selima::Form::Guestbook;
use Selima::Form::Guestbook::Public;
use Selima::Form::Page;
use Selima::Form::LinkCat;
use Selima::Form::Link;
use Selima::Form::LinkCatz;

use Selima::Form::Rebuild;

use Selima::Form::AcctSubj;
use Selima::Form::AcctTrx;
use Selima::Form::AcctRec;

# new: Initialize the HTML form table displayer
sub new : method {
    local ($_, %_);
    my ($class, $status, $args, $self, $CURFORM, $CALLINGFORM);
    ($class, $status, $args) = @_;
    $args = {} if !defined $args;
    $self = bless {}, $class;
    $self->{"status"} = $status;
    
    # $args must be a hash reference
    http_500 "type of argument 2 must be a hash reference"
        if ref($args) ne "HASH";
    # The form type
    $self->{"type"} = exists $$args{"type"}? $$args{"type"}: form_type;
    # The form type to pass to the handler
    if (exists $$args{"type_to_pass"}) {
        $self->{"type_to_pass"} = $$args{"type_to_pass"};
    } else {
        $self->{"type_to_pass"} = $$args{"type"};
    }
    # The allowed form types
    $self->{"valid_types"} = exists $$args{"valid_types"}?
        $$args{"valid_types"}: [qw(new cur del)];
    # Only new, cur or del is allowed for the form type
    http_500 "invalid form type: " . $self->{"type"}
        if !in_array($self->{"type"}, @{$self->{"valid_types"}});
    # The form step
    $self->{"step"} = $$args{"step"} if exists $$args{"step"};
    # The request ID.
    $self->{"req"} = $$args{"req"} if exists $$args{"req"};
    # The managing table
    if (exists $$args{"table"}) {
        $self->{"table"} = $$args{"table"};
    } elsif (defined $THIS_TABLE) {
        $self->{"table"} = $THIS_TABLE;
    }
    # The current record
    $self->{"cur"} = exists $$args{"current"}? $$args{"current"}:
        new CGI({%CURRENT});
    $self->{"sn"} = $self->{"cur"}->param("sn")
        if defined $self->{"cur"}->param("sn");
    # The submitted form
    $self->{"form"} = exists $$args{"form"}? $$args{"form"}:
        retrieve_form;
    # If we should process with HTTPS/SSL
    $self->{"https"} = 0
        if !defined($self->{"https"} = $self->https($args));
    # If the form contains file uploads (multipart/form-data)
    $self->{"isupload"} = exists $$args{"isupload"} && $$args{"isupload"};
    # If this record can be deleted
    $self->{"nodelete"} = exists $$args{"nodelete"} && $$args{"nodelete"};
    # The prefix message to display before the form
    $self->{"prefmsg"} = [];
    push @{$self->{"prefmsg"}}, @{$$args{"prefmsg"}} if exists $$args{"prefmsg"};
    # The deletion text
    $self->{"deltext"} = exists $$args{"deltext"}? $$args{"deltext"}:
        C_("Delete it.");
    # The mark
    $self->{"mark"} = exists $$args{"mark"}? $$args{"mark"}:
        C_("<span class=\"mark\">*</span>");
    # The columns to mark
    $self->{"markcols"} = $$args{"markcols"} if exists $$args{"markcols"};
    # The prompt message for the marked columns
    $self->{"markmsg"} = $$args{"markmsg"} if exists $$args{"markmsg"};
    # The hidden columns
    $self->{"hidcols"} = $$args{"hidcols"} if exists $$args{"hidcols"};
    # The buttons to show before and after the form
    $self->{"header_buttons"} = $$args{"header_buttons"}
        if exists $$args{"header_buttons"};
    $self->{"footer_buttons"} = $$args{"footer_buttons"}
        if exists $$args{"footer_buttons"};
    # If we should show the table
    $self->{"show_table"} = exists $$args{"show_table"}?
        $$args{"show_table"}: 1;
    # The table summary
    if (exists $$args{"summary"}) {
        $self->{"summary"} = $$args{"summary"};
    } else {
        # A form to create a new item
        if ($self->{"type"} eq "new") {
            $self->{"summary"} = C_("This table provides you a form to add a new data record.");
        # A form to edit a current item
        } elsif ($self->{"type"} eq "cur") {
            $self->{"summary"} = C_("This table provides you a form to update a current data record.");
        # A form to delete a current item
        } elsif ($self->{"type"} eq "del") {
            $self->{"summary"} = C_("This table provides you a form to delete a data record.");
        }
    }
    # The form class
    $self->{"class"} = exists $$args{"class"}? $$args{"class"}: "defform";
    # The onsubmit javascript form checker
    $self->{"onsubmit"} = exists $$args{"onsubmit"}?
        $$args{"onsubmit"}: undef;
    # The colspan for each normal <td> cell
    $self->{"colspan"} = exists $$args{"colspan"}? $$args{"colspan"}: 1;
    # The default input box size
    $self->{"defsize"} = exists $$args{"defsize"}? $$args{"defsize"}: 40;
    # The process URL
    if (exists $$args{"procurl"}) {
        $self->{"procurl"} = $$args{"procurl"};
    } elsif ($self->{"https"} && !is_guest) {
        if ($VIRTUAL_HOST) {
            $self->{"procurl"} = "https://" . https_host . $REQUEST_PATH;
        } else {
            $self->{"procurl"} = "https://" . https_host . "/" . $PACKAGE . $REQUEST_PATH;
        }
    } else {
        $self->{"procurl"} = $REQUEST_FILE;
    }
    # The columns to display
    if (exists $$args{"cols"}) {
        $self->{"cols"} = $$args{"cols"};
    } elsif (exists $self->{"table"}) {
        $self->{"cols"} = [$DBH->cols($self->{"table"})];
    }
    # Should we automatically keep our HTTP_REFERER
    $self->{"auto_referer2"} = exists $$args{"auto_referer2"}?
        $$args{"auto_referer2"}: 1;
    # The title
    if (exists $$args{"title"}) {
        $self->{"title"} = $$args{"title"};
    } else {
        # A form to create a new item
        if ($self->{"type"} eq "new") {
            $self->{"title"} = C_("Add a New Data Record");
        # A form to edit a current item
        } elsif ($self->{"type"} eq "cur") {
            $self->{"title"} = C_("Update a Current Data Record");
        # A form to delete a current item
        } elsif ($self->{"type"} eq "del") {
            $self->{"title"} = C_("Delete a Data Record");
        }
    }
    # The caller form and form ID
    $CURFORM = curform;
    if (        exists $$args{"caller"}
                && exists $$args{"cformid"}) {
        $self->{"is_called_form"} = 1;
        $self->{"caller"} = $$args{"caller"};
        $self->{"cformid"} = $$args{"cformid"};
    } elsif (   defined $CURFORM->param("caller")
                && defined $CURFORM->param("cformid")) {
        $self->{"is_called_form"} = 1;
        $self->{"caller"} = $CURFORM->param("caller");
        $self->{"cformid"} = $CURFORM->param("cformid");
    } else {
        $self->{"is_called_form"} = 0;
    }
    # The preview link
    $self->{"preview"} = exists $$args{"preview"}? $$args{"preview"}: 0;
    $self->{"prevmsg"} = exists $$args{"prevmsg"}? $$args{"prevmsg"}:
            C_("Preview it.")
        if $$args{"preview"};
    
    # Initialize the first form
    $self->{"is_first_form"} = 0;
    if (scalar(@_ = $self->{"form"}->param) == 0) {
        $self->{"is_first_form"} = 1;
        # ...with the current item
        eval Data::Dumper->Dump([$self->{"cur"}], [qw($self->{"form"})])
            if $self->{"type"} eq "cur";
    }
    if (exists $self->{"table"}) {
        $self->{"mlcols"} = [$DBH->cols_ml($self->{"table"})];
        $self->{"maxlens"} = {$DBH->col_lens($self->{"table"})};
    }
    
    # Check if each column is available
    foreach (@{$self->{"cols"}}) {
        http_500 "invalid table column \"$_\""
            if !$self->can("_html_col_$_");
    }
    
    # Set the referer2 (the place to return when finishing the form)
    if ($self->{"is_called_form"}) {
        # Referer specified
        $CALLINGFORM = retrieve_form($self->{"cformid"});
        $self->{"referer2"} = $CALLINGFORM->param("referer2")
            if defined $CALLINGFORM->param("referer2");
    # First form
    } elsif ($self->{"is_first_form"}) {
        # Referer specified
        if (defined $CURFORM->param("referer")) {
            $self->{"referer2"} = $CURFORM->param("referer");
        # Keep the source referer
        } elsif (   $self->{"auto_referer2"}
                    && exists $ENV{"HTTP_REFERER"}
                    && substr($ENV{"HTTP_REFERER"}, 0, length($REQUEST_HOSTPORT)+1) eq $REQUEST_HOSTPORT . "/") {
            $self->{"referer2"} = $ENV{"HTTP_REFERER"};
        }
    # A subsequent form
    } else {
        # Maintain the previous referer2
        $self->{"referer2"} = $self->{"form"}->param("referer2")
            if defined $self->{"form"}->param("referer2");
    }
    
    # The prefix of where to return after form is processed
    # No need to have it if we have a proper referer2 to return to
    $self->{"hostport"} = $REQUEST_HOSTPORT
        if !exists $self->{"referer2"} && $self->{"https"};
    
    # Check if Chinese synchronization is available
    %_ = map { $_ => 1 } @ALL_LINGUAS;
    $_ = getlang;
    $self->{"zhsync"} = 0;
    if (    exists $self->{"table"}
            && $DBH->is_ml_table($self->{"table"})
            && $_ ne $DEFAULT_LANG) {
        if ($_ eq "zh-tw" && exists $_{"zh-cn"}) {
            $self->{"zhsync"} = h_abbr(C_("Convert from Simplified Chinese"));
        } elsif ($_ eq "zh-cn" && exists $_{"zh-tw"}) {
            $self->{"zhsync"} = h_abbr(C_("Convert from Traditional Chinese"));
        }
    }
    
    %_ = map { $_ => 1 } @ALL_LINGUAS;
    $_ = getlang;
    $self->{"zhsync"} = 0;
    if (    exists $self->{"table"}
            && $DBH->is_ml_table($self->{"table"})
            && $_ ne $DEFAULT_LANG) {
        if ($_ eq "zh-tw" && exists $_{"zh-cn"}) {
            $self->{"zhsync"} = h_abbr(C_("Convert from Simplified Chinese"));
        } elsif ($_ eq "zh-cn" && exists $_{"zh-tw"}) {
            $self->{"zhsync"} = h_abbr(C_("Convert from Traditional Chinese"));
        }
    }
    
    return $self;
}

# html: Display the HTML form table
sub html : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Display the preview_link
    $self->_html_preview_link;
    # Display the form header
    $self->_html_form_header;
    
    # Display the table
    # Display the table header
    $self->_html_table_header
        if $self->{"show_table"};
    # Display each column
    &{$self->can("_html_col_$_")}($self) foreach @{$self->{"cols"}};
    # Display the table footer
    $self->_html_table_footer
        if $self->{"show_table"};
    
    # Display the form footer
    $self->_html_form_footer;
    return;
}

# https: If we should process with HTTPS/SSL
sub https : method {
    local ($_, %_);
    my ($self, $args, $FORM);
    ($self, $args) = @_;
    # Checked before
    return $self->{"https"} if exists $self->{"https"};
    # Already in HTTPS
    return ($self->{"https"} = 0) if is_https;
    # HTTPS specified
    return $self->{"https"} = ($$args{"https"}? 1: 0)
        if defined $args && exists $$args{"https"} && defined $$args{"https"};
    # Specified in the current form
    $FORM = curform;
    return ($self->{"https"} = 1)
        if defined $FORM->param("https") && $FORM->param("https");
    # Specified in the GET or POST arguments
    $FORM = get_or_post;
    return ($self->{"https"} = 1)
        if defined $FORM->param("https") && $FORM->param("https");
    # Unable to decide it
    return undef;
}


###################
# Methods below are private.  Do not call them directly.
###################
###################
# Basic form elements
###################
# _html_preview_link: Display the preview_link
sub _html_preview_link : method {
    local ($_, %_);
    my ($self, $form, $url, $msg);
    $self = $_[0];
    $form = $self->{"form"};
    # Bounce when preview is not available for this form
    return if !$self->{"preview"};
    # No preview on forms that cannot be previewed
    if (defined $self->{"status"}) {
        return unless   exists ${$self->{"status"}}{"preview"}
                        && ${$self->{"status"}}{"preview"};
    }
    
    @_ = qw();
    push @_, "form=preview";
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        # No preview for the first blank form
        if ($self->{"is_first_form"}) {
            return;
        } else {
            push @_, "sn=" . $form->param("formid");
        }
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        # Make a suspended form and get the form ID.
        if ($self->{"is_first_form"}) {
            push @_, "sn=" . $self->{"sn"};
            push @_, "source=db";
        } else {
            push @_, "sn=" . $form->param("formid");
        }
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        # No preview for the deletion form
        return;
    }
    $url = h($REQUEST_FILE . "?" . join "&", @_);
    $msg = h_abbr($self->{"prevmsg"});
    print << "EOT";
<p><a href="$url">$msg</a></p>

EOT
    return;
}

# _html_form_header: Display the form header
sub _html_form_header : method {
    local ($_, %_);
    my ($self, $class, $url, $enctype, $onsubmit, $meta);
    $self = $_[0];
    $class = defined $self->{"class"}?
        " class=\"" . h($self->{"class"}) . "\"": "";
    $url = h($self->{"procurl"});
    $enctype = $self->{"isupload"}? " enctype=\"multipart/form-data\"": "";
    $onsubmit = defined $self->{"onsubmit"}?
        " onsubmit=\"" . h($self->{"onsubmit"}) . "\"": "";
    
    # The meta form information
    $meta = Selima::Form::MetaCols->new;
    $meta->add("hidden", "lang", getlang);
    $meta->add("hidden", "charset", undef);
    $meta->add("hidden", "form", $self->{"type_to_pass"})
        if defined $self->{"type_to_pass"};
    $meta->add("hidden", "step", $self->{"step"})
        if exists $self->{"step"};
    $meta->add("hidden", "sn", $self->{"sn"})
        if exists $self->{"sn"};
    $meta->add("hidden", "req", $self->{"req"})
        if exists $self->{"req"};
    if ($self->{"is_called_form"}) {
        $meta->add("hidden", "caller", $self->{"caller"});
        $meta->add("hidden", "cformid", $self->{"cformid"});
    }
    if ($self->{"https"}) {
        $meta->add("hidden", "https", 1);
        $meta->add("hidden", "referer", $REQUEST_HOSTPATH);
        $meta->add("hidden", $$SESSION{".meta"}->{"name"},
            $$SESSION{".meta"}->{"id"});
    }
    if (exists $self->{"referer2"}) {
        $meta->add("hidden", "referer2", $self->{"referer2"});
    } elsif (exists $self->{"hostport"}) {
        $meta->add("hidden", "hostport", $self->{"hostport"});
    }
    if (exists $self->{"hidcols"}) {
        $meta->add("hidden", $$_{"name"}, $$_{"value"})
            foreach @{$self->{"hidcols"}};
    }
    
    # The submit buttons
    if (exists $self->{"header_buttons"}) {
        $meta->add("submit", $$_{"name"}, $$_{"value"})
            foreach @{$self->{"header_buttons"}};
    } else {
        # A form to create a new item
        if ($self->{"type"} eq "new") {
            $meta->add("submit", undef, C_("Submit"));
            $meta->add("submit", "confirm", C_("Save"));
        # A form to edit a current item
        } elsif ($self->{"type"} eq "cur") {
            $meta->add("submit", undef, C_("Submit"));
            $meta->add("submit", "confirm", C_("Save"));
            $meta->add("submit", "zhsync", $self->{"zhsync"})
                if $self->{"zhsync"};
            $meta->add("submit", "del", $self->{"deltext"})
                unless $self->{"nodelete"};
        # A form to delete a current item
        } elsif ($self->{"type"} eq "del") {
        }
    }
    
    # Output the form header
    print << "EOT";
<form$class action="$url" method="post"$enctype
    accept-charset="<!--selima:charset-->"$onsubmit>
EOT
    # Display the prompt for the marked columns
    $self->_html_mark_prompt;
    # Display the prefix message
    $self->_html_prefix_message;
    print << "EOT";
<div>
EOT
    # Output the meta form information
    $meta->out;
    return;
}

# _html_mark_prompt: Display the prompt for the marked columns
sub _html_mark_prompt : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Bounce when there is no prompt message or no mark to use
    return if !exists $self->{"markmsg"} || !defined $self->{"mark"};
    $_ = printf $self->{"markmsg"}, $self->{"mark"};
    print << "EOT";
<p>$_</p>

EOT
    return;
}

# _html_prefix_message: Display the prefix message
sub _html_prefix_message : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Bounce when there is no prefix message
    foreach my $msg (@{$self->{"prefmsg"}}) {
        $_ = h_abbr($msg);
        print << "EOT";
<p class="prefmsg">$_</p>

EOT
    }
    return;
}

# _html_table_header: Display the table header
sub _html_table_header : method {
    local ($_, %_);
    my ($self, $cols, $summary);
    $self = $_[0];
    # Output the table header
    $cols = "<col />";
    $cols .= "<col />" if $self->{"type"} eq "cur";
    for ($_ = 0; $_ < $self->{"colspan"}; $_++) {
        $cols .= "<col />";
    }
    $summary = h_abbr($self->{"summary"});
    print << "EOT";
<table summary="$summary">
<colgroup>$cols</colgroup>
<tbody>
EOT
    
    return;
}

# _html_table_footer: Display the table footer
sub _html_table_footer : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Output the table footer
    print << "EOT";
</tbody>
</table>
EOT
    return;
}

# _html_form_footer: Display the form footer
sub _html_form_footer : method {
    local ($_, %_);
    my ($self, $meta, $msg);
    $self = $_[0];
    
    # The meta form information
    $meta = Selima::Form::MetaCols->new;
    # The submit buttons
    if (exists $self->{"footer_buttons"}) {
        $meta->add("submit", $$_{"name"}, $$_{"value"})
            foreach @{$self->{"footer_buttons"}};
    } else {
        # A form to create a new item
        if ($self->{"type"} eq "new") {
            $meta->add("submit", undef, C_("Submit"));
            $meta->add("submit", "confirm", C_("Save"));
        # A form to edit a current item
        } elsif ($self->{"type"} eq "cur") {
            $meta->add("submit", undef, C_("Submit"));
            $meta->add("submit", "confirm", C_("Save"));
            $meta->add("submit", "zhsync", $self->{"zhsync"})
                if $self->{"zhsync"};
            $meta->add("submit", "del", $self->{"deltext"})
                unless $self->{"nodelete"};
        # A form to delete a current item
        } elsif ($self->{"type"} eq "del") {
            $meta->add("submit", "confirm", C_("Delete"));
            $meta->add("submit", "cancel", C_("Cancel"));
        }
    }
    
    # Output the deletion warning
    print "<p>" . h_abbr(C_("Are you sure you want to delete this data?  You cannot recover it if you do so.")) . "</p>\n"
        if $self->{"type"} eq "del";
    # Output the meta form information
    $meta->out;
    # Output the form footer
    print << "EOT";
</div>
</form>

EOT
    return;
}


###################
# Column templates
###################
# _html_coltmpl_ro: Display a read-only normal column
sub _html_coltmpl_ro : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = $self->_cval_text($col);
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_textarea: Display a read-only textarea column
sub _html_coltmpl_ro_textarea : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = $self->_cval_textarea($col);
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_bool: Display a read-only boolean column
sub _html_coltmpl_ro_bool : method {
    local ($_, %_);
    my ($self, $col, $label, $true, $false, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $true, $false, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = $self->{"cur"}->param($col)? $true: $false;
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_user: Display a read-only user column
sub _html_coltmpl_ro_user : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = h_abbr(username scalar $self->{"cur"}->param($col));
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_date: Display a read-only date column
sub _html_coltmpl_ro_date : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = defined $self->{"cur"}->param($col)?
        h_abbr(fmtdate $self->{"cur"}->param($col)): h_abbr(t_none);
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_datetime: Display a read-only date-time column
sub _html_coltmpl_ro_datetime : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = defined $self->{"cur"}->param($col)?
        h_abbr(fmttime $self->{"cur"}->param($col)): h_abbr(t_none);
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_lang: Display a read-only language column
sub _html_coltmpl_ro_lang : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = defined $self->{"cur"}->param($col)?
        h_abbr(ln $self->{"cur"}->param($col), LN_DESC_CURLC): h_abbr(t_none);
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_ct: Display a read-only country column
sub _html_coltmpl_ro_ct : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = h_abbr(ctname $self->{"cur"}->param($col));
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_title: Display a read-only column with a title function
sub _html_coltmpl_ro_title : method {
    local ($_, %_);
    my ($self, $col, $label, $titlefunc, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $titlefunc, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = h(&$titlefunc($self->{"cur"}->param($col)));
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_ro_radio: Display a read-only column with a option list
sub _html_coltmpl_ro_radio : method {
    local ($_, %_);
    my ($self, $col, $label, $opts, $prompt, $cur, $mark, $colspan, $thclass, $thcolspan);
    ($self, $col, $label, $opts, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cur = $$opts{grep $self->{"cur"}->param($col) eq $_, keys %$opts};
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
    <td$colspan>$cur$prompt</td>
</tr>
EOT
    return;
}

# _html_coltmpl_text: Display a text column
sub _html_coltmpl_text : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $size, $class, $mark, $colspan);
    my ($cur, $val, $orig, $new);
    ($self, $col, $label, $prompt, $size) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $class = defined $size? "": " class=\"text\"";
    $size = h($self->{"defsize"}) if !defined $size;
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $val = $self->_val_text($col, $col);
        $col = h($col);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$col">$mark$label</label></th>
    <td$colspan><input id="$col"$class type="text" name="$col" size="$size"$val />$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $cur = $self->_cval_text($col);
        $val = $self->_val_text($col, $col);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        # A multi-lingual column, that is not in the default language
        if (in_array($col, @{$self->{"mlcols"}}) && getlang ne $DEFAULT_LANG) {
            my ($srclabel, $srccur);
            $srclabel = h_abbr(C_("Source:"));
            $_ = $col . "_" . ln($DEFAULT_LANG, LN_DATABASE);
            $srccur = $self->_cval_text($_);
            $col = h($col);
            print << "EOT";
<tr>
    <th class="th" rowspan="3" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$srclabel</th>
    <td$colspan>$srccur</td>
</tr>
<tr>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><input id="$col"$class type="text" name="$col" size="$size"$val />$prompt</td>
</tr>
EOT
        
        # A uni-lingual column
        } else {
            $col = h($col);
            print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><input id="$col"$class type="text" name="$col" size="$size"$val />$prompt</td>
</tr>
EOT
        }
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = $self->_cval_text($col);
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_text_null: Display a nullable text column
sub _html_coltmpl_text_null : method {
    local ($_, %_);
    my ($self, $col, $label, $nullcol, $nulllabel, $prompt, $size, $class, $mark, $colspan);
    my ($form, $cur, $val, $orig, $new, $valfalse, $valtrue);
    ($self, $col, $label, $nullcol, $nulllabel, $prompt, $size) = @_;
    $form = $self->{"form"};
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $class = defined $size? "": " class=\"textnull\"";
    $size = h($self->{"defsize"}) if !defined $size;
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $valfalse = $self->_val_radio($nullcol, "false");
        $valtrue = $self->_val_radio($nullcol, "true");
        $val = $self->_val_text($col, $col);
        $col = h($col);
        $nullcol = h($nullcol);
        print << "EOT";
<tr>
    <th class="th"><label for="$col" scope="row">$mark$label</label></th>
    <td$colspan><input id="not$nullcol" type="radio" name="$nullcol"$valfalse />
        <input id="$col"$class type="text" name="$col" size="40"$val />$prompt<br />
        <input id="$nullcol" type="radio" name="$nullcol"$valtrue />
        <label for="$nullcol">$nulllabel</label></td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $form->param($nullcol, !defined $form->param($col)? "true": "false")
            if $self->{"is_first_form"};
        $valfalse = $self->_val_radio($nullcol, "false");
        $valtrue = $self->_val_radio($nullcol, "true");
        $val = $self->_val_text($col, $col);
        $cur = defined $self->{"cur"}->param($col)?
            h($self->{"cur"}->param($col)): $nulllabel;
        $col = h($col);
        $nullcol = h($nullcol);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><input id="not$nullcol" type="radio" name="$nullcol"$valfalse />
        <input id="$col"$class type="text" name="$col" size="40"$val />$prompt<br />
        <input id="$nullcol" type="radio" name="$nullcol"$valtrue />
        <label for="$nullcol">$nulllabel</label></td>
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = defined $self->{"cur"}->param($col)?
            h($self->{"cur"}->param($col)): $nulllabel;
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_textarea: Display a textarea column
sub _html_coltmpl_textarea : method {
    local ($_, %_);
    my ($self, $col, $label, $default, $prompt, $rows, $cols, $mark, $colspan, $hdef);
    my ($cur, $val, $orig, $new);
    ($self, $col, $label, $default, $prompt, $rows, $cols) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $cols = h($self->{"defsize"}) if !defined $cols;
    $rows = h(10) if !defined $rows;
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $val = $self->_val_textarea($col, $default);
        $hdef = h($default);
        $col = h($col);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$col">$mark$label</label></th>
    <td$colspan><textarea id="$col" name="$col" cols="$cols" rows="$rows"
        onfocus="if (this.value == &quot;$hdef&quot;) this.value = &quot;&quot;;">$val</textarea>$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $cur = $self->_cval_textarea($col);
        $val = $self->_val_textarea($col, $default);
        $hdef = h($default);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        # A multi-lingual column, that is not in the default language
        if (in_array($col, @{$self->{"mlcols"}}) && getlang ne $DEFAULT_LANG) {
            my ($srclabel, $srccur);
            $srclabel = h_abbr(C_("Source:"));
            $_ = $col . "_" . ln($DEFAULT_LANG, LN_DATABASE);
            $srccur = $self->_cval_textarea($_);
            $col = h($col);
            print << "EOT";
<tr>
    <th class="th" rowspan="3" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$srclabel</th>
    <td$colspan>$srccur</td>
</tr>
<tr>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><textarea id="$col" name="$col" cols="$cols" rows="$rows"
        onfocus="if (this.value == &quot;$hdef&quot;) this.value = &quot;&quot;;">$val</textarea>$prompt</td>
</tr>
EOT
        
        # A uni-lingual column
        } else {
            $col = h($col);
            print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><textarea id="$col" name="$col" cols="$cols" rows="$rows"
        onfocus="if (this.value == &quot;$hdef&quot;) this.value = &quot;&quot;;">$val</textarea>$prompt</td>
</tr>
EOT
        }
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = $self->_cval_textarea($col);
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_bool: Display a boolean column
sub _html_coltmpl_bool : method {
    local ($_, %_);
    my ($self, $col, $label, $true, $false, $text, $prompt, $mark, $colspan);
    my ($cur, $val, $orig, $new);
    ($self, $col, $label, $true, $false, $text, $prompt) = @_;
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $val = $self->_val_check($col);
        $col = h($col);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$col">$mark$label</label></th>
    <td$colspan><input id="$col" type="checkbox" name="$col"$val />
        <label for="$col">$text</label>$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $cur = $self->{"cur"}->param($col)? $true: $false;
        $val = $self->_val_check($col);
        $col = h($col);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><input id="$col" type="checkbox" name="$col"$val />
        <label for="$col">$text</label>$prompt</td>
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = $self->{"cur"}->param($col)? $true: $false;
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_call: The call selection column
sub _html_coltmpl_call : method {
    local ($_, %_);
    my ($self, $col, $label, $titlefunc, $prompt, $mark, $colspan);
    my ($form, $cur, $val, $orig, $new);
    my ($vallabel, $choose, $delete);
    ($self, $col, $label, $titlefunc, $prompt) = @_;
    $self = $_[0];
    $form = $self->{"form"};
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $choose = h_abbr(C_("Choose"));
    $delete = h_abbr(C_("Delete"));
    # "" means not selected yet
    $form->delete($col)
        if defined $form->param($col) && $form->param($col) eq "";
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $val = $self->_val_text($col);
        $vallabel = h(&$titlefunc($form->param($col)));
        $col = h($col);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="sel$col">$mark$label</label></th>
    <td$colspan><label for="sel$col">$vallabel</label>
EOT
        if (defined $form->param($col)) {
            print << "EOT";
        <input id="del$col" type="submit" name="del$col" value="$delete" /><input
            id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        } else {
            print << "EOT";
        <input id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        }
        print << "EOT";
        <input type="hidden" name="$col"$val />$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $val = $self->_val_text($col);
        $vallabel = h(&$titlefunc($form->param($col)));
        $cur = h(&$titlefunc($self->{"cur"}->param($col)));
        $col = h($col);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="sel$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="sel$col">$new</label></th>
    <td$colspan><label for="sel$col">$vallabel</label>
EOT
        if (defined $form->param($col)) {
            print << "EOT";
        <input id="del$col" type="submit" name="del$col" value="$delete" /><input
            id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        } else {
            print << "EOT";
        <input id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        }
        print << "EOT";
        <input type="hidden" name="$col"$val />$prompt</td>
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = h(&$titlefunc($self->{"cur"}->param($col)));
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_call_null: The nullable call selection column
sub _html_coltmpl_call_null : method {
    local ($_, %_);
    my ($self, $col, $label, $nullcol, $nulllabel, $titlefunc, $prompt, $mark, $colspan);
    my ($form, $cur, $val, $orig, $new, $valfalse, $valtrue);
    my ($vallabel, $choose, $delete);
    ($self, $col, $label, $nullcol, $nulllabel, $titlefunc, $prompt) = @_;
    $self = $_[0];
    $form = $self->{"form"};
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $choose = h_abbr(C_("Choose"));
    $delete = h_abbr(C_("Delete"));
    # "" means not selected yet
    $form->delete($col)
        if defined $form->param($col) && $form->param($col) eq "";
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $valfalse = $self->_val_radio($nullcol, "false");
        $valtrue = $self->_val_radio($nullcol, "true");
        $val = $self->_val_text($col);
        $vallabel = h(&$titlefunc($form->param($col)));
        $col = h($col);
        $nullcol = h($nullcol);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="sel$col">$mark$label</label></th>
    <td$colspan><ul>
        <li><input id="not$nullcol" type="radio" name="$nullcol"$valfalse />
            <label for="not$nullcol">$vallabel</label>
EOT
        if (defined $form->param($col)) {
            print << "EOT";
        <input id="del$col" type="submit" name="del$col" value="$delete" /><input
            id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        } else {
            print << "EOT";
        <input id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        }
        print << "EOT";
            <input type="hidden" name="$col"$val />
        </li>
        <li><input id="$nullcol" type="radio" name="$nullcol"$valtrue />
            <label for="$nullcol">$nulllabel</label>
        </li>
        </ul>
    $prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $form->param($nullcol, !defined $form->param($col)? "true": "false")
            if $self->{"is_first_form"};
        $valfalse = $self->_val_radio($nullcol, "false");
        $valtrue = $self->_val_radio($nullcol, "true");
        $val = $self->_val_text($col);
        $vallabel = h(&$titlefunc($form->param($col)));
        $cur = defined $self->{"cur"}->param($col)?
            h(&$titlefunc($self->{"cur"}->param($col))): $nulllabel;
        $col = h($col);
        $nullcol = h($nullcol);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="sel$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="sel$col">$new</label></th>
    <td$colspan><ul>
        <li><input id="not$nullcol" type="radio" name="$nullcol"$valfalse />
            <label for="not$nullcol">$vallabel</label>
EOT
        if (defined $form->param($col)) {
            print << "EOT";
        <input id="del$col" type="submit" name="del$col" value="$delete" /><input
            id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        } else {
            print << "EOT";
        <input id="sel$col" type="submit" name="sel$col" value="$choose" />
EOT
        }
        print << "EOT";
            <input type="hidden" name="$col"$val />
        </li>
        <li><input id="$nullcol" type="radio" name="$nullcol"$valtrue />
            <label for="$nullcol">$nulllabel</label>
        </li>
        </ul>
    $prompt</td>
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = defined $self->{"cur"}->param($col)?
            h(&$titlefunc($self->{"cur"}->param($col))): $nulllabel;
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_select: The selection column
sub _html_coltmpl_select : method {
    local ($_, %_);
    my ($self, $form, $current, $col, $label, $optfunc, $titlefunc, $prompt, $mark, $colspan);
    my ($cur, $orig, $new);
    ($self, $col, $label, $optfunc, $titlefunc, $prompt) = @_;
    $form = $self->{"form"};
    $current = $self->{"cur"};
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $col = h($col);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$col">$mark$label</label></th>
    <td$colspan><select id="$col" name="$col">
EOT
        print &$optfunc($form->param($col));
        print << "EOT";
        </select>$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $cur = h(&$titlefunc($self->{"cur"}->param($col)));
        $col = h($col);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><select id="$col" name="$col">
EOT
        print &$optfunc($form->param($col));
        print << "EOT";
        </select>$prompt</td>
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = h(&$titlefunc($self->{"cur"}->param($col)));
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
}

# _html_coltmpl_select_multi: The multiple selection column
sub _html_coltmpl_select_multi : method {
    local ($_, %_);
    my ($self, $form, $current, $col, $label, $optfunc, $prompt, $mark, $colspan);
    my ($orig, $new, $count, $col0, $col_);
    ($self, $col, $label, $optfunc, $prompt) = @_;
    $form = $self->{"form"};
    $current = $self->{"cur"};
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    
    # Find the last used category index, and append 3 blank selections
    for ($_ = 0; defined $form->param("$col$_"); $_++) { };
    for ($_--; $_ >= 0 && $form->param("$col$_") eq ""; $_--) { };
    $count = $_ + 3;
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $col0 = h($col . "0");
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$col0">$mark$label</label></th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ <= $count; $_++) {
            $col_ = h($col . $_);
            push @_, "        <li><select id=\"$col_\" name=\"$col_\">\n"
                    . &$optfunc($form->param($col_))
                    . "            </select>\n"
                    . "        </li>\n";
        }
        print "<ul>\n" . join("", @_) . "        </ul>\n    ";
        print << "EOT";
$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $col0 = h($col . "0");
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col0">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ < $current->param("$col" . "count"); $_++) {
            push @_, "        <li>" . h($current->param("$col$_" . "title")) . "</li>\n";
        }
        print @_ > 0? "<ul>\n" . join("", @_) . "        </ul>\n    ": h_abbr(t_none);
        print << "EOT";
</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col0">$new</label></th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ <= $count; $_++) {
            $col_ = h($col . $_);
            push @_, "        <li><select id=\"$col_\" name=\"$col_\">\n"
                    . &$optfunc($form->param($col_))
                    . "            </select>\n"
                    . "        </li>\n";
        }
        print "<ul>\n" . join("", @_) . "        </ul>\n    ";
        print << "EOT";
$prompt</td>
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ < $current->param("$col" . "count"); $_++) {
            push @_, "        <li>" . h($current->param("$col$_" . "title")) . "</li>\n";
        }
        print @_ > 0? "<ul>\n" . join("", @_) . "        </ul>\n    ": h_abbr(t_none);
        print << "EOT";
</td>
</tr>
EOT
    }
}

# _html_coltmpl_radio: The radio column
sub _html_coltmpl_radio : method {
    local ($_, %_);
    my ($self, $form, $current, $col, $label, $opts, $prompt, $oneline, $mark, $colspan);
    my ($orig, $new, $coldef, $found);
    ($self, $col, $label, $opts, $prompt, $oneline) = @_;
    $form = $self->{"form"};
    $current = $self->{"cur"};
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $oneline = 0 if !defined $oneline;
    $oneline = $oneline? " class=\"oneline\"": "";
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $coldef = $col . (exists ${$$opts[0]}{"id"}? ${$$opts[0]}{"id"}:
            ${$$opts[0]}{"val"});
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$coldef">$mark$label</label></th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ < @$opts; $_++) {
            my $id;
            $id = $col . (exists ${$$opts[$_]}{"id"}? ${$$opts[$_]}{"id"}:
                ${$$opts[$_]}{"val"});
            push @_, sprintf("        <li><input id=\"%s\" type=\"radio\" name=\"%s\"%s />\n"
                . "            <label for=\"%s\">%s<\/label>\n        <\/li>\n",
                h($id), h($col),
                $self->_val_radio($col, ${$$opts[$_]}{"val"}),
                h($id), h_abbr(${$$opts[$_]}{"title"}));
        }
        print "<ul$oneline>\n" . join("", @_) . "        </ul>\n    ";
        print << "EOT";
$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $coldef = $col . (exists ${$$opts[0]}{"id"}? ${$$opts[0]}{"id"}:
            ${$$opts[0]}{"val"});
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, $found = 0; $_ < @$opts; $_++) {
            if ($current->param($col) eq ${$$opts[$_]}{"val"}) {
                $found = 1;
                print h_abbr(${$$opts[$_]}{"title"});
                last;
            }
        }
        print h_abbr(t_na) if !$found;
        print << "EOT";
</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$coldef">$new</label></th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ < @$opts; $_++) {
            my $id;
            $id = $col . (exists ${$$opts[$_]}{"id"}? ${$$opts[$_]}{"id"}:
                ${$$opts[$_]}{"val"});
            push @_, sprintf("        <li><input id=\"%s\" type=\"radio\" name=\"%s\"%s />\n"
                . "            <label for=\"%s\">%s<\/label>\n        <\/li>\n",
                h($id), h($col),
                $self->_val_radio($col, ${$$opts[$_]}{"val"}),
                h($id), h_abbr(${$$opts[$_]}{"title"}));
        }
        print "<ul$oneline>\n" . join("", @_) . "        </ul>\n    ";
        print << "EOT";
$prompt</td>
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, $found = 0; $_ < @$opts; $_++) {
            if ($current->param($col) eq ${$$opts[$_]}{"val"}) {
                $found = 1;
                print h_abbr(${$$opts[$_]}{"title"});
                last;
            }
        }
        print h_abbr(t_na) if !$found;
        print << "EOT";
</td>
</tr>
EOT
    }
}

# _html_coltmpl_tags: The tags
sub _html_coltmpl_tags : method {
    local ($_, %_);
    my ($self, $form, $current, $col, $label, $table, $titlefunc, $prompt, $size, $oneline, $class, $mark, $colspan);
    my ($valfree, $orig, $new, $colfree);
    ($self, $col, $label, $table, $titlefunc, $prompt, $size, $oneline) = @_;
    $form = $self->{"form"};
    $current = $self->{"cur"};
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $class = defined $size? "": " class=\"text\"";
    $size = h($self->{"defsize"}) if !defined $size;
    $oneline = 0 if !defined $oneline;
    $oneline = $oneline? " class=\"oneline\"": "";
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $colfree = $col . "free";
        $valfree = $self->_val_text($colfree, $colfree);
        $colfree = h($colfree);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$colfree">$mark$label</label></th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); defined $form->param("$col$_" . "sn"); $_++) {
            if (check_sn_in ${$form->param_fetch("$col$_" . "sn")}[0], $table) {
                push @_, sprintf(
                        "        <li><input type=\"hidden\" name=\"%1\$s%2\$dsn\"%3\$s />\n"
                        . "            <input id=\"%1\$s%2\$d\" type=\"checkbox\" name=\"%1\$s%2\$d\"%4\$s />\n"
                        . "            %5\$s\n"
                        . "        </li>\n",
                    h($col), h($_), $self->_val_text("$col$_" . "sn"),
                    $self->_val_check("$col$_"),
                    h_abbr(&$titlefunc($form->param("$col$_" . "sn"))));
            } else {
                push @_, sprintf(
                        "        <li><input type=\"hidden\" name=\"%1\$s%2\$dsn\"%3\$s />\n"
                        . "            <input type=\"checkbox\"%4\$s disabled=\"disabled\" />\n"
                        . "            %5\$s\n"
                        . "        </li>\n",
                    h($col), h($_), $self->_val_text("$col$_" . "sn"),
                    $self->_val_check("$col$_"), h_abbr(t_na));
            }
        }
        print "<ul$oneline>\n" . join("", @_) . "        </ul>\n"
            . "        <input id=\"$colfree\"$class type=\"text\" name=\"$colfree\" size=\"$size\"$valfree />$prompt";
        print << "EOT";
</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $colfree = $col . "free";
        $valfree = $self->_val_text($colfree, $colfree);
        $colfree = h($colfree);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$colfree">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ < $current->param($col . "count"); $_++) {
            push @_, $self->_cval_text("$col$_" . "title");
        }
        print @_ > 0? join(", ", @_): h_abbr(t_none);
        print << "EOT";
</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$colfree">$new</label></th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); defined $form->param("$col$_" . "sn"); $_++) {
            if (check_sn_in ${$form->param_fetch("$col$_" . "sn")}[0], $table) {
                push @_, sprintf(
                        "        <li><input type=\"hidden\" name=\"%1\$s%2\$dsn\"%3\$s />\n"
                        . "            <input id=\"%1\$s%2\$d\" type=\"checkbox\" name=\"%1\$s%2\$d\"%4\$s />\n"
                        . "            %5\$s\n"
                        . "        </li>\n",
                    h($col), h($_), $self->_val_text("$col$_" . "sn"),
                    $self->_val_check("$col$_"),
                    h_abbr(&$titlefunc($form->param("$col$_" . "sn"))));
            } else {
                push @_, sprintf(
                        "        <li><input type=\"hidden\" name=\"%1\$s%2\$dsn\"%3\$s />\n"
                        . "            <input type=\"checkbox\"%4\$s disabled=\"disabled\" />\n"
                        . "            %5\$s\n"
                        . "        </li>\n",
                    h($col), h($_), $self->_val_text("$col$_" . "sn"),
                    $self->_val_check("$col$_"), h_abbr(t_na));
            }
        }
        print "<ul$oneline>\n" . join("", @_) . "        </ul>\n"
            . "        <input id=\"$colfree\"$class type=\"text\" name=\"$colfree\" size=\"$size\"$valfree />$prompt";
        print << "EOT";
</td>
</tr>
EOT
    
    # A form to delete a current item
    } else {
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
EOT
        print "    <td$colspan>";
        for ($_ = 0, @_ = qw(); $_ < $current->param($col . "count"); $_++) {
            push @_, $self->_cval_text("$col$_" . "title");
        }
        print @_ > 0? join(", ", @_): h_abbr(t_none);
        print << "EOT";
</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_date: Display a date column
sub _html_coltmpl_date : method {
    local ($_, %_);
    my ($self, $form, $col, $label, $prompt, $size, $mark, $colspan);
    my ($cur, $val, $orig, $new);
    ($self, $col, $label, $prompt, $size) = @_;
    $form = $self->{"form"};
    $mark = $self->_mark($col);
    $colspan = $self->_colspan;
    $prompt = !defined $prompt? "":
        "\n        <p class=\"prompt\">" . h_abbr($prompt) . "</p>\n    ";
    $size = h(10) if !defined $size;
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        # Set the default date to today
        $form->param($col, time) if $self->{"is_first_form"};
        $val = $self->_val_date($col, $col);
        $col = h($col);
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="$col">$mark$label</label></th>
    <td$colspan><input id="$col" type="text" name="$col" size="$size"$val />$prompt</td>
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $cur = defined $self->{"cur"}->param($col)?
            h(fmtdate $self->{"cur"}->param($col)): h_abbr(t_none);
        $val = $self->_val_date($col, $col);
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        # A multi-lingual column, that is not in the default language
        if (in_array($col, @{$self->{"mlcols"}}) && getlang ne $DEFAULT_LANG) {
            my ($srclabel, $srccur);
            $srclabel = h_abbr(C_("Source:"));
            $_ = $col . "_" . ln($DEFAULT_LANG, LN_DATABASE);
            $srccur = defined $self->{"cur"}->param($_)?
                h($self->{"cur"}->param($_)): h_abbr(t_none);
            $col = h($col);
            print << "EOT";
<tr>
    <th class="th" rowspan="3" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$srclabel</th>
    <td$colspan>$srccur</td>
</tr>
<tr>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><input id="$col" type="text" name="$col" size="$size"$val />$prompt</td>
</tr>
EOT
        
        # A uni-lingual column
        } else {
            $col = h($col);
            print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$col">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$cur</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$col">$new</label></th>
    <td$colspan><input id="$col" type="text" name="$col" size="$size"$val />$prompt</td>
</tr>
EOT
        }
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $cur = defined $self->{"cur"}->param($col)?
            h(fmtdate $self->{"cur"}->param($col)): h_abbr(t_none);
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$cur</td>
</tr>
EOT
    }
    return;
}

# _html_coltmpl_url: The URL column
sub _html_coltmpl_url : method {
    $_[0]->{"form"}->param($_[1], "http://")
        if $_[0]->{"is_first_form"} && !defined $_[0]->{"form"}->param($_[1]);
    $_[0]->_html_coltmpl_text($_[1], $_[2], $_[3], $_[4]);
}


###################
# Columns, sorted alphabetically
###################
# _html_col_addr: The address
sub _html_col_addr : method {
    $_[0]->_html_coltmpl_text("addr", h_abbr(C_("Address:")));
}

# _html_col_author: The author
sub _html_col_author : method {
    $_[0]->_html_coltmpl_text("author", h_abbr(C_("Author:")));
}

# _html_col_body: The content body
sub _html_col_body : method {
    $_[0]->_html_coltmpl_textarea("body", h_abbr(C_("Content:")),
        h_abbr(C_("Fill in the content here.")));
}

# _html_col_captcha: The CAPTCHA (human test)
# Add a field that is not displayed and should be empty to trap spam
# See: http://www.hockinson.com/programmer-web-designer-denver-co-usa.php?s=44
sub _html_col_captcha : method {
    local ($_, %_);
    my ($self, $col, $label, $prompt, $size, $class, $mark, $colspan);
    my ($thclass, $thcolspan);
    $self = $_[0];
    $mark = $self->_mark("captcha");
    $col = FORM_CAPTCHA;
    $label = h_abbr(C_("Current Website:"));
    $size = h($self->{"defsize"});
    $class = " class=\"text\"";
    $colspan = $self->_colspan;
    $prompt = "\n        <p class=\"prompt\">"
        . h_abbr(C_("Enter your website URL here.")) . "</p>\n    ";
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr class="tr$col">
    <th$thclass$thcolspan scope="row"><label for="$col">$mark$label</label></th>
    <td$colspan><input id="$col"$class type="text" name="$col" size="$size" value="" />$prompt</td>
</tr>
EOT
    return;
}

# _html_col_created: The creation time
sub _html_col_created : method {
    $_[0]->_html_coltmpl_ro_datetime("created", h_abbr(C_("Created:")));
}

# _html_col_createdby: The creator
sub _html_col_createdby : method {
    $_[0]->_html_coltmpl_ro_user("createdby", h_abbr(C_("Created by:")));
}

# _html_col_disabled: Disabled?
sub _html_col_disabled : method {
    $_[0]->_html_coltmpl_bool("email", h_abbr(C_("Disabled?")),
        h_abbr(C_("Disabled")), h_abbr(C_("Enabled")), h_abbr(C_("Disable it.")));
}

# _html_col_date: The date
sub _html_col_date : method {
    $_[0]->_html_coltmpl_date("date", C_("Date:"));
}

# _html_col_dsc: The description
sub _html_col_dsc : method {
    $_[0]->_html_coltmpl_textarea("dsc", h_abbr(C_("Description:")),
        h_abbr(C_("Fill in the description here.")), undef, 4);
}

# _html_col_email: The e-mail
sub _html_col_email : method {
    $_[0]->_html_coltmpl_text("email", h_abbr(C_("E-mail:")));
}

# _html_col_fax: The facsimile number
sub _html_col_fax : method {
    $_[0]->_html_coltmpl_text("fax", h_abbr(C_("Fax.:")));
}

# _html_col_grp: The group
sub _html_col_grp : method {
    $_[0]->_html_coltmpl_call("grp", h_abbr(C_("Group:")), \&groupdsc);
}

# _html_col_hid: Hide?
sub _html_col_hid : method {
    $_[0]->_html_coltmpl_bool("hid", h_abbr(C_("Hide?")),
        h_abbr(C_("Hide it")), h_abbr(C_("Show it")), h_abbr(C_("Hide it currently.")));
}

# _html_col_html: HTML?
sub _html_col_html : method {
    $_[0]->_html_coltmpl_bool("html", h_abbr(C_("HTML?")),
        h_abbr(C_("HTML")), h_abbr(C_("Plain text")), h_abbr(C_("The submitted content is HTML.")));
}

# _html_col_host: The hostname
sub _html_col_host : method {
    $_[0]->_html_coltmpl_ro("host", h_abbr(C_("Host:")));
}

# _html_col_id: The ID.
sub _html_col_id : method {
    $_[0]->_html_coltmpl_text("id", h_abbr(C_("ID.:")));
}

# _html_col_identity: The Identity
sub _html_col_identity : method {
    $_[0]->_html_coltmpl_text("identity", h_abbr(C_("Identity:")));
}

# _html_col_intro: The introduction
sub _html_col_intro : method {
    $_[0]->_html_coltmpl_textarea("intro", h_abbr(C_("Introduction:")),
        h_abbr(C_("Fill in the introduction here.")), undef, 4);
}

# _html_col_ip: The IP
sub _html_col_ip : method {
    $_[0]->_html_coltmpl_ro("ip", h_abbr(C_("IP:")));
}

# _html_col_kw: The keywords list
sub _html_col_kw : method {
    $_[0]->_html_coltmpl_text("kw", h_abbr(C_("Keywords:")));
}

# _html_col_lang: The language
sub _html_col_lang : method {
    $_[0]->_html_coltmpl_ro_lang("lang", h_abbr(C_("Language:")));
}

# _html_col_location: The location
sub _html_col_location : method {
    $_[0]->_html_coltmpl_text("location", h_abbr(C_("Location:")));
}

# _html_col_message: The message
sub _html_col_message : method {
    $_[0]->_html_coltmpl_textarea("message", h_abbr(C_("Message:")),
        h_abbr(C_("Fill in the message here.")));
}

# _html_col_name: The name
sub _html_col_name : method {
    $_[0]->_html_coltmpl_text("name", h_abbr(C_("Name:")));
}

# _html_col_ord: The order
sub _html_col_ord : method {
    local ($_, %_);
    my ($self, $form);
    $self = $_[0];
    $form = $self->{"form"};
    # Set the default order to the half of the maximum
    $form->param("ord", (10 ** ${$self->{"maxlens"}}{"ord"}) / 2)
        if $self->{"is_first_form"} && $self->{"type"} eq "new";
    $self->_html_coltmpl_text("ord", h_abbr(C_("Order:")), undef,
        ${$self->{"maxlens"}}{"ord"});
}

# _html_col_parent: The parent
sub _html_col_parent : method {
    $_[0]->_html_coltmpl_call_null("parent", h_abbr(C_("Parent category:")),
        "topmost", h_abbr(C_("At the very top")), $MAIN->can($_[0]->{"table"} . "_title"));
}

# _html_col_passwd: The password
sub _html_col_passwd : method {
    local ($_, %_);
    my ($self, $label, $label2, $dummy, $val, $val_id, $passid, $mark, $colspan);
    my ($orig, $new, $size);
    $self = $_[0];
    $mark = $self->_mark("passwd");
    $colspan = $self->_colspan;
    $size = h($self->{"defsize"});
    $label = h_abbr(C_("Password:"));
    $label2 = h_abbr(C_("Confirm password:"));
    $dummy = "*" x ${$self->{"maxlens"}}{"passwd"};
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        print << "EOT";
<tr>
    <th class="th" scope="row"><label for="passwd">$mark$label</label></th>
EOT
        # There is a previously-saved password
        if (defined($passid = $self->{"form"}->param("passid"))) {
            $passid = h($passid);
            $val = $self->_val_scalar($dummy, "passwd");
            print << "EOT";
    <td$colspan><input type="hidden" name="passid" value="$passid"  /><input
        id="passwd" class="text" type="password" name="passwd" size="$size"$val /></td>
EOT
        } else {
            $val = $self->_val_scalar(undef, "passwd");
            print << "EOT";
    <td$colspan><input id="passwd" class="text" type="password" name="passwd" size="$size"$val /></td>
EOT
        }
        print << "EOT";
</tr>
<tr>
    <th class="th" scope="row"><label for="passwd2">$mark$label2</label></th>
EOT
        # There is a previously-saved password
        if (defined($passid = $self->{"form"}->param("passid2"))) {
            $passid = h($passid);
            $val = $self->_val_scalar($dummy, "passwd");
            print << "EOT";
    <td$colspan><input type="hidden" name="passid2" value="$passid"  /><input
        id="passwd2" class="text" type="password" name="passwd2" size="$size"$val /></td>
EOT
        } else {
            $val = $self->_val_scalar(undef, "passwd");
            print << "EOT";
    <td$colspan><input id="passwd2" class="text" type="password" name="passwd2" size="$size"$val /></td>
EOT
        }
        print << "EOT";
</tr>
EOT
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        print << "EOT";
<tr>
    <th colspan="2" scope="row"><label for="passwd">$mark$label</label></th>
EOT
        # There is a previous-saved password
        if (defined($passid = $self->{"form"}->param("passid"))) {
            $passid = h($passid);
            $val = $self->_val_scalar($dummy, "passwd");
            print << "EOT";
    <td$colspan><input type="hidden" name="passid" value="$passid"  /><input
        id="passwd" class="text" type="password" name="passwd" size="$size"$val /></td>
EOT
        } else {
            $val = $self->_val_scalar(undef, "passwd");
            print << "EOT";
    <td$colspan><input id="passwd" class="text" type="password" name="passwd" size="$size"$val /></td>
EOT
        }
        print << "EOT";
</tr>
<tr>
    <th colspan="2" scope="row"><label for="passwd2">$mark$label2</label></th>
EOT
        # There is a previous-saved password
        if (defined($passid = $self->{"form"}->param("passid2"))) {
            $passid = h($passid);
            $val = $self->_val_scalar($dummy, "passwd");
            print << "EOT";
    <td$colspan><input type="hidden" name="passid2" value="$passid"  /><input
        id="passwd2" class="text" type="password" name="passwd2" size="$size"$val /></td>
EOT
        } else {
            $val = $self->_val_scalar(undef, "passwd");
            print << "EOT";
    <td$colspan><input id="passwd2" class="text" type="password" name="passwd2" size="$size"$val /></td>
EOT
        }
        print << "EOT";
</tr>
EOT
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $dummy = h($dummy);
        print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$dummy</td>
</tr>
EOT
    }
    return;
}

# _html_col_path: The page path
sub _html_col_path : method {
    local ($_, %_);
    my ($self, $form);
    $self = $_[0];
    $form = $self->{"form"};
    # Set the default path to "/"
    $form->param("path", "/")
        if $self->{"is_first_form"} && $self->{"type"} eq "new";
    $self->_html_coltmpl_text("path", h_abbr(C_("Page path:")));
}

# _html_col_pic: The picture
sub _html_col_pic : method {
    local ($_, %_);
    my ($self, $form, $current, $label, $labelpos, $labelcap, $mark, $colspan);
    my ($curpic, $curcap, $curpos, $val, $valpic, $valcap, $orig, $new);
    my ($PICS, $pic, $setpic, $delpic, $picposid_default, $alt, $origalt);
    $self = $_[0];
    $form = $self->{"form"};
    $current = $self->{"cur"};
    $mark = $self->_mark("pic");
    $colspan = $self->_colspan;
    $label = h_abbr(C_("Picture:"));
    $labelcap = h_abbr(C_("Pic. caption:"));
    $labelpos = h_abbr(C_("Pic. position:"));
    # Obtain the picture deposit
    $PICS = pic_deposit;
    $setpic = h_abbr(C_("Set the picture"));
    $delpic = h_abbr(C_("Delete this picture"));
    $picposid_default = h("picpos" . lc PIC_POS_DEFAULT);
    
    # A form to create a new item
    if ($self->{"type"} eq "new") {
        $alt = h_abbr(C_("Picture preview"));
        if (!defined $form->param("pic")) {
            $_ = h_abbr(t_none);
            print << "EOT";
<tr>
    <th class="th" scope="row"><label for="setpic">$mark$label</label></th>
    <td$colspan>$_<input
            id="setpic" type="submit" name="setpic" value="$setpic" /></td>
</tr>
EOT
        } elsif (!pic_exists ${$form->param_fetch("pic")}[0]) {
            $_ = h_abbr(t_na);
            print << "EOT";
<tr>
    <th class="th" scope="row"><label for="setpic">$mark$label</label></th>
    <td$colspan>$_<input
            id="setpic" type="submit" name="setpic" value="$setpic" /></td>
</tr>
EOT
        } else {
            $val = $self->_val_text("pic");
            $pic = $$PICS{$form->param("pic")};
            $valpic = echopic $pic, $alt, $$pic{"ratio"};
            $valcap = $self->_val_text("piccap", "piccap");
            print << "EOT";
<tr>
    <th class="th" scope="row"><label for="setpic">$mark$label</label></th>
    <td$colspan><input type="hidden" name="pic"$val />$valpic<br />
        <input id="setpic" type="submit" name="setpic" value="$setpic" /><input
            id="delpic" type="submit" name="delpic" value="$delpic" /></td>
</tr>
<tr>
    <th class="th" scope="row"><label for="piccap">$mark$labelcap</label></th>
    <td$colspan><input id="piccap" class="text" type="text" name="piccap" size="40"$valcap /></td>
</tr>
<tr>
    <th class="th" scope="row"><label for="$picposid_default">$mark$labelpos</label></th>
EOT
            print "    <td$colspan>";
            @_ = map sprintf("<input id=\"picpos%s\" type=\"radio\""
                    . " name=\"picpos\"%s /><label"
                    . " for=\"picpos%s\">%s</label>",
                    h(lc $_),
                    $self->_val_radio("picpos", $_, ($_ eq PIC_POS_DEFAULT)),
                    h(lc $_), h_abbr(picpos_label $_)), @PIC_VALID_POS;
            print join("\n        ", @_);
            print << "EOT";
</td>
</tr>
EOT
        }
    
    # A form to edit a current item
    } elsif ($self->{"type"} eq "cur") {
        $orig = h_abbr(C_("Original:"));
        $new = h_abbr(C_("New:"));
        $origalt = h_abbr(C_("Original picture preview"));
        $alt = h_abbr(C_("New picture preview"));
        if (!defined $current->param("pic")) {
            $curpic = h_abbr(t_none);
        } elsif ($current->param("pic") == 0) {
            $curpic = h_abbr(t_na);
        } else {
            $pic = $$PICS{$current->param("pic")};
            $curpic = echopic $pic, $origalt, $$pic{"ratio"};
        }
        print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="setpic">$mark$label</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$curpic</td>
</tr>
EOT
        if (    !pic_exists(${$current->param_fetch("pic")}[0])
                && getlang ne $DEFAULT_LANG) {
            $_ = h_abbr(C_("Please upload a new picture from [_1].",
                ln($DEFAULT_LANG, LN_DESC_CURLC)));
            print << "EOT";
<tr>
    <th class="oldnew" scope="row"><label for="setpic">$new</label></th>
    <td id="setpic"$colspan>$_</td>
</tr>
EOT
        } elsif (!defined $form->param("pic")) {
            $_ = h_abbr(t_none);
            print << "EOT";
<tr>
    <th class="oldnew" scope="row"><label for="setpic">$new</label></th>
    <td$colspan>$_<input
            id="setpic" type="submit" name="setpic" value="$setpic" /></td>
</tr>
EOT
        } elsif (!pic_exists ${$form->param_fetch("pic")}[0]) {
            $_ = h_abbr(t_na);
            print << "EOT";
<tr>
    <th class="oldnew" scope="row"><label for="setpic">$new</label></th>
    <td$colspan>$_<input
            id="setpic" type="submit" name="setpic" value="$setpic" /></td>
</tr>
EOT
        } else {
            $curcap = $self->_cval_text("piccap");
            $curpos = h_abbr(picpos_label $current->param("picpos"));
            $val = $self->_val_text("pic");
            $pic = $$PICS{$form->param("pic")};
            $valpic = echopic $pic, $alt, $$pic{"ratio"};
            $valcap = $self->_val_text("piccap", "piccap");
            print << "EOT";
<tr>
    <th class="oldnew" scope="row"><label for="setpic">$new</label></th>
    <td$colspan><input type="hidden" name="pic"$val />$valpic<br />
        <input id="setpic" type="submit" name="setpic" value="$setpic" /><input
            id="delpic" type="submit" name="delpic" value="$delpic" /></td>
</tr>
EOT
            # A multi-lingual column, that is not in the default language
            if (getlang ne $DEFAULT_LANG) {
                my ($srclabel, $srccur);
                $srclabel = h_abbr(C_("Source:"));
                $_ = "piccap_" . ln($DEFAULT_LANG, LN_DATABASE);
                $srccur = $self->_cval_text($_);
                print << "EOT";
<tr>
    <th class="th" rowspan="3" scope="row"><label for="piccap">$mark$labelcap</label></th>
    <th class="oldnew" scope="row">$srclabel</th>
    <td$colspan>$srccur</td>
</tr>
<tr>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$curcap</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="piccap">$new</label></th>
    <td$colspan><input id="piccap" class="text" type="text" name="piccap" size="40"$valcap /></td>
</tr>
EOT
            } else {
                print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="piccap">$mark$labelcap</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$curcap</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="piccap">$new</label></th>
    <td$colspan><input id="piccap" class="text" type="text" name="piccap" size="40"$valcap /></td>
</tr>
EOT
            }
            print << "EOT";
<tr>
    <th class="th" rowspan="2" scope="row"><label for="$picposid_default">$mark$labelpos</label></th>
    <th class="oldnew" scope="row">$orig</th>
    <td$colspan>$curpos</td>
</tr>
<tr>
    <th class="oldnew" scope="row"><label for="$picposid_default">$new</label></th>
EOT
            print "    <td$colspan>";
            @_ = map sprintf("<input id=\"picpos%s\" type=\"radio\""
                    . " name=\"picpos\"%s /><label"
                    . " for=\"picpos%s\">%s</label>",
                    h(lc $_), h($_),
                    $self->_val_radio("picpos", $_, ($_ eq PIC_POS_DEFAULT)),
                    h(lc $_), h_abbr(picpos_label $_)), @PIC_VALID_POS;
            print join("\n        ", @_);
            print << "EOT";
</td>
</tr>
EOT
        }
    
    # A form to delete a current item
    } elsif ($self->{"type"} eq "del") {
        $alt = h_abbr(C_("Picture preview"));
        if (!defined $current->param("pic")) {
            $curpic = h_abbr(t_none);
            print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$curpic</td>
</tr>
EOT
        } elsif ($current->param("pic") == 0) {
            $curpic = h_abbr(t_na);
            print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$curpic</td>
</tr>
EOT
        } else {
            $pic = $$PICS{$current->param("pic")};
            $curpic = echopic $pic, $origalt, $$pic{"ratio"};
            $curcap = $self->_cval_text("piccap");
            $curpos = h_abbr(picpos_label $current->param("picpos"));
            print << "EOT";
<tr>
    <th class="th" scope="row">$mark$label</th>
    <td$colspan>$curpic</td>
</tr>
<tr>
    <th class="th" scope="row">$mark$labelcap</th>
    <td$colspan>$curcap</td>
</tr>
<tr>
    <th class="th" scope="row">$mark$labelpos</th>
    <td$colspan>$curpos</td>
</tr>
EOT
        }
    }
    return;
}

# _html_col_scats: The subcategories
sub _html_col_scats : method {
    local ($_, %_);
    my ($self, $form, $current, $label, $url, $mark, $colspan, $thclass, $thcolspan);
    $self = $_[0];
    $form = $self->{"form"};
    $current = $self->{"cur"};
    $mark = $self->_mark("scats");
    $colspan = $self->_colspan;
    $label = h_abbr(C_("[numerate,_1,Subcategory,Subcategories]:", $current->param("scatcount")));
    # A current form span for 2 columns
    $thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
    $thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
    
    print << "EOT";
<tr>
    <th$thclass$thcolspan scope="row">$mark$label</th>
EOT
    print "    <td$colspan>";
    @_ = qw();
    for ($_ = 0; $_ < $current->param("scatcount"); $_++) {
        push @_, sprintf("        <li><a href=\"%1\$s\">%2\$s</a>\n"
                        . "            (<a href=\"%3\$s\"><samp>%3\$s</samp></a>)\n"
                        . "        </li>\n",
            h($REQUEST_FILE . "?form=cur&sn=" . $current->param("scat$_" . "sn")),
            h($current->param("scat$_" . "title")),
            h($current->param("scat$_" . "url")));
    }
    print @_ > 0? "<ul>\n" . join("", @_) . "        </ul>\n    ": h_abbr(t_none);
    print << "EOT";
</td>
</tr>
EOT
}

# _html_col_script: The script
sub _html_col_script : method {
    $_[0]->_html_coltmpl_text("script", h_abbr(C_("Script:")));
}

# _html_col_sn: The serial number
sub _html_col_sn : method {
    $_[0]->_html_coltmpl_ro("sn", h_abbr(C_("S/N:")));
}

# _html_col_tel: The telephone number
sub _html_col_tel : method {
    $_[0]->_html_coltmpl_text("tel", h_abbr(C_("Tel.:")));
}

# _html_col_title: The title
sub _html_col_title : method {
    $_[0]->_html_coltmpl_text("title", h_abbr(C_("Title:")));
}

# _html_col_title_en: The English title
sub _html_col_title_en : method {
    $_[0]->_html_coltmpl_text("title_en", h_abbr(C_("English title:")));
}

# _html_col_updated: The last-update time
sub _html_col_updated : method {
    $_[0]->_html_coltmpl_ro_datetime("updated", h_abbr(C_("Updated:")));
}

# _html_col_updatedby: The last maintainer
sub _html_col_updatedby : method {
    $_[0]->_html_coltmpl_ro_user("updatedby", h_abbr(C_("Updated by:")));
}

# _html_col_url: The URL
sub _html_col_url : method {
    $_[0]->_html_coltmpl_url("url", h_abbr(C_("URL:")));
}

# _html_col_value: The preference value
sub _html_col_value : method {
    $_[0]->_html_coltmpl_text("value", h_abbr(C_("Value:")));
}

# _html_col_visited: The last-visited time
sub _html_col_visited : method {
    $_[0]->_html_coltmpl_ro_datetime("visited", h_abbr(C_("Visited:")));
}

# _html_col_visits: The visiting counter
sub _html_col_visits : method {
    $_[0]->_html_coltmpl_ro("visits", h_abbr(C_("Visits:")));
}

#####################
# Private utility methods.  Do not call them directly.
#####################
# _cval_text: Output a current text value
sub _cval_text : method {
    local ($_, %_);
    my ($self, $col);
    ($self, $col) = @_;
    return h($_) if defined($_ = $self->{"cur"}->param($col));
    return h_abbr(t_none);
}

# _cval_textarea: Output a current textarea value
sub _cval_textarea : method {
    local ($_, %_);
    my ($self, $col);
    ($self, $col) = @_;
    return a2html($_) if defined($_ = $self->{"cur"}->param($col));
    return h_abbr(t_none);
}

# _val_text: Output a value
sub _val_text : method {
    local ($_, %_);
    my ($self, $col, $maxcol, $html);
    ($self, $col, $maxcol) = @_;
    $html = "";
    $html .= " maxlength=\"" . h(${$self->{"maxlens"}}{$maxcol}) . "\""
        if defined $maxcol;
    $html .= defined($_ = $self->{"form"}->param($col))?
        " value=\"" . h($_) . "\"": " value=\"\"";
    return $html;
}

# _val_scalar: Output a scalar value
sub _val_scalar : method {
    local ($_, %_);
    my ($self, $val, $maxcol, $html);
    ($self, $val, $maxcol) = @_;
    $html = "";
    $html .= " maxlength=\"" . h(${$self->{"maxlens"}}{$maxcol}) . "\""
        if defined $maxcol;
    $html .= defined $val?
        " value=\"" . h($val) . "\"": " value=\"\"";
    return $html;
}

# _val_date: Output a date value
sub _val_date : method {
    local ($_, %_);
    my ($self, $col, $maxcol, $html, $val);
    ($self, $col, $maxcol) = @_;
    $html = "";
    $html .= " maxlength=\"" . h(${$self->{"maxlens"}}{$maxcol}) . "\""
        if defined $maxcol;
    if (defined($val = $self->{"form"}->param($col))) {
        $val = fmtdate $val if $val =~ /^\-?\d+(?:\.\d+)?$/;
    }
    $html .= defined $val?
        " value=\"" . h($val) . "\"": " value=\"\"";
    return $html;
}

# _val_textarea: Output a value as a textarea content
sub _val_textarea : method {
    local ($_, %_);
    my ($self, $col, $default);
    ($self, $col, $default) = @_;
    return h($_) if defined($_ = $self->{"form"}->param($col)) && $_ ne "";
    return h($default);
}

# _val_check: Output a value as a checkbox check value
sub _val_check : method {
    local ($_, %_);
    my ($self, $col);
    ($self, $col) = @_;
    return " checked=\"checked\""
        if defined($_ = $self->{"form"}->param($col)) && $_;
    return "";
}

# _val_radio: Output a value as a radio check value
sub _val_radio : method {
    local ($_, %_);
    my ($self, $col, $valhere, $is_default);
    ($self, $col, $valhere, $is_default) = @_;
    $is_default = 0 if !defined $is_default;
    
    return " value=\"" . h($valhere) . "\""
            . (($_ eq $valhere)? " checked=\"checked\"": "")
        if defined($_ = $self->{"form"}->param($col));
    return " value=\"" . h($valhere) . "\""
            . ($is_default? " checked=\"checked\"": "");
}

# _colspan: Output the colspan phrase
sub _colspan : method {
    local ($_, %_);
    my ($self, $addcols);
    ($self, $addcols) = @_;
    $addcols = 0 if !defined $addcols;
    $_ = $self->{"colspan"} + $addcols;
    # Only output for many columns
    return $_ > 1? " colspan=\"" . h($_) . "\"": "";
}

# _colspan_full: Output the colspan phrase spanning the whole table
sub _colspan_full : method {
    local ($_, %_);
    my ($self, $addcols);
    ($self, $addcols) = @_;
    $addcols = 0 if !defined $addcols;
    $_ = $self->{"colspan"} + $addcols;
    $_ += ($self->{"type"} eq "cur")? 2: 1;
    # Only output for many columns
    return $_ > 1? " colspan=\"" . h($_) . "\"": "";
}

# _mark: Output the column mark
sub _mark : method {
    local ($_, %_);
    my ($self, $col);
    ($self, $col) = @_;
    # Bounce if no columns to check or no mark to use
    return "" if !exists $self->{"markcols"} || !defined $self->{"mark"};
    %_ = map { $_ => 1 } @{$self->{"markcols"}};
    return exists $_{$col}? $self->{"mark"}: "";
}

# _delcolcount: Obtain the number of items of a column for the deletion form
sub _delcolcount : method {
    local ($_, %_);
    my ($self, $col);
    ($self, $col) = @_;
    # None-deletion form -- return 0 since the number of items is unknown
    return 0 unless $self->{"type"} eq "del";
    # Deletion form -- return the number of items
    return $self->{"cur"}->param($col . "count")
}


###################
# Echo the column values
###################


# Selima::Form::MetaCols: Manage and output the meta form information
package Selima::Form::MetaCols;
use 5.008;
use strict;
use warnings;

use Selima::ShortCut;

# new: Initialize the handler
sub new : method {
    local ($_, %_);
    my ($class, $self);
    $class = $_[0];
    $self = bless {}, $class;
    $self->{"cols"} = [];
    return $self;
}

# add: Add a column
sub add : method {
    local ($_, %_);
    my ($self, $type, $name, $value);
    ($self, $type, $name, $value) = @_;
    push @{$self->{"cols"}}, {
        "type"  => $type,
        "name"  => $name,
        "value" => $value,
    };
    return;
}

# out: Output the columns
sub out : method {
    local ($_, %_);
    my $self;
    $self = $_[0];
    # Bounce for nothing
    return if @{$self->{"cols"}} == 0;
    # Output the first column
    $_ = shift @{$self->{"cols"}};
    print "<input " . $self->_out_attrs($_) . " />";
    # Output the rest columns
    print "<input\n    " . $self->_out_attrs($_) . " />"
        foreach @{$self->{"cols"}};
    # Output a new line
    print "\n";
    return;
}

# _out_attrs: Output the attributes
sub _out_attrs : method {
    local ($_, %_);
    my $self;
    ($self, $_) = @_;
    @_ = qw();
    push @_, "type=\"" . h($$_{"type"}) . "\"";
    push @_, "name=\"" . h($$_{"name"}) . "\""
        if defined $$_{"name"};
    if (defined $$_{"name"} && $$_{"name"} eq "charset") {
        push @_, "value=\"<!--selima:charset-->\"";
    } else {
        push @_, "value=\"" . h($$_{"value"}) . "\"";
    }
    return join " ", @_;
}

return 1;