2658 lines
88 KiB
Perl
2658 lines
88 KiB
Perl
# 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 == "$hdef") this.value = "";">$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 == "$hdef") this.value = "";">$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 == "$hdef") this.value = "";">$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;
|