100 lines
2.7 KiB
Perl
100 lines
2.7 KiB
Perl
# Selima Website Content Management System
|
|
# EchoForm.pm: The subroutines to output various form elements.
|
|
|
|
# Copyright (c) 2003-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: 2003-03-30
|
|
|
|
package Selima::EchoForm;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Exporter);
|
|
use vars qw(@EXPORT @EXPORT_OK);
|
|
BEGIN {
|
|
@EXPORT = qw();
|
|
push @EXPORT, qw(auto_keep_referer);
|
|
push @EXPORT, qw(opt_list opt_list_array preselect_options);
|
|
@EXPORT_OK = @EXPORT;
|
|
# Prototype declaration
|
|
sub opt_list($$);
|
|
sub opt_list_array(\@);
|
|
sub preselect_options($$);
|
|
sub auto_keep_referer();
|
|
}
|
|
|
|
use Selima::Cache qw(:echoform);
|
|
use Selima::CommText;
|
|
use Selima::DataVars qw($DBH);
|
|
use Selima::ShortCut;
|
|
use Selima::Unicode;
|
|
|
|
# opt_list: Return an options list
|
|
sub opt_list($$) {
|
|
local ($_, %_);
|
|
my ($sql, $curval, $sth, $count, $html);
|
|
($sql, $curval) = @_;
|
|
# Not cached yet
|
|
if (!exists $EchoForm_opt_list{$sql}) {
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0, @_ = qw(); $_ < $count; $_++) {
|
|
push @_, $sth->fetchrow_hashref;
|
|
}
|
|
$EchoForm_opt_list{$sql} = opt_list_array @_;
|
|
}
|
|
return preselect_options($EchoForm_opt_list{$sql}, $curval);
|
|
}
|
|
|
|
# opt_list_array: Return an options list from an array
|
|
sub opt_list_array(\@) {
|
|
local ($_, %_);
|
|
my ($opts, $html);
|
|
$opts = $_[0];
|
|
# Obtain the HTML
|
|
$html = " <option value=\"\">"
|
|
. h(t_notset) . "</option>\n";
|
|
foreach (@$opts) {
|
|
$html .= " <option value=\""
|
|
. h($$_{"value"}) . "\">"
|
|
. h($$_{"content"}) . "</option>\n";
|
|
}
|
|
return $html;
|
|
}
|
|
|
|
# preselect_options: Presect an option in an option list
|
|
sub preselect_options($$) {
|
|
local ($_, %_);
|
|
my ($html, $value);
|
|
($html, $value) = @_;
|
|
# Not selected if value not set
|
|
return $html if !defined $value;
|
|
$value = h_encode($value);
|
|
$html =~ s/<(option value="$value")>/<$1 selected="selected">/;
|
|
return $html;
|
|
}
|
|
|
|
# auto_keep_referer: If we should keep the referer information
|
|
# To be done
|
|
sub auto_keep_referer() {
|
|
local ($_, %_);
|
|
# False for now;
|
|
return 0;
|
|
}
|
|
|
|
return 1;
|